Posted Thu Oct 13, 2011 6:48 PM
Posted Fri Oct 14, 2011 7:34 AM
: HGET ( row column length buffer -- ) >R >R \ buffer address & length to return stack SWAP XMAX * + \ calculate screen address R> \ get length from return stack R> \ get buffer address from return stack SWAP \ stack is now: saddr buffer length VMBR \ read from screen into buffer ; : HPUT ( row column length buffer -- ) >R >R \ buffer address & length to return stack SWAP XMAX * + \ calculate screen address R> \ get length from return stack R> \ get buffer address from return stack SWAP \ stack is now: saddr buffer length VMBW \ write to screen from buffer ;The above just use the built in TurboForth words VMBR and VMBW (which work the same was as the editor assembler equivalents). They are very fast because they don't have to do any limit checks, since they are working on consequtive VDP addresses.
0 VALUE EOS : VGET ( row column length buffer -- ) XMAX 24 * TO EOS \ compute end of screen address >R >R \ move buffer and length out of the way SWAP XMAX * + \ convert row and column to screen address R> \ get length back R> \ get buffer address back SWAP 0 DO \ repeat length times SWAP \ get screen address to top of stack DUP V@ \ read a byte from VDP 2 PICK \ get buffer address C! \ store byte in buffer XMAX + \ move down 1 row DUP \ copy new screen address EOS >= IF \ moved off bottom of screen? EOS - 1+ \ move to top of next column THEN SWAP \ get buffer address 1+ \ increase buffer address LOOP \ repeat 2DROP \ drop buffer address and screen address ; : VPUT ( row column length buffer -- ) XMAX 24 * TO EOS \ compute end of screen address >R >R \ move buffer and length out of the way SWAP XMAX * + \ convert row and column to screen address R> \ get length back R> \ get buffer address back SWAP 0 DO \ repeat length times DUP C@ \ get a byte from the buffer 2 PICK \ get screen address V! \ write the byte from the buffer to screen 1+ \ move to next buffer address SWAP \ get screen address on top of stack XMAX + \ move down 1 row DUP \ copy new screen address EOS >= IF \ moved off bottom of screen? EOS - 1+ \ move to top of next column THEN SWAP LOOP 2DROP ;
0 VALUE buffer 0 VALUE repeat 0 VALUE length 0 VALUE column 0 VALUE row : RGET ( row column length repeat buffer -- ) TO buffer TO repeat TO length TO column TO row repeat 0 DO row column length buffer HGET 1 +TO row length +TO buffer LOOP ; : RPUT ( row column length repeat buffer -- ) TO buffer TO repeat -ROT TO column TO row repeat 0 DO row column 2 PICK buffer HPUT 1 +TO row length +TO buffer LOOP DROP ;
RGET1.PNG 72.03K
5 downloads0 0 40 24 HERE RGET
5 11 12 10 HERE RPUT
RGET2.PNG 22.93K
5 downloads: HGET ( row column length buffer -- ) >R >R SWAP XMAX * + R> R> SWAP VMBR ; : HPUT ( row column length buffer -- ) >R >R SWAP XMAX * + R> R> SWAP VMBW ; 0 VALUE EOS : VGET ( row column length buffer -- ) XMAX 24 * TO EOS >R >R SWAP XMAX * + R> R> SWAP 0 DO SWAP DUP V@ 2 PICK C! XMAX + DUP EOS >= IF EOS - 1+ THEN SWAP 1+ LOOP 2DROP ; : VPUT ( row column length buffer -- ) XMAX 24 * TO EOS >R >R SWAP XMAX * + R> R> SWAP 0 DO DUP C@ 2 PICK V! 1+ SWAP XMAX + DUP EOS >= IF EOS - 1+ THEN SWAP LOOP 2DROP ; 0 VALUE buffer 0 VALUE repeat 0 VALUE length 0 VALUE column 0 VALUE row : RGET ( row column length repeat buffer -- ) TO buffer TO repeat TO length TO column TO row repeat 0 DO row column length buffer HGET 1 +TO row length +TO buffer LOOP ; : RPUT ( row column length repeat buffer -- ) TO buffer TO repeat -ROT TO column TO row repeat 0 DO row column 2 PICK buffer HPUT 1 +TO row length +TO buffer LOOP DROP ;
Posted Fri Oct 14, 2011 2:46 PM
Posted Mon Oct 17, 2011 7:26 PM



Posted Mon Oct 17, 2011 7:30 PM
: SETVAR 10 5 ; : TEST SETVAR BEGIN BREAK? 2DUP PAGE 42 1 HCHAR (duplicate top two numbers, clear screen, place "*" onscreen) KEY 68 - 0 = IF DROP 1 - ELSE (if "E" then drop ascii and subtract 1 from top stack item) 1 = IF DROP SWAP 1 + SWAP ELSE (if "D" then add 1 to second stack item) 15 = IF DROP SWAP 1 - SWAP ELSE (if "S" then subtract 1 from second stack item) 20 = IF DROP 1 + ELSE (if "X" then add 1 to top stack item) DROP (if the key is none of these, drop it from the stack and complete loop) THEN THEN THEN THEN AGAIN ;
Posted Tue Oct 18, 2011 6:24 AM
: ADSP PAGE 0 MAGNIFY 1 10 10 42 15 SPRITE BEGIN BREAK? AGAIN ;
: TEST 1 GMODE \ select 32 column mode \ define a cross hatch character for *sprite* char 42: DATA 4 $AA55 $AA55 $AA55 $AA55 42 256 + DCHAR \ now use sprite 0 0 10 10 42 15 SPRITE ;
Posted Tue Oct 18, 2011 7:29 AM
: MAKVAR VARIABLE PX VARIABLE PY ; : SETVAR 10 PY ! 5 PX ! ; : PCSET PY @ PX @ 42 1 HCHAR ; : TEST MAKVAR SETVAR PCSET ;
VARIABLE PX VARIABLE PY : SETVAR 10 PY ! 5 PX ! ; : PCSET PY @ PX @ 42 1 HCHAR ; : TEST SETVAR PCSET ;
: SETVAR ( row column -- ) PX ! PY ! ;
owen1.PNG 35.38K
6 downloads0 VALUE PX 0 VALUE PY : SETVAL 10 TO PY 5 TO PX ; : PCSET PY PX 42 1 HCHAR ; : TEST SETVAL PCSET ;
0 VALUE PX 0 VALUE PY 42 CONSTANT STAR : SETVAL 10 TO PY 5 TO PX ; : PCSET PY PX STAR 1 HCHAR ; : TEST SETVAL PCSET ;
Posted Tue Oct 18, 2011 7:33 AM
Opry99er, on Mon Oct 17, 2011 7:26 PM, said:
Posted Tue Oct 18, 2011 9:15 AM
CHAR E CONSTANT KEY_E CHAR X CONSTANT KEY_X CHAR S CONSTANT KEY_S CHAR D CONSTANT KEY_D : SETVAR 10 5 ; : TEST SETVAR BEGIN PAGE 0 0 GOTOXY .S 2DUP 42 1 HCHAR KEY DUP KEY_E = IF DROP SWAP 1- SWAP ELSE DUP KEY_S = IF DROP 1- ELSE DUP KEY_D = IF DROP 1+ ELSE KEY_X = IF SWAP 1+ SWAP THEN THEN THEN THEN AGAIN ;
: ERASE 2DUP 32 1 HCHAR ; : TEST SETVAR PAGE BEGIN 0 0 GOTOXY .S 2DUP 42 1 HCHAR KEY DUP KEY_E = IF DROP ERASE SWAP 1- SWAP ELSE DUP KEY_S = IF DROP ERASE 1- ELSE DUP KEY_D = IF DROP ERASE 1+ ELSE KEY_X = IF SWAP ERASE 1+ SWAP THEN THEN THEN THEN AGAIN ;
CHAR E CONSTANT KEY_E CHAR X CONSTANT KEY_X CHAR S CONSTANT KEY_S CHAR D CONSTANT KEY_D : SETVAR 10 5 ; : ERASE 2DUP 32 1 HCHAR ; : TEST SETVAR BEGIN 0 0 GOTOXY .S 2DUP 42 1 HCHAR KEY? DUP -1 <> IF DUP KEY_E = IF DROP ERASE SWAP 1- SWAP ELSE DUP KEY_S = IF DROP ERASE 1- ELSE DUP KEY_D = IF DROP ERASE 1+ ELSE KEY_X = IF SWAP ERASE 1+ SWAP THEN THEN THEN THEN ELSE DROP THEN AGAIN ;
CHAR E CONSTANT KEY_E CHAR X CONSTANT KEY_X CHAR S CONSTANT KEY_S CHAR D CONSTANT KEY_D : SETVAR 10 5 ; : ERASE 2DUP 32 1 HCHAR ; : CLIP-ROW 24 MOD ; : CLIP-COL XMAX MOD ; : TEST SETVAR PAGE BEGIN 2DUP 42 1 HCHAR KEY? DUP -1 <> IF DUP KEY_E = IF DROP ERASE SWAP 1- CLIP-ROW SWAP ELSE DUP KEY_S = IF DROP ERASE 1- CLIP-COL ELSE DUP KEY_D = IF DROP ERASE 1+ CLIP-COL ELSE KEY_X = IF ERASE SWAP 1+ CLIP-ROW SWAP THEN THEN THEN THEN ELSE DROP THEN AGAIN ;
15 CONSTANT WHITE 42 CONSTANT FACE 20 VALUE ROW 40 VALUE COL 0 CONSTANT SPRITE#0 : AS-SPRITE 256 + DCHAR ; : FACE_DATA DATA 4 $7E81 $A581 $A599 $817E ; : TEST 1 GMODE FACE_DATA FACE AS-SPRITE SPRITE#0 ROW COL FACE WHITE SPRITE ;
Posted Tue Oct 18, 2011 7:48 PM
Block:006 0*VARIABLE PX VARIABLE PY 1*10 PX ! 5 PY ! 2*: GETVAR PY@ PX @ ; 3* 4*: TEST 5* BEGIN GETVAR 6* 2DUP PAGE 42 1 HCHAR 7* KEY 68 - 8* DUP 0 = IF DROP 1 + PX ! ELSE 9* DUP 1 = IF DROP SWAP 1 - PY ! ELSE 10* DUP 15 = IF DROP 1 - PX ! ELSE 11* DUP 20 = IF DROP SWAP 1 + PY ! ELSE 12* DROP 13* THEN THEN THEN THEN 14* AGAIN 15*;
Posted Tue Oct 18, 2011 7:50 PM
Posted Wed Oct 19, 2011 3:23 AM
Opry99er, on Tue Oct 18, 2011 7:48 PM, said:
Block:006 0*VARIABLE PX VARIABLE PY 1*10 PX ! 5 PY ! 2*: GETVAR PY@ PX @ ; 3* 4*: TEST 5* BEGIN GETVAR 6* 2DUP PAGE 42 1 HCHAR 7* KEY 68 - 8* DUP 0 = IF DROP 1 + PX ! ELSE 9* DUP 1 = IF DROP SWAP 1 - PY ! ELSE 10* DUP 15 = IF DROP 1 - PX ! ELSE 11* DUP 20 = IF DROP SWAP 1 + PY ! ELSE 12* DROP 13* THEN THEN THEN THEN 14* AGAIN 15*;
CALL KEY(0,K,S) IF K=68 THEN X=X+1
KEY 68 = IF X @ 1+ X !THEN
KEY 68 = IF 1 X +!
VARIABLE ROW 10 ROW ! VARIABLE COL 10 COL ! VARIABLE KEYCODE : TEST BEGIN ROW @ COL @ 42 1 HCHAR KEY? KEYCODE ! KEYCODE @ -1 <> IF ROW @ COL @ 32 1 HCHAR KEYCODE @ 68 = IF 1 COL +! THEN KEYCODE @ 83 = IF 1 COL -! THEN KEYCODE @ 69 = IF 1 ROW -! THEN KEYCODE @ 88 = IF 1 ROW +! THEN KEYCODE @ 32 = IF EXIT THEN ROW @ 24 MOD ROW ! COL @ XMAX MOD COL ! THEN AGAIN ;
VARIABLE ROW 10 ROW ! VARIABLE COL 10 COL ! : TEST BEGIN ROW @ COL @ 42 1 HCHAR KEY? DUP -1 <> IF ROW @ COL @ 32 1 HCHAR DUP 68 = IF DROP 1 COL +! ELSE DUP 83 = IF DROP 1 COL -! ELSE DUP 69 = IF DROP 1 ROW -! ELSE DUP 88 = IF DROP 1 ROW +! ELSE 32 = IF EXIT THEN THEN THEN THEN THEN ROW @ 24 MOD ROW ! COL @ XMAX MOD COL ! ELSE DROP THEN AGAIN ;
: TEST 10 10 \ row and column BEGIN 2DUP 42 1 HCHAR KEY? DUP -1 <> IF -ROT 2DUP 32 1 HCHAR ROT DUP 68 = IF DROP 1+ ELSE DUP 83 = IF DROP 1- ELSE DUP 69 = IF DROP SWAP 1- SWAP ELSE DUP 88 = IF DROP SWAP 1+ SWAP ELSE 32 = IF 2DROP EXIT THEN THEN THEN THEN THEN XMAX MOD SWAP 24 MOD SWAP ELSE DROP THEN AGAIN ;
Posted Wed Oct 19, 2011 7:21 PM

Posted Wed Oct 19, 2011 8:36 PM
: TEST 10 10 \ row and column BEGIN 2DUP 42 1 HCHAR KEY? DUP -1 <> IF -ROT 2DUP 32 1 HCHAR ROT CASE 68 OF 1+ ENDOF 83 OF 1- ENDOF 69 OF SWAP 1- SWAP ENDOF 88 OF SWAP 1+ SWAP ENDOF 32 OF 2DROP EXIT ENDOF ENDCASE XMAX MOD SWAP 24 MOD SWAP ELSE DROP THEN AGAIN ;
Posted Wed Oct 19, 2011 9:39 PM
: TEST 10 10 \ row and column BEGIN 2DUP 42 1 HCHAR KEY? 1+ \ add 1 to make 0 if no key pressed ?DUP \ DUP if not 0 IF -ROT 2DUP 32 1 HCHAR ROT CASE \ check incremented ASCII values 69 OF 1+ ENDOF 84 OF 1- ENDOF 70 OF SWAP 1- SWAP ENDOF 89 OF SWAP 1+ SWAP ENDOF 33 OF 2DROP EXIT ENDOF ENDCASE XMAX MOD SWAP 24 MOD SWAP THEN AGAIN ;
Posted Wed Oct 19, 2011 11:56 PM
Posted Thu Oct 20, 2011 2:27 AM
Lee Stewart, on Wed Oct 19, 2011 9:39 PM, said:
: TEST 10 10 \ row and column BEGIN 2DUP 42 1 HCHAR KEY? 1+ \ add 1 to make 0 if no key pressed ?DUP \ DUP if not 0 IF -ROT 2DUP 32 1 HCHAR ROT CASE \ check incremented ASCII values 69 OF 1+ ENDOF 84 OF 1- ENDOF 70 OF SWAP 1- SWAP ENDOF 89 OF SWAP 1+ SWAP ENDOF 33 OF 2DROP EXIT ENDOF ENDCASE XMAX MOD SWAP 24 MOD SWAP THEN AGAIN ;
Posted Thu Oct 20, 2011 2:40 AM
retroclouds, on Wed Oct 19, 2011 11:56 PM, said:
Posted Thu Oct 20, 2011 2:51 AM
retroclouds, on Wed Oct 19, 2011 11:56 PM, said:
Posted Thu Oct 20, 2011 1:45 PM
Block:006 0*VARIABLE PX VARIABLE PY 1*10 PX ! 5 PY ! 2*: GETVAR PY@ PX @ ; 3* 4*: TEST 5* BEGIN GETVAR 6* 2DUP PAGE 42 1 HCHAR 7* KEY 68 - 8* DUP 0 = IF DROP 1 + PX ! ELSE 9* DUP 1 = IF DROP SWAP 1 - PY ! ELSE 10* DUP 15 = IF DROP 1 - PX ! ELSE 11* DUP 20 = IF DROP SWAP 1 + PY ! ELSE 12* DROP 13* THEN THEN THEN THEN 14* AGAIN 15*;Looking back at the above code, what I did was just combine my straight Forth example
10 VALUE PX 5 VALUE PY : TEST BEGIN PY PX 2DUP 42 1 HCHAR KEY? DUP -1 <> IF -ROT 2DUP 32 1 HCHAR ROT DUP 68 = IF DROP 1 +TO PX ELSE DUP 69 = IF DROP -1 +TO PY ELSE DUP 83 = IF DROP -1 +TO PX ELSE DUP 88 = IF DROP 1 +TO PY ELSE THEN THEN THEN THEN ELSE DROP 2DROP THEN AGAIN ;1) defined values for PX and PY (-)
Posted Thu Oct 20, 2011 1:53 PM
XMAX MOD SWAP 24 MOD SWAP
IF PY>24 THEN PY=24
XMAX MOD SWAP 24 MOD SWAP
Posted Thu Oct 20, 2011 4:48 PM
XMAX MOD SWAP 24 MOD SWAP
10 VALUE PX 5 VALUE PY : TEST BEGIN PY PX 42 1 HCHAR KEY? DUP -1 <> IF PY PX 32 1 HCHAR DUP 68 = IF DROP 1 +TO PX ELSE DUP 69 = IF DROP -1 +TO PY ELSE DUP 83 = IF DROP -1 +TO PX ELSE DUP 88 = IF DROP 1 +TO PY ELSE 32 = IF EXIT THEN THEN THEN THEN THEN PY 24 MOD TO PY PX XMAX MOD TO PX ELSE DROP THEN AGAIN ;
Edited by Lee Stewart, Thu Oct 20, 2011 7:39 PM.
Posted Thu Oct 20, 2011 7:37 PM
Posted Fri Oct 21, 2011 2:04 AM
Posted Fri Oct 21, 2011 2:29 AM
Opry99er, on Thu Oct 20, 2011 1:53 PM, said:
IF PY>24 THEN PY=24
SWAP DUP 23 > IF DROP 23 THEN SWAP ;
DUP 39 > IF DROP 39 THEN
10 VALUE PX 5 VALUE PY : TEST BEGIN PY PX 42 1 HCHAR KEY? DUP -1 <> IF PY PX 32 1 HCHAR DUP 68 = IF DROP 1 +TO PX ELSE DUP 69 = IF DROP -1 +TO PY ELSE DUP 83 = IF DROP -1 +TO PX ELSE DUP 88 = IF DROP 1 +TO PY ELSE 32 = IF EXIT THEN THEN THEN THEN THEN \ do limit checks PY 23 > IF 23 TO PY THEN PY 0 < IF 0 TO PY THEN PX XMAX = IF XMAX 1- TO PX THEN PX 0 < IF 0 TO PX THEN ELSE DROP THEN AGAIN ;
10 VALUE PX 5 VALUE PY : TEST BEGIN PY PX 42 1 HCHAR KEY? DUP -1 <> IF PY PX 32 1 HCHAR DUP 68 = IF DROP PX XMAX 1- < IF 1 +TO PX THEN ELSE DUP 69 = IF DROP PY 0 > IF -1 +TO PY THEN ELSE DUP 83 = IF DROP PX 0 > IF -1 +TO PX THEN ELSE DUP 88 = IF DROP PY 23 < IF 1 +TO PY THEN ELSE 32 = IF EXIT THEN THEN THEN THEN THEN ELSE DROP THEN AGAIN ;
0 members, 0 guests, 0 anonymous users