home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / dev / aforth-1.4.lha / AForth-1.4 / progs / case.f < prev    next >
Encoding:
Text File  |  1994-03-31  |  2.3 KB  |  69 lines
  1. ( A CASE control construct for AFORTH)
  2. ( This version handles standard FORTH integer values only,)
  3. ( ie bytes, chars, integers, NOT doubles or addresses it WILL break)
  4. ( using this code as your starting point it would be a fairly simple task)
  5. ( to construct a version which handles double precision, ie 32 bit, values)
  6. ( Copyright © Stratagem4, 1994)
  7.  
  8. : CASE    ( n -> ) ( the construct header, n is the test value)
  9.     COMPILE >R    ( push test value on return stack)
  10.     0 ; IMMEDIATE    ( push nest depth on stack)
  11.  
  12. : OF    ( n -> ) ( run-time code, n is the 'case' value)
  13.     COMPILE R@        ( get a copy of the test value)
  14.     COMPILE =        ( test equality)
  15.     [COMPILE] IF ; IMMEDIATE    ( do following code)
  16.  
  17. : (ENDOF)    ( addr -> ) ( run-time ENDOF code)
  18.     DR> D@ D>R ;    ( adjust return address)
  19.  
  20. : ENDOF    ( -> )    ( OF terminator)
  21.     COMPILE (ENDOF)    ( compile run-time code)
  22.     D>R                ( temp store IF address)
  23.     >R                ( temp store depth counter)
  24.     HERE            ( fetch compilation address)
  25.     4 ALLOT            ( leave space for ENDCASE address)
  26.     R> 1+            ( fetch and increment depth counter)
  27.     DR>                ( retrieve IF address)
  28.     [COMPILE] THEN     ( complete IF..THEN construct)
  29.     ; IMMEDIATE
  30.  
  31. : ENDCASE ( -> ) ( the construct terminator)
  32.     0 DO                ( start looping through cases)
  33.         D>R    HERE DR> D!    ( store HERE at address)
  34.     LOOP                ( loop?)
  35.     COMPILE R> COMPILE DROP ; IMMEDIATE    ( drop test value)
  36.  
  37. : TESTCASE ( -> ) ( just an example CASE)
  38.     CR ." Please enter a number between 1 and 25 : " ( ask for a number)
  39.     0 0 QUERY 1 WORD CONVERT DROPD DROP                ( convert to reality)
  40.     CR ." You selected item "                        ( snappy little message)
  41.     CASE                            ( test each possible value)
  42.          1 OF ." one!"            ENDOF
  43.          2 OF ." two!"            ENDOF
  44.          3 OF ." three!"        ENDOF
  45.          4 OF ." four!"            ENDOF
  46.          5 OF ." five!"            ENDOF
  47.          6 OF ." six!"            ENDOF
  48.          7 OF ." seven!"        ENDOF
  49.          8 OF ." eight!"        ENDOF
  50.          9 OF ." nine!"            ENDOF
  51.         10 OF ." ten!"            ENDOF
  52.         11 OF ." eleven!"        ENDOF
  53.         12 OF ." twelve!"        ENDOF
  54.         13 OF ." thirteen!"        ENDOF
  55.         14 OF ." fourteen!"        ENDOF
  56.         15 OF ." fifteen!"        ENDOF
  57.         16 OF ." sixteen!"        ENDOF
  58.         17 OF ." seventeen!"    ENDOF
  59.         18 OF ." eighteen!"        ENDOF
  60.         19 OF ." nineteen!"        ENDOF
  61.         20 OF ." twenty!"        ENDOF
  62.         21 OF ." twentyone!"    ENDOF
  63.         22 OF ." twentytwo!"    ENDOF
  64.         23 OF ." twentythree!"    ENDOF
  65.         24 OF ." twentyfour!"    ENDOF
  66.         25 OF ." twentyfive!"    ENDOF
  67.         ." I am an !!!!!AIRHEAD!!!!"    ( and don't forget the airheads!)
  68.     ENDCASE ;
  69.