Progress on tilemap parser

2 files changed, 50 insertions, 31 deletions

diff --git a/src/game.scm b/src/game.scm
index a7f1695..d1e38f0 100644
--- a/src/game.scm
+++ b/src/game.scm
@@ -8,7 +8,8 @@
 	miscmacros
 	(prefix sdl2 "sdl2:")
         (prefix sdl2-ttf "ttf:")
-	(prefix sdl2-image "img:"))
+	(prefix sdl2-image "img:")
+	tilemap)
 
 (define +color-depth+ 32)
 (define +screen-width+ 600)
@@ -49,6 +50,9 @@
 (define *joystick* (if (> (sdl2:num-joysticks) 0)
 		       (sdl2:joystick-open! 0)
 		       #f))
+(define *level* (load-tilemap "assets/level-0.tmx"))
+
+(define (draw-tile target tileset tile-id))
 
 (set! (sdl2:render-draw-color *renderer*) +background-color+)
 (sdl2:render-clear! *renderer*)
diff --git a/src/tilemap.scm b/src/tilemap.scm
index 297777b..49c98e2 100644
--- a/src/tilemap.scm
+++ b/src/tilemap.scm
@@ -3,6 +3,7 @@
 (import scheme
 	(chicken io)
 	(chicken base)
+	(chicken string)
 	(chicken pretty-print)
 	(srfi 1)
 	expat
@@ -40,62 +41,78 @@
   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 (attempt action)
+  (lambda (value)
+    (or (action value) value)))
 
-(define (alist-ref-number key alist)
-  (maybe-string->number (alist-ref key alist)))
+(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 (parse-tilemap string-tilemap)
   (let ((parser (expat:make-parser))
 	(tags '())
-	(tilemap (make-tilemap 0 0 0 0 '() '() '())))
+	(tilemap (make-tilemap 0 0 0 0 '() '() '()))
+	(layer '()))
     (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)))
+					 (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)))
 					((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))))
+					 (set! layer (alist->layer attrs)))
 					((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))
+									     (tilemap-objects tilemap)))))
+				  (set! tags (cons tag tags)))))
+    (expat:set-end-handler! parser (lambda (tag)
+				     (when (string=? tag "layer")
+				       (tilemap-layers-set! tilemap
+							    (cons layer (tilemap-layers tilemap)))
+				       (set! layer '()))
+				     (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 (load-tilemap file-name)
   (call-with-input-file file-name
     (lambda (port)
-      (parse-tilemap (read-string port)))))
-
+      (parse-tilemap (read-string port))
+      ;; TODO: Open and parse the tileset
+      )))
 
 (when #f
-  ;; Demo block
-  
-  (let ((the-map (parse-tilemap "<?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'>
-  <data encoding='csv'>foobar</data>
+  <data encoding='csv'>
+0,0,0,0,168,169,0,0,0,0,
+844,0,0,0,0,0,845,546,546,546,
+</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'/>
@@ -107,12 +124,10 @@
   <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
+"))
+    (tileset-source (tilemap-tileset (parse-tilemap txt))))
+  
   )
 
 ) ;; End tilemap module
 
-