Support scling

1 files changed, 77 insertions, 0 deletions

diff --git a/demo/scaling.scm b/demo/scaling.scm
new file mode 100644
index 0000000..983e583
--- /dev/null
+++ b/demo/scaling.scm
@@ -0,0 +1,77 @@
+(import scheme
+        (chicken base)
+        (prefix sdl2 "sdl2:")
+        (prefix sdl2-ttf "ttf:")
+        downstroke-engine
+        downstroke-world
+        downstroke-entity
+        downstroke-input
+        downstroke-renderer
+        downstroke-assets)
+
+;; Logical resolution: 320×240, displayed at 640×480 via scale: 2
+
+(define +width+  320)
+(define +height+ 240)
+(define +box-size+ 16)
+(define +speed+    2)
+
+(define *game*
+  (make-game
+    title: "Demo: Scaling (2×)"
+    width: +width+ height: +height+
+    scale: 2
+
+    create: (lambda (game)
+      (game-scene-set! game
+        (make-scene
+          entities: (list (list #:type    'box
+                                #:x       (/ +width+ 2)
+                                #:y       (/ +height+ 2)
+                                #:width   +box-size+
+                                #:height  +box-size+
+                                #:vx 0 #:vy 0
+                                #:color   '(255 200 0)))
+          tilemap:         #f
+          camera:          (make-camera x: 0 y: 0)
+          tileset-texture: #f
+          camera-target:   #f
+          background:      '(30 30 50))))
+
+    update: (lambda (game dt)
+      (let* ((input (game-input game))
+             (scene (game-scene game))
+             (box   (car (scene-entities scene)))
+             (vx (cond ((input-held? input 'left)  (- +speed+))
+                       ((input-held? input 'right)    +speed+)
+                       (else 0)))
+             (vy (cond ((input-held? input 'up)    (- +speed+))
+                       ((input-held? input 'down)     +speed+)
+                       (else 0)))
+             (nx (max 0 (min (- +width+ +box-size+)
+                             (+ (entity-ref box #:x 0) vx))))
+             (ny (max 0 (min (- +height+ +box-size+)
+                             (+ (entity-ref box #:y 0) vy))))
+             (box (entity-set (entity-set box #:x nx) #:y ny)))
+        (scene-entities-set! scene (list box))))
+
+    render: (lambda (game)
+      (let* ((renderer (game-renderer game))
+             (scene    (game-scene game))
+             (box      (car (scene-entities scene)))
+             (bx (inexact->exact (floor (entity-ref box #:x 0))))
+             (by (inexact->exact (floor (entity-ref box #:y 0)))))
+        ;; Draw the colored box
+        (set! (sdl2:render-draw-color renderer) (sdl2:make-color 255 200 0))
+        (sdl2:render-fill-rect! renderer
+          (sdl2:make-rect bx by +box-size+ +box-size+))
+        ;; Draw a border around the logical viewport
+        (set! (sdl2:render-draw-color renderer) (sdl2:make-color 100 100 100))
+        (sdl2:render-draw-rect! renderer
+          (sdl2:make-rect 0 0 +width+ +height+))
+        ;; Draw crosshair at center
+        (set! (sdl2:render-draw-color renderer) (sdl2:make-color 60 60 80))
+        (sdl2:render-draw-line! renderer (/ +width+ 2) 0 (/ +width+ 2) +height+)
+        (sdl2:render-draw-line! renderer 0 (/ +height+ 2) +width+ (/ +height+ 2))))))
+
+(game-run! *game*)