4d2006-04 Listings

Adventures in Forth Teil 2 - Viele kleine Dateien, bitte selbst entpacken.

\ Gedankenlesen

\ Prinzip:
\ Die Zahlen 9, 18, 27, 36, 45, 54, 63, 72, 81 
\ bekommen das gleiche Symbol zugeordnet. 
\ Alle übrigen erhalten ein Symbol random zugeordnet, 
\ es muss nur druckbar sein.

Decimal

\ include random.fs 
( gforth-0.6.2 Verzeichnis; Mac OSX Version)

Variable seed

$10450405 Constant generator

: rnd  ( -- n )  
  seed @ generator um* drop 1+ dup seed ! ;

: random ( n -- 0..n-1 )  
  rnd um* nip ;  \ \include

: init ( -- )
  5 seed ! 10 0 DO 100 random drop LOOP ; 
  
  \ choose a token, but no digit.
: token ( -- x )  126 58 - random 58 + ;
  
  \ test number of tokens
: tt ( -- )  $FF 0 DO I emit I . LOOP ;

variable symbol

: symbol!  ( -- )  token symbol ! ;
  
: sy. ( -- ) symbol @ emit ;

: symbol. ( I -- )
  DUP 09 = IF sy. drop exit THEN
  DUP 18 = IF sy. drop exit THEN
  DUP 27 = IF sy. drop exit THEN
  DUP 36 = IF sy. drop exit THEN
  DUP 45 = IF sy. drop exit THEN
  DUP 54 = IF sy. drop exit THEN
  DUP 63 = IF sy. drop exit THEN
  DUP 72 = IF sy. drop exit THEN
  DUP 81 = IF sy. drop exit THEN
  token emit drop ;

: tabelle. ( -- )
  cr 100 0 DO
  I 2 .r space 
  I symbol. 2 spaces 
  I 1+ 10 /mod drop 0= IF cr THEN
  LOOP ;

\ : page ( -- ) <your own code> ; \ gforth has this comand
\   page clears the display. 

: text.de ( -- )
  cr ." Gedankenlesen in Forth"
  cr
  cr ." Denke an eine zweistellige Zahl, z.B. die 54."
  cr ." Ziehe von dieser Zahl ihre 2 Ziffern ab "
     ." (54-5-4=45)"
  cr ." Suche das Symbol, das zu diesem Ergebnis passt."
  cr ." Konzentriere dich auf dieses Symbol "
     ." und druecke eine Taste..." ;
    
: ?again.de ( -- f )
  cr ." Noch mal? --> Leertaste! " key $20 = ;
  
  
: text.en ( --)
  cr ." MindReader in Forth"
  cr
  cr ." Think of a number with 2 digits (ex: 54)"
  cr ." Subtract from this number its 2 digits "
     ." (54-5-4=45)"
  cr ." Find the symbol that corresponds "
     ." to this number"
  cr ." Concentrate on the symbol "
     ." and press a key..." ;

: ?again.en ( -- f )
  cr ." Again? --> press space bar! " key $20 = ;


  \ german version
: Gedankenlesen ( -- )
  init
  BEGIN symbol!
  page text.de cr Tabelle. key drop 
  cr ." Es ist:  " sy. cr 
  ?again.de 0= UNTIL ;
  
  \ english version
: MindReader  ( -- )
  init
  BEGIN symbol!
  page text.en cr Tabelle. key drop
  cr ." It is:  " sy. cr
  ?again.en 0= UNTIL ;
  
  \ Des Rätsels Lösung
: ?? ( -- )
  100 10 DO cr
  i . 
  i i 10 /mod + - . 
  LOOP ;
  
\ fin