~technomancy/tremendous-quest-iv

ref: d55ff0ad828cf954ea1b818e533edb214f4defb5 tremendous-quest-iv/world.fnl -rw-r--r-- 11.5 KiB
d55ff0adPhil Hagelberg Allow (wget :octo) without extension. 1 year, 3 months ago
                                                                                
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
(local sti (require "lib.sti"))
(local bump (require "lib.bump"))
(local lume (require "polywell.lib.lume"))
(local fennel (require "polywell.lib.fennel"))
(local fennelview (require "polywell.lib.fennelview"))
(local dialog (require "dialog"))
(local characters (require "characters"))
(local editor (require "polywell"))
(local teammates (require "teammates"))
(local pathfinding (require "pathfinding"))
(local util (require "util"))
(local ai (require "ai"))
(local sound (require "sound"))

(local state {:characters [(lume.extend (characters.make "me" 528 4096 11)
                                        {:team? true
                                         :diamond? false
                                         :speed 192
                                         :ui-color [0.2 0.8 0.2]})]
              :logged-out []
              :viewport {:scale 1 :x 0 :y 0}
              :login-timer 3
              :ragequits 0
              :warn-timer 0})

(set state.player (. state.characters 1))

(global s (or _G.s state)) ; exposed for repl
(when (os.getenv "STARTCLOSE")
  (set (state.player.x state.player.y) (values 720 3000)))

(fn distance-from-player [a]
  (lume.distance a.x a.y state.player.x state.player.y))

(fn draw-path [path]
  (->> path
       pathfinding.path->points
       unpack
       (pathfinding.path-points->absolute-points)
       (util.transform-points 6 6)
       ((fn [...]
          (when (>= (select :# ...) 4)
            (love.graphics.line ...))))))

(fn draw []
  (set state.viewport.x (- 196 state.player.x))
  (set state.viewport.y (- 144 state.player.y))
  (state.map:draw state.viewport.x state.viewport.y
                  state.viewport.scale state.viewport.scale))

(fn draw-characters []
  (each [_ character (ipairs state.characters)]
    (let [(x y w h) (: state.world :getRect character)]
      (love.graphics.setColor character.ui-color)
      (when (and character.closest?
                 (<= (distance-from-player character) dialog.talk-range))
        (love.graphics.rectangle :line (- x 1) (- y 1) (+ w 2) (+ h 2)))
      (when state.debug?
        (-?> character (. :ai) (. :task) (. :path) draw-path))
      (love.graphics.setColor 1 1 1)
      (character.draw x y true)
      ;; (-?> character (. :ai) (. :task) (. :name) (love.graphics.print x y))
      (-?> character (. :ai) (. :bark)
           (love.graphics.print (math.floor (+ x 16)) (math.floor (- y 16)))))))

(fn init-layer [layer]
  (when layer.properties.autohide
    (set layer.visible false)))

(local fake-players-quads
  [10 11 12 18 19 20 24 25 31 32 33 34 35 36 37 38 50])
(local original-fake-players-quads (lume.clone fake-players-quads))

(fn range1 [acc n]
  (if (< n 1) (values)
      (= n 1) (values acc)
      (values acc (range1 (+ acc 1) (- n 1)))))

(fn range [n1 n2]
  (if (not n2) (range1 1 n1)
      (and n2 (< n2 1)) (values)
      (range1 n1 n2)))

(fn reserve-random-fake-player-quad []
  (if (= 0 (length fake-players-quads))
      (do (dbg "ran out of quads")
          (lume.randomchoice original-fake-players-quads))
      (let [i (lume.randomchoice [(range (length fake-players-quads))])]
        (. fake-players-quads i)
        (table.remove fake-players-quads i))))

;; generate all characters ahead of time and simply log them in/out
(for [_ 1 characters.count]
  ;; only give out each quad once
  (let [quad (reserve-random-fake-player-quad)]
    (table.insert state.logged-out
                  (ai.make (characters.make nil 0 0 quad)))))

(fn select-login-point [tried-unclaimed?]
  "Prefer unclaimed login point but fall back to claimed if none are found."
  (let [point (-> state.map.layers
                  (.  "points of interest" :objects)
                  (lume.filter #(or tried-unclaimed? (not $.properties.claimed?)))
                  (lume.randomchoice))]
    (or point (and (not tried-unclaimed?)
                   (assert (select-login-point true) "could not find login")))))

(fn login-fake-player []
  (when (< 0 (# state.logged-out))
    (let [point (select-login-point false)
          char (lume.randomchoice state.logged-out)]
      (fn char.logout []
        (dbg :logout char.name)
        (when char.ai
          (set char.ai.mood (love.math.randomNormal 4 10))
          (set char.ai.task nil))
        (lume.remove state.characters char)
        (table.insert state.logged-out char)
        (state.world:remove char)
        (when (< (love.math.random) 0.5)
          (login-fake-player)))
      (set char.spawn-point point)
      (dbg :login char.name)
      (lume.remove state.logged-out char)
      (set (char.x char.y) (values point.x point.y))
      (state.world:add char char.x char.y char.w char.h)
      (table.insert state.characters char))))

(set state.stopped-chars {})
(fn stop-char [char]
  (tset state.stopped-chars char.name true))
(fn char-stopped? [char]
  (. state.stopped-chars char.name))
(fn resume-char [char]
  (tset state.stopped-chars char.name false))

(fn teleport-collision [player other]
  )

(fn teleport [char]
  (let [char (lume.match state.characters #(= char.name $.name))
        dx (* (- state.player.x char.x) 0.75)
        dy (* (- state.player.y char.y) 0.75)
        (nx ny) (state.world:move char (+ char.x dx) (+ char.y dy)
                                  #(if (= $2.name "me") :slide))]
    (set (char.x char.y) (values nx ny))
    (if (= char.ai.task.name :stuck)
        (do (set char.ai.task nil)
            (set char.ai.mood (+ char.ai.mood 3)))
        (set char.ai.mood (- char.ai.mood 5)))))

(fn remove-item [char item]
  (let [char (lume.match state.characters #(= char.name $.name))
        old-convo char.convo]
    (lume.remove char.inventory item)
    (if char.team? false
        (= item char.bugged-item)
        (do (fn char.convo [c]
              (dialog.say c "thanks for fixing that")
              (set char.convo nil))
            (set char.bugged-item nil)
            (set char.ai.mood (+ char.ai.mood 5))
            true)
        (do (fn char.convo [c]
              (let [quip (lume.randomchoice
                          [["hey! what are you doing! that's my" "%s!"]
                           ["did you ... did you just take my" "%s?!?"
                            "" "i can't believe you would do that."]
                           ["where'd my %s go?"]
                           ["aw come on; I was using that!"]])]
                (dialog.say c (unpack (lume.map quip #($:format item)))))
              (set char.convo old-convo))
            (set char.ai.mood (- char.ai.mood 10))
            true))))

(fn init-env [env fs read-only]
  (lume.extend env {: stop-char : resume-char : teleport : remove-item
                    :characters (read-only state.characters :characters)
                    :toggle-sound sound.toggle
                    :ragequits #state.ragequits
                    :me (read-only state.player :me)
                    :world {:draw draw}
                    :dialog {:start (partial dialog.start state)}
                    :cheat state ; for debugging only; remove!
                    :toggle-debug #(set state.debug? (not state.debug?))
                    :get-debug #state.debug?
                    :viewport state.viewport})
  (fn env.grant-diamond [target]
    (if target.diamond?
        false
        (let [char (lume.match state.characters #(= target.name $.name))
              old-convo char.convo]
          (set char.diamond? true)
          (set char.ai.mood (+ char.ai.mood 10))
          (match char.name
            :anya (fn char.convo [c]
                    (dialog.say c "uh, what's this?")
                    (set char.convo teammates.anya.diamond)
                    (teammates.anya.diamond c))
            _ (fn char.convo [c]
                (dialog.say c "oh wow; diamond platinum status?"
                            "thanks!")
                (set char.convo old-convo)))
          "OK.")))
  (fn env.wget [path]
    (assert (or (= path "octo.fnl") (= path "octo")) "404 NOT FOUND")
    (fs.write path (love.filesystem.read path))
    (editor.print "Success: octo.fnl saved.")
    (let [octo (lume.match state.characters #(= :octo $.name))]
      (set octo.convo octo.wget-convo)))
  (set env.curl env.wget)
  (let [load-code fennel.loadCode]
    (fn fennel.loadCode [source loading-env]
      (if (and loading-env (not state.player.diamond?))
          (error "Upgrade to Diamond Platinum\nto unlock scripting.\n")
          (load-code source loading-env)))))

(fn init [env fs read-only]
  (set state.map (sti "map.lua" ["bump"]))
  (set state.pathfinder (pathfinding.finder-from-tiled-map state.map))
  (set state.world (bump.newWorld))
  (set state.env env)
  (init-env env fs read-only)
  (sound.play :arcana)
  (for [_ 1 (love.math.randomNormal 4 12)]
    (login-fake-player))
  (teammates.init state)
  (: state.map :bump_init state.world)
  (lume.map state.map.layers init-layer)
  ;; need to insert the characters layer right below "sea"
  (let [(_ i) (lume.match state.map.layers #(= $1.name "sea"))
        layer (: state.map :addCustomLayer "characters" i)]
    (set layer.draw draw-characters)))


(fn coll-filter [item other]
  ;; AIs can only collide with other AIs when the other isn't moving
  (if (and item.ai (not (and other.ai other.ai.task other.ai.task.target)))
      nil
      :slide))

(fn maybe-login [dt]
  (set state.login-timer (- state.login-timer dt))
  (when (< state.login-timer 0)
    (set state.login-timer (love.math.randomNormal 2 5))
    (let [count (# state.characters)
          rnd (love.math.random)]
      (if (< count 10)
          (login-fake-player)
          (< count 14)
          (when (< rnd 0.4)
            (login-fake-player))
          (< count 17)
          (when (< rnd 0.2)
            (login-fake-player))
          (when (< rnd 0.1)
            (login-fake-player))))))

(local key-dirs {:up [0 -1] :down [0 1] :left [-1 0] :right [1 0]
                 :w  [0 -1] :s    [0 1] :a    [-1 0] :d     [1 0]})

(fn update [dt]
  (: state.map :update dt)
  (let [(ok msg) (pcall maybe-login dt)]
    (when (not ok)
      (print :maybe-login-err msg)
      (each [_ p (.  state.map.layers "points of interest" :objects)]
        (print :poi p.id p.properties.claimed?))))
  (each [key delta (pairs key-dirs)]
    (when (and (love.keyboard.isDown key)
               (= :play (editor.current-mode-name)))
      (let [speed (if (love.keyboard.isDown "lshift" "rshift")
                      (* 1.5 state.player.speed)
                      state.player.speed)
            [dx dy] delta
            x (+ state.player.x (* (* dx speed) dt))
            y (+ state.player.y (* (* dy speed) dt))
            (nx ny colls) (: state.world :move state.player x y  coll-filter)]
        (set [state.player.x state.player.y] [nx ny]))))
  (each [_ character (ipairs state.characters)]
    (set character.closest? false)
    ;; todo: don't pass the entire state to run-ai
    (when (and character.ai (not (char-stopped? character)))
      (let [(ok msg) (pcall ai.run dt state character)]
        (when (not ok) (print :ai.run-err msg)))))
  (each [_ character (ipairs state.characters)]
    (set character.distance (distance-from-player character)))
  (let [[_ closest] (lume.sort state.characters :distance)]
    (set closest.closest? true))
  (when (and (< 0 state.ragequits) (not state.warned))
    (set state.warn-timer (- state.warn-timer dt))
    (when (< state.warn-timer 0)
      (if (= :play (editor.current-mode-name))
          (do (set state.warned true)
              (editor.open "*play*" "warning" true))
          (set state.warn-timer 5))))
  (when state.win?
    (editor.open "*play*" "ending" true))
  (update (coroutine.yield)))

{: init : update : draw}