blob: efaf6bb5504b857a16bb3dddd6bbe020b764c90f (
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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
;;;; Copyright (C) 2018 Jakob L. Kreuze, All Rights Reserved.
;;;;
;;;; This file is part of slime-the-world.
;;;;
;;;; slime-the-world is free software: you can redistribute it and/or modify it
;;;; under the terms of the GNU General Public License as published by the Free
;;;; Software Foundation, either version 3 of the License, or (at your option)
;;;; any later version.
;;;;
;;;; slime-the-world is distributed in the hope that it will be useful, but
;;;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
;;;; more details.
;;;;
;;;; You should have received a copy of the GNU General Public License along
;;;; with slime-the-world. If not, see <http://www.gnu.org/licenses/>.
(local tile-sheet
{:img (love.graphics.newImage "art/tiles.png")
:width 32 :height 32
:padding-x 8 :padding-y 8
:offsets {:bricks 0}})
(local tile-values
{:empty [1 0 0 0]
:bricks [0 0 0 1]})
(local slime
{:img (love.graphics.newImage "art/slime.png")
:width 32 :height 32
:padding-x 8 :padding-y 8
:offsets {:top 0 :bottom 1 :left 2 :right 3}})
(fn tile-at [tiles x y]
(if (and (>= x 0)
(< x (. tiles :width))
(>= y 0)
(< y (. tiles :height)))
(. tiles :tiles (+ 1 y) (+ 1 x))
nil))
(fn find-first [tile-type tiles]
(var res nil)
(each [_ row (ipairs (. tiles :tiles))]
(each [_ tile (ipairs row)]
(when (= tile-type (. tile :type))
(set res tile))))
res)
(fn tile-checked [tile checked]
(var res false)
(each [_ other (ipairs checked)]
(when (and (= (. tile :x-pos) (. other :x-pos))
(= (. tile :y-pos) (. other :y-pos)))
(set res true)))
res)
(fn count-surfaces-recur [tiles tile checked]
(var surfaces 0)
(when (not (tile-checked tile checked))
(table.insert checked tile)
(let [x (/ (. tile :x-pos) (. tile-sheet :width))
y (/ (. tile :y-pos) (. tile-sheet :height))
width (. tiles :width)
height (. tiles :height)]
(when (>= x 0)
(let [tile (tile-at tiles (- x 1) y)]
(if (= :empty (. tile :type))
(set surfaces (+ surfaces (count-surfaces-recur tiles tile checked)))
(set surfaces (+ 1 surfaces)))))
(when (< x width)
(let [tile (tile-at tiles (+ x 1) y)]
(if (= :empty (. tile :type))
(set surfaces (+ surfaces (count-surfaces-recur tiles tile checked)))
(set surfaces (+ 1 surfaces)))))
(when (>= y 0)
(let [tile (tile-at tiles x (- y 1))]
(if (= :empty (. tile :type))
(set surfaces (+ surfaces (count-surfaces-recur tiles tile checked)))
(set surfaces (+ 1 surfaces)))))
(when (< y height)
(let [tile (tile-at tiles x (+ y 1))]
(if (= :empty (. tile :type))
(set surfaces (+ surfaces (count-surfaces-recur tiles tile checked)))
(set surfaces (+ 1 surfaces)))))))
surfaces)
(fn count-surfaces [tiles]
(let [seed (find-first :empty tiles)]
(when seed
(count-surfaces-recur tiles seed []))))
;; Creates a new tile object of the given `type-type' positioned at world
;; coordinates (`x', `y').
(fn make-tile [tile-type x y]
{:x-pos x
:y-pos y
:type tile-type
:slimed {:top false
:bottom false
:left false
:right false}})
;; Returns the tile object for a given pixel in `image'.
(fn get-tile [image x y]
(var res (make-tile :empty (* x (. tile-sheet :width)) (* y (. tile-sheet :width))))
(let [(r g b a) (: image :getPixel x y)]
(each [tile-type colors (pairs tile-values)]
(when (and (= (. colors 1) r)
(= (. colors 2) g)
(= (. colors 3) b)
(= (. colors 4) a))
(tset res :type tile-type))))
res)
;; Loads the tile layout of the level from the given ImageData, returning a
;; rectangular two-dimensional array.
(fn load-tiles [image]
(var tiles [])
(let [width (: image :getWidth)
height (: image :getHeight)]
(for [y 0 (- height 1)]
(var row [])
(for [x 0 (- width 1)]
(table.insert row (get-tile image x y)))
(table.insert tiles row))
(values tiles width height)))
;; Returns the metadata and objects stored in the metadata file at the given
;; path.
(fn load-meta [path]
(fennel.dofile path))
;; Loads the map of the given name. Will error out if either 'maps/${name}.png'
;; or 'maps/${name}.fnl' do not exist.
(fn load [name]
(let [tiles-path (.. "maps/" name ".png")
meta-path (.. "maps/" name ".fnl")]
(let [(tiles width height) (load-tiles (love.image.newImageData tiles-path))
tiles-temp {:tiles tiles :width width :height height}]
{:tiles tiles
:width width
:height height
:surfaces-slimed 0
:surfaces-total (count-surfaces tiles-temp)
:meta (load-meta meta-path)})))
{:tiles tile-sheet
:slime slime
:load load}
|
