VolksForth/sources/generic/case/case.fb

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ CASE   OF  ENDOF   END-CASE     BREAK              jrg 30mai89                                                                 : CASE      ( n -- n n )  dup ;  restrict                                                                                       : OF        [compile] IF compile drop ;  immediate restrict                                                                     : ENDOF     [compile] ELSE 4+ ;  immediate restrict                                                                             : ENDCASE   compile drop                                                    BEGIN                                                             3 case?                                                       WHILE                                                             >resolve                                                      REPEAT ;  immediate restrict                                                                                        : BREAK     compile exit  [compile] THEN ;  immediate restrict \ =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 ;                                                                                                                                                                                                                                                                                                                                                   \ leapyear?    nach Wil Baden VD 2/87 S.42           jrg 30mai89                                                                | : leapyear?  ( year# -- f : true falls Jahr = Schaltjahr )           CASE 400 mod 0= OF  true   BREAK                                CASE 100 mod 0= OF  false  BREAK                                CASE   4 mod 0= OF  true   BREAK                                drop   false ;                                                                                                           \\ nach Kaiser, Grundlegende Elemente ... S.160, Birkh<6B>user                                                                       : leapyear?  ( year# -- f : true falls Jahr = Schaltjahr )           dup         4 mod 0=        ( y# f)                             swap dup  100 mod 0<>       ( f1 y# f2 )                        rot       and               ( y# f3 )                           swap      400 mod 0= or  ;                                                                                               \ Monatsnamen                                        jrg 30mai89|  1 Constant jan                                               |  2 Constant feb                                               |  3 Constant m<>r                                               |  4 Constant apr                                               |  5 Constant mai                                               |  6 Constant jun                                               |  7 Constant jul                                               |  8 Constant aug                                               |  9 Constant sep                                               | 10 Constant okt                                               | 11 Constant nov                                               | 12 Constant dez                                                                                                               \\                                                              | Create months  ," janfebm<62>raprmaijunjulaugsepoktnovdez"       \ Tage im Monat                                      jrg 30mai89                                                                : #days  ( month# -- days-in-month )                                CASE  jan =  apr =or  jun =or  nov =or  OF  30  BREAK           CASE  feb = not                         OF  31  BREAK           drop  leapyear? IF  29  ELSE  28  THEN ;                                                                                    : .all                                                              12 1+  1                                                                 DO cr                                                            I .                                                             I >months type  ."  hat "                                       I #days   .     ." Tage."                                      LOOP ;                                                                                                                                                                             % Schaltjahr ?                                       jrg 30mai89                                                                Bei der Entscheidung, ob eine Jahreszahl ein Schaltjahr be-     zeichnet, werden zun<75>chst die ohne Rest durch 4 teilbaren Jahre durch                                                                   JAHR MOD 4 = 0                                          erkannt. Die ohne Rest durch 100 teilbaren Jahre werden durch                                                                           (JAHR MOD 4 = 0) AND (JAHR MOD 100 <> 0)                                                                                "entfernt".                                                     Dazu werden die ohne Rest durch 400 teilbaren Jahreszahlen hin- zugef<65>gt:                                                                                                                       ((JAHR MOD 4 = 0) AND (JAHR MOD 100 <> 0)) OR (JAHR MOD 400 = 0)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                % Schaltjahr ?                                       jrg 30mai89                                                                Bei der Entscheidung, ob eine Jahreszahl ein Schaltjahr be-     zeichnet, werden zun<75>chst die ohne Rest durch 4 teilbaren Jahre durch                                                                   JAHR MOD 4 = 0                                          erkannt. Die ohne Rest durch 100 teilbaren Jahre werden durch                                                                           (JAHR MOD 4 = 0) AND (JAHR MOD 100 <> 0)                                                                                "entfernt".                                                     Dazu werden die ohne Rest durch 400 teilbaren Jahreszahlen hin- zugef<65>gt:                                                                                                                       ((JAHR MOD 4 = 0) AND (JAHR MOD 100 <> 0)) OR (JAHR MOD 400 = 0)