(module tilemap
*
(import scheme
	(chicken io)
	(chicken base)
	(chicken pretty-print)
	(srfi 1)
	expat
	defstruct)

(defstruct tileset
  tilewidth
  tileheight
  spacing
  tilecount
  columns
  image)

(defstruct layer
  name
  width
  height
  map)

(defstruct object
  name
  type
  x
  y
  width
  height
  properties)

(defstruct tilemap
  width
  height
  tilewidth
  tileheight
  tileset
  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))
	(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: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