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