;;; bad-solar --- space is bigger than .emacs -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:

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

(-> 'bad-ecs)
(-> 'bad-grid)

;; +----------------+
;; | dynamic module |
;; +----------------+

(let ((dm (@f "bad-sdl%s" module-file-suffix)))
  (load dm nil t)
  (declare-function sdl_draw_circle      dm)
  (declare-function sdl_draw_clear       dm)
  (declare-function sdl_draw_frame       dm)
  (declare-function sdl_draw_grid_init   dm)
  (declare-function sdl_draw_grid_toggle dm)
  (declare-function sdl_draw_init        dm)
  (declare-function sdl_draw_quit        dm))

;; +-------+
;; | solar |
;; +-------+

(defvar ecs-circles nil)

(cl-defmethod ecs-kepler-e4 ((M float) (e float))
  (let ((Mm (- (m (+ M float-pi) (* 2 float-pi)) float-pi)))
    (+ Mm
       (*           e    (sin      Mm))
       (* 0.5   (** e 2) (sin (* 2 Mm)))
       (* 0.375 (** e 3) (sin (* 3 Mm)))
       (* 0.333 (** e 4) (sin (* 4 Mm))))))

(defun ecs-solar-update ()
  (cl-loop
   for id in ecs-entities
   for a = (ecs-get-component id 'semi-major-axis)
   for e = (ecs-get-component id 'eccentricity)
   for i = (ecs-get-component id 'inclination)
   for O = (ecs-get-component id 'node-longitude)
   for P = (ecs-get-component id 'orbital-period)
   for w = (ecs-get-component id 'periapsis)
   when (& a e i O P w) do
   (let* ((M     (// (* (float-time) 64) P))
          (theta (ecs-kepler-e4 M e))    (sin-t (sin theta)) (cos-t (cos theta))
          (w-rad (degrees-to-radians w)) (sin-w (sin w-rad)) (cos-w (cos w-rad))
          (i-rad (degrees-to-radians i)) (sin-i (sin i-rad)) (cos-i (cos i-rad))
          (O-rad (degrees-to-radians O)) (sin-O (sin O-rad)) (cos-O (cos O-rad))
          (er    (// (* a (- 1 (** e 2))) (1+ (* e cos-t))))
          (x-orb (* cos-t er))
          (y-orb (* sin-t er))
          ;; rotation
          (x1 (- (* cos-w x-orb) (* sin-w y-orb)))
          (y1 (+ (* sin-w x-orb) (* cos-w y-orb)))
          ;; inclination
          (y2 (* cos-i y1))
          (z2 (* sin-i y1))
          ;; ascending node longitude
          (x3 (- (* cos-O x1) (* sin-O y2)))
          (y3 (+ (* sin-O x1) (* cos-O y2))))
     (ecs-set-component-vector id 'position x3 y3 z2))))

(defun bad-solar-init ()
  (ecs-init t t)
  (ecs-interface-init 96)
  (ecs-grid-init)
  (ecs-add-entity 'mercury '(( periapsis       .   29.124               )
                             ( eccentricity    .    0.206               )
                             ( inclination     .    7.005               )
                             ( node-longitude  .   48.331               )
                             ( orbital-period  .   87.969               )
                             ( radius          . 2439.700               )
                             ( semi-major-axis .    0.387               )
                             ( color           .  [ 0.531 0.562 0.594 ] )
                             ( position        .  [ 0.000 0.000 0.000 ] )))

  (ecs-add-entity 'venus   '(( periapsis       .    54.884                  )
                            (  eccentricity    .     0.007                  )
                            (  inclination     .     3.395                  )
                            (  node-longitude  .    76.680                  )
                            (  orbital-period  .   224.701                  )
                            (  radius          .  6051.800                  )
                            (  semi-major-axis .     0.723                  )
                            (  color           .   [ 0.931 0.762 0.494 ]    )
                            (  position        .   [ 0.000 0.000 0.000 ]  )))

  (ecs-add-entity 'earth   '(( periapsis       .   102.947                  )
                            (  eccentricity    .     0.017                  )
                            (  inclination     .     0.00005                )
                            (  node-longitude  .   348.739                  )
                            (  orbital-period  .   365.256                  )
                            (  radius          .  6371.124                  )
                            (  semi-major-axis .     1.124                  )
                            (  color           .   [ 0.231 0.462 0.894 ]    )
                            (  position        .   [ 0.000 0.000 0.000 ]  )))

  ;; Mars
  (ecs-add-entity 'mars    '(( periapsis       .   286.502                  )
                            (  eccentricity    .     0.093                  )
                            (  inclination     .     1.850                  )
                            (  node-longitude  .    49.558                  )
                            (  orbital-period  .   686.984                  )
                            (  radius          .  3389.524                  )
                            (  semi-major-axis .     1.523                  )
                            (  color           .   [ 0.831 0.362 0.294 ]    )
                            (  position        .   [ 0.000 0.000 0.000 ]  )))

  (ecs-add-entity 'jupiter '(( periapsis       .   273.867                  )
                            (  eccentricity    .     0.049                  )
                            (  inclination     .     1.305                  )
                            (  node-longitude  .   100.464                  )
                            (  orbital-period  .  4332.590                  )
                            (  radius          . 69911.124                  )
                            (  semi-major-axis .     5.204                  )
                            (  color           .   [ 0.831 0.662 0.494 ]    )
                            (  position        .   [ 0.000 0.000 0.000 ] ))))
;; +--------+
;; | render |
;; +--------+

(defun ecs-solar-render ()
  (cl-loop
   with p    = (ecs-camera-position)
   with u    = (ecs-camera-up)
   with r    = (ecs-camera-right)
   with f    = (ecs-camera-forward)
   with ch   = (+ 2 34) ; NOTE: OK
   with cw   = (+ 0 17) ; NOTE: OK
   with chgh = (*   ch ecs-grid-h)
   with cwgw = (*   cw ecs-grid-w)
   with cxp  = (*  0.5 ecs-grid-w)
   with cyp  = (*  0.5 ecs-grid-h)
   with chb  = (*  2   (// cwgw chgh))
   with cwb  = (* 96   (// chgh cwgw))
   for id in (sort ecs-entities :key #'ecs-camera-distance :lessp #'< :in-place t)
   for pos = (ecs-position id)
   for rad = (ecs-get-component id 'radius)
   when (& id pos rad) do
   (cl-loop
    with rel        = (v-v     pos p)
    with rx         = (ecs-dot rel r)
    with ry         = (ecs-dot rel u)
    with rz         = (ecs-dot rel f)
    with gx         = (+ cxp (* cwb rx))
    with gy         = (- cyp (* chb ry))
    with gr         = (max 1 (* 0.6 (// rad rz)))
    with gr2        = (** gr 2)
    with sun-rel    = (k*v -1 p)
    with sun-z      = (ecs-dot sun-rel f)
    with sun-behind = (< sun-z rz)
    with ded        = (ecs-get-component id 'char)
    with chr        = (or ded (if sun-behind 120 77))
    with row-beg    = (max 0          (r (- gy gr)))
    with row-end    = (min ecs-grid-h (r (+ gy gr)))
    for row from row-beg below row-end
    for dy2 = (* 4 (** (- row gy) 2))
    for inv = (- gr2 dy2) when (< 0 inv) do
    (cl-loop
     with rad = (sqrt inv)
     with beg = (max 0          (r (- gx rad)))
     with end = (min ecs-grid-w (r (+ gx rad)))
     with cx  = (* 1.0 gx cw)
     with cy  = (* 1.0 gy ch)
     with cr  = (* 1.0 gr cw)
     with clr = (ecs-get-component id 'color)
     initially (& clr (pcase-let ((`[             ,r ,g ,b ] clr          ))
                      (push        `[ ,cx ,cy ,cr ,r ,g ,b ] ecs-circles )))
     for col from beg below end
     do (ecs-grid-set row col chr)))))

(defun bad-solar ()
  (ecs-init)
  (bad-solar-init)
  (sdl_draw_init)
  (ecs-interface-init)
  (cl-loop
   with run      = t
   with circles  = t
   with hz       = (bad-hz)
   with fps      = 60
   with delta    = (// hz fps)
   with frames   = 8092
   with beg      = (bad-ticks)
   ;; look
   with origo     = [ 0.0 0.0 0.0 ]
   with look-pos  = origo
   with look-lbl  = "[camera] "
   with origo-lbl = (concat look-lbl "origo")
   ;; done
   for fr from 0 below frames
   for next = (+ beg (* fr delta))
   while run do
   (setf ecs-circles nil)
   (ecs-grid-clear)
   (sdl_draw_clear)
   (when-let* ((evnt (& (input-pending-p) (read-event))))
     (pcase evnt
       ;; quit
       ((or 13 81 113) (setf run nil))
       ;; modes
       (?a (setf circles (! circles)))
       (?p (sdl_draw_grid_toggle))
       ;; look-at planets
       (?v         (progn (setf look-pos (& (! (equal look-pos origo)) origo)) ($ (if look-pos origo-lbl "free camera"))))
       ((or ?0 ?`) (progn (setf look-pos origo)                                ($ origo-lbl)))
       ((or ?1 ?m) (progn (setf look-pos (ecs-position 'mercury))              ($ (concat look-lbl "Mercury"))))
       ((or ?2 ?v) (progn (setf look-pos (ecs-position 'venus))                ($ (concat look-lbl "Venus"))))
       ((or ?3 ?e) (progn (setf look-pos (ecs-position 'earth))                ($ (concat look-lbl "Earth"))))
       ((or ?4 ?M) (progn (setf look-pos (ecs-position 'mars))                 ($ (concat look-lbl "Mars"))))
       ((or ?5 ?J) (progn (setf look-pos (ecs-position 'jupiter))              ($ (concat look-lbl "Jupiter"))))
       (_ (ecs-camera-input evnt))))
   (& look-pos (ecs-camera-look-at look-pos))
   (ecs-solar-update)
   (ecs-solar-render)
   (when circles
     (pcase-dolist (`[ ,x ,y ,rad ,r ,g ,b ] ecs-circles)
       (sdl_draw_circle x y rad r g b)))
   (sdl_draw_frame)
   (sleep-for (// (- next (bad-ticks)) hz))
   finally (sdl_draw_quit)))

(defun ecs-position (entity)
  (ecs-get-component entity 'position))

(<- 'bad-solar)
;;; bad-solar.el ends here