home *** CD-ROM | disk | FTP | other *** search
/ The Party 1994: Try This At Home / disk_image.bin / source / gallery / subdirs.exe / MAP / SPATH.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-21  |  2KB  |  81 lines
  1.  
  2. {$N+}
  3. type real=single;
  4.  
  5. const wallHeight = 200;
  6.  
  7. {var    P : array[1..500,0..3] of real;}
  8.  
  9. var Iname, Oname : string;
  10.     I : Text;
  11.     O : Text;
  12.  
  13.     lastt,t,x,y,th,lastth : real;  cth : integer;
  14.  
  15. procedure WritePos( freq, time, X, Y, Th : real; cTh : integer; Eye : real; Fog : integer );
  16. const HexD : string[16] = '0123456789abcdef';
  17.   function ToHex( w : longint; l : byte ) : string;
  18.   var s : string;
  19.       i : integer;
  20.   begin
  21.     s := '';
  22.     for i := 1 to 2*l do begin
  23.       s := HexD[ (w mod 16)+1 ] + s;
  24.       w := w div 16;
  25.     end;
  26.     ToHex := '0'+s+'h';
  27.   end;
  28.   function spos(X:real):string;
  29.   begin
  30.     spos := ToHex( round(X*$10000), 4 );
  31.   end;
  32.   function sang(X:real):string;
  33.   begin
  34.     sang := ToHex( round((X+cTH*360)/45*$100), 2 );
  35.   end;
  36. var ed : word;
  37. begin
  38.   ed := round(Eye*WallHeight);
  39.   if ed <= 5 then ed := 5;
  40.   if ed >195 then ed := 195;
  41.   writeln(O,'   SKey  <',round(TIME*freq):6,', ',spos(X),', ',spos(Y),', ',sang(Th),', ',round(ed):3,', ',Fog:3,' >');
  42. end;
  43.  
  44.  
  45. BEGIN
  46.   writeln('SPATH - script generator from TPATH output // A.R-M. 7/93');
  47.   writeln;
  48.   if paramcount<2 then begin
  49.     writeln('Usage: SPATH InputFile OutputFile');
  50.     Halt(1);
  51.   end;
  52.  
  53.   Iname := ParamStr(1);
  54.   Oname := ParamStr(2);
  55.  
  56.   cTH := 16;
  57.   lastth := 180;
  58.   lastt := -1;
  59.  
  60.   assign(I,Iname); reset(I);
  61.   assign(O,Oname); rewrite(O);
  62.   writeln(O,'; script created from "',Iname,'"');
  63.   writeln(O);
  64.  
  65.  
  66.   repeat
  67.     readln(I, t,x,y,th);
  68.     if abs(th-lastth)>180 then begin
  69.       if th>lastth then cTH := cTH-1 else cTH := cTH+1;
  70.     end;
  71.     lastth := th;
  72.     if abs(lastt-t)>0.05 then WritePos( 1, t, x, y, th, cth, 0.5, 9 );
  73.     lastt := t;
  74.   until EOF(I);
  75.  
  76.   WritePos( 1, t*4, x, y, th, cth, 0.5, 255 );
  77.  
  78.   close(O);
  79.   close(I);
  80. END.
  81.