summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@vistahigherlearning.com>2020-10-04 21:05:45 -0400
committerDavid Thompson <dthompson@vistahigherlearning.com>2020-10-04 21:05:45 -0400
commit549b762ce1c84b847faadc5b10cf8e1bb31d42d7 (patch)
tree5d7b2a7822b40cf525b9acfb831b76cfda81f0f6
parent78f2065ad0fd92d3ba3f8d26143a78175783df89 (diff)
kernel: Add an fps counter in dev mode.
-rw-r--r--starling/kernel.scm60
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