Created
January 3, 2012 14:57
-
-
Save fancypantalons/1555228 to your computer and use it in GitHub Desktop.
Extremely basic raytracer written in a Pascal-like language called Pal. This was a test input I came up with for a toy compiler I helped write during my compiler class back in the day.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{ | |
Simple sphere raytracer which uses a Phong + diffuse lighting model | |
for sphere shading. Implements the basic recursive raytracing | |
algorithm with simple reflection. Also implements a checkerboard | |
floor. No refraction, though... ;) | |
Produces a TGA image in a file called "fourout". Rename to | |
"fourout.tga" to view. | |
BTW, this thing pushes the memory limits of the ASC machine. The | |
175x175 image takes up 30k of memory, leaving only 7k for the | |
tracing process. Compilers which aren't that frugal with memory may | |
have problems (although ours works fine, and it's a pig :). | |
} | |
program prog(input, fourout); | |
const imgWidth = 175; | |
imgHeight = 175; | |
{ Sphere attributes } | |
sphereX = 0.0; | |
sphereY = 0.0; | |
sphereZ = 2.0; | |
radius = 1.0; | |
phongk = 192; { Phong scaling constant } | |
phongpow = 96; { Phong fudge factor; higher == sharper highlight } | |
ambient = 96; | |
reflection = 0.95; { Lower values == more reflective } | |
{ Plane attributes } | |
planepow = 768; { Ambient value for plane } | |
planedist = -5.0; { Distance along the Y-axis } | |
{ Light attributes } | |
lightX = 1.5; | |
lightY = 2.0; | |
lightZ = -7.0; | |
type object = (Sphere, Plane, None); | |
image = array[1..imgWidth, 1..imgHeight] of integer; | |
imageptr = ^image; | |
vector = record | |
x : real; | |
y : real; | |
z : real | |
end; | |
var img : imageptr; | |
light : vector; | |
center : vector; | |
planenorm : vector; | |
view : vector; | |
{ **************** Misc Math Functions **************** } | |
{ Pretty obvious what these all do, I think... } | |
function abs(x : real) : real; | |
begin | |
if (x < 0) then | |
abs := -x | |
else | |
abs := x | |
end; | |
function sqrt(m : real) : real; | |
var e, guess, nextguess : real; | |
begin | |
e := 1.0E-9; | |
guess := 0; | |
nextguess := m / 2; | |
while (abs(nextguess - guess) > e) do | |
begin | |
guess := nextguess; | |
nextguess := (guess + m / guess) / 2 | |
end; | |
sqrt := nextguess | |
end; | |
function pow(base : real; exp : integer) : real; | |
var result : real; | |
i : integer; | |
begin | |
i := exp; | |
result := 1; | |
while (i > 0) do | |
begin | |
result := result * base; | |
i := i - 1 | |
end; | |
pow := result | |
end; | |
{ ****************** Vector Functions ****************** } | |
{ These should all be pretty self explanatory as well... } | |
function vsub(a : vector; b : vector) : vector; | |
var result : vector; | |
begin | |
result.x := a.x - b.x; | |
result.y := a.y - b.y; | |
result.z := a.z - b.z; | |
vsub := result | |
end; | |
function vadd(a : vector; b : vector) : vector; | |
var result : vector; | |
begin | |
result.x := a.x + b.x; | |
result.y := a.y + b.y; | |
result.z := a.z + b.z; | |
vadd := result | |
end; | |
function vdot(a : vector; b : vector) : real; | |
begin | |
vdot := a.x * b.x + a.y * b.y + a.z * b.z | |
end; | |
function vscale(a : vector; l : real) : vector; | |
var result : vector; | |
begin | |
result.x := a.x * l; | |
result.y := a.y * l; | |
result.z := a.z * l; | |
vscale := result | |
end; | |
function vlength(a : vector) : real; | |
begin | |
vlength := sqrt(a.x * a.x + a.y * a.y + a.z * a.z) | |
end; | |
procedure vnormalize(var a : vector); | |
var len : real; | |
begin | |
len := vlength(a); | |
a.x := a.x / len; | |
a.y := a.y / len; | |
a.z := a.z / len | |
end; | |
{ ****************** Image Functions ****************** } | |
{ | |
initImage - Fills provided image with black pixels. | |
} | |
procedure initImage(img : imageptr); | |
var x, y : integer; | |
begin | |
x := 1; | |
while (x <= imgWidth) do | |
begin | |
y := 1; | |
while (y <= imgHeight) do | |
begin | |
img^[x][y] := 0; | |
y := y + 1 | |
end; | |
x := x + 1 | |
end | |
end; | |
{ | |
writeTGAHeader - Dump a TGA header for a 24-bit RGB image. | |
} | |
procedure writeTGAHeader(); | |
begin | |
write(chr(0)); | |
write(chr(0)); | |
write(chr(2)); | |
write(' '); | |
write(chr(0)); | |
write(chr(0)); | |
write(chr(0)); | |
write(chr(0)); | |
write(chr(imgWidth)); | |
write(chr(0)); | |
write(chr(imgHeight)); | |
write(chr(0)); | |
write(chr(24)); | |
write(chr(0)) | |
end; | |
{ | |
outputImage - Take an image and write it to standard out. Dump | |
bottom-to-top, right-to-left, since that's what TGA | |
expects. | |
} | |
procedure outputImage(img : imageptr); | |
var x, y : integer; | |
begin | |
y := imgHeight; | |
writeTGAHeader; | |
while (y > 0) do | |
begin | |
x := imgWidth; | |
while (x > 0) do | |
begin | |
write(chr(img^[x, y])); | |
write(chr(img^[x, y])); | |
write(chr(img^[x, y])); | |
x := x - 1 | |
end; | |
y := y - 1 | |
end | |
end; | |
{ ****************** Drawing Core ****************** } | |
{ | |
getIntersection | |
Takes the viewing position and direction vector, and computes the | |
parameter 't', which describes the distance along the direction | |
vector to the closest intersection. It then returns an enumerated | |
type which represents the surface which was intersected. | |
} | |
function getIntersection(view : vector; | |
dir : vector; | |
var t : real) : object; | |
var t1, t2 : real; | |
{ | |
getSphereIntersection | |
Takes the viewing position and direction vector, and computes the | |
parameter 't' which represents the distances along the direction | |
vector to the closest intersection with the sphere. | |
} | |
function getSphereIntersection(view : vector; | |
dir : vector) : real; | |
var A : real; | |
B : real; | |
C : real; | |
D : real; | |
E : real; | |
t1, t2 : real; | |
begin | |
t1 := 0; | |
t2 := 0; | |
A := 2 * (view.x - center.x) * dir.x + | |
2 * (view.y - center.y) * dir.y + | |
2 * (view.z - center.z) * dir.z; | |
B := dir.x * dir.x + | |
dir.y * dir.y + | |
dir.z * dir.z; | |
C := (view.x - center.x) * (view.x - center.x) + | |
(view.y - center.y) * (view.y - center.y) + | |
(view.z - center.z) * (view.z - center.z); | |
D := C - radius * radius; | |
E := A * A - 4 * B * D; | |
if (E < 0) then | |
getSphereIntersection := -1 | |
else | |
begin | |
t1 := -A + sqrt(E) / (2 * B); | |
t2 := -A - sqrt(E) / (2 * B); | |
if (t1 < t2) then | |
getSphereIntersection := t1 | |
else | |
getSphereIntersection := t2 | |
end | |
end; | |
{ | |
getPlaneIntersection | |
Takes the viewing position and direction vector and computes the | |
parameter 't', which represents the distance along the direction | |
vector to the point of intersection with the plane. | |
} | |
function getPlaneIntersection(view : vector; | |
dir : vector) : real; | |
var A : real; | |
B : real; | |
t : real; | |
begin | |
A := planenorm.x * view.x + | |
planenorm.y * view.y + | |
planenorm.z * view.z; | |
B := planenorm.x * dir.x + | |
planenorm.y * dir.y + | |
planenorm.z * dir.z; | |
t := -(A + planedist) / B; | |
{ Need to clamp upper bound to prevent rendering artifacts. } | |
if (t > maxint) then | |
t := maxint; | |
getPlaneIntersection := t | |
end; | |
begin | |
t1 := getSphereIntersection(view, dir); | |
t2 := getPlaneIntersection(view, dir); | |
if ((t1 < 0) and (t2 < 0)) then | |
getIntersection := None | |
else if ((t1 < 0) and (t2 >= 0)) then | |
begin | |
t := t2; | |
getIntersection := Plane | |
end | |
else if ((t2 < 0) and (t1 >= 0)) then | |
begin | |
t := t1; | |
getIntersection := Sphere | |
end | |
else if (t1 < t2) then | |
begin | |
t := t1; | |
getIntersection := Sphere | |
end | |
else | |
begin | |
t := t2; | |
getIntersection := Plane | |
end | |
end; | |
{ | |
planeTexture | |
Simple function to compute the base color of the plane at a given | |
point. Generates a simple checkerboard pattern. | |
} | |
function planeTexture(p : vector) : real; | |
var x, z : integer; | |
black : boolean; | |
begin | |
p.x := p.x / 4; | |
p.z := p.z / 2; | |
if (p.x < 0) then | |
p.x := abs(p.x + 10); | |
x := trunc(p.x); | |
if (p.z < 0) then | |
p.z := abs(p.z + 10); | |
z := trunc(p.z); | |
black := ((x mod 2 = 0) or (z mod 2 = 0)) and | |
(not (x mod 2 = 0) or not (z mod 2 = 0)); | |
if (black) then | |
planeTexture := planepow / 2 | |
else | |
planeTexture := planepow | |
end; | |
{ | |
getIntensity | |
This function is the recursive part of the algorithm. Takes the | |
viewing position and direction as parameters, computes the first | |
intersection along the ray direction, and then calculates the | |
intensity at that point. In the case of the sphere, the process of | |
calculating the intensity includes a recursive call to check the | |
reflected ray. The result of this call is then combined with the | |
intensity of the point on the surface to produce the final intensity. | |
} | |
function getIntensity(view : vector; dir : vector) : integer; | |
var i, n, l, v, p, dirout : vector; | |
intensity : real; | |
t : real; | |
obj : object; | |
refintensity : real; | |
begin | |
obj := getIntersection(view, dir, t); | |
if (obj = Sphere) then | |
begin | |
p := vscale(dir, t); | |
n := vsub(p, center); | |
vnormalize(n); | |
l := vsub(light, p); | |
vnormalize(l); | |
v := vsub(view, p); | |
vnormalize(v); | |
i := vsub(l, vscale(l, 2 * vdot(l, n))); | |
vnormalize(i); | |
intensity := phongk * pow(vdot(v, i), phongpow); | |
dirout := vsub(v, vscale(n, 2 * vdot(v, n))); | |
vnormalize(dirout); | |
refintensity := getIntensity(p, dirout); | |
intensity := intensity * reflection + | |
refintensity * (1 - reflection) - | |
vdot(l, n) * ambient; | |
if (intensity < 0) then | |
intensity := 0; | |
if (intensity > 255) then | |
intensity := 255; | |
getIntensity := trunc(intensity) | |
end | |
else if (obj = Plane) then | |
begin | |
p := vscale(dir, t); | |
n := planenorm; | |
vnormalize(n); | |
l := vsub(light, p); | |
vnormalize(l); | |
intensity := -vdot(n, l) * planeTexture(p); | |
if (intensity < 0.0) then | |
intensity := 0.0; | |
getIntensity := trunc(intensity) | |
end | |
else | |
getIntensity := 0 | |
end; | |
{ | |
drawImage | |
The main loop in the code. Loops through the points in the image | |
plane, generates a ray, and computes the intensity of the point. | |
} | |
procedure drawImage(img : imageptr); | |
var x, y : real; | |
psx, psy, pex, pey, pw, ph : real; | |
dir : vector; | |
begin | |
y := 1; | |
ph := 2 * y; | |
x := y / (imgWidth / imgHeight); | |
pw := 2 * x; | |
psx := -x; | |
psy := -y; | |
pex := x; | |
pey := y; | |
y := 1; | |
while (y <= imgHeight) do | |
begin | |
x := 1; | |
while (x <= imgWidth) do | |
begin | |
dir.x := psx + pw * ((x - 1) / imgWidth); | |
dir.y := psy + ph * ((y - 1) / imgHeight); | |
dir.z := 1; | |
vnormalize(dir); | |
img^[trunc(x), trunc(y)] := getIntensity(view, dir); | |
x := x + 1 | |
end; | |
y := y + 1 | |
end | |
end; | |
{ Here we initialize the basic components and then start the tracer. } | |
begin | |
view.x := 0; | |
view.y := 0; | |
view.z := 0; | |
light.x := lightX; | |
light.y := lightY; | |
light.z := lightZ; | |
center.x := sphereX; | |
center.y := sphereY; | |
center.z := sphereZ; | |
planenorm.x := 0.0; | |
planenorm.y := 1.0; | |
planenorm.z := 0.0; | |
new(img); | |
initImage(img); | |
drawImage(img); | |
outputImage(img) | |
end. |
Huh, I just noticed I never got around to implementing shadows (when calculating light intensity at a point, I should be casting back a ray to the light source and testing for any intersections).
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
If it wasn't obvious, this thing isn't a general-purpose raytracer by any means. It's structure to do one thing and one thing only: render a reflective sphere, with phong highlights, on a non-reflective checkered plane. Making the plane recursive would be an interesting addition (thus better demonstrating the recursive nature of a basic raytracer), but I don't believe the default Asc stack (the toy stack machine the Pal compiler targeted) was big enough to make that possible...