blob: 297777be643c9634a01fbbe914e7bd2fd8a51b05 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
(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
|
