worlds/haxima-1.002/gamestart-mech.scm

   1
   2
   3 (define (get-player-name kbeing)
   4       (begin
   5         (kern-log-msg "Speak your name, Seeker")
   6                 (let
   7                 ((reply (kern-conv-get-string kbeing)))
   8             (if (equal? reply "")
   9                                 nil
  10                 (begin
  11                         (kern-log-msg (string-append "Hail, " reply "!"))
  12                         (kern-being-set-name kbeing reply)
  13                                         (kern-map-flash 1)
  14                )
  15             )
  16         )
  17                 #f
  18                 ))
  19
  20 (define (one-off-message kbeing message messageid)
  21         (if (is-player-party-member? kbeing)
  22                 (begin
  23                         (kern-log-msg message)
  24                         (map (lambda (trigobj)
  25                                 (if (equal? (length (gob trigobj)) 3)
  26                                         (if (equal? (caddr (gob trigobj)) messageid)
  27                                                 (kern-obj-remove trigobj)
  28                                         ))
  29                                 )
  30                                 (kplace-get-objects-of-type (car (kern-obj-get-location kbeing)) t_step_trig))
  31                         #f
  32                         )))
  33
  34 (define (gamestart-statue-clean kbeing messageid)
  35         (map (lambda (trigobj)
  36                 (if (equal? (length (gob trigobj)) 3)
  37                         (if (equal? (caddr (gob trigobj)) messageid)
  38                                 (kern-obj-remove trigobj)
  39                         ))
  40                 )
  41         (kplace-get-objects-of-type (car (kern-obj-get-location kbeing)) t_step_trig))
  42         )
  43
  44 (define (gamestart-statue-speak kbeing speaker messageid)
  45         (if (is-player-party-member? kbeing)
  46                 (begin
  47                         (kern-log-msg "A statue suddenly speaks to you!")
  48                         (kern-conv-begin (eval speaker))
  49                         ))
  50                         #f
  51                 )
  52
  53 (define (get-gamestart-data kbeing key)
  54         (let ((rdata (get-roomdata (car (kern-obj-get-location kbeing)))))
  55                 (list-ref rdata key)
  56     ))
  57
  58 (define (gamestart-field-circle ftype loc x y count)
  59         (define (sign n)
  60                 (cond ((> n 0) 1)
  61                                 ((< n 0) -1)
  62                                 (#t 0))
  63                 )
  64         (define (is-my-field? kobj) (eqv? ftype (kern-obj-get-type kobj)))
  65         (define (gamestart-field-circle-elem xp yp toshow tocheck)
  66                 (let* ((xf (+ x xp))
  67                                 (yf (+ y yp))
  68                                 (show (not (< (* toshow 8) (* tocheck count))))
  69                                 (fields (filter is-my-field? (kern-get-objects-at (mk-loc loc xf yf))))
  70                                 )
  71                         (cond ((null? fields) nil)
  72                                 (else
  73                                         (kern-obj-remove (car fields))))
  74                         (if show
  75                                 (kern-obj-put-at (kern-mk-obj ftype 1) (mk-loc loc xf yf))
  76                                 )
  77                         (if (> tocheck 1)
  78                                 (let (
  79                                         (ntoshow (if show (- toshow 1) toshow))
  80                                         (nxp (sign (- xp yp)))
  81                                         (nyp (sign (+ xp yp)))
  82                                         )
  83                                 (gamestart-field-circle-elem nxp nyp ntoshow (- tocheck 1))
  84                                 ))
  85                         ))
  86         (let* ((sa (kern-dice-roll "1d3-2"))
  87                         (sb (if (> 1 (kern-dice-roll "1d2")) 1 -1))
  88                         (xy (kern-dice-roll "1d2"))
  89                         (xp (if (> xy 1) sa sb))
  90                         (yp (if (> xy 1) sb sa))
  91                         )
  92                         (gamestart-field-circle-elem xp yp count 8)
  93         )
  94 )
  95
  96 (define (gamestart-reset-lamps kbeing)
  97                 (let ((str (floor (+ (/ (* (- (kern-char-get-strength kbeing) 10) 7) 12) 1)))
  98                                 (dex (floor (+ (/ (* (- (kern-char-get-dexterity kbeing) 10) 7) 12) 1)))
  99                                 (int (floor (+ (/ (* (- (kern-char-get-intelligence kbeing) 10) 7) 12) 1)))
 100                                 (place (eval 'p_char_setup)))
 101                         (gamestart-field-circle F_fire_perm place 4 10 str)
 102                         (gamestart-field-circle F_acid_perm place 9 8 dex)
 103                         (gamestart-field-circle F_energy_perm place 14 10 int)
 104                 (kern-map-repaint)
 105         ))
 106
 107 (define (gamestart-light-lamps kbeing unused messageid)
 108         (if (is-player-party-member? kbeing)
 109                 (begin
 110                                 (gamestart-reset-lamps kbeing)
 111         (map (lambda (trigobj)
 112
 113                 (if (equal? (length (gob trigobj)) 3)
 114                         (if (equal? (caddr (gob trigobj)) messageid)
 115                                 (kern-obj-remove trigobj)
 116                         ))
 117                 )
 118         (kplace-get-objects-of-type (car (kern-obj-get-location kbeing)) t_step_trig))
 119         )
 120
 121         )
 122         #f)
 123
 124 (define (set-gamestart-data kbeing key value)
 125         (println (get-roomdata (car (kern-obj-get-location kbeing))))
 126         (let* ((rdata (get-roomdata (car (kern-obj-get-location kbeing))))
 127                         (curdat (list-tail rdata key)))
 128                 (set-car! curdat value)
 129     ))
 130
 131 (define (initstats kbeing)
 132         (let ((rdata (get-roomdata (car (kern-obj-get-location kbeing)))))
 133                 (kern-char-set-strength     kbeing (/ (- 24    (list-ref rdata 0)  (list-ref rdata 1)) 2))
 134                 (kern-char-set-dexterity    kbeing (/ (- (+ 12 (list-ref rdata 0)) (list-ref rdata 2)) 2))
 135                 (kern-char-set-intelligence kbeing (/ (+       (list-ref rdata 1)  (list-ref rdata 2)) 2))
 136
 137                 (kern-log-msg "Strength: "     (number->string (kern-char-get-strength     kbeing)) ", "
 138                               "Dexterity: "    (number->string (kern-char-get-dexterity    kbeing)) ", "
 139                               "Intelligence: " (number->string (kern-char-get-intelligence kbeing))
 140                               )
 141
 142         ))
 143
 144 (define (set-stat-info kbeing key value)
 145         (set-gamestart-data kbeing key value)
 146         (initstats kbeing)
 147         (kern-sound-play sound-moongate-enter)
 148         (kern-map-flash 1)
 149         #f
 150         )
 151
 152 (mk-obj-type 't_start_portal "path forward" s_blackgate_full layer-mechanism step-trig-ifc)
 153
 154 (define (mk-start-portal proc-tag . args)
 155   (bind (kern-mk-obj t_start_portal 1)
 156         (trig-mk proc-tag args)))
 157
 158 (define (start-cutscene kplayer startgate)
 159         (kern-char-set-sleep ch_wanderer #t)
 160         (kern-log-enable #t)
 161         (kern-log-msg "A dark gate rises in a quiet clearing...")
 162         (moongate-animate black-gate blackgate-stages)
 163         (kern-sleep 2000)
 164         (kern-log-enable #f)
 165         )
 166
 167 (define (mk-start-cutscene kplayer startgate)
 168         (lambda () (start-cutscene kplayer startgate)))
 169
 170 (define (start-actual-game kplayer)
 171
 172   (kern-log-enable #f)
 173
 174   (kern-obj-set-sprite (eval (get-gamestart-data kplayer 3)) s_grass)
 175    (kern-map-repaint)
 176
 177   (kern-obj-relocate kplayer (list p_moongate_clearing 11 12) (mk-start-cutscene kplayer (get-gamestart-data kplayer 3)))
 178
 179   (kern-log-enable #t)
 180   (kern-log-msg "Then closes without a trace...")
 181   (moongate-animate black-gate (reverse blackgate-stages))
 182   (kern-sleep 1000)
 183
 184   (kern-log-msg "You lie dreaming for a while, of another life...")
 185   (kern-sleep 2000)
 186
 187   (kern-log-enable #f)
 188   (kern-char-set-sleep ch_wanderer #f)
 189   (kern-player-set-follow-mode)
 190   (kern-log-enable #t)
 191   (kern-log-msg "...then awaken to a strange new world.")
 192   (kern-log-msg "To the southwest you see a cave.")
 193   (quest-remove (quest-data-get 'questentry-charcreate))
 194   (quest-assign (quest-data-get 'questentry-whereami))
 195   )
 196