#lang scheme

(require "point.ss")
(require "vector.ss")
(require "../utils.ss")
;(require (prefix-in point: "point.ss"))
;(require (prefix-in vector: "vector.ss"))
;
;(define xyz point:xyz)
;(define xy  point:xy )
;(define cx  point:cx )
;(define cy  point:cy )
;(define cz  point:cz )
;
;(define vxyz vector:vxyz)
;(define vxy  vector:vxy )
;(define vx   vector:vx  )
;(define vy   vector:vy  )
;(define vz   vector:vz  )


(require (only-in scheme
                  + - * /))
                      ;; Será que faz sentido?
;                      sin cos tan)))
;(require (prefix-in
;          s: (only-in "coordinates-new.ss"
;                      ;; Será que faz sentido?
;                      sec csc cot
;                      sinh cosh tanh asinh acosh atanh)))

(provide (rename-out [+** +]
                     [-** -]
                     [*** *]
                     [/** /]))

;         ;; Será que faz sentido?
;         sin cos tan sec csc cot
;         sinh cosh tanh asinh acosh atanh)



;;;; Prepare functions to map through a point/vector's coordinates
(define-syntax define-curried-version
  (syntax-rules ()
    [(_ name f)
     (define name
       (case-lambda
         ;; With zero arguments, perform the default behaviour.
         [()
          (f)]
         ;; With one argument, curry the function.
         [(arg)
          (lambda args
            (apply f arg args))]
         ;; With more than one arguments, perform the default behaviour.
         [args
          (apply f args)]))]))


;;;; Defines a point/vector version of function f
;; f must be a commutative function of two arguments
;;   If one of those arguments is a point or a vector,
;;   the function is mapped across its coordinates.

;; 2 (or more*) argument version
(define-syntax define-point/vector-version-2*
  (lambda (stx)
    (syntax-case stx ()
      [(_ name f)
       #`(define name
           (let ([map-point (lambda (p f)
                              (if (point-3d? p)
                                  (xyz (f (cx p))
                                       (f (cy p))
                                       (f (cz p)))
                                  (xy  (f (cx p))
                                       (f (cy p)))))]
                 [map-vector (lambda (v f)
                               (if (vector-3d? v)
                                   (vxyz (f (vx v))
                                         (f (vy v))
                                         (f (vz v)))
                                   (vxy  (f (vx v))
                                        (f (vy v)))))])
             (case-lambda
               ;; With zero arguments, perform the default behaviour.
               [()
                (f)]
               ;; With one argument, perform the default behaviour.
               [(arg)
                (f arg)]
              ;; With two arguments, check for point/vector.
               [(a1 a2)
                (let ([error-out (lambda ()
                                   (error #,(syntax->datum #'(quote f))
                                          "Function ~s is not applicable to objects: '~s' and '~s'."
                                          #,(syntax->datum #'(quote f)) a1 a2))])
                  (cond [(number? a1)
                         (cond [(number? a2)
                                (f a1 a2)]
                               [(point? a2)
                                (map-point a2 (lambda (x) (f x a2)))]
                               [(gvector? a2)
                               (map-vector a2 (lambda (x) (f x a2)))]
                               [else (error-out)])]
                        [(point? a1)
                         (cond [(number? a2)
                                (map-point a1 (lambda (x) (f x a2)))]
                               [(point? a2)
                                (error "Can't apply function " name " to two points.")]
                               [(gvector? a2)
                                (when (not (same-dimension? a1 a2))
                                  (error a1 " and " a2 " are not of the same dimension."))
                                (if (point-3d? a1)
                                    (xyz (f (cx a1) (vx a2))
                                        (f (cy a1) (vy a2))
                                        (f (cz a1) (vz a2)))
                                    (xy  (f (cx a1) (vx a2))
                                         (f (cy a1) (vy a2))))]
                               [else (error-out)])]
                        [(gvector? a1)
                         (cond [(number? a2)
                               (map-vector a1 (lambda (x) (f x a2)))]
                               [(point? a2)
                                (when (not (same-dimension? a1 a2))
                                  (error a1 " and " a2 " are not of the same dimension."))
                                (if (vector-3d? a1)
                                    (vxyz (f (vx a1) (cx a2))
                                          (f (vy a1) (cy a2))
                                          (f (vz a1) (cz a2)))
                                    (vxy  (f (vx a1) (cx a2))
                                         (f (vy a1) (cy a2))))]
                               [(gvector? a2)
                                (when (not (same-dimension? a1 a2))
                                  (error a1 " and " a2 " are not of the same dimension."))
                                (if (vector-3d? a1)
                                    (vxyz (f (vx a1) (vx a2))
                                          (f (vy a1) (vy a2))
                                         (f (vz a1) (vz a2)))
                                    (vxy  (f (vx a1) (vx a2))
                                          (f (vy a1) (vy a2))))]
                               [else (error-out)])]
                        [else (f a1 a2)]))] ;; Default.
               ;; With more than two arguments, perform the default behaviour.
               [args
               (apply f args)])))])))

;; 1 argument version
(define-syntax-rule (define-point/vector-version-1 name f)
  (define name
    (let ([map-point (lambda (p f)
                       (xyz (f (cx p))
                            (f (cy p))
                            (f (cz p))))]
          [map-vector (lambda (v f)
                        (vxyz (f (vx v))
                              (f (vy v))
                              (f (vz v))))])
      (case-lambda
        ;; With zero arguments, perform the default behaviour.
        [()
         (f)]
        ;; With one argument, perform the default behaviour.
        [(arg)
         (cond [(point? arg)
                (map-point arg f)]
               [(gvector? arg)
                (map-vector arg f)]
               [else (f arg)])]))))

(define-syntax define-point/vector-versions-1
  (syntax-rules ()
    [(_ new old)
     (define-point/vector-version-1 new old)]
    [(_ new old more ...)
     (begin
       (define-point/vector-version-1 new old)
       (define-point/vector-versions-1 more ...))]))


;;;; And now... The definitions
(define-point/vector-version-2* +* +)
(define-point/vector-version-2* -* -)
(define-point/vector-version-2* ** *)
(define-point/vector-version-2* /* /)

(define-curried-version +** +*)
(define-curried-version -** -*)
(define-curried-version *** **)
(define-curried-version /** /*)


;(define-point/vector-versions-1
;  sin s:sin
;  cos s:cos
;  tan s:tan
;  sec s:sec
;  csc s:csc
;  cot s:cot
;
;  sinh  s:sinh
;  cosh  s:cosh
;  tanh  s:tanh
;  asinh s:asinh
;  acosh s:acosh
;  atanh s:atanh
;  )