diff options
Diffstat (limited to 'src/tilemap.scm')
| -rw-r--r-- | src/tilemap.scm | 74 |
1 files changed, 69 insertions, 5 deletions
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 + + |