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

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

;; -----------------------------------------------------------------------------

(defvar bad-grid nil)

(defun grid-init ()
  (let* ((w 212)
         (h  61))
    (setf bad-grid (make-vector h nil))
    (cl-loop
     for l across-ref bad-grid do
     (setf l (make-string w ?.)))))

(defun grid-set (row col val)
  (& (<= 0 row (1- (--- bad-grid)))
     (<= 0 col (1- (--- (aref bad-grid row))))
     (aset (aref bad-grid row) col val)))

(defun grid-print ()
  (cl-loop
   for l across-ref bad-grid
   concat (@f "%s%c" l ?\n) into str
   finally
   (with-silent-modifications
     (@i str)
     (goto-beg))))

;; -----------------------------------------------------------------------------

(defvar bad-ents nil)
(defvar bad-cmps (make-hash-table))

(defun add-entity (name cmps)
  (let ((id (gensym name)))
    (push id bad-ents)
    (puthash id cmps bad-cmps)))

(defun system-render-planets ()
  (cl-loop
   with row = 0
   for id in bad-ents
   for cmp  = (gethash id bad-cmps)
   for rad  = (cdr (assoc 'rad cmp))
   for dst  = (cdr (assoc 'dst cmp))
   do (when (& rad dst)
        (cl-loop
         initially (setf row (max 0 (-- row 6)))
         with comp = (// (frame-char-height) (frame-char-width))
         with unt  = (* 2 (** 2 -7))
         with spc  = (max 0 (round (* 2 dst (** unt 1))))
         with sze  = (max 0 (round (*   rad (** unt 2))))
         for y from (- sze) to sze
         do (cl-loop
             with x   = (max 0 (round (* comp (sqrt (- (** sze 2) (** y 2))))))
             with pad = (- sze x)
             with beg = (+ spc pad)
             with mid = (+ beg x)
             with end = (+ mid x)
             for i from beg to mid
             for j from mid to end
             for draw = (<= 1 x) do
             (when draw
               (grid-set row i ?M)
               (grid-set row j ?&))
             finally
               (grid-set (++ j) row ?\s)
               (grid-set     j  row ?.)
               (++ row))))
   finally (grid-print)))

(defun system-render-space (&optional dry)
  (with-current-buffer (get-buffer-create "*ecs-scene*")
    (with-silent-modifications
      (erase-buffer)
      (system-render-planets))
    (unless dry
      (set-face-attribute 'default nil :height 39) ; TODO
      (setq-local buffer-undo-list t)
      (pop-to-buffer (current-buffer)))))

(defun init-space ()
  (setf bad-ents nil)
  (setf bad-cmps (make-hash-table))
  (add-entity "Mercury"   '( (rad .  2440)  (dst .   58) ))
  (add-entity "Mercury-1" '( (rad .    18)  (dst .   58) ))
  (add-entity "Mercury-2" '( (rad .     8)  (dst .   58) ))

  (add-entity "Venus"     '( (rad .  6051)  (dst .  108) ))

  (add-entity "Earth"     '( (rad .  6371)  (dst .  150) ))
  (add-entity "Moon"      '( (rad .  1737)  (dst .  150) ))
  (add-entity "Mars"      '( (rad .  3389)  (dst .  228) ))
  (add-entity "Phobos"    '( (rad .    11)  (dst .  228) ))
  (add-entity "Deimos"    '( (rad .     6)  (dst .  228) ))

  ;; Jupiter has a lot of moons so very incomplete list
  (add-entity "Jupiter"   '( (rad . 69911)  (dst .  778) ))
  (add-entity "Callisto"  '( (rad .  4877)  (dst .  778) ))
  (add-entity "Ganymede"  '( (rad .  3228)  (dst .  778) ))
  (add-entity "Europa"    '( (rad .  3112)  (dst .  778) ))

  ;; not done
  (add-entity "Saturn"    '( (rad . 58232)  (dst . 1427) ))

  ;; not done
  (add-entity "Uranus"    '( (rad . 25362)  (dst . 2871) ))

  ;; Neptune has at least 16 moons
  (add-entity "Neptune"   '( (rad . 24622)  (dst . 4495) ))
  (add-entity "Triton"    '( (rad .  1354)  (dst . 4495) ))

  (add-entity "Pluto"     '( (rad .  1188)  (dst . 5906) )) )

(defun bad-run-space ()
  (grid-init)
  (init-space)
  (system-render-space))

(defun bad-run-space-benchmark (&optional n)
  (or n (setf n 1))
  (floor (/ n (1st (benchmark-run-compiled n (system-render-space t))))))

;; (progn (eval-buffer) (bad-run-space-benchmark (** 2 8)))
;; (progn (eval-buffer) (bad-run-space))

(<- 'bad-ecs)