Re-format

1 files changed, 243 insertions, 243 deletions

diff --git a/engine.scm b/engine.scm
index 0513df2..ae86f03 100644
--- a/engine.scm
+++ b/engine.scm
@@ -1,245 +1,245 @@
 (module (downstroke engine) *
 
-(import scheme
-        (chicken base)
-        (prefix sdl2 "sdl2:")
-        (prefix sdl2-ttf "ttf:")
-        (prefix sdl2-image "img:")
-        (srfi 69)
-	    (only srfi-197 chain)
-        defstruct
-        (downstroke world)
-        (downstroke input)
-        (downstroke physics)
-        (downstroke tween)
-        (downstroke assets)
-        (downstroke animation)
-        (downstroke renderer))
-
-;; ── Game struct ────────────────────────────────────────────────────────────
-;; defstruct auto-generates make-game, which we'll wrap with default values
-
-(defstruct game
-  title width height
-  scale          ;; positive integer: whole-game pixel scaling factor
-  window renderer
-  input          ;; input-state record
-  input-config   ;; input-config record
-  assets         ;; asset registry (hash-table from assets.scm)
-  frame-delay
-  preload-hook   ;; (lambda (game) ...)
-  create-hook    ;; (lambda (game) ...)
-  update-hook    ;; (lambda (game dt) ...)
-  render-hook    ;; (lambda (game) ...) — post-render overlay
-  scene          ;; current scene struct; #f until create: runs
-  states         ;; hash-table of name → state-plist
-  active-state   ;; symbol or #f — currently active state name
-  debug?)        ;; boolean: enable debug overlay drawing
-
-;; Store the auto-generated constructor as make-game*
-(define make-game* make-game)
-
-;; ── Public constructor wrapper ─────────────────────────────────────────────
-;; Wraps the auto-generated make-game (renamed to make-game*) with default values
-
-;; ── Default engine update ────────────────────────────────────────────────
-;; Standard physics pipeline: tweens → acceleration → gravity → velocity →
-;; tile collisions → ground detection → entity collisions → group sync.
-;; Runs automatically each frame unless overridden or disabled.
-
-(define (default-engine-update game dt)
-  (let ((scene (game-scene game)))
-    (when scene
-      (game-scene-set!
-       game
-       (chain scene
-	          (scene-map-entities _ (cut step-tweens <> <> dt))
-	          (scene-map-entities _ (cut apply-acceleration <> <> dt))
-	          (scene-map-entities _ (cut apply-gravity <> <> dt))
-	          (scene-map-entities _ (cut apply-velocity-x <> <> dt))
-	          (scene-map-entities _ (cut resolve-tile-collisions-x <> <> dt))
-	          (scene-map-entities _ (cut apply-velocity-y <> <> dt))
-	          (scene-map-entities _ (cut resolve-tile-collisions-y <> <> dt))
-	          (scene-map-entities _ (cut detect-on-solid <> <> dt))
-	          (scene-transform-entities _ resolve-entity-collisions)
-	          (scene-transform-entities _ sync-groups)
-	          (scene-map-entities _ (cut apply-animation <> <> dt)))))))
-
-(define (make-game #!key
-                   (title "Downstroke Game")
-                   (width 640) (height 480)
-                   (scale 1)
-                   (frame-delay 16)
-                   (input-config *default-input-config*)
-                   (preload #f) (create #f) (update #f) (render #f)
-                   (debug? #f))
-  (unless (and (integer? scale) (positive? scale))
-    (error "make-game: scale must be a positive integer" scale))
-  (make-game*
-   title:        title
-   width:        width
-   height:       height
-   scale:        scale
-   window:       #f
-   renderer:     #f
-   scene:        #f
-   input:        (create-input-state input-config)
-   input-config: input-config
-   assets:       (make-asset-registry)
-   frame-delay:  frame-delay
-   preload-hook: preload
-   create-hook:  create
-   update-hook:  update
-   render-hook:  render
-   states:       (make-hash-table)
-   active-state: #f
-   debug?:       debug?))
-
-;; ── Convenience accessors ──────────────────────────────────────────────────
-
-;; game-camera: derived from the current scene (only valid after create: runs)
-(define (game-camera game)
-  (scene-camera (game-scene game)))
-
-;; game-asset: retrieve an asset by key
-(define (game-asset game key)
-  (asset-ref (game-assets game) key))
-
-;; game-asset-set!: store an asset by key
-(define (game-asset-set! game key value)
-  (asset-set! (game-assets game) key value))
-
-;; ── Named scene states ────────────────────────────────────────────────────
-
-;; Construct a state alist with lifecycle hooks.
-(define (make-game-state #!key (create #f) (update #f) (render #f))
-  `((#:create . ,create) (#:update . ,update) (#:render . ,render)))
-
-;; Retrieve a value from a state alist.
-(define (state-hook state key)
-  (cond ((assq key state) => cdr) (else #f)))
-
-;; Register a named state. name is a symbol; state is a make-game-state alist.
-(define (game-add-state! game name state)
-  (hash-table-set! (game-states game) name state))
-
-;; Transition to a named state. Calls the state's create: hook if present.
-(define (game-start-state! game name)
-  (game-active-state-set! game name)
-  (let* ((state  (hash-table-ref (game-states game) name))
-         (create (state-hook state #:create)))
-    (when create (create game))))
-
-;; Set renderer draw color for SDL_RenderClear (called every frame before clear).
-(define (renderer-set-clear-color! renderer scene)
-  (let ((bg (and scene (scene-background scene))))
-    (if (and (list? bg) (>= (length bg) 3))
-        (let ((r (list-ref bg 0))
-              (g (list-ref bg 1))
-              (b (list-ref bg 2))
-              (a (if (>= (length bg) 4) (list-ref bg 3) 255)))
-          (set! (sdl2:render-draw-color renderer) (sdl2:make-color r g b a)))
-        (set! (sdl2:render-draw-color renderer) (sdl2:make-color 0 0 0 255)))))
-
-;; ── game-run! helpers ─────────────────────────────────────────────────────
-
-(define (collect-sdl-events)
-  (sdl2:pump-events!)
-  (let collect ((lst '()))
-    (if (not (sdl2:has-events?))
-        (reverse lst)
-        (let ((e (sdl2:make-event)))
-          (sdl2:poll-event! e)
-          (collect (cons e lst))))))
-
-(define (resolve-hooks game)
-  (let* ((active (game-active-state game))
-         (state  (and active
-                      (hash-table-ref/default (game-states game) active #f))))
-    (values (or (and state (state-hook state #:update)) (game-update-hook game))
-            (or (and state (state-hook state #:render)) (game-render-hook game)))))
-
-(define (update-camera-follow scene game)
-  (let ((target-tag (and scene (scene-camera-target scene))))
-    (if (not target-tag)
-        scene
-        (let ((target (scene-find-tagged scene target-tag)))
-          (if (not target)
-              scene
-              (update-scene scene
-                            camera: (camera-follow (scene-camera scene)
-                                                   target
-                                                   (game-width game)
-                                                   (game-height game))))))))
-
-(define (game-render! game render-fn)
-  (renderer-set-clear-color! (game-renderer game) (game-scene game))
-  (sdl2:render-clear! (game-renderer game))
-  (when (game-scene game)
-    (render-scene! (game-renderer game) (game-scene game)))
-  (when (and (game-debug? game) (game-scene game))
-    (render-debug-scene! (game-renderer game) (game-scene game)))
-  (when render-fn (render-fn game))
-  (sdl2:render-present! (game-renderer game)))
-
-;; ── game-run! ──────────────────────────────────────────────────────────────
-
-(define (game-run! game)
-  (sdl2:set-main-ready!)
-  (sdl2:init! '(video joystick game-controller))
-  (ttf:init!)
-  (img:init! '(png))
-
-  (let init-controllers ((i 0))
-    (when (< i (sdl2:num-joysticks))
-      (when (sdl2:is-game-controller? i)
-        (sdl2:game-controller-open! i))
-      (init-controllers (+ i 1))))
-
-  (let ((scale (game-scale game)))
-    (game-window-set! game
-                      (sdl2:create-window! (game-title game) 'centered 'centered
-                                           (* (game-width game) scale)
-                                           (* (game-height game) scale) '()))
-    (game-renderer-set! game
-                        (sdl2:create-renderer! (game-window game) -1 '(accelerated)))
-    (when (> scale 1)
-      (sdl2:render-logical-size-set!
-       (game-renderer game)
-       (list (game-width game) (game-height game)))))
-
-  (when (game-preload-hook game) ((game-preload-hook game) game))
-  (when (game-create-hook game) ((game-create-hook game) game))
-
-  (let loop ((last-ticks (sdl2:get-ticks)))
-    (let* ((now   (sdl2:get-ticks))
-           (dt    (- now last-ticks))
-           (input (input-state-update (game-input game) (collect-sdl-events)
-                                      (game-input-config game))))
-      (game-input-set! game input)
-      (unless (input-held? input 'quit)
-        (let ((scene (game-scene game)))
-          (when scene
-            (let ((eu (scene-engine-update scene)))
-              ;; engine-update dispatch:
-              ;;   #f      → run default-engine-update (implicit opt-in)
-              ;;   'none   → run no engine update at all (explicit opt-out)
-              ;;   <proc>  → run the user procedure
-              (cond
-               ((eq? eu 'none))
-               ((procedure? eu) (eu game dt))
-               ((not eu) (default-engine-update game dt))
-               (else
-                (error "engine-update must be #f, 'none, or a procedure" eu))))))
-        (receive (update-fn render-fn) (resolve-hooks game)
-          (when update-fn (update-fn game dt))
-          (when (game-scene game)
-            (game-scene-set! game (update-camera-follow (game-scene game) game)))
-          (game-render! game render-fn))
-        (sdl2:delay! (game-frame-delay game))
-        (loop now))))
-
-  (sdl2:destroy-window! (game-window game))
-  (sdl2:quit!))
-
-) ;; end module
+  (import scheme
+          (chicken base)
+          (prefix sdl2 "sdl2:")
+          (prefix sdl2-ttf "ttf:")
+          (prefix sdl2-image "img:")
+          (srfi 69)
+	      (only srfi-197 chain)
+          defstruct
+          (downstroke world)
+          (downstroke input)
+          (downstroke physics)
+          (downstroke tween)
+          (downstroke assets)
+          (downstroke animation)
+          (downstroke renderer))
+
+  ;; ── Game struct ────────────────────────────────────────────────────────────
+  ;; defstruct auto-generates make-game, which we'll wrap with default values
+
+  (defstruct game
+    title width height
+    scale          ;; positive integer: whole-game pixel scaling factor
+    window renderer
+    input          ;; input-state record
+    input-config   ;; input-config record
+    assets         ;; asset registry (hash-table from assets.scm)
+    frame-delay
+    preload-hook   ;; (lambda (game) ...)
+    create-hook    ;; (lambda (game) ...)
+    update-hook    ;; (lambda (game dt) ...)
+    render-hook    ;; (lambda (game) ...) — post-render overlay
+    scene          ;; current scene struct; #f until create: runs
+    states         ;; hash-table of name → state-plist
+    active-state   ;; symbol or #f — currently active state name
+    debug?)        ;; boolean: enable debug overlay drawing
+
+  ;; Store the auto-generated constructor as make-game*
+  (define make-game* make-game)
+
+  ;; ── Public constructor wrapper ─────────────────────────────────────────────
+  ;; Wraps the auto-generated make-game (renamed to make-game*) with default values
+
+  ;; ── Default engine update ────────────────────────────────────────────────
+  ;; Standard physics pipeline: tweens → acceleration → gravity → velocity →
+  ;; tile collisions → ground detection → entity collisions → group sync.
+  ;; Runs automatically each frame unless overridden or disabled.
+
+  (define (default-engine-update game dt)
+    (let ((scene (game-scene game)))
+      (when scene
+        (game-scene-set!
+         game
+         (chain scene
+	            (scene-map-entities _ (cut step-tweens <> <> dt))
+	            (scene-map-entities _ (cut apply-acceleration <> <> dt))
+	            (scene-map-entities _ (cut apply-gravity <> <> dt))
+	            (scene-map-entities _ (cut apply-velocity-x <> <> dt))
+	            (scene-map-entities _ (cut resolve-tile-collisions-x <> <> dt))
+	            (scene-map-entities _ (cut apply-velocity-y <> <> dt))
+	            (scene-map-entities _ (cut resolve-tile-collisions-y <> <> dt))
+	            (scene-map-entities _ (cut detect-on-solid <> <> dt))
+	            (scene-transform-entities _ resolve-entity-collisions)
+	            (scene-transform-entities _ sync-groups)
+	            (scene-map-entities _ (cut apply-animation <> <> dt)))))))
+
+  (define (make-game #!key
+                     (title "Downstroke Game")
+                     (width 640) (height 480)
+                     (scale 1)
+                     (frame-delay 16)
+                     (input-config *default-input-config*)
+                     (preload #f) (create #f) (update #f) (render #f)
+                     (debug? #f))
+    (unless (and (integer? scale) (positive? scale))
+      (error "make-game: scale must be a positive integer" scale))
+    (make-game*
+     title:        title
+     width:        width
+     height:       height
+     scale:        scale
+     window:       #f
+     renderer:     #f
+     scene:        #f
+     input:        (create-input-state input-config)
+     input-config: input-config
+     assets:       (make-asset-registry)
+     frame-delay:  frame-delay
+     preload-hook: preload
+     create-hook:  create
+     update-hook:  update
+     render-hook:  render
+     states:       (make-hash-table)
+     active-state: #f
+     debug?:       debug?))
+
+  ;; ── Convenience accessors ──────────────────────────────────────────────────
+
+  ;; game-camera: derived from the current scene (only valid after create: runs)
+  (define (game-camera game)
+    (scene-camera (game-scene game)))
+
+  ;; game-asset: retrieve an asset by key
+  (define (game-asset game key)
+    (asset-ref (game-assets game) key))
+
+  ;; game-asset-set!: store an asset by key
+  (define (game-asset-set! game key value)
+    (asset-set! (game-assets game) key value))
+
+  ;; ── Named scene states ────────────────────────────────────────────────────
+
+  ;; Construct a state alist with lifecycle hooks.
+  (define (make-game-state #!key (create #f) (update #f) (render #f))
+    `((#:create . ,create) (#:update . ,update) (#:render . ,render)))
+
+  ;; Retrieve a value from a state alist.
+  (define (state-hook state key)
+    (cond ((assq key state) => cdr) (else #f)))
+
+  ;; Register a named state. name is a symbol; state is a make-game-state alist.
+  (define (game-add-state! game name state)
+    (hash-table-set! (game-states game) name state))
+
+  ;; Transition to a named state. Calls the state's create: hook if present.
+  (define (game-start-state! game name)
+    (game-active-state-set! game name)
+    (let* ((state  (hash-table-ref (game-states game) name))
+           (create (state-hook state #:create)))
+      (when create (create game))))
+
+  ;; Set renderer draw color for SDL_RenderClear (called every frame before clear).
+  (define (renderer-set-clear-color! renderer scene)
+    (let ((bg (and scene (scene-background scene))))
+      (if (and (list? bg) (>= (length bg) 3))
+          (let ((r (list-ref bg 0))
+                (g (list-ref bg 1))
+                (b (list-ref bg 2))
+                (a (if (>= (length bg) 4) (list-ref bg 3) 255)))
+            (set! (sdl2:render-draw-color renderer) (sdl2:make-color r g b a)))
+          (set! (sdl2:render-draw-color renderer) (sdl2:make-color 0 0 0 255)))))
+
+  ;; ── game-run! helpers ─────────────────────────────────────────────────────
+
+  (define (collect-sdl-events)
+    (sdl2:pump-events!)
+    (let collect ((lst '()))
+      (if (not (sdl2:has-events?))
+          (reverse lst)
+          (let ((e (sdl2:make-event)))
+            (sdl2:poll-event! e)
+            (collect (cons e lst))))))
+
+  (define (resolve-hooks game)
+    (let* ((active (game-active-state game))
+           (state  (and active
+                        (hash-table-ref/default (game-states game) active #f))))
+      (values (or (and state (state-hook state #:update)) (game-update-hook game))
+              (or (and state (state-hook state #:render)) (game-render-hook game)))))
+
+  (define (update-camera-follow scene game)
+    (let ((target-tag (and scene (scene-camera-target scene))))
+      (if (not target-tag)
+          scene
+          (let ((target (scene-find-tagged scene target-tag)))
+            (if (not target)
+                scene
+                (update-scene scene
+                              camera: (camera-follow (scene-camera scene)
+                                                     target
+                                                     (game-width game)
+                                                     (game-height game))))))))
+
+  (define (game-render! game render-fn)
+    (renderer-set-clear-color! (game-renderer game) (game-scene game))
+    (sdl2:render-clear! (game-renderer game))
+    (when (game-scene game)
+      (render-scene! (game-renderer game) (game-scene game)))
+    (when (and (game-debug? game) (game-scene game))
+      (render-debug-scene! (game-renderer game) (game-scene game)))
+    (when render-fn (render-fn game))
+    (sdl2:render-present! (game-renderer game)))
+
+  ;; ── game-run! ──────────────────────────────────────────────────────────────
+
+  (define (game-run! game)
+    (sdl2:set-main-ready!)
+    (sdl2:init! '(video joystick game-controller))
+    (ttf:init!)
+    (img:init! '(png))
+
+    (let init-controllers ((i 0))
+      (when (< i (sdl2:num-joysticks))
+        (when (sdl2:is-game-controller? i)
+          (sdl2:game-controller-open! i))
+        (init-controllers (+ i 1))))
+
+    (let ((scale (game-scale game)))
+      (game-window-set! game
+                        (sdl2:create-window! (game-title game) 'centered 'centered
+                                             (* (game-width game) scale)
+                                             (* (game-height game) scale) '()))
+      (game-renderer-set! game
+                          (sdl2:create-renderer! (game-window game) -1 '(accelerated)))
+      (when (> scale 1)
+        (sdl2:render-logical-size-set!
+         (game-renderer game)
+         (list (game-width game) (game-height game)))))
+
+    (when (game-preload-hook game) ((game-preload-hook game) game))
+    (when (game-create-hook game) ((game-create-hook game) game))
+
+    (let loop ((last-ticks (sdl2:get-ticks)))
+      (let* ((now   (sdl2:get-ticks))
+             (dt    (- now last-ticks))
+             (input (input-state-update (game-input game) (collect-sdl-events)
+                                        (game-input-config game))))
+        (game-input-set! game input)
+        (unless (input-held? input 'quit)
+          (let ((scene (game-scene game)))
+            (when scene
+              (let ((eu (scene-engine-update scene)))
+                ;; engine-update dispatch:
+                ;;   #f      → run default-engine-update (implicit opt-in)
+                ;;   'none   → run no engine update at all (explicit opt-out)
+                ;;   <proc>  → run the user procedure
+                (cond
+                 ((eq? eu 'none))
+                 ((procedure? eu) (eu game dt))
+                 ((not eu) (default-engine-update game dt))
+                 (else
+                  (error "engine-update must be #f, 'none, or a procedure" eu))))))
+          (receive (update-fn render-fn) (resolve-hooks game)
+            (when update-fn (update-fn game dt))
+            (when (game-scene game)
+              (game-scene-set! game (update-camera-follow (game-scene game) game)))
+            (game-render! game render-fn))
+          (sdl2:delay! (game-frame-delay game))
+          (loop now))))
+
+    (sdl2:destroy-window! (game-window game))
+    (sdl2:quit!))
+
+  ) ;; end module