worlds/haxima-1.002/arms.scm

   1 ;;----------------------------------------------------------------------------
   2 ;; arms.scm - armament types
   3 ;;
   4 ;; The basic primitive for creating an armament type is the kern-mk-arms-type
   5 ;; procedure. This procedure takes a lot of parameters (listed below in
   6 ;; order). A lot of the parameters are boiler-plate for whole classes of
   7 ;; weapons, so I added some "curried" wrapper calls below.
   8 ;;
   9 ;;          tag : the symbol for the type in the script (variable-name)
  10 ;;         name : the string name used by the game
  11 ;;       sprite : sprite for the type
  12 ;;       to-hit : to-hit attack bonus (dice expr)
  13 ;;       damage : attack damage (dice expr)
  14 ;;        armor : damage reduced when hit (dice expr)
  15 ;;      deflect : bonus to deflect attack (dice expr)
  16 ;;        slots : slots it will fit in (e.g., hands)
  17 ;;        hands : number of slots required to ready it
  18 ;;        range : range it will fire
  19 ;;          rap : required action points to attack with it
  20 ;;       AP_mod : modifier to max AP per round for the wielder
  21 ;;      missile : nil or the armament type it fires
  22 ;;       thrown : true or false
  23 ;;         ubiq : true if it needs ammo in inventory, false otherwise
  24 ;;       weight : weight of arms
  25 ;;   fire-sound : string name of sound file to play when it's fired
  26 ;;     gifc-cap :
  27 ;;         gifc :
  28 ;;   stratt_mod : percentage of str based attack bonus used
  29 ;;   dexatt_mod : percentage of dex based attack bonus used
  30 ;;   damage_mod : percentage of damage bonus used
  31 ;;    avoid_mod : multiplier for avoidance bonus (1.0 = no effect)
  32 ;;
  33 ;;
  34 ;;----------------------------------------------------------------------------
  35
  36 ;; This keeps weapons proportional to the default cost, for a one line change between turn systems
  37 (define (weap-ap mult)
  38         (floor (* mult default-weapon-rap)))
  39
  40 (define (armour-ap mult)
  41         (floor (* mult default-armour-apmod)))
  42
  43 (kern-mk-sprite-set 'ss_arms 32 32 9 8 0 0 "arms.png")
  44
  45 ;;-------------------------------------------------------------------------
  46 ;; Temp ifc for mutable attack types
  47 ;;-------------------------------------------------------------------------
  48
  49 (define temp-ifc-state (list 0))
  50
  51 (define (temp-ifc-set tempifc)
  52         (set-car! temp-ifc-state tempifc))
  53
  54 (define temp-ifc
  55   (ifc '()
  56        (method 'hit-loc
  57                (lambda (kmissile kuser ktarget kplace x y dam)
  58                                  ((car temp-ifc-state) kmissile kuser ktarget kplace x y dam)
  59                  ))))
  60
  61 (define temp-cannonball-state (list -1 -1))
  62
  63 (define (temp-cannonball-init x y)
  64         (set-car! temp-cannonball-state x)
  65         (set-car! (cdr temp-cannonball-state) y)
  66                 )
  67
  68 ;;--------------------------------------------------------------------------
  69 ;; Curried constructors
  70 ;;
  71 ;; These are for creating the standard classes of armaments. They simplify
  72 ;; things by filling in the blanks for all the boilerplate parameters of
  73 ;; the primitive kern-mk-arms-type procedure.
  74 ;;--------------------------------------------------------------------------
  75
  76 (define obj-ifc-cap (ifc-cap obj-ifc))
  77
  78 (define (mk-melee-arms-type tag name sprite to-hit-bonus damage deflect AP_cost AP_mod slots
  79                             num-hands range weight
  80                                                         stratt_mod dexatt_mod
  81                                                         damage_mod avoid_mod)
  82   (kern-mk-arms-type tag name sprite to-hit-bonus damage "0" deflect slots
  83                      num-hands range AP_cost AP_mod nil nil #f #f weight nil
  84                                          obj-ifc-cap obj-ifc stratt_mod dexatt_mod damage_mod avoid_mod mmode-smallobj))
  85
  86 ;; Curried constructor: missile weapon (add missile, ubiq flag to melee)
  87 (define (mk-projectile-arms-type tag name sprite to-hit-bonus damage deflect AP_cost AP_mod
  88                                  slots num-hands range projectile ammo ubiq weight
  89                                                                  stratt_mod dexatt_mod damage_mod avoid_mod ifc)
  90   (kern-mk-arms-type tag name sprite to-hit-bonus damage "0" deflect slots
  91                      num-hands range AP_cost AP_mod projectile ammo #f ubiq weight nil (ifc-cap ifc) ifc stratt_mod dexatt_mod damage_mod avoid_mod mmode-smallobj))
  92
  93 ;; Curried constructor: thrown weapon (add field to melee)
  94 (define (mk-thrown-arms-type tag name sprite to-hit-bonus damage deflect AP_cost AP_mod slots
  95                              num-hands range missile ubiq ifc weight
  96                                                          stratt_mod dexatt_mod damage_mod avoid_mod)
  97   (kern-mk-arms-type tag name sprite to-hit-bonus damage "0" deflect slots
  98                      num-hands range AP_cost AP_mod missile nil #t ubiq weight nil (ifc-cap ifc) ifc stratt_mod dexatt_mod damage_mod avoid_mod mmode-smallobj))
  99
 100 (define (mk-ammo-arms-type tag name sprite ifc mmode)
 101   (kern-mk-arms-type tag name sprite "0" "0" "0" "0" slot-nil 0 0 0 0 nil nil #f #f
 102                      0 nil (ifc-cap ifc) ifc 20 60 20 1.0 mmode))
 103
 104 (define (mk-missile-arms-type tag name sprite ifc mmode beam)
 105   (kern-mk-missile-type tag name sprite (ifc-cap ifc) ifc mmode beam beam))
 106
 107 (define (mk-armor-type tag name sprite to-hit armor slots equiptime AP_mod weight avoid_mod)
 108   (kern-mk-arms-type tag name sprite to-hit "0" armor "0" slots 1 0 equiptime AP_mod nil nil #f #f
 109                      weight nil obj-ifc-cap obj-ifc 20 60 20 avoid_mod mmode-largeobj))
 110
 111 (define (mk-shield-type tag name sprite to-hit deflect AP_mod slots weight avoid_mod)
 112   (kern-mk-arms-type tag name sprite to-hit "0" "0" deflect slots 1 0 default-weapon-rap AP_mod nil nil #f #f
 113                      weight nil obj-ifc-cap obj-ifc 20 60 20 avoid_mod mmode-largeobj))
 114
 115 ;; ============================================================================
 116 ;; Missiles for Projectile Weapons & Spells
 117 ;; ============================================================================
 118
 119 (kern-mk-sprite 's_sling_stone               ss_arms 1  0  #f   0 )
 120 (kern-mk-sprite 's_warhead                   ss_arms 1  1  #f   0 )
 121 (kern-mk-sprite 's_cannonball                ss_arms 1  2  #f   0 )
 122 (kern-mk-sprite 's_fireball                  ss_arms 1  3  #f   0 )
 123 (kern-mk-sprite 's_deathball                 ss_arms 1  4  #f   0 )
 124 (kern-mk-sprite 's_arrow                     ss_arms 1  8  #f 495 )
 125 (kern-mk-sprite 's_bolt                      ss_arms 1 80  #f 495 )
 126 (kern-mk-sprite 's_arrowobj                  ss_arms 1 68  #f   0 )
 127 (kern-mk-sprite 's_arrowstack                ss_arms 1 69  #f   0 )
 128 (kern-mk-sprite 's_boltobj                   ss_arms 1 70  #f   0 )
 129 (kern-mk-sprite 's_boltstack                 ss_arms 1 71  #f   0 )
 130 (kern-mk-sprite 's_poison_bolt               ss_arms 1 16  #f 170 )
 131 (kern-mk-sprite 's_acid_bolt                 ss_arms 1 20  #f 170 )
 132 (kern-mk-sprite 's_thrownweb                 ss_arms 1 31  #f   0 )
 133 (kern-mk-sprite 's_prismatic_bolt            ss_arms 4 100  #f   0 )
 134 (kern-mk-sprite 's_squat_bubbly_green_potion ss_arms 1 30  #f   0 )
 135 (kern-mk-sprite 's_thrown_green_potion       ss_arms 4 104  #f   0 )
 136
 137 ;; ----------------------------------------------------------------------------
 138 ;; mk-missile-ifc -- automate missile ifc creation. 'pred?' takes an object as
 139 ;; a parameter and returns true iff the 'hit' proc should be applied to it.
 140 ;; ----------------------------------------------------------------------------
 141 (define (mk-missile-ifc hit)
 142   (ifc '()
 143        (method 'hit-loc (lambda (kmissile kuser ktarget kplace x y dam)
 144                           (let ((targets (filter obj-is-char?
 145                                                  (kern-get-objects-at (mk-loc kplace
 146                                                                               x
 147                                                                               y)))))
 148                             (if (notnull? targets)
 149                                 (hit (car targets))))))))
 150
 151
 152 (define poison-bolt-ifc (mk-missile-ifc apply-poison))
 153 (define deathball-ifc   (mk-missile-ifc magical-kill))
 154 (define stunball-ifc (mk-missile-ifc paralyze))
 155 (define acid-bolt-ifc (mk-missile-ifc apply-acid))
 156
 157 (define lightningbolt-ifc
 158         (ifc '()
 159                 (method 'enter
 160                         (lambda (kmissile kplace x y)
 161                                 ((car temp-ifc-state) kmissile nil nil kplace x y 0)
 162                                 ))
 163                 ))
 164
 165 (define (on-hit-nontarget ktarget loc dam proc)
 166         (for-each proc
 167                 (if (> dam -1)
 168                 (filter (lambda (obj) (not (equal? obj ktarget)))
 169                 (kern-get-objects-at loc))
 170         (kern-get-objects-at loc)
 171                 ))
 172 )
 173
 174 (define (on-hit-target ktarget dam proc)
 175         (if (> dam -1)
 176                 (proc ktarget)
 177         ))
 178
 179 ;; fireball-hit -- when a fireball hits it burns all characters and leaves a
 180 ;; fire
 181 (define fireball-ifc
 182   (ifc '()
 183        (method 'hit-loc
 184                (lambda (kmissile kuser ktarget kplace x y dam)
 185                 (let* (
 186                                 (havemana (> (kern-char-get-mana kuser) 0))
 187                                 (usedmana (if (and havemana (equal? (kern-dice-roll "1d15") 1))
 188                                                         (
 189                                                                 begin
 190                                                                 (kern-char-set-mana kuser (- (kern-char-get-mana kuser) 1))
 191                                                                 #t
 192                                                         )
 193                                                         #f))
 194                                 (setfire (and usedmana (equal? (kern-dice-roll "1d3") 1)))
 195                                 (loc (mk-loc kplace x y))
 196                                 (hurt (> dam 0))
 197                                 (targdamage (cond
 198                                                                         (usedmana (if hurt "2d5+3" "2d4+2"))
 199                                                                         (havemana (if hurt "2d4+2" "2d3+2"))
 200                                                                         (else (if hurt "1d4-1" "1d2-1"))
 201                                                                         ))
 202                                 (othdamage (cond
 203                                                                         (usedmana "2d3+2")
 204                                                                         (havemana "1d4")
 205                                                                         (else "0")
 206                                                                         ))
 207                                 )
 208                         (if (and setfire (terrain-ok-for-field? loc))
 209                                         (kern-obj-put-at (kern-mk-field F_fire (kern-dice-roll "1d5")) loc))
 210                                 (if (not havemana)
 211                                                 (kern-log-msg "Attack fizzles!"))
 212                                 (on-hit-target ktarget dam
 213                                         (lambda (obj) (generic-burn obj targdamage))
 214                                 )
 215                         (if havemana
 216                                 (on-hit-nontarget ktarget loc dam
 217                                         (lambda (obj) (generic-burn obj othdamage)))
 218                                 )
 219                ))
 220                         )))
 221
 222 (define (prismatic-acid ktarget power)
 223         (if (and (kern-obj-is-char? ktarget)
 224                         (contest-of-skill power
 225                                 (occ-ability-dexdefend ktarget)))
 226                 (apply-acid ktarget)))
 227
 228 (define (prismatic-slip ktarget power)
 229         (if (and (kern-obj-is-char? ktarget)
 230                         (contest-of-skill power
 231                         (occ-ability-dexdefend ktarget)))
 232                 (slip ktarget)))
 233
 234 (define prismatic-bolt-ifc
 235         (ifc '()
 236        (method 'hit-loc
 237                (lambda (kmissile kuser ktarget kplace x y dam)
 238                 (let* (
 239                                 (havemana (> (kern-char-get-mana kuser) 0))
 240                                 (usedmana (if (and havemana (equal? (kern-dice-roll "1d15") 1))
 241                                                         (
 242                                                                 begin
 243                                                                 (kern-char-set-mana kuser (- (kern-char-get-mana kuser) 1))
 244                                                                 #t
 245                                                         )
 246                                                         #f))
 247                                 (magpower (if havemana
 248                                                 (if usedmana (max 7 (occ-ability-blackmagic kuser)) 5)
 249                                                 0))
 250                                 (loc (mk-loc kplace x y))
 251                                 (hit (> dam -1))
 252                                 (hurt (> dam 0))
 253                                 (havetarget (not (eqv? ktarget '())))
 254                                 (pristype (kern-dice-roll "1d100"))
 255                                 (proclist
 256
 257                                                 (cond ((< pristype 10)
 258                                                                 (list nil
 259                                                         (lambda (obj) (powers-paralyse kuser obj magpower))
 260                                                         (lambda (obj) (powers-paralyse kuser obj (- magpower 3)))))
 261
 262                                                         ((< pristype 20)
 263                                                                 (list nil
 264                                                         (lambda (obj) (prismatic-acid obj magpower))
 265                                                         (lambda (obj) (prismatic-acid obj (- magpower 3)))))
 266
 267                                                                 ((< pristype 30)
 268                                                                         (list nil
 269                                                         (lambda (obj) (powers-poison-effect kuser obj (+ magpower 3)))
 270                                                         (lambda (obj) (powers-poison-effect kuser obj (- magpower 2)))))
 271
 272                                                         ((< pristype 40)
 273                                                                         (list nil
 274                                                         (lambda (obj) (generic-burn obj "2d3+2"))
 275                                                         (lambda (obj) (generic-burn obj "1d5"))))
 276
 277                                                         ((< pristype 50)
 278                                                                         (list nil
 279                                                         (lambda (obj) (apply-lightning obj))
 280                                                         (lambda (obj) (apply-lightning obj))))
 281
 282                                                                                 ((< pristype 60)
 283                                                                         (list nil
 284                                                         (lambda (obj) (prismatic-slip obj (+ magpower 5)))
 285                                                         (lambda (obj) (prismatic-slip obj (+ magpower 2)))))
 286
 287                                                                         ((< pristype 70)
 288                                                                         (list
 289                                                                 (lambda (loc) (powers-field-energy-weak kuser loc magpower))
 290                                                                 nil nil))
 291
 292                                                                         ((< pristype 80)
 293                                                                         (list
 294                                                                 (lambda (loc) (powers-field-fire-weak kuser loc magpower))
 295                                                                 nil nil))
 296
 297                                                                         ((< pristype 90)
 298                                                                         (list
 299                                                                 (lambda (loc) (powers-field-poison-weak kuser loc magpower))
 300                                                                 nil nil))
 301
 302                                                                         ((< pristype 101)
 303                                                                         (list
 304                                                                 (lambda (loc) (powers-field-sleep-weak kuser loc magpower))
 305                                                                 nil nil))
 306                                 )))
 307                                 (if (not havemana)
 308                                                 (kern-log-msg "Attack fizzles!")
 309                                                 (begin
 310                                                         (if (not (null? (car proclist)))
 311                                                                 ((car proclist) loc))
 312                                                         (if (not (null? (cadr proclist)))
 313                                                                 (on-hit-target ktarget dam (cadr proclist)))
 314                                                         (if (not (null? (caddr proclist)))
 315                                                                 (on-hit-nontarget ktarget loc dam (caddr proclist)))
 316                                                 )
 317                                         )
 318                         ))
 319                         )))
 320
 321 (define warhead-ifc
 322   (ifc nil
 323        (method 'hit-loc
 324                (lambda (kmissile kuser ktarget kplace x y dam)
 325                  (kern-obj-put-at (kern-mk-obj F_fire 1)
 326                                   (mk-loc kplace x y))))))
 327
 328 (kern-mk-sprite 's_flaming_oil    ss_arms 4 96 #f 0)
 329 (kern-mk-sprite 's_oil_potion     ss_arms 1 5 #f 0)
 330 (kern-mk-sprite 's_spear          ss_arms 1 88 #f 495 )
 331 (kern-mk-sprite 's_spearobj       ss_arms 1 6 #f 0)
 332 (kern-mk-sprite 's_throwing_axe   ss_arms 1 29 #f 0)
 333 (kern-mk-sprite 's_thrown_axe     ss_arms 8 72 #f 0)
 334 (kern-mk-sprite 's_thrown_boulder ss_arms 1 7 #f 0)
 335 (kern-mk-sprite 's_smoke_bomb     ss_arms 4 112 #f 0)
 336 (kern-mk-sprite 's_smoke_potion   ss_arms 1 108 #f 0)
 337
 338 (define flaming-oil-ifc
 339   (ifc obj-ifc
 340        (method 'hit-loc
 341                (lambda (kmissile kuser ktarget kplace x y dam)
 342                  (kern-obj-put-at (kern-mk-obj F_fire 1)
 343                                   (mk-loc kplace x y))))))
 344
 345 (define vial-of-slime-ifc
 346   (ifc obj-ifc
 347        (method 'hit-loc
 348                (lambda (kmissile kuser ktarget kplace x y dam)
 349                  (let* ((lvl (kern-dice-roll "1d3+5"))
 350                         (knpc (spawn-npc 'green-slime lvl))
 351                         (loc (pick-loc (mk-loc kplace x y) knpc)))
 352                    (cond ((null? loc)
 353                           (kern-obj-dec-ref knpc)
 354                           0)
 355                          (else
 356                           (kern-being-set-base-faction knpc (kern-being-get-base-faction kuser))
 357                           (kern-obj-set-temporary knpc #t)
 358                           (kern-obj-put-at knpc loc))))))))
 359
 360 (define smoke-bomb-ifc
 361         (ifc obj-ifc
 362                 (method 'hit-loc
 363                         (lambda (kmissile kuser ktarget kplace x y dam)
 364                                 (fields-smoke-apply kplace x y 10)
 365                 ))))
 366
 367 (define (mk-drop-proj-ifc type-tag prob)
 368         (ifc obj-ifc
 369        (method 'hit-loc
 370                (lambda (kmissile kuser ktarget kplace x y dam)
 371                 (if (< (kern-dice-roll "1d100") prob)
 372                         (let ((dropobj (kern-mk-obj (eval type-tag) 1))
 373                                         (loc (mk-loc kplace x y)))
 374                                 (if (can-be-dropped? dropobj loc cant)
 375                                         (kern-obj-put-at dropobj loc)
 376                 ))))
 377       )))
 378
 379 ;; todo: handle possibility that magicaxe doesnt have a wielder?
 380 (define magicaxe-ifc
 381         (ifc obj-ifc
 382                 (method 'hit-loc
 383                         (lambda (kmissile kuser ktarget kplace x y dam)
 384                                 (kern-fire-missile (eval 't_returning_axe_p) (mk-loc kplace x y) (kern-obj-get-location kuser))
 385                                 (kern-log-msg "Magic axe returns!")
 386                         )
 387         ))
 388 )
 389
 390
 391 (define missile-arms-types
 392   (list
 393    ;;    ==================================================================================================
 394    ;;    tag                 | name          | sprite          | gifc              | movement_mode | beam
 395    ;;    ====================================================================================================
 396    (list 't_slingstone        "sling stone"    s_sling_stone     obj-ifc             mmode-missile      #f)
 397    (list 't_arrow_p           "arrow"          s_arrow           (mk-drop-proj-ifc 't_arrow 5)
 398                                                                                      mmode-missile      #f  )
 399    (list 't_bolt_p            "bolt"           s_bolt            (mk-drop-proj-ifc 't_bolt 5)
 400                                                                                      mmode-missile      #f  )
 401    (list 't_warhead_p         "warhead"        s_warhead         warhead-ifc         mmode-missile      #f  )
 402    (list 't_cannonball_p      "cannonball"     s_cannonball      obj-ifc             mmode-missile      #f  )
 403
 404
 405    (list 't_poison_bolt       "poison bolt"    s_poison_bolt     poison-bolt-ifc     mmode-missile      #f  )
 406    (list 't_acid_bolt         "acid bolt"      s_acid_bolt       acid-bolt-ifc       mmode-missile      #f  )
 407    (list 't_fireball          "fireball"       s_fireball        fireball-ifc        mmode-missile      #f  )
 408    (list 't_deathball         "deathball"      s_deathball       deathball-ifc       mmode-missile      #f  )
 409    (list 't_slimeglob         "slime glob"     s_acid_bolt       obj-ifc             mmode-missile      #f  )
 410    (list 't_mfireball         "fireball"       s_fireball        temp-ifc            mmode-missile      #f  )
 411    (list 't_mpoison_bolt      "poison bolt"    s_poison_bolt     temp-ifc            mmode-missile      #f  )
 412    (list 't_prismatic_bolt    "prismatic bolt" s_prismatic_bolt  prismatic-bolt-ifc  mmode-missile      #f  )
 413    (list 't_stunball                    "stun ball"       s_lightning    stunball-ifc            mmode-missile          #f  )
 414    (list 't_lightning_bolt      "lightning bolt"        s_lightning      lightningbolt-ifc   mmode-missile      #t  )
 415    (list 't_magicarrow_p      "arrow"          s_arrow           obj-ifc             mmode-missile      #f  )
 416
 417
 418
 419    (list 't_mweb              "web"            s_thrownweb       temp-ifc            mmode-missile      #f  )
 420    (list 't_oil_p             "flaming oil"    s_flaming_oil     flaming-oil-ifc     mmode-missile      #f  )
 421    (list 't_smoke_bomb_p      "smoke bomb"     s_smoke_bomb      smoke-bomb-ifc      mmode-missile      #f  )
 422    (list 't_spear_p           "spear"          s_spear           (mk-drop-proj-ifc 't_spear 25)
 423                                                                                      mmode-missile      #f  )
 424    (list 't_thrown_axe_p      "thrown axe"     s_thrown_axe      magicaxe-ifc        mmode-missile      #f  )
 425    (list 't_returning_axe_p   "thrown axe"     s_thrown_axe      obj-ifc              mmode-return      #f  )
 426    (list 't_thrown_rock_p     "thrown rock"    s_cannonball      (mk-drop-proj-ifc 't_thrown_rock 80)
 427                                                                                      mmode-missile      #f  )
 428    (list 't_thrown_boulder_p  "hurled boulder" s_thrown_boulder  (mk-drop-proj-ifc 't_thrown_boulder 80)
 429                                                                                      mmode-missile      #f  )
 430
 431    (list 't_slime_vial_p      "vial of slime"  s_thrown_green_potion vial-of-slime-ifc  mmode-missile   #f  )
 432
 433    ))
 434
 435 (map (lambda (type) (apply mk-missile-arms-type type)) missile-arms-types)
 436
 437
 438 (define ammo-arms-types
 439   (list
 440    ;;    ===========================================================================================
 441    ;;    tag                 | name          | sprite          | gifc              | movement_mode
 442    ;;    ===========================================================================================
 443
 444    (list 't_arrow             "arrow"          s_arrowobj        obj-ifc             mmode-smallobj )
 445    (list 't_bolt              "bolt"           s_boltobj         obj-ifc             mmode-smallobj )
 446    (list 't_warhead           "warhead"        s_warhead         warhead-ifc         mmode-smallobj )
 447    (list 't_cannonball        "cannonball"     s_cannonball      obj-ifc             mmode-smallobj )
 448    ))
 449
 450
 451 ;; If we don't create these missile types now, we won't be able to refer to
 452 ;; them below in the projectile-arms-types table. For example, t_bow needs to
 453 ;; refer to t_arrow. But the interpreter won't recognize t_arrow as a variable
 454 ;; name until we call this procedure to create the t_arrow type.
 455 (map (lambda (type) (apply mk-ammo-arms-type type)) ammo-arms-types)
 456
 457 ;; ============================================================================
 458 ;; Projectile Weapons
 459 ;; ============================================================================
 460
 461 (kern-mk-sprite 's_sling      ss_arms 1 24 #f 0)
 462 (kern-mk-sprite 's_bow        ss_arms 1 25 #f 0)
 463 (kern-mk-sprite 's_crossbow   ss_arms 1 26 #f 0)
 464 (kern-mk-sprite 's_doom_staff ss_arms 1 27 #f 0)
 465 (kern-mk-sprite 's_stun_wand  ss_arms 1 28 #f 0)
 466
 467 (define proj-ifc
 468         (ifc obj-ifc
 469                 (method 'on-attack
 470                         (lambda (kuser)
 471                                 (println "oa")
 472                                 (kern-sound-play-at sound-missile (kern-obj-get-location kuser))
 473                         )
 474         ))
 475 )
 476
 477 (define projectile-arms-types
 478   (list
 479    ;;     =========================================================================================================================================================================================
 480    ;;     tag            | name           |  sprite     | to-hit | damage | to-def | AP_cost | AP_mod       | slots       | hnds | rng | missile        | ammo  | ubiq | weight | stratt | dexatt | dammod | avoid | ifc
 481    ;;     =========================================================================================================================================================================================
 482    (list 't_sling          "sling"           s_sling      "1d2-2"  "1d4"    "-1"      (weap-ap 1) 0   slot-weapon   1      4     t_slingstone     nil     #t     0        10       60       30       0.9        proj-ifc)
 483    (list 't_sling_4        "+4 sling"        s_sling      "+3"     "1d4+4"  "+0"      (weap-ap 1) 0   slot-weapon   1      6     t_slingstone     nil     #t     0        10       60       30       0.9        proj-ifc)
 484
 485    (list 't_self_bow       "self bow"        s_bow        "+1"     "1d6"    "-2"      (weap-ap 0.8) 0   slot-weapon   2      4     t_arrow_p        t_arrow #f     2        10       70       20       0.9  proj-ifc)
 486    (list 't_bow            "bow"             s_bow        "1d3-2"  "2d4"    "-2"     (weap-ap 1) 0   slot-weapon   2      5     t_arrow_p        t_arrow #f     2        10       70       20       0.9  proj-ifc)
 487    (list 't_long_bow       "longbow"         s_bow        "1d3-2"  "2d6+1"  "-2"     (weap-ap 1.2) 0   slot-weapon   2      6     t_arrow_p        t_arrow #f     2        10       70       20       0.9  proj-ifc)
 488    (list 't_great_bow      "great bow"       s_bow        "1d3-2"  "2d6+3"  "-2"     (weap-ap 1.34) 0   slot-weapon   2      7     t_arrow_p        t_arrow #f     2        10       70       20       0.9  proj-ifc)
 489
 490    (list 't_lt_crossbow    "light crossbow"  s_crossbow   "1d4-2"  "2d5"    "-1"     (weap-ap 1) 0   slot-weapon   2      5     t_bolt_p         t_bolt  #f     3         0       80        0       0.95 proj-ifc)
 491    (list 't_crossbow       "crossbow"        s_crossbow   "1d4-2"  "4d4"    "-1"     (weap-ap 1) 0   slot-weapon   2      6     t_bolt_p         t_bolt  #f     3         0       80        0       0.95 proj-ifc)
 492    (list 't_hvy_crossbow   "heavy crossbow"  s_crossbow   "1d4-2"  "4d6+2"  "-1"     (weap-ap 2) 0   slot-weapon   2      7     t_bolt_p         t_bolt  #f     3         0       80        0       0.95 proj-ifc)
 493    (list 't_trpl_crossbow  "triple crossbow" s_crossbow   "1d4-2"  "2d5"    "-1"      (weap-ap 0.67) 0   slot-weapon   2      5     t_bolt_p         t_bolt  #f     3         0       80        0       0.95 proj-ifc)
 494
 495    (list 't_doom_staff     "doom staff"      s_doom_staff "1d4"    "1d2"    "+2"     (weap-ap 1) 0    slot-weapon   2      5     t_fireball       nil     #t     2         0       50        0       1.0  proj-ifc)
 496    (list 't_acid_spray     "acid spray"      nil          "-7"     "1d6"    "+0"     (weap-ap 1) 0    slot-nil      2      2     t_slimeglob      nil     #t     0        10       50       20       1.0  proj-ifc)
 497    (list 't_fire_glob      "fire glob"       nil          "-8"     "1d6"    "+0"     (weap-ap 1) 0    slot-nil      2      2     t_fireball       nil     #t     0        10       50       20       1.0  proj-ifc)
 498    (list 't_stun_wand      "stun wand"       s_stun_wand  "-2"     "1d4"    "-1"     (weap-ap 1) 0    slot-weapon   1      6     t_stunball       nil     #t     2         0       80        0       1.0  proj-ifc)
 499    (list 't_acid_wand      "acid wand"       s_stun_wand  "-2"     "1d4"    "-1"     (weap-ap 1) 0    slot-weapon   1      6     t_acid_bolt      nil     #t     2         0       80        0       1.0  proj-ifc)
 500    (list 't_prismatic_gaze "prismatic gaze"  nil          "1d4"    "0"      "+0"     (weap-ap 1) 0    slot-nil      1      3     t_prismatic_bolt nil     #t     0         0        0        0       0.85 proj-ifc)
 501    ))
 502
 503 ;; ============================================================================
 504 ;; Thrown Weapons
 505 ;; ============================================================================
 506
 507
 508 (define thrown-arms-types
 509   (list
 510    ;;     =================================================================================================================================================================================================================
 511    ;;     tag              | name          | sprite                   | to-hit | dmg | to-def | AP_cost | AP_mod        | slots       | hnds | rng | missile          | ubiq | ifc              | weight | stratt | dexatt | dammod | avoid
 512    ;;     =================================================================================================================================================================================================================
 513    (list  't_thrown_rock    "small rock"    s_cannonball                "-2"     "1d2"    "-2"   (weap-ap 1.33) 0  slot-weapon   1      4     t_thrown_rock_p    #t     obj-ifc             1       20       20         0      0.9 )
 514    (list  't_thrown_boulder "loose boulder" s_thrown_boulder            "-2"     "3d4+1"  "-2"  (weap-ap 2) 0  slot-weapon   2      5     t_thrown_boulder_p #f     obj-ifc            10       40       20        60      0.9 )
 515
 516    (list  't_spear          "spear"         s_spearobj                  "+1"     "1d8+1"  "+1"  (weap-ap 1) 0  slot-weapon   1      4     t_spear_p          #f     obj-ifc             2       30       60        40      1.0 )
 517    (list  't_magic_axe      "magical axe"   s_throwing_axe              "+2"     "2d4+2"  "+0"  (weap-ap 1) 0  slot-weapon   1      4     t_thrown_axe_p     #t     obj-ifc             2       30       60        40      1.0 )
 518
 519    (list  't_oil            "flaming oil"   s_oil_potion                "-1"     "1d6"    "-2"  (weap-ap 1.2) 0  slot-weapon   1      4     t_oil_p            #f     flaming-oil-ifc     1       20       30         0      0.9 )
 520    (list  't_slime_vial     "vial of slime" s_squat_bubbly_green_potion "-1"     "1d2"    "-2"  (weap-ap 1.2) 0  slot-weapon   1      4     t_slime_vial_p     #f     vial-of-slime-ifc   1       20       30         0      1.0 )
 521    (list  't_smoke_bomb     "smoke bomb"    s_smoke_potion                "-1"     "1"      "-2"  (weap-ap 1.2) 0  slot-weapon   1      6     t_smoke_bomb_p     #f     smoke-bomb-ifc      1       20       30         0      0.9 )
 522    ))
 523
 524 (map (lambda (type) (apply mk-thrown-arms-type type)) thrown-arms-types)
 525
 526 ;; Inventory sprites
 527 (kern-mk-sprite 's_axe            ss_arms 1 29 #f 0)
 528 (kern-mk-sprite 's_dagger         ss_arms 1 32 #f 0)
 529 (kern-mk-sprite 's_mace           ss_arms 1 33 #f 0)
 530 (kern-mk-sprite 's_sword          ss_arms 1 34 #f 0)
 531 (kern-mk-sprite 's_2h_axe         ss_arms 1 35 #f 0)
 532 (kern-mk-sprite 's_2h_sword       ss_arms 1 36 #f 0)
 533 (kern-mk-sprite 's_morning_star   ss_arms 1 37 #f 0)
 534 (kern-mk-sprite 's_halberd        ss_arms 1 38 #f 0)
 535 (kern-mk-sprite 's_staff          ss_arms 1 39 #f 0)
 536 (kern-mk-sprite 's_eldritch_blade ss_arms 2 40 #f 0)
 537 (kern-mk-sprite 's_mystic_sword   ss_arms 2 42 #f 0)
 538 (kern-mk-sprite 's_flaming_sword  ss_arms 2 44 #f 0)
 539
 540 ;; Paper-doll sprites
 541 (kern-mk-sprite 's_hum_staff_gold     ss_arms 4 56 #f 0)
 542 (kern-mk-sprite 's_hum_staffglo_blue  ss_arms 4 60 #f 0)
 543 (kern-sprite-apply-matrix (kern-sprite-clone s_hum_staffglo_blue
 544                                              's_hum_staffglo_green)
 545                           mat_blue_to_green)
 546 (kern-mk-sprite 's_hum_halberd ss_arms 4 64 #f 0)
 547
 548 (define melee-arms-types
 549   (list
 550    ;;     ===================================================================================================================================================
 551    ;;     tag          |    name           | sprite         | to-hit | damage | to-def | AP_cost | AP_mod | slots | hnds | rng | weight | dxmod | stmod | dammod | avoid
 552    ;;     ===================================================================================================================================================
 553    (list  't_hands          "bare hands"     nil              "1d2"    "1d2"    "1d2"    (weap-ap 0.67) 0 slot-nil      1      1     0        50      20       10      1.0  )
 554    (list  't_F_fangs        "fangs"          nil              "1d2"    "1d4"    "+0"     (weap-ap 0.67) 0 slot-nil      1      1     0        50      20       30      1.0  )
 555    (list  't_fangs          "fangs"          nil              "1d2"    "1d6"    "+0"      (weap-ap 1)   0 slot-nil      1      1     0        50      20       30      1.0  )
 556    (list  't_G_fangs        "great fangs"    nil              "1d2"    "1d10"   "+0"     (weap-ap 1.34) 0 slot-nil      1      1     0        50      20       30      1.0  )
 557    (list  't_horns          "horns"          nil              "1d2"    "1d8"    "1d2"    (weap-ap 0.67) 0 slot-nil      1      1     0        30      40       60      1.0  )
 558    (list  't_stinger        "stinger"        nil              "1d2"    "1d2"    "+0"     (weap-ap 0.67) 0 slot-nil      1      1     0        50      20       10      1.0  )
 559    (list  't_tentacles      "tentacles"      nil              "1d3"    "4d4"    "4d2"     (weap-ap 1)   0 slot-nil      1      1     0        70      20       60      1.0  )
 560    (list  't_beak           "beak"           nil              "+0"     "2d4"    "+0"      (weap-ap 1)   0 slot-nil      1      1     0        50      30       30      1.0  )
 561    (list  't_pincers        "pincers"        nil              "-1"     "4d4"    "4d2"     (weap-ap 1.2) 0 slot-nil      1      1     0        50      30       30      1.0  )
 562
 563    (list  't_dagger         "dagger"         s_dagger         "1d4"    "1d4"    "1d2"     (weap-ap 0.8) 0 slot-weapon   1      1     0        80      10       10      1.0  )
 564    (list  't_dagger_4       "+4 dagger"      s_dagger         "1d4+4"  "1d4+4"  "1d2+4"   (weap-ap 0.8) 0 slot-weapon   1      1     0        80      10       10      1.0  )
 565    (list  't_mace           "mace"           s_mace           "1d4"    "1d6+2"  "+0"      (weap-ap 1)   0 slot-weapon   1      1     3        20      60       80      0.95 )
 566    (list  't_axe            "axe"            s_axe            "1d2"    "2d4+2"  "+0"      (weap-ap 1.2) 0 slot-weapon   1      1     3        30      50       90      0.95 )
 567    (list  't_sword          "sword"          s_sword          "1d2"    "1d8+1"  "1d2"     (weap-ap 1)   0 slot-weapon   1      1     2        50      20       70      1.0  )
 568    (list  't_sword_2        "+2 sword"       s_sword          "1d2+2"  "1d8+3"  "1d2+2"   (weap-ap 1)   0 slot-weapon   1      1     2        50      20       70      1.0  )
 569    (list  't_sword_4        "+4 sword"       s_sword          "1d2+4"  "1d8+5"  "1d2+4"   (weap-ap 1)   0 slot-weapon   1      1     2        50      20       70      1.0  )
 570    (list  't_2H_axe         "2H axe"         s_2h_axe         "+0"     "4d4+4"  "-2"     (weap-ap 1.34) 0 slot-weapon   2      1     4        20      60      100      0.9  )
 571    (list  't_2H_sword       "2H sword"       s_2h_sword       "+0"     "2d8+2"  "+1"      (weap-ap 1.2) 0 slot-weapon   2      1     4        40      40       90      0.95 )
 572    (list  't_morning_star   "morning star"   s_morning_star   "1d2+2"  "1d6+1"  "-1"      (weap-ap 1)   0 slot-weapon   1      2     3        20      40       70      0.9  )
 573    (list  't_morning_star_2 "+2 morning star" s_morning_star  "1d2+4"  "1d6+3"  "+2"      (weap-ap 1)   0 slot-weapon   1      2     3        20      40       70      0.9  )
 574    (list  't_halberd        "halberd"        s_halberd        "1d3+1"  "2d8-2"  "1d2"     (weap-ap 1)   0 slot-weapon   2      2     4        30      30      100      0.9  )
 575    (list  't_staff          "staff"          s_staff          "1d3"    "1d4"    "1d3"     (weap-ap 0.8) 0 slot-weapon   2      2     2        60      30       40      1.0  )
 576    (list  't_eldritch_blade "eldritch blade" s_eldritch_blade "+2"     "3d7+5"  "+0"     (weap-ap 1.34) 0 slot-weapon   2      1     2        50      20       70      1.0  )
 577    (list  't_mystic_sword   "mystic sword"   s_mystic_sword   "+3"     "1d10+5" "+2"      (weap-ap 1)   0 slot-weapon   1      1     1        60      20       70      1.0  )
 578    ))
 579
 580 (kern-mk-sprite 's_leather_helm  ss_arms 1 48 #f 0)
 581 (kern-mk-sprite 's_chain_coif    ss_arms 1 49 #f 0)
 582 (kern-mk-sprite 's_iron_helm     ss_arms 1 50 #f 0)
 583 (kern-mk-sprite 's_leather_armor ss_arms 1 51 #f 0)
 584 (kern-mk-sprite 's_chain_armor   ss_arms 1 52 #f 0)
 585 (kern-mk-sprite 's_plate_armor   ss_arms 1 53 #f 0)
 586
 587 (define armor-types
 588   (list
 589    ;;     ===============================================================================================================
 590    ;;     tag               | name            |  sprite        |  to-hit | armor  | slots     | equip_AP | AP_mod | weight | avoid
 591    ;;     ===============================================================================================================
 592    (list   't_leather_helm    "leather helm"     s_leather_helm   "-1"     "1d2"    slot-helm    (weap-ap 1) -0  0  1.0  )
 593    (list   't_leather_helm_2  "+2 leather helm"  s_leather_helm   "+0"     "1d2+2"  slot-helm    (weap-ap 1) -0  0  1.0  )
 594    (list   't_leather_helm_4  "+4 leather helm"  s_leather_helm   "+0"     "1d2+4"  slot-helm    (weap-ap 1) -0  0  1.0  )
 595
 596    (list   't_chain_coif      "chain coif"       s_chain_coif     "-1"     "1d3"    slot-helm    (weap-ap 1) (armour-ap -1)  1  0.9  )
 597    (list   't_chain_coif_4    "+4 chain coif"    s_chain_coif     "+0"     "1d3+4"  slot-helm    (weap-ap 1) (armour-ap -1)  1  0.9  )
 598
 599    (list   't_iron_helm       "iron helm"        s_iron_helm      "-1"     "1d4"    slot-helm    (weap-ap 1) (armour-ap -2)  2  0.9  )
 600    (list   't_iron_helm_4     "+4 iron helm"     s_iron_helm      "+0"     "1d4+4"  slot-helm    (weap-ap 1) (armour-ap -2)  2  0.9  )
 601
 602    (list   't_armor_leather   "leather armor"    s_leather_armor  "-1"     "1d4"    slot-armor   (weap-ap 2) (armour-ap -1)  2  0.85 )
 603    (list   't_armor_leather_2 "+2 leather armor" s_leather_armor  "+0"     "1d4+2"  slot-armor   (weap-ap 2) (armour-ap -1)  2  0.85 )
 604    (list   't_armor_leather_4 "+4 leather armor" s_leather_armor  "+0"     "1d4+4"  slot-armor   (weap-ap 2) (armour-ap -1)  2  0.9  )
 605
 606    (list   't_armor_chain     "chain armor"      s_chain_armor    "-2"     "2d4"    slot-armor   (weap-ap 2) (armour-ap -5)  4  0.7  )
 607    (list   't_armor_chain_4   "+4 chain armor"   s_chain_armor    "+0"     "2d4+4"  slot-armor   (weap-ap 2) (armour-ap -5)  4  0.8  )
 608
 609    (list   't_armor_plate     "plate armor"      s_plate_armor    "-4"     "4d4"    slot-armor   (weap-ap 5) (armour-ap -10) 8  0.6  )
 610    (list   't_armor_plate_4   "+4 plate armor"   s_plate_armor    "+0"     "4d4+4"  slot-armor   (weap-ap 5) (armour-ap -10) 8  0.7  )
 611    ))
 612
 613 (kern-mk-sprite 's_shield            ss_arms 1 54 #f 0)
 614 (kern-mk-sprite 's_scratched_shield  ss_arms 1 55 #f 0)
 615
 616 (define shield-types
 617   (list
 618    ;;     ============================================================================================================
 619    ;;     tag                 | name             | sprite           | to-hit | deflect | AP_mod | slots      | weight | avoid
 620    ;;     ============================================================================================================
 621    (list   't_shield           "small shield"     s_shield            "-1"     "5"    -0  slot-shield  2         0.9  )
 622    (list   't_shield_4         "+4 small shield"  s_shield            "+0"     "9"    -0  slot-shield  2         0.95 )
 623    (list   't_scratched_shield "scratched shield" s_scratched_shield  "+0"     "7"    -0  slot-shield  2         0.9  )
 624    ))
 625
 626
 627 (map (lambda (type) (apply mk-projectile-arms-type type)) projectile-arms-types)
 628 (map (lambda (type) (apply mk-melee-arms-type      type)) melee-arms-types)
 629 (map (lambda (type) (apply mk-armor-type           type)) armor-types)
 630 (map (lambda (type) (apply mk-shield-type          type)) shield-types)
 631
 632 ;;----------------------------------------------------------------------------
 633 ;; Spiked Armor
 634 ;;----------------------------------------------------------------------------
 635 (kern-mk-sprite 's_spiked_helm    ss_arms 1 46 #f 0)
 636 (kern-mk-sprite 's_spiked_shield  ss_arms 1 47 #f 0)
 637
 638 (kern-mk-arms-type 't_spiked_helm "spiked helm" s_spiked_helm
 639                    "0" "1d4" "3" "0"
 640                    slot-helm 1 1 (weap-ap 2) -0
 641                    nil nil #f #f
 642                    2 ;; weight
 643                    nil obj-ifc-cap obj-ifc
 644                                    30 10 20 0.9 mmode-smallobj)
 645
 646 (kern-mk-arms-type 't_spiked_shield "spiked shield" s_spiked_shield
 647                    "0" "1d5" "0" "5"
 648                    slot-shield 1 1 (weap-ap 2) -0
 649                    nil nil #f #f
 650                    3 ;; weight
 651                    nil obj-ifc-cap obj-ifc
 652                                    40 20 20 0.8 mmode-largeobj)
 653
 654 ;;--------------------------------------------------------------------------
 655 ;; Special arms types
 656 ;;
 657 ;; These don't fit into the mold for any standard arms type.
 658 ;;--------------------------------------------------------------------------
 659
 660 (define flaming-sword-ifc
 661   (ifc obj-ifc
 662        (method 'hit-loc
 663                (lambda (kmissile kuser ktarget kplace x y dam)
 664                 (cond ((equal? dam 0)
 665                                         (generic-burn ktarget "1d5-2"))
 666                                 ((> dam 0)
 667                                         (generic-burn ktarget "2d4"))
 668                 ))
 669          )))
 670
 671 (kern-mk-arms-type 't_flaming_sword "flaming sword" s_flaming_sword "1d2" "1d8+2" "0" "1d2" slot-weapon 1 1 (weap-ap 1) 0 nil nil #f #f 2 nil
 672                                          (ifc-cap flaming-sword-ifc) flaming-sword-ifc 50 20 70 1.0 mmode-smallobj)
 673
 674
 675 (kern-mk-arms-type 't_cannon         ; tag
 676                    "cannon"          ; name
 677                    nil               ; sprite
 678                    "+1"              ;;       to-hit : to-hit attack bonus (dice expr)
 679                    "1d10+4"          ;;       damage : attack damage (dice expr)
 680                    "0"               ;;        armor : added to armor class (dice expr)
 681                    "0"               ;;      deflect : damage deflected when hit (dice expr)
 682                    slot-nil          ;;        slots : slots it will fit in (e.g., hands)
 683                    0                 ;;        hands : number of slots required to ready it
 684                    6                 ;;        range : range it will fire
 685                    (weap-ap 2.0)     ;;          rap : required action points to attack with it
 686                    0                 ;;       AP_mod : modifier to max AP per round for the wielder
 687                    t_cannonball_p    ;;
 688                    nil               ;;      missile : nil or the armament type it fires
 689                    #f                ;;       thrown : true or false
 690                    #t                ;;         ubiq : true if it needs ammo in inventory, false otherwise
 691                    0                 ;;       weight : unused
 692                    sound-cannon-fire ;;   fire-sound : string name of sound file to play when it's fired
 693                    0                 ;;      ifc-cap : integer bitmap describing interface slots
 694                    nil               ;;  get-handler : script ifc
 695                                    0 0 0 1.0
 696                                    mmode-largeobj
 697                    )
 698
 699 ;;----------------------------------------------------------------------------
 700 ;; This list of "blockable" arms types is used by combat ai. An arms type is
 701 ;; "blockable" if an adjacent enemy can interfere with its usage.
 702 ;;----------------------------------------------------------------------------
 703 (define blockable-arms-types
 704   (list t_sling t_sling_4
 705         t_self_bow t_bow t_long_bow t_great_bow
 706         t_hvy_crossbow t_trpl_crossbow
 707         t_spear
 708         t_thrown_rock t_thrown_boulder ))
 709 ; t_lt_crossbow is quick to load, and can be used in melee
 710
 711 (define arms-types-needing-ammo
 712   (list t_self_bow t_bow t_long_bow t_great_bow
 713         t_lt_crossbow t_crossbow t_hvy_crossbow t_trpl_crossbow ))
 714
 715 (define (arms-type-is-blockable? karms)
 716   (display "arms-type-is-bloackable?")(newline)
 717   (in-list? karms blockable-arms-types))
 718
 719 (define (arms-type-needs-ammo? karms)
 720   (in-list? karms arms-types-needing-ammo))
 721
 722 ;;----------------------------------------------------------------------------
 723 ;; Test paper doll sprites: add a gob to the staff arms type with a "readied"
 724 ;; sprite.
 725 ;;----------------------------------------------------------------------------
 726 (kern-type-set-gob t_staff
 727                    (kern-sprite-blit-over s_hum_staff_gold
 728                                           s_hum_staffglo_blue))
 729
 730 (kern-type-set-gob t_halberd s_hum_halberd)
 731
 732 ;;--------------------------------------------------------------------------
 733 ;; Cannon mounting for shipboard combat (and maybe anywhere else we can think of later)
 734 ;;--------------------------------------------------------------------------
 735
 736 ;; uglyhack find target location or set up 'safe' location to simulate cannonball leaving play area
 737 (define (arms-searchline place x y dx dy)
 738         (let* ((wid (kern-place-get-width place))
 739                 (hgt (kern-place-get-height place)))
 740                 (define (arms-searchline-iter ix iy)
 741                         (cond ((< ix 0) (list 0 iy #f))
 742                                 ((< iy 0) (list ix 0 #f))
 743                                 ((>= ix wid) (list (- wid 1) iy #f))
 744                                 ((>= iy hgt) (list ix (- wid 1) #f))
 745                                 ((not (null? (get-being-at (mk-loc place ix iy))))
 746                                         (list ix iy #t))
 747                                 (else (arms-searchline-iter (+ ix dx) (+ iy dy)))
 748                         ))
 749                 (let* ((target (arms-searchline-iter (+ x dx) (+ y dy)))
 750                                 (tx (car target))
 751                                 (ty (cadr target))
 752                                 (havet (caddr target))
 753                                 )
 754                         (if havet
 755                                 (temp-cannonball-init -1 -1)
 756                                 (temp-cannonball-init tx ty)
 757                         )
 758                         (list tx ty)
 759                         )))
 760
 761 (define localcannonball-ifc
 762         (ifc '()
 763                 (method 'hit-loc
 764                         (lambda (kmissile kuser ktarget kplace x y dam)
 765                                 (let ((ktarget (get-being-at (mk-loc kplace x y))))
 766                                         (if (not (null? ktarget))
 767                                                 (
 768                                                         begin
 769                                                         (kern-log-msg (kern-obj-get-name ktarget) " hit by cannonball!")
 770                                                         (kern-obj-apply-damage ktarget "cannon" (kern-dice-roll "1d10+4"))
 771                                                 )
 772                                         )
 773                                 ))
 774                 )))
 775
 776 (mk-missile-arms-type 't_localcannonball "cannonball" s_cannonball localcannonball-ifc mmode-cannon #f)
 777
 778 (define cannon-ifc
 779         (ifc '()
 780                 (method 'xamine
 781                         (lambda (kcannon kuser)
 782                                 (let ((ready (cadr (gob kcannon))))
 783                                         (kern-log-msg "The cannon is "
 784                                                 (cond ((equal? ready 2)
 785                                                          "ready to fire")
 786                                                          ((equal? ready 1)
 787                                                          "loaded but unready")
 788                                                          (else "unloaded")))
 789                                         result-ok
 790                         ))
 791                 )
 792                 (method 'handle
 793                         (lambda (kcannon kuser)
 794                                 (let ((ready (cadr (gob kcannon)))
 795                                                 (facing (car (gob kcannon))))
 796                                         (kern-obj-dec-ap kuser speed-human)
 797                                         (cond
 798                                                 ((equal? ready 2)
 799                                                         (let* ((loc (kern-obj-get-location kcannon))
 800                                                                 (aimdir (direction-to-lvect facing))
 801                                                                 (targetloc (arms-searchline (car loc)
 802                                                                         (cadr loc) (caddr loc)
 803                                                                         (car aimdir) (cadr aimdir))))
 804                                                                 (kern-sound-play sound-cannon-fire)
 805                                                                 (kern-log-msg "BOOOM")
 806                                                                 (kern-fire-missile t_localcannonball loc (mk-loc (car loc) (car targetloc) (cadr targetloc)))
 807                                                                 )
 808                                                         (bind kcannon (list facing 0)))
 809                                                 ((equal? ready 1)
 810                                                         (kern-log-msg "Cannon ready to fire")
 811                                                         (bind kcannon (list facing 2)))
 812                                                 (else
 813                                                         (kern-log-msg "Cannon loaded")
 814                                                         (bind kcannon (list facing 1)))
 815                                         )
 816                         ))
 817                 )
 818                 (method 'init
 819                         (lambda (kcannon)
 820                                 (kern-obj-set-facing kcannon (car (gob kcannon)))
 821                                 (kern-obj-set-pclass kcannon pclass-boulder)
 822                 ))
 823         ))
 824
 825 (mk-obj-type 't_cannonobj "cannon" s_cannon layer-mechanism cannon-ifc)
 826
 827 (define  (arms-mk-cannon facing)
 828         (let ((kcannon (kern-mk-obj t_cannonobj 1)))
 829           (kern-obj-set-facing kcannon facing)
 830           (bind kcannon (list facing 0))
 831           kcannon))
 832
 833 ;; Weapons that aren't affected by acid
 834 (define arms-immune-to-acid
 835   (list t_flaming_sword
 836         t_shield_4
 837         t_armor_plate_4
 838         t_armor_chain_4
 839         t_armor_leather_2
 840         t_armor_leather_4
 841         t_iron_helm_4
 842         t_chain_coif_4
 843         t_leather_helm_2
 844         t_leather_helm_4
 845         t_sword_2
 846         t_sword_4
 847         t_eldritch_blade
 848         t_mystic_sword
 849         t_magic_axe
 850         t_doom_staff
 851         t_stun_wand))