From 38eee24832fe6da4f135cae455881ab97953b23a Mon Sep 17 00:00:00 2001
From: Gene Pasquet <dev@etenil.net>
Date: Sat, 18 Apr 2026 02:47:10 +0100
Subject: Refresh docs and re-indent

---
 tilemap.scm | 425 ++++++++++++++++++++++++++++++------------------------------
 1 file changed, 213 insertions(+), 212 deletions(-)

(limited to 'tilemap.scm')

diff --git a/tilemap.scm b/tilemap.scm
index 0335cc3..00b0508 100644
--- a/tilemap.scm
+++ b/tilemap.scm
@@ -1,242 +1,243 @@
 (module downstroke-tilemap
-    *
-  (import scheme
-	  (chicken io)
-	  (chicken base)
-	  (chicken string)
-	  (chicken format)
-	  (chicken process-context)
-	  (chicken pathname)
-	  (chicken pretty-print)
-	  (srfi 1)
-	  matchable
-	  expat
-	  defstruct
-	  (prefix sdl2-image "img:")
-	  (prefix sdl2 "sdl2:"))
+*
+(import scheme
+	    (chicken io)
+	    (chicken base)
+	    (chicken string)
+	    (chicken format)
+	    (chicken process-context)
+	    (chicken pathname)
+	    (chicken pretty-print)
+	    (srfi 1)
+	    matchable
+	    expat
+	    defstruct
+	    (prefix sdl2-image "img:")
+	    (prefix sdl2 "sdl2:"))
 
 (+ 1 1)
 
-  (defstruct tileset
-    tilewidth
-    tileheight
-    spacing
-    tilecount
-    columns
-    image-source
-    image)
+(defstruct tileset
+  tilewidth
+  tileheight
+  spacing
+  tilecount
+  columns
+  image-source
+  image)
 
-  (+ 1 1)
+(+ 1 1)
 
-  (defstruct layer
-    name
-    width
-    height
-    map)
+(defstruct layer
+  name
+  width
+  height
+  map)
 
-  (defstruct object
-    name
-    type
-    x
-    y
-    width
-    height
-    properties)
+(defstruct object
+  name
+  type
+  x
+  y
+  width
+  height
+  properties)
 
-  (defstruct tilemap
-    width
-    height
-    tilewidth
-    tileheight
-    tileset-source
-    tileset
-    layers
-    objects)
+(defstruct tilemap
+  width
+  height
+  tilewidth
+  tileheight
+  tileset-source
+  tileset
+  layers
+  objects)
 
-  (defstruct tile
-    id
-    rect)
+(defstruct tile
+  id
+  rect)
 
-  (define (maybe-do action)
-    (lambda (value)
-      (if (eq? value #f)
-	  #f
-	  (action value))))
+(define (maybe-do action)
+  (lambda (value)
+    (if (eq? value #f)
+	    #f
+	    (action value))))
 
-  (define (attempt action)
-    (lambda (value)
-      (or (action value) value)))
+(define (attempt action)
+  (lambda (value)
+    (or (action value) value)))
 
-  (define maybe-string->number (maybe-do (attempt string->number)))
+(define maybe-string->number (maybe-do (attempt string->number)))
 
-  (define (string-alist->alist string-alist)
-    (map (lambda (pair) (cons (string->symbol (car pair))
-			      (maybe-string->number (cdr pair))))
-	 string-alist))
+(define (string-alist->alist string-alist)
+  (map (lambda (pair) (cons (string->symbol (car pair))
+			                (maybe-string->number (cdr pair))))
+	   string-alist))
 
-  (define (alist->tileset attrs)
-    (make-tileset
-      tilewidth: (alist-ref 'tilewidth attrs eq?)
-      tileheight: (alist-ref 'tileheight attrs eq?)
-      spacing: (alist-ref 'spacing attrs eq? 0)
-      tilecount: (alist-ref 'tilecount attrs eq?)
-      columns: (alist-ref 'columns attrs eq?)
-      image-source: ""
-      image: #f))
+(define (alist->tileset attrs)
+  (make-tileset
+   tilewidth: (alist-ref 'tilewidth attrs eq?)
+   tileheight: (alist-ref 'tileheight attrs eq?)
+   spacing: (alist-ref 'spacing attrs eq? 0)
+   tilecount: (alist-ref 'tilecount attrs eq?)
+   columns: (alist-ref 'columns attrs eq?)
+   image-source: ""
+   image: #f))
 
-  (define (alist->layer attrs)
-    (let ((symbol-attrs (string-alist->alist attrs)))
-      (make-layer
-        name: (alist-ref 'name symbol-attrs eq?)
-        width: (alist-ref 'width symbol-attrs eq?)
-        height: (alist-ref 'height symbol-attrs eq?)
-        map: '())))
+(define (alist->layer attrs)
+  (let ((symbol-attrs (string-alist->alist attrs)))
+    (make-layer
+     name: (alist-ref 'name symbol-attrs eq?)
+     width: (alist-ref 'width symbol-attrs eq?)
+     height: (alist-ref 'height symbol-attrs eq?)
+     map: '())))
 
-  (define (alist->object attrs)
-    (make-object
-      name: (alist-ref 'name attrs eq?)
-      type: (alist-ref 'type attrs eq?)
-      x: (alist-ref 'x attrs eq?)
-      y: (alist-ref 'y attrs eq?)
-      width: (alist-ref 'width attrs eq? 0)
-      height: (alist-ref 'height attrs eq? 0)
-      properties: '()))
+(define (alist->object attrs)
+  (make-object
+   name: (alist-ref 'name attrs eq?)
+   type: (alist-ref 'type attrs eq?)
+   x: (alist-ref 'x attrs eq?)
+   y: (alist-ref 'y attrs eq?)
+   width: (alist-ref 'width attrs eq? 0)
+   height: (alist-ref 'height attrs eq? 0)
+   properties: '()))
 
-  (define (parse-tileset string-tileset)
-    (let ((parser (expat:make-parser))
-	  (tags '())
-	  (tileset (make-tileset 0 0 0 0 0 "")))
-      (expat:set-start-handler! parser
-				(lambda (tag attrs)
-				  (let ((symbol-attrs (string-alist->alist attrs)))
-				    (match tag
-				      ("tileset" (set! tileset (alist->tileset symbol-attrs)))
-				      ("image" (tileset-image-source-set! tileset (alist-ref 'source symbol-attrs)))
-				      (_ #f)))
-				  (set! tags (cons tag tags))))
-      (expat:set-end-handler! parser (lambda (tag)
-				       (set! tags (cdr tags))))
-      (expat:set-character-data-handler! parser (lambda (line) #f))
-      (expat:parse parser string-tileset)
-      tileset))
+(define (parse-tileset string-tileset)
+  (let ((parser (expat:make-parser))
+	    (tags '())
+	    (tileset (make-tileset 0 0 0 0 0 "")))
+    (expat:set-start-handler! parser
+				              (lambda (tag attrs)
+				                (let ((symbol-attrs (string-alist->alist attrs)))
+				                  (match tag
+				                    ("tileset" (set! tileset (alist->tileset symbol-attrs)))
+				                    ("image" (tileset-image-source-set! tileset (alist-ref 'source symbol-attrs)))
+				                    (_ #f)))
+				                (set! tags (cons tag tags))))
+    (expat:set-end-handler! parser (lambda (tag)
+				                     (set! tags (cdr tags))))
+    (expat:set-character-data-handler! parser (lambda (line) #f))
+    (expat:parse parser string-tileset)
+    tileset))
 
-  (define (load-tileset file-name)
-    (call-with-input-file file-name
-      (lambda (port)
-	(let* ((tileset (parse-tileset (read-string #f port)))
-	       (image-source (tileset-image-source tileset))
-	       (base-path (pathname-directory file-name))
-	       (img-to-load (if (absolute-pathname? image-source)
-				image-source
-				(pathname-replace-directory
-				 image-source
-				 (if (pathname-directory image-source)
-				     (format "~a/~a" base-path (pathname-directory image-source))
-				     base-path)))))
-	  (tileset-image-set! tileset (img:load img-to-load))
-	  tileset))))
+(define (load-tileset file-name)
+  (call-with-input-file file-name
+    (lambda (port)
+	  (let* ((tileset (parse-tileset (read-string #f port)))
+	         (image-source (tileset-image-source tileset))
+	         (base-path (pathname-directory file-name))
+	         (img-to-load (if (absolute-pathname? image-source)
+				              image-source
+				              (pathname-replace-directory
+				               image-source
+				               (if (pathname-directory image-source)
+				                   (format "~a/~a" base-path (pathname-directory image-source))
+				                   base-path)))))
+	    (tileset-image-set! tileset (img:load img-to-load))
+	    tileset))))
 
-  (define (parse-tilemap string-tilemap)
-    (let ((parser (expat:make-parser))
-	  (tags '())
-	  (tilemap (make-tilemap width: 0 height: 0 tilewidth: 0 tileheight: 0
-				 tileset-source: "" tileset: #f
-				 layers: '() objects: '()))
-	  (layer '())
-	  (object '()))
-      (expat:set-start-handler!
-       parser
-       (lambda (tag attrs)
-	 (let ((symbol-attrs (string-alist->alist attrs)))
+(define (parse-tilemap string-tilemap)
+  (let ((parser (expat:make-parser))
+	    (tags '())
+	    (tilemap (make-tilemap width: 0 height: 0 tilewidth: 0 tileheight: 0
+				               tileset-source: "" tileset: #f
+				               layers: '() objects: '()))
+	    (layer '())
+	    (object '()))
+    (expat:set-start-handler!
+     parser
+     (lambda (tag attrs)
+	   (let ((symbol-attrs (string-alist->alist attrs)))
+	     (match tag
+	       ("map"
+	        (tilemap-width-set! tilemap (alist-ref 'width symbol-attrs))
+	        (tilemap-height-set! tilemap (alist-ref 'height symbol-attrs))
+	        (tilemap-tilewidth-set! tilemap (alist-ref 'tilewidth symbol-attrs))
+	        (tilemap-tileheight-set! tilemap (alist-ref 'tileheight symbol-attrs)))
+	       ("tileset"
+	        (tilemap-tileset-source-set! tilemap (alist-ref 'source symbol-attrs)))
+	       ("layer"
+	        (set! layer (alist->layer attrs)))
+	       ("object"
+	        (set! object (alist->object symbol-attrs)))
+	       ("property"
+	        (object-properties-set!
+	         object
+	         (cons (cons (string->symbol (alist-ref "name" attrs string=?))
+			             (alist-ref "value" attrs string=?))
+		           (or (object-properties object) '()))))
+	       (_ #f))
+	     (set! tags (cons tag tags)))))
+    (expat:set-end-handler!
+     parser
+     (lambda (tag)
 	   (match tag
-	     ("map"
-	      (tilemap-width-set! tilemap (alist-ref 'width symbol-attrs))
-	      (tilemap-height-set! tilemap (alist-ref 'height symbol-attrs))
-	      (tilemap-tilewidth-set! tilemap (alist-ref 'tilewidth symbol-attrs))
-	      (tilemap-tileheight-set! tilemap (alist-ref 'tileheight symbol-attrs)))
-	     ("tileset"
-	      (tilemap-tileset-source-set! tilemap (alist-ref 'source symbol-attrs)))
-	     ("layer"
-	      (set! layer (alist->layer attrs)))
-	     ("object"
-	      (set! object (alist->object symbol-attrs)))
-	     ("property"
-	      (object-properties-set!
-	       object
-	       (cons (cons (string->symbol (alist-ref "name" attrs string=?))
-			  (alist-ref "value" attrs string=?))
-		     (or (object-properties object) '()))))
+	     ("layer" (begin
+		            (tilemap-layers-set! tilemap
+					                     (cons layer (tilemap-layers tilemap)))
+		            (set! layer '())))
+	     ("object" (tilemap-objects-set! tilemap (cons object (tilemap-objects tilemap))))
 	     (_ #f))
-	   (set! tags (cons tag tags)))))
-      (expat:set-end-handler!
-       parser
-       (lambda (tag)
-	 (match tag
-	   ("layer" (begin
-		      (tilemap-layers-set! tilemap
-					   (cons layer (tilemap-layers tilemap)))
-		      (set! layer '())))
-	   ("object" (tilemap-objects-set! tilemap (cons object (tilemap-objects tilemap))))
-	   (_ #f))
-	 (set! tags (cdr tags))))
-      (expat:set-character-data-handler!
-       parser
-       (lambda (line)
-	 (when (string=? (car tags) "data")
-	   (let ((txt (string-chomp line)))
-	     (when (not (string=? txt ""))
-	       (layer-map-set! layer (append
-				      (or (layer-map layer) '())
-				      (list (map string->number
-						 (string-split txt ","))))))))))
-      (expat:parse parser string-tilemap)
-      tilemap))
+	   (set! tags (cdr tags))))
+    (expat:set-character-data-handler!
+     parser
+     (lambda (line)
+	   (when (string=? (car tags) "data")
+	     (let ((txt (string-chomp line)))
+	       (when (not (string=? txt ""))
+	         (layer-map-set! layer (append
+				                    (or (layer-map layer) '())
+				                    (list (map string->number
+						                       (string-split txt ","))))))))))
+    (expat:parse parser string-tilemap)
+    tilemap))
 
-  (define (tileset-rows tileset)
-    "Return the number of rows in the tileset"
-    (inexact->exact (ceiling (/ (tileset-tilecount tileset) (tileset-columns tileset)))))
+(define (tileset-rows tileset)
+  "Return the number of rows in the tileset"
+  (inexact->exact (ceiling (/ (tileset-tilecount tileset) (tileset-columns tileset)))))
 
-  (define (tileset-tile tileset tile-id)
-    ;; Use the tileset's columns setting and the tileheight/tilewidth to
-    ;; find the tile's x,y location and create a rect
-    (let* ((tile-num (- tile-id 1))	; tile-id starts at 1!
-	   (tile-width (tileset-tilewidth tileset))
-	   (tile-height (tileset-tileheight tileset))
-	   (tile-x (modulo tile-num (tileset-columns tileset)))
-	   (tile-y (inexact->exact (floor (/ tile-num (tileset-columns tileset)))))
-	   (x (+ (* tile-x tile-width) tile-x))
-	   (y (+ (* tile-y tile-height) tile-y)))
-      (make-tile
-       id: tile-id
-       rect: (sdl2:make-rect x y tile-width tile-height))))
+(define (tileset-tile tileset tile-id)
+  ;; Use the tileset's columns setting and the tileheight/tilewidth to
+  ;; find the tile's x,y location and create a rect
+  (let* ((tile-num    (- tile-id 1))	; tile-id starts at 1!
+	     (tile-width  (tileset-tilewidth  tileset))
+	     (tile-height (tileset-tileheight tileset))
+	     (spacing     (or (tileset-spacing tileset) 0))
+	     (tile-x      (modulo tile-num (tileset-columns tileset)))
+	     (tile-y      (inexact->exact (floor (/ tile-num (tileset-columns tileset)))))
+	     (x           (+ (* tile-x tile-width)  (* tile-x spacing)))
+	     (y           (+ (* tile-y tile-height) (* tile-y spacing))))
+    (make-tile
+     id: tile-id
+     rect: (sdl2:make-rect x y tile-width tile-height))))
 
-  (define (load-tilemap file-name)
-    (call-with-input-file file-name
-      (lambda (port)
-	(let* ((tilemap (parse-tilemap (read-string #f port)))
-	       (base-path (pathname-directory file-name))
-	       (tileset-source (tilemap-tileset-source tilemap)))
-	  (tilemap-tileset-set! tilemap (load-tileset
-					 (if (absolute-pathname? tileset-source)
-					     tileset-source
-					     (pathname-replace-directory
-					      tileset-source
-					      (if (pathname-directory tileset-source)
-						  (format "~a/~a" base-path (pathname-directory tileset-source))
-						  base-path))
-					     )))
-	  tilemap))))
+(define (load-tilemap file-name)
+  (call-with-input-file file-name
+    (lambda (port)
+	  (let* ((tilemap (parse-tilemap (read-string #f port)))
+	         (base-path (pathname-directory file-name))
+	         (tileset-source (tilemap-tileset-source tilemap)))
+	    (tilemap-tileset-set! tilemap (load-tileset
+					                   (if (absolute-pathname? tileset-source)
+					                       tileset-source
+					                       (pathname-replace-directory
+					                        tileset-source
+					                        (if (pathname-directory tileset-source)
+						                        (format "~a/~a" base-path (pathname-directory tileset-source))
+						                        base-path))
+					                       )))
+	    tilemap))))
 
-  (when #f
+(when #f
 
-    (let ((txt "<?xml version='1.0' encoding='UTF-8'?>
+  (let ((txt "<?xml version='1.0' encoding='UTF-8'?>
 <tileset version='1.10' tiledversion='1.11.2' name='monochrome_transparent' tilewidth='16' tileheight='16' spacing='1' tilecount='1078' columns='49'>
  <image source='monochrome-transparent.png' width='832' height='373'/>
 </tileset>
 "))
-      (tileset-image (parse-tileset txt)))
+    (tileset-image (parse-tileset txt)))
 
-    (let ((txt "<?xml version='1.0' encoding='UTF-8'?>
+  (let ((txt "<?xml version='1.0' encoding='UTF-8'?>
 <map version='1.10' tiledversion='1.11.0' orientation='orthogonal' renderorder='right-down' width='40' height='30' tilewidth='16' tileheight='16' infinite='0' nextlayerid='8' nextobjectid='5'>
  <tileset firstgid='1' source='monochrome_transparent.tsx'/>
  <layer id='3' name='ground' width='40' height='30'>
@@ -256,9 +257,9 @@
  </objectgroup>
 </map>
 "))
-      (tilemap-tileset (parse-tilemap txt)))
+    (tilemap-tileset (parse-tilemap txt)))
 
-    (tileset-image (tilemap-tileset (load-tilemap "assets/level-0.tmx")))
-    )
+  (tileset-image (tilemap-tileset (load-tilemap "assets/level-0.tmx")))
+  )
 
-  ) ;; End tilemap module
+) ;; End tilemap module
-- 
cgit v1.2.3