;; pick the right procedure based on the size of the variable
;; vector sizes expand to 2, 3 or 4 dimensions.
;; (pp (expand '(vector-length-dispatch variable f32vector +/type/for/variable)))
(define-syntax vector-length-dispatch
  (er-macro-transformer
   (lambda (x r t)     
     (let* ((variable (cadr x))
            (vtype (caddr x))
            (form (cadddr x))
            (precision-prefix (case vtype
                                ((f32vector) "")
                                ((f64vector) 'd)
                                ((s32vector) 'i)
                                ((u32vector) 'u)
                                ((u8vector)  'b)))
            (vector-type? (string->symbol (conc vtype "?")))
            (vector-length (string->symbol (conc vtype "-length"))))
       `(begin (,(r 'case) (,vector-length ,variable)
          ((2) ,(rewrite form variable (conc precision-prefix "vec2")))
          ((3) ,(rewrite form variable (conc precision-prefix "vec3")))
          ((4) ,(rewrite form variable (conc precision-prefix "vec4")))))))))



;; *** vector constructors

(begin-template
 `((P vec dvec   ivec uvec   bvec)
   (R ,glmtype->schemetype)) ;; f32vector s32vector etc
 
 (define (P2 x y)     (R x y))
 (define (P3 x y z)   (R x y z))
 (define (P4 x y z w) (R x y z w)))


(begin-template
 `((D 2 3 4))
 (define (make-vecD  fill) (make-f32vector D fill))
 (define (make-dvecD fill) (make-f64vector D fill))
 (define (make-ivecD fill) (make-s32vector D fill))
 (define (make-uvecD fill) (make-u32vector D fill))
 (define (make-bvecD fill) (make-u8vector D fill)))




;; OBS: we won't be able to distinguish between vec4 and mat2 for example
(begin-template
 `((D 2 3 4))

 (define ( vecD? vec) (and (f32vector? vec) (= (f32vector-length vec) D)))
 (define (dvecD? vec) (and (f64vector? vec) (= (f64vector-length vec) D)))

 (define (ivecD? vec) (and (s32vector? vec) (= (s32vector-length vec) D)))
 (define (uvecD? vec) (and (u32vector? vec) (= (u32vector-length vec) D)))

 (define (bvecD? vec) (and (u8vector? vec) (= (u8vector-length vec) D))))


;;; vector operations
(begin-template
 `((T  vec2  vec3  vec4
       dvec2 dvec3 dvec4
       uvec2 uvec3 uvec4
       ivec2 ivec3 ivec4
       bvec2 bvec3 bvec4
       )
   (R ,value-type))

 ;; unary operators
 (define length/T (glm R "return(" "glm::length(" T "));"))
   
 ;; infix operators
 (begin-template `((OP + - * /) )
           
           (define OP/T/T! (glm void T "=" T "OP" T))
           (define (OP/T/T operand1 operand2)
             (with-destination (make-T #f) OP/T/T! operand1 operand2)))

 ;; vector unary operators
 (begin-template `((OP
              abs      ceil  floor       fract round roundEven  sign
              sin      cos  tan  sinh  cosh  tanh
              asin acos atan asinh acosh atanh
              degrees  radians
              exp      exp2     inversesqrt log   log2  sqrt
              normalize
              ))
           (define OP/T! (glm void T "=" "glm::OP(" T ")"))
           (define (OP/T vec) (with-destination (make-T #f) OP/T! vec)))
 

 ;; prefix binary operators, primitive return type
 (begin-template `((OP "dot" "distance"))
           (define OP/T (glm R "return(" "glm::" "OP" "(" T "," T "));"))))

(define (length/vec v)
  (cond-template
   `((VECTOR f32vector f64vector  s32vector u32vector u8vector))
   ((VECTOR? v) ((vector-length-dispatch v VECTOR length/v) v))
   (error "unknown vector-type" v)))

(begin-template
 `((<OP> dot distance))
 
 (define (<OP> v1 v2)
   (cond-template
    `((VECTOR f32vector f64vector   s32vector u32vector u8vector))
    ((VECTOR? v2) (if (VECTOR? v2)
                      (if (= (VECTOR-length v1) (VECTOR-length v2))
                          ((vector-length-dispatch v1 VECTOR <OP>/v1) v1 v2)
                          (error "vector length mismatch" v1 v2))
                      (error "operand two must be vector" v2)))
    (error "unknown vector-type" v1))))



;; vector-scalar infix operators (excludes bvec types)
(begin-template
 `((T  vec2  vec3  vec4
       dvec2 dvec3 dvec4
       uvec2 uvec3 uvec4
       ivec2 ivec3 ivec4
       )
   (R ,value-type))
 
 ;; infix operators
 (begin-template `((OP + - * /) )
      
           (define OP/T/scalar! (glm void T "=" T "OP" R))
           (define (OP/T/scalar vec scalar)
             (with-destination (make-T #f) OP/T/scalar! vec scalar))))


;; cross is only defined for vec3
(begin-template
 `((T vec3 dvec3 ivec3 uvec3 bvec3))
 (define cross/T! (glm void T "=" "glm::cross(" T "," T ")"))
 (define (cross/T veca vecb) (with-destination (make-T #f) cross/T! veca vecb)))



;; vector-vector or vector-scalar
(begin-template
 `((<OP> * / + -))

 (define (<OP>/vec/scalar/delegate vec scalar)
   (cond
    ((f32vector? vec) (vector-length-dispatch vec f32vector <OP>/vec/scalar))
    ((f64vector? vec) (vector-length-dispatch vec f64vector <OP>/vec/scalar))
    ((s32vector? vec) (vector-length-dispatch vec s32vector <OP>/vec/scalar))
    ((u32vector? vec) (vector-length-dispatch vec u32vector <OP>/vec/scalar))))

 (define (v<OP>/delegate v1 v2)
   (if (number? v2)  (<OP>/vec/scalar/delegate v1 v2)
       (cond-template
        `((VECTOR f32vector f64vector s32vector u32vector))
        ((VECTOR? v1) (if (VECTOR? v2)
                          (if (= (VECTOR-length v1) (VECTOR-length v2))
                              (vector-length-dispatch v1 VECTOR <OP>/v1/v1)
                              (error "vector dimension mismatch" v1 v2))
                          (if (number? v2)
                              (vector-length-dispatch v1 VECTOR <OP>/v1/scalar)
                              (error "invalid operand types" v1 v2))))
        (error "unknown vector type" v1))))

 (define (v<OP> v1 v2)
   ((v<OP>/delegate v1 v2) v1 v2)))

;; this should do what we want,
;; but let's keep an eye on this guy:
(define v= equal?)