Skip to content

Commit 2add8b6

Browse files
committed
line drawing updates
1 parent f0a3bf5 commit 2add8b6

File tree

4 files changed

+288
-7
lines changed

4 files changed

+288
-7
lines changed

DEMO/MultiColor/MM-LINETEST.FTH

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -50,10 +50,9 @@ DECIMAL
5050
: TESTLINE
5151
MULTICOLOR
5252
CLEAR
53-
BEGIN
53+
500 0 DO
5454
RNDCOLOR RNDX RNDY RNDX RNDY LINE
55-
?TERMINAL
56-
UNTIL
55+
LOOP
5756
TEXT
5857
;
5958

DEMO/MultiColor/MULTIMODE.FTH

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -119,5 +119,36 @@ DROP
119119
: XY@ ( -- x y) VROW 2@ ;
120120
: HLINE ( n x y --) AT-XY 0 DO MCOLOR @ XY@ MCHAR VCOL 1+! LOOP ;
121121
: VLINE ( n x y --) AT-XY 0 DO MCOLOR @ XY@ MCHAR VROW 1+! LOOP ;
122+
DECIMAL
123+
\ Text macros make LINE clearer but run full speed
124+
: 2ROT ( d1 d2 d3 -- d2 d3 d1)
125+
S" 2>R 2SWAP 2R> 2SWAP" EVALUATE ; IMMEDIATE
126+
\ : 4DUP ( a b c d -- a b c d a b c d)
127+
\ S" 3 PICK 3 PICK 3 PICK 3 PICK" EVALUATE ; IMMEDIATE
128+
129+
HEX
130+
CODE 4DUP ( a b c d -- a b c d a b c d)
131+
C046 , \ SP R1 MOV, \ dup stack pointer \ 14
132+
0646 , C584 , \ TOS PUSH, ( -- a b c d d) \ 28
133+
0226 , FFFA , \ SP -6 AI, \ make some room \ 12
134+
C5B1 , \ R1 *+ *SP MOV, \ 28
135+
C9B1 , 0002 , \ R1 *+ 2 (SP) MOV, \ 30
136+
C9B1 , 0004 , \ R1 *+ 4 (SP) MOV, \ 30
137+
NEXT, \ TOTAL 142
138+
ENDCODE
139+
140+
DECIMAL
141+
: LINE ( x1 y1 x2 y2 -- )
142+
\ ANS version of Dr. Ting's recursive line. R.I.P.
143+
4DUP ROT - ABS -ROT - ABS \ compute dx dy
144+
MAX 2 < IF 2DROP MM.PLOT EXIT THEN \ nothing do, get out
145+
146+
4DUP ROT
147+
+ 1+ 2/ >R \ compute mid points
148+
+ 1+ 2/ R>
149+
2DUP 2ROT RECURSE RECURSE ;
150+
151+
: MOVETO ( x y -- ) S" AT-XY" EVALUATE ; IMMEDIATE ( alias)
152+
: LINETO ( x y -- ) 2DUP XY@ LINE MOVETO ;
122153

123154
HERE SWAP - DECIMAL . .( bytes)

LIB.ITC/GRAPHICS2.9.FTH

Lines changed: 212 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,212 @@
1+
\ Graphics2 Mode V2.8 for Camel99 Forth Dec 2022 BJF
2+
\ Referenced TI-FORTH:
3+
( CONVERT TO GRAPHICS2 MODE CONFIG 14SEP82 LAO)
4+
5+
\ Test results using simple program
6+
\ V2.1 Forth with text macros
7+
\ 2.7 critical VOR VERASE and XY-offset as CODE
8+
\ 2.8 PIXPOS re-coded in ASM
9+
10+
\ COMPILES under ITC ONLY
11+
CR .( Two colour bit map mode )
12+
13+
NEEDS DUMP FROM DSK1.TOOLS
14+
NEEDS MOV, FROM DSK1.ASM9900
15+
NEEDS VALUE FROM DSK1.VALUES
16+
NEEDS CHARSET FROM DSK1.CHARSET
17+
NEEDS ARRAY FROM DSK1.ARRAYS
18+
NEEDS 4TH FROM DSK1.3RD4TH \ fast access to deep stack items
19+
20+
HEX
21+
\
22+
\ text mode so we can return to the Forth console
23+
\ KERNEL version does not init all registers
24+
\
25+
83D4 CONSTANT VDPR1
26+
CREATE 40COL
27+
\ CNT 0 1 2 3 4 5 6 7
28+
08 C, 00 C, F0 C, 00 C, 0E C, 01 C, 06 C, 02 C, 17 C, 00 C,
29+
30+
: VREGS ( addr len -- )
31+
OVER 1+ C@ VDPR1 C! \ store the R1 value from the table
32+
0 DO COUNT I VWTR LOOP DROP ;
33+
34+
HEX
35+
0000 VALUE CTAB \ color table
36+
2000 VALUE PDT \ pattern descriptor table
37+
1800 VALUE IMG
38+
39+
: TEXT ( -- )
40+
40COL COUNT VREGS
41+
800 TO PDT
42+
380 TO CTAB
43+
VTOP OFF
44+
2 VMODE !
45+
28 C/L!
46+
CHARSET \ restore charset because VDP memory is mangled
47+
PAGE ;
48+
49+
: CLEAR ( -- ) PDT 1800 0 VFILL ; \ ERASE pattern table
50+
51+
: COLOR ( fg bg --)
52+
SWAP 4 LSHIFT SWAP + \ merge colors into a byte
53+
CTAB 1800 ROT VFILL ; \ init color table
54+
55+
: INIT-IMAGE ( -- )
56+
-1 IMG 300 BOUNDS DO 1+ DUP 0FF AND I VC! LOOP DROP ;
57+
58+
\ replacing text macro with code words
59+
HEX
60+
' VC! 2 CELLS + @ CONSTANT VWMODE \ Access VDP write address sub-routine
61+
' VC@ 2 CELLS + @ CONSTANT VRMODE \ Access VDP read address sub-routine
62+
63+
8800 CONSTANT VDPRD \ vdp ram read data port
64+
8C00 CONSTANT VDPWD \ vdp ram write data port
65+
66+
\ : VOR ( c Vaddr -- ) DUP>R VC@ OR R> VC! ;
67+
CODE VOR ( c Vaddr -- )
68+
VRMODE @@ BL, \ set read address, disables Interrupts
69+
W CLR,
70+
VDPRD @@ W MOVB, \ read screen data to W
71+
W SWPB,
72+
*SP+ W SOC, \ OR C on stack with screen data
73+
W SWPB,
74+
VWMODE @@ BL, \ set the address for writing
75+
W VDPWD @@ MOVB, \ write back to screen
76+
TOS POP,
77+
2 LIMI,
78+
NEXT,
79+
ENDCODE
80+
81+
\ : VAND ( c Vaddr -- ) S" DUP>R VC@ AND R> VC!" EVALUATE ; IMMEDIATE
82+
\ : VERASE ( c Vaddr -- ) >R INVERT R> VAND ;
83+
84+
CODE VERASE ( c Vaddr -- )
85+
VRMODE @@ BL, \ set read address
86+
W CLR,
87+
VDPRD @@ W MOVB, \ read screen data to W
88+
W SWPB,
89+
*SP+ W SZC, \ AND C on stack with screen data
90+
W SWPB,
91+
VWMODE @@ BL, \ set the address for writing
92+
W VDPWD @@ MOVB, \ write back to screen
93+
2 LIMI,
94+
TOS POP,
95+
NEXT,
96+
ENDCODE
97+
98+
\ PENCIL and ERASER are "execution tokens"
99+
' VOR CONSTANT PENCIL
100+
' VERASE CONSTANT ERASER
101+
102+
VARIABLE STYLUS \ usage: PENCIL STYLUS ! ERASER STYLUS !
103+
104+
\ setup VDP code ...
105+
: GRAPHICS2
106+
0000 TO CTAB \ color table
107+
1800 TO IMG \ "name" table (TI nomenclature)
108+
2000 TO PDT \ pattern descriptor table
109+
110+
0A0 1 VWTR \ VR1 >A0 16K, screen on
111+
INIT-IMAGE
112+
F 0 COLOR \ white on transparent
113+
CLEAR
114+
20 C/L! 300 C/SCR !
115+
2 0 VWTR \ VR0 >02 Bitmap mode on
116+
6 2 VWTR \ Screen image = 6*>400 = 1800
117+
07F 3 VWTR \ Color table at >0000
118+
7 4 VWTR \ PATTERN table= VR4*>800 = 2000
119+
70 5 VWTR \ sprite attribute table: VR5*>80 = >3800
120+
7 6 VWTR \ sprite pattern table: VR6 * >800 = >3800
121+
F1 7 VWTR \ screen background colour white on transparent
122+
0E0 DUP VDPR1 C! 1 VWTR \ set mode, copy into memory for system
123+
4 VMODE !
124+
0 837A C! ; \ highest sprite in auto-motion
125+
126+
127+
\ Compute offset into pattern table per:
128+
\ TI Video Display Processors, Programmer's Guide
129+
130+
CREATE BITS ( -- addr) 80 , 40 , 20 , 10 , 8 , 4 , 2 , 1 ,
131+
132+
\ =============================================
133+
\ PIXPOS Register usage
134+
\ R0 X offset
135+
\ R1 dup of Y coordinate
136+
\ R2 Temp Y quotient
137+
\ R3 Y coordinate
138+
\ R4 Forth Accumulator, outputs PDT address
139+
\ R8 = W = X division remainder
140+
141+
CODE PIXPOS ( x y -- bit Vaddr)
142+
\ mask x,y to 8 bit values
143+
TOS 00FF ANDI,
144+
*SP R0 MOV, \ get X into R0, leave stack position available
145+
R0 00FF ANDI,
146+
147+
\ calc X offset
148+
R0 W MOV, \ copy x to W
149+
R0 3 SRA, \ divide by 8
150+
R0 3 SLA, \ mult quot by 8. R0 = X offset
151+
R0 W SUB, \ sub-tract result -> W = remainder
152+
153+
\ convert remainder to bit mask
154+
W 1 SLA, \ W 2*
155+
BITS (W) *SP MOV, \ lookup bit value leave as 2nd on stack
156+
157+
\ calc Y offset
158+
TOS R1 MOV, \ DUP Y for subtraction later
159+
TOS 3 SRA, \ divide by 8 = Y quotient
160+
TOS R2 MOV, \ dup quotient result
161+
R2 3 SLA, \ mult quot by 8
162+
R2 R1 SUB, \ sub-tract result = remainder
163+
TOS SWPB, \ Y quotient 256*
164+
165+
\ compute pattern table address
166+
R1 TOS ADD, \ add remainder to quotient
167+
R0 TOS ADD, \ add X offset to Y offset
168+
TOS PDT AI, \ add index to pattern table base address
169+
NEXT,
170+
ENDCODE
171+
172+
\ TEXT macro for speed
173+
: PLOT ( x y -- ) S" PIXPOS STYLUS PERFORM " EVALUATE ; IMMEDIATE
174+
175+
\ ====================================
176+
\ line drawing
177+
DECIMAL
178+
: 2ROT ( d1 d2 d3 -- d2 d3 d1) S" 2>R 2SWAP 2R> 2SWAP" EVALUATE ; IMMEDIATE
179+
: 4DUP ( d1 d2 -- d1 d2 d1) S" 4TH 4TH 4TH 4TH" EVALUATE ; IMMEDIATE
180+
181+
HEX
182+
\ manual tail call optimizer. Improves LINE by 1.5%
183+
CODE GOTO C259 , ( *IP IP MOV,) NEXT, ENDCODE
184+
: -; ( -- )
185+
HERE 2- @ >BODY \ get previous XT, compute data field
186+
-2 ALLOT \ erase the previous XT
187+
POSTPONE GOTO , \ compile the address for GOTO
188+
POSTPONE [ \ turn off compiler
189+
REVEAL
190+
?CSP
191+
; IMMEDIATE
192+
193+
: LINE ( x1 y1 x2 y2 -- )
194+
\ ANS version of Dr. Ting's recursive line R.I.P.
195+
4DUP ROT - ABS >R - ABS R>
196+
MAX 2 <
197+
IF 2DROP PLOT EXIT THEN
198+
4DUP ROT + 1+ 2/ >R
199+
+ 1+ 2/ R>
200+
2DUP 2ROT
201+
RECURSE RECURSE -;
202+
203+
0 VALUE x
204+
0 VALUE y
205+
206+
: MOVETO ( x y -- ) TO y TO x ;
207+
: LINETO ( x y -- ) 2DUP x y LINE MOVETO ;
208+
209+
\ no safety net !!
210+
: HLINE ( x y len ) >R MOVETO R> 0 DO x I + y PLOT LOOP ;
211+
: VLINE ( x y len ) >R MOVETO R> 0 DO y x I + PLOT LOOP ;
212+

LIB.ITC/MULTIMODE.FTH

Lines changed: 43 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,9 @@
11
\ multicolor.fth for Camel99 Forth 2024 Brian Fox
22
\ based on code from TI-Forth
33

4+
INCLUDE DSK1.TOOLS
5+
INCLUDE DSK1.ASM9900
6+
47
NEEDS CHARSET FROM DSK1.CHARSET
58
HERE
69

@@ -139,15 +142,51 @@ CODE 4DUP ( a b c d -- a b c d a b c d)
139142
NEXT, \ TOTAL 142
140143
ENDCODE
141144

145+
HEX
146+
\ : DXY ( x y x2 y2 -- dY dX) ROT - ABS -ROT - ABS ;
147+
CODE DXY? ( x y x2 y2 -- ?)
148+
R0 POP, \ X2
149+
R1 POP, \ Y
150+
R2 POP, \ X
151+
TOS PUSH, \ Y2->*SP
152+
R2 TOS MOV, \ X->TOS
153+
154+
R0 TOS SUB, \ x2 x -
155+
TOS ABS, \ abs(dx)
156+
157+
R1 *SP SUB, \ y2-y
158+
*SP ABS, \ abs(dy)
159+
\ MAX
160+
*SP TOS CMP,
161+
LO IF, SP INCT,
162+
ELSE, TOS POP,
163+
ENDIF,
164+
\ 2 <
165+
TOS 2 CI,
166+
LO IF, TOS SETO,
167+
ELSE, TOS CLR,
168+
ENDIF,
169+
NEXT,
170+
ENDCODE
171+
172+
\ : MID + 1+ 2/ \ compute mid points
173+
\ + 1+ 2/ R>
174+
175+
CODE MID ( x1 y1 x2 y2 -- n )
176+
A136 , \ *SP+ TOS ADD, \ +
177+
0584 , \ TOS INC, \ 1+
178+
0814 , \ TOS 1 SRA, \ 2/
179+
NEXT,
180+
ENDCODE
181+
142182
DECIMAL
143183
: LINE ( x1 y1 x2 y2 -- )
144184
\ ANS version of Dr. Ting's recursive line. R.I.P.
145-
4DUP ROT - ABS -ROT - ABS \ compute dx dy
146-
MAX 2 < IF 2DROP MM.PLOT EXIT THEN \ nothing do, get out
185+
4DUP ( DXY MAX 2 <)
186+
DXY? IF 2DROP MM.PLOT EXIT THEN
147187

148188
4DUP ROT
149-
+ 1+ 2/ >R \ compute mid points
150-
+ 1+ 2/ R>
189+
MID >R MID R>
151190
2DUP 2ROT RECURSE RECURSE ;
152191

153192
: MOVETO ( x y -- ) S" AT-XY" EVALUATE ; IMMEDIATE ( alias)

0 commit comments

Comments
 (0)