worlds/haxima-1.002/minimal-start.scm

   1 ;;----------------------------------------------------------------------------
   2 ;; The very first line of any session file should be (load "naz.scm"). This
   3 ;; bootstraps some procedures that we need to continue. This is the only place
   4 ;; you should use 'load'. Every other place you want to load a file you should
   5 ;; user 'kern-load'. 'kern-load' ensures that a saved session will be able to
   6 ;; load the file, too.
   7 ;;----------------------------------------------------------------------------
   8 (load "naz.scm")
   9
  10
  11 ;; Setup progress bar for loading. I arrived at the number by printing the
  12 ;; current number of steps in src/foogod.c:foogod_progress_bar_finish().
  13 (kern-progress-bar-start "ÆÉ¤ß¹þ¤ßÃæ" 205)
  14
  15 ;; Wrap the original definition of (load ...) with one that advances the
  16 ;; progress bar.
  17 (define original-load load)
  18 (define (load file)
  19   (println (kern-get-ticks) ":" file "...")
  20   (kern-progress-bar-advance 1)
  21   (original-load file)
  22   )
  23
  24
  25 ;;----------------------------------------------------------------------------
  26 ;; Load the read-only game data. See the note on 'kern-load' vs 'load' above.
  27 ;;----------------------------------------------------------------------------
  28 (kern-load "minimal-game.scm")
  29
  30 ;;----------------------------------------------------------------------------
  31 ;; Time -- this needs to be set before loading any dungeon rooms
  32 ;;----------------------------------------------------------------------------
  33 (define hour 07)
  34 (define minutes 00)
  35 (define time-in-minutes (+ (* hour 60) minutes))
  36 (define game-start-time (time-mk 0 0 0 0 hour minutes))
  37
  38 (kern-set-clock
  39  0 ; year
  40  0 ; month
  41  0 ; week
  42  0 ; day
  43  hour  ; hour
  44  minutes ; minutes
  45  )
  46
  47 ;;----------------------------------------------------------------------------
  48 ;; Characters
  49 ;;----------------------------------------------------------------------------
  50  (kern-mk-char
  51   'ch_wanderer
  52   "The Wanderer"        ; name
  53   sp_human              ; species
  54   oc_wanderer           ; occ
  55   s_wanderer    ; sprite
  56   faction-player        ; starting alignment
  57   6 6 6                ; str/int/dex
  58   pc-hp-off
  59   pc-hp-gain
  60   pc-mp-off
  61   pc-mp-gain
  62   max-health 0 max-health 0 1  ; hp/xp/mp/AP_per_turn/lvl
  63   #f                    ; dead
  64   nil                   ; conv
  65   nil                   ; sched
  66   nil                   ; special ai
  67   nil                   ; container
  68   nil                   ; readied
  69   )
  70
  71
  72 ;;----------------------------------------------------------------------------
  73 ;; Player Party
  74 ;;----------------------------------------------------------------------------
  75 (bind
  76  (kern-mk-player
  77   'player                     ; tag
  78   s_wanderer         ; sprite
  79   "Walk"                      ; movement description
  80   sound-walking               ; movement sound
  81   1                           ; food
  82   0                           ; gold
  83   (* 60 60 5)                 ; turns to next meal (5 hours)
  84   nil                         ; formation
  85   nil                         ; campsite map
  86   nil                         ; campsite formation
  87   nil                         ; vehicle
  88   ;; inventory
  89   (kern-mk-inventory nil)
  90   nil ;; party members (should be nil for initial load file)
  91   )
  92  (tbl-mk) ; gob
  93  )
  94
  95 ;;----------------------------------------------------------------------------
  96 ;; Party members
  97 ;;----------------------------------------------------------------------------
  98 (kern-party-add-member player ch_wanderer)
  99 ;;(kern-party-add-member player ch_thorald_greybeard)
 100
 101 ;;----------------------------------------------------------------------------
 102 ;; Astronomy
 103 ;;----------------------------------------------------------------------------
 104 (kern-mk-astral-body
 105  'sun              ; tag
 106  "Fyer (the sun)"  ; name
 107  1                 ; relative astronomical distance
 108  1                 ; minutes per phase (n/a for sun)
 109  (/ (* 24 60) 360) ; minutes per degree
 110  0                 ; initial arc
 111  0                 ; initial phase
 112  '()               ; script interface
 113  ;; phases:
 114  (list
 115   (list s_sun 255 "full")
 116   )
 117  )
 118
 119 ; ;;----------------------------------------------------------------------------
 120 ; ;; Lumis is the source gate, which means it opens the source moongates on its
 121 ; ;; phases. We designate this by using the source-moon-ifc as its ifc.
 122 ; ;;
 123 ; ;; Note: the arc and phase are calculated to give the moon the right orientation
 124 ; ;; with respect to phase vs sun position
 125 ; ;;----------------------------------------------------------------------------
 126 ; (mk-moon 'lumis  ; tag
 127 ;          "Lumis" ; name
 128 ;          5       ; hours per phase
 129 ;          60      ; hours per revolution
 130 ;          22      ; initial arc
 131 ;          0       ; initial phase
 132 ;          'source-moon-ifc ; ifc
 133 ;          ;; gates (moons are fixed at 8 phases in mk-moon):
 134 ;          (list 'mg-1 'mg-2 'mg-3 'mg-4
 135 ;                'mg-5 'mg-6 'mg-7 'mg-8
 136 ;                )
 137 ;          "yellow")
 138
 139 ; ;;----------------------------------------------------------------------------
 140 ; ;; Ord is the destination gate, which means its phase decides the destination
 141 ; ;; when the player steps through a moongate. We designate this by giving it a
 142 ; ;; nil ifc. Note that its gates do not need to be listed in the same order as
 143 ; ;; Lumis. In fact, they don't even need to be the same set of gates.
 144 ; ;;
 145 ; ;; Note: the arc and phase are calculated to give the moon the right orientation
 146 ; ;; with respect to phase vs sun position
 147 ; ;;----------------------------------------------------------------------------
 148 ; (mk-moon 'ord    ; tag
 149 ;          "Ord"   ; name
 150 ;          9       ; hours per phase
 151 ;          36      ; hours per revolution
 152 ;          67     ; initial arc
 153 ;          7       ; initial phase
 154 ;          nil     ; ifc
 155 ;          ;; gates (moons are fixed at 8 phases in mk-moon):
 156 ;          (list 'mg-1 'mg-2 'mg-3 'mg-4
 157 ;                'mg-5 'mg-6 'mg-7 'mg-8
 158 ;                )
 159 ;          "blue")
 160
 161 ;; ----------------------------------------------------------------------------
 162 ;; The diplomacy table. Each entry defines the attitude of the row to the
 163 ;; column. Note that attitudes are not necessarily symmetric. Negative values
 164 ;; are hostile, positive are friendly.
 165 ;;
 166 ;; Note: factions should always be allied with themselves in order for
 167 ;; summoning AI to work properly.
 168 ;;
 169 ;; Formatted for spreadsheet
 170 ;; ----------------------------------------------------------------------------
 171 (kern-mk-dtable
 172         ;;      non pla men cgb acc mon tro spd out gnt dem fgb prs gla
 173         (list   2   0   0   0   -1  -2  -2  -2  0   -2  -2  0   0   0    ) ;; none
 174         (list   0   2   2   -2  -2  -2  -2  -2  -2  -2  -2  -2  2   2    ) ;; player
 175         (list   -1  2   2   -1  -2  -2  -2  -2  -2  -2  -2  -2  2   2    ) ;; men
 176         (list   -1  -2  -2  2   -1  -2  0   -2  -2  -1  -2  -2  0   -2   ) ;; cave goblin
 177         (list   -1  -2  -1  -1  2   -2  -1  -1  -2  -1  -2  -2  0   -2   ) ;; accursed
 178         (list   -2  -2  -2  -2  -2  2   -2  0   -2  0   -2  0   0   -2   ) ;; monsters
 179         (list   -2  -2  -2  0   -1  -2  2   -2  -2  -1  -2  -1  0   -2   ) ;; hill trolls
 180         (list   -2  -2  -2  -2  -1  0   -2  2   -2  -1  -2  0   0   -2   ) ;; wood spiders
 181         (list   0   -2  -2  -2  -2  -2  -2  -2  2   -2  -2  -1  0   -2   ) ;; outlaws
 182         (list   -2  -2  -2  -1  -1  0   -1  -1  -2  2   -2  -1  0   -2   ) ;; gint
 183         (list   -2  -2  -2  -2  -2  -2  -2  -2  -2  -2  2   -2  0   -2   ) ;; demon
 184         (list   0   -2  -2  -2  -2  0   -2  0   -1  -1  -2  2   0   -2   ) ;; forest goblin
 185         (list   0   2   2   0   0   0   0   0   0   0   0   0   2   2    ) ;; prisoners
 186         (list   -1  2   2   -1  -2  -2  -2  -2  -2  -2  -2  -2  2   2    ) ;; glasdrin
 187 )
 188
 189
 190 (kern-mk-place
 191  'p_minimal "Minimal Place" s_keep
 192  (kern-mk-map
 193   nil 19 19 pal_expanded
 194   (list
 195    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 196    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 197    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 198    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 199    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 200    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 201    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 202    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 203    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 204    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 205    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 206    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 207    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 208    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 209    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 210    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 211    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 212    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 213    ".. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .."
 214    ))
 215  #f      ; wraps
 216  #f      ; underground
 217  #f      ; large-scale (wilderness)
 218  #f      ; tmp combat place
 219  nil     ; subplaces
 220  nil     ; neighbors
 221  nil ; objects
 222  nil ; hooks
 223  nil ; edge entrances
 224  )
 225
 226 (define (mk-npc name)
 227   (bind
 228    (kern-mk-char (string->symbol (string-append "ch_"
 229                                                 (string-lower name))) ; tag
 230                  name              ; name
 231                  sp_human            ; species
 232                  nil                 ; occ
 233                  s_wanderer          ; sprite
 234                  faction-men         ; starting alignment
 235                  0 10 5              ; str/int/dex
 236                  0 0                 ; hp mod/mult
 237                  0 0                 ; mp mod/mult
 238                  max-health -1 max-health 0 2  ; hp/xp/mp/AP_per_turn/lvl
 239                  #f                  ; dead
 240                  nil        ; conv
 241                  nil          ; sched
 242                  nil                 ; special ai
 243                  nil                 ; container
 244                  nil ; readied
 245                  )
 246    nil ; gob
 247    ))
 248
 249 (mk-npc "Andrea")
 250 (mk-npc "Charlie")
 251 (mk-npc "Gregor")
 252
 253
 254 (kern-obj-set-conv ch_gregor 'gregors-conv)
 255
 256 ;;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 257 ;; Setup a quest-offer test
 258
 259 ;;;; (define (attach kobj val-tag)
 260 ;;;;   (let ((val (eval val-tag))
 261 ;;;;         (obj (gob kobj)))
 262 ;;;;     (if (null? val) (error "attach: no val for " val-tag))
 263 ;;;;     (if (null? obj) (error "attach: no gob for " (kern-obj-get-name kobj)))
 264 ;;;;     (if (val 'can-attach? kobj)
 265 ;;;;         (tbl-append! obj val-tag)
 266 ;;;;         (val 'on-attach kobj)
 267 ;;;;         )))
 268 ;;;;
 269 ;;;; (define (attached? kobj val-tag)
 270 ;;;;   (let ((obj (gob kobj)))
 271 ;;;;     (if (null? obj)
 272 ;;;;         #f
 273 ;;;;         (tbl-get obj (val-tag 'key)))
 274 ;;;;         ))
 275 ;;;;
 276 ;;;; (define quest-offer-ifc
 277 ;;;;   (ifc nil
 278 ;;;;        (method 'can-attach? (lambda (knpc) (println "can-attach") #t))
 279 ;;;;        (method 'key (lambda () 'quest-offer))
 280 ;;;;        (method 'on-attach (lambda (knpc) ))
 281 ;;;;        (method 'is-avail? (lambda (knpc kpc) #t))
 282 ;;;;        (method 'offer (lambda (knpc kpc) ))
 283 ;;;;        ))
 284 ;;;;
 285 ;;;; (define (gregors-quest-make-offer kpc knpc)
 286 ;;;;   (say knpc "Want a quest?")
 287 ;;;;   (cond ((yes? kpc)
 288 ;;;;          (say knpc "You got it.")
 289 ;;;;          (quest-assign gregors-quest (gob (kern-get-player))))
 290 ;;;;         (else
 291 ;;;;          (say knpc "Fine. Loser.")
 292 ;;;;          (kern-conv-end))
 293 ;;;;         ))
 294 ;;;;
 295 ;;;; (define gregors-quest-offer
 296 ;;;;   (ifc quest-offer-ifc
 297 ;;;;        (method 'on-attach (lambda (knpc) (kern-add-hook 'conv_end_hook gregors-quest-make-offer)))
 298 ;;;;        (method 'key (lambda () 'gregors-quest))
 299 ;;;;        ))
 300
 301 ;;----------------------------------------------------------------------------
 302 ;; end-of-conv hook handling
 303
 304 ;; create the table for end-of-conv handlers
 305 (kern-define 'end-of-conv-handlers (tbl-mk))
 306
 307 ;; a procedure to run all the end-of-conv handlers
 308 (define (run-end-of-conv-handlers kpc knpc args)
 309   (println "run-end-of-conv-handlers:args=" args)
 310   (tbl-for-each-val (lambda (val)
 311                       (println "val:" val)
 312                       (apply (eval (car val)) (cons kpc (cons knpc (cdr val)))))
 313                     (eval (car args))))
 314
 315 ;; setup the end-of-conv hook to run the handlers (this must be done only once
 316 ;; per game, so keep it in the start-game file)
 317 (kern-add-hook 'conv_end_hook
 318                'run-end-of-conv-handlers
 319                '(end-of-conv-handlers))
 320
 321 ;;----------------------------------------------------------------------------
 322 ;; Offer a predefined quest in a piece of dialogue. 'args' should be a list
 323 ;; like this:
 324 ;;
 325 ;; (offer-string accept-string reject-string quest)
 326 ;;
 327 ;; Where 'quest' is an instance of a quest.
 328 (define (basic-quest-offer kpc knpc args)
 329   (println "basic-quest-offer: args=" args)
 330   (println "knpc=" knpc)
 331   (define (offer t1 t2 t3 quest)
 332     (println "offer")
 333     (say knpc t1)
 334     (cond ((yes? kpc)
 335            (say knpc t2)
 336            (quest-assign (eval quest)
 337                          (gob (kern-get-player)))
 338            (tbl-rm! end-of-conv-handlers quest)
 339            )
 340           (else
 341            (say knpc t3)
 342            )))
 343   (if (equal? knpc (safe-eval (car args)))
 344       (apply offer (cdr args))))
 345
 346
 347 ;;----------------------------------------------------------------------------
 348 ;; gregor's quest (test)
 349
 350 ;; create the quest (for now)
 351 (kern-define 'gregors-quest
 352              (quest-talk-to-for-xp-mk 'ch_gregor 10))
 353
 354 ;; Add an end-of-conv handler to offer gregor's quest
 355 ;;
 356 ;; (note 1: that the entry must be a list in a list because of the way
 357 ;; tbl-for-each and the apply within it work)
 358 ;;
 359 ;; (note 2: by convention, the key is the name of the quest; basic-quest-offer
 360 ;; assumes this)
 361 (tbl-set! end-of-conv-handlers
 362           'gregors-quest
 363           '((basic-quest-offer (ch_gregor "Want a quest?" "You got it." "Fine. Loser" gregors-quest))))
 364
 365
 366 ;;----------------------------------------------------------------------------
 367 ;; random quest assignment (prototype)
 368
 369 (define (random-mailman-quest-offer kpc knpc)
 370   (say knpc
 371        "I need someone to deliver THIS PACKAGE"
 372        " to SOMBEODY"
 373        " by SOMETIME"
 374        ". Will you do it?")
 375   (cond ((yes? kpc)
 376          (say knpc "GREAT")
 377          ;; (quest-assign ...)
 378          )
 379         (else
 380          (say knpc "WHAT? YOU SUCK!")
 381          ))
 382   (println "leaving")
 383   )
 384
 385 (define (select-random-quest-offer knpc)
 386   (println "select-random-quest-offer")
 387   (random-select (list random-mailman-quest-offer
 388                    )))
 389
 390 (define (offer-random-quest kpc knpc args)
 391   (println "offer-random-quest")
 392   (let ((offer (select-random-quest-offer knpc)))
 393     (if (notnull? offer)
 394         (offer kpc knpc))))
 395
 396 (tbl-set! end-of-conv-handlers
 397           'random-quest
 398           '((offer-random-quest nil)))
 399
 400 ;;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 401
 402 ;;----------------------------------------------------------------------------
 403 ;; Startup - this is a one-time only script that runs when the player starts
 404 ;; the game for the first time (or whenever he starts over from scratch,
 405 ;; loading the game from this file). It sets up the story a bit.
 406 ;;----------------------------------------------------------------------------
 407
 408 (define (simple-start kplayer)
 409   (kern-obj-put-at kplayer (list p_minimal 0 0))
 410   (kern-obj-put-at ch_gregor (list p_minimal 1 1))
 411   (quest-assign (quest-talk-to-for-xp-mk 'ch_gregor 10) (gob kplayer))
 412   )
 413
 414 (kern-add-hook 'new_game_start_hook 'simple-start)
 415
 416 (kern-progress-bar-finish)