home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SHUTTL.ZIP / SH.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-03-26  |  7.3 KB  |  245 lines
  1. {C-}
  2. PROGRAM DEMO;
  3. uses
  4.   crt,graph,gr_unt;
  5. const
  6.    maxa     =300;
  7.    maxv     =124;
  8.    maxe     =259;
  9.    data:array[1..631] of real = (
  10.    0,-2.2,46,1.5,-2.6,46,2.2,-4.6,46,1.7,-6.5,46,0,-6.7,46,
  11.    -1.7,-6.5,46,-2.2,-4.6,46,-1.5,-2.6,46,
  12.    0,-0.8,43,2.8,-1.5,43,4,-4.5,43,3,-7.2,43,0,-8,43,-3,-7.2,43,
  13.    -4,-4.5,43,-2.8,-1.5,43,
  14.    0,1.7,38,4.6,0,38,5.8,-4.4,38,4,-8.2,38,0,-9,38,-4,-8.2,38,
  15.    -5.8,-4.4,38,-4.6,0,38,
  16.    0,4,32.5,4.5,1,32.5,5.8,-4.6,32.5,4,-9,32.5,0,-9.5,32.5,-4,-9,32.5,
  17.    -5.8,-4.6,32.5,-4.5,1,32.5,
  18.    0,8,26.3,3.5,7,26.3,7.8,2,26.3,8,-7,26.3,0,-9.8,26.3,-8,-7,26.3,
  19.    -7.8,2,26.3,-3.5,7,26.3,
  20.    0,8,21.5,3.8,7.5,21.5,8,3,21.5,8,-8,21.5,0,-9.8,21.5,-8,-8,21.5,
  21.    -8,3,21.5,-3.8,7.5,21.5,
  22.    0,8,14,4.7,7,14,8,4,14,8,-8.7,14,0,-10,14,-8,-8.7,14,-8,4,14,
  23.    -4.7,7,14,
  24.    0,8,4,4.7,7,4,8,4,4,8,-8.7,4,0,-10,4,-8,-8.7,4,-8,4,4,
  25.    -4.7,7,4,
  26.    0,8,-12,4.7,7,-12,8,4,-12,8,-8.7,-12,0,-10,-12,-8,-8.7,-12,-8,4,-12,
  27.    -4.7,7,-12,
  28.    0,8,-27.3,4.7,7,-27.3,8,4,-27.3,8,-8.7,-27.3,0,-10,-27.3,-8,-8.7,-27.3,
  29.    -8,4,-27.3,-4.7,7,-27.3,
  30.    0,8,-35.6,4.7,7,-35.6,8,4,-35.6,8,-8.7,-35.6,0,-10,-35.6,-8,-8.7,-35.6,
  31.    -8,4,-35.6,-4.7,7,-35.6,
  32.    0,9,-43,2,8.5,-43,8.8,1.5,-43,9,-10,-43,0,-10.8,-43,-9,-10,-43,
  33.    -8.8,1.5,-43,-2,8.5,-43,
  34.    0,9.5,-48,2,9.3,-48,9.2,1.5,-48,10,-10,-48,0,-10.2,-48,-10,-10,-48,
  35.    -9.2,1.5,-48,-2,9.3,-48,
  36.    8.7,-8.7,21,15,-8.7,-16,35,-10,-36,35,-10,-40,
  37.    -8.7,-8.7,21,-15,-8.7,-16,-35,-10,-36,-35,-10,-40,
  38.    0,13,-37,0,33,-60,0,33,-69,0,14,-60,
  39.    6,11,-43,6,11,-48,11,5,-43,11,5,-48,-6,11,-43,-6,11,-48,-11,5,-43,
  40.    -11,5,-48,
  41.    -1,2,3,4,5,6,7,8,1,-9,10,11,12,13,14,15,16,9,-17,18,19,20,21,22,23,24,17,
  42.    -25,26,27,28,29,30,31,32,25,-33,34,35,36,37,38,39,40,33,
  43.    -41,42,43,44,45,46,47,48,41,-49,50,51,52,53,54,55,56,49,
  44.    -57,58,59,60,61,62,63,64,57,-65,66,67,68,69,70,71,72,65,
  45.    -73,74,75,76,77,78,79,80,73,-81,82,83,84,85,86,87,88,81,
  46.    -89,90,91,92,93,94,95,96,89,-97,98,99,100,101,102,103,104,97,
  47.    -1,9,17,25,33,41,49,57,65,73,81,89,97,
  48.    -2,10,18,26,34,42,50,58,66,74,82,90,98,
  49.    -3,11,19,27,35,43,51,59,67,75,83,91,99,
  50.    -4,12,20,28,36,44,52,60,68,76,84,92,100,
  51.    -5,13,21,29,37,45,53,61,69,77,85,93,101,
  52.    -6,14,22,30,38,46,54,62,70,78,86,94,102,
  53.    -7,15,23,31,39,47,55,63,71,79,87,95,103,
  54.    -8,16,24,32,40,48,56,64,72,80,88,96,104,
  55.    -44,105,106,107,108,92,
  56.    -46,109,110,111,112,94,
  57.    -81,113,114,115,116,89,
  58.    -82,117,118,-83,119,120,
  59.    -87,121,122,-88,123,124,
  60.    -117,119,-121,123,-118,120,-122,124);
  61.  
  62. var
  63.    oxangle,oyangle,ozangle,pc,ec:integer;
  64.    CH,SH,CP,SP,CB,SB,xv,yv,zv,
  65.    X,Y,Z,X3,Y3,Z3,AM,BM,CM,DM,
  66.    EM,FM,GM,HM,IM,D,P,B,H,U,vc,U1,V1:real;
  67.    V:array[1..maxa,1..3] of real;
  68.    E:array[1..maxa] of real;
  69.    saywhat:char;
  70.  
  71. procedure muck1;
  72. begin
  73.    CH:=COS (H); SH:=SIN (H);
  74.    CP:=COS (P); SP:=SIN (P);
  75.    CB:=COS (B); SB:=SIN (B);
  76.    AM:=CB * CH - SH * SP * SB;
  77.    BM:=-CB * SH - SP * CH * SB;
  78.    CM:=CP * SB;
  79.    DM:=SH * CP;
  80.    EM:=CP * CH;
  81.    FM:=SP;
  82.    GM:=-CH * SB - SH * SP * CB;
  83.    HM:=SH * SB - SP * CH * CB;
  84.    IM:=CP * CB;
  85. end;
  86.  
  87. procedure muck2;
  88. begin
  89.    X:=X - XV;
  90.    Y:=Y - YV;
  91.    Z:=Z - ZV;
  92.    X3:=AM * X + BM * Y + CM * Z;
  93.    Y3:=DM * X + EM * Y + FM * Z;
  94.    Z3:=GM * X + HM * Y + IM * Z;
  95.    U:=135 + 13.5 * D * X3 / Y3;
  96.    Vc:=80 - 11.5 * D * Z3 / Y3;
  97. end;
  98.  
  99. procedure muck3;
  100. begin
  101.    X:=0;Y:=0;Z:=0;X3:=0;Y3:=0;Z3:=0;
  102.    AM:=0;BM:=0;CM:=0;DM:=0;EM:=0;
  103.    FM:=0;GM:=0;HM:=0;IM:=0;D:=0;P:=0;
  104.    B:=0;H:=0;U:=0;Vc:=0;U1:=0;V1:=0;
  105.    D:=120;
  106.    P:=6.28 * oxangle / 255 - 3.1416;
  107.    B:=6.28 * ozangle / 255;
  108.    H:=6.28 * oyangle / 255;
  109.    muck1;
  110.    XV:= -D * CP * SH;
  111.    YV:= -D * CP * CH;
  112.    ZV:= -D * SP;
  113.    FOR Ec:=1 TO maxe do
  114.       begin
  115.          X:= V[ABS(round(E [Ec])),1];
  116.          Y:= V[ABS(round(E [Ec])),2];
  117.          Z:= V[ABS(round(E [Ec])),3];
  118.          muck2;
  119.          IF E[Ec]>0
  120.          THEN LINE(round(U1*2+75),round(V1+20),round(U*2+75),round(Vc+20));
  121.          U1:= U; V1:= Vc;
  122.       end;
  123. end;
  124.  
  125.  
  126. procedure initvars;
  127. var position,j:integer;
  128. begin
  129.    position:=0;
  130.    FOR Pc:=1 TO maxv do
  131.       begin
  132.          for j:=1 to 3 do
  133.             begin
  134.                position:=position+1;
  135.                v[pc,j]:=data[position]*0.12;
  136.             end;
  137.       end;
  138.    FOR Ec:=1 TO maxe do
  139.       begin
  140.          position:=position+1;
  141.          e[ec]:=data[position];
  142.       end;
  143.    clrscr;
  144.    writeln('This is a TP 4.0 demo prog. It consists of a graphics initialization');
  145.    writeln('unit that recongnizes ANY available graphics display.');
  146.    writeln('There are three options: User, Tour and Random. Each option');
  147.    writeln('displays 3D views of the SHUTTLE on CGA, EGA, VGA, HERCULES, ATT etc.');
  148.    writeln;
  149.    writeln('The Tour option shows 3D views from different angles until a key is pressed.');
  150.    writeln('The Random option shows views from random angles until a key is pressed.');
  151.    writeln('The User option displays views from angles chosen by the user.');
  152.    writeln('To stop the program enter some non-integer for any of the angles.');
  153.    writeln('Hit return to move to next view.');
  154.    writeln;
  155.    writeln('I''ve found the structural coordinates for the shuttle on a BB in');
  156.    writeln('FORTRAN and BASIC readable format. I don''t know who the donors were');
  157.    writeln('but I do appreciate their perseverence (over 600 data points).');
  158.    writeln('Please improve this as you see fit (such as JOY STICK control)');
  159.    writeln('Eddy Vasile, CompuServe 73317,701');
  160.    oxangle:=0;
  161.    oyangle:=0;
  162.    ozangle:=0;
  163. end;
  164.  
  165. procedure userangles;
  166. var
  167.    junk:string[5];
  168.    rc:integer;
  169. begin
  170.    rc:=0;
  171.    while rc=0 do
  172.       begin
  173.          gotoxy(20,21);
  174.          write('Enter inclination angle for OX: ');
  175.          readln(junk);
  176.          val(junk,oxangle,rc);
  177.          if rc<>0 then exit;
  178.          gotoxy(20,22);
  179.          write('Enter inclination angle for OY: ');
  180.          readln(junk);
  181.          val(junk,oyangle,rc);
  182.          if rc<>0 then exit;
  183.          gotoxy(20,23);
  184.          write('Enter inclination angle for OZ: ');
  185.          readln(junk);
  186.          val(junk,ozangle,rc);
  187.          if rc<>0 then exit;
  188.          gr_setup;
  189.          muck3;
  190.          readln(junk);
  191.          closegraph;
  192.       end;
  193. end;
  194.  
  195. procedure tourangles;
  196. begin
  197.    gr_setup;
  198.    while (oxangle<400) and (not keypressed) do
  199.        begin
  200.           setcolor(1);
  201.           muck3;
  202.           delay(800);
  203.           setcolor(0);
  204.           muck3;
  205.           oxangle:=oxangle+10;
  206.           oyangle:=oyangle+10;
  207.           ozangle:=ozangle+10;
  208.        end;
  209.    closegraph;
  210.    writeln('Thanks.. bye!');
  211.    if oxangle<350 then writeln('You should have waited a little more!');
  212. end;
  213.  
  214. procedure randomangles;
  215. begin
  216.    gr_setup;
  217.    while not keypressed do
  218.        begin
  219.           setcolor(1);
  220.           muck3;
  221.           delay(800);
  222.           setcolor(0);
  223.           muck3;
  224.           randomize;
  225.           oxangle:=round(random(400));
  226.           oyangle:=round(random(400));
  227.           ozangle:=round(random(400));
  228.        end;
  229.    closegraph;
  230.    writeln('Thanks.. bye!');
  231. end;
  232.  
  233. begin
  234.    initvars;
  235.    gotoxy(20,20);
  236.    write('R)andom angles, U)ser angles, T)our (default = T) > ');
  237.    saywhat:=readkey;
  238.    case upcase(saywhat) of
  239.       'R':randomangles;
  240.       'U':userangles;
  241.       'T':tourangles;
  242.       else tourangles;
  243.    end;
  244. end.
  245.