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