VolksForth/sources/generic/case/casepos.fb

***************** CRAPS *****************************jrg 06okt88nach Wil Baden                                                                                                                  Da es in Deutschland das W<>rfelspiel CRAPS nicht gibt, habe ich diesem Begriff ein W<>rfel- und Trinkspiel aus der Schulzeit     unterlegt.                                                      Bei diesem Spiel steht in der Tischmitte ein Vorrat an gef<65>lltenGl„sern. Danach soll ein Mitspieler abh„ngig von seinem Wurf                                                                    entweder   ein neues Glas aus der Tischmitte vor sich stellen   oder       eines seiner Gl„ser seinem Nachbarn zur linken oder             zur rechten zuschieben                               oder       alle vor ihm stehenden Gl„ser austrinken.                                                                            Zuordnung: 1=nehmen, 2/3=links, 4/5=rechts, 6 trinken                                                                           \ LoadScreen                                         jrg 31dez89                                                                \needs :Does>    2 load                                                                                                           8 load                                                          cr .( positionelles CASE geladen ) cr                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         \ :Does>  f<>r  Create <name> :Does> ... ;ks 25 aug 88jrg 31dez89                                                                | : (does>   here >r [compile] Does> ;                                                                                            : :Does>    last @ 0= Abort" without reference"                    (does> current @ context !   hide 0 ] ;                                                                                    clear                                                           \\                                                              : test   cls                                                         5 0 DO                                                               cr ." craps1 " I . ." mal" craps1                               cr ." craps2 " I . ." mal" craps2                               cr ." craps3 " I . ." mal" craps3                              LOOP                                                       cr ." fertig."  ;                                           \ nehmen  trinken  links  rechts  schieben           jrg 05feb89                                                                : nehmen   bright ." ein Glas nehmen"        normal  2 spaces ; : trinken  bright ." alle Gl„ser austrinken" normal  2 spaces ; : links    bright ." ein Glas nach LINKS"    normal  2 spaces ; : rechts   bright ." ein Glas nach RECHTS"   normal  2 spaces ; : schieben  ;                                                   : schimpfen   invers ." Betrug! " normal ;                                                                                      : Anfrage      cr ." Sollen Sie nehmen, trinken oder schieben? "               cr ." Bitte Ihre Augenzahl und <cr> : "   ;                                                                      : Gl<47>ckwunsch  cr ." Viel Gl<47>ck beim n„chsten Wurf ... " ;                                                                      cr .( Spr<70>che geladen )                                                                                                         \ Zugriffs-Prozeduren f<>r Tabellen von Prozeduren    jrg 05feb89                                                                : bewegen  ( adr n -- cfa )                                         2* +  perform ;                                                                                                             : richtig  ( n  --  0<= n <= 3 )                                    swap                                                            1 max  6 min                        \ ein biáchen Sicherheit    3 case? IF  2  1- exit  ENDIF                                   5 case? IF  4  1- exit  ENDIF                                   1-  ;                               \ ein biáchen Justage                                                                                                                                                                                                   \ Dieses Wort l„át zwar Werte < 1 und > 6 zu, justiert sie aber \ auf den Bereich zwischen 1 und 6 .                            \  Die m”glichen Tabellen mit  ] [  oder Create:     jrg 05feb89\  traditionell:                                                                                                                Create  Glas                                                            ]  nehmen  links schieben                                                  rechts schieben  trinken  [                                                                                                                                                  \  oder VOLKS4TH-gem„á :                                                                                                        Create: Glas                                                             nehmen                                                          links schieben                                                  rechts schieben                                                 trinken ;                                                                                                              \  Create: ; :Does>      Auswertung.8                jrg 05feb89                                                                Create: Auswertung.8                                                      nehmen                                                           links schieben                                                  rechts schieben                                                trinken ;                                                   :Does>                                                             richtig bewegen ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      \  Das vollst„ndige Programm                         jrg 05feb89                                                                : CRAPS1                                                             cr  Anfrage cr                                                        input#                                                          Glas richtig bewegen                                      cr  Gl<47>ckwunsch                                            ;                                                                                                                               \ ausschlieálich als Datenstruktur                              : CRAPS2                                                             cr  Anfrage cr                                                        input#                                                          Auswertung                                                cr  Gl<47>ckwunsch                                            ;                                                               \ #### positional CASE def.words  Case: Associative: jrg 05feb89: Case:    ( -- )                                                  Create: Does>    ( pfa -- )  swap 2* +  perform ;                                                                            \ alternative Definition f<>r CASE:                              \ : Case:                                                       \     : Does>       ( pfa -- )  swap 2* +  perform ;                                                                                                                                            : Associative:           ( n -- )                                  Constant   Does>      ( n - index )                             dup @ -rot            \ out of range = maxIndex + 1             dup @ 0                                                         DO  2+  2dup  @ =                                                   IF  2drop drop  I  0 0  LEAVE  THEN                         LOOP 2drop ;                                                 \  CASE: in der Anwendung       ( 9. Auswertung)     jrg 05feb89         Case:  handeln                   \ besteht aus :                          nehmen                                                           links  links                                                    rechts rechts                                                  trinken                                                      schimpfen ;                                                                                                     6 Associative:  auswerten                                                                                                                         1 ,                                                           2 , 3 ,                                                         4 , 5 ,                                                           6 ,                                                                                                           \ Hier erzeugen MIN und MAX  out of range Fehler  maxIndex + 1  \  CASE:  und  Associative:                          jrg 05feb89                                                                : CRAPS3   ( -- )                                                                                                                    cr  Anfrage cr                                                      input#                                                             auswerten                                                       handeln                                                  cr  Gl<47>ckwunsch                                            ;