home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / progjorn / pj_7_5.arc / GRWDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-06-08  |  6.0 KB  |  198 lines
  1. {GRWDemo.pas Copyright (C) 1989 by Gene Fowler
  2.  
  3. GRWDemo.pas is a stripped down 3-D object
  4. rotator and translator to be compiled in Turbo
  5. Pascal 5.0 using crt, graph, and graphWld. It
  6. uses three GraphWld procedures: CreateWorld in
  7. InitWorld; WLine in ConstructModel; and w2vp
  8. in WritePressKey.
  9. }
  10. program GraphWldDemo;
  11.  
  12. uses crt, graph, graphwld;
  13.  
  14. type
  15.    ObjectVertex = record
  16.                      x, y, z : real
  17.                   end;
  18.    WorldObj     = Array[0..5] of ObjectVertex;     {world coords}
  19.    ViewObj      = Array[0..5] of ObjectVertex;     {view coords }
  20.    ScreenVertex = record
  21.                      sx, sy : Real
  22.                   end;
  23.    DisplayObj   = Array[0..5] of ScreenVertex;     {display coords}
  24.  
  25. var
  26.    {BGI Init and other control variables}
  27.    gdriver, gmode, ecode : integer;
  28.    MaxX, MaxY : integer;
  29.    MaxColor : word;
  30.    ViewP : ViewPortType;
  31.    GoAgain : char;
  32.  
  33.    {The Array variables}
  34.    WObj   : WorldObj;
  35.    VObj   : ViewObj;
  36.    DObj   : DisplayObj;
  37.  
  38.    {3-D drawing variables}
  39.    Dist : Real;
  40.    YawDeg, RollDeg, PitchDeg,
  41.    YawRad, RollRad, PitchRad,
  42.    SinYawRad, CosYawRad, SinRollRad,
  43.    CosRollRad, SinPitchRad, CosPitchRad,
  44.    TransX, TransY, TransZ : Real;
  45.  
  46.    {work variables for calculations}
  47.    x, y, z, xa, ya, za,
  48.    x1, x2, x3, x4, y1, y2, y3, y4,
  49.    z1, z2, z3, z4,
  50.    sx, sy : Real;
  51.    i : byte;
  52.  
  53.    {VAR params for the w2vp translation procedure in GraphWld.tpu}
  54.    wx, wy   : real;
  55.    vpx, vpy : integer;
  56.  
  57. procedure AdjustParams;   {for use in rotation calcs}
  58. begin
  59.   SinYawRad := Sin(YawRad); CosYawRad := Cos(YawRad);
  60.   SinRollRad := Sin(RollRad); CosRollRad := Cos(RollRad);
  61.   SinPitchRad := Sin(PitchRad); CosPitchRad := Cos(PitchRad)
  62. end;
  63.  
  64. procedure CalcVandDArrays;
  65. begin
  66.    For i := 0 to 5 do
  67.      begin
  68.        x:= WObj[i].x; y:= WObj[i].y; z:= WObj[i].z;
  69.        x  := (-1)*x;
  70.        xa := CosYawRad*x - SinYawRad*z;
  71.        za := SinYawRad*x + CosYawRad*z;
  72.        x  := CosRollRad*xa + SinRollRad*y;
  73.        ya := CosRollRad*y - SinRollRad*xa;
  74.        z  := CosPitchRad*za - SinPitchRad*ya;
  75.        y  := SinPitchRad*za + CosPitchRad*ya;
  76.        x  := x + TransX; y := y + TransY; z := z + TransZ;
  77.        sx := Dist*x/z; sy := Dist*y/z;
  78.        VObj[i].x := x; VObj[i].y := y; VObj[i].z := z;
  79.        DObj[i].sx := sx; DObj[i].sy := sy
  80.      end
  81. end;
  82.  
  83. procedure ConstructModel;
  84.  
  85. begin
  86.    CalcVandDArrays;
  87.    SetColor(MaxColor);
  88.    SetLineStyle(0,0,1);
  89.  
  90.    {Surface 0 }
  91.    x1 := DObj[0].sx; y1 := DObj[0].sy; x2 := DObj[1].sx; y2 := DObj[1].sy;
  92.    x3 := DObj[2].sx; y3 := DObj[2].sy; x4 := DObj[3].sx; y4 := DObj[3].sy;
  93.    WLine(x1,y1,x2,y2);  {In GraphWld: translates params, calls Line}
  94.    WLine(x2,y2,x3,y3);
  95.    WLine(x3,y3,x4,y4);
  96.    WLine(x4,y4,x1,y1);
  97.  
  98.    {Surface 1}
  99.    x1 := DObj[1].sx; y1 := DObj[1].sy; x2 := DObj[4].sx; y2 := DObj[4].sy;
  100.    x3 := DObj[5].sx; y3 := DObj[5].sy; x4 := DObj[2].sx; y4 := DObj[2].sy;
  101.    WLine(x1,y1,x2,y2);  {In GraphWld: translates params, calls Line}
  102.    WLine(x2,y2,x3,y3);
  103.    WLine(x3,y3,x4,y4);  {Note: don't REDRAW a line to close surface}
  104. end; {ConstructModel}
  105.  
  106. procedure WritePressKey;
  107. begin
  108.    SetTextstyle(DefaultFont,HorizDir,1);
  109.    wx := 200; wy := 250;
  110.    w2vp(wx,wy,vpx,vpy);                   {uses standalone translator}
  111.    OutTextXY(vpx,vpy,'press any key...')
  112. end;
  113.  
  114. function Deg2Rad(Degs : Real) : Real;
  115. begin
  116.    Deg2Rad := Degs * 0.01745327778
  117. end;
  118.  
  119. procedure InitWorld;  {also inits graphics, program}
  120. begin
  121.    gdriver := Detect;
  122.    InitGraph(gdriver, gmode,'a:\');
  123.    ecode := GraphResult;
  124.    if ecode <> 0 then
  125.      begin
  126.        writeln('Halted on graphics error: ', GraphErrorMsg(ecode));
  127.        Halt(2)
  128.      end;
  129.    SetGraphMode(GetGraphMode);
  130.    MaxColor := GetMaxColor;
  131.    MaxX := GetMaxX;
  132.    MaxY := GetMaxY;
  133.    SetViewPort(0,0,MaxX,MaxY,ClipOn);
  134.    {See Note in header about "finagling" your world!}
  135.    CreateWorld(-399.0,-299.0,400.0,300.0); {after setting viewport}
  136. (* CreateWorld(-399.0,300.0,400.0,-299.0); {"flipped" world}  *)
  137.  
  138.   {---Initialize DataBase---}
  139.   WObj[0].x :=  30; WObj[0].y := -30; WObj[0].z := 0;
  140.   WObj[1].x :=  30; WObj[1].y :=  30; WObj[1].z := 0;
  141.   WObj[2].x := -30; WObj[2].y :=  30; WObj[2].z := 0;
  142.   WObj[3].x := -30; WObj[3].y := -30; WObj[3].z := 0;
  143.   WObj[4].x :=  30; Wobj[4].y :=  30; Wobj[4].z := -60;
  144.   Wobj[5].x := -30; WObj[5].y :=  30; WObj[5].z := -60;
  145.  
  146.   {---assign drawing variables---}
  147.   Dist := 1200;    {distance to picture plane}
  148.   {YawRad := Deg2Rad(0); RollRad := Deg2Rad(0); PitchRad := Deg2Rad(0);}
  149.   TransX := 0; TransY := 0; TransZ := -350   {Obj beyond picture plane}
  150. end; {initWorld}
  151.  
  152. procedure GetParams;
  153. begin
  154.    RestoreCrtMode;
  155.    writeln('GraphWld.tpu Demo - Copyright (C) 1989 by Gene Fowler');
  156.    writeln;
  157.    writeln('Only the 3 rotation params to be set, not the plane and');
  158.    writeln('object distances, translations, or placement of the two face');
  159.    writeln('semi-cube. This side is centered on x0,y0 and all four points');
  160.    writeln('have z = 0 - so a 90 degree yaw with 0-roll,0-pitch shows a');
  161.    writeln('straight line. Enter all three 0s when finageling world...to');
  162.    writeln('have an expected square for test measuring. Aspect is in world.');
  163.    writeln;
  164.    write('Yaw angle in degrees (0-360):   ');
  165.    readln(YawRad);
  166.    YawRad := Deg2Rad(YawRad);
  167.    writeln;
  168.    write('Roll angle in degrees (0-360):  ');
  169.    readln(RollRad);
  170.    RollRad := Deg2Rad(RollRad);
  171.    writeln;
  172.    write('Pitch angel in degrees (0-360); ');
  173.    readln(PitchRad);
  174.    PitchRad := Deg2Rad(PitchRad);
  175.    SetGraphMode(GetGraphMode)
  176. end;
  177.  
  178. begin  {main}
  179.    Directvideo := False;
  180.    InitWorld;
  181.    repeat
  182.      {set rotations, draw, and view}
  183.       GetParams;
  184.       AdjustParams;
  185.       ConstructModel;
  186.       WritePressKey;
  187.       repeat until keypressed;
  188.       GoAgain := ReadKey; {clear key}
  189.      {repeat or quit choice}
  190.       RestoreCRTMode;
  191.       write('Repeat or quit (r/q)? ');
  192.       repeat until keypressed;
  193.       GoAgain := ReadKey;
  194.       SetGraphMode(GetGraphMode);
  195.    until (GoAgain = 'q') or (GoAgain = 'Q');
  196.    CloseGraph
  197. end.
  198.