print

;;; Print

(define-class message ((data '((introduction . "イスカンダルのトーフ屋ゲーム (scheme版)\n
Copyright (C) 1978-2014 by N.Tsuda\n
ルール説明しますか?[y/n]")
                               (instruction . "ここはイスカンダル星。あなたはここでトーフ屋を経営し、\n
地球への帰還費用を作り出さなくてはいけません。\n
でもお向かいには、コンピュータが経営するトーフ屋があります。。。\n
\n
トーフの原価は1個40円、販売価格は50円です。\n
1日に売れる個数は天候に左右されます。\n
トーフは日持ちしないので、売れ残った分はすべて廃棄します。\n
そこで、次の日の天気予報を良く見て、何個作るか決心してください。\n
所持金5千円からはじめて早く3万円を超えた方が勝ちです。\n
\n
いいですか?[y/n]")
                               (1000-yen . #\■)
                               (empty-yen . #\□)
                               (next-day . "\n***** 次の日 *****\n")
                               (weather-is . "今日の天気は")
                               (result . " です。\n")
                               (sunny . (#\◎ . "晴れ \\(^o^)/ "))
                               (cloudy . (#\・ . "くもり (~_~) "))
                               (rainy . (#\● . "雨 (;_;) "))
                               (you-win . "あなたの勝ちです。\n\n")
                               (even . "引き分けです。")
                               (you-lose . "コンピュータの勝ちです。\n\n")
                               (play-again? . "play again? [y/n]"))))
  ()
  (print (x y)
         (letrec ((show-data
                   ; 現在のデータを表示
                   (lambda (env)
                     (letrec ((show-money 
                               ; 持ち金に関するデータを表示
                               (lambda ()
                                 (letrec ((calc
                                           ; 整形表示に関する各種演算
                                           (lambda (player)
                                             (letrec ((space-calc
                                                       (lambda (x)
                                                         (cond ((> x 9999) "")
                                                               ((> x 999) " ")
                                                               ((> x 99) "  ")
                                                               (else "   ")))))
                                               (let ((x (money player)))
                                                 (let ((y (quotient x 1000)))
                                                   (values (space-calc x) 
                                                           (number->string x) 
                                                           (make-string y 
                                                                        (cdr (assq '1000-yen data)))
                                                           (make-string (- 30 y)
                                                                        (cdr (assq 'empty-yen data))))))))))
                                   (let-values (((p0 p1 p2 p3) (calc (get-player env))))
                                     (let-values (((c0 c1 c2 c3) (calc (get-computer env))))
                                       (string-append "\n所持金: \nあなた " 
                                                      p0 p1 "円 " p2 p3
                                                      "\nわたし "
                                                      c0 c1 "円 " c2 c3
                                                      "\n\n"))))))
                              (show-weather-report
                               ; 天気予報に関するデータを表示
                               (lambda ()
                                 (letrec
                                     ((calc
                                       ; 整形表示に関する各種演算
                                       (lambda ()
                                         (let ((wr (weather-report (get-weather env)))
                                               (keys '(sunny cloudy rainy)))
                                           (let ((table (map (lambda (x)
                                                               `(,x . ,(quotient (* 40 (cdr (assq x wr))) 100)))
                                                             keys)))
                                             (append (map (lambda (x)
                                                            (number->string (cdr (assq x wr))))
                                                          keys)
                                                     (map (lambda (x)
                                                            (make-string (cdr (assq x table)) (cadr (assq x data))))
                                                          keys)))))))
                                   (let ((string-list (calc)))
                                     (string-append "明日の天気予報: 晴れ " 
                                                    (list-ref string-list 0)
                                                    "% くもり "
                                                    (list-ref string-list 1)
                                                    "% 雨 "
                                                    (list-ref string-list 2)
                                                    "%\n"
                                                    (list-ref string-list 3)
                                                    (list-ref string-list 4)
                                                    (list-ref string-list 5)
                                                    "\n\n")))))
                              (show-howmany-tofus
                               ; トーフをいくつ作るか質問表示
                               (lambda ()
                                 (string-append "\nトーフを何個作りますか? (1~"
                                                (number->string 
                                                 (maximum (get-tofu env) (get-player env)))
                                                ") "))))
                       (string-append (show-money)
                                      (show-weather-report) 
                                      (show-howmany-tofus)))))
                  (show-computer-reply
                   ; コンピュータの決定を表示
                   (lambda (num)
                     (string-append "わたしは" 
                                    (number->string num)
                                    "個作ります。\n")))
                  (show-result
                   ; 翌日のトーフ売上表示
                   (lambda (sym)
                     (string-append
                      (cddr (assq sym data))
                      (cdr (assq 'result data))))))
           ; Body
           (for-each (lambda (x)
                       ; sleep はRacket 実装依存
                       ; SRFI-18が使える処理系なら
                       ; 冒頭で呼び出し、thread-sleep
                       ; が代わりに使える
                       ; 他の場合は、各実装のマニュアル参照の事
                       (sleep 0.5)
                       (display x))
                     (case x
                       ((show-data) `(,(show-data y)))
                       ((opponent-turn) `(,(show-computer-reply y)))
                       ((next-day) `(,(cdr (assq 'next-day data))
                                     ,(cdr (assq 'weather-is data))
                                     "." "." "."
                                     ,(show-result y)))
                       ((who-is-winner) (map (lambda (z)
                                               (cdr (assq z data)))
                                             `(,y play-again?)))
                       (else `(,(cdr (assq x data)))))))))

(define-method print)