'===========================================================================
' Subject: REAL-TIME ITERATIVE RAYTRACER     Date: 10-20-98 (19:08)       
' Author:  Daniel Davies                     Code: QB, QBasic, PDS        
' Origin:  ia53@rapid.co.uk                Packet: GRAPHICS.ABC
'===========================================================================
'REAL TIME ITERATIVE RAYTRACER WITH PROCEDURAL TEXTURE
'by Daniel Davies
'
'e-mail   :- ia53@rapid.co.ul
'web site :- www.users.rapid.net.uk/ia53/
'ICQ #    :- 10620663
'
'This raytracer renders a single small sphere, with a procedural texture,
'and rotates the light source around the object,
'all of the functions are for generating procedural textures
'although two textures are defined only one is used, the other was just as a
'test.
'This program benefits greatly from being compiled,
'compiled it runs at 2.5fps on a p200
'uncompiled in q-basic it runs at .2fps on the same system.

DECLARE FUNCTION stripe# (a#)        'procedural stripe texture
DECLARE FUNCTION marble# (x#, y#, z#) 'procedural marble
DECLARE FUNCTION noise# (x#, y#, z#) '3d Perlin noise function
                                     'x#,y#,z# are a point in space to return
                                     'noise value for.
DECLARE FUNCTION turbulance# (x#, y#, z#, at#)
                                     '3d perlin noise function with
                                     'turbulance
                                     'x#,y#,z# are the point in space
                                     'at# is the amount of turbulance
                                     'and should be less than 1
                                     'lower values give more turbulance

TYPE point3d
 x AS DOUBLE
 y AS DOUBLE
 z AS DOUBLE
END TYPE
DIM dir AS point3d
DIM cur AS point3d
DIM light AS point3d
DIM normal AS point3d
DIM buffer(-20 TO 20, -20 TO 20) AS INTEGER

SCREEN 13

radian = (3.141592653# / 180) * 5
'set up palette
OUT 968, 0
FOR x% = 0 TO 255
OUT 969, x% \ 4
OUT 969, x% \ 4
OUT 969, x% \ 4
NEXT x%

angle% = 90
st# = TIMER
DO
f% = f% + 1
angle% = angle% + 5
 light.x = SIN(angle% * (3.141593 / 180))
 light.y = -.75
 light.z = COS(angle% * (3.141593 / 180))
 length# = SQR((light.x ^ 2) + (light.y ^ 2) + (light.z ^ 2))
 light.x = light.x / length#
 light.y = light.y / length#
 light.z = light.z / length#

'main raytracing bit
FOR x% = -20 TO 20

 FOR y% = -20 TO 20
 IF (x% * x%) + (y% * y%) <= 385 THEN
 'set direction of ray
 dir.x = x% / 4
 dir.y = y% / 4
 dir.z = 255
 'normalize direction of ray (i.e. give the direction vector
 'a length of 1)
 length# = (dir.x * dir.x) + (dir.y * dir.y) + (dir.z * dir.z)
 length# = SQR(length#)
 dir.x = dir.x / length#
 dir.y = dir.y / length#
 dir.z = dir.z / length#
 'now to follow the ray until it hits something
 hit% = 0
 fail% = 0
 cur.x = x%
 cur.y = y%
 cur.z = 0
 ray& = 0
 DO
 cur.x = cur.x + dir.x
 cur.y = cur.y + dir.y
 cur.z = cur.z + dir.z

'test for an intersection
cz# = cur.z - 21
IF (cur.x * cur.x) + (cur.y * cur.y) + (cz# * cz#) <= 400 THEN hit% = 1

LOOP UNTIL hit% = 1

 normal.x = cur.x
 normal.y = cur.y
 normal.z = cur.z - 21
 length# = SQR((normal.x ^ 2) + (normal.y ^ 2) + (normal.z ^ 2))
 normal.x = normal.x / length#
 normal.y = normal.y / length#
 normal.z = normal.z / length#

 dp# = (normal.x * light.x) + (normal.y * light.y) + (normal.z * light.z)
 diffuse# = (.7 * dp#)
 
 specular# = .5 * (dp#) ^ 50
 IF diffuse# < 0 THEN diffuse# = 0
 shade# = diffuse# + .075
 
 IF shade# > 1 THEN colour# = 1


tex# = marble#(cur.x, cur.y, cur.z)
IF tex% > 255 THEN tex# = 255

c% = shade# * tex#
                  



 IF c% > 255 THEN c% = 255
 buffer(x%, y%) = c%

 
 END IF

 NEXT y%
NEXT x%

IF scale% = 0 THEN
 FOR y% = -20 TO 20
 FOR x% = -20 TO 20
 PSET (x% + 160, y% + 100), buffer(x%, y%)
 NEXT x%
 NEXT y%
END IF

LOOP WHILE INKEY$ = ""
et# = TIMER
quit:
IF et# = 0 THEN et# = TIMER

SCREEN 0
WIDTH 80
PRINT "ARCLIGHTS REAL TIME ITERATIVE RAY-TRACER"
PRINT "INCLUDING PROCEDURAL TEXTURING"
PRINT "IN Q-BASIC"
PRINT "e-mail : ia53@rapid.co.uk"
PRINT "web : www.users.rapid.net.uk/ia53/"
PRINT "ICQ : 10620663"
PRINT
PRINT "time taken            ";
time# = et# - st#
PRINT USING "##.####"; time#
PRINT "frames drawn          "; f%
PRINT "frame rate            ";
PRINT USING "##.####"; (f% / time#);
PRINT " FPS"

FUNCTION marble# (x#, y#, z#)
g# = 175 + (80 * COS(y# + (5 * turbulance#(x#, y#, z#, 1))))

marble# = g#
END FUNCTION

FUNCTION noise# (x#, y#, z#)
'generates noise using mathematical functions

sine1# = -(4.3 * SIN(x# * 16))
sine2# = -(9.9 * SIN(x# * 6))
sine3# = -(10.1 * SIN(y# * 13))
sine4# = (6.25 * SIN(y# * 5))
sine5# = (8.3 * SIN(z# * 23))
sine6# = -(3.74 * SIN(z# * 27))

noise# = (sine1# + sine2# + sine3# + sine4# + sine5# + sine6#) / 41

END FUNCTION

FUNCTION stripe# (a#)
stripe# = 175 + (80 * COS(a#))
END FUNCTION

FUNCTION turbulance# (x#, y#, z#, at#)

t# = 0 'starting value for turbulance
s# = 1 'scale

DO
t# = t# + (ABS(noise(x# / s#, y# / s#, z# / s#) * s#))
s# = s# / 2
LOOP UNTIL (s# <= at#)

turbulance# = t#

END FUNCTION