program Prism3D; {Author: Krisjanis Gale, 10/06/94} {MY FIRST WORKING 3D OBJECT!} uses Gfx2, Crt; {<þÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄþ>} type vector=record x,y,z:integer; end; {<þÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄþ>} var deltaPRISM:array[0..11,0..1] of vector; ValCos:array[0..359] of real; ValSin:array[0..359] of real; k,sc:integer; {<þÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄþ>} const Zscale=256; {total z-coord depth} deltaZ=256; {by how much to move points "back" in z-plane} {A simple 8-sided prism} prism:array[0..11,0..1] of vector= ((( x:0; y:0; z:1 ),( x:1; y:0; z:0 )), (( x:0; y:0; z:1 ),( x:0; y:1; z:0 )), (( x:0; y:0; z:1 ),( x:-1; y:0; z:0 )), (( x:0; y:0; z:1 ),( x:0; y:-1; z:0 )), (( x:0; y:0; z:-1),( x:1; y:0; z:0 )), (( x:0; y:0; z:-1),( x:0; y:1; z:0 )), (( x:0; y:0; z:-1),( x:-1; y:0; z:0 )), (( x:0; y:0; z:-1),( x:0; y:-1; z:0 )), (( x:1; y:0; z:0 ),( x:0; y:1; z:0 )), (( x:0; y:1; z:0 ),( x:-1; y:0; z:0 )), (( x:-1; y:0; z:0 ),( x:0; y:-1; z:0 )), (( x:0; y:-1; z:0 ),( x:1; y:0; z:0 ))); {<þÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄþ>} procedure Get2D(x,y,z:integer;var sX:integer;var sY:byte); begin sX:=trunc(((x*Zscale)/z)+160); sY:=trunc(((y*Zscale)/z)+100) end; {<þÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄþ>} function GetCos(i:integer):real; var c:real; begin if i<0 then i:=-(abs(i) mod 360)+360; c:=ValCos[i mod 360]; GetCos:=c end; {<þÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄþ>} function GetSin(i:integer):real; var s:real; begin if i<0 then i:=-(abs(i) mod 360)+360; s:=ValSin[abs(i) mod 360]; GetSin:=s end; {<þÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄþ>} procedure Rot3D(var X,Y,Z:integer;rotX,rotY,rotZ:integer); {Trigonometrically rotate an (x,y,z) coordinate by} {degrees of rotation on the three axes; K.Gale, 9/21/94} var cosX,sinX,cosY,sinY,cosZ,sinZ:real; tX,tY,tZ:integer; begin cosX:=GetCos(rotX); sinX:=GetSin(rotX); cosY:=GetCos(rotY); sinY:=GetSin(rotY); cosZ:=GetCos(rotZ); sinZ:=GetSin(rotZ); tX:=X; tY:=Y; tZ:=Z; tX:=trunc(X*cosY-Z*sinY); {yaw} tZ:=trunc(X*sinY+Z*cosY); X:=trunc(tX*cosZ+Y*sinZ); {pitch} tY:=trunc(Y*cosZ-tX*sinZ); Z:=trunc(tZ*cosX-tY*sinX); {roll} Y:=trunc(tZ*sinX+tY*cosX) end; procedure DefinePrism(rotX,rotY,rotZ:integer;scale:byte); var x,y,z:integer; i1:0..11; i2:0..1; begin for i1:=0 to 11 do for i2:=0 to 1 do begin x:=(prism[i1,i2].x)*scale; y:=(prism[i1,i2].y)*scale; z:=(prism[i1,i2].z)*scale; Rot3D(x,y,z,rotX,rotY,rotZ); deltaPRISM[i1,i2].x:=x; deltaPRISM[i1,i2].y:=y; deltaPRISM[i1,i2].z:=z+deltaZ end end; {<þÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄþ>} procedure DrawPrism(col:byte;where:word); var i:0..11; x,y,z,sX1,sX2:integer; sY1,sY2:byte; begin for i:=0 to 11 do begin x:=deltaPRISM[i,0].x; y:=deltaPRISM[i,0].y; z:=deltaPRISM[i,0].z; Get2D(x,y,z,sX1,sY1); x:=deltaPRISM[i,1].x; y:=deltaPRISM[i,1].y; z:=deltaPRISM[i,1].z; Get2D(x,y,z,sX2,sY2); line(sX1,sY1,sX2,sY2,col,where) end end; {<þÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄþ>} begin for k:=0 to 359 do begin ValCos[k]:=cos(Deg2Rad(k)); ValSin[k]:=sin(Deg2Rad(k)) end; SetMCGA; DefinePrism(0,0,0,64); for k:=0 to 90 do begin DrawPrism(0,vga); DefinePrism(k div 6,k div 6,k*4,86); DrawPrism(15,vga) end; for k:=15 to 90 do begin DrawPrism(0,vga); DefinePrism(k,k,k,86); DrawPrism(15,vga) end; for k:=90 downto 0 do begin DrawPrism(0,vga); DefinePrism(k*4,k*2,k*8,86); DrawPrism(15,vga) end; while not keypressed do; SetText end.