#lang scheme/gui
(require sgl)

;;; ebellani's code
;; Standard requires
(require sgl/gl
         sgl/gl-vectors)

(define ITERATIONS 3)

;; simple struct
;; a b c d are all vectors of floats
(define-struct tetrahedron (a b c d))

(define INITIAL-TETRAHEDRON (make-tetrahedron
                             #(0.0 0.0 1.0)
                             #(0.0 0.942809 -0.33333)
                             #(-0.816497 -0.471405 -0.33333)
                             #(0.816497 -0.471405 -0.33333)))

(define COLORS #(#(1.0 0.0 0.0) 
                 #(0.0 1.0 0.0) 
                 #(0.0 0.0 1.0) 
                 #(0.0 0.0 0.0)))

;; draw-triangle : (vectorof float) (vectorof float) (vectorof float) -> void
(define (draw-triangle a b c)
  (begin (glVertex3fv (vector->gl-float-vector a))
         (glVertex3fv (vector->gl-float-vector b))
         (glVertex3fv (vector->gl-float-vector c))))


;; draw-tetrahedron : tetrahedron -> void
(define (draw-tetrahedron a-tetrahedron)
  (local [;; draw-part : (tetrahedron -> (vectorof float))
          ;;             (tetrahedron -> (vectorof float))
          ;;             (tetrahedron -> (vectorof float))
          ;;             number -> void
          (define (draw-part part1 part2 part3 color-index)
            (begin (glColor3fv (vector->gl-float-vector
                                (vector-ref COLORS color-index)))
                   (draw-triangle (part1 a-tetrahedron)
                                  (part2 a-tetrahedron)
                                  (part3 a-tetrahedron))))]
    (begin (draw-part tetrahedron-a tetrahedron-b tetrahedron-c 0)
           (draw-part tetrahedron-a tetrahedron-c tetrahedron-d 1)
           (draw-part tetrahedron-a tetrahedron-d tetrahedron-b 2)
           (draw-part tetrahedron-b tetrahedron-d tetrahedron-c 3))))

;; divide-tetrahedron : tetrahedron number -> void
;; divides the tetrahedron into 4 other tetrahedrons, and
;; contine doing this N times, then draws them.
(define (divide-tetrahedron a-tetrahedron (n 0))
  (local [;; compute-midpoint : (vectorof float) (vectorof float) ->
          ;;                     (vectorof float)
          (define (compute-midpoint a b (index 0))
            (cond
              [(>= index 3) #()]
              [else
               (let ([result (/ (+ (vector-ref a index)
                                   (vector-ref b index) 2))])
                 (vector-append (vector result)
                                (compute-midpoint a b (add1 index))))]))
          (define midpoint-0
            (compute-midpoint (tetrahedron-a a-tetrahedron)
                              (tetrahedron-b a-tetrahedron)))
          (define midpoint-1
            (compute-midpoint (tetrahedron-a a-tetrahedron)
                              (tetrahedron-c a-tetrahedron)))
          (define midpoint-2
            (compute-midpoint (tetrahedron-a a-tetrahedron)
                              (tetrahedron-d a-tetrahedron)))
          (define midpoint-3
            (compute-midpoint (tetrahedron-b a-tetrahedron)
                              (tetrahedron-c a-tetrahedron)))
          (define midpoint-4
            (compute-midpoint (tetrahedron-c a-tetrahedron)
                              (tetrahedron-d a-tetrahedron)))
          (define midpoint-5
            (compute-midpoint (tetrahedron-b a-tetrahedron)
                              (tetrahedron-d a-tetrahedron)))]
    (cond [(> n ITERATIONS)
           (draw-tetrahedron a-tetrahedron)]
          [else
           (begin (divide-tetrahedron
                   (make-tetrahedron (tetrahedron-a a-tetrahedron)
                                     midpoint-0
                                     midpoint-1
                                     midpoint-2)
                   (add1 n))
                  (divide-tetrahedron
                   (make-tetrahedron midpoint-0
                                     (tetrahedron-b a-tetrahedron)
                                     midpoint-3
                                     midpoint-5)
                   (add1 n))
                  (divide-tetrahedron
                   (make-tetrahedron midpoint-1
                                     midpoint-3
                                     (tetrahedron-c a-tetrahedron)
                                     midpoint-4)
                   (add1 n))
                  (divide-tetrahedron
                   (make-tetrahedron midpoint-2
                                     midpoint-4
                                     (tetrahedron-d a-tetrahedron)
                                     midpoint-5)
                   (add1 n)))])))
(define (display)
  (begin (glClear GL_COLOR_BUFFER_BIT)
         (glBegin GL_TRIANGLES)
         (divide-tetrahedron INITIAL-TETRAHEDRON)
         (glEnd)
         (glFlush)))

;;; my code
(define width 800)
(define height 600)

(define world-canvas%
  (class canvas%
    (init-field init on-draw)
    
    (super-new)
    
    (define dc (send this get-dc))
    (define gl-ctx (send dc get-gl-context))
    
    (send gl-ctx call-as-current
          (lambda ()
            (init)
            (send gl-ctx swap-buffers)))     
    
    (define/override (on-paint)
      (send gl-ctx call-as-current
            (lambda ()
              (on-draw)
              (gl-flush)
              (send gl-ctx swap-buffers))))))

(define frame 
  (new frame% 
       [label ""]
       [min-width width]
       [min-height height]
       [stretchable-width #f]
       [stretchable-height #f]
       [style '(no-resize-border metal)]))

(define canvas
  (new world-canvas% 
       [parent frame]
       [init (lambda ()
               (printf "Initializing GL context.~n"))]
       [on-draw display]
       [style '(no-autoclear)]))

(send canvas focus)
(send frame center)
(send frame show #t)