home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / diverace.zip / SOURCE.ZIP / source / work / dreid.pas < prev    next >
Pascal/Delphi Source File  |  1995-08-28  |  23KB  |  884 lines
  1. (***************************************************************************
  2.   DREID does 3-D calculations for the game.
  3.  
  4.   This Unit is ported from a stone-aged dos app and is quite proprietary for
  5.   this Game. Perhaps you can make need of the graphics primitives in the
  6.   gfx unit.
  7.  
  8. ****************************************************************************)
  9.  
  10. unit dreid;
  11.  
  12.  
  13. interface
  14.  
  15. uses OS2PMAPI,use32,gfxfunc;
  16.  
  17. const maxobjpts = 4;
  18.       maxcarnum = 10;
  19.  
  20.       ymax=199;
  21.       xmax=399; (*Value+1 has to be at DWORD boundary !!*)
  22.       xpels=xmax+1;
  23.  
  24.  
  25. type
  26.   objekte = record
  27.               Anz_Punkte : integer;
  28.               maxwid : integer;
  29.               ardir : integer;{Normal-Angle on Area, -1 for none}
  30.               xm,ym,zm : longint; {Center}
  31.               xo,yo,zo:array[0..maxobjpts-1] of Longint;{Object coords}
  32.               dist:integer;
  33.               Farbe : byte;
  34.             end;
  35.  
  36.  carentry = record
  37.               cx,cz : longint;    {Position}
  38.               cyw : integer;      {Angle}
  39.               carsp : integer;
  40.               lastdist : integer;
  41.               Col1,Col2 : byte;   {Colours}
  42.             end;
  43.  
  44.   carlist = record
  45.               carnum : integer;
  46.               carinfo : array[0..MaxCarnum] of CarEntry;
  47.             end;
  48.  
  49.      proj = record
  50.               xp,yp,zp:array[0..maxobjpts-1] of Longint;{Position relativ to viewing point}
  51.               disppunkte : integer;
  52.               scr:array[0..maxobjpts] of pixel;       {Screen-coords}
  53.               display:boolean;
  54.             end;
  55.  
  56.  
  57.   world = record
  58.             objnum : integer;
  59.             obj : array[1..500] of objekte;
  60.           end;
  61.  
  62.   dispentry = record
  63.                 num : integer;
  64.                 objdist : longint;
  65.               end;
  66.   displist = record
  67.                dispnum : integer;
  68.                dispobj : array[1..MaxCarnum] of dispentry;
  69.              end;
  70.  
  71.  
  72.  
  73. (*Procedure Mode(x:word);*)
  74. Procedure Display(x,y,z:longint;yangle:integer;var cl:carlist);
  75. Function pisin(faktor:integer;winkel:integer):longint;
  76. Function picos(faktor:integer;winkel:integer):longint;
  77. Function GetAngle(x,z:integer):integer;
  78.  
  79. Procedure Projektion(var o:Objekte;var p:proj);
  80.  
  81. Procedure InitDreid;
  82.  
  83.  
  84. const
  85.   faktor=5;
  86.   {Keycodes}
  87.   ESC = #27;
  88.   CR  = #13;
  89.   F1  = #59;
  90.   F2  = #60;
  91.   F3  = #61;
  92.   F4  = #62;
  93.   F5  = #63;
  94.   F6  = #64;
  95.   F7  = #65;
  96.   F8  = #66;
  97.   F9  = #67;
  98.   F10 = #68;
  99.   LeftKey  = #75;
  100.   RightKey = #77;
  101.   CtrlLeftKey = #115;
  102.   CtrlRightKey = #116;
  103.   CtrlPgUpKey = #132;
  104.   CtrlPgDnKey = #118;
  105.   UpKey    = #72;
  106.   DownKey  = #80;
  107.   PgUpKey  = #73;
  108.   PgDnKey  = #81;
  109.   HomeKey  = #71;
  110.   EndKey   = #79;
  111.   DelKey   = #83;
  112.   InsKey   = #82;
  113.  
  114.  
  115.  
  116. type
  117.   dispbuffer_arr = array[0..(ymax+1)*(xmax+1)-1] of Byte;
  118.  
  119. var
  120.   tsin,tcos : array[0..360] of SmallInt;
  121.   tatn      : array[0..100] of SmallInt;
  122.   isin,icos : array[0..360] of SmallInt;
  123.   linecol   : array[0..ymax] of integer;
  124.  
  125.   wo : world;
  126.   dl : displist;
  127.   linemode : boolean;
  128.   test:integer;
  129.  
  130.   dispbuffer:^dispbuffer_arr;
  131.  
  132.  
  133. implementation
  134.  
  135.  
  136. const
  137.       pa = (100*xpels) div 320; {Distance to projection area}
  138.  
  139.  
  140.   ColOfs = 16;
  141.  
  142.   Black         = 0 +ColOfs;
  143.   Blue          = 1 +ColOfs;
  144.   Green         = 2 +ColOfs;
  145.   Cyan          = 3 +ColOfs;
  146.   Red           = 4 +ColOfs;
  147.   Magenta       = 5 +ColOfs;
  148.   Brown         = 6 +ColOfs;
  149.   LightGray     = 7 +ColOfs;
  150.   DarkGray      = 8 +ColOfs;
  151.   LightBlue     = 9 +ColOfs;
  152.   LightGreen    = 10+ColOfs;
  153.   LightCyan     = 11+ColOfs;
  154.   LightRed      = 12+ColOfs;
  155.   LightMagenta  = 13+ColOfs;
  156.   Yellow        = 14+ColOfs;
  157.   White         = 15+ColOfs;
  158.  
  159.  
  160.   baumstamm : objekte = (anz_punkte:4;maxwid:0;ardir:-1;xm:0;ym:0;zm:0;xo:(-8,-8,8,8);
  161.                          yo:(0,50,50,0);zo:(0,0,0,0);dist:2000;farbe:Brown);
  162.   baumkrone : objekte = (anz_punkte:3;maxwid:0;ardir:-1;xm:0;ym:0;zm:0;xo:(-38,0,38,0);
  163.                          yo:(50,110,50,0);zo:(0,0,0,0);dist:2000;farbe:Green);
  164.  
  165.   cardist= 2000*faktor;
  166.   carobjs= 9;
  167.   car : array[1..carobjs] of objekte = (
  168.                      (anz_punkte:4;maxwid:0;ardir:-1;xm:0;ym:0;zm:0;xo:(-30,-30,-30,-30);
  169.                          yo:(5,0,0,5);zo:(-20,-20,-32,-32);dist:1000;farbe:DarkGray),
  170.                      (anz_punkte:4;maxwid:0;ardir:-1;xm:0;ym:0;zm:0;xo:(30,30,30,30);
  171.                          yo:(5,0,0,5);zo:(-20,-20,-32,-32);dist:1000;farbe:DarkGray),
  172.                      (anz_punkte:4;maxwid:0;ardir:-1;xm:0;ym:0;zm:0;xo:(-30,-30,-30,-30);
  173.                          yo:(5,0,0,5);zo:(24,24,12,12);dist:1000;farbe:DarkGray),
  174.                      (anz_punkte:4;maxwid:0;ardir:-1;xm:0;ym:0;zm:0;xo:(30,30,30,30);
  175.                          yo:(5,0,0,5);zo:(24,24,12,12);dist:1000;farbe:DarkGray),
  176.                      (anz_punkte:3;maxwid:0;ardir:-1;xm:0;ym:0;zm:0;xo:(-30,-30,0,0);
  177.                          yo:(5,5,10,0);zo:(-50,40,50,0);dist:2000;farbe:LightRed),
  178.                      (anz_punkte:3;maxwid:0;ardir:-1;xm:0;ym:0;zm:0;xo:(30,0,30,0);
  179.                          yo:(5,10,5,0);zo:(-50,50,40,0);dist:2000;farbe:LightRed),
  180.                      (anz_punkte:3;maxwid:0;ardir:-1;xm:0;ym:0;zm:0;xo:(-30,0,0,0);
  181.                          yo:(5,10,30,0);zo:(-50,50,-50,0);dist:2000;farbe:Blue),
  182.                      (anz_punkte:3;maxwid:0;ardir:-1;xm:0;ym:0;zm:0;xo:(0,0,30,0);
  183.                          yo:(30,10,5,0);zo:(-50,50,-50,0);dist:2000;farbe:Blue),
  184.                      (anz_punkte:3;maxwid:0;ardir:0;xm:0;ym:13;zm:-50;xo:(-30,0,30,0);
  185.                          yo:(5,30,5,0);zo:(-50,-50,-50,0);dist:2000;farbe:Blue));
  186.  
  187.  
  188. var
  189.   xv,yv,zv : longint; {Position}
  190.   yw : integer; {viewing angle around y-axis}
  191.   p : proj;
  192.  
  193.  
  194.   sinyw,cosyw:integer;
  195.  
  196. const
  197.   bufflen=sizeof(dispbuffer_arr);
  198.  
  199.  
  200. Function pisin(faktor:longint;winkel:integer):LONGINT;
  201. BEGIN
  202.   pisin:=(faktor*tsin[winkel]) div 1000;
  203. END;
  204.  
  205. Function picos(faktor,winkel:LONGINT):LONGINT;
  206. BEGIN
  207.   picos:=(faktor*tcos[winkel]) div 1000;
  208. END;
  209.  
  210.  
  211. Procedure ScanObjects(var w:world);
  212.  
  213. var f:text;
  214.     s:string;
  215.     o:objekte;
  216.     i,dx,dy,dz,px,py,pz:integer;
  217.     rc:longint;
  218.  
  219.   Procedure CutSpaces(var s:string);
  220.   begin
  221.     while (length(s)>0) and (s[1]=' ') do
  222.       delete(s,1,1);
  223.   end;
  224.  
  225.   Function GetNum(var s:string):integer;
  226.   var n:integer;
  227.   begin
  228.     CutSpaces(s);
  229.     n:=0;
  230.     while (length(s)>0) and (s[1]>='0') and (s[1]<='9') do
  231.     begin
  232.       n:=n*10+(ord(s[1])-ord('0'));
  233.       delete(s,1,1);
  234.     end;
  235.     GetNum:=n;
  236.   end;
  237.  
  238. begin
  239.   with w do
  240.   begin
  241.     ObjNum:=0;
  242.     assign(f,'RACE.LST');
  243.     {$I-}reset(f);{$I+}
  244.     if ioresult<>0 then begin
  245.       rc:=WinMessageBox( HWND_DESKTOP, HWND_DESKTOP,
  246.          'File RACE.LST not in current directory !!',
  247.          'Error!', 0, MB_OK or MB_MOVEABLE );
  248.       HALT;
  249.     end
  250.     else
  251.     begin
  252.       repeat
  253.         readln(f,s);
  254.       until pos('OBJECTS:',s)<>0;
  255.       readln(f,s);
  256.       while pos('ANIMATORS:',s)=0 do
  257.       begin
  258.         if pos('"',s)<>0 then
  259.         begin
  260.           if pos('"RCTNGL',s)=6 then
  261.           begin
  262.             inc(ObjNum);
  263.             with obj[Objnum] do
  264.             begin
  265.               readln(f,s);
  266.               s:=copy(s,17,255);
  267.               px:=Getnum(s);
  268.               py:=Getnum(s)-20;{Adjust}
  269.               pz:=Getnum(s);
  270.               s:=copy(s,7,255);
  271.               dx:=Getnum(s);
  272.               dy:=Getnum(s);
  273.               dz:=Getnum(s);
  274.               Anz_Punkte:=4;
  275.               xo[0]:=px;
  276.               xo[1]:=px;
  277.               xo[2]:=px+dx;
  278.               xo[3]:=px+dx;
  279.               zo[0]:=pz;
  280.               zo[1]:=pz+dz;
  281.               zo[2]:=pz+dz;
  282.               zo[3]:=pz;
  283.               yo[0]:=py;
  284.               yo[1]:=py;
  285.               yo[2]:=py+dy;
  286.               yo[3]:=py+dy;
  287.               readln(f,s);
  288.               dist:=2000;
  289.               if (pos('15x7',s)<>0) then
  290.                 Farbe:=Black
  291.               else
  292.                 if (pos('4x8',s)<>0) then
  293.                 begin
  294.                   Farbe:=White;
  295.                   dist:=1000;
  296.                 end
  297.                 else
  298.                   if (pos('8x5',s)<>0) or (pos('15,15',s)<>0) then
  299.                     Farbe:=Brown
  300.                   else
  301.                     begin farbe:=White end;
  302.             end;
  303.           end
  304.           else
  305.             if pos('"QUAD',s)=6 then
  306.             begin
  307.               inc(ObjNum);
  308.               with obj[Objnum] do
  309.               begin
  310.                 readln(f,s);
  311.                 s:=copy(s,17,255);
  312.                 px:=Getnum(s);
  313.                 py:=Getnum(s)-20;{Adjust}
  314.                 pz:=Getnum(s);
  315.                 Anz_Punkte:=4;
  316.                 readln(f,s);
  317.                 if pos('15x7',s)<>0 then
  318.                 begin
  319.                   farbe:=Black;
  320.                   dist:=2000;
  321.                 end
  322.                 else
  323.                   if pos('4x8',s)<>0 then
  324.                   begin
  325.                     farbe:=White;
  326.                     dist:=1000;
  327.                   end
  328.                   else
  329.                     farbe:=White;
  330.                 for i:=0 to 3 do
  331.                 begin
  332.                   readln(f,s);
  333.                   s:=copy(s,17,255);
  334.                   dx:=Getnum(s);
  335.                   dy:=Getnum(s);
  336.                   dz:=Getnum(s);
  337.                   xo[i]:=px+dx;
  338.                   yo[i]:=py+dy;
  339.                   zo[i]:=pz+dz;
  340.                 end;
  341.               end;
  342.             end
  343.             else
  344.               if pos('"TRNGLE',s)=6 then
  345.               begin
  346.                 inc(ObjNum);
  347.                 with obj[Objnum] do
  348.                 begin
  349.                   readln(f,s);
  350.                   s:=copy(s,17,255);
  351.                   px:=Getnum(s);
  352.                   py:=Getnum(s)-20;{Adjust}
  353.                   pz:=Getnum(s);
  354.                   Anz_Punkte:=3;
  355.                   readln(f,s);
  356.                   dist:=2000;
  357.                   if (pos('2x12',s)<>0) then
  358.                     farbe:=Green
  359.                   else
  360.                     farbe:=White;
  361.                   for i:=0 to 2 do
  362.                   begin
  363.                     readln(f,s);
  364.                     s:=copy(s,17,255);
  365.                     dx:=Getnum(s);
  366.                     dy:=Getnum(s);
  367.                     dz:=Getnum(s);
  368.                     xo[i]:=px+dx;
  369.                     yo[i]:=py+dy;
  370.                     zo[i]:=pz+dz;
  371.                   end;
  372.                 end;
  373.               end;
  374.         end;
  375.         readln(f,s);
  376.       end;
  377.       close(f);
  378.     end;
  379.   end;
  380. end;
  381.  
  382.  
  383.  
  384. Function GetAngle(x,z:integer):integer;
  385.  
  386. var
  387.   ofs:integer;
  388. begin
  389.   if (x=0) and (z=0) then
  390.     GetAngle:=0 {Sonderfall}
  391.   else
  392.     if abs(x)>=abs(z) then
  393.       if (x>=0) and (z>=0) then
  394.         GetAngle:=tatn[(longint(z)*100) div x]
  395.       else
  396.         if (x<0) and (z>=0) then
  397.           GetAngle:=180-tatn[(longint(z)*100) div -x]
  398.         else
  399.           if (x<0) and (z<0) then
  400.             GetAngle:=180+tatn[(longint(z)*100) div x]
  401.           else
  402.             GetAngle:=360-tatn[(longint(-z)*100) div x]
  403.     else
  404.       if (x>=0) and (z>=0) then
  405.         GetAngle:=90-tatn[(longint(x)*100) div z]
  406.       else
  407.         if (x<0) and (z>=0) then
  408.           GetAngle:=90+tatn[(longint(-x)*100) div z]
  409.         else
  410.           if (x<0) and (z<0) then
  411.             GetAngle:=270-tatn[(longint(x)*100) div z]
  412.           else
  413.             GetAngle:=270+tatn[(longint(x)*100) div -z];
  414. end;
  415.  
  416.  
  417.  
  418. Procedure InitSinCos;
  419.  
  420. var i:integer;
  421. begin
  422.   for i:=0 to 360 do
  423.   begin
  424.     tsin[i]:=round(sin(i*pi/180.0)*1000);
  425.     tcos[i]:=round(cos(i*pi/180.0)*1000);
  426.     isin[i]:=round(sin(i*pi/180.0)*1024); {Shiftable}
  427.     icos[i]:=round(cos(i*pi/180.0)*1024);
  428.   end;
  429.   for i:=0 to 100 do
  430.     tatn[i]:=round(arctan(i/100)*180.0/pi);
  431. end;
  432.  
  433.  
  434. Procedure ObjMult(var w:world;f:integer);
  435.  
  436. var k,i,j,m2:integer;
  437. begin
  438.   with w do begin
  439.     i:=0;
  440.     while i<objnum do begin
  441.       inc(i);
  442. (*    for i:=1 to objnum do begin
  443.       k:=i;*)
  444.       with obj[i] do
  445.       begin
  446.         xm:=0;
  447.         ym:=0;
  448.         zm:=0;
  449.         dist:=dist*f;
  450.         for j:=0 to anz_punkte-1 do
  451.         begin
  452.           xo[j]:=xo[j]*f;
  453.           inc(xm,xo[j]);
  454.           yo[j]:=yo[j]*f;
  455.           inc(ym,yo[j]);
  456.           zo[j]:=zo[j]*f;
  457.           inc(zm,zo[j]);
  458.         end;
  459.         if anz_punkte=4 then
  460.           maxwid:=round(sqrt(sqr(xo[2]-xo[0])+sqr(zo[2]-zo[0])))
  461.         else
  462.         begin
  463.           maxwid:=round(sqrt(sqr(xo[1]-xo[0])+sqr(zo[1]-zo[0])));
  464.           m2:=round(sqrt(sqr(xo[2]-xo[1])+sqr(zo[2]-zo[1])));
  465.           if m2>maxwid then maxwid:=m2;
  466.           m2:=round(sqrt(sqr(xo[0]-xo[2])+sqr(zo[0]-zo[2])));
  467.           if m2>maxwid then maxwid:=m2;
  468.         end;
  469.         xm:=xm div anz_punkte;
  470.         ym:=ym div anz_punkte;
  471.         zm:=zm div anz_punkte;
  472.       end;
  473.     end;
  474.   end;
  475.  
  476.  
  477.   for i:=1 to carobjs do begin
  478.     with car[i] do
  479.     begin
  480.       dist:=dist*f;
  481.       for j:=0 to anz_punkte-1 do
  482.       begin
  483.         xo[j]:=xo[j]*f;
  484.         yo[j]:=yo[j]*f;
  485.         zo[j]:=zo[j]*f;
  486.       end;
  487.       xm:=xm*f;
  488.       ym:=ym*f;
  489.       zm:=zm*f;
  490.       if anz_punkte=4 then
  491.         maxwid:=round(sqrt(sqr(xo[1]-xo[0])+sqr(zo[2]-zo[1])))
  492.       else
  493.       begin
  494.         maxwid:=round(sqrt(sqr(xo[1]-xo[0])+sqr(zo[1]-zo[0])));
  495.         m2:=round(sqrt(sqr(xo[2]-xo[1])+sqr(zo[2]-zo[1])));
  496.         if m2>maxwid then maxwid:=m2;
  497.         m2:=round(sqrt(sqr(xo[0]-xo[2])+sqr(zo[0]-zo[2])));
  498.         if m2>maxwid then maxwid:=m2;
  499.       end;
  500.     end;
  501.   end;
  502. end;
  503.  
  504.  
  505.  
  506. Procedure Drehe(var o:objekte;x,z:longint;w:integer);
  507. var i:integer;
  508.     x2:longint;
  509. begin
  510.   with o do
  511.     for i:=0 to anz_punkte-1 do
  512.     begin
  513.       x2:=x-picos(xo[i],w)+pisin(zo[i],w);
  514.       zo[i]:=z+picos(zo[i],w)+pisin(xo[i],w);
  515.       xo[i]:=x2;
  516.     end;
  517. end;
  518.  
  519. Procedure AddTrees(var w:world);
  520. var
  521.   f:text;
  522.   s:string[100];
  523.   i,j : integer;
  524.   x,z:integer;
  525.  
  526. begin
  527.   assign(f,'COURSE1.TXT');
  528.   {$I-}reset(f);{$I+}
  529.   if ioresult<>0 then begin
  530.     WinMessageBox( HWND_DESKTOP, HWND_DESKTOP,
  531.        'File COURSE1.TXT not in current directory !!',
  532.        'Error!', 0, MB_OK or MB_MOVEABLE );
  533.     HALT;
  534.   end
  535.   else
  536.     with w do
  537.     begin
  538.       readln(f,s);
  539.       for i:=0 to 81 do
  540.       begin
  541.         readln(f,s);
  542.         s:=copy(s,3,82);
  543.         for j:=0 to 81 do
  544.           if s[j+1] in ['>','^'] then
  545.           begin
  546.             inc(objnum);
  547.             obj[objnum]:=Baumstamm;
  548.             if s[j+1]='>' then
  549.               Drehe(obj[objnum],j*100+50,i*100+50,90)
  550.             else
  551.               Drehe(obj[objnum],j*100+50,i*100+50,0);
  552.             inc(objnum);
  553.             obj[objnum]:=Baumkrone;
  554.             if s[j+1]='>' then
  555.               Drehe(obj[objnum],j*100+50,i*100+50,90)
  556.             else
  557.               Drehe(obj[objnum],j*100+50,i*100+50,0);
  558.           end;
  559.       end;
  560.       close(f);
  561.     end;
  562. end;
  563.  
  564. Function To180(x:integer):integer;
  565. begin
  566.   x:=x mod 360;
  567.   if x>180 then dec(x,360)
  568.   else
  569.     if x<-180 then inc(x,360);
  570.   To180:=x;
  571. end;
  572.  
  573. Procedure SortDispList(var dl:displist);
  574. var c:integer;
  575.     i:integer;
  576.     h:longint;
  577. begin
  578.   with dl do begin
  579.     repeat
  580.       c:=0;
  581.       for i:=1 to dispnum-1 do
  582.         with dispobj[i] do
  583.           if objdist<dispobj[i+1].objdist then
  584.         begin
  585.           h:=objdist;objdist:=dispobj[i+1].objdist;dispobj[i+1].objdist:=h;
  586.           h:=num;num:=dispobj[i+1].num;dispobj[i+1].num:=h;
  587.           inc(c);
  588.         end;
  589.     until c=0;
  590.   end;
  591. end;
  592.  
  593.  
  594. Procedure Display(x,y,z:longint;yangle:integer;var cl:carlist);
  595.  
  596. const
  597.   sky=11;
  598.   ground=10;
  599. var
  600.   c:char;
  601.   i,j:integer;
  602.   odreh:objekte;
  603.   cxf,czf,cdist:longint;
  604.   adr:word;
  605.  
  606.   tempangle:integer;
  607.  
  608. begin
  609.   with wo do
  610.   begin
  611.     xv:=-x*faktor;
  612.     yv:=-y*faktor;
  613.     zv:=-z*faktor;
  614.     yw:=yangle;
  615.     sinyw:=tsin[yw];
  616.     cosyw:=tcos[yw];
  617.  
  618. (*    asm
  619.       push ds
  620.       pop es
  621.       mov di,OFFSET Buffer
  622.       cld
  623.       mov al,100
  624.     @1:
  625.       mov ah,al
  626.       mov cx,160
  627.       rep stosw
  628.       inc al
  629.       cmp al,200
  630.       jne @1
  631.     end;*)
  632.  
  633.     adr:=0;
  634.     for i:=0 to ymax do
  635.     begin
  636.       Fillchar(DispBuffer^[adr],xpels,linecol[i]);
  637.       inc(adr,xpels);
  638.     end;
  639.  
  640.     for i:=1 to objnum do
  641.     begin
  642.       with obj[i],p do
  643.       begin
  644.         if abs(xv+xm)+abs(zv+zm)<=dist then
  645.         begin
  646.           Projektion(obj[i],p);
  647.           if display then
  648.             if disppunkte=4 then
  649.               FillQuad(scr[0],scr[1],scr[2],scr[3],Farbe)
  650.             else
  651.               if disppunkte=5 then
  652.               begin
  653.                 FillTria(scr[0],scr[1],scr[2],Farbe);
  654.                 FillQuad(scr[2],scr[3],scr[4],scr[0],Farbe);
  655.               end
  656.               else
  657.                 if disppunkte=3 then
  658.                 begin
  659.                   FillTria(scr[0],scr[1],scr[2],Farbe);
  660.                 end
  661.         end;
  662.       end;
  663.     end;
  664.  
  665.     with cl,dl do
  666.     begin
  667.       dispnum:=0;
  668.       for i:=1 to cl.carnum do
  669.         with carinfo[i] do
  670.         begin
  671.           cdist:=abs(xv+cx*faktor)+abs(zv+cz*faktor);
  672.           if cdist<=cardist then
  673.           begin
  674.             inc(dispnum);
  675.             dispobj[dispnum].objdist:=cdist;
  676.             dispobj[dispnum].num:=i;
  677.           end;
  678.         end;
  679.     end;
  680.  
  681.     SortDispList(dl);
  682.  
  683.     with dl,cl do (*Show cars*)
  684.     begin
  685.       for i:=1 to dl.dispnum do
  686.         with carinfo[dispobj[i].num] do
  687.         begin
  688.           cxf:=cx*faktor;
  689.           czf:=cz*faktor;
  690.           car[7].farbe:=col1;
  691.           car[8].farbe:=col1;
  692.           car[9].farbe:=col1+8;
  693.           for j:=1 to carobjs do
  694.           begin
  695.             if dispobj[i].objdist<=car[j].dist then
  696.             begin
  697.               odreh:=car[j];
  698.               with odreh,p do
  699.               begin
  700.                 if ardir<0 then
  701.                   display:=true
  702.                 else
  703.                 begin
  704.                   drehe(odreh,cxf,czf,cyw);
  705.  
  706.                   tempangle:=GetAngle(zo[1]+zv,xo[1]+xv);
  707.                   display:=abs(to180(ardir-cyw+tempangle))<=90;
  708.  
  709. {                  display:=abs(to180(ardir-cyw+GetAngle(zo[1]+zv,xo[1]+xv)))<=90;}
  710.                 end;
  711.                 if (dispobj[i].num=2) and (ardir>=0) then
  712.                   test:=GetAngle(zo[1]+zv,xo[1]+xv);
  713.                 if display then
  714.                 begin
  715.                   if ardir<0 then
  716.                     drehe(odreh,cxf,czf,cyw);
  717.                   Projektion(odreh,p);
  718.                   if display then
  719.                     if disppunkte=4 then
  720.                     begin
  721.                       FillQuad(scr[0],scr[1],scr[2],scr[3],Farbe)
  722.                     end
  723.                     else
  724.                       if disppunkte=5 then
  725.                       begin
  726.                         FillTria(scr[0],scr[1],scr[2],Farbe);
  727.                         FillQuad(scr[2],scr[3],scr[4],scr[0],Farbe);
  728.                       end
  729.                       else
  730.                         if disppunkte=3 then
  731.                         begin
  732.                           FillTria(scr[0],scr[1],scr[2],Farbe);
  733.                         end
  734.                 end;
  735.               end;
  736.             end;
  737.           end;
  738.         end;
  739.     end;
  740.  
  741. (*    asm
  742.       mov si,OFFSET Buffer
  743.       mov ax,0a000h
  744.       mov es,ax
  745.       mov di,10*320
  746.       mov cx,Bufflen
  747.       shr cx,1
  748.       cld
  749.       rep movsw
  750.     end;*)
  751. (*    Move(Buffer,Mem[$a000:10*320],sizeof(Buffer));*)
  752.   end;
  753. end;
  754.  
  755.  
  756. Procedure Projektion(var o:Objekte;var p:proj);
  757. (*begin end;*)
  758.  
  759. var i,pts:integer;
  760.     dispcnt :integer;
  761.  
  762.    Function Norm(x:integer):integer;
  763.    begin
  764.      if x<0 then
  765.        inc(x,pts)
  766.      else
  767.        if x>=pts then
  768.          dec(x,pts);
  769.      Norm:=x;
  770.    end;
  771.  
  772.    Function Interp(x1,x2,z1,z2:Longint):longint;
  773.    begin (*x1 lies behind projection area, x2 in front of it*)
  774.      Interp:=( ((x1-x2)*(z2-pa)) div (z2-z1)) + x2;
  775.    end;
  776.  
  777. BEGIN
  778.   With o,p do
  779.   begin
  780.     pts:=Anz_Punkte;
  781.     dispcnt:=0;
  782.     display:=false;
  783.     zp[0]:=picos(zo[0]+zv,yw)+pisin(xo[0]+xv,yw);
  784. (*      if (abs(xo[0]+xv)>maxint) or (abs(zo[0]+zv)>maxint) then
  785.         begin xv:=xv;end;*)
  786.     if zp[0]<pa-maxwid then
  787.     begin
  788.       exit;
  789.     end;
  790.     if zp[0]>=pa then inc(dispcnt);
  791.     for i:=1 to pts-1 do
  792.     begin
  793. (*      if (abs(xo[i]+xv)>maxint) or (abs(zo[i]+zv)>maxint) then
  794.         begin xv:=xv;end;*)
  795.       zp[i]:=picos(zo[i]+zv,yw)+pisin(xo[i]+xv,yw);
  796.       if zp[i]>=pa then inc(dispcnt);
  797.     end;
  798.     if dispcnt>0 then
  799.     begin
  800.       for i:=0 to pts-1 do
  801.       begin
  802.         xp[i]:=picos(xo[i]+xv,yw)-pisin(zo[i]+zv,yw);
  803.         yp[i]:=yo[i]+yv;
  804.       end;
  805.  
  806.       display:=true;
  807.       disppunkte:=pts;
  808.       if dispcnt=pts then
  809.       begin
  810.         for i:=0 to pts-1 do
  811.           with scr[i] do
  812.           begin
  813.             x:=(xmax shr 1)+((pa*xp[i]) div zp[i]);(*ProjMul(xp[i],zp[i]);*)
  814.             y:=(ymax shr 1)-((pa*yp[i]) div zp[i]);(*ProjMul(yp[i],zp[i]);*)
  815. (*            x:=(xmax shr 1)+((pa*xp[i]) div zp[i]);
  816.             y:=(ymax shr 1)-((pa*yp[i]) div zp[i]);*)
  817.           end
  818.       end
  819.       else
  820.       begin
  821.         disppunkte:=0;
  822.         for i:=0 to pts-1 do
  823.           if zp[i]>=pa then (*calculate the correct points*)
  824.           begin
  825.             with scr[disppunkte] do
  826.             begin
  827.               x:=(xmax shr 1)+((pa*xp[i]) div zp[i]);(*ProjMul(xp[i],zp[i]);*)
  828.               y:=(ymax shr 1)-((pa*yp[i]) div zp[i]);(*ProjMul(yp[i],zp[i]);*)
  829. (*              x:=(xmax shr 1)+((pa*xp[i]) div zp[i]);
  830.               y:=(ymax shr 1)-((pa*yp[i]) div zp[i]);*)
  831.             end;
  832.             inc(disppunkte);
  833.             if zp[norm(i+1)]<pa then (*next point invisible ?*)
  834.             begin
  835.               with scr[disppunkte] do
  836.               begin
  837.                 x:=(xmax shr 1)+Interp(xp[norm(i+1)],xp[i],
  838.                                                     zp[norm(i+1)],zp[i]);
  839.                 y:=(ymax shr 1)-Interp(yp[norm(i+1)],yp[i],
  840.                                                     zp[norm(i+1)],zp[i]);
  841.               end;
  842.               inc(disppunkte);
  843.             end;
  844.           end
  845.           else (*Jetziger nicht sichtbar*)
  846.             if zp[norm(i+1)]>=pa then (*Nächster Punkt wieder sichtbar ?*)
  847.             begin
  848.               with scr[disppunkte] do
  849.               begin
  850.                 x:=(xmax shr 1)+Interp(xp[i],xp[norm(i+1)],
  851.                                                     zp[i],zp[norm(i+1)]);
  852.                 y:=(ymax shr 1)-Interp(yp[i],yp[norm(i+1)],
  853.                                                     zp[i],zp[norm(i+1)]);
  854.               end;
  855.               inc(disppunkte);
  856.             end;
  857.       end;
  858.     end;
  859.   end;
  860. end;
  861.  
  862.  
  863. Procedure InitDreid;
  864. var i:longint;
  865. begin
  866.   InitSinCos;
  867.   ScanObjects(wo);
  868.   AddTrees(wo);
  869.   ObjMult(wo,faktor);
  870.   with wo do
  871.   begin
  872.     xv:=-3000*faktor;
  873.     yv:=-100;
  874.     zv:=-200*faktor;
  875.     yw:=270;
  876.   end;
  877. (*  FillChar(DispBuffer^,sizeof(DispBuffer_Arr),0);*)
  878.   linemode:=false;
  879.   for i:=0 to ymax do
  880.     linecol[i]:=((i*99) div ymax)+100;
  881. end;
  882.  
  883. end.
  884.