worlds/haxima-1.002/skills.scm

   1 ;;----------------------------------------------------------------------------
   2 ;; Skill procedures
   3 ;;
   4 ;; Skill procedures should not do any requirements-checking because the kernel
   5 ;; checks all requirements before allowing them to be called. Skill procedures
   6 ;; should always return (ie, evaluate to) one of the standard result-* codes
   7 ;; (eg, result-ok, result-no-target, etc... see naz.scm).
   8
   9 (define (skill-jump kactor)
  10   (define (range)
  11     (let ((x (* (occ-ability-stracro kactor) (kern-obj-get-ap kactor))))
  12       (cond ((> x 1000) 4) ;; inconceivable!
  13             ((> x 500) 3)
  14             ((> x 150) 2)
  15             (else 0))))
  16   (if (has-effect? kactor ef_fatigue)
  17       result-not-now
  18       (cast-ui-ranged-loc powers-jump
  19                           kactor
  20                           (range)
  21                           0)))
  22
  23 (define (skill-sprint kactor)
  24   (if (has-effect? kactor ef_fatigue)
  25       result-not-now
  26       (let* ((origin (kern-obj-get-location kactor))
  27              (kplace (loc-place origin))
  28              (sprint-max-range (+ 2 (occ-ability-stracro kactor)))
  29              (sprint-max-cost (* sprint-max-range (kern-obj-get-ap kactor)))
  30              )
  31         (define (too-far? origin dest)
  32           (let ((path (line (loc-x origin) (loc-y origin)
  33                             (loc-x dest) (loc-y dest))))
  34             (let ((cost (foldr (lambda (d xy)
  35                                  (+ d
  36                                     (kern-place-get-movement-cost (mk-loc kplace
  37                                                                           (car xy)
  38                                                                           (cdr xy))
  39                                                                   kactor)
  40                                     ))
  41                                0
  42                                path)))
  43               (> cost sprint-max-cost))))
  44         (define (checkloc x y)
  45           (let ((dest (mk-loc kplace x y)))
  46             (and (kern-place-is-passable dest kactor)
  47                  (not (occupied? dest))
  48                  (kern-in-los? origin dest)
  49                  (not (too-far? origin dest))
  50                  )))
  51         (cast-ui-template-loc powers-sprint
  52                               kactor
  53                               (kern-mk-templ origin sprint-max-range 'checkloc)
  54                               0))))
  55
  56 (define (skill-wriggle kactor)
  57   ;; fixme: use smart target that only suggests viable locations?
  58   (cast-ui-ranged-loc powers-wriggle kactor 1 0))
  59
  60 (define (check-wriggle kactor)
  61   (cond ((null? (kern-char-get-arms kactor)) #t)
  62         (else
  63          (kern-log-msg "Must unready arms!")
  64          #f
  65          )))
  66
  67
  68 (load "disarm-trap.scm")
  69
  70 (define (skill-stealth kactor)
  71   (kern-obj-add-effect kactor ef_stealth nil)
  72   result-ok)
  73
  74 (define (skill-butcher kactor)
  75   (cast-ui-ranged-any powers-butcher
  76                       kactor 1 (occ-ability-crafting kactor)
  77                       (mk-ifc-query 'butcher)))
  78
  79 (define (skill-pickpocket kactor)
  80   (cast-ui-basic-ranged-spell powers-pickpocket
  81                               kactor
  82                               1
  83                               (occ-ability-thief kactor)
  84                               ))
  85
  86 ;;----------------------------------------------------------------------------
  87 ;; Skill declarations
  88 ;;
  89 ;; (kern-mk-skill <tag>
  90 ;;                <name>
  91 ;;                <description>
  92 ;;                <ap-consumed>
  93 ;;                <mp-consumed>
  94 ;;                <can-use-in-wilderness?>
  95 ;;                <is-passive?>
  96 ;;                <yusage-proc>
  97 ;;                <yusage-special-check-proc>
  98 ;;                <list-of-required-tools>
  99 ;;                <list-of-required-consumables>)
 100
 101 (define (mk-skill name description ap-cost mp-cost use-in-wilderness
 102                   is-passive yusage-proc yusage-special-check-proc list-of-required-tools list-of-required-consumables)
 103   (kern-mk-skill name description ap-cost mp-cost use-in-wilderness
 104                  is-passive yusage-proc yusage-special-check-proc list-of-required-tools list-of-required-consumables))
 105
 106
 107 (define sk_jump
 108   (mk-skill "Jump" "Jump over impassable terrain"
 109             0
 110             0
 111             #f
 112             #f
 113            'skill-jump
 114             nil
 115             nil
 116             nil
 117             ))
 118
 119 (define sk_arm_trap
 120   (mk-skill "Arm Trap" "Allows character to use beartraps and caltrops"
 121             0
 122             0
 123             #f
 124             #t
 125             nil
 126             nil
 127             nil
 128             nil
 129             ))
 130
 131 (define sk_sprint
 132   (mk-skill "Sprint" "Move quickly, in a straight line, for a short distance"
 133             0
 134             0
 135             #f
 136             #f
 137             'skill-sprint
 138             nil
 139             nil
 140             nil
 141             nil
 142             ))
 143
 144 (define sk_wriggle
 145   (mk-skill "Wriggle" "Squeeze through tight spots"
 146             base-move-ap   ;; ap
 147             0              ;; mp
 148             #f             ;; wilderness?
 149             #f             ;; passive?
 150             'skill-wriggle ;; yusage
 151             'check-wriggle ;; yusage check
 152             nil            ;; tools
 153             (list (list t_grease 1)) ;; material
 154             ))
 155
 156 (define sk_disarm_trap
 157   ;; fixme: should some special tools be required?
 158   (mk-skill "Disarm Trap" "Disarm a trap on a door or chest"
 159             0              ;; ap
 160             0              ;; mp
 161             #f             ;; wilderness?
 162             #f             ;; passive?
 163             'skill-disarm-trap ;; yusage
 164             nil            ;; yusage check
 165             nil            ;; tools
 166             nil            ;; material
 167             ))
 168
 169 (define sk_stealth
 170   (mk-skill "Stealth" "Avoid detection"
 171             base-move-ap   ;; ap
 172             0              ;; mp
 173             #f             ;; wilderness?
 174             #f             ;; passive?
 175             'skill-stealth ;; yusage
 176             nil            ;; yusage check
 177             nil            ;; tools
 178             nil            ;; material
 179             ))
 180
 181 (define sk_reach
 182   (mk-skill "Reach" "Handle objects more than one tile away"
 183             base-move-ap   ;; ap
 184             0              ;; mp
 185             #f             ;; wilderness?
 186             #t             ;; passive?
 187             nil            ;; yusage
 188             nil            ;; yusage check
 189             nil            ;; tools
 190             nil            ;; material
 191             ))
 192
 193 (define sk_butcher
 194   (mk-skill "Butcher" "Turn an animal corpse into food or materials"
 195             0              ;; ap
 196             0              ;; mp
 197             #f             ;; wilderness?
 198             #f             ;; passive?
 199             'skill-butcher ;; yusage
 200             nil            ;; yusage check
 201             nil            ;; tools (fixme: add knife)
 202             nil            ;; material
 203             ))
 204
 205 (define sk_pickpocket
 206   (mk-skill "Pickpocket" "Take something from an NPC"
 207             base-move-ap   ;; ap
 208             0              ;; mp
 209             #f             ;; wilderness?
 210             #f             ;; passive?
 211             'skill-pickpocket ;; yusage
 212             nil            ;; yusage check
 213             nil            ;; tools
 214             nil            ;; material
 215             ))
 216
 217 (define sk_unlock
 218   (mk-skill "Unlock" "Unlock a door with a picklock"
 219             0
 220             0
 221             #f
 222             #t ;; passive
 223             'skill-unlock
 224             nil
 225             (list t_picklock)
 226             nil
 227             ))
 228
 229 ;;----------------------------------------------------------------------------
 230 ;; Skill Set declarations
 231 ;;
 232 ;; The number preceeding the skill name is the minimum level needed to use the
 233 ;; skill.
 234
 235 (define sks_warrior
 236   (kern-mk-skill-set "Warrior" (list
 237                                 (list 1 sk_sprint)
 238                                 (list 2 sk_jump)
 239                                 )))
 240
 241 (define sks_ranger
 242   (kern-mk-skill-set "Ranger" (list
 243                                 (list 1 sk_sprint)
 244                                 (list 2 sk_jump)
 245                                 (list 3 sk_arm_trap)
 246                                 (list 5 sk_stealth)
 247                                 )))
 248
 249 (define sks_wrogue
 250   (kern-mk-skill-set "Wrogue" (list
 251                                (list 1 sk_sprint)
 252                                (list 1 sk_arm_trap)
 253                                (list 2 sk_unlock)
 254                                (list 2 sk_disarm_trap)
 255                                (list 3 sk_jump)
 256                                (list 3 sk_wriggle)
 257                                (list 4 sk_reach)
 258                                (list 4 sk_pickpocket)
 259                                (list 5 sk_stealth)
 260                                )))
 261
 262 (define sks_wright
 263   (kern-mk-skill-set "Wright" (list
 264                                (list 1 sk_arm_trap)
 265                                (list 2 sk_unlock)
 266                                (list 3 sk_disarm_trap)
 267                                )))
 268
 269 (define sks_wanderer
 270   (kern-mk-skill-set "Wanderer" (list
 271                                (list 2 sk_sprint)
 272                                (list 3 sk_jump)
 273                                (list 3 sk_unlock)
 274                                (list 4 sk_arm_trap)
 275                                (list 4 sk_disarm_trap)
 276                                (list 5 sk_reach)
 277                                (list 5 sk_pickpocket)
 278                                (list 6 sk_stealth)
 279                                )))