1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
program projection;
uses wincrt,wingraph;
var pilote,mode,xc,xd,yd,zd,yc,zc,i,dd:integer;
c:char;h:string;
tx: array[1..8] of integer;
ty: array[1..8] of integer;
tz: array[1..8] of integer;
txs: array[1..8] of integer;
tys: array[1..8] of integer;
BEGIN
xc:=-80;
yc:=0;
zc:=0;
begin
tx[1]:= -40;
ty[1]:= 40;
tz[1]:= 40;
tx[2]:= -40;
ty[2]:= -40;
tz[2]:= 40;
tx[3]:= -40;
ty[3]:= -40;
tz[3]:= -40;
tx[4]:= -40;
ty[4]:= 40;
tz[4]:= -40;
tx[5]:= 40;
ty[5]:= 40;
tz[5]:= 40;
tx[6]:= 40;
ty[6]:= -40;
tz[6]:= 40;
tx[7]:= 40;
ty[7]:= -40;
tz[7]:= -40;
tx[8]:= 40;
ty[8]:= 40;
tz[8]:= -40;
end;
dd:=200;
Pilote := Detect;
InitGraph(Pilote, Mode, 'PROJECTION DEMONSTRATION');
repeat
writeln('pass');
c:=readkey;
cleardevice;
writeln('pass');
if (upcase(c)= 'Z') then xc:=xc+1
else
if (upcase(c)='S' ) then xc:=xc-1
else
if (upcase(c)= 'D') then zc:=zc+1
else
if (upcase(c)='Q' ) then zc:=zc-1
else
if (upcase(c)= 'U') then yc:=yc+1
else
if (upcase(c)='X' ) then yc:=yc-1;
writeln('pass');
writeln(xc,' yc= ',yc,' zc= ',zc);
for i:= 1 to 8 do
begin
xd:=tx[i];
yd:=ty[i];
zd:=tz[i];
writeln('screeny= ',tys[i],' screenx= ',txs[i]);
if (yd<>yc)and(xc<>xd) then begin
tys[i]:=getmaxy div 2 + round(((yc-yd)*dd)/(xd-xc));
txs[i]:=getmaxx div 2 + round(((zc-zd)*dd)/(xd-xc));
str(i,h);
outtextxy(txs[i]+2,tys[i]+2,h);
end;
writeln('xs',i,'= ',txs[i],' ys',i,'= ',tys[i]);
end;
begin
line(txs[1],tys[1],txs[5],tys[5]);
line(txs[4],tys[4],txs[8],tys[8]);
line(txs[2],tys[2],txs[6],tys[6]);
line(txs[3],tys[3],txs[7],tys[7]);
line(txs[6],tys[6],txs[5],tys[5]);
line(txs[2],tys[2],txs[1],tys[1]);
line(txs[7],tys[7],txs[8],tys[8]);
line(txs[3],tys[3],txs[4],tys[4]);
line(txs[7],tys[7],txs[6],tys[6]);
line(txs[3],tys[3],txs[2],tys[2]);
line(txs[8],tys[8],txs[5],tys[5]);
line(txs[4],tys[4],txs[1],tys[1]);
end;
until (upcase(c)='C');
CloseGraph;
END.
|
