worlds/haxima-1.002/fields.scm

   1 ;;----------------------------------------------------------------------------
   2 ;; fields.scm - field types supported by the game
   3 ;;----------------------------------------------------------------------------
   4
   5 ;;----------------------------------------------------------------------------
   6 ;; kern-mk-field-type <tag> <name> <sprite> <light> <dur> <pmask> <effect>
   7 ;;
   8 ;; 'effect' is a procedure called whenever an object is positioned over the
   9 ;; field. Its only parameter is the object.
  10 ;;
  11 ;; 'light' is the amount of light radiated by the field.
  12 ;;
  13 ;; 'dur' is the number of turns the field will exist before disappearing.
  14 ;;
  15 ;; 'pmask' is the objective pmask (the passability it permits to cross it)
  16 ;;
  17 ;; 'effect' is an optional procedure to run on an object which steps on the
  18 ;; field. See effects.scm.
  19 ;;----------------------------------------------------------------------------
  20
  21 (kern-mk-field-type 'F_illum  "µ±¤¯¿Ð" s_magic          1024 5  pclass-none  nil        mmode-field)
  22 (kern-mk-field-type 'F_fire   "±ê" s_field_fire     512  20 pclass-none  'burn  mmode-field)
  23 (kern-mk-field-type 'F_poison "ÆÇÌ¸" s_field_poison   256  20 pclass-none  'apply-poison        mmode-field)
  24 (kern-mk-field-type 'F_sleep  "ºÅÌ²¥¬¥¹"  s_field_sleep    256  20 pclass-none  'apply-field-sleep      mmode-field)
  25 (kern-mk-field-type 'F_energy "¥¨¥Í¥ë¥®¡¼¾ì" s_field_energy   512  20 pclass-repel 'apply-lightning     mmode-field)
  26 (kern-mk-field-type 'F_acid "»À" s_field_acid   256  20 pclass-none 'apply-acid mmode-field)
  27 (kern-mk-field-type 'web-type "¥¯¥â¤ÎÁã"   s_spider_web     0    20 pclass-none  'ensnare       mmode-field)
  28
  29 (kern-mk-field-type 'F_poison_perm "ÆÇÌ¸" s_field_poison 256 -1 pclass-none  'apply-poison      mmode-field)
  30 (kern-mk-field-type 'F_sleep_perm  "ºÅÌ²¥¬¥¹"  s_field_sleep  256 -1 pclass-none  'apply-field-sleep    mmode-field)
  31 (kern-mk-field-type 'F_energy_perm "¥¨¥Í¥ë¥®¡¼¾ì" s_field_energy 512 -1 pclass-repel 'apply-lightning   mmode-field)
  32 (kern-mk-field-type 'F_fire_perm   "±ê"   s_field_fire   512 -1 pclass-none  'burn      mmode-field)
  33 (kern-mk-field-type 'F_acid_perm "»À" s_field_acid 256 -1 pclass-none 'apply-acid       mmode-field)
  34 (kern-mk-field-type 'F_web_perm    "¥¯¥â¤ÎÁã"   s_spider_web   0   -1 pclass-none  'ensnare     mmode-field)
  35 (kern-mk-field-type 'F_illum_perm    nil   nil   256   -1 pclass-none  nil      mmode-field)
  36
  37 (define all-field-types
  38   (list F_fire F_poison F_sleep F_energy web-type
  39         F_fire_perm F_poison_perm F_sleep_perm F_energy_perm F_web_perm))
  40
  41 (define (is-field-type? ktype)
  42   (foldr (lambda (x field-type) (or x (eqv? ktype field-type)))
  43          #f
  44          all-field-types))
  45
  46 (define (is-field? kobj)
  47   (kern-obj-is-field? kobj))
  48
  49 (define (is-fire-field? ktype)
  50   (or (eqv? ktype F_fire)
  51       (eqv? ktype F_fire_perm)))
  52
  53 (define (is-poison-field? ktype)
  54   (or (eqv? ktype F_poison)
  55       (eqv? ktype F_poison_perm)))
  56
  57 (define (is-sleep-field? ktype)
  58     (or (eqv? ktype F_sleep)
  59         (eqv? ktype F_sleep_perm)))
  60
  61 (define (is-energy-field? ktype)
  62     (or (eqv? ktype F_energy)
  63         (eqv? ktype F_energy_perm)))
  64
  65 (define (is-immune-to-field? kchar kfield)
  66   (let ((ktype (kern-obj-get-type kfield)))
  67     (cond ((is-fire-field? ktype) (has-fire-immunity? kchar))
  68           ((is-poison-field? ktype) (has-poison-immunity? kchar))
  69           ((is-sleep-field? ktype) (has-sleep-immunity? kchar))
  70           (else #f))))
  71
  72 (define (apply-field-sleep kobj)
  73         (if (> (modulo (random-next) 40) 1)
  74         (apply-sleep kobj)
  75     ))
  76
  77 ;; smoke is here since it more closely resembles a field than anything else
  78 ;; TODO: smoke should calculate a duration and store that in a gob
  79 ;;   so that denser smoke can be created
  80
  81 (define smoke-ifc
  82   (ifc nil
  83        (method 'exec (lambda (ksmoke)
  84                        (if (> (kern-dice-roll "1d20") 16)
  85                            (kern-obj-remove ksmoke)
  86
  87                            ;; smoke drifts with the wind in wilderness combat
  88                            (let ((curloc (kern-obj-get-location ksmoke)))
  89                              (if (kern-place-is-combat-map? (loc-place curloc))
  90                                  (let ((loc (loc-offset (kern-obj-get-location ksmoke)
  91                                                         (vector-ref opposite-dir (kern-get-wind)))))
  92                                    (if (not (kern-is-valid-location? loc))
  93                                        (kern-obj-remove ksmoke)
  94                                        (begin
  95                                          (kern-obj-relocate ksmoke loc nil)
  96                                          (kern-los-invalidate)
  97                                          ))))))))))
  98
  99
 100 (mk-obj-type 't_smoke_cloud "±ì" s_smoke layer-projectile smoke-ifc)
 101
 102 (define (fields-smoke-apply kplace x y power)
 103         (define (tryput loc)
 104                 (if (terrain-ok-for-field? loc)
 105                         (let ((kfield (kern-mk-obj t_smoke_cloud 1)))
 106                                 (kern-obj-set-opacity kfield #t)
 107                                 (kern-obj-put-at kfield loc)))
 108         )
 109         (tryput (mk-loc kplace x y))
 110         (tryput (mk-loc kplace (- x 1) y))
 111         (tryput (mk-loc kplace (+ x 1) y))
 112         (tryput (mk-loc kplace x (- y 1)))
 113         (tryput (mk-loc kplace x (+ y 1)))
 114         (tryput (mk-loc kplace (- x 1) (- y 1)))
 115         (tryput (mk-loc kplace (- x 1) (+ y 1)))
 116         (tryput (mk-loc kplace (+ x 1) (- y 1)))
 117         (tryput (mk-loc kplace (+ x 1) (+ y 1)))
 118         (kern-los-invalidate)
 119 )