Display objects

3 files changed, 263 insertions, 207 deletions

diff --git a/Makefile b/Makefile
index 044838e..25c0c94 100644
--- a/Makefile
+++ b/Makefile
@@ -1,13 +1,19 @@
-bin/game: bin bin/tilemap.o
-	csc -o bin/game bin/tilemap.o -uses tilemap src/game.scm
+.DEFAULT_GOAL := bin/game
 
 bin:
-	mkdir bin
+	@mkdir -p $@
 
-bin/tilemap.o: bin src/tilemap.scm
-	csc -c -J src/tilemap.scm -unit tilemap -o bin/tilemap.o
+bin/tilemap.o: src/tilemap.scm | bin
+	csc -c -J src/tilemap.scm -unit tilemap -o $@
 
-.PHONY:
+bin/game.o: src/game.scm | bin
+	csc -c src/game.scm -uses tilemap -o $@
+
+bin/game: bin/tilemap.o bin/game.o | bin
+	csc -o bin/game bin/tilemap.o bin/game.o
+
+
+.PHONY: clean
 clean:
 	rm -rf bin
 	rm -f *.import.scm game
diff --git a/src/game.scm b/src/game.scm
index 2e3f6ee..4206533 100644
--- a/src/game.scm
+++ b/src/game.scm
@@ -8,8 +8,9 @@
 	(srfi 12)
 	miscmacros
 	(prefix sdl2 "sdl2:")
-        (prefix sdl2-ttf "ttf:")
+	(prefix sdl2-ttf "ttf:")
 	(prefix sdl2-image "img:")
+	matchable
 	tilemap)
 
 (define +color-depth+ 32)
@@ -39,9 +40,9 @@
 (if (and +vsync?+ (not +software-mode?+)) ; vsync doesn't work with software rendering
     (sdl2:set-hint! 'render-vsync "1"))
 (define *window* (sdl2:create-window! "MacroKnight"
-                                      'centered 'centered
-                                      +screen-width+ +screen-height+
-                                      (if *fullscreen?* '(fullscreen) '())))
+				      'centered 'centered
+				      +screen-width+ +screen-height+
+				      (if *fullscreen?* '(fullscreen) '())))
 
 (define *renderer*
   (handle-exceptions exn
@@ -59,9 +60,9 @@
 (define *level* (load-tilemap "assets/level-0.tmx"))
 (define *level-tileset-texture* (sdl2:create-texture-from-surface *renderer* (tileset-image (tilemap-tileset *level*))))
 
-(define (draw-tile target tileset tile-id row-num col-num)
+(define (draw-tile renderer tileset tile-id row-num col-num)
   (let ((tile (tileset-tile tileset tile-id)))
-    (sdl2:render-copy! *renderer* *level-tileset-texture*
+    (sdl2:render-copy! renderer *level-tileset-texture*
 		       (tile-rect tile)
 		       (sdl2:make-rect (* col-num (tileset-tileheight tileset))
 				       (* row-num (tileset-tilewidth tileset))
@@ -75,37 +76,72 @@
 	      (iota (length (car rows))))
     (draw-tilemap-rows draw-fn (cdr rows) (+ row-num 1))))
 
-(define (draw-tilemap target tilemap)
-  (let ((map-layer (layer-map (list-ref (tilemap-layers tilemap) 0)))
+(define (draw-tilemap renderer tilemap)
+  (let ((map-layer (layer-map (car (tilemap-layers tilemap))))
 	(tileset (tilemap-tileset tilemap)))
     (draw-tilemap-rows
-     (lambda (tile-id row-num col-num) (draw-tile target tileset tile-id row-num col-num))
+     (lambda (tile-id row-num col-num) (draw-tile renderer tileset tile-id row-num col-num))
      map-layer
      0)))
 
+(define (draw-objects renderer tilemap)
+  (let ((objects (tilemap-objects tilemap))
+	(tileset (tilemap-tileset tilemap)))
+    (for-each
+     (cut draw-object renderer tileset <>)
+     objects)))
+
+(define (draw-object renderer tileset object)
+  (match (object-type object)
+    ("Player" (draw-player renderer tileset object))
+    ("Text" (draw-text renderer tileset object))
+    ("Enemy" (draw-enemy renderer tileset object))
+    (_ #f)))
+
+(define (draw-player renderer tileset object)
+  (let ((col-num (inexact->exact (floor (/ (object-x object) (tileset-tilewidth tileset)))))
+	(row-num (inexact->exact (floor (/ (object-y object) (tileset-tileheight tileset))))))
+    (draw-tile renderer tileset 29 row-num col-num)))
+
+(define (draw-text renderer tileset object)
+  (let* ((text (cdr (assoc "text" (object-properties object))))
+	 (text-texture (sdl2:create-texture-from-surface renderer
+			(ttf:render-text-solid *font* text *text-color*))))
+    (sdl2:render-copy! renderer text-texture #f (sdl2:make-rect
+						 (inexact->exact (floor (object-x object)))
+						 (inexact->exact (floor (object-y object)))
+						 (inexact->exact (floor (object-width object)))
+						 (inexact->exact (floor (object-height object)))))))
+
+(define (draw-enemy renderer tileset object)
+  (let ((col-num (inexact->exact (floor (/ (object-x object) (tileset-tilewidth tileset)))))
+	(row-num (inexact->exact (floor (/ (object-y object) (tileset-tileheight tileset))))))
+    (draw-tile renderer tileset 111 row-num col-num)))
+
 (set! (sdl2:render-draw-color *renderer*) +background-color+)
 (sdl2:render-clear! *renderer*)
 
 (let/cc exit-main-loop!
 	(while #t
 	  (set! (sdl2:render-draw-color *renderer*) +background-color+)
-          (sdl2:render-clear! *renderer*)
+	  (sdl2:render-clear! *renderer*)
 	  (sdl2:pump-events!)
 	  (while (sdl2:has-events?)
 	    (let ((event (sdl2:make-event)))
 	      (sdl2:poll-event! event)
-	      (pp event)
+	      ;; (pp event)
 	      (when (and (sdl2:keyboard-event? event)
 			 (eq? (sdl2:event-type event) 'key-down)
 			 (eq? (sdl2:keyboard-event-sym event) 'escape))
 		(exit-main-loop!))))
 
 	  (draw-tilemap *renderer* *level*)
-	  
+
+	  (draw-objects *renderer* *level*)
+
 	  (sdl2:render-present! *renderer*)
 	  (sdl2:delay! 10)))
 
 (sdl2:joystick-close *joystick*)
 
 (format #t "Bye!\n")
-
diff --git a/src/tilemap.scm b/src/tilemap.scm
index 6f6c3ef..3fa9ace 100644
--- a/src/tilemap.scm
+++ b/src/tilemap.scm
@@ -1,192 +1,207 @@
 (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:")
-	(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)))
-				  (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 (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)))
-    (pp (list tile-x tile-y x 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'?>
+    *
+  (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)))
+      (tileset-image (parse-tileset txt)))
 
-  (let ((txt "<?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'>
@@ -206,12 +221,11 @@
  </objectgroup>
 </map>
 "))
-    (tilemap-tileset (parse-tilemap txt)))
+      (tilemap-tileset (parse-tilemap txt)))
 
-  (tileset-image (tilemap-tileset (load-tilemap "assets/level-0.tmx")))
-  )
+    (tileset-image (tilemap-tileset (load-tilemap "assets/level-0.tmx")))
+    )
 
 
 
-) ;; End tilemap module
-
+  ) ;; End tilemap module