;;;; 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." (declare (type (or weak-pointer null) ptr)) (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 *world-scenes* () "List of all running scenes.") (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 get-scene (scene-id) "Get a scene by its ID." (find-if (lambda (scene) (eq [scene id] scene-id)) *world-scenes*)) (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 child-actor grandchild-actor) (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 child-actor (make-instance 'actor :name "Child Actor" :location (vec2 0 0.5) :z-layer -2)) [test-scene (add-actor child-actor)] [test-actor-2 (add-child child-actor)] [child-actor (add-component (make-instance 'drawable-test :colour (vec4 0.0 1.0 1.0 1.0))) ] (setf grandchild-actor (make-instance 'actor :name "Grandchild Actor" :location (vec2 0 1) :scale (vec2 0.25 0.25) :z-layer 1)) [test-scene (add-actor grandchild-actor)] [child-actor (add-child grandchild-actor)] [grandchild-actor (add-component (make-instance 'drawable-test :colour (vec4 1.0 1.0 0.0 0.0))) ] (setf camera-actor (make-instance 'actor :name "Camera")) [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* *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 (car (gl:gen-framebuffers 1))) (renderbuf (car (gl:gen-renderbuffers 1))) (render-texture (car (gl:gen-textures 1))) (win-width (nth-value 0 (sdl2:get-window-size win))) (win-height (nth-value 1 (sdl2:get-window-size win)))) ;; 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))) ;; 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 () ;; update (loop for scene in *world-scenes* do [scene (update)]) ;; 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 [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*)]))) ;; 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-primitive :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) (sdl2:gl-swap-window win))) )))))