diff options
Diffstat (limited to 'lisparuga/kernel.scm')
| -rw-r--r-- | lisparuga/kernel.scm | 69 |
1 files changed, 46 insertions, 23 deletions
diff --git a/lisparuga/kernel.scm b/lisparuga/kernel.scm index f94b832..36dea70 100644 --- a/lisparuga/kernel.scm +++ b/lisparuga/kernel.scm @@ -28,6 +28,7 @@ #:use-module (chickadee render) #:use-module (chickadee render gpu) #:use-module (chickadee render viewport) + #:use-module (gl) #:use-module (ice-9 match) #:use-module (oop goops) #:use-module (sdl2) @@ -35,7 +36,7 @@ #:use-module (sdl2 input game-controller) #:use-module (sdl2 input joystick) #:use-module (sdl2 input text) - #:use-module (sdl2 video) + #:use-module ((sdl2 video) #:prefix sdl2:) #:use-module (lisparuga asset) #:use-module (lisparuga config) #:use-module (lisparuga node) @@ -43,10 +44,10 @@ #:use-module (lisparuga scene) #:use-module (system repl command) #:export (<window-config> - width - height - title - fullscreen? + window-width + window-height + window-title + window-fullscreen? <kernel> window-config @@ -62,11 +63,11 @@ #:re-export (abort-game)) (define-class <window-config> () - (width #:accessor width #:init-form 640 #:init-keyword #:width) - (height #:accessor height #:init-form 480 #:init-keyword #:height) - (title #:accessor title #:init-form "Lisparuga" + (width #:accessor window-width #:init-form 640 #:init-keyword #:width) + (height #:accessor window-height #:init-form 480 #:init-keyword #:height) + (title #:accessor window-title #:init-form "Lisparuga" #:init-keyword #:title) - (fullscreen? #:accessor fullscreen? #:init-form #f + (fullscreen? #:accessor window-fullscreen? #:init-form #f #:init-keyword #:fullscreen?)) (define-class <kernel> (<scene-mux>) @@ -114,11 +115,20 @@ ;; Start REPL server. (attach-to kernel (make <repl> #:name 'repl)))) +(define-method (on-key-press (kernel <kernel>) key scancode modifiers repeat?) + ;; Hot keys when in dev mode + (when developer-mode? + (match key + ('f5 (reboot-current-scene)) + ('escape (abort-game)) + (_ #t))) + (next-method)) + (define-method (update-tree (kernel <kernel>) dt) (define (invert-y y) ;; SDL's origin is the top-left, but our origin is the bottom ;; left so we need to invert Y coordinates that SDL gives us. - (match (window-size (window kernel)) + (match (sdl2:window-size (window kernel)) ((_ height) (- height y)))) (define (process-event event) @@ -210,6 +220,12 @@ ;; Free any GPU resources that have been GC'd. (gpu-reap!)) +(define %clear-mask + (logior (attrib-mask color-buffer) + (attrib-mask depth-buffer) + (attrib-mask stencil-buffer) + (attrib-mask accum-buffer))) + (define-method (render-tree (kernel <kernel>) alpha) (let ((start-time (elapsed-time))) ;; Switch to the null viewport to ensure that @@ -217,8 +233,9 @@ ;; clear the screen. (set-gpu-viewport! (current-gpu) null-viewport) (with-viewport (default-viewport kernel) + (gl-clear %clear-mask) (next-method)) - (swap-gl-window (window kernel)) + (sdl2:swap-gl-window (window kernel)) ;; Compute FPS. (set! (avg-frame-time kernel) (+ (* (- (elapsed-time) start-time) 0.1) @@ -226,10 +243,10 @@ (define-method (on-error (kernel <kernel>) stack key args) (if developer-mode? - (let ((title (window-title (window kernel)))) - (set-window-title! (window kernel) (string-append "[ERROR] " title)) + (let ((title (sdl2:window-title (window kernel)))) + (sdl2:set-window-title! (window kernel) (string-append "[ERROR] " title)) (on-error (& kernel repl) stack key args) - (set-window-title! (window kernel) title)) + (sdl2:set-window-title! (window kernel) title)) (apply throw key args))) (define-method (on-scenes-empty (kernel <kernel>)) @@ -253,18 +270,18 @@ (init-audio) (let ((wc (window-config kernel))) (set! (window kernel) - (make-window #:opengl? #t - #:title (title wc) - #:size (list (width wc) (height wc)) - #:fullscreen? (fullscreen? wc))) - (set! (gl-context kernel) (make-gl-context (window kernel))) + (sdl2:make-window #:opengl? #t + #:title (window-title wc) + #:size (list (window-width wc) (window-height wc)) + #:fullscreen? (window-fullscreen? wc))) + (set! (gl-context kernel) (sdl2:make-gl-context (window kernel))) (set! (default-viewport kernel) - (make-viewport 0 0 (width wc) (height wc))) + (make-viewport 0 0 (window-width wc) (window-height wc))) ;; Attempt to activate vsync, if possible. Some systems do ;; not support setting the OpenGL swap interval. (catch #t (lambda () - (set-gl-swap-interval! 'vsync)) + (sdl2:set-gl-swap-interval! 'vsync)) (lambda args (display "warning: could not enable vsync\n" (current-error-port)))) @@ -284,12 +301,13 @@ (lambda () (deactivate kernel) (quit-audio) - (delete-gl-context! (gl-context kernel)) - (close-window! (window kernel)))))) + (sdl2:delete-gl-context! (gl-context kernel)) + (sdl2:close-window! (window kernel)))))) (define (reboot-current-scene) "Reboot the currently active scene being managed by the game engine kernel. A convenient procedure for developers." + (display "rebooting\n") (reboot (current-scene (current-kernel)))) (define-meta-command ((debug-game lisparuga) repl) @@ -301,3 +319,8 @@ Enter a debugger for the current game loop error." "resume-game Resume the game loop without entering a debugger." (set! (repl-debugging? (& (current-kernel) repl)) #f)) + +(define-meta-command ((reboot lisparuga) repl) + "reboot +Reboot the current scene." + (reboot-current-scene)) |