;;; -*- lexical-binding: t -*-

(require 'cl-lib)
(cl-pushnew "." load-path :test #'string=)
(require 'luki-lisp)

;; -----------------------------------------------------------------------------
;; faster list
;; -----------------------------------------------------------------------------

(cl-defstruct (vec3 (:constructor make-vec3 (x y z))) x y z)

(defun vec3-set (v x y z)
  (setf (vec3-x v) x
        (vec3-y v) y
        (vec3-z v) z)
  v)

;; -----------------------------------------------------------------------------
;; ecs
;; -----------------------------------------------------------------------------

(defvar ecs-entities   nil)
(defvar ecs-components nil)

;; -----------------------------------------------------------------------------
;; move camera
;; -----------------------------------------------------------------------------

(defun ecs-solar-camera-move-right (&optional left step)
  (or step (setf step 32))
  (pcase-let*
      ((pos            (ecs-get-component 'camera 'position))
       (`[,x ,y ,z]    pos)
       (dir            (ecs-get-component 'camera 'direction))
       (up             (ecs-get-component 'camera 'up-vector))
       (rightv         (normalize (cross-product up dir)))
       (boost          (mapcar (L (c) (+ c (* (if left -1 1) step))) rightv))
       (`[,bx ,by ,bz] boost))
    (vec3-set pos (+ x bx) (+ y by) (+ z bz))))

(defun ecs-solar-camera-move-up (&optional down step)
  (or step (setf step 16))
  (pcase-let*
      ((pos            (ecs-get-component 'camera 'position))
       (`[,x ,y ,z]    pos)
       (up             (ecs-get-component 'camera 'up-vector))
       (boost          (mapcar (L (c) (+ c (* (if down -1 1) step))) up))
       (`[,bx ,by ,bz] boost))
       (vec3-set pos (+ x bx) (+ y by) (+ z bz))))

(defun ecs-solar-camera-move-forward (&optional backward step)
  (or step (setf step 16))
  (pcase-let*
      ((pos            (ecs-get-component 'camera 'position))
       (`[,x ,y ,z]    pos)
       (dir            (ecs-get-component 'camera 'direction))
       (boost          (mapcar (L (c) (+ c (* (if backward -1 1) step))) dir))
       (`[,bx ,by ,bz] boost))
    (vec3-set pos (+ x bx) (+ y by) (+ z bz))))

(defun ecs-solar-camera-move-left     (&optional step) (ecs-solar-camera-move-right   t step))
(defun ecs-solar-camera-move-down     (&optional step) (ecs-solar-camera-move-up      t step))
(defun ecs-solar-camera-move-backward (&optional step) (ecs-solar-camera-move-forward t step))

;; -----------------------------------------------------------------------------
;; grid
;; -----------------------------------------------------------------------------

(defvar ecs-grid nil)

(defun ecs-grid-init ()
  (setf ecs-components (make-hash-table :size 128))
  (pcase-let* ((`(,w ,h) '(116 34)))
    (setf ecs-grid (make-vector h nil))
    (cl-loop
     for i across-ref ecs-grid do
     (setf i (make-string w 46)))))

(defun ecs-grid-clear (&optional chr)
  (unless (characterp chr) (setf chr 46))
  (cl-loop for l across-ref ecs-grid do
    (cl-loop for c being the elements of-ref l using (index i) do
      (aset l i chr))))

(defun ecs-grid-height () (--- ecs-grid))
(defun ecs-grid-width  () (--- (aref ecs-grid 0)))

(cl-defmethod ecs-grid-set ((row integer) (col integer) (val integer))
  (& (<= 0 row (1- (ecs-grid-height)))
     (<= 0 col (1- (ecs-grid-width)))
     (aset (aref ecs-grid row) col val)))

;; -----------------------------------------------------------------------------
;; entities
;; -----------------------------------------------------------------------------

(cl-defmethod ecs-add-entity ((id symbol) (cmps list))
  (push id ecs-entities)
  (puthash id cmps ecs-components))

;; -----------------------------------------------------------------------------
;; components
;; -----------------------------------------------------------------------------

(cl-defmethod ecs-get-component ((id symbol) (cmp symbol))
  (alist-get cmp (gethash id ecs-components)))

(cl-defmethod ecs-set-component ((id symbol) (cmp symbol) val)
  (setf (alist-get cmp (gethash id ecs-components)) val))

;; -----------------------------------------------------------------------------
;; camera
;; -----------------------------------------------------------------------------

(defun ecs-solar-camera-init ()
  (ecs-add-entity 'o-orb '((char . ?+) (position . nil) (radius . 3)))
  (ecs-add-entity 'x-orb '((char . ?x) (position . nil) (radius . 0.01)))
  (ecs-add-entity 'y-orb '((char . ?y) (position . nil) (radius . 0.01)))
  (ecs-add-entity 'z-orb '((char . ?z) (position . nil) (radius . 0.01)))
  (ecs-set-component 'o-orb 'position (make-vec3 0 0 0))
  (let ((d 1))
    (ecs-set-component 'x-orb 'position (make-vec3 d 0 0))
    (ecs-set-component 'y-orb 'position (make-vec3 0 d 0))
    (ecs-set-component 'z-orb 'position (make-vec3 0 0 d)))
  ;; camera
  (ecs-add-entity 'camera (backquote (,(backquote (position  . ,(make-vec3 0 0 0)))
                                      ,(backquote (direction . ,(make-vec3 0 0 0)))
                                      ,(backquote (up-vector . ,(make-vec3 0 1 0)))
                                      )))
  (let ((pos (ecs-set-component 'camera 'position)))
    (setf (vec3-x pos)    (** 2  8)
          (vec3-y pos) (- (** 2  9))
          (vec3-z pos)    (** 2 10)))
    (ecs-solar-camera-look-at-sun))

(defun ecs-solar-camera-look-at (x y z)
  (pcase-let* ((pos            (ecs-get-component 'camera 'position))
               (`[,cx ,cy ,cz] pos)
               (dir            (ecs-get-component 'camera 'direction)))
    (normalize (vec3-set dir (- x cx) (- y cy) (- z cz)))))

(defun ecs-solar-camera-look-at-sun ()
  (ecs-solar-camera-look-at 0 0 0))

;; -----------------------------------------------------------------------------
;; solar render, to grid vector
;; -----------------------------------------------------------------------------

(defun dot-product (a b)
  (pcase-let* ((`[,ax ,ay ,az] a)
               (`[,bx ,by ,bz] b))
    (+ (* ax bx)
       (* ay by)
       (* az bz))))

(defun cross-product (a b)
  (pcase-let* ((`[,a1 ,a2 ,a3] a)
               (`[,b1 ,b2 ,b3] b))
    (make-vec3 (- (* a2 b3) (* a3 b2))
               (- (* a3 b1) (* a1 b3))
               (- (* a1 b2) (* a2 b1)))))

(defun normalize (d)
  (pcase-let* ((`[,dx ,dy ,dz] d)
               (len (sqrt (+ (** dx 2) (** dy 2) (** dz 2)))))
    (if (z len) d (mapcar (L (e) (/ e len)) d))))

;; -----------------------------------------------------------------------------
;; solar model
;; -----------------------------------------------------------------------------

(defun ecs-solar-update-and-render ()
  (ecs-grid-clear)
  (ecs-solar-uptick)
  (ecs-solar-update)
  (ecs-solar-camera-look-at-sun)
  (ecs-solar-render))

(defun ecs-solar-update ()
  (cl-loop
   with time = (ecs-get-component 'model 'time)
   for id in ecs-entities
   for a = (ecs-get-component id 'semi-major-axis-au)
   for e = (ecs-get-component id 'eccentricity)
   for P = (ecs-get-component id 'orbital-period)
   for i = (ecs-get-component id 'inclination)
   for O = (ecs-get-component id 'longitude-of-node)
   for w = (ecs-get-component id 'argument-of-periapsis)
   when (& id a e P i O w) do
   (setf i (degrees-to-radians i))
   (setf O (degrees-to-radians O))
   (setf w (degrees-to-radians w))
   (let* ((M (* 2 float-pi (/ time P))) ; mean anomaly
          (theta M) ; for simplicity set theta to M
          (er    (// (* a (- 1 (** e 2))) (+ 1 (* e (cos theta)))))
          (x-orb (* er (cos theta)))
          (y-orb (* er (sin theta)))
          (z-orb 0)
          ;; rotate into 3D space
          (x1 (- (* (cos w) x-orb) (* (sin w) y-orb)))
          (y1 (+ (* (sin w) x-orb) (* (cos w) y-orb)))
          (z1 z-orb)
          ;; inclination
          (x2 x1)
          (y2 (- (* (cos i) y1) (* (sin i) z1)))
          (z2 (+ (* (sin i) y1) (* (cos i) z1)))
          ;; longitude of ascending node
          (x3 (- (* (cos O) x2) (* (sin O) y2)))
          (y3 (+ (* (sin O) x2) (* (cos O) y2)))
          (z3 z2))
          ;; done
     (vec3-set (ecs-get-component id 'position) x3 y3 z3))))

(defun ecs-solar-uptick ()
  (when-let* ((beg (ecs-get-component 'model 'begin))
              (tck (ecs-get-component 'model 'ticks))
              (tme (ecs-get-component 'model 'time))
              (ff  (ecs-get-component 'model 'fast-forward)))
    (ecs-set-component 'model 'ticks (++ tck))
    (ecs-set-component 'model 'time  (+ beg (* tck ff)))))

(defun ecs-init ()
  (setf ecs-entities   nil)
  (setf ecs-components nil)
  (ecs-grid-init))

(defun ecs-solar-init ()
  (ecs-init)
  (ecs-solar-camera-init)
  (ecs-add-entity 'model (list
                          '(ticks        . 0)
                          `(begin        . ,(round (float-time)))
                          '(time         . 0)
                          '(fast-forward . 0.67)))

  ;; Mercury
  (ecs-add-entity 'mercury '(
                            (argument-of-periapsis . 29.124)
                            (eccentricity          . 0.2056)
                            (inclination           . 7.005)
                            (longitude-of-node     . 48.331)
                            (orbital-period        . 87.969)
                            (position              . nil)
                            (radius                . 2439.7)
                            (semi-major-axis-au    . 0.387)
                            ))

  (ecs-add-entity 'mercury-1 '((radius .   18)))
  (ecs-add-entity 'mercury-2 '((radius .    8)))

  ;; Venus
  (ecs-add-entity 'venus '( (argument-of-periapsis . 54.884)
                            (eccentricity          . 0.00678)
                            (inclination           . 3.3947)
                            (longitude-of-node     . 76.68)
                            (orbital-period        . 224.701)
                            (radius                . 6051.8)
                            (semi-major-axis-au    . 0.723336)
                            (position              . nil) ))
  ;; Earth
  (ecs-add-entity 'earth '( (argument-of-periapsis . 102.94719)
                            (eccentricity          . 0.0167)
                            (inclination           . 0.00005)
                            (longitude-of-node     . 348.73936)
                            (orbital-period        . 365.256)
                            (position              . nil)
                            (radius                . 6371)
                            (semi-major-axis-au    . 1.0) ))
  (ecs-add-entity 'moon  '((radius . 1737)))

  ;; Mars
  (ecs-add-entity 'mars   '(
                            (argument-of-periapsis . 286.502)
                            (eccentricity          . 0.0934)
                            (inclination           . 1.85)
                            (longitude-of-node     . 49.558)
                            (orbital-period        . 686.98)
                            (position              . nil)
                            (radius                . 3389.5)
                            (semi-major-axis-au    . 1.523)
                            ))

  (ecs-add-entity 'phobos '((radius .   11)))
  (ecs-add-entity 'deimos '((radius .    6)))

  ;; Jupiter (incomplete)
  (ecs-add-entity 'jupiter  '((radius . 69911) (semi-major-axis . 778)))
  (ecs-add-entity 'callisto '((radius .  4877)))
  (ecs-add-entity 'ganymede '((radius .  3228)))
  (ecs-add-entity 'europa   '((radius .  3112)))

  ;; Saturn (incomplete)
  (ecs-add-entity 'saturn '((radius . 58232) (semi-major-axis . 1427)))

  ;; Uranus (incomplete)
  (ecs-add-entity 'uranus '((eccentricity    . 0.047)
                            (orbital-period  . 30687.15)
                            (radius          . 25362)
                            (semi-major-axis . 2872)))

  ;; Neptune (incomplete; Neptune has at least 16 moons)
  (ecs-add-entity 'neptune '((radius . 24622) (semi-major-axis . 4495)))
  (ecs-add-entity 'triton  '((radius .  1354)))

  ;; Pluto (incomplete)
  (ecs-add-entity 'pluto '((radius . 1188) (semi-major-axis . 5906))))

;; -----------------------------------------------------------------------------
;; render
;; -----------------------------------------------------------------------------

(defun ecs-solar-render ()
  (cl-loop
   ;; grid size in chars
   with gw = (ecs-grid-width)
   with gh = (ecs-grid-height)
   ;; camera
   with cpos  = (ecs-get-component 'camera 'position) with (cx cy cz) = cpos
   with cdir0 = (normalize (ecs-get-component 'camera 'direction))
   with cup0  = (normalize (ecs-get-component 'camera 'up-vector))
   ;; left-handed basis
   with criv0 = (cross-product cup0 cdir0)
   with criv  = (normalize criv0)
   with cupv  = (normalize (cross-product cdir0 criv))
   ;; screen
   with screen-w      = 1280
   with screen-h      =  720
   with screen-aspect = (// screen-w screen-h)
   with kx        = (** 2 9)
   with ky        = (// kx screen-aspect)
   with sx        = (* kx (// gw 1280))
   with sy        = (* ky (// gh  720)) ; view plane chars / world unit
   with f         = 2.0            ; focal-ish perspective size falloff scalar
   with depth-eps = 1.0            ; har far you can see
   with ax        = (// 11.0 21.0) ; actual font char size here
   ;; center
   with cxp = (* 0.5 gw)
   with cyp = (* 0.5 gh)
   ;; sun
   with rel-sun = (make-vec3 (- cx) (- cy) (- cz))
   with depth-sun = (max depth-eps (dot-product rel-sun cdir0))
   ;; entities
   for id in ecs-entities
   for pos = (ecs-get-component id 'position) for (x y z) = pos
   for rad = (ecs-get-component id 'radius)
   when (& pos rad cpos criv cupv cdir0) do
   (let* ((rel   (make-vec3 (- x cx) (- y cy) (- z cz)))
          (rx    (dot-product rel criv))  ; right component
          (ry    (dot-product rel cupv))  ; up component
          (rz    (dot-product rel cdir0)) ; forward depth
          (depth (max depth-eps rz))
          ;; center
          (gx (+ cxp (* sx rx)))
          (gy (- cyp (* sy ry)))
          ;; screen radius with perspective
          (gr (max 1 (/ (* f rad) depth)))
          (gr2 (* gr gr))
          ;; behind sun
          (behind-sun (< rz depth-sun))
          (ded-chr (ecs-get-component id 'char))
          (chr (or ded-chr (if behind-sun ?x ?M))) )
     ;; vertical span
     (let* ((row-beg (truncate (max  0 (- gy gr))))
            (row-end (truncate (min gh (+ gy gr)))))
       (cl-loop for row from row-beg to row-end
                for dy = (- row gy)
                ;; aspect fix
                for dy2 = (* dy dy)
                for inv = (- gr2 (* dy2 (/ 1.0 (** ax 2)))) when (<= 0 inv) do
                (let* ((dx      (truncate (sqrt inv)))
                       (col-beg (truncate (max  0 (- gx dx))))
                       (col-end (truncate (min gw (+ gx dx)))))
                  (cl-loop for col from col-beg to col-end
                           do (ecs-grid-set row col chr))))))))

(<- 'bad-ecs)