1;; ----------------------------------------------------------------------------
2;; Set the list of magic syllables we'll use in our game. The kernel sets a max
3;; limit of 26 (one for each letter of the alphabet) largely for reasons I am
4;; not willing to address at this point.
5;; ----------------------------------------------------------------------------
6
7(kern-set-spell-words "An"
8                      "Bet"
9                      "Corp"
10                      "Des"
11                      "Ex"
12                      "Flam"
13                      "Grav"
14                      "Hur"
15                      "In"
16                      "Jux"
17                      "Kal"
18                      "Lor"
19                      "Mani"
20                      "Nox"
21                      "Ort"
22                      "Por"
23                      "Quas"
24                      "Rel"
25                      "Sanct"
26                      "Tym"
27                      "Uus"
28                      "Vas"
29                      "Wis"
30                      "Xen"
31                      "Ylem"
32                      "Zu")
33
34;; ----------------------------------------------------------------------------
35;; The only purpose of this list is to prevent the scheme gc from harvesting
36;; the spell interfaces which are created on-the-fly in mk-spell. Without this
37;; I'd have to explicitly assign a variable to each ifc, which is needlessly
38;; verbose.
39;; ----------------------------------------------------------------------------
40
41(define spell-ifcs '())
42
43;; ----------------------------------------------------------------------------
44;; mk-spell creates a spell interface on the fly, puts it on the spell-ifcs to
45;; prevent the gc from getting it, registers a new object type for the spell
46;; with the kernel, and then adds it to the list of spells known to the kernel.
47;; ----------------------------------------------------------------------------
48(define (mk-spell tag name cast-handler magic-words level context sprite
49                  reagents)
50  (let ((spell-ifc (ifc obj-ifc (method 'cast cast-handler))))
51    (set! spell-ifcs (cons spell-ifc spell-ifcs))
52    (kern-add-spell (mk-obj-type tag name nil layer-none spell-ifc)
53                    magic-words
54                    level  ;; level
55                    level  ;; mana cost
56                    context
57                    (/ (* (+ level 1) base-spell-ap) 2) ;; action point cost
58                    sprite ;; sprite (FIXME)
59                    reagents
60                    )))
61
62
63
64;; ============================================================================
65;; Wind spell support
66;; ============================================================================
67
68(define (get-line origin dir n)
69  ;;(println "   get-line:" origin "," dir "," n)
70  (cond ((= n 0)
71         ;;(println "    nil")
72         nil)
73        (else
74         (cons origin
75               (get-line (loc-offset origin dir) dir (- n 1))))))
76
77(define (get-cone-vert origin depth dy)
78  ;;(println " get-cone-vert:" origin "," depth "," dy)
79  (let ((place (loc-place origin)))
80    (define (get-lines x y n h)
81      ;;(println "  get-lines:" x "," y "," n "," h)
82      (if (< h 0) nil
83          (let ((line (filter (lambda (a) (and (kern-in-los? origin a)
84                                               (kern-is-valid-location? a)
85                                               (terrain-ok-for-field? a)))
86                              (get-line (mk-loc place x y) east n))))
87            ;;(println "   line:" line)
88            (cons line
89                  (get-lines (if (= x 0) 0 (- x 1))
90                             (+ y dy)
91                             (+ n (if (= x 0) 1 2))
92                             (- h 1))))))
93    (get-lines (loc-x origin)
94               (loc-y origin)
95               1
96               depth)))
97
98(define (get-cone-horz origin depth dx)
99  (let ((place (loc-place origin)))
100    (define (get-lines x y n h)
101      (if (< h 0) nil
102          (cons (filter (lambda (a) (and (kern-in-los? origin a)
103                                         (kern-is-valid-location? a)
104                                         (terrain-ok-for-field? a)))
105                        (get-line (mk-loc place x y) south n))
106                (get-lines (+ x dx)
107                           (if (= y 0) 0 (- y 1))
108                           (+ n (if (= y 0) 1 2))
109                           (- h 1)))))
110    (get-lines (loc-x origin)
111               (loc-y origin)
112               1
113               depth)))
114
115(define (get-cone origin depth dir)
116  ;;(println "get-cone:" origin "," depth "," dir)
117  (cond ((= dir north) (get-cone-vert origin
118                                      (min depth (loc-y origin))
119                                      -1))
120        ((= dir east) (get-cone-horz origin
121                                     (min depth
122                                          (- (kern-place-get-width (loc-place origin))
123                                             (loc-x origin)))
124                                     1))
125        ((= dir south) (get-cone-vert origin
126                                      (min depth
127                                           (- (kern-place-get-height (loc-place origin))
128                                              (loc-y origin)))
129                                      1))
130        ((= dir west) (get-cone-horz origin
131                                     (min depth (loc-x origin))
132                                     -1))
133        (else nil)))
134
135(define (cast-wind-spell origin proc field-type)
136  (let ((dir (ui-get-direction)))
137    (if (null? dir) nil
138        (begin
139          (define (dropfield loc)
140            (if (kern-is-valid-location? loc)
141                (kern-obj-put-at (kern-mk-obj field-type 1) loc)))
142          (define (is-my-field? kobj) (eqv? field-type (kern-obj-get-type kobj)))
143          (define (rmfield loc)
144            (if (> (kern-dice-roll "2d20") 16)
145                (let ((fields (filter is-my-field? (kern-get-objects-at loc))))
146                  (cond ((null? fields) nil)
147                        (else
148                         (kern-obj-remove (car fields)))))))
149          (define (doline line)
150            (map (lambda (loc)
151                   (map proc (kern-get-objects-at loc)))
152                 line)
153            (map dropfield line)
154            (kern-map-repaint)
155            (map rmfield line)
156            )
157          (let ((lines (get-cone origin 10 dir)))
158            (cond ((null? lines) nil)
159                  (else
160                   (map doline (cdr lines))
161                   (kern-map-repaint))))))))
162
163;; This version:
164;;   o has caller-limited depth
165;;   o has caller-specified direction
166;;   o applies caller-specified proc to each location
167;; (Note: currently used for the spider's web-spew "spell")
168(define (cast-wind-spell2 origin proc dir depth)
169  ;;(println "cast-wind-spell2:" origin "," proc "," dir "," depth)
170  (define (dropfield loc)
171    (if (kern-is-valid-location? loc)
172        (proc loc)))
173  (define (doline line)
174    (map dropfield line)
175    (kern-map-repaint))
176  (let ((lines (get-cone origin depth dir)))
177    (cond ((null? lines) nil)
178          (else
179           ;;(println " doing lines")
180           (map doline (cdr lines))
181           (kern-map-repaint)))))
182
183
184;;----------------------------------------------------------------------------
185;; Core actions behind spells, special abilities, etc. No UI prompting, no mana
186;; or level checking, no mana decrementing -- that all needs to be handled by
187;; the callers. All of these calls must return #t on success or #f on
188;; failure. No further details as to cause of failure are required.
189;;----------------------------------------------------------------------------
190
191
192(define (resurrect kchar)
193  (kern-char-resurrect kchar)
194  #t)
195
196;; ----------------------------------------------------------------------------
197;; All the spell cast handlers are listed here. These are the procedures that
198;; get called whenever a spell is cast.
199;; ----------------------------------------------------------------------------
200
201(define (cast-on-party-member spell)
202  (let ((ktarg (kern-ui-select-party-member)))
203    (if (null? ktarg)
204        result-no-target
205        (if (spell ktarg)
206            result-ok
207            result-no-effect))))
208
209
210;;----------------------------------------------------------------------------
211;; Spell accessors
212;;----------------------------------------------------------------------------
213(define (spell-name spell) (cadr spell))
214(define (spell-handler spell) (caddr spell))
215(define (spell-level spell) (list-ref spell 4))
216(define (spell-cost spell) (spell-level spell))
217(define (spell-ap spell) (spell-level spell))
218
219;; ----------------------------------------------------------------------------
220;; This is the table of spells.
221;; ----------------------------------------------------------------------------
222
223;; Spell sprite set
224(kern-mk-sprite-set 'ss_spells 32 32 8 8 0 0 "spells.png")
225
226(define (mk-sprite tag offset)
227  (kern-mk-sprite tag ss_spells 1 offset #f 0))
228
229(mk-sprite 's_an_nox            0)
230(mk-sprite 's_an_zu             1)
231(mk-sprite 's_grav_por          2)
232(mk-sprite 's_in_lor            3)
233(mk-sprite 's_mani              4)
234(mk-sprite 's_wis_sanct         5)
235(mk-sprite 's_an_sanct_ylem     6)
236(mk-sprite 's_ylem_an_ex        7)
237(mk-sprite 's_sanct_nox         8)
238(mk-sprite 's_an_sanct          9)
239(mk-sprite 's_sanct            10)
240(mk-sprite 's_an_xen_corp      11)
241(mk-sprite 's_in_wis           12)
242(mk-sprite 's_kal_xen          13)
243(mk-sprite 's_rel_hur          14)
244(mk-sprite 's_in_nox_por       15)
245(mk-sprite 's_an_xen_bet       16)
246(mk-sprite 's_bet_flam_hur     17)
247(mk-sprite 's_in_flam_grav     18)
248(mk-sprite 's_in_nox_grav      19)
249(mk-sprite 's_in_zu_grav       20)
250(mk-sprite 's_vas_flam         21)
251(mk-sprite 's_vas_lor          22)
252(mk-sprite 's_in_flam_sanct    23)
253(mk-sprite 's_an_grav          24)
254(mk-sprite 's_in_sanct_grav    25)
255(mk-sprite 's_in_sanct         26)
256(mk-sprite 's_wis_quas         27)
257(mk-sprite 's_bet_por          28)
258(mk-sprite 's_vas_sanct_nox    29)
259(mk-sprite 's_in_ex_por        30)
260(mk-sprite 's_an_ex_por        31)
261(mk-sprite 's_in_bet_xen       32)
262(mk-sprite 's_in_zu            33)
263(mk-sprite 's_vas_mani         34)
264(mk-sprite 's_rel_tym          35)
265(mk-sprite 's_in_an            36)
266(mk-sprite 's_wis_an_ylem      37)
267(mk-sprite 's_an_xen_ex        38)
268(mk-sprite 's_in_vas_por_ylem  39)
269(mk-sprite 's_quas_an_wis      40)
270(mk-sprite 's_vas_uus_ylem     41)
271(mk-sprite 's_in_rel_por       42)
272(mk-sprite 's_vas_por          43)
273(mk-sprite 's_in_nox_hur       44)
274(mk-sprite 's_in_zu_hur        45)
275(mk-sprite 's_in_quas_corp     46)
276(mk-sprite 's_in_quas_wis      47)
277(mk-sprite 's_sanct_lor        48)
278(mk-sprite 's_xen_corp         49)
279(mk-sprite 's_in_quas_xen      50)
280(mk-sprite 's_kal_xen_nox      51)
281(mk-sprite 's_in_flam_hur      52)
282(mk-sprite 's_in_vas_grav_corp 53)
283(mk-sprite 's_an_tym           54)
284(mk-sprite 's_kal_xen_corp     55)
285(mk-sprite 's_in_mani_corp     56)
286(mk-sprite 's_vas_rel_por      57)
287(mk-sprite 's_vas_an_nox       58)
288(mk-sprite 's_ort_grav         59)
289(mk-sprite 's_bet_ylem_hur     60)
290(mk-sprite 's_rel_xen_quas     61)
291
292;; ----------------------------------------------------------------------------
293;; Now rip through the list of spells, adding them to the kernel.
294;; ----------------------------------------------------------------------------
295
296;;         tag               name                               handler          code   L context       sprite             mixture
297;;         ==========        ================================   =======          ====   = =========     ======             =======
298;; First Circle
299(mk-spell 'an_nox           "Cure Poison <An Nox>"              an-nox           "AN"   1 context-any   s_an_nox           (list garlic ginseng))
300(mk-spell 'an_zu            "Awaken <An Zu>"                    an-zu            "AZ"   1 context-any   s_an_zu            (list garlic ginseng))
301(mk-spell 'grav_por         "Magic Missile <Grav Por>"          grav-por         "GP"   1 context-town  s_grav_por         (list sulphorous_ash black_pearl))
302(mk-spell 'in_lor           "Light <In Lor>"                    in-lor           "IL"   1 context-any   s_in_lor           (list sulphorous_ash))
303(mk-spell 'mani             "Minor Healing <Mani>"              mani             "M"    1 context-any   s_mani             (list ginseng spider_silk))
304(mk-spell 'wis_sanct        "Detect Traps <Wis Sanct>"          wis-sanct        "WS"   1 context-town  s_wis_sanct        (list sulphorous_ash))
305(mk-spell 'an_sanct_ylem    "Disarm Trap <An Sanct Ylem>"       an-sanct-ylem    "ASY"  1 context-town  s_an_sanct_ylem    (list blood_moss))
306(mk-spell 'ylem_an_ex       "Web <Ylem An Ex>"                  ylem-an-ex       "YAE"  1 context-town  s_ylem_an_ex       (list spider_silk black_pearl))
307(mk-spell 'bet_ylem_hur     "Conjure Smoke <Bet Ylem Hur>"      bet-ylem-hur     "BYH"  1 context-town  s_bet_ylem_hur     (list sulphorous_ash))
308
309;; Second Circle
310(mk-spell 'sanct_nox        "Poison Ward <Sanct Nox>"           sanct-nox        "SN"   2 context-any   s_sanct_nox        (list nightshade garlic t_royal_cape))
311(mk-spell 'an_sanct         "Unlock <An Sanct>"                 an-sanct         "AS"   2 context-town  s_an_sanct         (list sulphorous_ash blood_moss))
312(mk-spell 'sanct            "Lock <Sanct>"                      sanct            "S"    2 context-town  s_sanct            (list sulphorous_ash spider_silk))
313(mk-spell 'an_xen_corp      "Turn Undead <An Xen Corp>"         an-xen-corp      "AXC"  2 context-town  s_an_xen_corp      (list garlic sulphorous_ash))
314(mk-spell 'in_wis           "Locate <In Wis>"                   in-wis           "IW"   2 context-any   s_in_wis           (list nightshade))
315(mk-spell 'in_bet_xen       "Summon Vermin <In Bet Xen>"        in-bet-xen       "IBX"  2 context-town  s_in_bet_xen       (list spider_silk blood_moss sulphorous_ash))
316(mk-spell 'rel_hur          "Change Wind <Rel Hur>"             rel-hur          "RH"   2 context-any   s_rel_hur          (list sulphorous_ash blood_moss))
317(mk-spell 'in_nox_por       "Poison Bolt <In Nox Por>"          in-nox-por       "INP"  2 context-town  s_in_nox_por       (list nightshade blood_moss black_pearl))
318(mk-spell 'an_xen_bet       "Calm Spiders <An Xen Bet>"         an-xen-bet       "AXB"  2 context-town  s_an_xen_bet       (list spider_silk garlic))
319(mk-spell 'bet_flam_hur     "Fire Spray <Bet Flam Hur>"         bet-flam-hur     "BFH"  2 context-town  s_bet_flam_hur     (list black_pearl sulphorous_ash blood_moss))
320(mk-spell 'in_quas_wis      "Vision <In Quas Wis>"              in-quas-wis      "IQW"  2 context-any   s_in_quas_wis      (list nightshade mandrake))
321(mk-spell 'xen_zu           "Sleep <Xen Zu>"                    xen-zu           "XZ"   2 context-town  s_in_zu            (list spider_silk ginseng))
322
323;; Third Circle
324(mk-spell 'in_flam_grav     "Fire Field <In Flam Grav>"         in-flam-grav     "IFG"  3 context-town  s_in_flam_grav     (list sulphorous_ash black_pearl spider_silk))
325(mk-spell 'in_nox_grav      "Poison Field <In Nox Grav>"        in-nox-grav      "ING"  3 context-town  s_in_nox_grav      (list nightshade black_pearl spider_silk))
326(mk-spell 'in_zu_grav       "Sleep Field <In Zu Grav>"          in-zu-grav       "IZG"  3 context-town  s_in_zu_grav       (list ginseng black_pearl spider_silk))
327(mk-spell 'vas_flam         "Fire Ball <Vas Flam>"              vas-flam         "VF"   3 context-town  s_vas_flam         (list sulphorous_ash black_pearl))
328(mk-spell 'vas_lor          "Great Light <Vas Lor>"             vas-lor          "VL"   3 context-any   s_vas_lor          (list mandrake sulphorous_ash))
329(mk-spell 'in_flam_sanct    "Fire Ward <In Flam Sanct>"         in-flam-sanct    "IFS"  3 context-any   s_in_flam_sanct    (list garlic sulphorous_ash t_royal_cape))
330(mk-spell 'vas_an_nox       "Mass Cure Poison <Vas An Nox>"     vas-an-nox       "VAN"  3 context-any   s_vas_an_nox       (list mandrake garlic ginseng))
331(mk-spell 'an_ort_xen       "Dispel Magic <An Ort Xen>"         an-ort-xen       "AOX"  3 context-any   s_in_an            (list garlic mandrake sulphorous_ash))
332
333;; Fourth Circle
334(mk-spell 'an_grav          "Dispel Field <An Grav>"            an-grav          "AG"   4 context-any   s_an_grav          (list black_pearl sulphorous_ash))
335;;(mk-spell 'uus_por        "Ascend <Uus Por>"                  uus-por          "UP"   4 context-any   nil                (list blood_moss spider_silk))
336;;(mk-spell 'des_por        "Descend <Des Por>"                 des-por          "DP"   4 context-any   nil                (list blood_moss spider_silk))
337(mk-spell 'in_sanct_grav    "Force Field <In Sanct Grav>"       in-sanct-grav    "ISG"  4 context-town  s_in_sanct_grav    (list mandrake black_pearl spider_silk))
338(mk-spell 'in_sanct         "Protection <In Sanct>"             in-sanct         "IS"   4 context-any   s_in_sanct         (list sulphorous_ash ginseng garlic))
339(mk-spell 'wis_quas         "Reveal <Wis Quas>"                 wis-quas         "WQ"   4 context-any   s_wis_quas         (list nightshade sulphorous_ash))
340(mk-spell 'bet_por          "Blink <Bet Por>"                   bet-por          "BP"   4 context-town  s_bet_por          (list black_pearl blood_moss))
341(mk-spell 'vas_sanct_nox    "Mass Poison Ward <Vas Sanct Nox>"  vas-sanct-nox    "VSN"  3 context-any   s_vas_sanct_nox    (list mandrake nightshade garlic t_royal_cape))
342(mk-spell 'ort_grav         "Lightning Bolt <Ort Grav>"         ort-grav         "OG"   1 context-town  s_ort_grav         (list black_pearl mandrake sulphorous_ash))
343
344;; Fifth Circle
345(mk-spell 'in_ex_por        "Magic Unlock <In Ex Por>"          in-ex-por        "IEP"  5 context-any   s_in_ex_por        (list sulphorous_ash blood_moss))
346(mk-spell 'an_ex_por        "Magic Lock <An Ex Por>"            an-ex-por        "AEP"  5 context-any   s_an_ex_por        (list sulphorous_ash blood_moss garlic))
347(mk-spell 'in_zu            "Mass Sleep <In Zu>"                in-zu            "IZ"   5 context-town  s_in_zu            (list nightshade spider_silk ginseng))
348(mk-spell 'vas_mani         "Great Heal <Vas Mani>"             vas-mani         "VM"   5 context-any   s_vas_mani         (list mandrake spider_silk ginseng))
349(mk-spell 'rel_tym          "Quickness <Rel Tym>"               rel-tym          "RT"   5 context-any   s_rel_tym          (list sulphorous_ash blood_moss mandrake))
350(mk-spell 'kal_xen          "Summon Beast <Kal Xen>"            kal-xen          "KX"   5 context-town  s_kal_xen          (list spider_silk mandrake))
351(mk-spell 'rel_xen_quas     "Illusion of Beastliness <Rel Xen Quas>" rel-xen-quas "RXQ" 5 context-town  s_rel_xen_quas     (list nightshade blood_moss))
352
353;; Sixth Circle
354(mk-spell 'in_an            "Negate Magic <In An>"              in-an            "IA"   6 context-any   s_in_an            (list garlic mandrake sulphorous_ash))
355(mk-spell 'wis_an_ylem      "X-Ray Vision <Wis An Ylem>"        wis-an-ylem      "WAY"  6 context-any   s_wis_an_ylem      (list mandrake sulphorous_ash))
356(mk-spell 'an_xen_ex        "Charm <An Xen Ex>"                 an-xen-ex        "AXE"  6 context-town  s_an_xen_ex        (list black_pearl nightshade spider_silk))
357(mk-spell 'in_vas_por_ylem  "Tremor <In Vas Por Ylem>"          in-vas-por-ylem  "IVPY" 6 context-town  s_in_vas_por_ylem  (list mandrake blood_moss sulphorous_ash))
358(mk-spell 'quas_an_wis      "Confusion <Quas An Wis>"           quas-an-wis      "QAW"  6 context-town  s_quas_an_wis      (list mandrake nightshade))
359(mk-spell 'vas_uus_ylem     "Raise Ship <Vas Uus Ylem>"         vas-uus-ylem     "VUY"  6 context-world s_vas_uus_ylem     (list mandrake blood_moss spider_silk))
360(mk-spell 'in_rel_por       "Telekinesis <In Rel Por>"          in-rel-por       "IRP"  6 context-town  s_in_rel_por       (list black_pearl blood_moss spider_silk))
361(mk-spell 'vas_por          "Teleport Party <Vas Por>"          vas-por          "VP"   6 context-world s_vas_por          (list mandrake black_pearl blood_moss))
362
363;; Seventh Circle
364(mk-spell 'in_nox_hur       "Poison Wind <In Nox Hur>"          in-nox-hur       "INH"  7 context-town  s_in_nox_hur       (list nightshade sulphorous_ash blood_moss))
365(mk-spell 'in_zu_hur        "Wind of Sleep <In Zu Hur>"         in-zu-hur        "IZH"  7 context-town  s_in_zu_hur        (list mandrake ginseng blood_moss))
366(mk-spell 'in_quas_corp     "Fear <In Quas Corp>"               in-quas-corp     "IQC"  7 context-town  s_in_quas_corp     (list nightshade mandrake garlic))
367(mk-spell 'sanct_lor        "Invisibility <Sanct Lor>"          sanct-lor        "SL"   7 context-any   s_sanct_lor        (list nightshade mandrake blood_moss))
368(mk-spell 'xen_corp         "Death Bolt <Xen Corp>"             xen-corp         "XC"   7 context-town  s_xen_corp         (list nightshade black_pearl))
369(mk-spell 'in_quas_xen      "Clone <In Quas Xen>"               in-quas-xen      "IQX"  7 context-town  s_in_quas_xen      (list nightshade mandrake sulphorous_ash spider_silk blood_moss ginseng))
370
371;; Eighth Circle
372(mk-spell 'kal_xen_nox      "Summon Slime <Kal Xen Nox>"        kal-xen-nox      "KXN"  8 context-town  s_kal_xen_nox      (list spider_silk mandrake nightshade))
373(mk-spell 'in_flam_hur      "Flame Wind <In Flam Hur>"          in-flam-hur      "IFH"  8 context-town  s_in_flam_hur      (list mandrake sulphorous_ash blood_moss))
374(mk-spell 'in_vas_grav_corp "Death Wind <In Vas Grav Corp>"     in-vas-grav-corp "IVGC" 8 context-town  s_in_vas_grav_corp (list mandrake sulphorous_ash nightshade))
375(mk-spell 'an_tym           "Time Stop <An Tym>"                an-tym           "AT"   8 context-any   s_an_tym           (list mandrake garlic blood_moss))
376(mk-spell 'kal_xen_corp     "Summon Undead <Kal Xen Corp>"      kal-xen-corp     "KXC"  8 context-town  s_kal_xen_corp     (list spider_silk mandrake nightshade))
377(mk-spell 'in_mani_corp     "Resurrection <In Mani Corp>"       in-mani-corp     "IMC"  8 context-any   s_in_mani_corp     (list garlic ginseng spider_silk sulphorous_ash blood_moss mandrake))
378(mk-spell 'vas_rel_por      "Gate <Vas Rel Por>"                vas-rel-por      "VRP"  8 context-any   s_vas_rel_por      (list sulphorous_ash mandrake black_pearl))
379
380