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

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

  (defstruct tile
    id
    rect)

  (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)))
				    (match tag
				      ("tileset" (set! tileset (alist->tileset symbol-attrs)))
				      ("image" (tileset-image-source-set! tileset (alist-ref 'source symbol-attrs)))
				      (_ #f)))
				  (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 '())
	  (object '()))
      (expat:set-start-handler!
       parser
       (lambda (tag attrs)
	 (let ((symbol-attrs (string-alist->alist attrs)))
	   (match 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)))
	     ("tileset"
	      (tilemap-tileset-source-set! tilemap (alist-ref 'source symbol-attrs)))
	     ("layer"
	      (set! layer (alist->layer attrs)))
	     ("object"
	      (set! object (alist->object symbol-attrs)))
	     ("property"
	      (object-properties-set!
	       object
	       (cons (cons (alist-ref 'name symbol-attrs) (alist-ref 'value symbol-attrs))
		     (or (object-properties object) '()))))
	     (_ #f))
	   (set! tags (cons tag tags)))))
      (expat:set-end-handler!
       parser
       (lambda (tag)
	 (match tag
	   ("layer" (begin
		      (tilemap-layers-set! tilemap
					   (cons layer (tilemap-layers tilemap)))
		      (set! layer '())))
	   ("object" (tilemap-objects-set! tilemap (cons object (tilemap-objects tilemap))))
	   (_ #f))
	 (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 (tileset-rows tileset)
    "Return the number of rows in the tileset"
    (inexact->exact (ceiling (/ (tileset-tilecount tileset) (tileset-columns tileset)))))

  (define (tileset-tile tileset tile-id)
    ;; Use the tileset's columns setting and the tileheight/tilewidth to
    ;; find the tile's x,y location and create a rect
    (let* ((tile-num (- tile-id 1))	; tile-id starts at 1!
	   (tile-width (tileset-tilewidth tileset))
	   (tile-height (tileset-tileheight tileset))
	   (tile-x (modulo tile-num (tileset-columns tileset)))
	   (tile-y (inexact->exact (floor (/ tile-num (tileset-columns tileset)))))
	   (x (+ (* tile-x tile-width) tile-x))
	   (y (+ (* tile-y tile-height) tile-y)))
      (make-tile
       id: tile-id
       rect: (sdl2:make-rect x y tile-width tile-height))))

  (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