;; Copyright (c) Camden Dixie O'Brien
;; SPDX-License-Identifier: AGPL-3.0-only

(in-package :ham)

(defstruct line points)
(defstruct polygon points)

(defun line (start-x start-y end-x end-y)
  (list (make-line :points (vector start-x start-y end-x end-y))))

(defun circle (radius centre-x centre-y &optional (segments 32))
  (let ((points (make-array (* segments 2))))
    (dotimes (i segments)
      (let ((angle (* 2 pi (/ i segments))))
        (setf (aref points (* i 2))
              (+ centre-x (* radius (cos angle))))
        (setf (aref points (1+ (* i 2)))
              (+ centre-y (* radius (sin angle))))))
    (list (make-polygon :points points))))

(defun rectangle (left-x bottom-y width height)
  (let ((right-x (+ left-x width))
		(top-y (+ bottom-y height)))
	(list (make-polygon
           :points (vector left-x bottom-y
						   left-x top-y
						   right-x top-y
						   right-x bottom-y)))))

(defun centre-rectangle (centre-x centre-y width height)
  (let ((left-x (- centre-x (/ width 2)))
        (bottom-y (- centre-y (/ height 2))))
    (rectangle left-x bottom-y width height)))

(defmacro define-transform (name (&rest params) &key x-transform y-transform)
  `(defun ,name (,@params drawing)
     (labels ((transform-points (points)
                (let ((new-points (copy-seq points)))
                  (do ((i 0 (+ i 2)))
                      ((>= i (length points)))
                    (let ((x (aref new-points i))
                          (y (aref new-points (1+ i))))
                      (setf (aref new-points i) ,x-transform)
                      (setf (aref new-points (1+ i)) ,y-transform)))
                  new-points))
              (transform-primitive (primitive)
                (typecase primitive
                  (line
                   (make-line
                    :points (transform-points (line-points primitive))))
                  (polygon
                   (make-polygon
                    :points (transform-points
                             (polygon-points primitive)))))))
       (mapcar #'transform-primitive drawing))))

(define-transform translate (delta-x delta-y)
                  :x-transform (+ delta-x x)
                  :y-transform (+ delta-y y))

(define-transform scale (scale-factor)
                  :x-transform (* scale-factor x)
                  :y-transform (* scale-factor y))

(define-transform rotate (theta)
                  :x-transform (- (* x (cos theta)) (* y (sin theta)))
                  :y-transform (+ (* x (sin theta)) (* y (cos theta))))

(defun overlay (&rest drawings)
  (apply #'append drawings))

(defclass graphics-context ()
  (window
   renderer
   (width :initarg :width :initform 800)
   (height :initarg :height :initform 600)))

(defmethod initialize-instance :after ((ctx graphics-context) &key)
  (with-slots (window renderer width height) ctx
    (sdl2:init)
    (setf window
          (sdl2:create-window :title "Simulation"
                              :w width :h height
                              :flags '(:shown)))
    (setf renderer
          (sdl2:create-renderer window -1 '(:accelerated :presentvsync)))))

(defmethod cleanup ((ctx graphics-context))
  (with-slots (window renderer) ctx
    (sdl2:destroy-renderer renderer)
    (sdl2:destroy-window window)
    (sdl2:quit)))

(define-transform project-to-screen (screen-height)
                  :x-transform (round x)
                  :y-transform (round (- screen-height y)))

(defmethod display-frame ((ctx graphics-context) drawing)
  (with-slots (renderer width height) ctx
    (sdl2:set-render-draw-color renderer 255 255 255 255)
    (sdl2:render-clear renderer)
    (sdl2:set-render-draw-color renderer 0 0 0 255)
    (draw renderer
		  (project-to-screen height
							 (translate (/ width 2) (/ height 2) drawing)))
    (sdl2:render-present renderer)))

(defun draw (renderer drawing)
  (defun draw-line (line)
	(let ((points (line-points line)))
      (sdl2:render-draw-line renderer
							 (aref points 0) (aref points 1)
							 (aref points 2) (aref points 3))))
  (defun draw-polygon (polygon)
	(let* ((points (polygon-points polygon))
           (point-count (/ (length points) 2)))
      (dotimes (i point-count)
		(let* ((start (* i 2))
               (end (if (= i (1- point-count)) 0 (+ start 2))))
          (sdl2:render-draw-line renderer
								 (aref points start)
								 (aref points (1+ start))
								 (aref points end)
								 (aref points (1+ end)))))))
  (dolist (primitive drawing)
    (typecase primitive
      (line (draw-line primitive))
      (polygon (draw-polygon primitive)))))