mirror of
https://github.com/Tolik-Trek/Spectrum.EXE.git
synced 2026-06-15 09:01:38 +03:00
178 lines
6.9 KiB
Forth
178 lines
6.9 KiB
Forth
\ \\\\ menu program for spectrum.exe \\\\ \
|
||
|
||
VARIABLE MAIN-X
|
||
VARIABLE CURS-M
|
||
VARIABLE MENU
|
||
VARIABLE ITEMS
|
||
VARIABLE EXE-POINT
|
||
VARIABLE PLACE-M
|
||
|
||
: M-CB 10 COLOR ! ;
|
||
: M-C0 07 COLOR ! ;
|
||
: M-C1 70 COLOR ! ;
|
||
: M-C2 30 COLOR ! ;
|
||
: M-C3 3F COLOR ! ;
|
||
: M-C4 01 COLOR ! ;
|
||
|
||
: CLSM M-CB 100 SET_POS 17 0 DO CLL CR LOOP ;
|
||
|
||
: MENU" CREATE , , ," ;
|
||
: ITEM" , ," BL WORD FIND IF NAME> , ELSE ABORT" no word!" THEN ;
|
||
: END-MENU 0 , ;
|
||
|
||
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \
|
||
|
||
19 CONSTANT LEN-F
|
||
|
||
: EDIT-FNAME EXE-POINT @ PLACE-M @ OVER C@ LEN-F - + SET_POS C@+ + LEN-F - LEN-F 1- (EXPECT) ;
|
||
: EDIT-CNAME EXE-POINT @ PLACE-M @ OVER C@ 0D - + SET_POS C@+ + 0D - 0C (EXPECT) ;
|
||
: NO-ESC ;
|
||
: H-LINE M-C3 1800 SET_POS CLL 1801 SET_POS ;
|
||
|
||
: NEW-MENU M-C1 PLACE-M @ SET_POS EXE-POINT @ C@+ TYPE MENU ! CLSM ;
|
||
|
||
: M-EXIT M-C0 CLS BYE ;
|
||
|
||
: RET-MAIN MAIN-X @ MENU @ = IF M-EXIT THEN
|
||
H-LINE ." Ret to Main " MAIN-X @ NEW-MENU ;
|
||
|
||
: NO-FN H-LINE ." no function " ;
|
||
|
||
1 0E1B MENU" TRDS TRD files "
|
||
1 ITEM" Disk A: testfile.trd " EDIT-FNAME
|
||
1 ITEM" Disk B: " EDIT-FNAME
|
||
1 ITEM" Disk C: " EDIT-FNAME
|
||
1 ITEM" Disk D: " EDIT-FNAME
|
||
1 ITEM" Main Menu <esc> " RET-MAIN
|
||
END-MENU
|
||
|
||
1 21B MENU" ROMS ROM Menu "
|
||
1 ITEM" BASIC48 basic48.bin " EDIT-FNAME
|
||
1 ITEM" BASIC128 basic128.bin " EDIT-FNAME
|
||
1 ITEM" TR-DOS trdos5s.bin " EDIT-FNAME
|
||
1 ITEM" EXPANSION exp.bin " EDIT-FNAME
|
||
1 ITEM" BIOS1 exp.bin " EDIT-FNAME
|
||
1 ITEM" BIOS2 exp2.bin " EDIT-FNAME
|
||
1 ITEM" Main Menu <esc> " RET-MAIN
|
||
END-MENU
|
||
|
||
1 414 MENU" CONFIG Options Menu "
|
||
1 ITEM" Turbo Yes " NO-FN
|
||
1 ITEM" Sprinter ports Yes " NO-FN
|
||
1 ITEM" Port 1FFD Yes " NO-FN
|
||
1 ITEM" Port 7FFD Yes " NO-FN
|
||
1 ITEM" 512Kb Memory No " NO-FN
|
||
1 ITEM" Original Int No " NO-FN
|
||
1 ITEM" Scorpion Int No " NO-FN
|
||
1 ITEM" 312 screen lines No " NO-FN
|
||
1 ITEM" Start TR-DOS No " NO-FN
|
||
1 ITEM" Install only No " NO-FN
|
||
1 ITEM" Reset to ZX Yes " NO-FN
|
||
1 ITEM" Main Menu <esc> " RET-MAIN
|
||
END-MENU
|
||
|
||
1 D03 MENU" STAN Standards "
|
||
1 ITEM" Sprinter ZX " NO-FN
|
||
1 ITEM" ZX Spectrum " NO-FN
|
||
1 ITEM" Pentagon 128 " NO-FN
|
||
1 ITEM" Scorpion 256 " NO-FN
|
||
1 ITEM" Pentagon 512 " NO-FN
|
||
1 ITEM" Main Menu <esc> " RET-MAIN
|
||
END-MENU
|
||
|
||
1 512 MENU" SPEC Specials "
|
||
1 ITEM" Save your MODE " NO-FN
|
||
1 ITEM" Save utility " NO-FN
|
||
1 ITEM" Main Menu <esc> " RET-MAIN
|
||
END-MENU
|
||
|
||
: START-ZX H-LINE ." Start SPECTRUM.EXE" ;
|
||
: STANDARD H-LINE ." Choose standard mode" STAN NEW-MENU ;
|
||
: CONFIG-ZX H-LINE ." Set Spectrum MODE options" CONFIG NEW-MENU ;
|
||
: ROM-SET H-LINE ." Set Spectrum ROM files" ROMS NEW-MENU ;
|
||
: TRD-FILES H-LINE ." Set TR-DOS disk images" TRDS NEW-MENU ;
|
||
: SPECIALS H-LINE ." Special functions" SPEC NEW-MENU ;
|
||
|
||
1 203 MENU" MAIN Main Menu " ( pos,curs,"name" )
|
||
1 ITEM" Mode: Sprinter ZX " EDIT-CNAME
|
||
1 ITEM" Start " START-ZX ( type "name" word )
|
||
1 ITEM" Standard modes " STANDARD
|
||
1 ITEM" Options " CONFIG-ZX
|
||
1 ITEM" ROM files " ROM-SET
|
||
1 ITEM" Disk image files " TRD-FILES
|
||
1 ITEM" Specials " SPECIALS
|
||
1 ITEM" Exit <esc> " M-EXIT
|
||
END-MENU
|
||
|
||
MAIN MAIN-X !
|
||
|
||
: CURS-TYPE CURS-M @ 0=
|
||
IF GET_POS PLACE-M ! DUP EXE-POINT ! C@+ M-C2 TYPE M-C1 ELSE C@+ TYPE THEN
|
||
-1 CURS-M +! 1 ITEMS +! ;
|
||
|
||
: HEAD ( len -> ) GET_POS SWAP M-C1 C" <EFBFBD> EMIT 0 DO C" <EFBFBD> EMIT LOOP C" <EFBFBD> EMIT 100 + SET_POS ;
|
||
: TEXT ( len -> ) GET_POS OVER M-C1 C" <EFBFBD> EMIT CURS-TYPE C" <EFBFBD> EMIT M-C4 ." <EFBFBD><EFBFBD>" 100 + SET_POS ;
|
||
: LINE ( len -> ) GET_POS SWAP M-C1 C" <EFBFBD> EMIT 0 DO C" <EFBFBD> EMIT LOOP C" <EFBFBD> EMIT M-C4 ." <EFBFBD><EFBFBD>" 100 + SET_POS ;
|
||
: ENDS ( l->) GET_POS OVER M-C1 C" <EFBFBD> EMIT 0 DO C" <EFBFBD> EMIT LOOP C" <EFBFBD> EMIT M-C4 ." <EFBFBD><EFBFBD>"
|
||
102 + SET_POS 2 + C" <EFBFBD> SWAP 0 DO DUP EMIT LOOP DROP ;
|
||
|
||
MAIN MENU !
|
||
|
||
: PRINT-MENU COLOR @ M-C1 ITEMS 0! EXE-POINT 0!
|
||
MENU @
|
||
DUP @ SET_POS 2 +
|
||
DUP @ CURS-M ! 2 +
|
||
DUP C@ HEAD TEXT DUP C@ LINE DUP C@ SWAP C@+ +
|
||
BEGIN DUP @ 0<> WHILE
|
||
2 + TEXT C@+ + 2 + REPEAT
|
||
DROP ENDS COLOR ! ;
|
||
|
||
|
||
: CURS-UP MENU @ 2 + DUP @ 1- 1 MAX SWAP ! ;
|
||
: CURS-DN MENU @ 2 + DUP @ 1+ ITEMS @ 1- MIN SWAP ! ;
|
||
: CURS-HOME 1 MENU @ 2 + ! ;
|
||
: CURS-END ITEMS @ 1- MENU @ 2 + ! ;
|
||
|
||
: EXE-MENU M-C0 EXE-POINT @ ?DUP IF C@+ + @ EXECUTE THEN ;
|
||
|
||
: KEY-MENU WAIT-KEY
|
||
|
||
DUP [ SYS-ID 011B AND SYS-ID NOT 011B AND OR ] LITERAL = IF DROP RET-MAIN EXIT THEN ( ESC )
|
||
DUP [ SYS-ID 4400 AND SYS-ID NOT 4400 AND OR ] LITERAL = IF DROP RET-MAIN EXIT THEN ( F10 )
|
||
DUP [ SYS-ID 5200 AND SYS-ID NOT 5000 AND OR ] LITERAL = IF DROP CURS-DN EXIT THEN ( Down )
|
||
DUP [ SYS-ID 5800 AND SYS-ID NOT 4800 AND OR ] LITERAL = IF DROP CURS-UP EXIT THEN ( Up )
|
||
DUP [ SYS-ID 280D AND SYS-ID NOT 1C0D AND OR ] LITERAL = IF DROP EXE-MENU EXIT THEN ( Up )
|
||
\ DUP [ SYS-ID D400 AND SYS-ID NOT 7300 AND OR ] LITERAL = IF DROP W-LEFT EXIT THEN ( <ctrl )
|
||
\ DUP [ SYS-ID D600 AND SYS-ID NOT 7400 AND OR ] LITERAL = IF DROP W-RIGHT EXIT THEN ( ctrl> )
|
||
\ DUP [ SYS-ID 5400 AND SYS-ID NOT 4B00 AND OR ] LITERAL = IF DROP -POS EXIT THEN ( <- )
|
||
\ DUP [ SYS-ID 5600 AND SYS-ID NOT 4D00 AND OR ] LITERAL = IF DROP +POS EXIT THEN ( -> )
|
||
\ DUP [ SYS-ID 0F09 AND SYS-ID NOT 0F09 AND OR ] LITERAL = IF DROP TAB+ EXIT THEN ( tab )
|
||
\ DUP [ SYS-ID 8F09 AND SYS-ID NOT 0F00 AND OR ] LITERAL = IF DROP TAB- EXIT THEN ( <tab )
|
||
\ DUP [ SYS-ID 0E08 AND SYS-ID NOT 0E08 AND OR ] LITERAL = IF DROP DELX EXIT THEN ( <del )
|
||
\ DUP [ SYS-ID 8E00 AND SYS-ID NOT 0E7F AND OR ] LITERAL = IF DROP DELW EXIT THEN ( ctrl<del )
|
||
DUP [ SYS-ID 5700 AND SYS-ID NOT 4700 AND OR ] LITERAL = IF DROP CURS-HOME EXIT THEN ( home )
|
||
DUP [ SYS-ID D700 AND SYS-ID NOT 7700 AND OR ] LITERAL = IF DROP CURS-HOME EXIT THEN ( ctrl.home )
|
||
DUP [ SYS-ID 5100 AND SYS-ID NOT 4F00 AND OR ] LITERAL = IF DROP CURS-END EXIT THEN ( end )
|
||
DUP [ SYS-ID D100 AND SYS-ID NOT 7500 AND OR ] LITERAL = IF DROP CURS-END EXIT THEN ( ctrl.end )
|
||
|
||
DROP ;
|
||
|
||
: LOOP-M M-CB CLS S0 @ SP! R0 @ RP!
|
||
MAIN MENU ! CURS-HOME
|
||
H-LINE 0 SET_POS M-C3 CLL ." Spectrum.exe config utility version 0.02"
|
||
BEGIN
|
||
PRINT-MENU KEY-MENU AGAIN ;
|
||
|
||
BL WORD NO-ESC FIND DROP NAME> ESC-W !
|
||
|
||
TRUE H-FLAG !
|
||
07 COLOR !
|
||
|
||
MAKE LOOP-M
|
||
\ PC> INC-END SAVE-SYSTEM _test.com
|
||
\ SP> INC-END SAVE-SYSTEM zxmode.exe
|
||
|
||
CLS LOOP-M
|
||
BYE
|
||
|