1;;---------------------------------------------------------------------------- 2;; Ability "class" 3;;---------------------------------------------------------------------------- 4 5(define default-aap 50) 6 7(define (mk-ability name level mana ap rng proc) 8 (list name level mana (* ap default-aap) proc rng)) 9 10(define (ability-name ability) (car ability)) 11(define (ability-level-required ability) (cadr ability)) 12(define (ability-mana-cost ability) (caddr ability)) 13(define (ability-ap-cost ability) (cadddr ability)) 14(define (ability-proc ability) (list-ref ability 4)) 15(define (ability-range ability) (list-ref ability 5)) 16 17(define (can-use-ability? ability kchar) 18 ;;(println " can-use-ability?" display ability) 19 (and (<= (kern-get-magic-negated) 0) 20 (>= (kern-char-get-mana kchar) 21 (ability-mana-cost ability)) 22 (>= (kern-char-get-level kchar) 23 (ability-level-required ability)))) 24 25(define (use-ability ability kchar . args) 26 (let ((result (apply (ability-proc ability) (cons kchar args)))) 27 (if result 28 (begin 29 (kern-char-dec-mana kchar (ability-mana-cost ability)) 30 (kern-obj-dec-ap kchar (ability-ap-cost ability)) 31 ) 32 ) 33 (if (<= (kern-char-get-mana kchar) 0) 34 (kern-log-msg (kern-obj-get-name kchar) " is exhausted!")) 35 result)) 36 37 38;;---------------------------------------------------------------------------- 39;; Ability procedures 40;;---------------------------------------------------------------------------- 41 42(define (vampiric-touch-proc kchar ktarg) 43 (let ((amount (min (* (kern-dice-roll "1d3") 44 (kern-char-get-level kchar)) 45 (kern-char-get-hp ktarg)))) 46 (kern-obj-inc-ref ktarg) 47 (kern-obj-apply-damage ktarg "life drained" amount) 48 (kern-obj-heal kchar amount) 49 (kern-log-msg (kern-obj-get-name kchar) 50 " drains life from " 51 (kern-obj-get-name ktarg) 52 "!") 53 (kern-obj-dec-ref ktarg)) 54 #t) 55 56(define (disease-touch-proc kchar ktarg) 57 (if (kern-obj-add-effect ktarg ef_disease nil) 58 (kern-log-msg (kern-obj-get-name kchar) 59 " inflicts " 60 (kern-obj-get-name ktarg) 61 " with Disease!")) 62 #t) 63 64(define (disarm kchar ktarg) 65 (let ((readied (kern-char-get-readied-weapons ktarg))) 66 (if (null? readied) 67 #f 68 (if (> (kern-char-get-level kchar) 69 (+ (kern-dice-roll "1d3-1") 70 (kern-char-get-level ktarg))) 71 (let ((ktype (random-select readied))) 72 (kern-log-msg (kern-obj-get-name kchar) 73 " disarms " 74 (kern-obj-get-name ktarg)) 75 (kern-char-unready ktarg ktype) 76 (kern-obj-remove-from-inventory ktarg ktype 1) 77 (kern-obj-put-at (kern-mk-obj ktype 1) 78 (kern-obj-get-location ktarg)) 79 ) 80 (kern-log-msg (kern-obj-get-name kchar) 81 " fails to disarm " 82 (kern-obj-get-name ktarg)) 83 #t)))) 84 85(define (heal-proc kchar ktarg) 86 (kern-log-msg (kern-obj-get-name kchar) 87 " casts a healing spell on " 88 (if (eqv? kchar ktarg) 89 "self" 90 (kern-obj-get-name ktarg))) 91 (kern-obj-heal ktarg 92 (+ 2 (kern-dice-roll "1d10") 93 (kern-dice-roll (string-append "2d" (number->string (occ-ability-whitemagic kchar))))))) 94 95(define (great-heal-proc kchar ktarg) 96 (kern-log-msg (kern-obj-get-name kchar) 97 " casts a great healing spell on " 98 (if (eqv? kchar ktarg) 99 "self" 100 (kern-obj-get-name ktarg))) 101 (kern-obj-heal ktarg (kern-dice-roll "4d20+20"))) 102 103;;---------------------------------------------------------------------------- 104;; field spells 105(define (cast-field-proc kchar loc ktype) 106 (kern-log-msg (kern-obj-get-name kchar) 107 " casts "(kern-type-get-name ktype) "!") 108 (kern-obj-put-at (kern-mk-obj ktype 1) loc)) 109 110(define (cast-fire-field-proc kchar ktarg) 111 (cast-field-proc kchar 112 (kern-obj-get-location ktarg) 113 F_fire)) 114 115(define (cast-poison-field-proc kchar ktarg) 116 (cast-field-proc kchar 117 (kern-obj-get-location ktarg) 118 F_poison)) 119 120(define (cast-sleep-field-proc kchar ktarg) 121 (cast-field-proc kchar 122 (kern-obj-get-location ktarg) 123 F_sleep)) 124 125(define (cast-energy-field-proc kchar ktarg) 126 (cast-field-proc kchar 127 (kern-obj-get-location ktarg) 128 F_energy)) 129 130;;---------------------------------------------------------------------------- 131;; missile spells 132 133;; cast-magic-missile-proc -- damage goes up with level of caster 134(define (cast-magic-missile-proc kchar ktarg) 135 (powers-magic-missile kchar ktarg (occ-ability-blackmagic kchar))) 136 137(define (cast-poison-missile-proc kchar ktarg) 138 (powers-poison kchar ktarg (occ-ability-blackmagic kchar))) 139 140(define (cast-fireball-proc kchar ktarg) 141 (let ((target (kern-obj-get-location ktarg)) 142 (power (occ-ability-blackmagic kchar))) 143 (and (powers-fireball-collateral-check kchar target power) 144 (powers-fireball kchar target power)) 145 )) 146 147(define (cast-kill-proc kchar ktarg) 148 (kern-log-msg (kern-obj-get-name kchar) 149 " casts kill at " 150 (kern-obj-get-name ktarg)) 151 (cast-missile-proc kchar ktarg t_deathball)) 152 153(define (cast-acid-missile-proc kchar ktarg) 154 (kern-log-msg (kern-obj-get-name kchar) 155 " hurls acid missile at " 156 (kern-obj-get-name ktarg)) 157 (cast-missile-proc kchar ktarg t_acid_bolt)) 158 159(define (web-spew-proc kchar ktarg) 160 (kern-log-msg (kern-obj-get-name kchar) 161 " spews web at " 162 (kern-obj-get-name ktarg)) 163 (define (spew-in-dir dir) 164 (define (ensnare-loc loc) 165 (kern-obj-put-at (kern-mk-obj web-type 1) loc)) 166 (let ((loc (kern-obj-get-location kchar))) 167 (cast-wind-spell2 loc 168 ensnare-loc 169 dir 170 (/ (kern-char-get-level kchar) 2)))) 171 (let* ((v (loc-diff (kern-obj-get-location kchar) 172 (kern-obj-get-location ktarg) 173 )) 174 (dir (loc-to-cardinal-dir v))) 175 (spew-in-dir dir))) 176 177(define (teleport-proc kchar loc) 178 (kern-log-msg (kern-obj-get-name kchar) 179 " teleports") 180 (kern-obj-relocate kchar loc nil)) 181 182(define (fire-wind-proc3 kchar ktarg) 183 (kern-log-msg (kern-obj-get-name kchar) 184 " blasts fire at " 185 (kern-obj-get-name ktarg)) 186 (define (spew-in-dir dir) 187 (define (ensnare-loc loc) 188 (kern-obj-put-at (kern-mk-obj F_fire 1) loc)) 189 (let ((loc (kern-obj-get-location kchar))) 190 (cast-wind-spell2 loc 191 ensnare-loc 192 dir 193 4))) 194 (let* ((v (loc-diff (kern-obj-get-location kchar) 195 (kern-obj-get-location ktarg) 196 )) 197 (dir (loc-to-cardinal-dir v))) 198 (spew-in-dir dir))) 199 200(define (fire-wind-proc kchar ktarg) 201 ;;(println "flamewind") 202 (let ((target (kern-obj-get-location ktarg)) 203 (power (occ-ability-blackmagic kchar))) 204 (and (powers-cone-fire-test kchar target power) 205 (begin 206 ;;(println "flamewind2") 207 (kern-log-msg (kern-obj-get-name kchar) 208 " blasts fire at " 209 (kern-obj-get-name ktarg)) 210 (powers-cone-fire kchar target power) 211 )) 212 )) 213 214(define (lightning-bolt-proc kchar ktarg) 215 (let ((target (kern-obj-get-location ktarg)) 216 (power (occ-ability-blackmagic kchar))) 217 (and (powers-lightning-collateral-check kchar target power) 218 (begin (kern-log-msg (kern-obj-get-name kchar) 219 " streams lightning at " 220 (kern-obj-get-name ktarg)) 221 (powers-lightning kchar target power) 222 )) 223 )) 224 225 226;;---------------------------------------------------------------------------- 227;; summoning 228(define (cast-summon-proc kchar gen-npct quantity) 229 (define (run-loop count) 230 (cond ((<= count 0) 0) 231 (else 232 (let* ((lvl (+ (kern-dice-roll "1d2") (/ (kern-char-get-level kchar) 2))) 233 (knpc (spawn-npc (gen-npct) lvl)) 234 (loc (pick-loc (kern-obj-get-location kchar) knpc)) 235 ) 236 (cond ((null? loc) 237 (kern-obj-dec-ref knpc) 238 0) 239 (else 240 (kern-being-set-base-faction knpc (kern-being-get-base-faction kchar)) 241 (kern-obj-set-temporary knpc #t) 242 (kern-obj-put-at knpc loc) 243 (+ 1 (run-loop (- count 1))))))))) 244 (cond ((> (run-loop quantity) 245 0) 246 (kern-log-msg (kern-obj-get-name kchar) " summons help") 247 #t) 248 (else 249 (kern-log-msg (kern-obj-get-name kchar) " fails to summon help") 250 #f))) 251 252(define (summon-skeleton-proc kchar) 253 ;;(println "summon-skeleton-proc") 254 (cast-summon-proc kchar 255 (lambda () 256 (random-select (list 'skeletal-warrior 'skeletal-spear-thrower))) 257 (/ (kern-char-get-level kchar) 2) 258 )) 259 260(define (summon-slime-proc kchar) 261 ;;(println "summon-slime-proc") 262 (cast-summon-proc kchar 263 (lambda () 'green-slime) 264 (/ (kern-char-get-level kchar) 2) 265 )) 266 267(define (summon-demon-proc kchar) 268 (cast-summon-proc kchar 269 (lambda () 'demon) 270 1)) 271 272(define (summon-wolf-proc kchar) 273 (cast-summon-proc kchar 274 (lambda () 'wolf) 275 1)) 276 277(define (summon-ratling-proc kchar) 278 (cast-summon-proc kchar 279 (lambda () 'ratling-swarmer) 280 (* (kern-char-get-level kchar) 3) 281 )) 282 283;;---------------------------------------------------------------------------- 284;; enslave -- aka charm 285(define (enslave-proc kchar ktarg) 286 (kern-log-msg (kern-obj-get-name kchar) 287 " enslaves " 288 (kern-obj-get-name ktarg)) 289 (kern-obj-add-effect ktarg 290 ef_charm 291 (charm-mk (kern-being-get-current-faction kchar)))) 292 293;;---------------------------------------------------------------------------- 294;; chomp-deck -- convert deck terrain into shallow water terrain 295(define (chomp-deck-proc kchar loc) 296 (cond ((not (is-deck? (kern-place-get-terrain loc))) #f) 297 ((not (null? (get-being-at loc))) #f) 298 (else 299 (kern-place-set-terrain loc t_shallow) 300 (msg-log-visible (kern-obj-get-location kchar) (kern-obj-get-name kchar) " chomps through the deck!") 301 (map kern-obj-remove 302 (kern-get-objects-at loc)) 303 (if (kern-place-is-combat-map? (loc-place loc)) 304 (let* ((vehicle (kern-party-get-vehicle (kern-get-player)))) 305 (if (not (null? vehicle)) 306 (begin 307 (shake-map 10) 308 (kern-obj-apply-damage vehicle "breakage" (floor (/ (kern-obj-get-hp vehicle) 7))) 309 ) 310 ) 311 ) 312 ) 313 #t))) 314 315(define (deck-to-sludge-proc kchar loc) 316 (cond ((not (is-deck? (kern-place-get-terrain loc))) #f) 317 (else 318 (kern-place-set-terrain loc t_shallow_sludge) 319 (kern-log-msg (kern-obj-get-name kchar) " chomps through the deck!") 320 #t))) 321 322;;---------------------------------------------------------------------------- 323;; narcotize -- mass sleep 324(define (narcotize-proc kchar) 325 (let ((hostiles (all-hostiles kchar))) 326 (cond ((null? hostiles) #f) 327 (else 328 (kern-log-msg (kern-obj-get-name kchar) 329 " beckons slumber to its foes") 330 (map (lambda (ktarg) 331 (if (> (- (+ (kern-dice-roll "1d20") 332 (kern-char-get-level kchar)) 333 (kern-char-get-level ktarg)) 334 12) 335 (begin 336 (apply-sleep ktarg) 337 (kern-log-msg (kern-obj-get-name ktarg) " succumbs!") 338 ) 339 (kern-log-msg (kern-obj-get-name ktarg) " resists!"))) 340 hostiles) 341 #t)))) 342 343;;---------------------------------------------------------------------------- 344;; turn invisible 345(define (turn-invisible-proc kchar) 346 (kern-log-msg (kern-obj-get-name kchar) 347 " vanishes!") 348 (kern-obj-add-effect kchar ef_invisibility nil)) 349 350;;---------------------------------------------------------------------------- 351;; Ability declarations 352;; 353;; L = level 354;; M = mana 355;; A = action points 356;; R = range 357;; 358;;---------------------------------------------------------------------------- 359 360;; name L M A R proc 361(define vampiric-touch (mk-ability "vampiric touch" 3 3 2 1 vampiric-touch-proc)) 362(define disease-touch (mk-ability "disease touch" 6 6 1 1 disease-touch-proc)) 363(define disarm (mk-ability "disarm" 4 2 2 1 disarm)) 364(define heal-ability (mk-ability "heal" 1 1 1 2 heal-proc)) 365(define great-heal-ability (mk-ability "great heal" 4 4 2 2 great-heal-proc)) 366(define cast-fire-field (mk-ability "cast fire field" 3 3 2 1 cast-fire-field-proc)) 367(define cast-poison-field (mk-ability "cast poison field" 3 3 2 1 cast-poison-field-proc)) 368(define cast-sleep-field (mk-ability "cast sleep field" 3 3 2 1 cast-sleep-field-proc)) 369(define cast-energy-field (mk-ability "cast energy field" 4 4 2 1 cast-energy-field-proc)) 370(define cast-magic-missile (mk-ability "cast magic missile" 1 1 1 6 cast-magic-missile-proc)) 371(define cast-poison-missile (mk-ability "cast poison missile" 2 2 1 6 cast-poison-missile-proc)) 372(define cast-fireball (mk-ability "cast fireball" 3 3 1 6 cast-fireball-proc)) 373(define cast-kill (mk-ability "cast kill" 7 7 2 4 cast-kill-proc)) 374(define cast-acid-missile (mk-ability "cast acid missile" 4 4 1 4 cast-acid-missile-proc)) 375(define web-spew (mk-ability "spew web" 4 4 2 5 web-spew-proc)) 376(define teleport (mk-ability "teleport" 6 6 2 0 teleport-proc)) 377(define summon-skeleton (mk-ability "summon skeleton" 6 6 4 0 summon-skeleton-proc)) 378(define summon-slimes (mk-ability "summon slimes" 2 2 3 0 summon-slime-proc)) 379(define summon-demon (mk-ability "summon demon" 8 8 6 0 summon-demon-proc)) 380(define summon-wolves (mk-ability "summon wolves" 4 4 2 0 summon-wolf-proc)) 381(define summon-ratlings (mk-ability "summon ratlings" 1 2 4 0 summon-ratling-proc)) 382(define chomp-deck (mk-ability "chomp deck" 2 4 3 1 chomp-deck-proc)) 383(define deck-to-sludge (mk-ability "chomp deck" 1 1 1 1 deck-to-sludge-proc)) 384(define enslave (mk-ability "enslave" 3 4 2 4 enslave-proc)) 385(define narcotize (mk-ability "narcotize" 5 6 3 0 narcotize-proc)) 386(define cast-fire-wind (mk-ability "fire wind" 6 6 2 9 fire-wind-proc)) 387(define turn-invisible (mk-ability "turn invisible" 7 7 2 0 turn-invisible-proc)) 388(define cast-lightning-bolt (mk-ability "lightning bolt" 4 4 2 9 lightning-bolt-proc)) 389 390;;---------------------------------------------------------------------------- 391;; Abilities listed by various attributes 392;;---------------------------------------------------------------------------- 393 394(define melee-spells 395 (list cast-fire-field 396 cast-sleep-field 397 cast-poison-field 398 cast-energy-field)) 399 400(define all-field-spells 401 (list cast-fire-field 402 cast-poison-field 403 cast-sleep-field 404 cast-energy-field 405 )) 406 407;; ranged-spells -- damaging spells which take a target kchar as an arg. 408(define fireball-spell cast-fireball) 409(define poison-missile-spell cast-poison-missile) 410(define acid-missile-spell cast-acid-missile) 411(define kill-spell cast-kill) 412(define all-ranged-spells 413 (list 414 cast-magic-missile 415 poison-missile-spell 416 fireball-spell 417 cast-fire-wind 418 cast-acid-missile 419 cast-lightning-bolt 420 )) 421 422