Re-format

1 files changed, 105 insertions, 105 deletions

diff --git a/world.scm b/world.scm
index c913663..8f24444 100644
--- a/world.scm
+++ b/world.scm
@@ -1,121 +1,121 @@
 (module (downstroke world)
-*
-(import scheme
-	    (chicken base)
-	    (only srfi-1 fold filter)
-	    defstruct
-	    (downstroke tilemap)
-	    (downstroke entity))
-;; Scene = current level: tilemap (layers, objects) + list of entities.
+    *
+  (import scheme
+	      (chicken base)
+	      (only srfi-1 fold filter)
+	      defstruct
+	      (downstroke tilemap)
+	      (downstroke entity))
+  ;; Scene = current level: tilemap (layers, objects) + list of entities.
 
-;; Returns tile-id if the cell at (col, row) in this layer is non-zero, #f otherwise.
-(define (layer-tile-at layer col row)
-  (let ((rows (layer-map layer)))
-    (and (< row (length rows))
-         (let ((row-data (list-ref rows row)))
-           (and (< col (length row-data))
-                (let ((tile-id (list-ref row-data col)))
-                  (and (not (zero? tile-id)) tile-id)))))))
+  ;; Returns tile-id if the cell at (col, row) in this layer is non-zero, #f otherwise.
+  (define (layer-tile-at layer col row)
+    (let ((rows (layer-map layer)))
+      (and (< row (length rows))
+           (let ((row-data (list-ref rows row)))
+             (and (< col (length row-data))
+                  (let ((tile-id (list-ref row-data col)))
+                    (and (not (zero? tile-id)) tile-id)))))))
 
-(define (tilemap-tile-at tilemap col row)
-  "Get the tile ID at grid position (col, row).
+  (define (tilemap-tile-at tilemap col row)
+    "Get the tile ID at grid position (col, row).
      Returns 0 if out of bounds or if all layers have 0 at that cell."
-  (let ((width  (tilemap-width  tilemap))
-        (height (tilemap-height tilemap)))
-    (if (or (< col 0) (>= col width) (< row 0) (>= row height))
-        0
-        (let loop ((layers (tilemap-layers tilemap)))
-          (if (null? layers)
-              0
-              (or (layer-tile-at (car layers) col row)
-                  (loop (cdr layers))))))))
+    (let ((width  (tilemap-width  tilemap))
+          (height (tilemap-height tilemap)))
+      (if (or (< col 0) (>= col width) (< row 0) (>= row height))
+          0
+          (let loop ((layers (tilemap-layers tilemap)))
+            (if (null? layers)
+                0
+                (or (layer-tile-at (car layers) col row)
+                    (loop (cdr layers))))))))
 
-(defstruct camera x y)
+  (defstruct camera x y)
 
-(defstruct scene
-  entities
-  tilemap
-  tileset           ; optional tileset struct when ~tilemap~ is ~#f~ (see renderer)
-  camera
-  tileset-texture
-  camera-target     ; symbol tag or #f
-  background        ; #f or (r g b) / (r g b a) for framebuffer clear
-  engine-update)    ; #f = inherit from game, procedure = per-scene override
+  (defstruct scene
+    entities
+    tilemap
+    tileset           ; optional tileset struct when ~tilemap~ is ~#f~ (see renderer)
+    camera
+    tileset-texture
+    camera-target     ; symbol tag or #f
+    background        ; #f or (r g b) / (r g b a) for framebuffer clear
+    engine-update)    ; #f = inherit from game, procedure = per-scene override
 
-(define (scene-add-entity scene entity)
-  (update-scene scene
-                entities: (append (scene-entities scene) (list entity))))
+  (define (scene-add-entity scene entity)
+    (update-scene scene
+                  entities: (append (scene-entities scene) (list entity))))
 
-(define (scene-map-entities scene . procs)
-  "Apply each proc in sequence to the scene's entities; returns a new scene."
-  (update-scene scene
-                entities: (fold
-		                   (lambda (proc es)
-		                     (map (cut proc scene <>) es))
-                           (scene-entities scene)
-                           procs)))
+  (define (scene-map-entities scene . procs)
+    "Apply each proc in sequence to the scene's entities; returns a new scene."
+    (update-scene scene
+                  entities: (fold
+		                     (lambda (proc es)
+		                       (map (cut proc scene <>) es))
+                             (scene-entities scene)
+                             procs)))
 
-(define (scene-filter-entities scene pred)
-  "Keep only entities satisfying pred; returns a new scene."
-  (update-scene scene
-                entities: (filter pred (scene-entities scene))))
+  (define (scene-filter-entities scene pred)
+    "Keep only entities satisfying pred; returns a new scene."
+    (update-scene scene
+                  entities: (filter pred (scene-entities scene))))
 
-(define (scene-transform-entities scene proc)
-  "Apply proc to the full entity list (entities → entities); returns a new scene."
-  (update-scene scene
-                entities: (proc (scene-entities scene))))
+  (define (scene-transform-entities scene proc)
+    "Apply proc to the full entity list (entities → entities); returns a new scene."
+    (update-scene scene
+                  entities: (proc (scene-entities scene))))
 
-;; Center camera on entity. Clamps to >= 0 on both axes.
-;; Returns a new camera struct.
-(define (camera-follow camera entity viewport-w viewport-h)
-  (let* ((entity-x (entity-ref entity #:x 0))
-         (entity-y (entity-ref entity #:y 0)))
-    (update-camera camera
-                   x: (inexact->exact (floor (max 0 (- entity-x (/ viewport-w 2)))))
-                   y: (inexact->exact (floor (max 0 (- entity-y (/ viewport-h 2))))))))
+  ;; Center camera on entity. Clamps to >= 0 on both axes.
+  ;; Returns a new camera struct.
+  (define (camera-follow camera entity viewport-w viewport-h)
+    (let* ((entity-x (entity-ref entity #:x 0))
+           (entity-y (entity-ref entity #:y 0)))
+      (update-camera camera
+                     x: (inexact->exact (floor (max 0 (- entity-x (/ viewport-w 2)))))
+                     y: (inexact->exact (floor (max 0 (- entity-y (/ viewport-h 2))))))))
 
-;; Returns the first entity in scene whose #:tags list contains tag, or #f.
-(define (scene-find-tagged scene tag)
-  (let loop ((entities (scene-entities scene)))
-    (cond
-     ((null? entities) #f)
-     ((member tag (entity-ref (car entities) #:tags '())) (car entities))
-     (else (loop (cdr entities))))))
+  ;; Returns the first entity in scene whose #:tags list contains tag, or #f.
+  (define (scene-find-tagged scene tag)
+    (let loop ((entities (scene-entities scene)))
+      (cond
+       ((null? entities) #f)
+       ((member tag (entity-ref (car entities) #:tags '())) (car entities))
+       (else (loop (cdr entities))))))
 
-;; Returns all entities in scene whose #:tags list contains tag.
-(define (scene-find-all-tagged scene tag)
-  (filter (lambda (e) (member tag (entity-ref e #:tags '())))
-          (scene-entities scene)))
+  ;; Returns all entities in scene whose #:tags list contains tag.
+  (define (scene-find-all-tagged scene tag)
+    (filter (lambda (e) (member tag (entity-ref e #:tags '())))
+            (scene-entities scene)))
 
-;; First wins: one origin entity per #:group-id (for lookup).
-(define (group-origin-alist entities)
-  (let loop ((es entities) (acc '()))
-    (if (null? es)
-        acc
-        (let ((e (car es)))
-          (if (and (entity-ref e #:group-origin? #f)
-                   (entity-ref e #:group-id #f))
-              (let ((gid (entity-ref e #:group-id)))
-                (if (assq gid acc)
-                    (loop (cdr es) acc)
-                    (loop (cdr es) (cons (cons gid e) acc))))
-              (loop (cdr es) acc))))))
+  ;; First wins: one origin entity per #:group-id (for lookup).
+  (define (group-origin-alist entities)
+    (let loop ((es entities) (acc '()))
+      (if (null? es)
+          acc
+          (let ((e (car es)))
+            (if (and (entity-ref e #:group-origin? #f)
+                     (entity-ref e #:group-id #f))
+                (let ((gid (entity-ref e #:group-id)))
+                  (if (assq gid acc)
+                      (loop (cdr es) acc)
+                      (loop (cdr es) (cons (cons gid e) acc))))
+                (loop (cdr es) acc))))))
 
-(define (sync-member-to-origin e origins)
-  (let* ((gid (entity-ref e #:group-id #f))
-         (o   (and gid (not (entity-ref e #:group-origin? #f))
-                   (assq gid origins))))
-    (if o
-        (let ((origin (cdr o)))
-          (entity-set (entity-set e #:x (+ (entity-ref origin #:x 0)
-                                           (entity-ref e #:group-local-x 0)))
-                      #:y (+ (entity-ref origin #:y 0)
-                             (entity-ref e #:group-local-y 0))))
-        e)))
+  (define (sync-member-to-origin e origins)
+    (let* ((gid (entity-ref e #:group-id #f))
+           (o   (and gid (not (entity-ref e #:group-origin? #f))
+                     (assq gid origins))))
+      (if o
+          (let ((origin (cdr o)))
+            (entity-set (entity-set e #:x (+ (entity-ref origin #:x 0)
+                                             (entity-ref e #:group-local-x 0)))
+                        #:y (+ (entity-ref origin #:y 0)
+                               (entity-ref e #:group-local-y 0))))
+          e)))
 
-;; Snap member #:x/#:y to origin + #:group-local-x/y.
-;; Pure entities → entities function; use with scene-transform-entities.
-(define (sync-groups entities)
-  (let ((origins (group-origin-alist entities)))
-    (map (cut sync-member-to-origin <> origins) entities)))
-)
+  ;; Snap member #:x/#:y to origin + #:group-local-x/y.
+  ;; Pure entities → entities function; use with scene-transform-entities.
+  (define (sync-groups entities)
+    (let ((origins (group-origin-alist entities)))
+      (map (cut sync-member-to-origin <> origins) entities)))
+  )