From ebd552879fa4dcfac14db0eb985b46b041bffa99 Mon Sep 17 00:00:00 2001
From: Gene Pasquet <dev@etenil.net>
Date: Sun, 22 Jun 2025 21:10:06 +0100
Subject: Initialise gamepad, load tilemaps

---
 src/game.scm    | 10 +++++---
 src/tilemap.scm | 74 +++++++++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 76 insertions(+), 8 deletions(-)

(limited to 'src')

diff --git a/src/game.scm b/src/game.scm
index 28211e9..a7f1695 100644
--- a/src/game.scm
+++ b/src/game.scm
@@ -19,7 +19,7 @@
 (define +vsync?+ (member "--vsync" (command-line-arguments)))
 
 (sdl2:set-main-ready!)
-(sdl2:init! '(video))
+(sdl2:init! '(video joystick))
 (ttf:init!)
 (img:init! '(png))
 
@@ -45,6 +45,10 @@
 
 (define *font* (ttf:open-font "DejaVuSans.ttf" 12))
 (define *text-color* (sdl2:make-color 255 255 255))
+(pp (sdl2:num-joysticks))
+(define *joystick* (if (> (sdl2:num-joysticks) 0)
+		       (sdl2:joystick-open! 0)
+		       #f))
 
 (set! (sdl2:render-draw-color *renderer*) +background-color+)
 (sdl2:render-clear! *renderer*)
@@ -67,7 +71,7 @@
 
 	  (sdl2:delay! 10)))
 
-(format #t "chicken env: ~a" (get-environment-variable "CHICKEN_ENV"))
+(sdl2:joystick-close *joystick*)
 
-(format #t "hello world")
+(format #t "Bye!\n")
 
diff --git a/src/tilemap.scm b/src/tilemap.scm
index a2833db..297777b 100644
--- a/src/tilemap.scm
+++ b/src/tilemap.scm
@@ -2,6 +2,9 @@
 *
 (import scheme
 	(chicken io)
+	(chicken base)
+	(chicken pretty-print)
+	(srfi 1)
 	expat
 	defstruct)
 
@@ -37,18 +40,79 @@
   layers
   objects)
 
+(define (string-alist->alist string-alist)
+  (map (lambda (pair) (cons (string->symbol (car pair))
+		       (cdr pair)))
+       string-alist))
+
+(define (maybe-do action)
+  (lambda (value)
+    (if (eq? value #f)
+	#f
+	(action value))))
+
+(define maybe-string->number (maybe-do string->number))
+
+(define (alist-ref-number key alist)
+  (maybe-string->number (alist-ref key alist)))
+
 (define (parse-tilemap string-tilemap)
   (let ((parser (expat:make-parser))
-	(current-tag "")
-	(tilemap (tilemap)))
-    (expat:set-start-handler! parser (lambda (tag attrs)
-				       (set! current-tag tag)))
+	(tags '())
+	(tilemap (make-tilemap 0 0 0 0 '() '() '())))
+    (expat:set-start-handler! parser
+			      (lambda (tag attrs)
+				(let ((symbol-attrs (string-alist->alist attrs)))
+				  (cond ((string=? tag "map")
+					 (pp symbol-attrs)
+					 (tilemap-width-set! tilemap (alist-ref-number 'width symbol-attrs))
+					 (tilemap-height-set! tilemap (alist-ref-number 'height symbol-attrs))
+					 (tilemap-tilewidth-set! tilemap (alist-ref-number 'tilewidth symbol-attrs))
+					 (tilemap-tileheight-set! tilemap (alist-ref-number 'tileheight symbol-attrs)))
+					((string=? tag "tileset")
+					 (tilemap-tileset-set! tilemap (alist->tileset symbol-attrs)))
+					((string=? tag "layer")
+					 (tilemap-layers-set! tilemap (cons (alist->layer symbol-attrs)
+									    (tilemap-layers tilemap))))
+					((string=? tag "object")
+					 (tilemap-objects-set! tilemap (cons (alist->object symbol-attrs)
+									     (tilemap-objects tilemap))))))))
     (expat:set-end-handler! parser (lambda (tag) #f))
-    (expat:set-character-data-handler! parser (lambda (text) #f))))
+    (expat:set-character-data-handler! parser (lambda (text) #f))
+    (expat:parse parser string-tilemap)
+    tilemap))
 
 (define (load-tilemap file-name)
   (call-with-input-file file-name
     (lambda (port)
       (parse-tilemap (read-string port)))))
 
+
+(when #f
+  ;; Demo block
+  
+  (let ((the-map (parse-tilemap "<?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'>
+  <data encoding='csv'>foobar</data>
+ </layer>
+ <objectgroup id='7' name='entities'>
+  <object id='2' name='player' type='Player' gid='29' x='182' y='350.5' width='16' height='16'/>
+  <object id='3' name='hint' type='Text' x='98.5' y='432.5' width='197' height='78'>
+   <properties>
+    <property name='text' value='hit enter to start a macro'/>
+   </properties>
+  </object>
+  <object id='4' name='goal' type='Goal' x='560.935' y='288.641' width='16' height='16'/>
+ </objectgroup>
+</map>
+")))
+    (layer-name (car (tilemap-layers the-map))) )
+
+  ;; End demo block
+  )
+
 ) ;; End tilemap module
+
+
-- 
cgit v1.2.3