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

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

;; -----------------------------------------------------------------------------
;; 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)
       (fnl   (list (+ x bx) (+ y by) (+ z bz))))
    (ecs-set-component 'camera 'position fnl)))

(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)
       (fnl   (list (+ x bx) (+ y by) (+ z bz))))
    (ecs-set-component 'camera 'position fnl)))

(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)
       (fnl   (list (+ x bx) (+ y by) (+ z bz))))
    (ecs-set-component 'camera 'position fnl)))

(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) '(80 30)))
    (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 (list 0 0 0))
  (let ((d 1))
    (ecs-set-component 'x-orb 'position (list d 0 0))
    (ecs-set-component 'y-orb 'position (list 0 d 0))
    (ecs-set-component 'z-orb 'position (list 0 0 d)))
  ;; camera
  (ecs-add-entity 'camera '((position . nil) (direction . nil) (up-vector . nil)))
  (ecs-set-component 'camera 'up-vector (normalize (list 0 1 0)))
  (ecs-set-component 'camera 'position  (list (** 2 8) (- (** 2 9)) (** 2 10)))
  (ecs-solar-camera-look-at-sun))

(defun ecs-solar-camera-look-at (x y z)
  (pcase-let ((`(,cx ,cy ,cz) (ecs-get-component 'camera 'position)))
    (ecs-set-component 'camera 'direction (normalize (list (- 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))
    (list (- (* 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))))

(defun ecs-solar-render ()
  (cl-loop
   with gw    = (ecs-grid-width)
   with gh    = (ecs-grid-height)
   with rat   = (** (// 16 9) 2) ; char on SDL screen; magic number place 1
   with cpos  = (ecs-get-component 'camera 'position) with (cx cy cz) = cpos
   with cdir  = (normalize (ecs-get-component 'camera 'direction))
   with cupv1 = (normalize (ecs-get-component 'camera 'up-vector))
   with lefth = t
   with criv  = (normalize (if lefth (cross-product cupv1 cdir) (cross-product cdir cupv1)))
   with cupv  =            (if lefth (cross-product cdir  criv) (cross-product criv cdir))
   ;; planets
   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 cdir) do
     (cl-loop
       with (zx zy zz) = (list 32 8 (// 1 4)) ; why needed? magic number place 2
       with rel-sun    = (list (-   cx) (-   cy) (-   cz))
       with rel        = (list (- x cx) (- y cy) (- z cz))
       with depth-sun  = (* zz (dot-product rel-sun cdir))
       with depth      = (* zz (dot-product rel     cdir))
       with behind-sun = (< depth depth-sun)
       with gx         = (+ (* 0.5 gw)                (* zx    (dot-product rel criv)))
       with gy         = (- (* 0.5 gh) (* (if behind-sun 4 zy) (dot-product rel cupv)))
       with gr         = (max 1 (// rad (if (z depth) 1 depth)))
       with gr2        = (** gr 2)
       with ded-chr    = (ecs-get-component id 'char)
       with chr        = (or ded-chr (if behind-sun ?x ?M))
       with row-beg    = (round (max  0 (- gy gr)))
       with row-end    = (round (min gh (+ gy gr)))
       for row from row-beg to row-end
       for dy     = (- row gy)
       for dy2    = (** dy 2)
       for dy2r   = (* dy2 rat)
       for inside = (- gr2 dy2r)
       for dx = (& (n inside) (<= 0 inside) (round (sqrt inside))) when dx do
         (cl-loop
          with col-beg = (round (max 0  (- gx dx)))
          with col-end = (round (min gw (+ gx dx)))
          for col from col-beg to col-end do (ecs-grid-set row col chr)))))

;; -----------------------------------------------------------------------------
;; 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)
          ;; apply inclination
          (x2 x1)
          (y2 (- (* (cos i) y1) (* (sin i) z1)))
          (z2 (+ (* (sin i) y1) (* (cos i) z1)))
          ;; apply longitude of ascending node
          (x3 (- (* (cos O) x2) (* (sin O) y2)))
          (y3 (+ (* (sin O) x2) (* (cos O) y2)))
          (z3 z2)
          ;; done
          (wpos (list x3 y3 z3)))
     (ecs-set-component id 'position wpos))))

(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 '((radius . 6051) (semi-major-axis . 108)))

  ;; 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 2
;; -----------------------------------------------------------------------------

(defun ecs-solar-render-2 ()
  (cl-loop
   ;; grid size in chars
   with (gw gh) = (list (ecs-grid-width) (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))
   ;; projection constants (tune these)
   with (sx sy)   = '(24.0 16.0) ; chars per world unit on the view plane
   with f         = 3.33         ; focal-ish scalar controlling perspective size falloff
   with ax        = 0.5          ; aspect fix because char cells are wider than tall
   with depth-eps = 0.5
   ;; center of screen
   with cxp = (* 0.5 gw)
   with cyp = (* 0.5 gh)
   ;; sun reference
   with rel-sun = (list (- 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   (list (- 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))
          ;; screen center for this entity
          (gx (+ cxp (* sx rx)))
          (gy (- cyp (* sy ry)))
          ;; screen radius with perspective
          (gr (max 1 (/ (* f rad) depth)))
          (gr2 (* gr gr))
          ;; behind-sun flag
          (behind-sun (< rz depth-sun))
          (ded-chr (ecs-get-component id 'char))
          (chr (or ded-chr (if behind-sun ?x ?M))) )
     ;; vertical span (clip to grid)
     (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 in the metric
                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)