Initial data commit

Task/Menu/Forth/menu-1.fth

@@ -0,0 +1,42 @@
+\ 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
+;

Task/Menu/Forth/menu-2.fth

@@ -0,0 +1,64 @@
+\ Rosetta Menu task with Simple lists in Forth
+
+: STRING, ( caddr len -- ) HERE  OVER CHAR+  ALLOT  PLACE ;
+: "       ( -- ) [CHAR] " PARSE  STRING, ;
+
+: {       ( -- ) ALIGN 0 C, ;
+: }       ( -- ) { ;
+
+: {NEXT} ( str -- next_str)  COUNT + ;
+: {NTH}  ( n array_addr -- str)  SWAP 0 DO {NEXT} LOOP ;
+
+: {LEN}  ( array_addr -- )  \ count strings in a list
+          0 >R                      \ Counter on Rstack
+          {NEXT}                    \ skip 1st empty string
+          BEGIN
+             {NEXT} DUP C@          \ Fetch length byte
+          WHILE                     \ While true
+             R> 1+ >R               \ Inc. counter
+          REPEAT
+          DROP
+          R> ;                      \ return counter to data stack
+
+: {TYPE}    ( $ -- ) COUNT TYPE ;
+: '"'    ( -- )   [CHAR] " EMIT ;
+: {""}   ( $ -- )  '"' SPACE {TYPE} '"' SPACE ;
+: }PRINT ( n array -- ) {NTH} {TYPE} ;
+
+\ ===== TASK BEGINS =====
+CREATE GOODLIST
+       { " fee fie"
+         " huff and puff"
+         " mirror mirror"
+         " tick tock" }
+
+CREATE NIL  {   }
+
+CHAR 1 CONSTANT '1'
+CHAR 4 CONSTANT '4'
+CHAR 0 CONSTANT '0'
+
+: BETWEEN ( n low hi -- ?)  1+ WITHIN ;
+
+: .MENULN ( n -- n) DUP '0' + EMIT SPACE OVER }PRINT ;
+
+: MENU    ( list -- string )
+       DUP {LEN} 0=
+       IF
+           DROP NIL
+       ELSE
+          BEGIN
+             CR
+             CR 1 .MENULN
+             CR 2 .MENULN
+             CR 3 .MENULN
+             CR 4 .MENULN
+             CR ." Choice: " KEY DUP EMIT
+             DUP '1' '4' BETWEEN
+         0= WHILE
+              DROP
+          REPEAT
+         [CHAR] 0 -
+         CR SWAP {NTH}
+       THEN
+;