(module tilemap
*
(import scheme
	(chicken io)
	(chicken base)
	(chicken string)
	(chicken format)
	(chicken process-context)
	(chicken pathname)
	(chicken pretty-print)
	(srfi 1)
	expat
	defstruct
	(prefix sdl2-image "img:"))

(defstruct tileset
  tilewidth
  tileheight
  spacing
  tilecount
  columns
  image-source
  image)

(defstruct layer
  name
  width
  height
  map)

(defstruct object
  name
  type
  x
  y
  width
  height
  properties)

(defstruct tilemap
  width
  height
  tilewidth
  tileheight
  tileset-source
  tileset
  layers
  objects)

(define (maybe-do action)
  (lambda (value)
    (if (eq? value #f)
	#f
	(action value))))

(define (attempt action)
  (lambda (value)
    (or (action value) value)))

(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-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)))
				  (cond ((string=? tag "tileset")
					 (set! tileset (alist->tileset symbol-attrs)))
					((string=? tag "image")
					 (tileset-image-source-set! tileset (alist-ref 'source symbol-attrs)))))
				(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 (parse-tilemap string-tilemap)
  (let ((parser (expat:make-parser))
	(tags '())
	(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")
					 (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-source-set! tilemap (alist-ref 'source symbol-attrs)))
					((string=? tag "layer")
					 (set! layer (alist->layer attrs)))
					((string=? tag "object")
					 (tilemap-objects-set! tilemap (cons (alist->object symbol-attrs)
									     (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)
      (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

  (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)))

  (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'>
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'/>
  <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>
"))
    (tilemap-tileset (parse-tilemap txt)))

  (tileset-image (tilemap-tileset (load-tilemap "assets/level-0.tmx")))
  )



) ;; End tilemap module