{3DTPSIMP.PAS- helppoa kolmiulotteista vektorigrafiikkaa Turbo-Pascalilla}
{VGA-resoluutiossa Laadittu 15.3.92}
{Gunnar Grönvall, puh 90-5051347, työ 90-578311}
uses
Crt, Graph;
const
PI=3.1416;
type
KuvioTaltio =record
x :longint;
y :longint;
z :longint;
vvari :integer;
end;
var
GraphDriver :integer; { The Graphics device driver }
GraphMode :integer; { The Graphics mode value }
MaxX, MaxY :word; { The maximum resolution of the screen }
MaxColor :word; { The maximum color value available }
Palette :PaletteType;
i, vvari, tausta:integer;
Size :Word;
ch :char;
W,E,V,K,Bakseli :longint;
OE,PE,QE :real;
O,P,Q,R,S,T,U :longint;
x,y,z :longint;
A, B, AA, BB :longint;
G, Gd, Gm, Askel:integer;
hStr,xStr,yStr,zStr : string;
PaikkaAStr,PaikkaBStr:string;
Koodi :integer;
Taltio :KuvioTaltio;
KuvioTallenne :File of KuvioTaltio;
Talletus :boolean;
{---------------------------------------------------------------------
------}
Procedure AlustaGrafiikka;
begin
GraphDriver := Detect;
InitGraph (GraphDriver, GraphMode, '');
Koodi := GraphResult;
if Koodi<> grOK then Halt;
RestoreCRTMode;
end;
Procedure Initialize;
begin
AlustaGrafiikka; SetGraphMode(GraphMode);
MaxColor := GetMaxColor; { Get the maximum allowable drawing color
}
MaxX := GetMaxX; { Get screen resolution values }
MaxY := GetMaxY;
TextColor(14);
end; { Initialize }
Procedure MonitoriMoodinParametrit (var W,E,K,V:LongInt);
begin
W:=1; {W:=4/3; =VGA, EGA:=48/35;}
V:=320; {320/W;}
K:=-240; {EGA:=175;}
E:=1000;
Bakseli:=479;
end;
Procedure AlkuLaskelmat ;
var AX, BY, CZ, py :real;
CA, CB, CC, SA, SB, SC :real;
ECA, ESA, ESAC, ESC :real;
begin
B:=Bakseli;
AX:=0;BY:=0;CZ:=0;
RestoreCrtMode;
TextColor(14);
MonitoriMoodinParametrit(W,E,K,V);
py:=PI/180;
writeln;
write ('Anna x-kulma '); readln (AX); AX:=-AX*py;
write ('Anna y-kulma '); readln (BY); BY:=-BY*py;
write ('Anna z-kulma '); readln (CZ); CZ:=CZ*py;
CA:=COS(AX); CB:=COS(BY); CC:=COS(CZ);
SA:=SIN(AX); SB:=SIN(BY); SC:=SIN(CZ);
OE:=CA*SC; PE:=-(CB*SA*SC+CC*SB); QE:=CB*CC-SA*SB*SC;
ECA:=E*CA; ESA:=E*SA; ESAC:=CC*ESA; ESC:=E*SC;
O:=round(CC*ECA+V*OE);
P:=round(SB*ESC-CB*ESAC+V*PE);
Q:=round(V*QE-CB*ESC-SB*ESAC);
R:=round(ESA+K*OE);
S:=round(CB*ECA+K*PE);
T:=round(SB*ECA+K*QE);
SetGraphMode(GraphMode);
SetBkColor(tausta);
SetColor(vvari);
end;
Procedure Paikka;
var U:LongInt;
begin
U:=round(E+x*OE+y*PE+z*QE);
A:=round((x*O+y*P+z*Q)*W/U);
B:=Bakseli+round((x*R+y*S+z*T)/U);
end;
Procedure AlkuRutiinit;
begin
clrscr;
{muuttujien alustus}
x:=0; y:=0; z:=0; A:=0; B:=0;
OE:=0; PE:=0; QE:=0; O:=0; P:=0; Q:=0; R:=0; S:=0; T:=0; U:=0;
G:=100; Askel:=G; vvari:=11; tausta:=0; Bakseli:=479; Talletus:=fal-
se;
Initialize;
AlkuLaskelmat;
Paikka;
PutPixel(A,B,vvari); MoveTo(A,B);
end;
Procedure UusiPaikka;
begin
str (X:7, xStr); str (-Y:7, yStr); str (Z:7, zStr);
{ Uuden x-arvon syöttö }
SetViewPort (300,0,600,10,ClipOn); ClearViewPort;
SetTextJustify (LeftText, TopText);
SetViewPort (300,0,310+TextWidth('X:xxxxxxx'),10,ClipOn);
ClearViewPort;
SetViewPort (300,0,310+TextWidth('X:xxxxxxx'),10,ClipOn);
OutTextXY (1,1,'X:'+xStr);
GotoXY(72,1); read (x);
GotoXY(72,1); ClrEol;
if Talletus then Taltio.x:=x;
ClearViewPort; SetTextJustify (LeftText, TopText);
str (x:7, xStr);
SetViewPort (300,0,310+TextWidth('X:xxxxxxx'),10,ClipOn);
OutTextXY (1,1,'X:'+xStr);
{ Uuden y-arvon syöttö }
SetTextJustify (LeftText, TopText);
SetViewPort (390,0,400+TextWidth('Y:yyyyyyy'),10,ClipOn);
ClearViewPort;
SetViewPort (390,0,400+TextWidth('Y:yyyyyyy'),10,ClipOn);
OutTextXY (1,1,'Y:'+yStr);
GotoXY(72,1); read (y); y:=-y;
GotoXY(72,1); ClrEol;
if Talletus Then Taltio.y:=y;
ClearViewPort; SetTextJustify (LeftText, TopText);
str (-y:7, yStr);
SetViewPort (390,0,400+TextWidth('Y:yyyyyyy'),10,ClipOn);
OutTextXY (1,1,'Y:'+yStr);
{ Uuden z-arvon syöttö }
SetTextJustify (LeftText, TopText);
SetViewPort (480,0,490+TextWidth('Z:zzzzzzz'),10,ClipOn);
ClearViewPort;
SetViewPort (480,0,490+TextWidth('Z:zzzzzzz'),10,ClipOn);
OutTextXY (1,1,'Z:'+zStr);
GotoXY(72,1); read (z);
GotoXY(72,1); ClrEol;
if Talletus then Taltio.z:=z;
ClearViewPort; SetTextJustify (LeftText, TopText);
str (z:7, zStr);
SetViewPort (480,0,490+TextWidth('Z:zzzzzzz'),10,ClipOn);
OutTextXY (1,1,'Z:'+zStr);
{ Uuden pisteen piirto }
Paikka; PutPixel(A,B,vvari); MoveTo (A,B);
end;
Procedure Askellus;
begin
str (g:7, hStr);
SetTextJustify (LeftText, TopText);
SetViewPort (300,10,600,20,ClipOn); ClearViewPort;
SetViewPort (300,10,360+TextWidth('Askel:ggggggg'),20,ClipOn);
OutTextXY (1,1,'Nyky-askel:'+hStr);
GotoXY(72,1); read (g);
GotoXY(72,1); ClrEol;
ClearViewPort; str (g:7, hStr); Askel:=g;
end;
Procedure ViivanVari;
begin
SetViewPort (300,10,600,20,ClipOn); ClearViewPort;
SetViewPort (300,10,360+TextWidth('vvari:ggggggg'),20,ClipOn);
OutTextXY (1,1,'Viivalle väri? ');
GotoXY(72,1); read (vvari);
GotoXY(72,1); ClrEol;
ClearViewPort;
if Talletus then
begin
Taltio.vvari:=vvari;
write (KuvioTallenne, Taltio);
end;
SetColor(vvari);
GotoXY(72,1); ClrEol;
end;
Procedure TaustanVari;
begin
SetViewPort (300,10,360+TextWidth('tausta:ggggggg'),20,ClipOn);
OutTextXY (1,1,'Taustan väri? ');
GotoXY(72,1); read (tausta);
GotoXY(72,1); ClrEol;
ClearViewPort;
SetBkColor(tausta);
end;
Procedure TallentaaViivaa;
var kStr: String;
Kerta :integer;
begin
Talletus := true;
Assign(KuvioTallenne,'C:KUVIO.DAT');
Rewrite(KuvioTallenne);
Taltio.x:=x ;
Taltio.y:=y ;
Taltio.z:=z ;
Taltio.vvari:=vvari;
Kerta:=1;
Write (KuvioTallenne, Taltio);
repeat
ch:=ReadKey;
case ch of
'e': begin
x:=x+G; Taltio.x:=x; Write (KuvioTallenne, Taltio); {e}
end;
'w': begin
x:=x-G; Taltio.x:=x; write (KuvioTallenne, Taltio); {w}
end;
's': begin
y:=y+G; Taltio.y:=y; write (KuvioTallenne, Taltio); {n}
end;
'n': begin
y:=y-G; Taltio.y:=y; write (KuvioTallenne, Taltio); {s}
end;
'a': begin
z:=z+G; Taltio.z:=z; write (KuvioTallenne, Taltio); {a}
end;
'r': begin
z:=z-G; Taltio.z:=z; write (KuvioTallenne, Taltio); {r}
end;
'x': begin
UusiPaikka;
write (KuvioTallenne, Taltio);
end;
'y': begin
ViivanVari; write (KuvioTallenne, Taltio);
end;
'h': begin
Askellus;
end;
end; {case}
Paikka ;
LineTo (A, B);
SetViewPort (0,0,600,40,ClipOn); ClearViewPort;
str (X:7, xStr); str (-Y:7, yStr); str (Z:7, zStr);
SetTextJustify (LeftText, TopText); SetViewPort (0,0,300,40,Cli-
pOn);
OutTextXY (1,1,'X:'+xStr);
OutTextXY (100,1,'Y:'+yStr);
OutTextXY (200,1,'Z:'+zStr);
str (A:7, PaikkaAStr); str (round(Bakseli-B):7, PaikkaBStr);
OutTextXY (1,10,'A:'+PaikkaAStr);
OutTextXY (100,10,'B:'+PaikkaBStr);
OutTextXY (200,10,'H:'+hStr);
str (Kerta:7, kStr);
SetTextJustify (LeftText, TopText);
SetViewPort (300,10,420+TextWidth('Kerta:ggggggg'),20,ClipOn);
OutTextXY (1,1,'TALLENTAA, Pisteitä: '+kStr);
Kerta:=Kerta+1;
Askel:=g;
SetViewPort (0,0,GetMaxX,GetMaxY,ClipOn);
MoveTo (A, B);
until ch='T';
Close(KuvioTallenne);
Talletus := False;
end;
Procedure LukeeTallennetta;
var Erotus, Eka :KuvioTaltio;
x1, y1, z1 :LongInt;
kerta :integer;
begin
x1:=x ; y1:=y; z1:=z;
G:=Askel; Kerta:=1;
assign (KuvioTallenne, 'C:KUVIO.DAT');
reset (KuvioTallenne);
SetViewPort (300,10,460,20,ClipOn); ClearViewPort;
SetViewPort (300,10,460,20,ClipOn);
SetTextJustify (LeftText, TopText);
SetViewPort (300,10,460,20,ClipOn);
OutTextXY (1,1,'LUKEE');
SetViewPort (0,0,GetMaxX,GetMaxY,ClipOn);
while not EOF(KuvioTallenne) do
begin
read (KuvioTallenne, Taltio);
vvari:=Taltio.vvari;
If kerta=1 then
begin
Paikka; PutPixel(A,B,vvari); MoveTo(A,B);
Eka:=Taltio;
end;
x:=x1+(Taltio.x-Eka.x);
y:=y1+(Taltio.y-Eka.y);
z:=z1+(Taltio.z-Eka.z);
Paikka; LineTo(A,B); MoveTo(A,B);
kerta:=2;
end;
Close (KuvioTallenne);
G:=Askel;
x:=x1; y:=y1; z:=z1;
Paikka; PutPixel(A,B,vvari); MoveTo(A,B);
end;
Procedure LukeeNappaimia;
var x1, y1, z1:LongInt;
Kerta :Integer;
Lopetus: char;
begin
str (g:7, hStr);
Lopetus:='e';
repeat
ch:=ReadKey;
case ch of
'e': x:=x+G; {itään}
'w': x:=x-G; {länteen}
's': y:=y+G; {pohjoiseen}
'n': y:=y-G; {etelään}
'a': z:=z+G; {eteenpäin}
'r': z:=z-G; {taaksepäin}
'M': TallentaaViivaa;
'd': SetColor(tausta);
'b': SetColor(vvari);
'm': begin
LukeeTallennetta;
end;
'y': begin
ViivanVari;
end;
'z': begin
TaustanVari;
end;
'x': begin
UusiPaikka;
end;
'h': begin
Askellus;
end;
end; {case}
Paikka ;
LineTo (A, B);
SetViewPort (0,0,600,20,ClipOn); ClearViewPort;
str (X:7, xStr); str (-Y:7, yStr); str (Z:7, zStr);
SetTextJustify (LeftText, TopText); SetViewPort (0,0,310,20,Cli-
pOn);
OutTextXY (1,1,'X:'+xStr);
OutTextXY (100,1,'Y:'+yStr);
OutTextXY (200,1,'Z:'+zStr);
str (A:7, PaikkaAStr); str (round(Bakseli-B):7, PaikkaBStr);
OutTextXY (1,10,'A:'+PaikkaAStr);
OutTextXY (100,10,'B:'+PaikkaBStr);
OutTextXY (200,10,'H:'+hStr);
SetViewPort (0,0,GetMaxX,GetMaxY,ClipOn);
MoveTo (A, B);
G:=Askel;
until ch='t';
if ch='t' then
begin
SetViewPort (300,10,460,20,ClipOn); ClearViewPort;
SetViewPort (300,10,460,20,ClipOn);
SetTextJustify (LeftText, TopText);
SetViewPort (300,10,639,20,ClipOn);
OutTextXY (1,1,'LOPETUS = l, ALUSTA = a');
SetViewPort (0,0,GetMaxX,GetMaxY,ClipOn);
GotoXY(72,1); read (lopetus);
GotoXY(72,1); ClrEol;
ClearViewPort;
SetBkColor(tausta);
if lopetus<>'l' then
begin
CloseGraph;
AlkuRutiinit;
LukeeNappaimia;
end;
end; {if ch='t'}
end;
begin {Pääohjelma}
Alkurutiinit;
LukeeNappaimia;
CloseGraph;
end.
