home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / GrafSys 2.0 / Demos / Shuttle ƒ / shuttle.p2 next >
Encoding:
Text File  |  1993-08-21  |  3.4 KB  |  149 lines  |  [TEXT/PJMM]

  1. program ShuttleBuild;
  2.  
  3.     uses
  4.         Matrix, Transformations, OffscreenCore, GrafSysCore, GrafSysScreen, GrafSysObject, Resources, OffScreenGraphics, GrafSysC;
  5.  
  6.     const
  7.         cMaxPoly = 100;
  8.         cTheWindow = 400;
  9.         degrees = 0.01745329; (* π/180 *)
  10.  
  11.  
  12.     procedure BuildObject (var Obj: TSObject3D);
  13.  
  14.         var
  15.             OK: longint;
  16.             theGreen: RGBColor;
  17.             dummyBool: boolean;
  18.  
  19.     begin
  20.         OK := Obj.AddPoint(-60, 0, 0);
  21.         OK := Obj.AddPoint(-57, 3, 3);
  22.         OK := Obj.AddPoint(-57, 3, -3);
  23.         OK := Obj.AddPoint(-57, -3, 3);
  24.         OK := Obj.AddPoint(-57, -3, -3);
  25.         OK := Obj.AddPoint(-42, 6, 9);
  26.         OK := Obj.AddPoint(-42, 9, -6);
  27.         OK := Obj.AddPoint(-42, -6, 9);
  28.         OK := Obj.AddPoint(-42, -9, -6);
  29.         OK := Obj.AddPoint(-15, 9, -6);
  30.         OK := Obj.AddPoint(-15, -9, -6);
  31.         OK := Obj.AddPoint(0, 15, -6);
  32.         OK := Obj.AddPoint(0, -15, -6);
  33.         OK := Obj.AddPoint(21, 36, -6);
  34.         OK := Obj.AddPoint(21, -36, -6);
  35.         OK := Obj.AddPoint(30, 36, -6);
  36.         OK := Obj.AddPoint(30, -36, -6);
  37.         OK := Obj.AddPoint(30, 9, -6);
  38.         OK := Obj.AddPoint(30, -9, -6);
  39.         OK := Obj.AddPoint(36, 9, -6);
  40.         OK := Obj.AddPoint(36, -9, -6);
  41.         OK := Obj.AddPoint(36, 6, 9);
  42.         OK := Obj.AddPoint(36, -6, 9);
  43.         OK := Obj.AddPoint(9, 0, 9);
  44.         OK := Obj.AddPoint(27, 0, 9);
  45.         OK := Obj.AddPoint(21, 0, 27);
  46.         OK := Obj.AddPoint(30, 0, 27);
  47.  
  48.     (* now add the lines *)
  49.         OK := Obj.AddLine(1, 2);
  50.         OK := Obj.AddLine(2, 6);
  51.         OK := Obj.AddLine(6, 22);
  52.         OK := Obj.AddLine(22, 23);
  53.         OK := Obj.AddLine(23, 21);
  54.         OK := Obj.AddLine(21, 20);
  55.         OK := Obj.AddLine(20, 18);
  56.         OK := Obj.AddLine(18, 16);
  57.         OK := Obj.AddLine(16, 14);
  58.         OK := Obj.AddLine(14, 12);
  59.         OK := Obj.AddLine(12, 10);
  60.         OK := Obj.AddLine(10, 7);
  61.         OK := Obj.AddLine(7, 3);
  62.         OK := Obj.AddLine(3, 1);
  63.  
  64.         OK := Obj.AddLine(1, 4);
  65.         OK := Obj.AddLine(4, 8);
  66.         OK := Obj.AddLine(8, 23);
  67.  
  68.         OK := Obj.AddLine(20, 22);
  69.  
  70.         OK := Obj.AddLine(24, 26);
  71.         OK := Obj.AddLine(26, 27);
  72.         OK := Obj.AddLine(27, 25);
  73.  
  74.         OK := Obj.AddLine(1, 5);
  75.         OK := Obj.AddLine(5, 9);
  76.         OK := Obj.AddLine(9, 11);
  77.         OK := Obj.AddLine(11, 13);
  78.         OK := Obj.AddLine(13, 15);
  79.         OK := Obj.AddLine(15, 17);
  80.         OK := Obj.AddLine(17, 19);
  81.         OK := Obj.AddLine(19, 21);
  82.  
  83.  
  84.  
  85.  
  86.     end;
  87.  
  88.     procedure Check (theErr: integer);
  89.     begin
  90.         if theErr <> noErr then
  91.             DebugStr(InterPretError(theErr));
  92.     end;
  93.  
  94. {MAIN PROGRAM}
  95.  
  96.     var
  97.         theCube: TSObject3D;
  98.         EyeLoc: Vector4;
  99.         theWindow: WindowPtr;
  100.         dummyLong: longint;
  101.         copyRect: Rect;
  102.         time: longint;
  103.         done: boolean;
  104.         theID: integer;
  105.  
  106. begin
  107.     InitCursor;
  108.     InitGrafSys;
  109.     theWindow := GetNew3DWindow(cTheWindow, pointer(-1));
  110.     SetVector4(EyeLoc, 0, 0, -300);
  111.     SetEyeChar(TRUE, EyeLoc, 0, 0, 0, 90 * degrees, fast);
  112. {    theCube := GetNewNamedObject('Shuttle');{}
  113.     New(theCube);
  114. {}
  115.     theCube.Init;
  116. {    }
  117.     BuildObject(theCube);
  118. {    }
  119. {SaveNamedObject(theCube, 'Shuttle', theID);}
  120.     Check(AttachOffscreen(theWindow, pointer(-1)));
  121.  (* does automatic sanity check *)
  122.     theCube.Scale(3, 3, 3);
  123.     theCube.Draw;
  124.     theCube.SetAutoErase(True);
  125.     repeat
  126.         Check(BeginOSDraw(theWindow));
  127.         theCube.Draw; (* erase it and redraw it*)
  128.         Check(EndOSDraw(theWindow));
  129.         UnionRect(theCube.oldBounds, theCube.bounds, copyrect);
  130.         Check(CopyOS2Screen(theWindow, copyrect, srcCopy));
  131. {FRAMERECT(COPYRECT);{}
  132.         Delay(1, dummyLong);{}
  133.  
  134.         theCube.Rotate(5 * degrees, 2 * degrees, 1 * degrees);
  135.         if button then
  136.             begin
  137.                 time := TickCount - time;
  138.                 if time < GetDblTime then
  139.                     done := true
  140.                 else
  141.                     repeat
  142.                     until not button;
  143.                 time := tickCount;
  144.             end;
  145.  
  146.     until done;
  147.     repeat
  148.     until not button;
  149. end.