1;;----------------------------------------------------------------------------
2;; traps.scm -- Traps that can be placed on chests, doors, etc. Most of the
3;; procedures which apply the effects of these trap can be found over in
4;; effects.scm, where they are shared in common.
5;;
6;; Traps are not kernel objects and do not have kernel types; they are entirely
7;; an invention of the script. In order for a trap to exist in the game world
8;; it must be attached to a kernel object like a door or a chest.
9;;----------------------------------------------------------------------------
10
11;;----------------------------------------------------------------------------
12;; Trap Implementaion
13;;----------------------------------------------------------------------------
14
15;; Define what a trap "type" is. Each type has a name and the procedure to call
16;; when the trap is triggered. The procedure should be of the form
17;;
18;;  (lambda (<kchar> <kobj>) ...)
19;;
20;; Where kchar is the kernel object for the character that triggered the trap,
21;; and kobj is the kernel object which the trap was attached to.
22;;
23(define (mk-trap-type namestr proc-tag) (list 'trap-type namestr proc-tag))
24(define (trap-type-name ttype) (cadr ttype))
25(define (trap-type-proc ttype) (caddr ttype))
26
27;; Define what a trap is. A trap has a type and some state variables. Currently
28;; the only state variable is a "detected" flag, which is set if the player has
29;; detected the trap. The avoidance is hard-coded currently, but depends on if
30;; the trap has already been detected. The detection and fumble difficulties
31;; are also hard-coded (these are used when s)earching trapped objects).
32(define (mk-trap type) (list 'trap type #f #f))
33(define (trap-type trap) (cadr trap))
34(define (trap-detected? trap) (caddr trap))
35(define (trap-set-detected! trap val) (set-car! (cddr trap) val))
36(define (trap-tripped? trap) (cadddr trap))
37(define (trap-set-tripped! trap val) (set-car! (cdddr trap) val))
38(define (trap-name trap) (trap-type-name (trap-type trap)))
39(define (trap-avoid-dc trap) (if (trap-detected? trap) 10 20))
40(define (trap-detect-dc trap) 18)
41(define (trap-fumble-dc trap) 12)
42
43;; Trigger a trap. The trap parm is one of our scripted traps conforming to the
44;; above, kobj is the kernel object the trap is applied to, and kchar is the
45;; kernel character object that triggered the trap. This proc will
46;; automatically use the character's thiefly skill to roll to avoid the trap.
47(define (trap-trigger trap kobj kchar)
48  (let ((roll (kern-dice-roll "1d20"))
49        (bonus (occ-thief-dice-roll kchar))
50        (ttype (trap-type trap))
51        (avoid (trap-avoid-dc trap))
52        (already-tripped? (trap-tripped? trap))
53        )
54    (trap-set-detected! trap #t)
55    (trap-set-tripped! trap #t)
56    (cond (already-tripped? nil)
57          ((or (= roll 20)
58               (> (+ roll bonus) avoid))
59           (kern-log-msg (kern-obj-get-name kchar)
60                         " ^c+gavoids^c- a "
61                         (trap-type-name ttype)
62                         " trap!"))
63          (else
64           (kern-log-msg (kern-obj-get-name kchar) " ^c+rtrips^c- a "
65                         (trap-type-name ttype)
66                         " trap!")
67           (apply (eval (trap-type-proc (trap-type trap)))
68                  (list kchar kobj))))))
69
70;; S)earch a trap. Roll to detect. If the roll is bad then the trap is
71;; triggered (whether or not it was already detected). If the roll is good then
72;; the trap is detected.
73(define (trap-search trap kobj kchar)
74  (let ((roll (kern-dice-roll "1d20"))
75        (bonus (occ-thief-dice-roll kchar))
76        (ttype (trap-type trap))
77        )
78    (cond ((and (not (trap-detected? trap))
79                (or (= roll 20)
80                    (> (+ roll bonus)
81                       (trap-detect-dc trap))))
82           (kern-log-msg (kern-obj-get-name kchar)
83                         " ^c+gfinds^c- a "
84                         (trap-type-name ttype)
85                         " trap!")
86           (trap-set-detected! trap #t))
87          ((or (= roll 1)
88               (< (+ roll bonus) (trap-fumble-dc trap)))
89           (trap-trigger trap kobj kchar)
90           ))))
91
92;;----------------------------------------------------------------------------
93;; Trap Types
94;;----------------------------------------------------------------------------
95(define (lightning-trap-proc actor subject) (apply-lightning actor))
96(define (burn-trap-proc actor subject) (burn actor))
97(define (poison-trap-proc actor subject) (apply-poison actor))
98(define (sleep-trap-proc actor subject) (apply-sleep actor))
99
100(define (spike-trap-proc actor subject)
101  (kern-obj-apply-damage actor "ouch"
102                         (kern-dice-roll "1d6")))
103
104(define (bomb-trap-proc actor subject)
105  (define (hit loc)
106    (map burn (kern-get-objects-at loc))
107    (if (terrain-ok-for-field? loc)
108        (kern-obj-put-at (kern-mk-obj F_fire 1) loc)))
109  (shake-map 10)
110  (map hit
111       (get-8-neighboring-tiles (kern-obj-get-location subject))))
112
113(define (self-destruct-trap-proc actor subject)
114  (shake-map 3)
115  (kern-obj-put-at (kern-mk-field F_fire 10)
116                   (kern-obj-get-location subject))
117  (kern-obj-put-at (kern-mk-obj sulphorous_ash 1)
118                   (kern-obj-get-location subject))
119  (ifccall subject 'self-destruct)
120  )
121
122(define lightning-trap (mk-trap-type "lightning" 'lightning-trap-proc))
123(define burn-trap (mk-trap-type "burn" 'burn-trap-proc))
124(define poison-trap (mk-trap-type "poison" 'poison-trap-proc))
125(define sleep-trap (mk-trap-type "sleep" 'sleep-trap-proc))
126(define spike-trap (mk-trap-type "spike" 'spike-trap-proc))
127(define bomb-trap (mk-trap-type "bomb" 'bomb-trap-proc))
128(define self-destruct-trap (mk-trap-type "self-destruct" 'self-destruct-trap-proc))
129