wh-engine/wh-engine/main.lisp

;;;; wh-engine/main.lisp
(in-package wh-engine)

;; FIXME this should be a defconst
(defvar +version+ (list 0 1 0)
  "Engine version.")

(defun ensure-version (expected-version)
  "Ensure this version of wh-engine is compatible with the expected version."
  (if (= (nth 0 +version+) 0)
      (unless (equal +version+ expected-version)
        (error "engine version ~S incompatible with expected-version ~S (pre-1.0 mismatch)"
               +version+ expected-version))
      (progn
        (unless (= (nth 0 +version+) (nth 0 expected-version))
          (error "engine version ~S incompatible with expected-version ~S (major-version mismatch)"
                 +version+ expected-version))
        (unless (>= (nth 1 +version+) (nth 1 expected-version))
          (error "engine version ~S incompatible with expected-version ~S (minor-version too low)"
                 +version+ expected-version))
        (unless (equal +version+ expected-version)
          (warn "engine version ~S differs from expected-version ~S, but is still compatible"
                +version+ expected-version)))))

(declaim (inline deref-pointer))
(defun deref-pointer (ptr)
  "Dereference ptr if it's non-nil."
  (when ptr (weak-pointer-value ptr)))

(defun points-to (ptr obj)
  "Return true if ptr points to obj."
  (declare (type weak-pointer ptr))

  (eq (weak-pointer-value ptr) obj))

(defun ensure-live (obj)
  "Ensure obj is live (non-destroyed)."
  (when [obj destroyed-p]
        (error "~S was used after it was destroyed" obj))
  obj)

(declaim (inline vxy1))
(defun vxy1 (vector)
  "Convert vector to a vec3, with a Z component of 1."
  (declare (type vec2 vector))
  (vec3 (vx2 vector) (vy2 vector) 1))

(declaim (inline vxy-trunc))
(defun vxy-trunc (vector)
  "Convert vector to a vec2 and truncate its X and Y components to the nearest integer."
  (declare (type vec3 vector))
  (vec2 (ftruncate (vx3 vector)) (ftruncate (vy3 vector))))

(defun opengl-matrix (matrix)
  (declare (type mat3 matrix))
  (with-fast-matref (m matrix 3)
    (make-array '(16) :initial-contents
                `(,(m 0 0) ,(m 0 1) 0.0 ,(m 0 2)
                  ,(m 1 0) ,(m 1 1) 0.0 ,(m 1 2)
                      0.0      0.0  1.0     0.0
                  ,(m 2 0) ,(m 2 1) 0.0 ,(m 2 2))
                )))

(defvar *id-counter* 0
  "Counter for assigning unique IDs.")

(defun make-id ()
  "Return a unique ID."
  (setq *id-counter* (+ *id-counter* 1)))

(defun fixed-id (id)
  "Ensure the given ID won't be returned by make-id."
  (declare (type fixnum id))
  (when (>= id *id-counter*)
    (setq *id-counter* (+ id 1)))
  id)

(defvar *running-scenes* nil
  "List of running scenes.")

(defun add-scene (scene)
  "Add a scene to the list of running scenes."
  (declare (type scene scene))

  (push scene *running-scenes*)
  scene)

(defun remove-scene (scene)
  "Remove a scene from the list of running scenes."
  (declare (type scene scene))

  (setf *running-scenes* (remove scene *running-scenes*))
  scene)

(defun get-scene (scene-id)
  "Get a scene by its ID."
  (find-if (lambda (scene) (eq [scene id] scene-id)) *running-scenes*))

(defun update-all-scenes ()
  "Update all running scenes."
  (loop for scene in *running-scenes*
        do [scene (update)]))

(defvar *view-width* 384
  "View-space width in pixels.")
(defvar *view-height* 256
  "View-space height in pixels.")
(defvar *view-ppu* 64
  "Pixels in view-space per unit in world-space.")

(defvar *pixel-scale* 2
  "Scaling factor for rendered pixels.")

(defvar *world-drawables* nil
  "List of all known drawables.")
(defvar *world-views* nil
  "List of all known views.")

(defun register-test-scene ()
  (let (test-scene test-actor test-drawable test-actor-2 camera-actor camera-view)
    (setf test-scene (make-instance 'scene
                                    :id -1
                                    :name "Test scene"))
    (add-scene test-scene)

    (setf test-actor (make-instance 'actor
                                    :name "Actor"))
    [test-scene (add-actor test-actor)]

    (setf test-drawable (make-instance 'drawable-test))
    [test-actor (add-component test-drawable)]

    (setf test-actor-2 (make-instance 'actor
                                      :name "Actor 2"
                                      :location (vec2 0.5 0.5)
                                      :rotation (coerce (/ pi 4) 'single-float)
                                      :z-layer -1))
    [test-scene (add-actor test-actor-2)]

    [test-actor-2 (add-component (make-instance 'drawable-test
                                                :colour (vec4 0.0 1.0 0.0 1.0)))
    ]

    (setf camera-actor (make-instance 'actor
                                      :name "Camera"
                                      :rotation (coerce (/ pi -4) 'single-float)))
    [test-scene (add-actor camera-actor)]

    (setf camera-view (make-instance 'view))
    [camera-actor (add-component camera-view)]

    test-scene))

(defun run ()
  "Run the main game loop."
  (sdl2:with-init (:everything)
    (format t "wh-engine: using SDL ~D.~D.~D~%"
            sdl2-ffi:+sdl-major-version+
            sdl2-ffi:+sdl-minor-version+
            sdl2-ffi:+sdl-patchlevel+)
    (finish-output)
    (sdl2:with-window (win :flags '(:shown :opengl)
                           :w *view-width* :h *view-height*
                           :title (format nil "wh-engine ~D.~D.~D (Affero GPL; NON-FREE USAGE PROHIBITED)"
                                          (nth 0 +version+) (nth 1 +version+) (nth 2 +version+)))
      (sdl2:with-gl-context (gl-context win)
        (sdl2:gl-make-current win gl-context)
        (gl:viewport 0 0 *view-width* *view-height*)
        (gl:matrix-mode :projection)
        (gl:ortho 0 *view-width*
                  0 *view-height*
                  -1024 1024)
        (gl:matrix-mode :modelview)
        (gl:load-identity)
        (gl:clear-color 0.0 0.0 0.0 1.0)
        (gl:clear :color-buffer)
        (gl:clear :depth-buffer)
        (gl:enable :depth-test)

        (sdl2:with-event-loop (:method :poll)
          (:quit () t)
          (:idle ()
                 (update-all-scenes)
                 (gl:clear :color-buffer)
                 (let ((render-pass nil))
                 (loop for view-ptr in *world-views*
                       for view = (ensure-live (weak-pointer-value view-ptr))
                       when (and [view active-p] [view actor tree-active-p])
                         do (progn
                              (unless (eq [view render-pass] render-pass)
                                (setf render-pass [view render-pass])
                                (gl:clear :depth-buffer)
                                )
                              [view (render-view *world-drawables*)])))
                 (gl:flush)
                 (sdl2:gl-swap-window win)))
        ))))