DUzun's Web
Programare, proiecte personale, divertisment

Program Space3D;

​

uses graph, crt, dos, mouse, d3, grph3d, fig3d, Drowing, Keyboard;

const nl=17;

var

    i,j,k  :integer;

    TV     :Vector;

    TP     :Point;

    TW     :Word;

    TmpFigP:TFig;

    lng    :integer;

    f      :text;

​

{-----------------------------------------------------------------------}

Procedure DoEnd(n:word);

begin

 CloseGraph;

 ClearMouseHandler;

 DoneMouse;

 MultikeysDone;

 fig.WriteFile('Fig.tmp');

 fig.done;

 halt(n);

end;

​

procedure output;begin writeln(f,o[1],' ',o[2],' ',o[3],' ',g(a):5:2,' ',g(b):5:2);end;

{-----------------------------------------------------------------------}

function Taste: boolean;

begin

    Taste := true;

    if TestKey(Up_Scan    ) then move(1, 2*speed);

    if TestKey(Down_Scan  ) then move(1,-2*speed);

    if TestKey(Right_Scan ) then move(3, 2*speed);

    if TestKey(Left_Scan  ) then move(3,-2*speed);

    if TestKey(PgDn_Scan  ) then move(2,-2*speed);

    if TestKey(PgUp_Scan  ) then move(2, 2*speed);

​

​

    {W} if TestKey(17) then vb := vb - 0.1;

    {S} if TestKey(31) then vb := vb + 0.1;

    {A} if TestKey(30) then va := va - 0.4;

    {D} if TestKey(32) then va := va + 0.4;

​

    if TestKey(Alt_Scan   ) then va := va + 0.1;

    if TestKey(Ctrl_Scan  ) then va := va - 0.1;

​

    if TestKey(Space_Scan ) then mv[2] := mv[2]+lng div 5;

    if TestKey(Ent_Scan   ) then mv[2] := mv[2]-lng div 5;

    if TestKey(F1_Scan    ) then begin dec(vm);init(vm);end;

    if TestKey(F2_Scan    ) then begin dec(vm);init(vm);end;

    if TestKey(ESC_Scan   ) then DoEnd(0);

{

  if keypressed then begin

    case readkey of

      #27:DoEnd(0);

      #72:move(2, 2*speed);

      #80:move(2,-2*speed);

      #77:move(3, 2*speed);

      #75:move(3,-2*speed);

      #32:mv[2]:=mv[2]+lng div 5;

      #13:mv[2]:=mv[2]-lng div 5;

      'm':begin inc(vm);init(vm);end;

      'M':begin dec(vm);init(vm);end;

      'S':fig.WriteFile('');

    end;

  end else Taste := false;

}

end;

{-----------------------------------------------------------------------}

Procedure Drow;

begin

Sfer(zero,1000);

 with fig do begin

  Drow(fc^);

  with Figs[Index[0]^.n]^ do begin

{   MoveRel((o[1]-xyz[1])div speed,((o[2]-xyz[2])div speed),((o[3]-xyz[3])div speed));}

   outtextxy((mx-length(name))div 2,2,Name);

  end;

 end;

 ShowInfo;

end;

​

{-----------------------------------------------------------------------}

{$I-}

Begin

textmode(259);

randomize;

clrscr;

SetAngles(0, 0);

Fig.Init;

​

     a      := 0;

     b      := 0;

     speed  := 500;

     miu    := (1-1/10);

     grvt[2]:=-speed div 1;

​

     lng := 3000;

​

if paramstr(1)<>'' then Fig.ReadFile(paramstr(1))

                   else Fig.ReadFile('All.3df');

​

{ Drowings ------------------------------------------}

​

DCirc3d(@Fig, zero, lng*3, 33, 1);

DCirc3d(@Fig, zero, lng*3, 33, 2);

DCirc3d(@Fig, zero, lng*3, 33, 3);

​

with Fig do begin

{

  for i:=0 to 20 do begin

    TmpFigP:= figs[AddFig(nil)];

    new(TmpFigP^.Clr);

    TmpFigP^.Clr^:=random($FFFFFF-1000)+1000;

//  TP[1]:=random(lng*500);    TP[2]:=-lng;    TP[3]:=random(lng*500);    TW   :=random(lng*5)+100;

​

    TP:=zero;  TP[1]:=i*lng*10;   TW:=20000;

​

    DCirc3d(TmpFigP, TP, TW, i+3, 2);

  end;

}

end;

{------------------------------------------ / Drowings}

​

//  readkey;

 init(vm);

 assign(f,'Move.poz');

 if exist('Move.poz')then begin

   reset(f);

   while not eof(f) do begin

     readln(f,o[1],o[2],o[3],a,b);  a:=r(a);b:=r(b);

     CalcVec;  Drow;  ChgPage;

     if keypressed and (readkey=#27) then Break;

   end;

   close(f);

 end;

​

​

rewrite(f);

​

  MultikeysInit;

repeat

  GetMouseAngles;  {GetAngles;}

  CalcVec;

//  Fig.CalcDynam;

  CalcDynam;

  Drow;

  ChgPage;

  output;

//   gotoxy(1, 1); writeln(g(a):6:0, ':', g(b):6:0, #13#10);

  Taste;

  if leftbuttonpressed  then move(1,speed);

  if rightbuttonpressed then move(1,-speed);

until middlebuttonpressed;

DoEnd(0);

End.

{-----------------------------------------------------------------------}

​