1 files changed, 108 insertions, 0 deletions
diff --git a/projection.pas b/projection.pas
new file mode 100644
index 0000000..60fe0cc
--- /dev/null
+++ b/projection.pas
@@ -0,0 +1,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.
+