#lang racket


(require racket/gui/base
         sgl
         sgl/gl
         sgl/gl-vectors)

(require "../base/coord.rkt"
         "../base/bounding-box.rkt")

(require (prefix-in % "vlwrapper.rkt"))

(provide (rename-out [%load-opengl load-opengl]
                     [%refresh refresh]
                     [%add-sweep add-sweep]
                     [%add-loft-curve-point add-loft-curve-point]
                     [%add-surface-from-curve add-surface-from-curve]
                     [%erase-all-actors erase-all-actors]
                     [%erase-actor erase-actor]
                     [%call-in-opengl call-in-opengl]))

(provide (all-defined-out))

(define (all-actors)
  (for/list ((i (in-range (%actor-count))))
    (%actor-at i)))

(define (set-view position target lens)
  (%call-in-opengl
   (thunk
    (%set-view (xyz-x position) (xyz-y position) (xyz-z position)
               (xyz-x target) (xyz-y target) (xyz-z target)
               lens))))

(define (set-view-top)
  (%call-in-opengl
   (thunk
    (%set-view-top))))

(define (zoom-extents)
  (%call-in-opengl
   (thunk
    (%zoom-extents))))

#;(define (erase-all-actors)
  (%call-in-opengl
   (thunk
    (%erase-all-actors))))

(define (add-point pt)
  (let ((pt (as-world pt)))
    (%add-point (xyz-x pt)
                (xyz-y pt)
                (xyz-z pt))))

(define (floats<-pts pts)
  (if (null? pts)
      (list)
      (let ((pt (as-world (car pts))))
        (cons (exact->inexact (xyz-x pt))
              (cons (exact->inexact (xyz-y pt))
                    (cons (exact->inexact (xyz-z pt))
                          (floats<-pts (cdr pts))))))))

(define (add-line closed? pts)
  (%add-polyline closed? (length pts) (floats<-pts pts)))
 
(define (add-spline closed? pts v0 v1)
  (let ((l (length pts)))
    (if (< l 2)
        (error 'add-spline "A spline must have at least two points")
        (let ((pts (if closed? (if (not (or v0 v1)) pts (cons (last pts) pts)) pts)))
          (let ((pts (if v1 (append pts (list (+c (last pts) v1))) pts)))
            (let ((pts (if v0 (cons (-c (car pts) v0) pts) pts)))
              (%add-spline closed? (not (or v0 v1)) (* l 10) l (floats<-pts pts))))))))

(define (add-grid-surface ptss closed-s? smooth-s? closed-t? smooth-t?)
  (%add-grid-surface (length ptss) closed-s? smooth-s? 
                (length (car ptss)) closed-t? smooth-t? 
                (floats<-pts (append* ptss))))


(define facet-resolution 60)

(define (add-circle c r)
  (%add-circle (xyz-x c) (xyz-y c) (xyz-z c) r facet-resolution))

(define (add-arc c r ba ea)
  (%add-arc (xyz-x c) (xyz-y c) (xyz-z c) r ba ea facet-resolution))

(define (add-rectangle c dx dy)
  (%add-rectangle (xyz-x c) (xyz-y c) (xyz-z c) dx dy))

(define (join-curves ss)
  (%join-curves ss (length ss)))


#;
(define (add-nurbs-curve controls knots)
  (add! (nurbs-curve gl-identity draw-nurbs-curve controls knots)))
#;
(define (add-nurbs-surface controls u-knots v-knots)
  (add! (nurbs-surface gl-identity draw-nurbs-surface controls u-knots v-knots)))

(define (add-box c w l h)
  (%add-box (xyz-x c) (xyz-y c) (xyz-z c) w l h))

(define (add-cylinder c r h)
  (%add-cylinder (xyz-x c) (xyz-y c) (xyz-z c) r h))

(define (add-cone c r h)
  (%add-cone (xyz-x c) (xyz-y c) (xyz-z c) r h))

(define (add-cone-frustum c rb rt h)
  (%add-cone-frustum (xyz-x c) (xyz-y c) (xyz-z c) rb rt h))

(define (add-pyramid c r h a n)
  (%add-pyramid (xyz-x c) (xyz-y c) (xyz-z c) r h (radians->degrees a) n))

(define (add-pyramid-frustum c br tr h a n)
  (%add-pyramid-frustum (xyz-x c) (xyz-y c) (xyz-z c) br tr h (radians->degrees a) n))

(define (add-sphere c r)
  (%add-sphere (xyz-x c) (xyz-y c) (xyz-z c) r))

(define (add-torus c re ri)
  (%add-torus (xyz-x c) (xyz-y c) (xyz-z c) re ri))

(define (add-text str c font-size)
  (%add-text (xyz-x c) (xyz-y c) (xyz-z c) font-size str))

(define (transform actor matrix)
  (apply %transform actor (list<-matrix matrix))
  actor)

(define (add-extrusion s v solid? pivot? smooth?)
  (%add-extrusion s (xyz-x v) (xyz-y v) (xyz-z v) solid? solid? pivot? smooth?))

(define (add-loft ss ruled? solid? closed? smooth?)
  (if (or (not ruled?) closed?)
      (error 'add-loft "The OpenGL backend only provides non-closed ruled lofts")
      (%add-loft ss (length ss) ruled? closed? solid? solid? smooth?)))

(define (add-surface-from-curves ss)
  (%add-surface-from-curves ss (length ss)))

(define (add-surface-from-points pts)
  (%add-surface-from-points (length pts) (floats<-pts pts)))

(define (add-surface-circle c r)
  (%add-surface-circle (xyz-x c) (xyz-y c) (xyz-z c) r 40))

(define (add-surface-arc c r ba ea)
  (%add-surface-arc (xyz-x c) (xyz-y c) (xyz-z c) r ba ea 40))

(define (add-surface-from-points-pivot pts p)
  (%add-surface-from-points-pivot (length pts) (floats<-pts pts) (xyz-x p) (xyz-y p) (xyz-z p)))

(define (bounding-box actor)
  (let-values ([(min-x min-y min-z max-x max-y max-z)
                (%bounding-box actor)])
    (make-bbox
     (box-corners-pp
      (xyz min-x min-y min-z)
      (xyz max-x max-y max-z)))))

(define (point-coordinates actor)
  (let-values ([(x y z)
                (%point-coordinates actor)])
    (xyz x y z)))

(define (add-intersect ids) ids)
#|
(define (move c id) #f #;
  (begin0
    id
    (let ((m
           (gl-vector<-matrix
            (*m (m-translation c) (matrix<-gl-vector (shape-tm id))))))
      (set-shape-tm! id m))))

(define (rotate a n id) #f #;
  (begin0
    id
    (let ((m
           (gl-vector<-matrix
            (*m (m-rotation a n) (matrix<-gl-vector (shape-tm id))))))
      (set-shape-tm! id m))))

(define (scale type c id/ids) #f #;
  (define (scale id)
    (let ((m
           (gl-vector<-matrix
            (*m (m-scaling c) (matrix<-gl-vector (shape-tm id))))))
      (set-shape-tm! id m)))
  #;
  (begin0
    id/ids
    (if (list? id/ids)
        (for-each scale id/ids)
        (scale id/ids))))

|#
(define (move actor v)
  (%move actor (xyz-x v) (xyz-y v) (xyz-z v))
  actor)

(define (rotate actor a n)
  (%rotate actor a (xyz-x n) (xyz-y n) (xyz-z n))
  actor)

(define (scale actor s)
  (%scale actor s s s)
  actor)