[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{ NOTE : Units needed are included at the end of this code }
program the_4d_experiment;
{version 1.1}
{ Kiszely Laszlo 1995
kiszely@bmeik.eik.bme.hu}
{--------------------------------------------------------------------------}
uses crt,mygraf;
const end_seq:real=237; {the end of a data-stream,
it is a 'í' sign, indicates
the end of a kind of stream}
{---------------------------------------------------------------------------}
var data:file of real; {the file of the generated object}
j:integer; {indexes}
a:real; {for temporary storage}
chrt:char; {readkey at the end}
vertex: array[1..100,1..4] of real;
{let's store the vertex-values!}
vertex_number:integer; {the number of vertexes}
edges: array[1..200,1..3] of byte;
{let's store the edges' start-
and end-points plus the color of the edge}
edge_number:integer; {yes, the number of edges}
xy,xz,xw,yz,yw,zw:integer;
sine: array[0..359] of real; {sine-table}
cosine: array[0..359] of real; {cosine-table}
FileName:string; {the name of the 4d-object file}
{---------------------------------------------------------------------------}
{Input/Output procedures}
procedure Open_And_Check; {Checks whether the requested file is
in the directory or not}
begin
{$I-}
reset(data);
{$I+}
if IOResult<>0 then
begin
writeln(FileName,' not found!');
halt;
end;
end;
function CheckFlag(flag:real): Boolean;
begin
read(data,a);
if a=flag then CheckFlag:=true else CheckFlag:=False;
end;
procedure GetVertex_And_Write; {Reads the vertexes and puts them
into an an array}
begin
for j:=1 to 4 do
read(data,vertex[vertex_number,j]);
end;
procedure GetEdge_And_Write; {Reads the edge-data-stream and
puts them into an array}
var real_edge:real;
begin
for j:=1 to 3 do
begin
read(data,real_edge);
edges[edge_number,j]:=round(real_edge);
end;
end;
{--------------------------------------------------------------------------}
procedure CmdLineFileName;
begin
if ParamCount<>1 then begin
writeln('No Parameter/Too much Parameters Found!');
writeln('Usage: 4dexp object.4d');
halt(1);
end;
FileName:=ParamStr(1);
end;
procedure MainScreenOut;
begin
writeln;writeln;writeln;
writeln(' THE 4D EXPERIMENT');
writeln;writeln;writeln;
writeln(' A little program to rotate a 4 dimensional cube');
writeln;writeln;
writeln(' programmed by Kiszely L�szl¢');
writeln;writeln;writeln;
writeln(' Control Keys');
writeln(' 4 - 6 Rotation around the YW-plane');
writeln(' 8 - 2 Rotation around the XW-plane');
writeln(' 1 - 9 Rotation around the ZW-plane');
writeln(' 3 - 7 Rotation around the XY-plane');
writeln(' a - s Rotation around the XZ-plane');
writeln(' z - x Rotation around the YZ-plane');
writeln(' q Quit');
writeln;
writeln(' Hit any key!');
writeln;writeln;
asm
@again:
in AL,60h
and AL,128
jnz @again
end;
end;
procedure BuildSineTable;
var index:integer;
begin
for index:=0 to 359 do
sine[index]:=sin(index*3.14/180);
end;
procedure BuildCosineTable;
var index:integer;
begin
for index:=0 to 359 do
cosine[index]:=cos(index*3.14/180);
end;
{--------------------------------------------------------------------------}
{Graphical procedures}
procedure ShowThePixel(x1:real;y1:real);{Transform the relative coords}
var x1tmp,y1tmp:integer;
begin
x1tmp:=160+round(x1); {160 - origin-translation}
y1tmp:=100+round(y1);
point(x1tmp,y1tmp,10);
end;
procedure ShowTheLine(startpoint:integer;endpoint:integer;color:byte);
var x1tmp,y1tmp,x2tmp,y2tmp,colour:integer;
begin
x1tmp:=160+round(vertex[startpoint,1]);
y1tmp:=100+round(vertex[startpoint,2]);
x2tmp:=160+round(vertex[endpoint,1]);
y2tmp:=100+round(vertex[endpoint,2]);
colour:=round(color);
myline(x1tmp,y1tmp,x2tmp,y2tmp,colour);
end;
procedure ShowTheObject;
var o:integer;
begin
cls;
for o:=1 to vertex_number do
ShowThePixel(vertex[o,1],vertex[o,2]);
for o:=1 to edge_number do
ShowTheLine(edges[o,1],edges[o,2],edges[o,3]);
end;
{--------------------------------------------------------------------------}
{The functions of rotation}
procedure RotateAroundXW(alfa:integer); {alfa - angle of rotating}
{in degrees, of course}
var ytmp,ztmp:real;
i:integer;
begin
for i:=1 to vertex_number do
begin
ytmp:=vertex[i,2]*cosine[alfa]+vertex[i,3]*sine[alfa];
ztmp:=-vertex[i,2]*sine[alfa]+vertex[i,3]*cosine[alfa];
vertex[i,2]:=ytmp;
vertex[i,3]:=ztmp;
end;
end;
procedure RotateAroundZW(alfa:integer);
var xtmp,ytmp:real;
index:integer;
begin
for index:=1 to vertex_number do
begin
xtmp:=vertex[index,1]*cosine[alfa]+vertex[index,2]*sine[alfa];
ytmp:=-(vertex[index,1]*sine[alfa])+vertex[index,2]*cosine[alfa];
vertex[index,1]:=xtmp;
vertex[index,2]:=ytmp;
end;
end;
procedure RotateAroundYW(alfa:integer);
var xtmp,ztmp:real;
index:integer;
begin
for index:=1 to vertex_number do
begin
xtmp:=vertex[index,1]*cosine[alfa]+vertex[index,3]*sine[alfa];
ztmp:=-(vertex[index,1]*sine[alfa])+vertex[index,3]*cosine[alfa];
vertex[index,1]:=xtmp;
vertex[index,3]:=ztmp;
end;
end;
procedure RotateAroundXY(alfa:integer);
var ztmp,wtmp:real;
index:integer;
begin
for index:=1 to vertex_number do
begin
ztmp:=vertex[index,3]*cosine[alfa]+vertex[index,4]*sine[alfa];
wtmp:=-(vertex[index,3]*sine[alfa])+vertex[index,4]*cosine[alfa];
vertex[index,3]:=ztmp;
vertex[index,4]:=wtmp;
end;
end;
procedure RotateAroundXZ(alfa:integer);
var ytmp,wtmp:real;
index:integer;
begin
for index:=1 to vertex_number do
begin
ytmp:=vertex[index,2]*cosine[alfa]+vertex[index,4]*sine[alfa];
wtmp:=-(vertex[index,2]*sine[alfa])+vertex[index,4]*cosine[alfa];
vertex[index,2]:=ytmp;
vertex[index,4]:=wtmp;
end;
end;
procedure RotateAroundYZ(alfa:integer);
var ytmp,ztmp:real;
index:integer;
begin
for index:=1 to vertex_number do
begin
ytmp:=vertex[index,2]*cosine[alfa]+vertex[index,3]*sine[alfa];
ztmp:=-(vertex[index,2]*sine[alfa])+vertex[index,3]*cosine[alfa];
vertex[index,2]:=ytmp;
vertex[index,3]:=ztmp;
end;
end;
{---------------------------------------------------------------------------}
begin
CmdLineFileName;
MainScreenOut;
assign(data,FileName);
Open_And_Check;
vertex_number:=0;
edge_number:=0;
while CheckFlag(47) do
begin
vertex_number:=vertex_number+1;
GetVertex_And_Write;
end;
while CheckFlag(92) do
begin
edge_number:=edge_number+1;
GetEdge_And_Write;
end;
if a<>237 then begin
writeln('This 4d file is not a valid one!');
halt(2);
end;
close(data);
vga320;
BuildSineTable;
BuildCosineTable;
ShowTheObject;
repeat
repeat
RotateAroundYW(yw);
RotateAroundZW(zw);
RotateAroundXW(xw);
RotateAroundXY(xy);
RotateAroundXZ(xz);
RotateAroundYZ(yz);
ShowTheObject;
until keypressed;
chrt:=readkey;
case chrt of
'4': begin;inc(yw);if yw>359 then yw:=yw-360;end;
'6': begin;dec(yw);if yw<0 then yw:=yw+360;end;
'1': begin;inc(zw);if zw>359 then zw:=zw-360;end;
'9': begin;dec(zw);if zw<0 then zw:=zw+360;end;
'8': begin;inc(xw);if xw>359 then xw:=xw-360;end;
'2': begin;dec(xw);if xw<0 then xw:=xw+360;end;
'7': begin;inc(xy);if xy>359 then xy:=xy-360;end;
'3': begin;dec(xy);if xy<0 then xy:=xy+360;end;
'a': begin;inc(xz);if xz>359 then xz:=xz-360;end;
's': begin;dec(xz);if xz<0 then xz:=xz+360;end;
'z': begin;inc(yz);if yz>359 then yz:=yz-360;end;
'x': begin;dec(yz);if yz<0 then yz:=yz+360;end;
'q': break;
end;
until j=0;
vga_out;
end.
{ ----------------------- CUT HERE ---------------------}
unit mygraf;
{Author: Kiszely Laszlo 1995
kiszely@bmeik.eik.bme.hu
Credits: Thanx to Bas van Gaalen for his 3dpas package}
interface
const vidseg: word=$a000;
procedure vga320;
procedure retrace;
procedure point(x,y:word;color:byte);
procedure vga_out;
procedure cls;
procedure myline(xk,yk,xv,yv:word; color:byte);
implementation
procedure vga320; assembler;
asm
mov ax,13h;
int 10h;
end;
procedure retrace; assembler; asm
mov dx,03dah; @vert1: in al,dx; test al,8; jnz @vert1
@vert2: in al,dx; test al,8; jz @vert2; end;
procedure point(x,y:word;color:byte);
begin
{if (y<200) and (x<320) then}
mem[vidseg:y*320+x]:=color;
end;
procedure vga_out; assembler;
asm
mov ax,03h
int 10h
end;
procedure cls; assembler;
asm
mov es,[vidseg];xor di,di;xor ax,ax;mov cx,320*100;
rep stosw;
end;
procedure myline(xk,yk,xv,yv:word; color:byte);
var
sgnx,sgny:byte;
eltx,elty,x,y,pp,qq,count,nn:word;
begin
asm
mov ax,xv
mov bx,xk
sub ax,bx
js @h1
mov cl,1
mov sgnx,cl
mov eltx,ax
jmp @h3
@h1:
mov cl,0
mov sgnx,cl
mov eltx,ax
neg eltx
@h3:
mov ax,yv
mov bx,yk
sub ax,bx
js @h4
mov cl,1
mov sgny,cl
mov elty,ax
jmp @h5
@h4:
mov cl,0
mov sgny,cl
mov elty,ax
neg elty
@h5:
mov ax, eltx
mov bx, elty
cmp ax,bx
ja @j1
mov ax, elty
mov nn,ax
jmp @j2
@j1:
mov ax, eltx
mov nn,ax
@j2:
mov ax, nn
mov dx,0
mov bx,2
div bx
cmp ax,0
je @gy1
mov ax,0
mov pp,ax
mov qq,ax
inc pp
inc qq
jmp @gy2
@gy1:
mov pp,ax
mov qq,ax
@gy2:
mov ax,xk
mov x,ax
mov ax,yk
mov y,ax
mov ax,1
mov count,ax
@next :
push x
push y
mov al,color
push ax
call point
mov ax, pp
add ax, eltx
mov pp,ax
mov bx, nn
cmp ax,bx
jb @t1
mov ax, pp
sub ax, nn
mov pp,ax
mov al, sgnx
cmp al,1
je @nn1
dec x
jmp @t1
@nn1:
inc x
@t1:
mov ax, qq
add ax, elty
mov qq,ax
mov bx, nn
cmp ax,bx
jb @t2
mov ax, qq
sub ax, nn
mov qq,ax
mov al, sgny
cmp al,1
je @nn3
dec y
jmp @t2
@nn3:
inc y
@t2:
inc count
mov ax, count
cmp nn,ax
jae @next
end;
end;
end.
{ ----------------------- CUT HERE ---------------------}
{ CODE TO GENERATE THE CUBE FILE }
program generate_the_4d_cube;
{this little util generates a 4d_object}
{Author:Kiszely Laszlo 1995
kiszely@bmeik.eik.bme.hu}
const end_seq:real=237; {the end of a data-stream,
it is a 'í' sign, indicates
the end of a kind of stream}
vertex_number:integer=16; {the number of the vertexes}
the_object: array[1..16,1..5] of real=((47,40,40,40,40),(47,40,40,40,-40),
(47,40,40,-40,40),(47,40,40,-40,-40),(47,40,-40,40,40),(47,40,-40,40,-40),
(47,40,-40,-40,40),(47,40,-40,-40,-40),(47,-40,40,40,40),(47,-40,40,40,-40),
(47,-40,40,-40,40),(47,-40,40,-40,-40),(47,-40,-40,40,40),
(47,-40,-40,40,-40),(47,-40,-40,-40,40),(47,-40,-40,-40,-40));
{an array of vertexes,where:
47 - a flag, here starts 4 data members
of the vertex-stream
of course, it can be anything else,too}
edge_number:integer=32; {the number of edges in the object}
the_edges: array[1..32,1..4] of real=( (92,1,3,10),(92,3,7,10),
(92,7,5,10),(92,5,1,10),(92,9,11,10),(92,11,15,10),
(92,15,13,10),(92,13,9,10),(92,11,3,10),(92,15,7,10),
(92,13,5,10),(92,9,1,10),
(92,2,10,3),(92,10,14,3),(92,14,6,3),(92,6,2,3),
(92,12,4,3),(92,4,8,3),(92,8,16,3),(92,16,12,3),
(92,10,12,3),(92,14,16,3),(92,6,8,3),(92,2,4,3),
(92,9,10,5),(92,13,14,5),(92,5,6,5),(92,1,2,5),
(92,11,12,5),(92,3,4,5),(92,7,8,5),(92,15,16,5));
{an array of edges,where:
92 - a flag to separate the 2 data members
first value - starting point of the edge
second value - endpoint of the edge
third value - the color of the edge}
var data:file of real; {the file of the generated object}
i,j:integer; {indexes}
begin
assign(data,'cube.4d');
rewrite(data);
for i:=1 to vertex_number do
begin
for j:=1 to 5 do
begin
write(data,the_object[i,j]);
end;
end; {the vertexes' coords}
write(data,end_seq);
for i:=1 to edge_number do
begin
for j:=1 to 4 do
begin
write(data,the_edges[i,j]);
end;
end; {which v-s are on one edge}
write(data,end_seq);
{Right now, the file of the 4d_object is ready. Be careful at the reading!}
close(data);
end.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]