diff options
| -rw-r--r-- | starling/kernel.scm | 60 |
1 files changed, 57 insertions, 3 deletions
diff --git a/starling/kernel.scm b/starling/kernel.scm index 042e1ac..3f19d5f 100644 --- a/starling/kernel.scm +++ b/starling/kernel.scm @@ -26,12 +26,18 @@ #:use-module (chickadee audio) #:use-module (chickadee game-loop) #:use-module (chickadee graphics) + #:use-module (chickadee graphics color) + #:use-module (chickadee graphics font) #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics viewport) + #:use-module (chickadee math rect) + #:use-module (chickadee math vector) + #:use-module (chickadee scripting) #:use-module (gl) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (oop goops) - #:use-module (sdl2) + #:use-module ((sdl2) #:select (sdl-init)) #:use-module (sdl2 events) #:use-module (sdl2 input game-controller) #:use-module (sdl2 input joystick) @@ -39,6 +45,7 @@ #:use-module (starling asset) #:use-module (starling config) #:use-module (starling node) + #:use-module (starling node-2d) #:use-module (starling repl) #:use-module (starling minibuffer) #:use-module (starling scene) @@ -71,6 +78,38 @@ (fullscreen? #:accessor window-fullscreen? #:init-form #f #:init-keyword #:fullscreen?)) +(define-class <fps-display> (<node>)) + +(define-method (on-boot (fps-display <fps-display>)) + (let* ((canvas (make <canvas> #:name 'canvas)) + (font (default-font)) + (padding 4.0) + (box-width (+ (font-line-width font "60.0") + (* padding 2.0))) + (box-height (+ (font-line-height font) (* padding 2.0)))) + (match (current-window-size) + ((_ window-height) + (attach-to canvas + (make <filled-rect> + #:region (make-rect 0.0 + (- window-height box-height) + box-width + box-height) + #:color (make-color 0.0 0.0 0.0 0.7)) + (make <label> + #:name 'fps-label + #:rank 9 + #:text "60.0" + #:font font + #:position (vec2 padding + (+ (- window-height box-height) + padding)))))) + (attach-to fps-display canvas))) + +(define-method (update-fps (fps-display <fps-display>) fps) + (set! (text (& fps-display canvas fps-label)) + (format #f "~1,1f" fps))) + (define-class <kernel> (<scene-mux>) (name #:accessor name #:init-form "lisparuga-kernel" #:init-keyword #:name) @@ -113,8 +152,15 @@ (when developer-mode? ;; Enable live asset reloading. (watch-assets #t) - ;; Start REPL server. - (attach-to kernel (make <repl> #:name 'repl)))) + (attach-to kernel + ;; FPS counter + (make <fps-display> #:name 'fps) + ;; REPL server + (make <repl> #:name 'repl)) + (run-script kernel + (forever + (sleep 60) + (update-fps (& kernel fps) (fps kernel)))))) (define-method (on-key-press (kernel <kernel>) key scancode modifiers repeat?) ;; Hot keys when in dev mode @@ -316,9 +362,17 @@ kernel. A convenient procedure for developers." (define (resume-current-scene) (resume (current-scene (current-kernel)))) +(define (show-fps) + (show (& (current-kernel) fps))) + +(define (hide-fps) + (hide (& (current-kernel) fps))) + (add-minibuffer-command "reboot" reboot-current-scene) (add-minibuffer-command "pause" pause-current-scene) (add-minibuffer-command "resume" resume-current-scene) +(add-minibuffer-command "show-fps" show-fps) +(add-minibuffer-command "hide-fps" hide-fps) (define-meta-command ((debug-game lisparuga) repl) "debug-game |