Project Lizardry ～その1～

#!/usr/bin/env mzscheme
#lang scheme/base

(require srfi/1)

;; データ
(define *gilgamesh-tavern-data* '())

(define *party* '())

;; キャラクター基本
(define *character-base*
  '(('foe . #f)
    ('level . #f)
    ('性格 . #f)
    ('職業 . #f)
    ('種族 . #f)
    ('E.P. . #f)
    ('Next . #f)
    ('Gold . #f)
    ('Marks . #f)
    ('Age . #f)
    ('A.C. . #f)
    ('Rip . #f)
    ('力 . #f)
    ('知恵 . #f)
    ('信仰心 . #f)
    ('生命力 . #f)
    ('素早さ . #f)
    ('運の強さ . #f)
    ('H.P.numerator . #f)
    ('H.P.denominator . #f)
    ('状態 . #f)
    ('Mage 0 0 0 0 0 0 0 0 0)
    ('Priest 0 0 0 0 0 0 0 0 0)
    ('持ち物 . '())))

(define *race* '((人間 ((力 . 8)
                        (知恵 . 8)
                        (信仰心 . 5)
                        (生命力 . 8)
                        (素早さ . 8)
                        (運の強さ . 9)))
                 (エルフ ((力 . 7)
                          (知恵 . 10)
                          (信仰心 . 10)
                          (生命力 . 6)
                          (素早さ . 9)
                          (運の強さ . 6)))
                 (ドワーフ ((力 . 10)
                            (知恵 . 7)
                            (信仰心 . 10)
                            (生命力 . 10)
                            (素早さ . 5)
                            (運の強さ . 6)))
                 (ノーム ((力 . 7)
                          (知恵 . 7)
                          (信仰心 . 10)
                          (生命力 . 8)
                          (素早さ . 10)
                          (運の強さ . 7)))
                 (ホビット ((力 . 5)
                            (知恵 . 7)
                            (信仰心 . 7)
                            (生命力 . 6)
                            (素早さ . 10)
                            (運の強さ . 15)))))

;; テキスト部分
(define *top-page-text*
  "\t Lizardry\n\n      Proving Grounds\n\t    of\n     the Let Over Lambda\n\n\tWelcome to\n  the world of Lizardry\n\n\t1. START\n\t2. READ STORY\n")

(define *story-text*
  '("昔々あるところにラムダ王国と言う平和な国があった。ラムダ王国の平和はラムダ騎士団によって守られていた。\n\nラムダ騎士団のリーダーは紫導師と呼ばれるハッカーだった。ラムダ騎士団は紫導師の指導の下、日々鍛錬を重ねていた。\n\nそんなある日、城壁のそばに転がっていた古びたSymbolicsの中に迷宮を作って住み着く邪悪なニシキヘビが、紫導師の寝室に忍び込み、熟睡中の紫導師の耳元で悪魔の言葉を大阪弁で囁いた。\n\n「今更マクロなんて流行りまへんがな。時代は豊富な組み込みライブラリでっせ、旦那。」\n\nこの言葉は呪詛となり、あろう事か紫導師はニシキヘビと共に電脳迷宮の奥深くへと消えて行った。\n\n"
    "紫導師の突然の失踪は即ラムダ騎士団の弱体化に繋がった。リーダーを失ったラムダ騎士団はもはや烏合の衆と成り果て、ラムダ王国は存亡の危機へと陥った。\n\n事態を重く見たラムダ国王はラムダ騎士団の立て直しを図り、世界に散らばった逸材を発掘するため、ある召集を行った。\n\n「我らが偉大な王、ラムダ国王の召集である。皆の者、心して聞くように。元主席ハッカー紫が、ニシキヘビの陰謀に嵌り連れ去られてしまった。ニシキヘビは勝手に町外れに転がっている中古のSymbolicsの電脳世界に迷宮を掘り、モンスターを離して立てこもっておるのだ。かの悪逆非道のニシキヘビを成敗し、紫導師を救い出すのだ!さすれば、ラムダの騎士の称号とラムダ騎士団への入隊、更には多額の賞金が贈られるであろう!ポール・グレアムも実はそうやって金を稼いだのだがそれは内緒にしててね!!」\n\nこの召集に、ラムダ王国だけではなく、各地からあらゆる種族のハッカー達が集まった。金に困る者、己の腕を磨こうとする者たちが次々に名乗りをあげる。ラムダの騎士の名誉と一攫千金を夢見て・・・。\n\n"))

(define *castle-text*
  "\t        キャッスル:\n\n\t1. ギルガメッシュないとの酒場\n\t2. ハッカーの宿\n\t3. ボッタクル商店\n\t4. カント寺院\n\t5. 街外れに行く\n")

(define *gilgamesh-tavern-text*
  "\t        キャッスル:\n\n\t1. 仲間に入れる\n\t2. 仲間から外す\n\t3. 調べる\n\t4. ゴールドの山分け\n\t5. 外へ出る\n")

(define *edge-of-town-text*
  "\t        街外れ:\n\n\t1. 迷宮に入る\n\t2. 冒険の再開\n\t3. 訓練場に行く\n\t4. ゲームの中断\n\t5. 城に戻る\n")

(define *leave-game-text*
  "\tお疲れ様でした。\nこの状態でゲームを終了します。\n\n\tAで冒険を再開します\n")

;; マクロ
(define-syntax character-making
  (syntax-rules ()
    ((_ name alist)
     (define name
       (alist-copy alist)))))

;; 実行部分

(define (top-page scenario)
  (display scenario)
  (newline)
  (display "コマンド? >> ")
  (let ((key (read)))
    (case key
      ((1) (castle *castle-text*))
      ((2) (story-reader *story-text*))
      (else (top-page scenario)))))

(define (story-reader scenario)
  (do ((ls scenario (cdr ls))
       (key #f (read)))
      ((null? ls) (top-page *top-page-text*))
    (display (car ls))))

(define (castle scenario)
  (display scenario)
  (newline)
  (display "コマンド? >> ")
  (let ((key (read)))
    (case key
      ((1) (gilgamesh-tavern *gilgamesh-tavern-text*))
      ((2) (adventurer-inn))
      ((3) (boltac-trading-post))
      ((4) (temple-of-cant))
      ((5) (edge-of-town *edge-of-town-text*))
      (else (castle scenario)))))

(define (gilgamesh-tavern scenario)
  (display scenario)
  (newline)
  (display "コマンド? >> ")
  (let ((key (read)))
    (case key
      ((1) (add-character))
      ((2) (remove-character))
      ((3) (inspect-character))
      ((4) (divvy-gold))
      ((5) (castle *castle-text*))
      (else (gilgamesh-tavern scenario)))))

(define (add-character) (display "工事中\n"))
(define (remove-character) (display "工事中\n"))
(define (inspect-character) (display "工事中\n"))
(define (divvy-gold) (display "工事中\n"))

(define (adventurer-inn)
  (display "工事中\n"))

(define (boltac-trading-post)
  (display "工事中\n"))

(define (temple-of-cant)
  (display "工事中"))

(define (edge-of-town scenario)
  (display scenario)
  (newline)
  (display "コマンド? >> ")
  (let ((key (read)))
    (case key
      ((1) (maze))
      ((2) (restart-an-out-party))
      ((3) (training-grounds))
      ((4) (leave-game *leave-game-text*))
      ((5) (castle *castle-text*))
      (else (edge-of-town scenario)))))

(define (maze) (display "工事中\n"))
(define (restart-an-out-party) (display "工事中\n"))
(define (training-grounds) (display "工事中\n"))

(define (leave-game scenario)
  (display scenario)
  (newline)
  (display "コマンド? >> ")
  (let ((key (read)))
    (if (eqv? key 'a)
        (edge-of-town *edge-of-town-text*)
        (exit))))

(define (inheritance key datum)
  (lambda (alist)
    (let ((ls (alist-delete key (alist-copy alist))))
      (alist-cons key datum alist))))

(top-page *top-page-text*)