Blob


1 ;; sn4k3
2 ;;
3 ;; Copyright (c) 2022 Omar Polo
4 ;;
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the MIT license. See LICENSE for
7 ;; details.
9 (local tick (require :tick))
11 (var game-state :menu) ;; :menu :game :pause :over
12 (var tick-event nil)
14 (var score 0)
15 (var snake-body [])
16 (var candies [])
18 (var direction :right)
20 (local ratio 20)
22 (local width 30)
23 (local height 20)
25 (local window-width (* ratio width))
26 (local window-height (* ratio height))
28 (fn hit? [x y seq]
29 "Return the index of the element of seq that is on (x, y), or nil."
30 (accumulate [index nil
31 i r (ipairs seq)
32 &until index]
33 (if (and (= x (. r :x))
34 (= y (. r :y)))
35 i)))
37 (fn place-candy []
38 (var done? false)
39 (while (not done?)
40 (let [x (math.random (- width 1))
41 y (math.random (- height 1))]
42 (when (and (not (hit? x y snake-body))
43 (not (hit? x y candies)))
44 (set done? true)
45 (table.insert candies {: x : y})))))
47 (fn wrap [val max]
48 (if (< val 0)
49 (- max 1)
50 (< val max)
51 val
52 0))
54 (fn compute-step [{: x : y}]
55 (match direction
56 :up (values x (wrap (- y 1) height))
57 :left (values (wrap (- x 1) width) y)
58 :right (values (wrap (+ x 1) width) y)
59 :down (values x (wrap (+ y 1) height))))
61 (fn move-snake []
62 (let [(x y) (compute-step (. snake-body 1))]
63 (if (hit? x y snake-body)
64 (do
65 (print "GAME OVER!")
66 (print "score:" score)
67 (set game-state :over))
68 (do
69 (match (hit? x y candies)
70 nil (table.remove snake-body)
71 i (do (table.remove candies i)
72 (place-candy)
73 (set score (+ 1 score))))
74 (table.insert snake-body 1 {: x : y})))))
76 (fn centered-text [x y rectw recth scale text]
77 (let [font (love.graphics.getFont)
78 tw (font:getWidth text)
79 th (font:getHeight)]
80 (love.graphics.print text
81 (+ (* x ratio) (* (/ rectw 2) ratio))
82 (+ (* y ratio) (* (/ recth 2) ratio))
83 0 scale scale
84 (/ tw 2)
85 (/ th 2))))
87 (fn menu-draw []
88 (love.graphics.setColor 0 1 0 1)
89 (centered-text 0 0 width height 2 "SN4K3")
90 (centered-text 0 6 width height 1 "press any key to play"))
92 (fn game-draw []
93 (love.graphics.setColor 255 255 255)
94 (each [_ r (ipairs snake-body)]
95 (let [{: x : y} r]
96 (love.graphics.rectangle :fill (* ratio x) (* ratio y) 20 20)))
98 (love.graphics.setColor 255 0 0)
99 (each [_ r (ipairs candies)]
100 (let [{: x : y} r]
101 (love.graphics.rectangle :fill (* ratio x) (* ratio y) 20 20))))
103 (fn pause-draw []
104 (game-draw)
105 (love.graphics.setColor 0 1 0 1)
106 (centered-text 0 0 width height 2 "PAUSED")
107 (centered-text 0 6 width height 1 "press any key to resume"))
109 (fn over-draw []
110 (game-draw)
111 (love.graphics.setColor 0 1 0 1)
112 (centered-text 0 0 width height 2 "GAME OVER!")
113 (centered-text 0 6 width height 1 (string.format "score: %03d" score)))
115 (fn game-init []
116 (set snake-body [{:x 14 :y 9}
117 {:x 13 :y 9}
118 {:x 12 :y 9}
119 {:x 11 :y 9}])
120 (set direction :right)
121 (set candies [])
122 (for [i 1 5]
123 (place-candy))
124 (when tick-event
125 (tick.remove tick-event))
126 (set tick-event (tick.recur move-snake .25)))
128 (fn love.load []
129 (love.window.updateMode window-width window-height {:fullscreen false}))
131 (fn love.draw []
132 (love.graphics.setColor 0 0 0)
133 (love.graphics.rectangle :fill 0 0 window-width window-height)
135 (if (= game-state :menu)
136 (menu-draw)
138 (= game-state :game)
139 (game-draw)
141 (= game-state :pause)
142 (pause-draw)
144 (= game-state :over)
145 (over-draw)))
147 (fn key-ok? [key]
148 (and (not= key "lctrl")
149 (not= key "lshift")
150 (not= key "lgui")
151 (not= key "lalt")
152 (not= key "rctrl")
153 (not= key "rshift")
154 (not= key "rgui")
155 (not= key "ralt")
156 (not= key "scrollock")))
158 (fn love.keypressed [key]
159 (if (or (= game-state :menu)
160 (= game-state :over))
161 (if (= key :q) (love.event.quit 0)
162 (key-ok? key) (do (set game-state :game)
163 (game-init)))
165 (= game-state :game)
166 (match key
167 (where (or :up :down :left :right)) (set direction key)
168 (where (or :p :escape)) (set game-state :pause))
170 (= game-state :pause)
171 (when (key-ok? key)
172 (set game-state :game))))
174 (fn love.update [dt]
175 (when (= game-state :game)
176 (tick.update dt)))