<div dir="ltr">I see it may be a bug.<div><br></div><div>I don't know if I put the code here or not, but determine to put it.</div><div><br></div><div>Note that this is a kind of messy code and I mean it. It is a sort of experiment.</div>
<div>I try making a REPL structure with Data Driven Programming way that might be implied in SICP using closures, a bit close to OOP without inheritance.</div><div>The first purpose the reason I write in this messy way is that I want to know "Functional Programming" on Scheme is "Obviously" better </div>
<div>and simpler than "OOP style"; therefore, the code shown here looks like </div><div>"Awful!-This-is-not-a-Scheme-code-you-mor*n!" style.</div><div>However, the second purpose is, more impotant, more than letting me got accustomed to OOP way, that I thought MVC pattern which is occasionally used in GUI programming is very close to REPL structure and it may imply if you wrote an completely-isolated R-E-P-L style CLI program, you may easily convert into the GUI one by inheritance with some GUI tool kit like Qt or WxWidgets. </div>
<div>These are why I decided to write an awful OOP-like code on Scheme.</div><div><br></div><div>--------</div><div><br></div><div><div>#lang racket</div><div><br></div><div>;;;;; Tofu Sellers in Iscandar (Version Scheme)</div>
<div>;;;;; Copyright (C) 1978-2014 by N.Tsuda</div><div>;;;;; <a href="http://vivi.dyndns.org/tofu/tofu.html">http://vivi.dyndns.org/tofu/tofu.html</a></div><div>;;;;; was made on PLT Racket</div><div>;;;;; Racket:</div><div>
;;;;; <a href="http://racket-lang.org/">http://racket-lang.org/</a></div><div><br></div><div>; This section relies on Racket.</div><div>; If you use another scheme implimentation,</div><div>; you've got to rewrite below one in each way</div>
<div>; such as:</div><div>; Gauche: <a href="http://practical-scheme.net/gauche/index-j.html">http://practical-scheme.net/gauche/index-j.html</a></div><div>; (use srfi-1) ...</div><div>; Guile: <a href="http://www.gnu.org/software/guile/">http://www.gnu.org/software/guile/</a></div>
<div>; (srfi srfi-1) ...</div><div>; and so on.</div><div>; Please refer to the paticular reference.</div><div><br></div><div>(require srfi/1 srfi/11 srfi/13 srfi/27)</div><div><br></div><div>; These codes here rely on Racket.</div>
<div>; To set character code on Windows especially for Japanese One.</div><div>(current-input-port (reencode-input-port (current-input-port)</div><div> "shift_jis"))</div>
<div>(current-output-port (reencode-output-port (current-output-port)</div><div> "shift_jis"))</div><div><br></div><div>;;; Initialize random number source</div><div>
(random-source-randomize! (make-random-source))</div><div><br></div><div>;;; Macros for Data Driven Programming</div><div>;;; Psedo Object Orientated Programming</div><div>;;; Inspired by the code on PAIP</div><div>;;; PAIP : <a href="http://norvig.com/paip.html">http://norvig.com/paip.html</a></div>
<div>;;; , written by Peter Norvig.</div><div><br></div><div>;; Associate list for Generic Procedures</div><div>(define generic-proc '())</div><div><br></div><div>;; Associate list for Class Variables</div><div>(define class-vars-alist '())</div>
<div><br></div><div>;; Macro for defining classes</div><div>(define-syntax define-class</div><div> (syntax-rules ()</div><div> ((_ class (inst-var ...) </div><div> ((class-var class-val) ...) </div><div> (method arg body ...) ...)</div>
<div> (begin</div><div> (set! class-vars-alist </div><div> (cons `(class ((class-var . ,class-val) ...)) </div><div> class-vars-alist))</div><div> (for-each ensure-generic-proc '(method ...))</div>
<div> (define (class inst-var ...)</div><div> (lambda (message)</div><div> (case message</div><div> ((method) (lambda arg body ...))</div><div> ...)))))))</div><div><br></div>
<div>(define (get-method object message)</div><div> (object message)) </div><div><br></div><div>(define (ensure-generic-proc message)</div><div> (if (assq message generic-proc)</div><div> #f</div><div> (let ((proc (lambda (object . args)</div>
<div> (apply (get-method object message) args))))</div><div> (set! generic-proc </div><div> (alist-cons message proc generic-proc)))))</div><div><br></div><div>(define-syntax get-class-var</div>
<div> (syntax-rules ()</div><div> ((_ class var)</div><div> (cdr (assq 'var </div><div> (cadr (assq 'class class-vars-alist)))))))</div><div><br></div><div>(define-syntax class-var-set!</div>
<div> (syntax-rules ()</div><div> ((_ class var val)</div><div> (let ((alist </div><div> (alist-cons 'var val </div><div> (alist-delete 'var </div><div> (cadr (assq 'class class-vars-alist))))))</div>
<div> (set! class-vars-alist </div><div> (cons `(class ,alist) </div><div> (alist-delete 'class class-vars-alist)))))))</div><div><br></div><div>;; Macro for defining method</div><div>
(define-syntax define-method</div><div> (syntax-rules ()</div><div> ((_ method)</div><div> (define method (cdr (assq 'method generic-proc))))))</div><div><br></div><div>;;; Test codes for macros of defining classes</div>
<div>;;; These are borrowed from PAIP,</div><div>;;; Paradigms of Artificial Intelligence Programming</div><div>;</div><div>;(define-class account (name (balance 0))</div><div>; ((interest-rate .06))</div><div>; (withdraw (amt) (cond ((<= amt balance)</div>
<div>; (set! balance (- balance amt))</div><div>; balance)</div><div>; (else 'insufficient-funds)))</div><div>; (deposit (amt) (set! balance (+ balance amt))</div>
<div>; balance)</div><div>; (balance () balance)</div><div>; (name () name)</div><div>; (interest () (set! balance </div><div>; (+ balance (* (get-class-var account interest-rate) balance)))</div>
<div>; balance))</div><div>;</div><div>;(define-method withdraw)</div><div>;(define-method deposit)</div><div>;(define-method balance)</div><div>;(define-method name)</div><div>;(define-method interest)</div><div>
;</div><div>;class-vars-alist</div><div>;generic-proc</div><div>;</div><div>;(define acct (account "A. User" 2000))</div><div>;(= (deposit acct 42) 2042)</div><div>;(= (interest acct) 2164.52)</div><div>;(= (balance acct) 2164.52)</div>
<div><br></div><div>;;; Parser Class (Read)</div><div><br></div><div>;; This is the Read section on REPL, or an interpreter model.</div><div>;; In the case of programming a game, deffering from the ordinary</div><div>;; Read section of an interpreter, games' Read function sometimes</div>
<div>;; got to change its behavior.</div><div>;; In this game, the game stage, reffering as "phase" in this</div><div>;; program, implimented as class variable, requires the Read to </div><div>;; behave three different ways, such as "Nothing-Inputted-but-returns</div>
<div>;; -something-to-eval", "Requires-input-only-integer-and-returns-</div><div>;; something-to-eval",and "Requires-input-only-yes-or-no-like-and-</div><div>;; returns-something-to-eval".</div><div>
;; This mentioned above is the guide to program 'EVAL' here in</div><div>;; this program.</div><div>;; By the way, this Read class always returns two variables, the first</div><div>;; one is phase as a Symbol and the second one is either input or #f</div>
<div>;; by using "values" of Scheme.</div><div><br></div><div>(define-class parser ()</div><div> ; Initial state of its class variable,</div><div> ; "phase" is 'introduction</div><div> ((phase 'introduction))</div>
<div> ; input method</div><div> (input () (let-syntax ((return-values</div><div> (syntax-rules ()</div><div> ((_ phase proc0 (proc1))</div><div> (values phase (let loop ((i (proc1)))</div>
<div> (let ((fact (proc0 i)))</div><div> (if (null? fact)</div><div> (loop (proc1))</div>
<div> fact))))))))</div><div> (letrec ((input-integer</div><div> ; Letting it being able to receive</div><div> ; only integers from input.</div>
<div> ; If not, returns an empty list.</div><div> (lambda (var)</div><div> (if (integer? var)</div><div> var</div><div> '())))</div>
<div> (yes-or-no?</div><div> ; Letting it being able to receive only</div><div> ; 'yes', 'no' or its-alikes.</div><div> ; If not, returns an empty list.</div>
<div> ; Trying emulating a Common Lisp</div><div> ; function "YES-OR-NO-P".</div><div> (lambda (var)</div><div> (letrec ((y-or-n?</div>
<div> ; Returning #t if the input</div><div> ; were yes-likes.</div><div> ; Returning #f if the input</div><div> ; were no-likes.</div>
<div> (lambda (sym)</div><div> (and (memq sym '(Y YES)) #t)))</div><div> (symbol-upcase</div><div> ; Converting the symbol inputted</div>
<div> ; into Upper-Case.</div><div> (lambda (arg)</div><div> (if (symbol? arg)</div><div> (string->symbol </div>
<div> (string-upcase </div><div> (symbol->string arg)))</div><div> '()))))</div><div> (let ((sym (symbol-upcase var)))</div>
<div> (if (memq sym '(Y YES N NO))</div><div> (y-or-n? sym)</div><div> '()))))))</div><div> ; body</div>
<div> (let ((p (get-class-var parser phase)))</div><div> (case p</div><div> ((input-integer) </div><div> (return-values p input-integer (read)))</div>
<div> ((instruction play-again?) </div><div> (return-values p yes-or-no? (read)))</div><div> (else (values p #f))))))))</div><div><br></div><div>(define-method input)</div>
<div><br></div><div>;;; Test codes for the Parser Class</div><div>;</div><div>;(define p (parser))</div><div>;class-vars-alist</div><div>;(class-var-set! parser phase 'input-integer)</div><div>;(input p)</div><div>;(class-var-set! parser phase 'instruction)</div>
<div>;(input p)</div><div>;(class-var-set! parser phase 'play-again)</div><div>;(input p)</div><div>;(class-var-set! parser phase 'foo)</div><div>;(input p)</div><div><br></div><div>;;; Player Class</div><div><br>
</div><div>;; This section defines the class for you,</div><div>;; or player of this game.</div><div><br></div><div>(define-class player ((money 5000) (tofu 0))</div><div> ()</div><div> (money () money)</div><div> (money-set! (arg) (set! money arg))</div>
<div> (show-tofu () tofu)</div><div> (make-tofu (num env) (let ((maxnum </div><div> (maximum (get-tofu env) (get-player env))))</div><div> (if (> num maxnum)</div>
<div> (set! tofu maxnum)</div><div> (set! tofu num))</div><div> tofu)))</div><div><br></div><div>;;; Computer Class</div><div><br></div><div>
;; This is the class for your opponent, computer.</div><div><br></div><div>(define-class computer ((money 5000) (tofu 0))</div><div> ()</div><div> (money () money)</div><div> (money-set! (arg) (set! money arg))</div><div>
(show-tofu () tofu)</div><div> (make-tofu (env) (letrec ((calc</div><div> (lambda (num)</div><div> (let ((maxnum </div><div> (quotient money (cost (get-tofu env)))))</div>
<div> (if (> num maxnum)</div><div> maxnum</div><div> num)))))</div><div> (cond ((> (cdr </div>
<div> (assq 'rainy </div><div> (weather-report (get-weather env)))) </div><div> 30)</div><div> (set! tofu </div>
<div> (is-rainy (get-tofu env))))</div><div> ((> (cdr </div><div> (assq 'sunny </div><div> (weather-report (get-weather env)))) </div>
<div> 49)</div><div> (set! tofu (calc (is-sunny (get-tofu env)))))</div><div> (else</div><div> (set! tofu (calc (is-cloudy (get-tofu env))))))</div>
<div> tofu)))</div><div><br></div><div>(define-method money)</div><div>(define-method money-set!)</div><div>(define-method show-tofu)</div><div>(define-method make-tofu)</div><div><br></div><div>;;; Tofu Class</div>
<div><br></div><div>;; Yes, SOY-BEAN-CURD!!!</div><div>;; Nothing to explain...</div><div>;; Oh, you've never eaten it?</div><div>;; Go to a Japanese restaurant</div><div>;; in or near your town...</div><div>;; <a href="http://www.amazon.co.jp/%E6%A3%AE%E6%B0%B8%E4%B9%B3%E6%A5%AD-%E7%B5%B9%E3%81%94%E3%81%97%E3%81%A8%E3%81%86%E3%81%B5-290g-24%E5%80%8B%E5%85%A5/dp/B001LGM4UG">http://www.amazon.co.jp/%E6%A3%AE%E6%B0%B8%E4%B9%B3%E6%A5%AD-%E7%B5%B9%E3%81%94%E3%81%97%E3%81%A8%E3%81%86%E3%81%B5-290g-24%E5%80%8B%E5%85%A5/dp/B001LGM4UG</a></div>
<div><br></div><div>(define-class tofu ((cost 40)</div><div> (price 50)</div><div> (sunny 500)</div><div> (cloudy 300)</div><div> (rainy 100))</div>
<div> ()</div><div> (cost () cost)</div><div> (price () price)</div><div> (is-sunny () sunny)</div><div> (is-cloudy () cloudy)</div><div> (is-rainy () rainy)</div><div> (maximum (player) (quotient (money player) cost)))</div>
<div><br></div><div>(define-method cost)</div><div>(define-method price)</div><div>(define-method is-sunny)</div><div>(define-method is-cloudy)</div><div>(define-method is-rainy)</div><div>(define-method maximum)</div><div>
<br></div><div>;;; Weather Class</div><div><br></div><div>;; How many tofus could be sold relies on weather in this game.</div><div>;; This weather class controls all related to weather.</div><div>;; This calculates weather report by using random number provided</div>
<div>;; from SRFI-27. It also calculates the actual weather.</div><div><br></div><div>(define-class weather ((sunny 0)</div><div> (cloudy 0)</div><div> (rainy 0))</div><div> ()</div>
<div> ; Calculating the weather report</div><div> (calc-weather-report () (let ((prob0 (random-integer 100))</div><div> (prob1 (random-integer 100)))</div><div> (cond ((> prob0 prob1) </div>
<div> (set! sunny (- 100 prob0))</div><div> (set! rainy prob1))</div><div> (else (set! sunny (- 100 prob1))</div><div> (set! rainy prob0)))</div>
<div> (set! cloudy (- 100 sunny rainy))))</div><div> ; Returning the weather report as an associate list</div><div> (weather-report () `((sunny . ,sunny) </div><div> (cloudy . ,cloudy) </div>
<div> (rainy . ,rainy)))</div><div> ; Returning actual weather next day</div><div> (actual-weather () (let ((r (random-integer 100)))</div><div> (cond ((<= r rainy) (values is-rainy 'rainy))</div>
<div> ((<= r (+ rainy cloudy)) (values is-cloudy 'cloudy))</div><div> (else (values is-sunny 'sunny))))))</div><div><br></div><div>(define-method calc-weather-report)</div>
<div>(define-method weather-report)</div><div>(define-method actual-weather)</div><div><br></div><div>;;; Environment class</div><div><br></div><div>;; As same as an ordinary REPL, the Eval section</div><div>;; refers an environment to get variable, state, or</div>
<div>;; information of the game such as how much money </div><div>;; the player has and so on.</div><div>;; The Environment Class packs the information of</div><div>;; the player, computer, tofu, weather defined as </div>
<div>;; classes above and the target amount of money to the </div><div>;; game-over as its instance variables, and the Eval</div><div>;; section accsesses to these.</div><div><br></div><div>(define-class environment ((p (player))</div>
<div> (c (computer))</div><div> (t (tofu))</div><div> (w (weather))</div><div> (game-over 30000))</div><div> ()</div>
<div> (get-player () p)</div><div> (player-set! (arg) (set! p (arg)))</div><div> (get-computer () c)</div><div> (computer-set! (arg) (set! c (arg)))</div><div> (get-tofu () t)</div><div> (get-weather () w)</div><div>
(get-game-over () game-over))</div><div><br></div><div>(define-method get-player)</div><div>(define-method player-set!)</div><div>(define-method get-computer)</div><div>(define-method computer-set!)</div><div>(define-method get-tofu)</div>
<div>(define-method get-weather)</div><div>(define-method get-game-over)</div><div><br></div><div>;;; Test codes for the Environment Class</div><div>;</div><div>;(define e (environment))</div><div>;(define method-list `(,money ,show-tofu))</div>
<div>;(map (lambda (x)</div><div>; (x (get-player e)))</div><div>; method-list)</div><div>;(map (lambda (x)</div><div>; (x (get-computer e)))</div><div>; method-list)</div><div>;(define tofu-proplist </div>
<div>; `(,price ,cost ,is-sunny ,is-rainy ,is-cloudy))</div><div>;(map (lambda (x)</div><div>; (x (get-tofu e)))</div><div>; tofu-proplist)</div><div>;(get-game-over e)</div><div><br></div><div>;;; Game Master Class (Eval)</div>
<div><br></div><div>;; The Game-Master Class is simply EVAL in the </div><div>;; REPL intepreter. It calclates results according</div><div>;; to the arguments coming from the READ, setting</div><div>;; the next-phase on the class variable "phase"</div>
<div>;; on the Read Class, and returns the calculated</div><div>;; results to the Print Class.</div><div>;; As long as the ordinary interpreter like Scheme,</div><div>;; this is the heart of system.</div><div>;; By the way, this Eval class always returns two </div>
<div>;; variables, the first one is "what-to-show" as</div><div>;; a Symbol and the second one is the information </div><div>;; calculated if needed by the Print section or #f, </div><div>;; by using "values" of Scheme.</div>
<div><br></div><div><br></div><div>(define-class game-master ((env (environment))</div><div> (strange-flag #t))</div><div> ()</div><div> (interp (x y) (letrec ((instruction</div><div> ; Evaluating "instruction of this game"</div>
<div> (lambda (x env)</div><div> (cond ((eq? x strange-flag)</div><div> (set! strange-flag #f)</div><div> (values 'instruction #f))</div>
<div> (else (class-var-set! parser phase 'input-integer)</div><div> (calc-weather-report (get-weather env))</div><div> (values 'show-data env)))))</div>
<div> (calculation</div><div> ; Evaluating "how mamy tofus are sold and income nextday"</div><div> (lambda (x fact env)</div><div> (let ((sold (if (> (show-tofu x) fact)</div>
<div> fact</div><div> (show-tofu x))))</div><div> (let ((money </div><div> (- (+ (money x) </div>
<div> (* sold (price (get-tofu env)))) </div><div> (* (show-tofu x) (cost (get-tofu env))))))</div><div> (money-set! x money)))))</div>
<div> (test-who-is-winner</div><div> ; Evaluationg "Who is the winner?"</div><div> (lambda (env)</div><div> (letrec ((test</div>
<div> ; Calculationg if the game is over or not</div><div> (lambda (env)</div><div> (or (>= (money (get-player env)) </div>
<div> (get-game-over env))</div><div> (>= (money (get-computer env)) </div><div> (get-game-over env))</div>
<div> (< (money (get-player env)) </div><div> (cost (get-tofu env)))</div><div> (< (money (get-computer env)) </div>
<div> (cost (get-tofu env))))))</div><div> (who-is-winner</div><div> ; Determing who is the winner in the turn</div>
<div> (lambda (env)</div><div> (cond ((> (money (get-player env)) </div><div> (money (get-computer env)))</div>
<div> 'you-win)</div><div> ((< (money (get-player env)) </div><div> (money (get-computer env)))</div>
<div> 'you-lose)</div><div> (else 'even)))))</div><div> (cond ((test env) (class-var-set! parser phase 'play-again?)</div>
<div> (values 'who-is-winner (who-is-winner env)))</div><div> (else (class-var-set! parser phase 'input-integer)</div><div> (calc-weather-report (get-weather env))</div>
<div> (values 'show-data env))))))</div><div> (play-again?</div><div> ; Asking continue? after the game-over of the turn</div><div>
(lambda (x env)</div><div> (cond (x (class-var-set! parser phase 'input-integer)</div><div> (player-set! env player)</div><div> (computer-set! env computer)</div>
<div> (calc-weather-report (get-weather env))</div><div> (values 'show-data env))</div><div> ; Both procedures here rely on Racket.</div>
<div> ; If you use another implimentation, please</div><div> ; refer to its manual.</div><div> ; Unfortunately, the specification of Scheme</div>
<div> ; (R5RS) does not define "exit" or "quit" to</div><div> ; quit the scheme system.</div><div> (else (flush-output) </div>
<div> (exit))))))</div><div> ; body</div><div> (case x</div><div> ((introduction) (class-var-set! parser phase 'instruction)</div>
<div> (values x #f))</div><div> ((instruction) (instruction y env))</div><div> ((input-integer) (class-var-set! parser phase 'next-day)</div><div>
(make-tofu (get-player env) y env)</div><div> (let ((num (make-tofu (get-computer env) env)))</div><div> (values 'opponent-turn num)))</div>
<div> ((next-day) (class-var-set! parser phase 'test)</div><div> (let-values (((method sym) (actual-weather (get-weather env))))</div><div> (let ((fact (method (get-tofu env))))</div>
<div> (for-each (lambda (x)</div><div> (calculation x fact env))</div><div> `(,(get-player env) ,(get-computer env)))</div>
<div> (values x sym))))</div><div> ((test) (test-who-is-winner env))</div><div> ((play-again?) (play-again? y env))))))</div><div><br></div><div>(define-method interp)</div>
<div><br></div><div>;;; test codes for the Game Master Class</div><div>;</div><div>;(define g (game-master))</div><div>;class-vars-alist</div><div>;(interp g 'introduction #t)</div><div>;class-vars-alist</div><div>;(interp g 'instruction #t)</div>
<div>;class-vars-alist</div><div>;(interp g 'instruction #t)</div><div>;class-vars-alist</div><div>;(interp g 'input-integer 100)</div><div>;class-vars-alist</div><div>;(interp g 'next-day #f)</div><div>;class-vars-alist</div>
<div>;(interp g 'test #f)</div><div><br></div><div>;;; Message Class (Print)</div><div><br></div><div>;; The Message Class is simply the Print in the ordinary REPL </div><div>;; interpreter like Scheme. It only calculates in order to </div>
<div>;; format texts to display; however, it never calculates something </div><div>;; related to the game's process itself. I try making completedly </div><div>;; isolating functions for each classes of REPL. As a result, the </div>
<div>;; Message class got to have a bunch of something to display like </div><div>;; strings as data inside it.</div><div><br></div><div>(define-class message ((data '((introduction . "$B%$%9%+%s%@%k$N%H!<%U20%2!<%`(B (scheme$BHG(B) \n</div>
<div>The Tofu Sellers in Iscandar for Scheme</div><div>Copyright (C) 1978-2014 by N.Tsuda\n</div><div>$B%k!<%k@bL@$7$^$9$+(B?[y/n]\n</div><div>Do you want to see the instruction?[y/n]")</div><div> (instruction . "$B$3$3$O%$%9%+%s%@%k@1!#$"$J$?$O$3$3$G%H!<%U20$r7P1D$7!"(B\n</div>
<div>This is the Planet Iscandar. You've got to manage a Tofu(Soy bean curd) shop\n</div><div>$BCO5e$X$N5"4THqMQ$r:n$j=P$5$J$/$F$O$$$1$^$;$s!#(B\n</div><div>and earn money to go back to the Earth.\n</div><div>$B$G$b$*8~$+$$$K$O!"%3%s%T%e!<%?$,7P1D$9$k%H!<%U20$,$"$j$^$9!#!#!#(B\n</div>
<div>However, you see another Tofu shop a computer manages across the street.\n </div><div>\n</div><div>$B%H!<%U$N862A$O(B1$B8D(B40$B1_!"HNGd2A3J$O(B50$B1_$G$9!#(B\n</div><div>The cost to make a Tofu is 40yen and its price is 50yen.\n</div><div>1$BF|$KGd$l$k8D?t$OE78u$K:81&$5$l$^$9!#(B\n</div>
<div>The number you could sell tofus in a day depends on the weather.\n</div><div>$B%H!<%U$OF|;}$A$7$J$$$N$G!"Gd$l;D$C$?J,$O$9$Y$FGQ4~$7$^$9!#(B\n</div><div>You can not keep Tofus for long and let them be as dead stock(Dispose them!).\n </div><div>$B$=$3$G!"<!$NF|$NE75$M=Js$rNI$/8+$F!"2?8D:n$k$+7h?4$7$F$/$@$5$$!#(B\n</div>
<div>Therefore, you have carefully got to see the wether report and decide how many tofus to make.\n</div><div>$B=j;}6b(B5$B@i1_$+$i$O$8$a$FAa$/(B3$BK|1_$rD6$($?J}$,>!$A$G$9!#(B\n</div><div>You initially have 5000yen and the winner would be the one to have more than 30000yen earlier.\n</div>
<div>\n</div><div>$B$$$$$G$9$+(B?[y/n]</div><div>Alrignt?[y/n]")</div><div> (1000-yen . #\$B"#(B)</div><div> (empty-yen . #\$B""(B)</div><div> (next-day . "\n***** $B<!$NF|(B(The Next Day) *****\n")</div>
<div> (weather-is . "$B:#F|$NE75$$O(B(Today's weather is")</div><div> (result . " $B$G$9!#(B\n")</div><div> (sunny . (#\$B!}(B . "$B@2$l(B \\(^o^)/ SUNNY "))</div>
<div> (cloudy . (#\$B!&(B . "$B$/$b$j(B (~_~) CLOUDY "))</div><div> (rainy . (#\$B!|(B . "$B1+(B (;_;) RAINY"))</div><div> (you-win . "$B$"$J$?$N>!$A$G$9!#(B\nYOU WIN!\n\n")</div>
<div> (even . "$B0z$-J,$1$G$9!#(B\nEVEN\n\n")</div><div> (you-lose . "$B%3%s%T%e!<%?$N>!$A$G$9!#(B\nCOMPUTER WINS!\n\n")</div><div> (play-again? . "play again? [y/n]"))))</div>
<div> ()</div><div> (print (x y)</div><div> (letrec ((show-data</div><div> ; Showing the data of current condition</div><div> (lambda (env)</div><div> (letrec ((show-money </div>
<div> ; Showing the money the player and the computer have</div><div> (lambda ()</div><div> (letrec ((calc</div><div> ; Calculating to format the text to show</div>
<div> (lambda (player)</div><div> (letrec ((space-calc</div><div> (lambda (x)</div>
<div> (cond ((> x 9999) "")</div><div> ((> x 999) " ")</div><div> ((> x 99) " ")</div>
<div> (else " ")))))</div><div> (let ((x (money player)))</div><div> (let ((y (quotient x 1000)))</div>
<div> (values (space-calc x) </div><div> (number->string x) </div><div> (make-string y </div>
<div> (cdr (assq '1000-yen data)))</div><div> (make-string (- 30 y)</div><div> (cdr (assq 'empty-yen data))))))))))</div>
<div> (let-values (((p0 p1 p2 p3) (calc (get-player env))))</div><div> (let-values (((c0 c1 c2 c3) (calc (get-computer env))))</div><div> (string-append "\n$B=j;}6b(B(MONEY): \n$B$"$J$?(B(YOU) " </div>
<div> p0 p1 "$B1_(B(YEN) " p2 p3</div><div> "\n$B$o$?$7(B(COM) "</div><div> c0 c1 "$B1_(B(YEN) " c2 c3</div>
<div> "\n\n"))))))</div><div> (show-weather-report</div><div> ; Showing the weather report</div><div>
(lambda ()</div><div> (letrec</div><div> ((calc</div><div> ; Calculating to format texts to show</div>
<div> (lambda ()</div><div> (let ((wr (weather-report (get-weather env)))</div><div> (keys '(sunny cloudy rainy)))</div>
<div> (let ((table (map (lambda (x)</div><div> `(,x . ,(quotient (* 40 (cdr (assq x wr))) 100)))</div><div> keys)))</div>
<div> (append (map (lambda (x)</div><div> (number->string (cdr (assq x wr))))</div><div> keys)</div>
<div> (map (lambda (x)</div><div> (make-string (cdr (assq x table)) (cadr (assq x data))))</div><div> keys)))))))</div>
<div> (let ((string-list (calc)))</div><div> (string-append "$BL@F|$NE75$M=Js(B(WEATHER REPORT): $B@2$l(B(SUNNY) " </div><div> (list-ref string-list 0)</div>
<div> "% $B$/$b$j(B(CLOUDY) "</div><div> (list-ref string-list 1)</div><div> "% $B1+(B(RAINY) "</div>
<div> (list-ref string-list 2)</div><div> "%\n"</div><div> (list-ref string-list 3)</div>
<div> (list-ref string-list 4)</div><div> (list-ref string-list 5)</div><div> "\n\n")))))</div>
<div> (show-howmany-tofus</div><div> ; Showing to ask how many tofus to make</div><div> (lambda ()</div><div> (string-append "\n$B%H!<%U$r2?8D:n$j$^$9$+(B?(HOW MANY TOFUS TO MAKE?) (1~"</div>
<div> (number->string </div><div> (maximum (get-tofu env) (get-player env)))</div><div> ") "))))</div>
<div> (string-append (show-money)</div><div> (show-weather-report) </div><div> (show-howmany-tofus)))))</div><div> (show-computer-reply</div>
<div> ; Showing the decision of the computer</div><div> (lambda (num)</div><div> (string-append "$B$o$?$7$O(B(COMP MAKES)" </div><div> (number->string num)</div>
<div> "$B8D:n$j$^$9!#(B\n")))</div><div> (show-result</div><div> ; Showing how many tofus are sold next day</div><div> (lambda (sym)</div>
<div> (string-append</div><div> (cddr (assq sym data))</div><div> (cdr (assq 'result data))))))</div><div> (for-each (lambda (x)</div><div> ; "sleep" relies on Racket.</div>
<div> ; If you use another implementation</div><div> ; letting you use SRFI-18, you can</div><div> ; use "thread-sleep" insted.</div><div> ; Anyway, refer to the manual of</div>
<div> ; implementation you use.</div><div> (sleep 0.5)</div><div> (display x))</div><div> (case x</div><div> ((show-data) `(,(show-data y)))</div>
<div> ((opponent-turn) `(,(show-computer-reply y)))</div><div> ((next-day) `(,(cdr (assq 'next-day data))</div><div> ,(cdr (assq 'weather-is data))</div>
<div> "." "." "."</div><div> ,(show-result y)))</div><div> ((who-is-winner) (map (lambda (z)</div>
<div> (cdr (assq z data)))</div><div> `(,y play-again?)))</div><div> (else `(,(cdr (assq x data)))))))))</div>
<div><br></div><div>(define-method print)</div><div><br></div><div>;;;; test codes for the Massage Class</div><div>;</div><div>;(define p (message))</div><div>;(define e (environment))</div><div>;(print p 'introduction #f)</div>
<div>;(print p 'instruction #t)</div><div>;(print p 'instruction #f)</div><div>;(print p 'show-data e)</div><div>;(print p 'opponent-turn (make-tofu (get-computer e) e))</div><div>;(print p 'next-day 'sunny)</div>
<div>;(print p 'next-day 'cloudy)</div><div>;(print p 'next-day 'rainy)</div><div><br></div><div>;;; REPL</div><div><br></div><div>(define (repl)</div><div> (let ((r (parser))</div><div> (e (game-master))</div>
<div> (p (message)))</div><div> (let loop ()</div><div> (let-values (((phase0 info0) (input r)))</div><div> (let-values (((phase1 info1) (interp e phase0 info0)))</div><div> (print p phase1 info1)))</div>
<div> (loop))))</div><div><br></div><div>(repl)</div></div></div><div class="gmail_extra"><br><br><div class="gmail_quote">2014/1/3 Pierpaolo Bernardi <span dir="ltr"><<a href="mailto:olopierpa@gmail.com" target="_blank">olopierpa@gmail.com</a>></span><br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div class="im">On Thu, Jan 2, 2014 at 4:09 PM, $B55EDGO;V(B <<a href="mailto:masashi.kameda@gmail.com">masashi.kameda@gmail.com</a>> wrote:<br>
<br>
> Is this O.K? or do I have to put (flush-output) every time after (display)?<br>
<br>
</div>without flush-output what you write in the stream remains in a buffer<br>
and is actually written out only when the buffer is full. You must use<br>
flush-output when you want to be sure that what you wrote is actually<br>
displayed on the screen, for example, before reading a string from the<br>
user.<br>
<br>
If you define your own print and read functions, as in the snippet<br>
above, you can put the flush-output in them.<br>
<div class="im"><br>
> The second question is... The game I compiled is, after shown several<br>
> processes I made, got Abend, though running on Racket Interpreter is fine.<br>
> What is the reason of this? Do I have to put something like<br>
> (current-input-port)<br>
> stuff?<br>
<br>
</div>If you use no foreign code, probably this indicates that there's a bug<br>
in Racket that only the developers can address. And they will need a<br>
way to reproduce the crash, to look at it.<br>
<br>
Cheers<br>
<span class="HOEnZb"><font color="#888888">P.<br>
</font></span></blockquote></div><br></div>