#lang scheme

;; By Antonio Leitao and me

;(require "autolisp.ss")
(require "point.ss"
         "vector.ss")
(provide
 ensure-3d
 signum
 sec
 csc
 cot
 sinh
 cosh
 tanh
 asinh
 acosh
 atanh
 2*pi
 pi/2
 3*pi
 pi/3
 4*pi
 pi/4
 -pi
 -2*pi
 -pi/2
 -3*pi
 -pi/3
 -4*pi
 -pi/4
 3*pi/2
 -3*pi/2
 radianos<-graus
 graus<-radianos
 radians<-degrees
 degress<-radians
 raio&angulo
 identidade
 id
 xy
 cx
 cy
 +x
 +y
 pol
 ;;;; TODO: Remove Portuguese words
 pol-ro
 pol-rho
 pol-fi
 pol-phi
 +pol
 vpol
 vpol-ro
 vpol-rho
 vpol-fi
 vpol-phi
 v+pol
 xyz
 cz
 +xyz
 +z
 xy?
 xyz?
 +xy
 ;;;; TODO: Remove this!
; +c
; -c
; *c
; =c
 cil
 ;;;; TODO: Remove Portuguese words
 cil-ro
 cil-rho
 cil-fi
 cil-phi
 cil-z
 +cil
 ;;;; TODO: Remove Portuguese words
 esf
 esf-ro
 esf-fi
 esf-psi
 +esf
 ;; ^^ Remove that!
 sph
 sph-rho
 sph-phi
 sph-psi
 +sph
 ;;;; TODO: Remove Portuguese words
 distancia
 distance
 longitude
 colatitude)

(define (ensure-3d o)
  (cond [(point-3d? o) o]
        [(point-2d? o) (xyz (cx o) (cy o) 0)]
        [(vector-3d? o) o]
        [(vector-2d? o) (vxyz (vx o) (vy o) 0)]
        [else (error "Can't ensure 3d: " o)]))

(define-syntax defun
  (syntax-rules ()
    [(_ name args stmt ...)
     (define (name . args)
       stmt ...)]))

(defun signum (x)
  (cond ((> x 0) 1)
	((< x 0) -1)
	(else 0)))

(defun sec (x)
  (/ 1.0 (cos x)))

(defun csc (x)
  (/ 1.0 (sin x)))

(defun cot (x)
  (/ 1.0 (tan x)))

;;Trigonometria hiperbolica

(defun sinh (x)
  (/ (- (exp x) (exp (- x)))
     2))

(defun cosh (x)
  (/ (+ (exp x) (exp (- x)))
     2))

(defun tanh (x)
  (/ (- (exp x) (exp (- x)))
     (+ (exp x) (exp (- x)))))

;;Trigonometria hiperbolica inversa

(defun asinh (x)
  (log (+ x (sqrt (+ (* x x) 1)))))

(defun acosh (x)
  (log (+ x (sqrt (- (* x x) 1)))))

(defun atanh (x)
  (if (< (abs x) 1)
    (/ (log (/ (+ 1 x) (- 1 x))) 2)
    (/ (log (/ (+ x 1) (- x 1))) 2)))

;;Constantes

(define 2*pi (* 2 pi))

(define pi/2 (/ pi 2))

(define 3*pi (* 3 pi))

(define pi/3 (/ pi 3))

(define 4*pi (* 4 pi))

(define pi/4 (/ pi 4))

(define -pi (- pi))

(define -2*pi (- 2*pi))

(define -pi/2 (- pi/2))

(define -3*pi (- 3*pi))

(define -pi/3 (- pi/3))

(define -4*pi (- 4*pi))

(define -pi/4 (- pi/4))

(define 3*pi/2 (/ 3*pi 2))

(define -3*pi/2 (/ -3*pi 2))

;; TODO: Remove Portuguese words
(defun radianos<-graus (graus)
  (* pi (/ graus 180.0)))

(defun graus<-radianos (radianos)
  (* 180.0 (/ radianos pi)))

(defun radians<-degrees (deg)
  (radianos<-graus deg))

(defun degress<-radians (rad)
  (graus<-radianos rad))

;; TODO: Remove?
(define (rtos n)
  (number->string (exact->inexact n)))
(defun raio&angulo (raio angulo)
  (string-append "@" (rtos raio) "<" (rtos (graus<-radianos angulo))))

;; TODO: Remove Portuguese words
(defun identidade (x) x)
(defun id (x) x)

(defun pol (ro fi)
  (xy (* ro (cos fi))
      (* ro (sin fi))))

;; TODO: Remove Portuguese words
(defun pol-ro (c)
  (sqrt (+ (expt (cx c) 2) (expt (cy c) 2))))
(defun pol-rho (c)
  (sqrt (+ (expt (cx c) 2) (expt (cy c) 2))))

;; TODO: Remove Portuguese words
(defun pol-fi (c)
  (atan (cy c) (cx c)))
(defun pol-phi (c)
  (atan (cy c) (cx c)))

(defun +pol (p ro fi)
  (+xy p
       (* ro (cos fi))
       (* ro (sin fi))))

;; Polar Vectors
(defun vpol (ro fi)
  (vxy (* ro (cos fi))
       (* ro (sin fi))))

;; TODO: Remove Portuguese words
(defun vpol-ro (c)
  (sqrt (+ (expt (vx c) 2) (expt (vy c) 2))))
(defun vpol-rho (c)
  (sqrt (+ (expt (vx c) 2) (expt (vy c) 2))))

;; TODO: Remove Portuguese words
(defun vpol-fi (c)
  (atan (vy c) (vx c)))
(defun vpol-phi (c)
  (atan (vy c) (vx c)))

(defun v+pol (v rho phi)
  (vpol (+ (vpol-rho v) rho)
        (+ (vpol-phi v) phi)))

;;;;;;;;;;;;;;;;;;;;;;;;;;
;;3D

;;;; Summing 2 points is a big no-no!
;; (defun +c (p0 p1)
;;   (if (and (xyz? p0) (xyz? p1))
;;     (xyz (+ (cx p0) (cx p1))
;; 	 (+ (cy p0) (cy p1))
;; 	 (+ (cz p0) (cz p1)))
;;     (xy (+ (cx p0) (cx p1))
;; 	(+ (cy p0) (cy p1)))))

;; (defun -c (p0 p1)
;;   (if (and (xyz? p0) (xyz? p1))
;;     (xyz (- (cx p0) (cx p1))
;; 	 (- (cy p0) (cy p1))
;; 	 (- (cz p0) (cz p1)))
;;     (xy (- (cx p0) (cx p1))
;; 	(- (cy p0) (cy p1)))))

;; (defun *c (p r)
;;   (if (xyz? p)
;;       (xyz (* (cx p) r)
;;            (* (cy p) r)
;;            (* (cz p) r))
;;       (xy (* (cx p) r)
;;           (* (cy p) r))))

;; (defun =c (c0 c1)
;;   (and (= (cx c0) (cx c1))
;;        (= (cy c0) (cy c1))
;;        (= (cz c0) (cz c1))))

;;Coordenadas cilindricas
(defun cil (ro fi z)
  (xyz (* ro (cos fi)) (* ro (sin fi)) z))

;; TODO: Remove Portuguese words
(defun cil-ro (c)
  (sqrt (+ (expt (cx c) 2) (expt (cy c) 2))))
(defun cil-rho (c)
  (sqrt (+ (expt (cx c) 2) (expt (cy c) 2))))

;; TODO: Remove Portuguese words
(defun cil-fi (c)
  (atan (cy c) (cx c)))
(defun cil-phi (c)
  (atan (cy c) (cx c)))

(defun cil-z (c)
  (cz c))

(defun +cil (c ro fi z)
  (let ([p (cil ro fi z)])
    (+xyz c (cx p) (cy p) (cz p))))

;;Coordenadas esfericas
;;;;;;;;;;;;;; TODO: Remove Portuguese words
(defun esf (ro fi psi)
  (xyz (* ro (sin psi) (cos fi))
       (* ro (sin psi) (sin fi))
       (* ro (cos psi))))

(defun esf-ro (c)
  (sqrt (+ (expt (cx c) 2)
	   (expt (cy c) 2)
	   (expt (cz c) 2))))

(defun esf-fi (c)
  (atan (cy c) (cx c)))

(defun esf-psi (c)
  (atan (sqrt (+ (expt (cx c) 2)
		 (expt (cy c) 2)))
	(cz c)))

(defun +esf (c ro fi psi)
  (let ([p (sph ro fi psi)])
    (+xyz c (cx p) (cy p) (cz p))))
;;;;;;;;;;;;;; ^^ Remove this
(defun sph (ro fi psi)
  (xyz (* ro (sin psi) (cos fi))
       (* ro (sin psi) (sin fi))
       (* ro (cos psi))))

(defun sph-rho (c)
  (sqrt (+ (expt (cx c) 2)
	   (expt (cy c) 2)
	   (expt (cz c) 2))))

(defun sph-phi (c)
  (atan (cy c) (cx c)))

(defun sph-psi (c)
  (atan (sqrt (+ (expt (cx c) 2)
		 (expt (cy c) 2)))
	(cz c)))

(defun +sph (c ro fi psi)
  (let ([p (sph ro fi psi)])
    (+xyz c (cx p) (cy p) (cz p))))
;;;;;;;;;;;;;;;;

;;;; TODO: Remove Portuguese words
(defun distancia (p0 p1)
  (vlength (p->q p1 p0)))
(defun distance (p0 p1)
  (vlength (p->q p1 p0)))

(defun longitude (p0 p1)
  (let ([v (p->q p0 p1)])
    (sph-phi (xyz (vx v) (vy v) (vz v)))))

(defun colatitude (p0 p1)
  (let ([v (p->q p0 p1)])
    (sph-psi (xyz (vx v) (vy v) (vz v)))))