43 lines
1.1 KiB
Forth
43 lines
1.1 KiB
Forth
\ Rosetta Code Menu Idiomatic Forth
|
|
|
|
\ vector table compiler
|
|
: CASE: ( -- ) CREATE ;
|
|
: | ( -- <text>) ' , ; IMMEDIATE
|
|
: ;CASE ( -- ) DOES> SWAP CELLS + @ EXECUTE ;
|
|
|
|
: NIL ( -- addr len) S" " ;
|
|
: FEE ( -- addr len) S" fee fie" ;
|
|
: HUFF ( -- addr len) S" huff and puff" ;
|
|
: MIRROR ( -- addr len) S" mirror mirror" ;
|
|
: TICKTOCK ( -- addr len) S" tick tock" ;
|
|
|
|
CASE: SELECT ( n -- addr len)
|
|
| NIL | FEE | HUFF | MIRROR | TICKTOCK
|
|
;CASE
|
|
|
|
CHAR 1 CONSTANT '1'
|
|
CHAR 4 CONSTANT '4'
|
|
: BETWEEN ( n low hi -- ?) 1+ WITHIN ;
|
|
|
|
: MENU ( addr len -- addr len )
|
|
DUP 0=
|
|
IF
|
|
2DROP NIL EXIT
|
|
ELSE
|
|
BEGIN
|
|
CR
|
|
CR 2DUP 3 SPACES TYPE
|
|
CR ." 1 " 1 SELECT TYPE
|
|
CR ." 2 " 2 SELECT TYPE
|
|
CR ." 3 " 3 SELECT TYPE
|
|
CR ." 4 " 4 SELECT TYPE
|
|
CR ." Choice: " KEY DUP EMIT
|
|
DUP '1' '4' BETWEEN 0=
|
|
WHILE
|
|
DROP
|
|
REPEAT
|
|
-ROT 2DROP \ drop input string
|
|
CR [CHAR] 0 - SELECT
|
|
THEN
|
|
;
|