;;;; wh-engine/main.lisp (in-package wh-engine) (defun add-scene (scene) "Add a scene to the list of running scenes." (declare (type scene scene)) (push scene *world-scenes*) scene) (defun remove-scene (scene) "Remove a scene from the list of running scenes." (declare (type scene scene)) (setf *world-scenes* (remove scene *world-scenes*)) scene) (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 *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.") (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! drawable-test)) (new! actor :name "Actor 2" :location (vec2 0.5 0.5) :rotation (coerce (/ pi 4) 'single-float) :z-layer -1 :component (new! drawable-test :colour (vec4 0 1 0 1)) :child (new! actor :name "Child Actor" :location (vec2 0 0.5) :z-layer -2 :component (new! 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! drawable-test :colour (vec4 1 1 0 1))))) (new! actor :name "Camera" :component (new! 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* *pixel-scale*) :h (* *view-height* *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 ((framebuf (gl:gen-framebuffer)) (renderbuf (gl:gen-renderbuffer)) (render-texture (gl:gen-texture)) (win-width (nth-value 0 (sdl2:get-window-size win))) (win-height (nth-value 1 (sdl2:get-window-size win))) (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))) ;; set up framebuffer (gl:bind-framebuffer :framebuffer framebuf) (gl:bind-texture :texture-2d render-texture) (gl:tex-image-2d :texture-2d 0 :rgba *view-width* *view-height* 0 :rgba :unsigned-byte (cffi:null-pointer)) (gl:tex-parameter :texture-2d :texture-wrap-s :clamp-to-edge) (gl:tex-parameter :texture-2d :texture-wrap-t :clamp-to-edge) (gl:tex-parameter :texture-2d :texture-min-filter :nearest) (gl:tex-parameter :texture-2d :texture-mag-filter :nearest) (gl:bind-texture :texture-2d 0) (gl:framebuffer-texture-2d :framebuffer :color-attachment0 :texture-2d render-texture 0) (gl:bind-renderbuffer :renderbuffer renderbuf) (gl:renderbuffer-storage :renderbuffer :depth24-stencil8 *view-width* *view-height*) (gl:bind-renderbuffer :renderbuffer 0) (gl:framebuffer-renderbuffer :framebuffer :depth-stencil-attachment :renderbuffer renderbuf) ;; make sure it's valid (let ((result (gl:check-framebuffer-status :framebuffer))) (unless (gl::enum= result :framebuffer-complete) (error "Failed to create framebuffer: ~S" result))) (format t "texture-resident-p: ~S~%" (gl:texture-resident-p render-texture)) ;; set up gl (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) (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-scenes* do (o! scene (update))) (format t "game=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale)) ;; draw to render texture (gl:bind-framebuffer :framebuffer framebuf) (gl:viewport 0 0 *view-width* *view-height*) (gl:clear :color-buffer) (gl:enable :depth-test) (let ((render-pass nil)) (loop for view-ptr in *world-views* for view = (ensure-live (weak-pointer-value view-ptr)) when (and (o! view active-p) (o! view actor tree-active-p)) do (progn (unless (eq (o! view render-pass) render-pass) (setf render-pass (o! view render-pass)) (gl:clear :depth-buffer)) (o! view (render-view *world-drawables*))))) (gl:flush) (format t "draw=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale)) ;; now draw to window (gl:bind-framebuffer :framebuffer 0) (gl:viewport 0 0 win-width win-height) (gl:clear :color-buffer) (gl:disable :depth-test) (gl:enable :texture-2d) (gl:bind-texture :texture-2d render-texture) (gl:matrix-mode :modelview) (gl:load-identity) (gl:with-primitives :quads (gl:color 1.0 1.0 1.0 1.0) (gl:tex-coord 0.0 0.0) (gl:vertex 0.0 0.0) (gl:tex-coord 1.0 0.0) (gl:vertex *view-width* 0.0) (gl:tex-coord 1.0 1.0) (gl:vertex *view-width* *view-height*) (gl:tex-coord 0.0 1.0) (gl:vertex 0.0 *view-height*)) (gl:disable :texture-2d) (gl:flush) (format t "blit=~S~%" (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale)) (sdl2:gl-swap-window win))) )))))