Initial Commit
This commit is contained in:
commit
20b4e22ea6
6 changed files with 2137 additions and 0 deletions
665
base.lua
Normal file
665
base.lua
Normal file
|
|
@ -0,0 +1,665 @@
|
||||||
|
base_fth = [[
|
||||||
|
: HEX 16 BASE ! ;
|
||||||
|
: DEC 10 BASE ! ;
|
||||||
|
: OCT 8 BASE ! ;
|
||||||
|
: BIN 2 BASE ! ;
|
||||||
|
|
||||||
|
: C! SWAP 255 AND SWAP ! ;
|
||||||
|
: C@ @ 255 AND ;
|
||||||
|
: C,
|
||||||
|
HERE @ C!
|
||||||
|
1 HERE +!
|
||||||
|
;
|
||||||
|
|
||||||
|
: LITERAL IMMEDIATE
|
||||||
|
COMP' LIT ,
|
||||||
|
,
|
||||||
|
;
|
||||||
|
: CHAR BL WORD 1+ C@ ;
|
||||||
|
|
||||||
|
: '"' [ CHAR " ] LITERAL ;
|
||||||
|
: '[' [ CHAR [ ] LITERAL ;
|
||||||
|
: ']' [ CHAR ] ] LITERAL ;
|
||||||
|
: '(' [ CHAR ( ] LITERAL ;
|
||||||
|
: ')' [ CHAR ) ] LITERAL ;
|
||||||
|
: ':' [ CHAR : ] LITERAL ;
|
||||||
|
: ';' [ CHAR ; ] LITERAL ;
|
||||||
|
: '0' [ CHAR 0 ] LITERAL ;
|
||||||
|
: 'A' [ CHAR A ] LITERAL ;
|
||||||
|
: '-' [ CHAR - ] LITERAL ;
|
||||||
|
: '.' [ CHAR . ] LITERAL ;
|
||||||
|
|
||||||
|
: CR 10 EMIT ;
|
||||||
|
: SPACE 32 EMIT ;
|
||||||
|
|
||||||
|
: ' BL WORD FIND >CFA ;
|
||||||
|
: [COMPILE] IMMEDIATE ' , ;
|
||||||
|
: ['] IMMEDIATE ' [COMPILE] LITERAL ;
|
||||||
|
: LIT, ['] LIT , , ;
|
||||||
|
|
||||||
|
: / /MOD SWAP DROP ;
|
||||||
|
: MOD /MOD DROP ;
|
||||||
|
|
||||||
|
: U/ UM/MOD SWAP DROP ;
|
||||||
|
: UMOD UM/MOD DROP ;
|
||||||
|
|
||||||
|
: NOT 0= ;
|
||||||
|
|
||||||
|
: RECURSE IMMEDIATE
|
||||||
|
LATEST @
|
||||||
|
>CFA ,
|
||||||
|
;
|
||||||
|
|
||||||
|
: IF IMMEDIATE
|
||||||
|
['] 0BRANCH ,
|
||||||
|
HERE @
|
||||||
|
0 ,
|
||||||
|
;
|
||||||
|
: THEN IMMEDIATE
|
||||||
|
DUP
|
||||||
|
HERE @ SWAP -
|
||||||
|
SWAP !
|
||||||
|
;
|
||||||
|
: ELSE IMMEDIATE
|
||||||
|
['] BRANCH ,
|
||||||
|
HERE @
|
||||||
|
0 ,
|
||||||
|
SWAP
|
||||||
|
DUP HERE @ SWAP -
|
||||||
|
SWAP !
|
||||||
|
;
|
||||||
|
|
||||||
|
: ?HIDDEN 1+ C@ F_HIDDEN AND ;
|
||||||
|
: ?IMMEDIATE 1+ C@ F_IMMED AND ;
|
||||||
|
|
||||||
|
: EXECUTE-COMPILING
|
||||||
|
STATE @ IF EXECUTE EXIT THEN
|
||||||
|
] EXECUTE [
|
||||||
|
;
|
||||||
|
|
||||||
|
: POSTPONE IMMEDIATE
|
||||||
|
BL WORD FIND
|
||||||
|
DUP ?IMMEDIATE
|
||||||
|
SWAP >CFA LIT,
|
||||||
|
IF ['] EXECUTE-COMPILING ELSE ['] , THEN ,
|
||||||
|
;
|
||||||
|
|
||||||
|
: BEGIN IMMEDIATE HERE @ ;
|
||||||
|
: UNTIL IMMEDIATE
|
||||||
|
POSTPONE 0BRANCH
|
||||||
|
HERE @ - ,
|
||||||
|
;
|
||||||
|
: AGAIN IMMEDIATE
|
||||||
|
POSTPONE BRANCH
|
||||||
|
HERE @ - ,
|
||||||
|
;
|
||||||
|
: WHILE IMMEDIATE
|
||||||
|
POSTPONE 0BRANCH
|
||||||
|
HERE @
|
||||||
|
0 ,
|
||||||
|
;
|
||||||
|
: REPEAT IMMEDIATE
|
||||||
|
POSTPONE BRANCH
|
||||||
|
SWAP HERE @ - ,
|
||||||
|
DUP HERE @ SWAP - SWAP !
|
||||||
|
;
|
||||||
|
: UNLESS IMMEDIATE
|
||||||
|
POSTPONE NOT
|
||||||
|
POSTPONE IF
|
||||||
|
;
|
||||||
|
|
||||||
|
: ( IMMEDIATE
|
||||||
|
1
|
||||||
|
BEGIN
|
||||||
|
KEY DUP '(' = IF
|
||||||
|
DROP
|
||||||
|
1+
|
||||||
|
ELSE
|
||||||
|
')' = IF
|
||||||
|
1-
|
||||||
|
THEN
|
||||||
|
THEN
|
||||||
|
DUP 0= UNTIL
|
||||||
|
DROP
|
||||||
|
;
|
||||||
|
|
||||||
|
: NIP ( x y -- y ) SWAP DROP ;
|
||||||
|
: TUCK ( x y -- y x y ) SWAP OVER ;
|
||||||
|
: PICK ( xn ... x1 x0 n -- xn ... x1 x0 xn )
|
||||||
|
1+ 1 CELLS * DSP@ + @
|
||||||
|
;
|
||||||
|
|
||||||
|
( Print many of a character )
|
||||||
|
: MANY ( n c -- )
|
||||||
|
SWAP
|
||||||
|
BEGIN
|
||||||
|
DUP 0>
|
||||||
|
WHILE
|
||||||
|
OVER EMIT
|
||||||
|
1-
|
||||||
|
REPEAT
|
||||||
|
2DROP
|
||||||
|
;
|
||||||
|
|
||||||
|
: SPACES ( n -- )
|
||||||
|
BL MANY
|
||||||
|
;
|
||||||
|
|
||||||
|
: ZEROS ( n -- )
|
||||||
|
'0' MANY
|
||||||
|
;
|
||||||
|
|
||||||
|
: U. ( u -- )
|
||||||
|
BASE @ UM/MOD ( base rem quot )
|
||||||
|
?DUP IF
|
||||||
|
RECURSE
|
||||||
|
THEN
|
||||||
|
|
||||||
|
DUP 10 < IF
|
||||||
|
'0'
|
||||||
|
ELSE
|
||||||
|
10 -
|
||||||
|
'A'
|
||||||
|
THEN
|
||||||
|
+ EMIT
|
||||||
|
;
|
||||||
|
|
||||||
|
( Get number of chars in an unsigend number )
|
||||||
|
: UWIDTH ( u -- width )
|
||||||
|
BASE @ U/ ( rem quot)
|
||||||
|
?DUP IF ( if quot <> 0 )
|
||||||
|
RECURSE 1+
|
||||||
|
ELSE
|
||||||
|
1
|
||||||
|
THEN
|
||||||
|
;
|
||||||
|
|
||||||
|
( Get number of chars in an unsigend number )
|
||||||
|
: SWIDTH ( u -- width )
|
||||||
|
DUP 0< IF NEGATE THEN
|
||||||
|
BASE @ / ( rem quot)
|
||||||
|
?DUP IF ( if quot <> 0 )
|
||||||
|
RECURSE 1+
|
||||||
|
ELSE
|
||||||
|
1
|
||||||
|
THEN
|
||||||
|
;
|
||||||
|
|
||||||
|
( Left pad number )
|
||||||
|
: U.R ( u width -- )
|
||||||
|
SWAP
|
||||||
|
DUP
|
||||||
|
UWIDTH
|
||||||
|
ROT
|
||||||
|
SWAP -
|
||||||
|
SPACES
|
||||||
|
U.
|
||||||
|
;
|
||||||
|
|
||||||
|
( Zero pad number )
|
||||||
|
: U.0R ( u width -- )
|
||||||
|
SWAP
|
||||||
|
DUP
|
||||||
|
UWIDTH
|
||||||
|
ROT
|
||||||
|
SWAP -
|
||||||
|
ZEROS
|
||||||
|
U.
|
||||||
|
;
|
||||||
|
|
||||||
|
( Print left padded signed number )
|
||||||
|
: .R
|
||||||
|
SWAP
|
||||||
|
DUP 0< IF
|
||||||
|
NEGATE
|
||||||
|
1
|
||||||
|
SWAP
|
||||||
|
ROT
|
||||||
|
1-
|
||||||
|
ELSE
|
||||||
|
0
|
||||||
|
SWAP
|
||||||
|
ROT
|
||||||
|
THEN
|
||||||
|
SWAP
|
||||||
|
DUP
|
||||||
|
SWIDTH
|
||||||
|
ROT
|
||||||
|
SWAP -
|
||||||
|
|
||||||
|
SPACES
|
||||||
|
SWAP
|
||||||
|
|
||||||
|
IF
|
||||||
|
'-' EMIT
|
||||||
|
THEN
|
||||||
|
|
||||||
|
U.
|
||||||
|
;
|
||||||
|
|
||||||
|
( Print zero padded signed number )
|
||||||
|
: .0R
|
||||||
|
SWAP
|
||||||
|
DUP 0< IF
|
||||||
|
NEGATE
|
||||||
|
1
|
||||||
|
SWAP
|
||||||
|
ROT
|
||||||
|
1-
|
||||||
|
ELSE
|
||||||
|
0
|
||||||
|
SWAP
|
||||||
|
ROT
|
||||||
|
THEN
|
||||||
|
SWAP
|
||||||
|
DUP
|
||||||
|
SWIDTH
|
||||||
|
ROT
|
||||||
|
SWAP -
|
||||||
|
|
||||||
|
ZEROS
|
||||||
|
SWAP
|
||||||
|
|
||||||
|
IF
|
||||||
|
'-' EMIT
|
||||||
|
THEN
|
||||||
|
|
||||||
|
U.
|
||||||
|
;
|
||||||
|
|
||||||
|
: . 0 .R SPACE ;
|
||||||
|
: U. U. SPACE ;
|
||||||
|
|
||||||
|
: .S ( Print the stack )
|
||||||
|
DSP@ S0 @
|
||||||
|
BEGIN
|
||||||
|
2DUP <
|
||||||
|
WHILE
|
||||||
|
1-
|
||||||
|
DUP @ .
|
||||||
|
SPACE
|
||||||
|
REPEAT
|
||||||
|
2DROP
|
||||||
|
CR
|
||||||
|
;
|
||||||
|
|
||||||
|
( Print number at address )
|
||||||
|
: ? ( addr -- ) @ . ;
|
||||||
|
|
||||||
|
: WITHIN
|
||||||
|
-ROT OVER
|
||||||
|
<= IF
|
||||||
|
> IF
|
||||||
|
TRUE
|
||||||
|
ELSE
|
||||||
|
FALSE
|
||||||
|
THEN
|
||||||
|
ELSE
|
||||||
|
2DROP
|
||||||
|
FALSE
|
||||||
|
THEN
|
||||||
|
;
|
||||||
|
|
||||||
|
( Returns depth of stack )
|
||||||
|
: DEPTH ( -- n )
|
||||||
|
S0 @ DSP@ -
|
||||||
|
1-
|
||||||
|
;
|
||||||
|
|
||||||
|
: S" IMMEDIATE
|
||||||
|
STATE @ IF
|
||||||
|
POSTPONE LITSTRING
|
||||||
|
HERE @
|
||||||
|
0 ,
|
||||||
|
BEGIN
|
||||||
|
KEY
|
||||||
|
DUP '"' <>
|
||||||
|
WHILE
|
||||||
|
C,
|
||||||
|
REPEAT
|
||||||
|
DROP
|
||||||
|
DUP
|
||||||
|
HERE @ SWAP -
|
||||||
|
1-
|
||||||
|
SWAP !
|
||||||
|
ELSE
|
||||||
|
HERE @
|
||||||
|
BEGIN
|
||||||
|
KEY
|
||||||
|
DUP '"' <>
|
||||||
|
WHILE
|
||||||
|
OVER C!
|
||||||
|
1+
|
||||||
|
REPEAT
|
||||||
|
DROP
|
||||||
|
HERE @ -
|
||||||
|
HERE @
|
||||||
|
SWAP
|
||||||
|
THEN
|
||||||
|
;
|
||||||
|
|
||||||
|
: ." IMMEDIATE
|
||||||
|
STATE @ IF
|
||||||
|
POSTPONE S"
|
||||||
|
POSTPONE TELL
|
||||||
|
ELSE
|
||||||
|
BEGIN
|
||||||
|
KEY
|
||||||
|
DUP '"' = IF
|
||||||
|
DROP
|
||||||
|
EXIT
|
||||||
|
THEN
|
||||||
|
EMIT
|
||||||
|
AGAIN
|
||||||
|
THEN
|
||||||
|
;
|
||||||
|
|
||||||
|
: DOES>
|
||||||
|
STATE @ IF
|
||||||
|
POSTPONE (DOES>)
|
||||||
|
ELSE
|
||||||
|
HERE @ ( HERE )
|
||||||
|
LATEST @ >CFA ( HERE CFA )
|
||||||
|
DUP [ ' DODOES @ ] LITERAL SWAP ! ( Write CW of DODOES to CFA )
|
||||||
|
1+ ! ( Write HERE to >DOES )
|
||||||
|
LATEST @ HIDDEN
|
||||||
|
]
|
||||||
|
THEN
|
||||||
|
; IMMEDIATE
|
||||||
|
|
||||||
|
: VARIABLE CREATE 0 , ;
|
||||||
|
: CONSTANT CREATE , DOES> @ ;
|
||||||
|
|
||||||
|
: VALUE ( n -- )
|
||||||
|
CREATE ,
|
||||||
|
DOES> ( -- n )
|
||||||
|
@
|
||||||
|
;
|
||||||
|
|
||||||
|
: TO ( n "name" -- )
|
||||||
|
' >BODY !
|
||||||
|
;
|
||||||
|
|
||||||
|
: +TO ( n "name" -- )
|
||||||
|
' >BODY +!
|
||||||
|
;
|
||||||
|
|
||||||
|
0 VALUE I
|
||||||
|
: SETI [ ' I >BODY ] LITERAL ! ;
|
||||||
|
|
||||||
|
: DO IMMEDIATE ( C: -- HERE ) ( LIMIT I -- )
|
||||||
|
SETI
|
||||||
|
R> ( r: -- LIMIT )
|
||||||
|
HERE @ ( C: -- HERE )
|
||||||
|
;
|
||||||
|
|
||||||
|
: (LOOP)
|
||||||
|
I 1+ DUP SETI
|
||||||
|
R@ >
|
||||||
|
0BRANCH
|
||||||
|
;
|
||||||
|
|
||||||
|
: (UNLOOP)
|
||||||
|
>R DROP
|
||||||
|
;
|
||||||
|
|
||||||
|
: LOOP IMMEDIATE
|
||||||
|
POSTPONE (LOOP)
|
||||||
|
HERE @ - ,
|
||||||
|
POSTPONE (UNLOOP)
|
||||||
|
;
|
||||||
|
|
||||||
|
: ID.
|
||||||
|
1+ ( Skip link pointer )
|
||||||
|
DUP C@ ( entry flags )
|
||||||
|
F_LENMASK AND ( entry len)
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
DUP 0> ( entry len len>0? )
|
||||||
|
WHILE
|
||||||
|
SWAP 1+ ( len entry+1 )
|
||||||
|
DUP C@ EMIT
|
||||||
|
SWAP 1- ( entry+1 len-1 )
|
||||||
|
REPEAT
|
||||||
|
2DROP ( entry len -- )
|
||||||
|
;
|
||||||
|
|
||||||
|
: WORDS
|
||||||
|
LATEST @
|
||||||
|
BEGIN
|
||||||
|
?DUP
|
||||||
|
WHILE
|
||||||
|
DUP ?HIDDEN IF
|
||||||
|
." (H)"
|
||||||
|
THEN
|
||||||
|
DUP ?IMMEDIATE IF
|
||||||
|
." (I)"
|
||||||
|
THEN
|
||||||
|
DUP ID. SPACE
|
||||||
|
@
|
||||||
|
REPEAT
|
||||||
|
CR
|
||||||
|
;
|
||||||
|
|
||||||
|
: HIDE
|
||||||
|
BL WORD FIND
|
||||||
|
HIDDEN
|
||||||
|
;
|
||||||
|
|
||||||
|
: FORGET
|
||||||
|
BL WORD FIND
|
||||||
|
DUP @ LATEST !
|
||||||
|
HERE !
|
||||||
|
;
|
||||||
|
|
||||||
|
: DUMP ( addr len -- )
|
||||||
|
( Save BASE )
|
||||||
|
BASE @ -ROT
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
?DUP
|
||||||
|
WHILE
|
||||||
|
HEX
|
||||||
|
OVER 8 U.0R
|
||||||
|
4 SPACES
|
||||||
|
|
||||||
|
( Print hex )
|
||||||
|
2DUP
|
||||||
|
1- 15 AND 1+
|
||||||
|
BEGIN
|
||||||
|
?DUP
|
||||||
|
WHILE
|
||||||
|
SWAP
|
||||||
|
DUP
|
||||||
|
5 PICK DEC 10 = IF
|
||||||
|
@ 0 DEC
|
||||||
|
ELSE
|
||||||
|
C@ 2 HEX
|
||||||
|
THEN
|
||||||
|
.0R SPACE
|
||||||
|
1+ SWAP 1-
|
||||||
|
REPEAT
|
||||||
|
DROP
|
||||||
|
|
||||||
|
3 SPACES
|
||||||
|
|
||||||
|
( Print ascii )
|
||||||
|
2DUP
|
||||||
|
1- 15 AND 1+
|
||||||
|
BEGIN
|
||||||
|
?DUP
|
||||||
|
WHILE
|
||||||
|
SWAP
|
||||||
|
DUP C@
|
||||||
|
DUP 32 128 WITHIN IF
|
||||||
|
EMIT
|
||||||
|
ELSE
|
||||||
|
DROP '.' EMIT
|
||||||
|
THEN
|
||||||
|
1+ SWAP 1-
|
||||||
|
REPEAT
|
||||||
|
DROP
|
||||||
|
CR
|
||||||
|
|
||||||
|
DUP 1- 15 AND 1+
|
||||||
|
TUCK
|
||||||
|
-
|
||||||
|
>R + R>
|
||||||
|
REPEAT
|
||||||
|
|
||||||
|
DROP
|
||||||
|
BASE !
|
||||||
|
;
|
||||||
|
|
||||||
|
: CASE IMMEDIATE
|
||||||
|
0
|
||||||
|
;
|
||||||
|
|
||||||
|
: OF IMMEDIATE
|
||||||
|
POSTPONE OVER
|
||||||
|
POSTPONE =
|
||||||
|
POSTPONE IF
|
||||||
|
POSTPONE DROP
|
||||||
|
;
|
||||||
|
|
||||||
|
: ENDOF IMMEDIATE
|
||||||
|
POSTPONE ELSE
|
||||||
|
;
|
||||||
|
|
||||||
|
: ENDCASE IMMEDIATE
|
||||||
|
POSTPONE DROP
|
||||||
|
|
||||||
|
( Compile THEN's for each ELSE )
|
||||||
|
BEGIN
|
||||||
|
?DUP
|
||||||
|
WHILE
|
||||||
|
POSTPONE THEN
|
||||||
|
REPEAT
|
||||||
|
;
|
||||||
|
|
||||||
|
: CFA>
|
||||||
|
LATEST @
|
||||||
|
BEGIN
|
||||||
|
?DUP
|
||||||
|
WHILE
|
||||||
|
2DUP SWAP
|
||||||
|
< IF
|
||||||
|
NIP
|
||||||
|
EXIT
|
||||||
|
THEN
|
||||||
|
@
|
||||||
|
REPEAT
|
||||||
|
DROP
|
||||||
|
0
|
||||||
|
;
|
||||||
|
|
||||||
|
: SEE
|
||||||
|
BL WORD FIND
|
||||||
|
|
||||||
|
HERE @
|
||||||
|
LATEST @
|
||||||
|
BEGIN
|
||||||
|
2 PICK
|
||||||
|
OVER
|
||||||
|
<>
|
||||||
|
WHILE
|
||||||
|
NIP
|
||||||
|
DUP @
|
||||||
|
REPEAT
|
||||||
|
|
||||||
|
DROP SWAP
|
||||||
|
|
||||||
|
':' EMIT SPACE DUP ID. CR
|
||||||
|
DUP ?IMMEDIATE IF ." IMMEDIATE " THEN
|
||||||
|
|
||||||
|
>DFA
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
2DUP >
|
||||||
|
WHILE
|
||||||
|
DUP @
|
||||||
|
|
||||||
|
CASE
|
||||||
|
['] LIT OF
|
||||||
|
CELL+ DUP @
|
||||||
|
. CR
|
||||||
|
ENDOF
|
||||||
|
['] LITSTRING OF
|
||||||
|
[ CHAR S ] LITERAL EMIT '"' EMIT SPACE
|
||||||
|
CELL+
|
||||||
|
COUNT 2DUP TELL
|
||||||
|
'"' EMIT CR
|
||||||
|
+
|
||||||
|
CELL-
|
||||||
|
ENDOF
|
||||||
|
['] 0BRANCH OF
|
||||||
|
." 0BRANCH("
|
||||||
|
CELL+ DUP @ 0 .R
|
||||||
|
." ) " CR
|
||||||
|
ENDOF
|
||||||
|
['] BRANCH OF
|
||||||
|
." BRANCH("
|
||||||
|
CELL+ DUP @ 0 .R
|
||||||
|
." ) " CR
|
||||||
|
ENDOF
|
||||||
|
['] ' OF
|
||||||
|
[ CHAR ' ] LITERAL EMIT SPACE
|
||||||
|
CELL+ @
|
||||||
|
CFA> ID. CR
|
||||||
|
ENDOF
|
||||||
|
['] EXIT OF
|
||||||
|
2DUP CELL+
|
||||||
|
<> IF
|
||||||
|
." EXIT " CR
|
||||||
|
THEN
|
||||||
|
ENDOF
|
||||||
|
DUP
|
||||||
|
CFA>
|
||||||
|
ID. CR
|
||||||
|
ENDCASE
|
||||||
|
|
||||||
|
CELL+
|
||||||
|
REPEAT
|
||||||
|
|
||||||
|
';' EMIT CR
|
||||||
|
|
||||||
|
2DROP
|
||||||
|
;
|
||||||
|
|
||||||
|
: :NONAME
|
||||||
|
HERE @
|
||||||
|
LATEST @ ,
|
||||||
|
LATEST !
|
||||||
|
0 ,
|
||||||
|
HERE @
|
||||||
|
[ ' DOCOL @ ] LITERAL ,
|
||||||
|
0 ,
|
||||||
|
]
|
||||||
|
;
|
||||||
|
|
||||||
|
( Colors )
|
||||||
|
DEC
|
||||||
|
: ESC[ 27 EMIT '[' EMIT ;
|
||||||
|
0 CONSTANT RESET
|
||||||
|
1 CONSTANT BRIGHT
|
||||||
|
2 CONSTANT DIM
|
||||||
|
4 CONSTANT UNSERSCORE
|
||||||
|
5 CONSTANT BLINK
|
||||||
|
7 CONSTANT REVERSE
|
||||||
|
8 CONSTANT HIDDEN
|
||||||
|
|
||||||
|
: FG> 30 + ;
|
||||||
|
: BG> 40 + ;
|
||||||
|
|
||||||
|
0 CONSTANT <BLK
|
||||||
|
1 CONSTANT <RED
|
||||||
|
2 CONSTANT <GRN
|
||||||
|
3 CONSTANT <YEL
|
||||||
|
4 CONSTANT <BLU
|
||||||
|
5 CONSTANT <MAG
|
||||||
|
6 CONSTANT <CYN
|
||||||
|
7 CONSTANT <WHT
|
||||||
|
|
||||||
|
: <COLOR> ESC[ 0 .R ';' EMIT 0 .R ." m" ;
|
||||||
|
: <ATTRIB> ESC[ 0 .R ';' EMIT ." ;m" ;
|
||||||
|
]]
|
||||||
198
control.lua
Normal file
198
control.lua
Normal file
|
|
@ -0,0 +1,198 @@
|
||||||
|
require('forth')
|
||||||
|
|
||||||
|
function init_storage()
|
||||||
|
-- storage.valid = false
|
||||||
|
if not storage.valid then
|
||||||
|
storage.players = {}
|
||||||
|
storage.computers = {}
|
||||||
|
storage.guis = {}
|
||||||
|
storage.valid = true
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
||||||
|
function computer_for_ent(entity)
|
||||||
|
for _, computer in pairs(storage.computers) do
|
||||||
|
if computer.entity == entity then
|
||||||
|
return computer
|
||||||
|
end
|
||||||
|
end
|
||||||
|
return nil
|
||||||
|
end
|
||||||
|
|
||||||
|
script.on_event(defines.events.on_tick, function(event)
|
||||||
|
init_storage()
|
||||||
|
|
||||||
|
for _, computer in pairs(storage.computers) do
|
||||||
|
for _=1,250 do
|
||||||
|
local ok, result = pcall(forth_tick, computer.ctx)
|
||||||
|
if ok and result then break end
|
||||||
|
if not ok then
|
||||||
|
game.print(result)
|
||||||
|
computer.ctx = forth_initialize(computer.entity)
|
||||||
|
end
|
||||||
|
end
|
||||||
|
if #computer.ctx.outbuf > 0 then
|
||||||
|
local out = ''
|
||||||
|
for i, v in pairs(computer.ctx.outbuf) do
|
||||||
|
out = out..v
|
||||||
|
end
|
||||||
|
computer.screen = computer.screen..out
|
||||||
|
computer.ctx.outbuf = {}
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
||||||
|
for player_index, player in pairs(storage.players) do
|
||||||
|
if player.opened_combinator then
|
||||||
|
local computer = computer_for_ent(player.opened_combinator)
|
||||||
|
local ui = game.get_player(player_index).gui.screen.forth_combinator_gui
|
||||||
|
ui.forth_combinator_console.text = computer.screen
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end)
|
||||||
|
|
||||||
|
script.on_event(defines.events.on_gui_text_changed, function(event)
|
||||||
|
if not event.element or event.element.name ~= 'forth_combinator_editor' then return end
|
||||||
|
|
||||||
|
local player = storage.players[event.player_index]
|
||||||
|
player.curtext = event.element.text
|
||||||
|
end)
|
||||||
|
|
||||||
|
function create_ui(player, computer)
|
||||||
|
local frame = player.gui.screen.add{type = "frame", name = "forth_combinator_gui", caption = "Console"}
|
||||||
|
frame.force_auto_center()
|
||||||
|
|
||||||
|
local editor = frame.add{type = 'text-box', name = 'forth_combinator_editor'}
|
||||||
|
editor.style.minimal_height = 600
|
||||||
|
editor.style.minimal_width = 800
|
||||||
|
editor.style.maximal_height = 600
|
||||||
|
editor.style.maximal_width = 800
|
||||||
|
editor.text = computer.script
|
||||||
|
local console = frame.add{type = 'text-box', name = 'forth_combinator_console'}
|
||||||
|
console.style.minimal_height = 600
|
||||||
|
console.style.minimal_width = 400
|
||||||
|
console.style.maximal_height = 600
|
||||||
|
console.style.maximal_width = 400
|
||||||
|
console.text = computer.screen
|
||||||
|
local run_button = frame.add{type = 'button', name = 'forth_combinator_run', caption = "Do Shit"}
|
||||||
|
-- console.selectable = false
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
return frame
|
||||||
|
end
|
||||||
|
|
||||||
|
script.on_event(defines.events.on_gui_opened, function(event)
|
||||||
|
if not event.entity or event.entity.name ~= 'forth-combinator' then return end
|
||||||
|
init_storage()
|
||||||
|
|
||||||
|
local player = game.get_player(event.player_index)
|
||||||
|
|
||||||
|
if not storage.players[event.player_index] then
|
||||||
|
storage.players[event.player_index] = {}
|
||||||
|
end
|
||||||
|
|
||||||
|
if player.gui.screen.forth_combinator_gui then
|
||||||
|
player.gui.screen.forth_combinator_gui.destroy()
|
||||||
|
end
|
||||||
|
|
||||||
|
if player.opened then
|
||||||
|
player.opened = nil
|
||||||
|
end
|
||||||
|
|
||||||
|
player.opened = create_ui(player, computer_for_ent(event.entity))
|
||||||
|
storage.players[event.player_index].opened_combinator = event.entity
|
||||||
|
end)
|
||||||
|
|
||||||
|
script.on_event(defines.events.on_gui_closed, function(event)
|
||||||
|
local player = game.get_player(event.player_index)
|
||||||
|
|
||||||
|
if player.gui.screen.forth_combinator_gui then
|
||||||
|
player.gui.screen.forth_combinator_gui.destroy()
|
||||||
|
if storage.players[event.player_index] then
|
||||||
|
storage.players[event.player_index].opened_combinator = nil
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end)
|
||||||
|
|
||||||
|
script.on_event(defines.events.on_gui_click, function(event)
|
||||||
|
local player = game.get_player(event.player_index)
|
||||||
|
local entity = storage.players[event.player_index].opened_combinator
|
||||||
|
|
||||||
|
if event.element.name == 'forth_combinator_run' then
|
||||||
|
local computer = computer_for_ent(entity)
|
||||||
|
if not computer then
|
||||||
|
game.print('Invalid computer in gui click')
|
||||||
|
return
|
||||||
|
end
|
||||||
|
computer.ctx = forth_initialize(entity)
|
||||||
|
|
||||||
|
-- Hack, idc
|
||||||
|
local text = storage.players[event.player_index].curtext
|
||||||
|
for c in text:gmatch('.') do
|
||||||
|
table.insert(computer.ctx.keybuf, string.byte(c))
|
||||||
|
end
|
||||||
|
table.insert(computer.ctx.keybuf, 10)
|
||||||
|
|
||||||
|
computer.screen = ''
|
||||||
|
computer.script = text
|
||||||
|
end
|
||||||
|
end)
|
||||||
|
|
||||||
|
function OnBuiltEntity(event)
|
||||||
|
local entity = event.entity
|
||||||
|
if entity.name ~= 'forth-combinator' then return end
|
||||||
|
init_storage()
|
||||||
|
|
||||||
|
local computer = {
|
||||||
|
ctx = forth_initialize(entity),
|
||||||
|
entity = entity,
|
||||||
|
screen = '',
|
||||||
|
script = '',
|
||||||
|
}
|
||||||
|
|
||||||
|
table.insert(storage.computers, computer)
|
||||||
|
end
|
||||||
|
|
||||||
|
function OnEntityDied(event)
|
||||||
|
local entity = event.entity
|
||||||
|
if entity.name ~= 'forth-combinator' then return end
|
||||||
|
init_storage()
|
||||||
|
|
||||||
|
local removals = {}
|
||||||
|
for i, comp in pairs(storage.computers) do
|
||||||
|
if comp.entity == entity then
|
||||||
|
table.insert(removals, i)
|
||||||
|
end
|
||||||
|
end
|
||||||
|
for _, i in pairs(removals) do
|
||||||
|
table.remove(storage.computers, i)
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
||||||
|
script.on_event(defines.events.on_built_entity, OnBuiltEntity)
|
||||||
|
script.on_event(defines.events.on_robot_built_entity, OnBuiltEntity)
|
||||||
|
-- script.on_event(defines.events.on_pre_ghost_deconstructed, OnPreGhostDeconstructed)
|
||||||
|
script.on_event(defines.events.on_entity_died, OnEntityDied)
|
||||||
|
script.on_event(defines.events.on_pre_player_mined_item, OnEntityDied)
|
||||||
|
script.on_event(defines.events.on_robot_pre_mined, OnEntityDied)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- player.surface.create_entity({
|
||||||
|
-- name = 'laser-beam',
|
||||||
|
-- position = entity.position,
|
||||||
|
-- source_position = entity.position,
|
||||||
|
-- target = player.position,
|
||||||
|
-- })
|
||||||
27
data.lua
Normal file
27
data.lua
Normal file
|
|
@ -0,0 +1,27 @@
|
||||||
|
local forthCombinator = table.deepcopy(data.raw['constant-combinator']['constant-combinator'])
|
||||||
|
|
||||||
|
forthCombinator.name = 'forth-combinator'
|
||||||
|
forthCombinator.minable.result = 'forth-combinator'
|
||||||
|
for k, direction in pairs(forthCombinator.sprites) do
|
||||||
|
for kk, vv in pairs(direction.layers) do
|
||||||
|
vv.tint = {r = 0, g = 0, b = 1}
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
||||||
|
local forthCombinatorItem = table.deepcopy(data.raw['item']['constant-combinator'])
|
||||||
|
forthCombinatorItem.name = 'forth-combinator'
|
||||||
|
forthCombinatorItem.place_result = 'forth-combinator'
|
||||||
|
|
||||||
|
local recipe = {
|
||||||
|
type = 'recipe',
|
||||||
|
name = 'forth-combinator',
|
||||||
|
enabled = true,
|
||||||
|
energy_required = 1, -- time to craft in seconds (at crafting speed 1)
|
||||||
|
ingredients = {
|
||||||
|
{type = 'item', name = 'copper-plate', amount = 1}
|
||||||
|
},
|
||||||
|
results = {{type = 'item', name = 'forth-combinator', amount = 1}}
|
||||||
|
}
|
||||||
|
|
||||||
|
data:extend{forthCombinator, forthCombinatorItem, recipe}
|
||||||
|
|
||||||
9
info.json
Normal file
9
info.json
Normal file
|
|
@ -0,0 +1,9 @@
|
||||||
|
{
|
||||||
|
"name": "forthCombinator",
|
||||||
|
"version": "0.1.0",
|
||||||
|
"title": "Forth Combinator",
|
||||||
|
"author": "UrMomLel",
|
||||||
|
"factorio_version": "2.0",
|
||||||
|
"dependencies": ["base >= 2.0"],
|
||||||
|
"description": "This game needs computers and those computers need to be running forth"
|
||||||
|
}
|
||||||
9
locale/en/locale.cfg
Normal file
9
locale/en/locale.cfg
Normal file
|
|
@ -0,0 +1,9 @@
|
||||||
|
|
||||||
|
[item-name]
|
||||||
|
forth-combinator=forth combinator
|
||||||
|
|
||||||
|
[entity-name]
|
||||||
|
forth-combinator=forth combinator
|
||||||
|
|
||||||
|
[item-description]
|
||||||
|
forth-combinator=This game needs computers and those computers need to run Forth
|
||||||
Loading…
Reference in a new issue