175 lines
8.3 KiB
Common Lisp
175 lines
8.3 KiB
Common Lisp
;;;; wh-engine/main.lisp
|
|
(in-package wh-engine)
|
|
|
|
(defun initialize-actors-in (scene &rest actors)
|
|
"Properly attach actors and their descendents to scene, and initialize them."
|
|
(loop for actor in actors
|
|
do ;; attach actor to scene
|
|
(o! actor (apply-to-tree (lambda (a)
|
|
(setf (o! a :slot scene) nil)
|
|
(o! scene (add-actor a)))))
|
|
;; (resume) -> automatically resumes children
|
|
(o! actor (resume))
|
|
;; (activate) -> automatically activates eligible children
|
|
(when (o! actor tree-active-p)
|
|
(o! actor (activate)))
|
|
))
|
|
|
|
(defvar *delta-time* 0.0
|
|
"Time in seconds since the last game tick.")
|
|
|
|
(defun register-test-scene ()
|
|
(let ((test-scene (new! scene :id -1 :name "Test scene")))
|
|
(add-scene test-scene)
|
|
(initialize-actors-in test-scene
|
|
(new! actor
|
|
:name "Actor"
|
|
:component (new! whe/render:drawable-test))
|
|
(new! actor
|
|
:name "Actor 2"
|
|
:location (vec2 0.5 0.5)
|
|
:rotation (coerce (/ pi 4) 'single-float)
|
|
:z-layer -1
|
|
:component (new! whe/render:drawable-test :colour (vec4 0 1 0 1))
|
|
:child (new! actor
|
|
:name "Child Actor"
|
|
:location (vec2 0 0.5)
|
|
:z-layer -2
|
|
:component (new! whe/render:drawable-test :colour (vec4 0 1 1 1))
|
|
:child (new! actor
|
|
:name "Grandchild Actor"
|
|
:location (vec2 0 1)
|
|
:scale (vec2 0.25 0.25)
|
|
:z-layer 1
|
|
:component (new! whe/render:drawable-test :colour (vec4 1 1 0 1)))))
|
|
(new! actor
|
|
:name "Camera"
|
|
:component (new! whe/render:view)))
|
|
test-scene))
|
|
|
|
(defmacro 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 (* whe/render:*view-width* whe/render:*pixel-scale*) :h (* whe/render:*view-height* whe/render:*pixel-scale*)
|
|
:title (format nil "wh-engine ~1{~D.~D.~D~} (Affero GPL; NON-FREE USAGE PROHIBITED)"
|
|
+version+))
|
|
(sdl2:with-gl-context (gl-context win)
|
|
(sdl2:gl-make-current win gl-context)
|
|
(let ((prev-tick (sdl2:get-ticks))
|
|
(this-tick (sdl2:get-ticks))
|
|
(prev-profiling-tick (sdl2:get-performance-counter))
|
|
(profiling-scale (/ (sdl2:get-performance-frequency) 1000.0)))
|
|
|
|
,@(loop for system in *world-systems*
|
|
append `((,(second system))))
|
|
|
|
(sdl2:with-event-loop (:method :poll)
|
|
(:quit () t)
|
|
(:idle
|
|
()
|
|
|
|
(setf prev-profiling-tick (sdl2:get-performance-counter))
|
|
;; calculate delta-time
|
|
(setf this-tick (sdl2:get-ticks))
|
|
(setf *delta-time* (* (- this-tick prev-tick) 0.001))
|
|
(setf prev-tick this-tick)
|
|
;; (format t "~%Δt = ~S (~S FPS)~%" *delta-time* (/ 1.0 *delta-time*))
|
|
;; update
|
|
(loop for scene in *world*
|
|
do (o! scene (update)))
|
|
;; (format t "game=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
|
|
,@(loop for system in *world-systems*
|
|
append `((,(third system))
|
|
;; (format t ,(format nil "~S~A" (first system) "=~S ")
|
|
;; (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
|
|
))
|
|
(sdl2:gl-swap-window win))
|
|
(:keydown
|
|
(:keysym keysym)
|
|
|
|
,@(loop for system in *world-systems*
|
|
for handler = (assoc :keydown (fourth system))
|
|
when handler
|
|
collect `(,(cdr handler) keysym)))
|
|
(:keyup
|
|
(:keysym keysym)
|
|
|
|
,@(loop for system in *world-systems*
|
|
for handler = (assoc :keyup (fourth system))
|
|
when handler
|
|
collect `(,(cdr handler) keysym)))
|
|
(:mousemotion
|
|
(:x mouse-x :y mouse-y :xrel delta-x :yrel delta-y :state state)
|
|
|
|
,@(loop for system in *world-systems*
|
|
for handler = (assoc :mousemotion (fourth system))
|
|
when handler
|
|
collect `(,(cdr handler)
|
|
(vec2 (truncate mouse-x whe/render:*pixel-scale*)
|
|
(- wh-engine/render:*view-height* (truncate mouse-y whe/render:*pixel-scale*)))
|
|
(vec2 (truncate delta-x whe/render:*pixel-scale*)
|
|
(- (truncate delta-y whe/render:*pixel-scale*)))
|
|
state)))
|
|
(:mousebuttondown
|
|
(:x mouse-x :y mouse-y :button button)
|
|
|
|
,@(loop for system in *world-systems*
|
|
for handler = (assoc :mousebuttondown (fourth system))
|
|
when handler
|
|
collect `(,(cdr handler)
|
|
(vec2 (truncate mouse-x whe/render:*pixel-scale*)
|
|
(- wh-engine/render:*view-height* (truncate mouse-y whe/render:*pixel-scale*)))
|
|
button)))
|
|
(:mousebuttonup
|
|
(:x mouse-x :y mouse-y :button button)
|
|
|
|
,@(loop for system in *world-systems*
|
|
for handler = (assoc :mousebuttonup (fourth system))
|
|
when handler
|
|
collect `(,(cdr handler)
|
|
(vec2 (truncate mouse-x whe/render:*pixel-scale*)
|
|
(- wh-engine/render:*view-height* (truncate mouse-y whe/render:*pixel-scale*)))
|
|
button)))
|
|
(:joyaxismotion
|
|
(:which joy-id :axis axis :value value)
|
|
|
|
,@(loop for system in *world-systems*
|
|
for handler = (assoc :joyaxismotion (fourth system))
|
|
when handler
|
|
collect `(,(cdr handler) joy-id axis value)))
|
|
(:joyballmotion
|
|
(:which joy-id :ball ball :xrel delta-x :yrel delta-y)
|
|
|
|
,@(loop for system in *world-systems*
|
|
for handler = (assoc :joyballmotion (fourth system))
|
|
when handler
|
|
collect `(,(cdr handler) joy-id ball (vec2 delta-x delta-y))))
|
|
(:joyhatmotion
|
|
(:which joy-id :hat hat :value value)
|
|
|
|
,@(loop for system in *world-systems*
|
|
for handler = (assoc :joyhatmotion (fourth system))
|
|
when handler
|
|
collect `(,(cdr handler) joy-id hat value)))
|
|
(:joybuttondown
|
|
(:which joy-id :button button)
|
|
|
|
,@(loop for system in *world-systems*
|
|
for handler = (assoc :joybuttondown (fourth system))
|
|
when handler
|
|
collect `(,(cdr handler) joy-id button)))
|
|
(:joybuttonup
|
|
(:which joy-id :button button)
|
|
|
|
,@(loop for system in *world-systems*
|
|
for handler = (assoc :joybuttonup (fourth system))
|
|
when handler
|
|
collect `(,(cdr handler) joy-id button))))
|
|
)))))
|