====== 4d2006-04 Listings ====== ===== Adventures ===== {{ :vd-archiv:listings:adv2.zip |Adventures in Forth Teil 2}} - Viele kleine Dateien, bitte selbst entpacken. ===== Gedankenlesen ===== \ 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 ( -- ) ; \ 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