#lang scheme/gui

;;LA VENTANA Y EL LIENZO
(define ventana
  (make-object frame% 
    "3 D" 
    #f 
    500 500;ANCHO ALTO
    1400 0;UBICACIÓN
    ))

(define lienzo
  (instantiate canvas% 
    (ventana) 
    (style '(border)) ))
  
(define dc (send lienzo get-dc))

(send ventana show #t)
(sleep/yield 1)

;;
(define x-or 50)
(define y-or 450)
(define x-fin 450)
(define y-fin 50)
;;una rejilla con divisiones cada 10 puntos
(define rejilla
  (lambda (dc)
    (send dc set-pen (make-object pen% "black" 0.3 'long-dash))
    (let* ((orig-x x-or)
           (orig-y y-or)
           (largo 450)
           )
      (let go ((i 0)
               (j largo)
               )
        (if (= i j)
            'grid-10
            (begin
              (send dc draw-line orig-x (- orig-y i) (+ orig-x largo) (- orig-y i))
              (send dc draw-line (+ orig-x i) orig-y (+ orig-x i) (- orig-y largo))
              (go (+ 10 i) j))
            )
        )
      )
    ))
(rejilla dc)
;la diagonal
(define diagonal
  (lambda (dc)
    (send dc set-pen (make-object pen% "black" 0.5 'long-dash))
    (send dc draw-line x-or y-or x-fin y-fin)))
(diagonal dc)
;;ensayo de escalado y perspectiva
(define escalado
  (lambda (base altura offset)
    (values (- base offset) (- altura offset)) ))

(define perspectiva
  (lambda (x-orig y-orig offset)
    (values (+ x-orig offset) (- y-orig offset)) ))
;;La idea es: nos dan la cara de un cubo
;;calculamos los 4 puntos de cada cara que hay que pintar (3)
(define calculo-puntos-paralelepipedo
  (lambda (x-orig y-orig base altura escala persp)
    (let* ((x1 (+ x-or x-orig));vértice superior izqdo.
           (y1 (- y-or y-orig));vértice superior izqdo.
           (x2 (+ x1 base));vértice superior dcho.
           (y2 y1);vértice superior dcho.
           (x3 x1);vértice inferior izqdo.
           (y3 (+ y1 altura));vértice inferior izqdo.
           (x4 x2);vértice inferior dcho.
           (y4 y3);vértice inferior dcho.
           )
      (let-values (((b a) (escalado base altura escala))
                   ((x y) (perspectiva x1 y1 persp))
                   )
        (let* ((x_1 x)
               (y_1 y)
               (x_2 (+ x_1 b))
               (y_2 y_1)
               (x_3 x_1)
               (y_3 (+ y_1 a))
               (x_4 x_2)
               (y_4 y_3)
               )
      (values
       (make-object point% x1 y1);frente arriba izqdo y tapa delante izqdo
       (make-object point% x2 y2);frente arriba dcho y costado delante arriba y tapa delante dcho
       (make-object point% x3 y3);frente abajo izdo
       (make-object point% x4 y4);frente abajo dcho y costado delante abajo
       (make-object point% x_2 y_2);costado atrás arriba y tapa atrás dcha
       (make-object point% x_4 y_4);costado atrás abajo
       (make-object point% x_1 y_1);tapa atrás izqda
       )
      )))
    ))
(define draw-paralelepipedo
  (lambda (dc color x-orig y-orig base altura escala persp)
    (send dc set-pen (make-object pen% color 3 'solid))
    (send dc set-brush (make-object brush% color 'solid))
    (let-values (((p1 p2 p3 p4 p5 p6 p7) 
                  (calculo-puntos-paralelepipedo x-orig y-orig base altura escala persp))
                 )
      (send dc draw-lines (list p1 p2 p4 p3 p1) 0 0);frente
      (send dc draw-lines (list p1 p2 p5 p7 p1) 0 0);tapa
      (send dc draw-lines (list p2 p5 p6 p4 p2) 0 0);costado
      )
    ))
(draw-paralelepipedo dc "black" 200 200 50 50 10 20)
(draw-paralelepipedo dc "red" 50 50 80 50 10 20)
      
          