VolksForth/sources/generic/case/casetru.fb

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ F83-number?  input#                                jrg 05feb89                                                                  : F83-number?   ( string -- d f )                                    number? ?dup  IF  0< IF extend ENDIF                                              true exit                                                   THEN  drop  0 0  false ;                                                                                     : input#   ( <string> -- n )                                         pad c/l 1- >expect                                              pad F83-number?  2drop ;                                                                                                                                                                                                                                                                                                                                                                                                                                 \ nehmen  trinken  links  rechts  schieben           jrg 05feb89                                                                : nehmen   bright ." ein Glas nehmen"        normal  2 spaces ; : trinken  bright ." alle Gl<47>ser austrinken" normal  2 spaces ; : links    bright ." ein Glas nach LINKS"    normal  2 spaces ; : rechts   bright ." ein Glas nach RECHTS"   normal  2 spaces ;                                                                 : schieben  ;                                                                                                                                                                                   : 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 )                                         \ Auswertung.1 mit IF...ELSE...THEN                  jrg 05feb89                                                                : Auswertung.1  ( Wurfergebnis --)                                                                                                   dup 1 = IF nehmen ELSE                                                  dup 2 = IF links schieben ELSE                                  dup 3 = IF links schieben ELSE                                          dup 4 = IF rechts schieben ELSE                                 dup 5 = IF rechts schieben ELSE                                         dup 6 = IF trinken THEN                                         THEN                                                            THEN                                                    THEN                                                            THEN                                                    THEN                                                    1 6 between not IF invers ." Betrug!" normal ENDIF ;       \ Auswertung.2 mit IF...THEN / ENDIF                 jrg 05feb89                                                                ' THEN Alias ENDIF  immediate restrict                                                                                          : Auswertung.2  ( Wurfergebnis --)                                                                                                   dup 1 = IF nehmen          ENDIF                                dup 2 = IF links  schieben ENDIF                                dup 3 = IF links  schieben ENDIF                                dup 4 = IF rechts schieben ENDIF                                dup 5 = IF rechts schieben ENDIF                                dup 6 = IF trinken         ENDIF                                                                                                1 6 between not IF invers ." Betrug!" normal ENDIF         ;                                                                                                                               \ Auswertung.3 mit IF...ENDIF  und  CASE?            jrg 05feb89                                                                : Auswertung.3   ( Wurfergebnis --)                                                                                                   1 case? IF nehmen           exit ENDIF                          2 case? IF links  schieben  exit ENDIF                          3 case? IF links  schieben  exit ENDIF                          4 case? IF rechts schieben  exit ENDIF                          5 case? IF rechts schieben  exit ENDIF                          6 case? IF trinken          exit ENDIF                                                                                      1 6 between not IF                                                               invers ." Betrugsversuch" normal                               ENDIF                                         ;                                                                                                                               \ =or                                                jrg 06okt88                                                                  code =or       ( n1 f1 n2 -- n1 f2 )                               A D xchg  D pop                                                 S W mov                                                           W ) A cmp                                                       0= ?[ -1 # D mov ]?                                          next                                                          end-code                                                                                                                      \ : =or  ( n1 f1 n2 -- n1 f2 )  2 pick = or ;                                                                                                                                                                                                                                                                                                                                                   \ Auswertung.4 mit IF...THEN  und =or                jrg 05feb89                                                                : Auswertung.4  ( Wurfergebnis --)                                   dup                                                             1 6 between IF                                                               dup 1 =       IF  nehmen           ENDIF                        dup 2 = 3 =or IF  links schieben   ENDIF                        dup 4 = 5 =or IF  rechts schieben  ENDIF                        dup 6 =       IF  trinken          ENDIF                       ELSE                                                             invers ." Betrug!" normal                                      ENDIF                                               drop                                                       ;                                                                                                                                                                                               ****** Beginn der Kommentare ************************jrg 05feb89                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     jrg 03feb89                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \\ So ist es schrecklich !                           jrg 03feb89                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \\ ENDIF  und  CASE?                                 jrg 03feb89                                                                ENDIF  macht deutlich(er), warum FORTH ohne Verbundanweisung wie       z.B. PASCAL auskommt.                                    AUSWERTUNG f<>hrt entsprechend einem Selektor genau eine von 6          m<>glichen Prozeduren aus.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     jrg 03feb89                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \\ =OR                                               jrg 03feb89                                                                =OR     pr<70>ft eine Zahl n2 auf Gleichheit mit einem Testwert n1         und verkn<6B>pft resultierende Ergebnis mit einem bereits          vorliegenden flag f1. Es werden das neue flag f2 und der        "alte" Testwert n1 <20>bergeben.