[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]