More ray tracing in BASIC

More ray tracing

5  POKE65495,0:PMODE 4,1:PCLS:SCREEN1,1
10 SP = 2:O = 0:P = 0.5: DIM C(SP,3),R(SP),Q(SP)
20  FOR K = 1 TO SP: READ C(K,1),C(K,2),C(K,3),T:R(K) = T:Q(K) = T * T: NEXT K
30  DATA -0.3,-0.8,3,0.6
40  DATA 0.9,-1.1,2,0.2
50  FOR I = 0 TO 191: FOR J = 0 TO 255
70 X = 0.3:Y =  - 0.5:Z = 0:DX = J - 128:DY = I - 96
72 DZ = 300:DD = DX * DX + DY * DY + DZ * DZ
100 N =  - 1: IF Y <  = O AND DY > O THEN N = 0:S =  - Y / DY
110  FOR K = 1 TO SP:PX = C(K,1) - X:PY = C(K,2) - Y:PZ = C(K,3) - Z
140 SC = PX * DX + PY * DY + PZ * DZ
150  IF SC <  = O GOTO 200
155 PP = PX * PX + PY * PY + PZ * PZ
160 BB = SC * SC / DD:AA = Q(K) - PP + BB
180  IF AA <  = O GOTO 200
190 SC = ( SQR (BB) -  SQR (AA)) /  SQR (DD): IF SC < S OR N < O THEN N = K:S = SC
200  NEXT K: IF N < 0 GOTO 350
220 DX = DX * S:DY = DY * S:DZ = DZ * S:DD = DD * S * S:X = X + DX:Y = Y + DY:Z = Z + DZ
240  IF N = O GOTO 300
250 NX = X - C(N,1):NY = Y - C(N,2):NZ = Z - C(N,3)
270 L = 2 * (DX * NX + DY * NY + DZ * NZ) / Q(N)
280 DX = DX - NX * L:DY = DY - NY * L:DZ = DZ - NZ * L: GOTO 100
300  FOR K = 1 TO SP:U = C(K,1) - X:V = C(K,3) - Z: IF U * U + V * V <  = Q(K) GOTO 350
320  NEXT K
330  IF ((X -  INT (X)) > P) <  > ((Z -  INT (Z)) > P) THEN  PSET(J,I)
350  NEXT J,I
360  GOTO 360

 

 

 

More BASIC

Version for all Color Computers:
0 POKE65495,0:PCLEAR4:PMODE 4,1:PCLS1:SCREEN 1,0

1 B=0:A=0:I=0:PI=3.141592

10 FOR I=0 TO 2*PI STEP PI/180

20 FOR A=0 TO 7:FOR B=0 TO 7

30 PRESET(44+21*A+10*SIN((A+1)*I),175-(14+21*B-10*COS((B+1)*I)))

40 NEXT B:NEXT A:NEXT I

50 GOTO 50

CoCo 3 version with math patch and a few optimizations:

0 POKE65497,0:PCLEAR4:PMODE 4,1:PCLS1:SCREEN 1,0

1 AD=VAL("&HFA0C")

2 FORI=0 TO 64:READ B$:A=VAL("&H"+B$)

3 POKE AD+I,A:NEXT

REM $BB00 JMP $FA0C

4 POKE VAL("&HBB02"),VAL("&H7E"):POKE VAL("&HBB03"),VAL("&HFA"):POKE VAL("&HBB04"),VAL("&H0C")

5 B=0:A=0:I=0:PI=3.141592

10 FOR I=0 TO 2*PI STEP PI/180

20 FOR A=0 TO 7:FOR B=0 TO 7

30 PRESET(44+21*A+10*SIN((A+1)*I),175-(14+21*B-10*COS((B+1)*I)))

40 NEXT B:NEXT A:NEXT I

50 GOTO 50

1000 DATA 32,79,E7,60,96,60,3D,ED,63,E6,60,96,5E,3D,ED,61,E6,60,96,5D

1001 DATA 3D,ED,65,E6,60,96,5F,3D,E3,62,ED,62,EC,65,E9,61,89,00,ED,60

1002 DATA EC,63,D3,15,97,16,D7,63,EC,61,D9,14,99,13,DD,14,A6,60,89,00

1003 DATA 97,13,32,67,39

Fractal in BASIC for the CoCo 3

And a good old fractal program I ported a year and a half ago. 

Most of these I did just to show how much faster BASIC would have been if Microsoft had used the 6809 multiply instruction for the floating point multiply.  The patch uses the stack for temporary storage, and the code would be even faster if temporary variables had been placed on the direct page... but I didn't want to take the time to learn what I could or could not use by studying the ROM disassembly.  I've spent enough time rewriting the MC-10 ROM already.

1 POKE 65497,0

2 AD=VAL("&HFA0C")

3 FORI=0 TO 64:READ B$:A=VAL("&H"+B$)

4 POKE AD+I,A:NEXT

REM $BB00 JMP $FA0C

5 POKE VAL("&HBB02"),VAL("&H7E"):POKE VAL("&HBB03"),VAL("&HFA"):POKE VAL("&HBB04"),VAL("&H0C")

7 FOR I = 0 to 15:PALETTE I,I:NEXT I

10 HGR2

10 HSCREEN 2 : HCOLOR 1,3

20 XC = -0.5 : REM CENTER COORD X

30 YC = 0 : REM " " Y

40 S = 2 : REM SCALE

45 IT = 20 : REM ITERATIONS

50 XR = S * (280 / 192): REM TOTAL RANGE OF X

50 XR = S * (320 / 192): REM TOTAL RANGE OF X

60 YR = S : REM " " " Y

70 X0 = XC - (XR/2) : REM MIN VALUE OF X

80 X1 = XC + (XR/2) : REM MAX " " X

90 Y0 = YC - (YR/2) : REM MIN " " Y

100 Y1 = YC + (YR/2) : REM MAX " " Y

110 XM = XR / 279 : REM SCALING FACTOR FOR X

110 XM = XR / 319 : REM SCALING FACTOR FOR X

120 YM = YR / 191 : REM " " " Y

130 FOR YI = 0 TO 3 : REM INTERLEAVE

140 FOR YS = 0+YI TO 188+YI STEP 4 : REM Y SCREEN COORDINATE

145 HCOLOR=3 : HPLOT 0,YS TO 279,YS

145 HLINE(0,YS)-(319,YS),PRESET

150 FOR XS = 0 TO 278 STEP 2 : REM X SCREEN COORDINATE

150 FOR XS = 0 TO 318 STEP 2 : REM X SCREEN COORDINATE

170 X = XS * XM + X0 : REM TRANSL SCREEN TO TRUE X

180 Y = YS * YM + Y0 : REM TRANSL SCREEN TO TRUE Y

190 ZX = 0

200 ZY = 0

210 XX = 0

220 YY = 0

230 FOR I = 0 TO IT

240 ZY = 2 * ZX * ZY + Y

250 ZX = XX - YY + X

260 XX = ZX * ZX

270 YY = ZY * ZY

280 C = IT-I

290 IF XX+YY >= 4 GOTO 301

300 NEXT I

301 IF C >= 8 THEN C = C - 8 : GOTO 301

301 IF C >= 16 THEN C = C - 16 : GOTO 301

310 HCOLOR = C : HPLOT XS, YS TO XS+1, YS

310 HCOLOR C:HLINE(XS, YS)-(XS+1, YS),PSET

320 NEXT XS

330 NEXT YS

340 NEXT YI

350 END

REM ROM PATCH 1 - 65 bytes

1000 DATA 32,79,E7,60,96,60,3D,ED,63,E6,60,96,5E,3D,ED,61,E6,60,96,5D

1001 DATA 3D,ED,65,E6,60,96,5F,3D,E3,62,ED,62,EC,65,E9,61,89,00,ED,60

1002 DATA EC,63,D3,15,97,16,D7,63,EC,61,D9,14,99,13,DD,14,A6,60,89,00

1003 DATA 97,13,32,67,39