worlds/haxima-1.002/mouse.scm

   1 ;;----------------------------------------------------------------------------
   2 ;; Constants
   3 ;;----------------------------------------------------------------------------
   4 (define mouse-start-lvl 8)
   5
   6 ;;----------------------------------------------------------------------------
   7 ;; Schedule
   8 ;;----------------------------------------------------------------------------
   9
  10 ;;----------------------------------------------------------------------------
  11 ;; Gob
  12 ;;
  13 ;; Quest flags, etc, go here.
  14 ;;----------------------------------------------------------------------------
  15 (define (mouse-mk) (list #t))
  16 (define (mouse-first-meeting? mouse) (car mouse))
  17 (define (mouse-set-first-meeting! mouse val) (set-car! mouse val))
  18 (define (mouse-talked)
  19         (quest-data-update-with 'questentry-thiefrune 'talked 1 (quest-notify (grant-party-xp-fn 10)))
  20         )
  21
  22
  23 (define (mouse-meet-first-time knpc kpc)
  24
  25   (define (mouse-disappear)
  26     (say knpc "¤ª¤Ã¤È·»Äï¤è¡¢¤â¤¦²ñ¤¤¤¿¤¯¤Ê¤«¤Ã¤¿¤Ê¡ª")
  27     (kern-obj-add-effect knpc ef_invisibility nil)
  28     (kern-conv-end kpc)
  29     )
  30
  31   (define (mouse-query)
  32     (say knpc "¤ä¤¢¡£ÀÖ¤¤½÷¤Î¥Ñ¥·¥ê¤«¤¤¡©")
  33     (if (yes? kpc)
  34         (mouse-disappear)
  35         (begin
  36                 (say knpc "¥Ò¥§¡¼¡ª¤Ó¤Ã¤¯¤ê¤·¤¿¤è¡£")
  37                 (mouse-talked)
  38         )
  39     ))
  40
  41   (define (mouse-gratitude)
  42     (say knpc "¥¢¥í¥Ú¥¯¥¹¤è´¶¼Õ¤·¤Þ¤¹¡ªÀÖ¤¤½÷¤Ï»à¤ó¤À¡ª"
  43          "¤¢¤ó¤¿¡¢¤è¤¯¤ä¤Ã¤Æ¤¯¤ì¤¿¤Ê¡£")
  44          (mouse-talked)
  45          )
  46
  47   (define (kathryn-speech)
  48     (say ch_kathryn "¥Ð¥«¤Ê¿Í¤Í¡ªÅ¥ËÀ¤Î½ê¤Þ¤Ç°ÆÆâ¤·¤Æ¤¯¤ì¤ë¤Ê¤ó¤Æ¡ª")
  49     (kern-obj-set-conv ch_kathryn nil)
  50     (kern-being-set-base-faction ch_kathryn faction-monster))
  51
  52   (define (thud-speech)
  53     (say ch_thud "Å¥ËÀ¤¬¡¡¤¤¤¿¡ª»¦¤¹¡ª»¦¤¹¡ª»¦¤¹¡ª")
  54     (kern-obj-set-conv ch_thud nil)
  55     (kern-being-set-base-faction ch_thud faction-monster))
  56
  57   (define (open-gate)
  58     (open-moongate (mk-loc (loc-place (kern-obj-get-location knpc)) 7 2)))
  59
  60   (define (warp-in-kathryn kgate)
  61     (warp-in ch_kathryn
  62              (kern-obj-get-location kgate)
  63              south
  64              faction-monster))
  65
  66   (define (warp-in-thud kgate)
  67     (warp-in ch_thud
  68              (kern-obj-get-location kgate)
  69              west
  70              faction-monster))
  71
  72   (mouse-set-first-meeting! (kobj-gob-data knpc) #f)
  73   (if (defined? 'ch_kathryn)
  74       (if (is-alive? ch_kathryn)
  75           (if (is-player-party-member? ch_kathryn)
  76
  77               ;; kathryn is alive in the party (if thud is defined then he must
  78               ;; be in the party, too; see kathryn.scm)
  79               (begin
  80                 (kern-char-leave-player ch_kathryn)
  81                 (kathryn-speech)
  82                 (if (defined? 'ch_thud)
  83                     (begin
  84                       (if (is-alive? ch_thud)
  85                           (thud-speech))
  86                       (kern-char-leave-player ch_thud)))
  87                 (mouse-disappear))
  88
  89               ;; kathryn is alive but not in the party so gate her in, and
  90               ;; thud, too, if he's alive
  91               (let ((kgate (open-gate))
  92                     (use-thud? (and (defined? 'ch_thud)
  93                                     (is-alive? ch_thud))))
  94                 (kern-sleep 1000)
  95                 (warp-in-kathryn kgate)
  96                 (if use-thud?
  97                     (warp-in-thud kgate))
  98                 (kathryn-speech)
  99                 (if use-thud?
 100                     (thud-speech))
 101                 (kern-sleep 1000)
 102                 (close-moongate kgate)
 103                 (mouse-disappear)))
 104
 105           ;; kathryn is dead
 106           (if (is-player-party-member? ch_kathryn)
 107
 108               ;; but in the party so remove her and thud, too, if he's defined
 109               (begin
 110                 (kern-char-leave-player ch_kathryn)
 111                 (if (defined? 'ch_thud)
 112                     (if (is-alive? ch_thud)
 113                         (begin
 114                           (thud-speech)
 115                           (kern-char-leave-player ch_thud)
 116                           (mouse-disappear))
 117                         (begin
 118                           (kern-char-leave-player ch_thud)
 119                           (mouse-gratitude)))
 120                     (mouse-gratitude)))
 121
 122               ;; kathryn is dead but not in the party (since she is not in the
 123               ;; party, thud cannot be either)
 124               (mouse-query)))
 125
 126       ;; kathryn is undefined (so she could never have been in the party, and
 127       ;; thus neither could thud)
 128       (mouse-query)))
 129
 130 ;;----------------------------------------------------------------------------
 131 ;; Conv
 132 ;;----------------------------------------------------------------------------
 133 (define (mouse-hail knpc kpc)
 134   (let ((mouse (kobj-gob-data knpc)))
 135     (if (mouse-first-meeting? mouse)
 136         (mouse-meet-first-time knpc kpc)
 137         (begin
 138                 (say knpc "¤¢¡¢¤³¤ó¤Ë¤Á¤Ï¡£¤Ø¤Ø¤Ã¡£")
 139                 (mouse-talked)
 140             )
 141         )))
 142
 143 (define (mouse-default knpc kpc)
 144   (say knpc "¤µ¤¢¤É¤¦¤«¤Ê¡£"))
 145
 146 (define (mouse-name knpc kpc)
 147   (say knpc "¥Í¥º¥ß¤Ç¤¹¡£"))
 148
 149 (define (mouse-join knpc kpc)
 150   (say knpc "°¤¤¤Ê¤¢¡£¶¦Æ±ºî¶È¤Ë¤Ï¸þ¤¤¤Æ¤Ê¤¤¤ó¤À¡£¤Ø¤Ø¡£"))
 151
 152 (define (mouse-job knpc kpc)
 153   (say knpc "¤¨¡¼¡¢Êª¤ò¡Ä½¸¤á¤ë¤³¤È¡£"))
 154
 155
 156 (define (mouse-coll knpc kpc)
 157   (say knpc "Å¥ËÀ¤È¸Æ¤Ö¿Í¤â¤¤¤ë¡£"))
 158
 159 (define (mouse-thie knpc kpc)
 160   (say knpc "ºÇ¶á¤Þ¤Ç¤Ï¤¤¤¤»Å»ö¤À¤Ã¤¿¤Í¤¨¡£"
 161        "²¿¤«Íß¤·¤¤Êª¤¬¤¢¤ì¤Ð¡¢¤½¤ì¤ò¼ê¤ËÆþ¤ì¤ë¤¿¤á¤Ë¤¢¤Ã¤·¤Ë¶â¤òÊ§¤Ã¤¿¡£"
 162        "¤Ç¡¢¤³¤ÎÊÑ¤ÊÀÖ¤¤½÷¤Ë¸Û¤ï¤ì¤¿¤ó¤À¡£"))
 163
 164 (define (mouse-lady knpc kpc)
 165   (say knpc "¤½¤ÎÀÖ¤¤½÷¤Ï¤¢¤Ã¤·¤ò¤¢¤ëÊª¤ò¼ê¤ËÆþ¤ì¤ë¤¿¤á¤Ë¸Û¤Ã¤¿¡£¤½¤Î¸å¡¢¶â¤È¸ò´¹¤¹¤ë¤¿¤á¤Ë²ñ¤Ã¤¿¡£"
 166        "¤³¤³¤Þ¤Ç¤Ï¤è¤¯¤¢¤ë¤³¤È¤À¡£¤ï¤«¤ë¤À¤í¡©"
 167        "¤Ç¤â¡¢¤³¤Î½÷¤Ï¶â¤òÊ§¤¦¤«¤ï¤ê¤Ë¡¢¤¢¤Ã¤·¤ò»¦¤½¤¦¤È¤·¤¿¤ó¤À¡ª"))
 168
 169 (define (mouse-kill knpc kpc)
 170   (say knpc "ÀÖ¤¤½÷¤È¥´¥Ä¤¤¼ê²¼¤ÏÍÆ¼Ï¤Ê¤«¤Ã¤¿¡ª"
 171        "¤³¤¤¤Ä¤é¤òÅÝ¤·¤¿¤³¤È¤À¤±¤Ï´¶¼Õ¤¹¤ë¤è¡£¤À¤¬¡¢¤³¤¤¤Ä¤é¤¬Ã±ÆÈ¤Ç¤ä¤Ã¤¿¤Î¤Ç¤Ï¤Ê¤¤µ¤¤¬¤¹¤ë¡£"
 172        "¤³¤Î¤¯¤À¤é¤Ê¤¤ÀÐÈÇ¤È¤ª¤µ¤é¤Ð¤·¤Ê¤¤¸Â¤ê¤º¤Ã¤ÈÁÀ¤ï¤ì¤½¤¦¤À¡ª"))
 173
 174 (define (mouse-rune knpc kpc)
 175   (if (not (in-inventory? knpc t_rune_k))
 176       (say knpc "¤½¤ì¤Ï¤â¤¦¤¢¤ó¤¿¤ÎÌäÂê¤À¡¢¿ÆÍ§¤è¡ª")
 177       (begin
 178
 179         (define (give-rune gold)
 180           (let* ((pgold (kern-player-get-gold)))
 181             (if (> pgold gold)
 182                 (kern-obj-add-gold kpc (- 0 gold))
 183                 (let ((price (min pgold gold)))
 184                   (say knpc "¤ª¤Ã¤È¡¢¶â¤¬Â¤ê¤Ê¤¤¤Ê¡ª"
 185                        "Ê§¤¨¤ëÊ¬¤À¤±¼õ¤±¼è¤Ã¤Æ¤ª¤³¤¦¡£")
 186                   (kern-obj-add-gold kpc (- 0 price)))))
 187           (kern-obj-remove-from-inventory knpc t_rune_k 1)
 188           (kern-obj-add-to-inventory kpc t_rune_k 1)
 189           (quest-data-update-with 'questentry-thiefrune 'recovered 1 (quest-notify (grant-party-xp-fn 50)))
 190           )
 191
 192         (say knpc "ÀÖ¤¤½÷¤Î¤¿¤á¤Ë¼ê¤ËÆþ¤ì¤¿¤³¤ÎÀÐÈÇ¤Ï¡¢ºÇ½é¤ËÊ¹¤¤¤¿¤È¤¤«¤é¤º¤Ã¤È¤ä¤Ã¤«¤¤¤´¤È¤Ë²á¤®¤Ê¤«¤Ã¤¿¡£"
 193              "¤³¤ì¤¬²¿¤Ê¤Î¤«¤â¤ï¤«¤é¤Ê¤¤¡ª"
 194              "¤ªÇã¤¤ÆÀ²Á³Ê¤Ç¤¢¤ó¤¿¤ËÇä¤Ã¤Æ¤ä¤í¤¦¡£¤É¤¦¡©¶â²ß500Ëç¤À¡£")
 195         (if (kern-conv-get-yes-no? kpc)
 196             (give-rune 500)
 197             (begin
 198               (say knpc "¤¦¡¼¤ó¡¢ÀÖ¤¤½÷¤«¤é½õ¤±¤Æ¤â¤é¤Ã¤¿¼Ú¤ê¤¬¤¢¤ë¤«¤é¤Ê¡£250Ëç¤Ï¤É¤¦¤À¡©")
 199               (if (kern-conv-get-yes-no? kpc)
 200                   (give-rune 250)
 201                   (begin
 202                     (say knpc "¾¦Çä¾å¼ê¤À¤Ê¤¢¡¢¿ÆÍ§¤è¡£100Ëç¡©")
 203                     (if (kern-conv-get-yes-no? kpc)
 204                         (give-rune 100)
 205                         (begin
 206                           (say knpc "50¡©")
 207                           (if (kern-conv-get-yes-no? kpc)
 208                               (give-rune 50)
 209                               (begin
 210                                 (say knpc "¤ï¤«¤Ã¤¿¡£»ý¤Ã¤Æ¤±¡£¤³¤ì¤Ç¤¤¤¤¤Ê¡©")
 211                                 (if (kern-conv-get-yes-no? kpc)
 212                                     (give-rune 0)
 213                                     (begin
 214                                       (say knpc "¤¿¤Î¤à¤è¡ª"
 215                                            "¶â¤ò½Ð¤¹¤«¤é»ý¤Ã¤Æ¹Ô¤Ã¤Æ¤¯¤ì¡ª"
 216                                            "¤º¡¼¤Ã¤È±ó¤¯¤Ø¡ª")
 217                                       (give-rune (- 0 100))))))
 218                           )))))))))
 219
 220 (define (mouse-bye knpc kpc)
 221   (say knpc "°µ¤¤Ï¤Ê¤¤¤¬¡¢¤â¤¦ÆóÅÙ¤È²ñ¤¤¤¿¤¯¤Ê¤¤¤Í¡£"))
 222
 223 (define (mouse-alopex knpc kpc)
 224   (say knpc "¥¢¥í¥Ú¥¯¥¹¡©¤¢¤¢¡¢¸Å¤¤Å¥ËÀ¤Î¿À¤À¡£"
 225        "¤½¤¦Ê¹¤¤¤¿¡£"))
 226
 227 (define mouse-conv
 228   (ifc nil
 229        (method 'default mouse-default)
 230        (method 'hail mouse-hail)
 231        (method 'bye mouse-bye)
 232        (method 'job mouse-job)
 233        (method 'name mouse-name)
 234        (method 'join mouse-join)
 235
 236        (method 'coll mouse-coll)
 237        (method 'kill mouse-kill)
 238        (method 'lady mouse-lady)
 239        (method 'rune mouse-rune)
 240        (method 'thie mouse-thie)
 241        (method 'alop mouse-alopex)
 242        ))
 243
 244 ;;----------------------------------------------------------------------------
 245 ;; First-time constructor
 246 ;;----------------------------------------------------------------------------
 247 (define (mk-mouse)
 248   (bind
 249    (kern-char-force-drop
 250     (kern-char-arm-self
 251      (kern-mk-char
 252       'ch_mouse ;;..tag
 253       "¥Í¥º¥ß" ;;....name
 254       sp_human ;;.....species
 255       nil ;;..........occupation
 256       s_brigand ;;.....sprite
 257       faction-men ;;..faction
 258       0 ;;............custom strength modifier
 259       0 ;;............custom intelligence modifier
 260       6 ;;............custom dexterity modifier
 261       2 ;;............custom base hp modifier
 262       2 ;;............custom hp multiplier (per-level)
 263       1 ;;............custom base mp modifier
 264       1 ;;............custom mp multiplier (per-level)
 265       max-health ;;..current hit points
 266       -1 ;;...........current experience points
 267       max-health ;;..current magic points
 268       0
 269       mouse-start-lvl  ;;..current level
 270       #f ;;...........dead?
 271       'mouse-conv ;;...conversation (optional)
 272       nil ;;..........schedule (optional)
 273       nil ;;..........custom ai (optional)
 274
 275       ;;..........container (and contents)
 276       (mk-inventory
 277        (list
 278         (list 1 t_rune_k)
 279         (list 1 t_armor_leather)
 280         (list 1 t_leather_helm)
 281         (list 1 t_sword)
 282         (list 1 t_bow)
 283         (list 50 t_arrow)))
 284
 285       nil ;;..........readied arms (in addition to the container contents)
 286       nil ;;..........hooks in effect
 287       ))
 288     #t)
 289    (mouse-mk)))