Pascal Source Code
uses crt,graph;
type coords = record
x,y,z:integer;
end;
const maxnum=4250; {cannot be greater than 4465}
sin_vals:array[0..256] of Integer=
( 0 ,6 ,13 ,19 ,25 ,31 ,38 ,44 ,50 ,
56 ,62 ,68 ,74 ,80 ,86 ,92 ,98 ,
104 ,109 ,115 ,121 ,126 ,132 ,137 ,142 ,
147 ,152 ,157 ,162 ,167 ,172 ,177 ,181 ,
185 ,190 ,194 ,198 ,202 ,206 ,209 ,213 ,
216 ,220 ,223 ,226 ,229 ,231 ,234 ,237 ,
239 ,241 ,243 ,245 ,247 ,248 ,250 ,251 ,
252 ,253 ,254 ,255 ,255 ,256 ,256 ,256 ,
256 ,256 ,255 ,255 ,254 ,253 ,252 ,251 ,
250 ,248 ,247 ,245 ,243 ,241 ,239 ,237 ,
234 ,231 ,229 ,226 ,223 ,220 ,216 ,213 ,
209 ,206 ,202 ,198 ,194 ,190 ,185 ,181 ,
177 ,172 ,167 ,162 ,157 ,152 ,147 ,142 ,
137 ,132 ,126 ,121 ,115 ,109 ,104 ,98 ,
92 ,86 ,80 ,74 ,68 ,62 ,56 ,50 ,
44 ,38 ,31 ,25 ,19 ,13 ,6 ,0 ,
-6 ,-13 ,-19 ,-25 ,-31 ,-38 ,-44 ,-50 ,
-56 ,-62 ,-68 ,-74 ,-80 ,-86 ,-92 ,-98 ,
-104 ,-109 ,-115 ,-121 ,-126 ,-132 ,-137 ,-142 ,
-147 ,-152 ,-157 ,-162 ,-167 ,-172 ,-177 ,-181 ,
-185 ,-190 ,-194 ,-198 ,-202 ,-206 ,-209 ,-213 ,
-216 ,-220 ,-223 ,-226 ,-229 ,-231 ,-234 ,-237 ,
-239 ,-241 ,-243 ,-245 ,-247 ,-248 ,-250 ,-251 ,
-252 ,-253 ,-254 ,-255 ,-255 ,-256 ,-256 ,-256 ,
-256 ,-256 ,-255 ,-255 ,-254 ,-253 ,-252 ,-251 ,
-250 ,-248 ,-247 ,-245 ,-243 ,-241 ,-239 ,-237 ,
-234 ,-231 ,-229 ,-226 ,-223 ,-220 ,-216 ,-213 ,
-209 ,-206 ,-202 ,-198 ,-194 ,-190 ,-185 ,-181 ,
-177 ,-172 ,-167 ,-162 ,-157 ,-152 ,-147 ,-142 ,
-137 ,-132 ,-126 ,-121 ,-115 ,-109 ,-104 ,-98 ,
-92 ,-86 ,-80 ,-74 ,-68 ,-62 ,-56 ,-50 ,
-44 ,-38 ,-31 ,-25 ,-19 ,-13 ,-6 ,-0 )
cos_vals:array[0..256] of integer=
( 256 ,256 ,256 ,255 ,255 ,254 ,253 ,252 ,251 ,
250 ,248 ,247 ,245 ,243 ,241 ,239 ,237 ,
234 ,231 ,229 ,226 ,223 ,220 ,216 ,213 ,
209 ,206 ,202 ,198 ,194 ,190 ,185 ,181 ,
177 ,172 ,167 ,162 ,157 ,152 ,147 ,142 ,
137 ,132 ,126 ,121 ,115 ,109 ,104 ,98 ,
92 ,86 ,80 ,74 ,68 ,62 ,56 ,50 ,
44 ,38 ,31 ,25 ,19 ,13 ,6 ,0 ,
-6 ,-13 ,-19 ,-25 ,-31 ,-38 ,-44 ,-50 ,
-56 ,-62 ,-68 ,-74 ,-80 ,-86 ,-92 ,-98 ,
-104 ,-109 ,-115 ,-121 ,-126 ,-132 ,-137 ,-142 ,
-147 ,-152 ,-157 ,-162 ,-167 ,-172 ,-177 ,-181 ,
-185 ,-190 ,-194 ,-198 ,-202 ,-206 ,-209 ,-213 ,
-216 ,-220 ,-223 ,-226 ,-229 ,-231 ,-234 ,-237 ,
-239 ,-241 ,-243 ,-245 ,-247 ,-248 ,-250 ,-251 ,
-252 ,-253 ,-254 ,-255 ,-255 ,-256 ,-256 ,-256 ,
-256 ,-256 ,-255 ,-255 ,-254 ,-253 ,-252 ,-251 ,
-250 ,-248 ,-247 ,-245 ,-243 ,-241 ,-239 ,-237 ,
-234 ,-231 ,-229 ,-226 ,-223 ,-220 ,-216 ,-213 ,
-209 ,-206 ,-202 ,-198 ,-194 ,-190 ,-185 ,-181 ,
-177 ,-172 ,-167 ,-162 ,-157 ,-152 ,-147 ,-142 ,
-137 ,-132 ,-126 ,-121 ,-115 ,-109 ,-104 ,-98 ,
-92 ,-86 ,-80 ,-74 ,-68 ,-62 ,-56 ,-50 ,
-44 ,-38 ,-31 ,-25 ,-19 ,-13 ,-6 ,0 ,
6 ,13 ,19 ,25 ,31 ,38 ,44 ,50 ,
56 ,62 ,68 ,74 ,80 ,86 ,92 ,98 ,
104 ,109 ,115 ,121 ,126 ,132 ,137 ,142 ,
147 ,152 ,157 ,162 ,167 ,172 ,177 ,181 ,
185 ,190 ,194 ,198 ,202 ,206 ,209 ,213 ,
216 ,220 ,223 ,226 ,229 ,231 ,234 ,237 ,
239 ,241 ,243 ,245 ,247 ,248 ,250 ,251 ,
252 ,253 ,254 ,255 ,255 ,256 ,256 ,256 );
var gd,gm,numverts,d,loop,loop2,s,xo,yo,numfaces,stepx,stepy,stepz:integer;
x,y,z,x1,y1,z1,xang,yang,zang,sxa,sya,cxa,cya,number,sza,cza :real;
z3:extended;
dist:longint;
PNTS,pnt:array[0..maxnum] of coords;{Here I'm using my variable type
definition.}
col:array[1..maxnum] of integer;
ch:char;
rand,rand2:Integer;
function ozsin(x:real):real;
begin;
ozsin := (sin_vals[round(x)])/256;
end;
function ozcos(x:real):real;
begin;
ozcos := (cos_vals[round(x)])/256;
end;
Procedure VWait; assembler;
Asm
@@vwait:
mov dx,3DAH
in ax,dx
and ax,8H
or ax,ax
jnz @@vwait
end;
procedure modelTwistandCurl;
var loop2,count:integer;
begin;
loop:=0;
loop2:=0;
count:=0;
repeat
loop:=loop+1;
loop2:=0;
repeat
loop2:=loop2+1;
count:=count+1;
sxa := 500 * sin(loop2/10) * cos(loop/10);
sya := 500 * cos(loop2/10) * cos(loop/10);
sza := 500 * sin(loop/10) * (loop2/10);
pnt[count].x:=round(sxa); {This is an example of how my variable}
pnt[count].y:=round(sya); {type definition is used.}
pnt[count].z:=round(sza);
until loop2=64;
until loop=64;
numverts:=count;
end;
procedure modelSphere;
var loop2,count:integer;
begin;
loop:=0;
loop2:=0;
count:=0;
repeat
loop:=loop+1;
loop2:=0;
repeat
loop2:=loop2+1;
count:=count+1;
sxa := 500 * cos(loop2/10) * cos(loop/10);
sya := 500 * cos(loop2/10) * sin(loop/10);
sza := 500 * sin(loop2/10);
pnt[count].x:=round(sxa); {This is an example of how my variable}
pnt[count].y:=round(sya); {type definition is used.}
pnt[count].z:=round(sza);
until loop2=64;
until loop=64;
numverts:=count;
end;
procedure modelTorus;
var loop2,count:integer;
begin;
loop:=0;
loop2:=0;
count:=0;
repeat
loop:=loop+1;
loop2:=0;
repeat
loop2:=loop2+1;
count:=count+1;
sxa := 500 * (2 + cos(loop2/10)) * cos(loop/10);
sya := 500 * (2 + cos(loop2/10)) * sin(loop/10);
sza := 500 * sin(loop2/10);
pnt[count].x:=round(sxa); {This is an example of how my variable}
pnt[count].y:=round(sya); {type definition is used.}
pnt[count].z:=round(sza);
until loop2=64;
until loop=64;
numverts:=count;
end;
procedure modelTube;
var loop2,count:integer;
begin;
loop:=0;
loop2:=0;
count:=0;
repeat
loop:=loop+1;
loop2:=0;
repeat
loop2:=loop2+1;
count:=count+1;
sxa := 500 * cos(cos((loop2/20)-1.57)) * cos((loop/10)-3.14);
sya := 500 * cos(cos((loop2/20)-1.57)) * sin((loop/10)-3.14);
sza := 500 * sin(sin((loop2/20)-1.57));
pnt[count].x:=round(sxa); {This is an example of how my variable}
pnt[count].y:=round(sya); {type definition is used.}
pnt[count].z:=round(sza);
until loop2=64;
until loop=64;
numverts:=count;
end;
begin;
randomize;
d:=1000;
dist:=17000;
gd:=vga;
gm:=vgamed;
initgraph(gd,gm,'bgi');
rand:=random(4)+1;
if rand=1 then begin
dist:=13000;
modelTwistandCurl;
end;
if rand=2 then begin
dist:=4000;
modelSphere;
end;
if rand=3 then begin
dist:=11000;
modelTorus;
end;
if rand=4 then begin
dist:=4000;
modelTube;
end;
xang:=0;
yang:=0;
zang:=0;
stepx:=random(11)-5;
stepy:=random(11)-5;
stepz:=random(21)-10;
repeat
s:=1-s;
setvisualpage(s);
setactivepage(1-s);
vwait;
cleardevice;
xo:=320;
yo:=175;
xang:=xang+stepx;
yang:=yang+stepy;
zang:=zang+stepz;
rand:=random(100);
if rand = 3 then begin
rand:=random(4)+1;
if rand=1 then begin
dist:=13000;
modelTwistandCurl;
end;
if rand=2 then begin
dist:=4000;
modelSphere;
end;
if rand=3 then begin
dist:=11000;
modelTorus;
end;
if rand=4 then begin
dist:=4000;
modelTube;
end;
end;
rand2:=random(50);
if rand2 = 4 then stepx := random(11)-5;
if rand2 = 5 then stepy := random(11)-5;
if rand2 = 6 then stepz := random(21)-10;
repeat
if keypressed then ch:=readkey;
until not keypressed;
if xang>256 then xang:=xang-256;
if yang>256 then yang:=yang-256;
if zang>256 then zang:=zang-256;
if xang<0 then xang:=xang+256;
if yang<0 then yang:=yang+256;
if zang<0 then zang:=zang+256;
sxa := ozsin(xang);
cxa := ozcos(xang);
sya := ozsin(yang);
cya := ozcos(yang);
sza := ozsin(zang);
cza := ozcos(zang);
loop:=0; {This resets the loop value to zero}
repeat
inc(loop); {This increments the loop value by 1}
x:= (pnt [ loop ] . X);
y:= (pnt [ loop ] . Y);
z:= (pnt [ loop ] . Z);
x1 := x * cza - y * sza;
y1 := x * sza + y * cza;
z1 := z;
x := x1;
y := y1 * cxa - z1 * sxa;
z := y1 * sxa + z1 * cxa;
x1 := z * sya + x * cya;
y1 := y;
z1 := z * cya - x * sya;
z1:=(z1*8);
if z1>1950 then col[loop]:=15;
if (z1>=50) and (z1<=1950) then col[loop]:=7;
if (z1<=50) and (z1>=-1950) then col[loop]:=8;
if (z1<=-1950) then col[loop]:=0;
if z1>=round(dist) then begin;
col[loop]:=0;
z1:=dist;
end;
z1:=z1-dist;
if z1=0 then z1:=1;
pnts[LOOP].x := round(d * x1 / z1) ;
pnts[LOOP].y := round((d * y1 / z1) * 0.9) ;
if col[loop] <> 0 then
putpixel(pnts[loop].x+xo,pnts[loop].y+yo,col[loop]);
until loop=numverts; {The end of the loop occurs when loop is equal to
the number of vertices.}
until ch=chr(27); {This loops the program until the Escape key is pressed.}
CLOSEGRAPH; {Closes down graphics mode.}
end. {End of Program.}