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

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

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

(cl-defstruct (vecd (:constructor vecd-new (x y z)))
  x y z)

(defun vecd-set (dst x y z)
  (setf (vecd-x dst) x
        (vecd-y dst) y
        (vecd-z dst) z)
  dst)

(defun vecd-map (dst fun)
  (pcase-let ((`[,x ,y ,z] dst))
    (vecd-set dst (funcall fun x)
                  (funcall fun y)
                  (funcall fun z))))

(defun vecd-add (dst k)
  (pcase-let ((`[,x ,y ,z] dst))
    (vecd-set dst (+ x k)
                  (+ y k)
                  (+ z k))))

(defun vecd-add-vector (dst src-a src-b &optional k)
  (or k (setf k 1.0))
  (pcase-let* ((`[,ax ,ay ,az] src-a)
               (`[,bx ,by ,bz] src-b))
    (vecd-set dst (+ ax (* k bx))
                  (+ ay (* k by))
                  (+ az (* k bz)))))

(defun vecd-subtract-vector (dst src-a src-b &optional k)
  (vecd-set dst
            (- (vecd-x src-a) (* k (vecd-x src-b)))
            (- (vecd-y src-a) (* k (vecd-y src-b)))
            (- (vecd-z src-a) (* k (vecd-z src-b)))))

(defun vecd-normsub (dst src-a src-b)
  (vecd-subtract-vector dst src-a src-b)
  (vecd-normalize       dst))

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

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

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

(defun ecs-solar-camera-move-right (&optional step inverse)
  (or step (setf step 32))
  (&  inverse (setf step (- step)))
  (pcase-let*
      ((pos (ecs-get-component 'camera 'position))
       (dir (ecs-get-component 'camera 'direction))
       (up  (ecs-get-component 'camera 'up-vector)))
    (vecd-add-vector pos pos (vecd-normcross dir dir up) step)))

(defun ecs-solar-camera-move-up (&optional step inverse)
  (or step    (setf step 32))
  (&  inverse (setf step (- step)))
  (pcase-let*
      ((pos (ecs-get-component 'camera 'position))
       (up  (ecs-get-component 'camera 'up-vector)))
    (vecd-add-vector pos pos up step)))

(defun ecs-solar-camera-move-forward (&optional step inverse)
  (or step    (setf step 32))
  (&  inverse (setf step (- step)))
  (pcase-let*
      ((pos (ecs-get-component 'camera 'position))
       (dir (ecs-get-component 'camera 'direction)))
    (vecd-add-vector pos pos dir step)))

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

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

(defvar ecs-grid   nil)
(defvar ecs-grid-h nil)
(defvar ecs-grid-w nil)

(defun ecs-set-grid-data ()
  (setf ecs-grid-w (--- ecs-grid)
        ecs-grid-h (--- (aref ecs-grid 0))))

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

(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))))

(cl-defmethod ecs-grid-set ((row integer) (col integer) (val integer))
  (& (<= 0 row (1- ecs-grid-h))
     (<= 0 col (1- ecs-grid-w))
     (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 (list '(char . ?+) `(position . ,(vecd-new 0 0 0)) '(radius . 3)))
  (ecs-add-entity 'x-orb (list '(char . ?x) `(position . ,(vecd-new 1 0 0)) '(radius . 0.01)))
  (ecs-add-entity 'y-orb (list '(char . ?y) `(position . ,(vecd-new 0 1 0)) '(radius . 0.01)))
  (ecs-add-entity 'z-orb (list '(char . ?z) `(position . ,(vecd-new 0 0 1)) '(radius . 0.01)))
  ;; camera
  (ecs-set-component 'camera 'position  (vecd-new (** 2 8) (- (** 2 9)) (** 2 10)))
  (ecs-set-component 'camera 'direction (vecd-new 0 0 0))
  (ecs-set-component 'camera 'up-vector (vecd-new 0 1 0))
  (ecs-solar-camera-look-at-sun))

(defun ecs-solar-camera-look-at (dst)
  (let ((pos (ecs-get-component 'camera 'position))
        (dir (ecs-get-component 'camera 'direction)))
    (vecd-normsub dir dst pos)))

(defun ecs-solar-camera-look-at-sun ()
  (ecs-solar-camera-look-at (ecs-get-component 'o-orb 'position)))


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

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

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

(defun vecd-normalize (dst)
  (pcase-let* ((`[,x ,y ,z] dst)
               (len (sqrt (+ (** x 2) (** y 2) (** z 2)))))
    (if (z len)
        dst
      (vecd-set dst (/ x len) (/ y len) (/ z len)))))

(defun vecd-normcross (dst a b)
  (vecd-normalize (vecd-cross-product dst a b)))

;; -----------------------------------------------------------------------------
;; 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)
   for pos = (ecs-get-component id 'position)
   when (& id a e P i O w pos) 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))
   (vecd-set pos 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 (list '(argument-of-periapsis . 29.124)
                                 '(eccentricity          . 0.2056)
                                 '(inclination           . 7.005)
                                 '(longitude-of-node     . 48.331)
                                 '(orbital-period        . 87.969)
                                 '(radius                . 2439.7)
                                 '(semi-major-axis-au    . 0.387)
                                 `(position              . ,(vecd-new 0 0 0))))
  (ecs-add-entity 'mercury-1 '((radius .   18)))
  (ecs-add-entity 'mercury-2 '((radius .    8)))

  ;; Venus
  (ecs-add-entity 'venus (list '(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              . ,(vecd-new 0 0 0))))

  ;; Earth
  (ecs-add-entity 'earth (list '(argument-of-periapsis . 102.94719)
                               '(eccentricity          . 0.0167)
                               '(inclination           . 0.00005)
                               '(longitude-of-node     . 348.73936)
                               '(orbital-period        . 365.256)
                               '(radius                . 6371)
                               '(semi-major-axis-au    . 1.0)
                               `(position              . ,(vecd-new 0 0 0))))
  (ecs-add-entity 'moon  '((radius . 1737)))

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

  (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; 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
   with cpos      = (ecs-get-component 'camera 'position) with (cx cy cz) = cpos
   with cdir0     = (vecd-normalize (ecs-get-component 'camera 'direction))
   with cup0      = (vecd-normalize (ecs-get-component 'camera 'up-vector))
   with screen-w  = 1280
   with screen-h  =  720
   with screen-a  = (// screen-w screen-h)
   with kx        = (** 2 9)
   with ky        = (// kx screen-a)
   with sx        = (* kx (// ecs-grid-w screen-w))
   with sy        = (* ky (// ecs-grid-h screen-h)) ; view plane chars per world unit
   with f         = 2.0 ; focal perspective falloff scalar
   with depth-eps = 1.0 ; har far you can see
   with ax        = (// 11.0 21.0) ; actual font char size here
   with cxp       = (// ecs-grid-w 2)
   with cyp       = (// ecs-grid-h 2)
   with depth-sun = (max depth-eps (vecd-dot-product cdir0 (vecd-new (- cx) (- cy) (- cz))))
   for id in ecs-entities
   for pos = (ecs-get-component id 'position)
   for rad = (ecs-get-component id 'radius)
   when (& pos rad cpos cdir0)
   do (let* ((criv  (vecd-new 0 0 0))
             (_     (vecd-normcross criv cup0 cdir0))
             (rel   (vecd-new 0 0 0))
             (_     (vecd-subtract-vector rel rel cpos))
             (rx    (vecd-dot-product rel criv)) ; right component
             (ry    (vecd-new 0 0 0)) ; up
             (_     (vecd-dot-product rel (vecd-normcross ry cdir0 criv)))
             (rz    (vecd-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 ecs-grid-h (+ 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 ecs-grid-w (+ gx dx)))))
                        (cl-loop for col from col-beg to col-end
                                 do (ecs-grid-set row col chr))))))))

(<- 'bad-ecs)