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 "Loading" 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) 417