home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue42 / opengl / glFuncs.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-26  |  47.3 KB  |  1,476 lines
  1. unit GLFuncs;
  2. {============================================================}
  3. { Unit Title -  Abstract OpenGL Window                            }
  4. {                                                            }
  5. { Codemaster  -      ohn Hutchings                             }
  6. {   Date      -      10/6/98                                 }
  7. {  DeBugged   -               }
  8. {                                }
  9. {============================================================}
  10.  
  11. {$V+,X+,F+,B-}
  12. {$IFDEF MinSize} {$S-,L-,R-,Q-,D-} {$ENDIF}
  13.  
  14. {===============================================================================
  15.  
  16. PURPOSE
  17.  
  18.   This unit defines some global types and functions used with OpenGL
  19.  
  20. METHOD
  21.  
  22. COMPILER DIRECTIVES
  23.  
  24.   MINSIZE   limits debug and symbol info
  25.  
  26. GLOBALS
  27.  
  28.   Classes
  29.   Exceptions
  30.   Variables
  31.  
  32.   Procedures
  33.  
  34.  
  35.   Pass Through values
  36.   1000-1999 pOINTS
  37.   2000-2999 Lines
  38.   3000-3999 Ploygons
  39.   4000-4999 Polygon Text
  40.   5000-5999 Bitmap Text
  41.   6000-6999 Bitmaps
  42.   7000-7999 Textures
  43.  
  44.   Split value under here into HundredVal, TenVal, UnitVal and each code
  45.   is meaningful to the category
  46. Points
  47.    HundredVal = NotUsed
  48.    TenVal     = Size
  49.    UnitVal    = PointType
  50.  
  51. Lines
  52.    HundredVal = LineType
  53.    TenVal     = NotUsed
  54.    UnitVal    = LineWidth
  55.  
  56. Polygons
  57.    HundredVal = NotUsed
  58.    TenVal     = NotUsed
  59.    UnitVal    = Fill=1,
  60.  
  61. PolygonText
  62.    CharVal = 0-255 represents the text
  63.    CharSize = Size of text in pixels
  64.    UnitVal    = NotUsed
  65.  
  66. Bitmaps
  67.  
  68. EXCEPTIONS
  69.  
  70.  
  71. NOTES
  72.  
  73.  
  74. ===============================================================================}
  75.  
  76. (******* ******************************************************)
  77.                              interface
  78. (******* ******************************************************)
  79. {$W+}//set stack frames on as this seemms to help win95 access error
  80.  
  81.   uses Windows, sysutils, classes, Graphics, Math, openGL;
  82.  
  83. Const
  84. //Size of general list
  85.    glGeneralListSize=200;
  86. //Size of Text list
  87.    glTextSize=256;
  88.  
  89. //Fixed RenderCanvas Diplay List offset constants
  90.   dlFullRenderMode=1;
  91.   dlQuickRenderMode=2;
  92.   dlBackground=3;
  93.   dl2DWindow=4;
  94.   dlForeGround=5;
  95.  
  96.   dlSimpleCube=12;
  97.   dl2DGraphics=13;
  98.   dlFullAxis=14;
  99.   dlQuickAxis=15;
  100.   dlBasicAxis=16;
  101.   dlFocusedBorder=17;
  102.   {dlUnFocusedBorder=18;}
  103.   dlGridFront=19;
  104.   dlGridBack=20;
  105.   dlGridLeft=21;
  106.   dlGridRight=22;
  107.   dlGridTop=23;
  108.   dlGridBottom=24;
  109.   dlPointCross=25;
  110.   dlPointX =26;
  111.   dlPointsphere=27;
  112.   dlSelectCube=28;
  113.   dlLightsOn=29;
  114.   dlLightsOff=30;
  115.   dlXYCircle=31;
  116.   dlXZCircle=32;
  117.   dlYZCircle=33;
  118.   dlLockedSelectCube=34;
  119.   dlSimpleDiamond=35;
  120.   dlYellowDiamond=36;
  121.   dlRedDiamond=37;
  122.  
  123.  
  124.  // glFeedBack buffer trial start size
  125.   fbBufferSizetiny  = 500000;
  126.   fbBufferSizeLarge = 20000000;
  127.  
  128.   CursorPlaneSide = 10000;
  129.  type
  130.  
  131.   GLToolMode     =(tlNone,tlSelect,tlPoint,tlLine,tlPolyLine,tlPolygon,tlRectangle);
  132.   //Set the current tool mode
  133.   GLSelectState = (stNone,stButtonDown,stDrag,stStretch,stEdit,stPoly,stPolyClosed);
  134.   //set when mouse moves objects
  135.   GLMoveMode     =(mmNone,mmMoveToPt,mmZoom,mmPan,mmFly,mmRotate,
  136.                    mmslide,mmLookAt,mmWalk,mmTwist,mmMeasure,
  137.                    mmModifyScreenZ,mmLookAtPt,mmViewPoints);
  138.   //Move mode will have precedence over the current Tool mode
  139.   GLRenderState  =(rmFull,rmQuick,rmMotion,rmThread,rmAnimation,rmViewAnimate,fmGDIOnly);
  140.   //current state for rendering, will be passed to evemnts
  141.   GLRender       =(rPoints,rWireframe,rBoundary,rFlat,rSmooth);
  142. // states for rendering
  143.   GLMoveRender   =(mrSameAsStationary,mrPoints,mrWireframe,mrBoundary,mrFlat,mrSmooth);
  144. //states for rendering if in motion  
  145.   GLBackground   =(glWhiteBkgd,glBlackBkgd);
  146.   //current background color will set black color as needed
  147.   GLPointMode    =(ptSimple,ptCross,ptX,ptShpere,ptCube);
  148.   //how a point is drawn
  149.   GLViewMode     =(vmLookDown,vmLookUp,vmLookWest,vmLookEast,vwLookNorth,vmLookSouth,vmCustom);
  150.   //fixed view modes can still move relative to these
  151.   GLDriver       =(eGeneric,eMiniClient,eInstallableClient);
  152.   //not currently used
  153.   GLGridType = (gtBottom,gtTop,gtLeftSide,gtRightSide,gtBack,gtFront);
  154.   //Type of Grid boxes
  155.   GLSaveState = (stAll,stDrawing,stLighting,stTexturing);
  156.   // specify the state to save, stAll will save all
  157.   GLLightType = (ltStd,ltSpot);
  158.   // specify the type of the light
  159.   GLStereoState = (steNone,steRedBlue,steBuffer);
  160.   //current Stereo state
  161.   vViewFrom= (vCentrePt,vLeftEye,vRightEye);
  162.   // where is the current view point
  163.    Type
  164.       glColorVal =Array[1..4]of GlFloat;
  165.  
  166.       tgmf       =Array[0..255] of tGlyphMetricsFloat;
  167.   {Mode for dynamic creation of points}
  168.  
  169.       GLMatrixArrayd =Array[1..16] of GLDouble;
  170.       GLMatrixArrayf =Array[1..16] of GLfloat;
  171.       GLViewPortArray=Array[1..4] of GLInt;
  172.  
  173.  //array of RGB values from pixelread
  174.       pGLRGB=^tGLRGB;
  175.       tGLRGB= Array[1..3] of GLUByte;
  176.  
  177.  // array for storing feed back buffer data
  178.       pFeedBackArray = ^tFeedBackArray;
  179.       tFeedBackArray = Array[0..fbBufferSizeLarge]of single;
  180.  
  181.       pGLPoint       = ^tGLPoint;
  182.       tGLPoint        = record  X,Y,Z :GLDouble;  end;
  183.  //the  GLPoint record structure
  184.  
  185.       tGLPointArray=Array of pGLPoint;
  186.  //Dynamic array of GLPoints
  187.  
  188.       tGLLightVal = Record  R,G,B,A  : GLFloat;  end;
  189.  
  190.  // record filled out by a call to the GLWin.GetMeasurementData
  191.   tMeasureRecord= Record
  192.     NoOfPoints  :LongInt;  //No of points used
  193.     LastDeltaX,     //dif in X
  194.     LastDeltaY,     //dif in Y
  195.     LastDeltaZ,     //dif in Z
  196.     LastDistance,   //Real dist
  197.     Lastbearing,    //Bearing of line degree
  198.     LastElevation,  //Elevation angle degree
  199.     DistanceSum,    //Sum of distance covered
  200.     Area,           //Area in the current plane
  201.     CMX,CMY,CMZ     //centre of mass location in current plane
  202.     :Double;
  203.   end;
  204.  
  205.  tPlaneEq = Record
  206.   A,B,C,D:Single;
  207.   isValid:Boolean;
  208.  end;
  209.  
  210. Const
  211.   glMaroon : glColorVal=(0.5,0,0,1);
  212.   glGreen : glColorVal=(0,0.5,0,1) ;
  213.   glOlive : glColorVal=(0.5,0.5,0,1) ;
  214.   glNavy  : glColorVal=(0,0,0.5,1);
  215.   glPurple: glColorVal=(0.5,0,0.5,1);
  216.   glTeal  : glColorVal=(0.5,0.5,0,1);
  217.   glGray  : glColorVal=(0.5,0.5,0.5,1);
  218.   glSilver : glColorVal=(0.8,0.8,0.8,1);
  219.   glRed    : glColorVal=(1,0,0,1);
  220.   glLime   : glColorVal=(0,1,0,1);
  221.   glYellow : glColorVal=(1,1,0,1);
  222.   glBlue   : glColorVal=(0,0,1,1);
  223.   glFuchsia: glColorVal=(1,0,1,1);
  224.   glAqua   : glColorVal=(0,1,1,1);
  225.   glLtGray : glColorVal=(0.7,0.7,0.7,1);
  226.   glMidGray : glColorVal=(0.5,0.5,0.5,1);
  227.   glDkGray : glColorVal=(0.25,0.25,0.25,1);
  228.   glGray10  : glColorVal=(0.9,0.9,0.9,1);
  229.   glGray20  : glColorVal=(0.8,0.8,0.8,1);
  230.   glGray30  : glColorVal=(0.7,0.7,0.7,1);
  231.   glGray40  : glColorVal=(0.6,0.6,0.6,1);
  232.   glGray50  : glColorVal=(0.5,0.5,0.5,1);
  233.   glGray60  : glColorVal=(0.4,0.4,0.4,1);
  234.   glGray70  : glColorVal=(0.3,0.3,0.3,1);
  235.   glGray80  : glColorVal=(0.2,0.2,0.2,1);
  236.   glGray90  : glColorVal=(0.1,0.1,0.1,1);
  237.   glWhite  : glColorVal=(1,1,1,1);
  238.  
  239.  Var
  240. //Size of border around window - DONT change it
  241.   fBorderWidth:SmallInt=2;
  242. //Start up size for Model block
  243.   DefaultSize:Double=200;
  244.   defaultAngle:Double=60;
  245.  
  246.   // no of segnents drawn in the axis set
  247.   AxisRes:Smallint=10;
  248.   MoveTolerance:Double=0.001;
  249.   //tolerance for movement
  250.   MouseMoveTol:SmallInt=6;
  251.  
  252.  glBlack : glColorVal=(0,0,0,1);
  253.  // default black
  254.  RotSensitivity :Integer =50;
  255.  //sensitivity for rotation
  256.  
  257.  //   default line types
  258.  stContinous:gluShort=$FFFF;
  259.  stDotted1:gluShort=$AAAA;
  260.  stDashed:gluShort=$00FF;
  261.  stDashDot:gluShort=$1C47;
  262.  stDotted2:gluShort=$0101;
  263.  stDotted3:gluShort=$0505;
  264.  stDotted4:gluShort=$3333;
  265.  
  266.  //scale factor on the grid display
  267.  Grid_Scale  : Single=4;
  268.  
  269.  SnapDistance: GLDouble=5;
  270.    // distance for gravity well
  271.  fly_speed   : Single= 5;
  272.  
  273. // variables for setting up the pixel format to be used
  274.  pix_ColorBits:      Word=24;
  275.  pix_DepthBits:      Word=16;
  276.  pix_StencilBits:    Word=1;
  277.  pix_AccumBits:      Word=16;
  278.  
  279.  EyeOffset : Double = 1;//the offset from viewerposition for eye coordinates
  280.  //currently as an angle in degrees
  281.  MinCubeSize : Double=10;
  282.  // min cube size setting
  283.  Type
  284.  
  285. // the light class contains GL Fundamentals for the lighting
  286.  
  287.   tGLLight = Class(TObject)
  288.    Protected
  289.      fPosition,
  290.      fSpotDir   : tGLPoint;
  291.      fOn        : Boolean;
  292.      fLightNum  : LongInt;
  293.      // GL Name of Light
  294.      fLightType : GLLightType;
  295.      fAmbient,
  296.      fDiffuse,
  297.      fSpecular  : tGLLightVal;
  298.      fShininess : GLFloat;
  299.      fSpotAngle,
  300.      fSpotExponent : GLFloat;
  301.  
  302.   Public
  303.     Constructor Create(aNum:LongInt);
  304.     Destructor Destroy; Override;
  305.     Procedure TurnLightOn;
  306.     Procedure TurnLightOff;
  307.     Procedure PositionLight(aPt:tGLPoint);
  308.     Procedure SetUpLight;
  309.     Procedure SetLightColor(aCol:tGLLightVal);
  310.     Property IsOn:Boolean Read fOn;
  311.     {Property Color:tGLLightVal Read Write}
  312.   end;
  313.  
  314.  TLinkPoint = Class(TObject)
  315.   Public
  316.    X,Y,Z    :GLDouble;
  317.    SX,SY    :LongInt;   {GL Screen Coords}
  318.    SPt      :TPoint;    {Windows screen coords}
  319.    ScreenZ  :Double;    {Gl Screen Z}
  320.    fScreenPtValid :Boolean;
  321.  
  322.   Constructor CreateSpecial(aWorldX,aWorldY,aWorldZ:Double);
  323.   Function GetWorldPt:pGLDouble;
  324.   Procedure SetHeight(aHt:LongInt);
  325.   Function GetGLScreenPt(var aPt: TPoint):Boolean;
  326.   Procedure SetGLScreenPt(AX,AY,aHt:LongInt;AZ:Double);
  327.   Procedure SetWinScreenPt(aX,aY,aHt:LongInt;aZ:Double);
  328.   Procedure SetWorldPt(aX,aY,aZ:Double);
  329.   Function Duplicate:TLinkPoint;
  330.  end;
  331.  
  332.  // General Routines
  333.  
  334. Function  GetGLStringValue(aext:GLInt):pchar;
  335. Function SetSwapHintAddress:Pointer;
  336.  
  337. Procedure DrawAxes(SegLength,segDia,ArrowDia:glFloat;
  338.                     Const SegCount:GLInt; FullRender:Boolean);
  339.  
  340. Procedure Scale_Data(Dmin,                   {data minimum}
  341.                      Dmax:   Double;           {data maximum}
  342.                      Nmax:   Smallint;        {max number of intervals}
  343.                  var st:     Double;           {starting value}
  344.                  var dinc:   Double;           {increment}
  345.                  var Ninc:   Smallint);       {number of increments}
  346.  
  347.  Procedure CreateGrid(MinPt,MaxPt:tGLPoint;aGridType:GLGridType;aStep:LongInt);
  348.  
  349.  Function Distancebetween(P1,p2:tGLPoint):Double;
  350.  
  351.  function PolygonArea(Polygon: TList): double;
  352. // assume a list of TLink points, will find the Plan area in the current screen plane
  353.  
  354.  Procedure GetListData(var aMeasRec:tMeasureRecord;aList:TList);
  355.  
  356.  procedure CalcPolarValues(P1,P2:tGLPoint;var Length,Bearing,Inclination:Single);
  357.  // Calc the polar values for two GLPoints
  358.  Procedure CalcEndPoint(P1:tGLPoint;Length,Bearing,Inclination:Single;Var P2:tGLPoint);
  359.  // calc end point(P2) from polar and startpoint(P1)
  360.  
  361.  function MaskX86Exceptions: Pointer;
  362.  procedure RestoreX86Mask(dwOldMask: Pointer);
  363.  // from Delphi mag fix for Divide by zero
  364.  
  365.  
  366.   Function BearingAndAzimuth(const P1,P2:tGLPoint;var Bearing,Azimuth:Double):Boolean;
  367. {Given 2 points return the bearing and azimuth}
  368.   Function AngleFromVertical(const P1,P2:tGLPoint; var Angle:Double):Boolean;
  369.   {given}
  370.   function  IsPtInsideList(x,y:LongInt;aList:tList):boolean;
  371. { return true if x,y is inside polygon
  372.   List must contain a list of tlinkpoints assumed to be closed
  373.   Most form a simple polygon}
  374.   function intersects(x1,y1,x2,y2,u1,v1,u2,v2: Double;
  375.                       var lambda:   Double ) : boolean;
  376. { check if two line segments (x1,y1)to(x2,y2) and (u1,v1)to(u2,v2) cross,
  377.   if so return true and lambda ie x1,y1 lambda=0 x2,y2 lambda=1 }
  378.   function HorzIntersects(x1,y1,x2,y2,u1,v1,u2: Double;
  379.                                   var lambda: Double ) : boolean;
  380.  
  381.   Function CalcUnitNormal(P1,P2,P3:tGLPoint;var N:tGLPoint):Boolean;
  382.   // calc the unit normal for the three supplied points
  383.   // will be false if say points are in a line
  384.   Procedure SetGLPointVal(Var aPt:tGLPoint;XVal,YVal,ZVal:Double);
  385.   //set the tGLPoint values
  386.  
  387.   Procedure DrawFeedBackDataToCanvas(aCanvas     : TCanvas;  //canvas to draw on
  388.                                      aSize       : Integer;  //amount of data
  389.                                      FeedBack    : pFeedBackArray;//arrray holding data
  390.                                      FeedBackType: Longint;  //data record type
  391.                                      aHeight     : Integer;  //current window height (need to draw with GDI coordinates)
  392.                                      aBitMaps    : tList;    //list of bitmaps to be drawn
  393.                                      XScale,YScale:Double);  // point scale factor
  394.   // parse the data in feedback array according to the feedback type and draw to canvas
  395.     function CalcPlaneEq(v1x,v1y,v1z,
  396.                          v2x,v2y,v2z,
  397.                          v3x,v3y,v3z:Double;
  398.                          Var fPlaneEq:tPlaneEq): boolean;
  399.  (******* ******************************************************)
  400.                         implementation
  401. (******* ******************************************************)
  402. (******* ******************************************************)
  403.   Const
  404.   pi180:double=pi/180;
  405.   CompareTol  =0.001;   { two points identical if within this of each other }
  406.   SmallDivisor = 0.001; {check for parallel case in PlaneIntercept}
  407.  
  408.  
  409. {*********************************************************}
  410. {********************************************************}
  411. function Det3x3(       { calc determinant of 3x3 matrix }
  412.             a,b,c,     { matrix elements }
  413.             d,e,f,
  414.             g,h,i:  Double):Double;
  415. begin
  416.   Result:=a*(e*i-f*h)-b*(d*i-f*g)+c*(d*h-e*g);
  417. end;
  418. {*********************************************************}
  419. function CalcPlaneEq(v1x,v1y,v1z,
  420.                      v2x,v2y,v2z,
  421.                      v3x,v3y,v3z:Double;
  422.                      Var fPlaneEq:tPlaneEq): boolean;
  423. var
  424.   d1:  Double;
  425. begin
  426. Result:=False;
  427. {calc plane equation  ax+by+cz=d}
  428. {JH MOD 1/10/97}
  429.     with fPlaneEq do
  430.     Begin
  431.         a:= det3x3(v1Y,V1Z,1.0,
  432.                    V2Y,V2Z,1.0,
  433.                    V3Y,V3Z,1.0);
  434.  
  435.         B:=-det3x3(V1X,V1Z,1.0,
  436.                    V2X,V2Z,1.0,
  437.                    V3X,V3Z,1.0);
  438.  
  439.         C:= DET3X3(V1X,V1Y,1.0,
  440.                    V2X,V2Y,1.0,
  441.                    V3X,V3Y,1.0);
  442.  
  443.    {normalise vector equation}
  444.         d1:= sqrt(a*a + b*b + c*c);
  445.         if abs(d1)<SmallDivisor then
  446.           begin
  447.             d:=0;
  448.             IsValid:=False;
  449.           end else
  450.           begin
  451.             with fPlaneEq do
  452.             begin
  453.               a:= a/d1;    b:= b/d1;   c:= c/d1;
  454.              {now calculate constant in plane equation}
  455.               d:=a*V1X + b*V1y + c*v1z;
  456.               IsValid:=True;
  457.               Result:=True;
  458.             end;
  459.           end;
  460.     end;
  461. end;
  462. {********************************************}
  463.   Procedure DrawFeedBackDataToCanvas(aCanvas:TCanvas;aSize:Integer;FeedBack:pFeedBackArray;
  464.                                      FeedBackType:Integer;aHeight:Integer;
  465.                                      aBitMaps    : tList;    //list of bitmaps to be drawn
  466.                                      XScale,YScale:Double);  // point scale factor
  467.   // parse the data in feedback array according to the feedback type and draw to canvas
  468.     Var Count,CVal:Integer;
  469.         OldPenCol:TColor;
  470.         OldBrushCol:TColor;
  471.         CUserVal:Longint;
  472.         T1,T2:TPoint;
  473.         C1,C2:tColor;
  474.         UnitVal,TenVal,HundredVal,ThousVal,CharVal,CharSize:Single;
  475.    // scale the point value based on the supplied XScale,YScale
  476.       Procedure ScalePoint(aPt:tPoint);
  477.         Begin
  478.           aPt.X:=round(aPt.X*XScale);
  479.           aPt.Y:=Round(aPt.Y*YScale);
  480.         end;
  481.  
  482.       Procedure ReadPoint(Var aPt:TPoint;Var aCol:Tcolor);
  483.          Var R,G,B:Byte;
  484.              R1,G1,B1:Single;
  485.         Begin
  486.           aCol:=clBlack;
  487.           aPt.X:=0;aPt.Y:=0;
  488.           aPt.X:=Round(FeedBack^[Count]);
  489.           Inc(Count); //jump the XVal
  490.           aPt.Y:=aHeight-Round(FeedBack^[count]);
  491.           Inc(Count); //jump the Y Val
  492.           If FeedBackType>=GL_3D then
  493.             Begin
  494.               inc(Count); // jump the Z val
  495.               If FeedBackType>=GL_3D_COLOR then
  496.                 Begin
  497.                    R1:= FeedBack^[Count];
  498.                    inc(Count); // jump the R val
  499.                    G1:= FeedBack^[Count];
  500.                    inc(Count); // jump the G val
  501.                    B1:= FeedBack^[Count];
  502.                    inc(Count); // jump the B val
  503.                    R:=Round(R1*255);G:=Round(G1*255);B:=Round(B1*255);
  504.                    // set to black if white
  505.                    If (R=255)and (G=255) and (B=255) then
  506.                      aCol:=clBlack else
  507.                      aCol:=PaletteRGB(R,G,B);
  508.                    inc(Count); // jump the A Level
  509.                   If FeedBackType>=GL_3D_COLOR_TEXTURE then
  510.                     Begin
  511.                        inc(Count); // jump the  val
  512.                        inc(Count); // jump the  val
  513.                        inc(Count); // jump the  val
  514.                        inc(Count); // jump the  val
  515.                     end; //GL_3D_COLOR_TEXTURE
  516.                 end;//GL_3D_COLOR
  517.             end; //GL_3D
  518.           ScalePoint(aPt);
  519.         end;
  520.  
  521.    Procedure ExtractValues(aVal:LongInt);
  522.      Begin
  523.         UnitVal:=0;TenVal:=0;HundredVal:=0;ThousVal:=0;CharVal:=0;
  524.         CharSize:=0;
  525.         If aVal=0 then exit;
  526.         UnitVal:=Frac(aVal/10)*10;
  527.         TenVal :=Frac(aVal/100)*100-UnitVal;
  528.         CharVal:=Frac(aVal/1000)*1000;
  529.         HundredVal:=CharVal-TenVal-UnitVal;
  530.         ThousVal:=Frac(aVal/10000)*10000-charVal;
  531.         CharSize:=ThousVal;
  532.      end;
  533.  
  534.       Procedure  MakePoint;
  535.         Begin
  536.           Inc(Count);
  537.           ReadPoint(T1,C1);
  538.           With aCanvas do
  539.             Begin
  540.              Pen.Color:=C1;
  541.              MoveTo(T1.X,T1.Y);
  542.              LineTo(T1.X+1,T1.Y+1);
  543.             end;
  544.          CUserVal:=0;
  545.         end;
  546.       Procedure  MakeLine;
  547.         Begin
  548.           Inc(Count);
  549.           ReadPoint(T1,C1);
  550.           ReadPoint(T2,C2);
  551.           With aCanvas do
  552.             Begin
  553.              Pen.Color:=C1;
  554.              MoveTo(T1.X,T1.Y);
  555.              LineTo(T2.X,T2.Y);
  556.             end;
  557.          CUserVal:=0;
  558.        end;
  559.       Procedure MakePolygon;
  560.         Var PolyC,j: Integer;
  561.             PolyPts: Array of TPoint;
  562.         Begin
  563.           Inc(Count);
  564.           PolyC:= Round(FeedBack^[Count]);
  565.           inc(Count);
  566.           SetLength(PolyPts,PolyC);
  567.           For j:=0 to PolyC-1  Do
  568.             Begin
  569.              ReadPoint(PolyPts[j],C1);
  570.             end;
  571.           With aCanvas do
  572.             Begin
  573.              Brush.Color :=C1;
  574.              If CUserVal>0 then Brush.Style :=bsClear;
  575.              Pen.Color   :=C1;
  576.              PolyGon(PolyPts);
  577.             end;
  578.           Finalize(PolyPts);
  579.           CUserVal:=0;
  580.         end;
  581.       Procedure MakeBitMap ;
  582.         Begin
  583.           Inc(Count);
  584.           ReadPoint(T1,C1);
  585.           If assigned(aBitMaps) and (aBitMaps.Count>0) then
  586.            With aCanvas do
  587.             Begin
  588.              Pen.Color:=C1;
  589.              MoveTo(T1.X,T1.Y);
  590.              {Draw(
  591.              Ned to get the bitmap and draw
  592.              }
  593.             end;
  594.           CUserVal:=0;
  595.         end;
  596.       Procedure MakeDraw ;
  597.         Begin
  598.           Inc(Count);
  599.           CUserVal:=0;
  600.         end;
  601.       Procedure MakeCopy ;
  602.         Begin
  603.           Inc(Count);
  604.           CUserVal:=0;
  605.         end;
  606.  
  607.  
  608.     Begin
  609.       If not Assigned(aCanvas) then exit;
  610.       If aSize=0 then exit;
  611.       Count:=0;
  612.       OldPenCol  := aCanvas.Pen.Color;
  613.       OldBrushCol:= aCanvas.Brush.Color;
  614.       CUserVal:=0;
  615.       Repeat
  616.         CVal:=Round(FeedBack^[Count]);
  617.         Case CVal of
  618.             GL_PASS_THROUGH_TOKEN   :Begin
  619.                                       Inc(Count);
  620.                                       CUserVal:=Round(FeedBack^[Count]);
  621.                                       ExtractValues(CUserVal);
  622.                                       Inc(Count);
  623.                                      end ;
  624.             GL_POINT_TOKEN          :MakePoint;
  625.             GL_LINE_TOKEN           :MakeLine;
  626.             GL_POLYGON_TOKEN        :MakePolyGon;
  627.             GL_BITMAP_TOKEN         :MakeBitMap;
  628.             GL_DRAW_PIXEL_TOKEN     :MakeDraw;
  629.             GL_COPY_PIXEL_TOKEN     :MakeCopy;
  630.             GL_LINE_RESET_TOKEN     :Begin
  631.                                       Case CUserVal of
  632.                                         1001..1009 :aCanvas.Pen.Width:=CUserVal-1000;
  633.                                         //set pen width
  634.                                        else aCanvas.Pen.Width:=1;
  635.                                       end;
  636.                                       MakeLine;
  637.                                      end;
  638.          else inc(Count);
  639.          end;
  640.       until (Count>=aSize-2);
  641.       aCanvas.Pen.Color   :=OldPenCol;
  642.       aCanvas.Brush.Color :=OldBrushCol;
  643.     end;
  644.  {********************************************}
  645. {********************************************}
  646. function HorzIntersects(x1,y1,x2,y2,u1,v1,u2: Double;
  647.                                   var lambda: Double ) : boolean;
  648. const
  649.   eps = 1e-6;
  650. var
  651.   mu,
  652.   det: Double;
  653.  
  654. begin
  655.   Result:=false;
  656.   lambda:=-1e6;
  657. { check if no overlap of coordinate ranges }
  658.   if ((x1>=x2) and ((u1<=u2)and(u1>x1) or (u2<u1)and(u2>x1)))or
  659.      ((x2>x1)  and ((u1<=u2)and(u1>x2) or (u2<u1)and(u2>x2)))or
  660.      ((y1>=y2) and (v1>y1))or ((y2>y1)  and (v1>y2)) then exit;
  661.  
  662.   det:=-(u2-u1)*(y2-y1);
  663.   if det=0 then exit;
  664.   lambda:=(-(u2-u1)*(v1-y1))/det;
  665.   mu:=((u1-x1)*(y2-y1)-(x2-x1)*(v1-y1))/det;
  666.   if (lambda>-eps)and(lambda<1.0+eps)and
  667.      (mu>-eps)and(mu<1.0+eps) then Result:=true;
  668. end;
  669. {********************************************}
  670.  Function CalcUnitNormal(P1,P2,P3:tGLPoint;var N:tGLPoint):Boolean;
  671.   // calc the unit normal for the three supplied points
  672.   // will be false if say points are in a line
  673.   Var T1,T2:tGLPoint;
  674.       Length:Extended;
  675.   Begin
  676.     Result:=False;
  677.  
  678.     T1.X:=P1.X-P2.X;
  679.     T1.Y:=P1.Y-P2.Y;
  680.     T1.Z:=P1.Z-P2.Z;
  681.  
  682.     T2.X:=P2.X-P3.X;
  683.     T2.Y:=P2.Y-P3.Y;
  684.     T2.Z:=P2.Z-P3.Z;
  685.  
  686.     N.X:=(T1.Y*T2.Z) - (T1.Z*T2.Y);
  687.     N.Y:=(T1.Z*T2.X) - (T1.X*T2.Z);
  688.     N.Z:=(T1.X*T2.Y) - (T1.Y*T2.X);
  689. //set unit length
  690.     Length:=Sqrt(sqr(N.X)+Sqr(N.Y)+Sqr(N.Z));
  691.     If Length=0 then exit;
  692.     N.X:=N.X/Length;
  693.     N.Y:=N.Y/Length;
  694.     N.Z:=N.Z/Length;
  695.     Result:=True;
  696.   end;
  697. {********************************************}
  698. function intersects(x1,y1,x2,y2,u1,v1,u2,v2: Double;
  699.                     var lambda:   Double ) : boolean;
  700. { check if two line segments (x1,y1)to(x2,y2) and (u1,v1)to(u2,v2) cross,
  701.   if so return true and lambda ie x1,y1 lambda=0 x2,y2 lambda=1 }
  702. const
  703.   eps = 1e-6;
  704. var
  705.   mu,
  706.   det: Double;
  707.  
  708. begin
  709.   Result:=false;
  710.   lambda:=-1e6;
  711. { check if no overlap of coordinate ranges }
  712.   if ((x1>=x2) and ((u1<=u2)and(u1>x1) or (u2<u1)and(u2>x1)))or
  713.      ((x2>x1)  and ((u1<=u2)and(u1>x2) or (u2<u1)and(u2>x2)))or
  714.      ((y1>=y2) and ((v1<=v2)and(v1>y1) or (v2<v1)and(v2>y1)))or
  715.      ((y2>y1)  and ((v1<=v2)and(v1>y2) or (v2<v1)and(v2>y2))) then exit;
  716.  
  717.   det:=(x2-x1)*(v2-v1)-(u2-u1)*(y2-y1);
  718.   if det=0 then exit;
  719.   lambda:=((u1-x1)*(v2-v1)-(u2-u1)*(v1-y1))/det;
  720.   mu:=((u1-x1)*(y2-y1)-(x2-x1)*(v1-y1))/det;
  721.   if (lambda>-eps)and(lambda<1.0+eps)and
  722.      (mu>-eps)and(mu<1.0+eps) then Result:=true;
  723. end;
  724. (*************************************************************)
  725. function  IsPtInsideList(x,y:LongInt;aList:tList):boolean;
  726. { return true if x,y is inside polygon
  727.   List must contain a list of tlinkpoints assumed to be closed
  728.   Most form a simple polygon}
  729. const
  730.   eps = 1e-6;
  731. var
  732.   lambda:double;
  733.   iseg,
  734.   nc,i:    longint;
  735.   pt1,
  736.   pt2:   TPoint;
  737.   XMax,YMax,XMin,YMin:Longint;
  738. begin
  739.   Result:=false;
  740.   if not Assigned(aList) or (aList.count=0) then exit;
  741.   //find max min values
  742.   XMax:=Low(LongInt);YMax:=Low(LongInt);
  743.   XMin:=High(LongInt);YMin:=High(LongInt);
  744.   for i:=0 to aList.count-1 do
  745.    begin
  746.       Pt1.X:=tlinkPoint(aList.Items[i]).Spt.X;
  747.       Pt1.Y:=tlinkPoint(aList.Items[i]).Spt.Y;
  748.       If Pt1.X>XMax then XMax:=Pt1.X;
  749.       If Pt1.Y>YMax then YMax:=Pt1.Y;
  750.       If Pt1.X<XMin then XMin:=Pt1.X;
  751.       If Pt1.Y<YMin then YMin:=Pt1.Y;
  752.    end;
  753.   if (x>xmax)or(y>ymax)or(x<xmin)or(y<ymin) then exit;
  754.  
  755. { find if point is inside boundary or not by counting number of line crossings}
  756.     nc:=0;
  757.     for iseg:=0 to aList.count-2 do
  758.     begin
  759.       pt1:=tLinkPoint(aList.Items[iseg]).SPt;
  760.       pt2:=tLinkPoint(aList.Items[iseg+1]).SPt;
  761.       if Horzintersects(pt1.x,pt1.y,pt2.x,pt2.y,xmin,y,x,lambda) then
  762.         begin
  763.           if (lambda>eps)and(lambda<=1.0-eps) then inc(nc)
  764.           else
  765.           if (lambda<=eps)and(lambda>-eps) then
  766.             begin
  767.               if iseg=0 then pt1:=tLinkPoint(aList.Items[aList.count-2]).SPt
  768.                          else pt1:=tLinkPoint(aList.Items[iseg-1]).SPt;
  769.               Horzintersects(pt1.x,pt1.y,pt2.x,pt2.y,xmin,y,x,lambda);
  770.               if (lambda>-eps)and(lambda<1.0+eps) then inc(nc);
  771.             end;
  772.         end;
  773.     end;
  774.     if (nc mod 2 = 1) then Result:=true;
  775. end;
  776. {********************************************}
  777.  Procedure SetGLPointVal(Var aPt:tGLPoint;XVal,YVal,ZVal:Double);
  778.   //set the tGLPoint value
  779.    Begin
  780.      aPt.X:=XVal;
  781.      aPt.Y:=YVal;
  782.      aPt.Z:=ZVal;
  783.    end;
  784. {********************************************}
  785.  
  786.   Function BearingAndAzimuth(const P1,P2:tGLPoint;var Bearing,Azimuth:Double):Boolean;
  787.     Var XDif,YDif,ZDif,HDist:Extended;
  788.     Begin
  789.       Result:=False;
  790.       XDif:=P2.X-P1.X; YDif:=P2.Y-P1.Y; ZDif:=P2.Z-P1.Z;
  791.       HDist:=sqrt(sqr(XDif)+sqr(YDif));
  792.       If YDif<>0 then Bearing:=ArcTan(abs(XDif)/abs(YDif))/pi180 else bearing:=0;
  793.       If ZDif<>0 then Azimuth:=arcTan(HDist/ZDif)/pi180 else Azimuth:=0;
  794.       If (XDif=0) and(YDif=0) then exit;
  795.        If XDif>=0 then
  796.          Begin
  797.            If YDif>=0 then Bearing:=Bearing  else Bearing:=180-Bearing;
  798.          end else
  799.          If XDif<0 then
  800.          Begin
  801.            If YDif>0 then Bearing:=360-Bearing  else Bearing:=270-Bearing;
  802.          end;
  803.       Result:=True;
  804.     end;
  805. {********************************************}
  806.   Function AngleFromVertical(const P1,P2:tGLPoint; var Angle:Double):Boolean;
  807.     Var XDif,YDif,ZDif,HDist:Extended;
  808.     Begin
  809.       Result:=False;
  810.       Angle:=0;
  811.       XDif:=P1.X-P2.X; YDif:=P1.Y-P2.Y; ZDif:=P1.Z-P2.Z;
  812.       HDist:=sqrt(sqr(XDif)+sqr(YDif));
  813.       If (HDist=0) then exit;
  814.       Angle:=ArcTan(ZDif/HDist)/pi180;
  815.       Result:=True;
  816.     end;
  817.  
  818. {********************************************}
  819. function MaskX86Exceptions: Pointer;
  820. var
  821.   dwOldMask: Pointer;
  822. begin
  823.   asm
  824.     fnstcw WORD PTR dwOldMask;
  825.     mov eax, dwOldMask;
  826.     or eax, $3f;
  827.     mov WORD PTR dwOldMask + 2, ax;
  828.     fldcw WORD PTR dwOldMask + 2;
  829.   end;
  830.   result := dwOldMask;
  831. end;
  832. (******* ******************************************************)
  833.  
  834. procedure RestoreX86Mask(dwOldMask: Pointer);
  835. begin
  836.   asm
  837.     fnclex;
  838.     fldcw WORD PTR dwOldMask;
  839.   end;
  840. end;
  841. (******* ******************************************************)
  842.  procedure CalcPolarValues(P1,P2:tGLPoint;var Length,Bearing,Inclination:Single);
  843.  // zero north, zero=horizontal
  844.    var
  845.      XDif,YDif,ZDif, HorDist,Pi180 : Double;
  846.    begin
  847.      Pi180:=Pi/180;
  848.      XDif:= (P1.X-P2.X);
  849.      YDif:= (P1.Y-P2.Y);
  850.      ZDif:= (P1.Z-P2.Z);
  851.      HorDist := SQRT(Sqr(XDif)+Sqr(YDif));
  852.      Length  := Sqrt(Sqr(HorDist)+Sqr(ZDif));
  853.      Bearing:=arcTan2(Ydif,XDif)/pi180;
  854.      If Bearing<0 then Bearing:=360+Bearing;
  855.      Inclination:=arcTan2(-Zdif,HorDist)/pi180;
  856.      {Tim B change for correct convention}
  857.      Inclination:=Inclination-90{-VertAngle};
  858.    end;
  859. (******************************************************)
  860. Procedure CalcEndPoint(P1:tGLPoint;Length,Bearing,Inclination:Single;Var P2:tGLPoint);
  861.  // calc end point(P2) from polar and startpoint(P1)
  862.   var
  863.     HorDist,
  864.     CompareTol   : Double;
  865.   begin
  866.     CompareTol:=0.001;
  867.  
  868.     if Length <= CompareTol then
  869.      begin
  870.       P2.X:=P1.X;
  871.       P2.Y:=P1.Y;
  872.       P2.Z:=P1.Z;
  873.      end  else
  874.      begin
  875.       p2.z:=P1.z-(cos(Pi180*(90+Inclination))*Length);
  876.       HorDist := (Sin(Pi180*(90+Inclination)))*Length ;
  877.       P2.X := P1.X+(Sin(Bearing*Pi180))*HorDist;
  878.       P2.Y := P1.Y+(Cos(Bearing*Pi180))*HorDist;
  879. {$B+}
  880.       If (P2.x<comparetol)and(P2.x>-Comparetol) then P2.x:=0;
  881.       If (P2.y<comparetol)and(P2.y>-Comparetol) then P2.y:=0;
  882.       If (P2.z<comparetol)and(P2.Z>-Comparetol) then P2.z:=0;
  883. {$B-}
  884.     end;
  885.   end;
  886. (******************************************************)
  887.  Procedure GetListData(var aMeasRec:tMeasureRecord;aList:TList);
  888.     //Used to fill record with current move point data
  889.  
  890.     Procedure CalculateArea(Var Area,CMX,CMY,CMZ,DistanceSum:Double);
  891.         Var TmpArea,TmpEast,TmpNorth,TmpElevation,CT,PX,PY,Pz:Double;
  892.             iVal:LongInt;
  893.             P1:tLinkPoint;
  894.       Begin
  895.         Area:=0;
  896.         CMX:=0;CMY:=0;CMZ:=0;
  897.         TmpArea:=0;
  898.         TmpEast:=0;
  899.         TmpNorth:=0;
  900.         TmpElevation:=0;
  901.         DistanceSum:=0;
  902.         Px:=TLinkPoint(aList.Items[aList.count-1]).X ;
  903.         Py:=TLinkPoint(aList.Items[aList.count-1]).Y ;
  904.         pz:=TLinkPoint(aList.Items[aList.count-1]).Z ;
  905.         For iVal:=0 to aList.Count-1 do
  906.           Begin
  907.            P1:= TLinkPoint(aList.Items[iVal]);
  908.            DistanceSum:=DistanceSum+sqrt(Sqr(Px-P1.x)+sqr(Py-P1.y)+sqr(pz-P1.Z));
  909.            CT:=PX*P1.Y - PY*P1.X;
  910.            TmpArea:=TmpArea+CT;
  911.            TmpEast:=TmpEast+CT*(PX+P1.X);
  912.            TmpNorth:=TmpNorth+CT*(PY+P1.Y);
  913.            TmpElevation:=TmpElevation+ P1.Z;
  914.            PX:=P1.X;
  915.            PY:=P1.Y;
  916.            end;
  917.          { Get Area and center of mass in the current square units  }
  918.         if abs(TmpArea)<0.001 then exit;
  919.         CT:=TmpArea*3.0;
  920.         CMX:=TmpEast/CT;
  921.         CMY:=TmpNorth/CT;
  922.         CMZ:=TmpElevation/aList.Count;
  923.         Area:=abs(0.5*TmpArea) ;
  924.       end;
  925.  
  926.     Var LP1,LP2:tLinkPoint;
  927.     Begin
  928.       FillChar(aMeasRec,SizeOf(aMeasRec),0);
  929.       If aList.Count<2 then exit;
  930.      // get last 2 points
  931.       Lp1:=aList.Items[aList.count-2] ;
  932.       Lp2:=aList.Items[aList.count-1] ;
  933.       With ameasRec do
  934.        Begin
  935.          NoOfPoints  := aList.Count;     //No of points used
  936.          LastDeltaX  := Lp2.X-LP1.X;     //dif in X
  937.          LastDeltaY  := Lp2.Y-LP1.Y;     //dif in Y
  938.          LastDeltaZ  := Lp2.Z-LP1.Z;     //dif in Z
  939.          LastDistance:=sqrt( sqr(LastDeltaX)+sqr(LastDeltaY)+sqr(LastDeltaY));  //Real dist
  940.          // to Do
  941.        (*  Lastbearing,    //Bearing of line degree
  942.          LastElevation,  //Elevation angle degree*)
  943.          If (aList.Count>2) then CalculateArea(Area,CMX,CMY,CMZ,DistanceSum);
  944.        end;
  945.     end;
  946. {*********************general routines******************************}
  947. function PolygonArea(Polygon: TList): double;
  948.  
  949. function MySucc(n,Count: LongInt): LongInt;
  950. { returns next in series 123..Count123 }
  951. begin
  952.   if n=Count then Result := 1
  953.              else Result := n+1;
  954. end;
  955.  
  956. function MyPrev(n,Count: LongInt): LongInt;
  957. { returns previous in series 123..Count123 }
  958. begin
  959.   if n=1 then Result := Count
  960.          else Result := n-1;
  961. end;
  962.  
  963. var
  964.   i: integer;
  965.   PPrev, P, PSucc: TLinkPoint;
  966.   Area: double;
  967. begin
  968.   Area:= 0;
  969.   for i:= 1 to Polygon.Count-1 do
  970.   begin
  971.     PPrev:= Polygon.Items[MyPrev(i,Polygon.Count)-1];
  972.     P:= tLinkPoint(Polygon.Items[i-1]);
  973.     PSucc:= Polygon.Items[MySucc(i,Polygon.Count)-1];
  974.     Area:= Area + abs(P.X * (PSucc.Y - PPrev.Y));
  975.   end;
  976.   Result:= Area * 0.5;
  977. end;
  978. {*********************general routines******************************}
  979. Function DistanceBetween(P1,p2:tGLPoint):Double;
  980.   Begin
  981.    Result:=Sqrt(Sqr(P1.X-P2.X)+
  982.                 Sqr(P1.Y-P2.Y)+
  983.                 Sqr(P1.Z-P2.Z));
  984.   end;
  985. (******* ******************************************************)
  986. Function GetGLStringValue(aext:GLInt):pchar;
  987. Begin
  988.   Result:=glGetString(aext);
  989. end;
  990. (******* ******************************************************)
  991. Function SetSwapHintAddress:Pointer;
  992. const PC2 : pchar='GL_WIN_swap_hint';
  993. var   PC1 : pChar;
  994. Begin
  995.   Result:=nil;
  996.   pc1:=GetGLStringValue(GL_EXTENSIONS);
  997.   If  StrPos(PC1,PC2)<>nil then
  998.      Result:=wglGetProcAddress('');
  999. end;
  1000. {**********************************************************************}
  1001.  Procedure DrawAxes(SegLength,segDia,ArrowDia:glFloat;
  1002.                       Const SegCount:GLInt;FullRender:Boolean);
  1003.    var       Quad:GLUquadricObj;
  1004.      Begin
  1005.           glPushAttrib(GL_ALL_ATTRIB_BITS);
  1006.             Quad:=gluNewQuadric;
  1007.             If fullRender then
  1008.              Begin
  1009.                gluQuadricDrawStyle(Quad,GLU_fill);
  1010.                gluQuadricNormals(Quad,GLU_SMOOTH);
  1011.              end else
  1012.               Begin
  1013.                gluQuadricDrawStyle(Quad,GLU_LINE);
  1014.                gluQuadricNormals(Quad,GLU_NONE);
  1015.              end;
  1016.                glColor4fv(@glRed);     {X Axis}
  1017.              glPushMatrix;
  1018.                glTranslatef(0,0,0);
  1019.                glRotatef(90,0.0,1.0,0.0);
  1020.                gluCylinder(quad,segDia,segDia,SegLength,SegCount,SegCount);
  1021.              glPopMatrix;
  1022.              glPushMatrix;
  1023.                glTranslatef(SegLength,0,0);
  1024.                glRotatef(90,0.0,1.0,0.0);
  1025.                gluCylinder(quad,ArrowDia,0.0,SegLength,SegCount,SegCount);
  1026.              glPopMatrix;
  1027.               glColor4fv(@glBlue);    {Y Axis}
  1028.              glPushMatrix;
  1029.                glTranslatef(0,0,0);
  1030.                glRotatef(-90,1.0,0.0,0.0);
  1031.                gluCylinder(quad,segDia,segDia,SegLength,SegCount,SegCount);
  1032.              glPopMatrix;
  1033.              glPushMatrix;
  1034.                glTranslatef(0,SegLength,0);
  1035.                glRotatef(-90,1.0,0.0,0.0);
  1036.                gluCylinder(quad,ArrowDia,0.0,SegLength,SegCount,SegCount);
  1037.              glPopMatrix;
  1038.               glColor4fv(@glGreen);    {z Axis}
  1039.              glPushMatrix;
  1040.                glTranslatef(0,0,0);
  1041.                gluCylinder(quad,segDia,segDia,SegLength,SegCount,SegCount);
  1042.              glPopMatrix;
  1043.              glPushMatrix;
  1044.                glTranslatef(0,0,SegLength);
  1045.                gluCylinder(quad,ArrowDia,0.0,SegLength,SegCount,SegCount);
  1046.              glPopMatrix;
  1047.             gluDeleteQuadric(Quad);
  1048.           glPopAttrib;
  1049.      end;
  1050. {**********************************************************}
  1051. {**********************************************************}
  1052.  Constructor tGLLight.Create(aNum:LongInt);
  1053.    const DefVal1=0.5;
  1054.          DefVal2=1.0;
  1055.          defval3=0.0;
  1056.    Begin
  1057.      Inherited create;
  1058.   //default values
  1059.      With fPosition do
  1060.       Begin
  1061.         X:=0;Y:=0; Z:=1000;
  1062.       end;
  1063.      With fSpotDir do
  1064.       Begin
  1065.         X:=0;Y:=0;Z:=-1;
  1066.       end;
  1067.      With fAmbient do
  1068.       Begin
  1069.         R:=DefVal2;G:=DefVal2;B:=DefVal2;A:=DefVal2;
  1070.       end;
  1071.      With fDiffuse do
  1072.       Begin
  1073.         R:=DefVal2;G:=DefVal2;B:=DefVal2;A:=DefVal2;
  1074.       end;
  1075.      With fSpecular do
  1076.       Begin
  1077.         R:=DefVal2;G:=DefVal2;B:=DefVal2;A:=DefVal2;
  1078.       end;
  1079.      fShininess :=128;
  1080.  
  1081.      fLightNum:=aNum;
  1082.      fSpotExponent:=100;
  1083.      fSpotAngle:=60;
  1084.  
  1085.    end;
  1086. {**********************************************************}
  1087.  Destructor tGLLight.Destroy;
  1088.   Begin
  1089.      Inherited Destroy;
  1090.   end;
  1091. {**********************************************************}
  1092.  Procedure tGLLight.TurnLightOn;
  1093.   Begin
  1094.    fOn:=True;
  1095.    glEnable(fLightNum);
  1096.    SetUpLight;
  1097.   end;
  1098. {**********************************************************}
  1099.  Procedure tGLLight.TurnLightOff;
  1100.   Begin
  1101.    fOn:=False;
  1102.    glDisable(fLightNum);
  1103.   end;
  1104. {**********************************************************}
  1105.  Procedure tGLLight.PositionLight(aPt:tGLPoint);
  1106.   Begin
  1107.    fPosition:=aPt;
  1108.    SetUpLight;
  1109.   end;
  1110. {**********************************************************}
  1111.  Procedure tGLLight.SetLightColor(aCol:tGLLightVal);
  1112.    Begin
  1113.     fAmbient:=aCol;
  1114.     fDiffuse:=aCol;
  1115.     fSpecular:=aCol;
  1116.     SetUpLight;
  1117.    end;
  1118. {**********************************************************}
  1119.  Procedure tGLLight.SetUpLight;
  1120.    Begin
  1121.      If not fOn then exit;
  1122.      //assume GL session
  1123.      glLightfv(fLightNum,GL_POSITION,@fPosition);
  1124.      glLightfv(fLightNum,GL_Diffuse,@fDiffuse);
  1125.      glLightfv(fLightNum,GL_AMBIENT,@fAmbient);
  1126.      glLightfv(fLightNum,GL_Specular,@fSpecular);
  1127.      If fLightType=ltSpot then
  1128.       Begin
  1129.         glLightfv(fLightNum,GL_SPOT_DIRECTION,@fSpotDir);
  1130.         glLightf(fLightNum, GL_SPOT_CUTOFF,fSpotAngle);
  1131.         glLightf(fLightNum, GL_SPOT_EXPONENT,fSpotExponent);
  1132.       end;
  1133.    end;
  1134. {**********************************************************}
  1135. {**********************************************************}
  1136. Constructor TLinkPoint.CreateSpecial(aWorldX,aWorldY,aWorldZ:Double);
  1137.   Begin
  1138.     Inherited Create;
  1139.     X:=aWorldX;
  1140.     Y:=aWorldy;
  1141.     Z:=aWorldZ;
  1142.     ScreenZ:=1;
  1143.   end;
  1144. {**********************************************************}
  1145.   Procedure TLinkPoint.SetWorldPt(aX,aY,aZ:Double);
  1146.    Begin
  1147.      X:=aX;
  1148.      Y:=aY;
  1149.      z:=aZ;
  1150.    end;
  1151. {**********************************************************}
  1152.   Function TLinkPoint.Duplicate:TLinkPoint;
  1153.     Begin
  1154.       Result:=TLinkPoint.Create;
  1155.       Result.X:=X;
  1156.       Result.Y:=Y;
  1157.       Result.Z:=Z;
  1158.       Result.sPt.X:=sPt.X;
  1159.       Result.sPt.Y:=sPt.Y;
  1160.       Result.sX:=sX;
  1161.       Result.sY:=sY;
  1162.       Result.ScreenZ:=ScreenZ;
  1163.       Result.fScreenPtValid:=fScreenPtValid;
  1164.     end;
  1165. {**********************************************************}
  1166.   Function TLinkPoint.GetWorldPt :pGLDouble;
  1167.     Begin
  1168.      Result:=pGLDouble(@X);
  1169.     end;
  1170. {**********************************************************}
  1171.   Procedure TLinkPoint.SetHeight(aHt:LongInt);
  1172.     Begin
  1173.       Spt.Y:=abs(SY-aHt);
  1174.     end;
  1175. {**********************************************************}
  1176.   Function TLinkPoint.GetGLScreenPt(var aPt: TPoint):Boolean;
  1177.     Begin
  1178.      Result:=fScreenPtValid;
  1179.      If Not fScreenPtValid  then exit;
  1180.      aPt.X:=aPt.X;
  1181.      aPt.Y:=aPt.Y;
  1182.     end;
  1183. {**********************************************************}
  1184.   Procedure TLinkPoint.SetGLScreenPt(AX,AY,aHt:LongInt;AZ:Double);
  1185.      begin
  1186.        SX:=ax;
  1187.        SY:=ay;
  1188.        ScreenZ:=aZ;
  1189.        sPt.X:=aX;
  1190.        sPt.Y:=abs(ay-aHt);
  1191.      end;
  1192. {**********************************************************}
  1193.   Procedure TLinkPoint.SetWinScreenPt(aX,aY,aHt:LongInt;aZ:Double);
  1194.     Begin
  1195.      SPt.X:=aX;
  1196.      SPt.Y:=aY;
  1197.      ScreenZ:=aZ;
  1198.      SX:=aX;
  1199.      SY:=aHt-AY;
  1200.     end;
  1201. {**********************************************************}
  1202. Procedure Scale_Data(
  1203.  
  1204.                      Dmin,                   {data minimum}
  1205.                      Dmax:   Double;           {data maximum}
  1206.                      Nmax:   Smallint;        {max number of intervals}
  1207.                  var st:     Double;           {starting value}
  1208.                  var dinc:   Double;           {increment}
  1209.                  var Ninc:   SmallInt);       {number of increments}
  1210.  
  1211. { this routines calculates a nice starting value and increment such
  1212.   that the data is enclosed by the interval }
  1213.  
  1214.     Function LintVal( aval:Double ):Smallint;
  1215.  
  1216.     { this function returns the lower integer value between which a Double
  1217.       number lies. i.e. truncates if >0 and truncates-1 if <0 }
  1218.     var DL,DH:Smallint;
  1219.     begin
  1220.       DL:=Low(Smallint);
  1221.       DH:=High(Smallint);
  1222.       Result:=0;
  1223.      try
  1224.       if aval<0 then
  1225.        begin
  1226.         if (aval<DL) then REsult:=DL else REsult:=system.Trunc(aval)-1;
  1227.        end else
  1228.        Begin
  1229.         if (aval>DH) then REsult:=DH else REsult:=system.Trunc(aval);
  1230.        end;
  1231.      except
  1232.       On EInvalidOp do else Raise;
  1233.      end;
  1234.     end;
  1235.  
  1236.     Function PowerOf10( n:Smallint ):Double;
  1237.  
  1238.     {  this function returns the nth power of 10 }
  1239.     var
  1240.       i:   Smallint;
  1241.       aval:   Double;
  1242.  
  1243.     begin
  1244.       aval:=1.0;
  1245.       Result:=aval;
  1246.      try
  1247.       if n>0 then for i:=1 to n do aval:=aval*10.0
  1248.              else if n<0 then for i:=1 to -n do aval:=aval/10.0;
  1249.       Result:=aval;
  1250.      except
  1251.       On EInvalidOp do else Raise;
  1252.      end;
  1253.     end;
  1254.  
  1255. var
  1256.   OK:          boolean;
  1257.   r,
  1258.   Range,
  1259.   En,v1,v2,v3: double;
  1260.   i,
  1261.   ipow:        Smallint;
  1262.  
  1263. Const
  1264.   Srange: array[1..80] of Double
  1265.   = (0.1  ,0.1  ,0.1  ,0.1  ,0.1  ,0.1  ,0.11 ,0.12 ,0.12 ,0.125,
  1266.      0.13 ,0.14 ,0.14 ,0.15 ,0.15 ,0.15 ,0.16 ,0.16 ,0.17 ,0.175,
  1267.      0.18 ,0.18 ,0.19 ,0.2  ,0.2  ,0.2  ,0.2  ,0.2  ,0.2  ,0.22 ,
  1268.      0.225,0.24 ,0.25 ,0.25 ,0.25 ,0.26 ,0.275,0.28 ,0.3  ,0.3  ,
  1269.      0.3  ,0.3  ,0.32 ,0.325,0.34 ,0.35 ,0.35 ,0.36 ,0.375,0.38 ,
  1270.      0.4  ,0.4  ,0.4  ,0.4  ,0.4  ,0.425,0.45 ,0.45 ,0.475,0.5  ,
  1271.      0.5  ,0.5  ,0.5  ,0.5  ,0.55 ,0.6  ,0.6  ,0.6  ,0.65 ,0.7  ,
  1272.      0.7  ,0.75 ,0.75 ,0.8  ,0.8  ,0.8  ,0.85 ,0.9  ,0.9  ,0.95 );
  1273.   Snum:  array [1..80] of byte
  1274.   = (20   ,10   ,5    ,4    ,2    ,1    ,11   ,12   ,6    ,5    ,
  1275.      13   ,14   ,7    ,15   ,6    ,3    ,16   ,8    ,17   ,7    ,
  1276.      18   ,9    ,19   ,20   ,10   ,8    ,4    ,2    ,1    ,11   ,
  1277.      9    ,12   ,10   ,5    ,1    ,13   ,11   ,14   ,15   ,12   ,
  1278.      6    ,3    ,16   ,13   ,17   ,14   ,7    ,18   ,15   ,19   ,
  1279.      20   ,16   ,8    ,4    ,2    ,17   ,18   ,9    ,19   ,20   ,
  1280.      10   ,5    ,2    ,1    ,11   ,12   ,6    ,3    ,13   ,14   ,
  1281.      7    ,15   ,3    ,16   ,8    ,4    ,17   ,18   ,9    ,19);
  1282.  
  1283.  
  1284. begin
  1285. { initial values}
  1286.   i:=0;
  1287.   OK:=false;
  1288.   st:=0;dinc:=0;Ninc:=0;
  1289.  Try
  1290. { adjust invalid values for data items }
  1291.   if Nmax<1 then Nmax:=1;
  1292.   if Dmin>Dmax then begin
  1293.     r:=Dmin;
  1294.     Dmin:=Dmax;
  1295.     Dmax:=r;
  1296.   end;
  1297. { bug fix if both equal 0 }
  1298.   if (Dmin=Dmax)and(Dmin=0.0) then begin
  1299.     st:=0.0;
  1300.     Ninc:=1;
  1301.     dinc:=1.0e-36;
  1302.     exit;
  1303.   end;
  1304. { bug fix to prevent very small increments incomparison to value }
  1305.   if Dmax-Dmin<0.000001*Dmin then Dmax:=Dmin*1.000001;
  1306.  
  1307. { calculate the range of the data and the order of magntiude }
  1308.   Range:=Abs(Dmax-Dmin);
  1309.   v1:=ln(Range);
  1310.   v2:=ln(10.0);
  1311.   v3:=V1/v2;
  1312.   ipow:=LintVal(v3);
  1313.   r:=Range/PowerOf10(ipow+1);
  1314.  
  1315. { search for suitable range }
  1316.   repeat
  1317.  
  1318.     while (i<80)and(not OK) do begin
  1319.       i:=i+1;
  1320.       if (Srange[i]>=r*0.9999999)and(Snum[i]<=Nmax) then
  1321.       begin
  1322.         Ninc:=Snum[i];
  1323.         Dinc:=Srange[i]/Int(Ninc)*PowerOf10(ipow+1);
  1324.         V1:=DMin/Dinc+0.0000001;
  1325.         V2:=lintVal(V1);
  1326.         St:=v2*Dinc;
  1327.         En:=st+Int(Ninc)*Dinc;
  1328.         if (st<=Dmin+abs(Dmin)*0.0000001)and(En>=Dmax-abs(Dmax)*0.0000001) then OK:=true;
  1329.       end;
  1330.     end;
  1331.     if not OK then begin
  1332.       r:=r/10.0;
  1333.       ipow:=ipow+1;
  1334.       i:=0;
  1335.     end;
  1336.   until OK or (ipow>37);
  1337.  
  1338.   if not OK then begin
  1339.     Ninc:=1;
  1340.     Dinc:=range;
  1341.     st:=Dmin;
  1342.   end;
  1343.  except
  1344.   // fix for a very odd  EInvalidOp at startup
  1345.       On EInvalidOp do else Raise;
  1346.  end;
  1347. end;
  1348. (***********************************************)
  1349. Procedure CreateGrid(MinPt,MaxPt:tGLPoint;aGridType:GLGridType;aStep:LongInt);
  1350.  
  1351.      var MaxVal1,MinVal1,MaxVal2,MinVal2:double;
  1352.          Linestart,LineEnd :tGLPoint;
  1353.          StartVal,Inc:Double;
  1354.          NoInc,Step:Smallint;
  1355.  
  1356.      Procedure BottomTop(CommonVal:Double);
  1357.         var Count:LongInt;
  1358.         Begin
  1359.            MaxVal1:=MaxPt.X;MinVal1:=MinPt.X;
  1360.            maxVal2:=MaxPt.Y;MinVal2:=MinPt.Y;
  1361.            StartVal:=0;Inc:=0;NoInc:=0;
  1362.            //first series
  1363.            Scale_Data(MinVal1,MaxVal1,Step,StartVal,Inc,NoInc);
  1364.            Linestart.X:=StartVal;Linestart.Y:=MinPt.Y;Linestart.Z:=CommonVal;
  1365.            LineEnd.X:=StartVal;LineEnd.Y:=MaxPt.Y;LineEnd.Z:=CommonVal;
  1366.            GLBegin(GL_Lines);
  1367.               For Count:=0 to NoInc do
  1368.                Begin
  1369.                 glVertex3dv(@LineStart);
  1370.                 glvertex3dv(@LineEnd);
  1371.                 LineStart.X:=LineStart.X+Inc;
  1372.                 LineEnd.X:=LineEnd.X+inc;
  1373.                end;
  1374.            glEnd;
  1375.            //2nd series vary Y
  1376.            StartVal:=0;Inc:=0;NoInc:=0;
  1377.            Scale_Data(MinVal2,MaxVal2,Step,StartVal,Inc,NoInc);
  1378.            Linestart.X:=MinPt.X;Linestart.Y:=StartVal;Linestart.Z:=CommonVal;
  1379.            LineEnd.X:=MaxPt.X;LineEnd.Y:=StartVal;LineEnd.Z:=CommonVal;
  1380.            GLBegin(GL_Lines);
  1381.               For Count:=0 to NoInc do
  1382.                Begin
  1383.                 glVertex3dv(@LineStart);
  1384.                 glvertex3dv(@LineEnd);
  1385.                 LineStart.Y:=LineStart.Y+Inc;
  1386.                 LineEnd.Y:=LineEnd.Y+inc;
  1387.                end ;
  1388.            glEnd;
  1389.        end;
  1390.  
  1391.      Procedure LeftRight(CommonVal:Double);
  1392.         var     Count:LongInt;
  1393.        Begin
  1394.            MaxVal1:=MaxPt.Z;MinVal1:=MinPt.Z;
  1395.            maxVal2:=MaxPt.Y;MinVal2:=MinPt.Y;
  1396.            //first series
  1397.            StartVal:=0;Inc:=0;NoInc:=0;
  1398.            Scale_Data(MinVal1,MaxVal1,Step,StartVal,Inc,NoInc);
  1399.            Linestart.X:=CommonVal;Linestart.Y:=MinPt.Y;Linestart.Z:=StartVal;
  1400.            LineEnd.X:=CommonVal;LineEnd.Y:=MaxPt.Y;LineEnd.Z:=StartVal;
  1401.            GLBegin(GL_Lines);
  1402.               For Count:=0 to NoInc do
  1403.                Begin
  1404.                 glVertex3dv(@LineStart);
  1405.                 glvertex3dv(@LineEnd);
  1406.                 LineStart.Z:=LineStart.Z+Inc;
  1407.                 LineEnd.Z:=LineEnd.Z+inc;
  1408.                end;
  1409.            glEnd;
  1410.            //2nd series vary Y
  1411.            StartVal:=0;Inc:=0;NoInc:=0;
  1412.            Scale_Data(MinVal2,MaxVal2,Step,StartVal,Inc,NoInc);
  1413.            Linestart.X:=CommonVal;Linestart.Y:=StartVal;Linestart.Z:=MinPt.Z;
  1414.            LineEnd.X:=CommonVal;LineEnd.Y:=StartVal;LineEnd.Z:=MaxPt.Z;
  1415.            GLBegin(GL_Lines);
  1416.               For Count:=0 to NoInc do
  1417.                Begin
  1418.                 glVertex3dv(@LineStart);
  1419.                 glvertex3dv(@LineEnd);
  1420.                 LineStart.Y:=LineStart.Y+Inc;
  1421.                 LineEnd.Y:=LineEnd.Y+inc;
  1422.                end;
  1423.            glEnd;
  1424.        end;
  1425.      Procedure FrontBack(CommonVal:Double);
  1426.         var Count:LongInt;
  1427.        Begin
  1428.            MaxVal1:=MaxPt.Z;MinVal1:=MinPt.Z;
  1429.            maxVal2:=MaxPt.X;MinVal2:=MinPt.X;
  1430.            StartVal:=0;Inc:=0;NoInc:=0;
  1431.            //first series
  1432.            Scale_Data(MinVal1,MaxVal1,Step,StartVal,Inc,NoInc);
  1433.            Linestart.X:=MinPt.X;Linestart.Y:=CommonVal;Linestart.Z:=StartVal;
  1434.            LineEnd.X:=MaxPt.X;LineEnd.Y:=CommonVal;LineEnd.Z:=StartVal;
  1435.            GLBegin(GL_Lines);
  1436.               For Count:=0 to NoInc do
  1437.                Begin
  1438.                 glVertex3dv(@LineStart);
  1439.                 glvertex3dv(@LineEnd);
  1440.                 LineStart.Z:=LineStart.Z+Inc;
  1441.                 LineEnd.Z:=LineEnd.Z+inc;
  1442.                end ;
  1443.            glEnd;
  1444.            //2nd series vary Y
  1445.            StartVal:=0;Inc:=0;NoInc:=0;
  1446.            Scale_Data(MinVal2,MaxVal2,Step,StartVal,Inc,NoInc);
  1447.            Linestart.X:=StartVal;Linestart.Y:=CommonVal;Linestart.Z:=MinPt.Z;
  1448.            LineEnd.X:=StartVal;LineEnd.Y:=CommonVal;LineEnd.Z:=MaxPt.Z;
  1449.            GLBegin(GL_Lines);
  1450.               For Count:=0 to NoInc do
  1451.                Begin
  1452.                 glVertex3dv(@LineStart);
  1453.                 glvertex3dv(@LineEnd);
  1454.                 LineStart.X:=LineStart.X+Inc;
  1455.                 LineEnd.X:=LineEnd.X+inc;
  1456.                end;
  1457.            glEnd;
  1458.        end;
  1459.   begin
  1460.     If astep<=0 then step:=7 else step:=aStep;
  1461. // set up for the L state in display list
  1462. //create the necessay lines
  1463.     glColor4fv(@glBlack);
  1464.         Case aGridtype of
  1465.            gtBottom:{XY Min}BottomTop(MinPt.Z);
  1466.            gtTop: {XY,Max}  BottomTop(MaxPt.Z);
  1467.            gtLeftSide:      LeftRight(MinPt.X);
  1468.            gtRightSide:     LeftRight(MaxPt.X);
  1469.            gtBack:          FrontBack(MaxPt.Y);
  1470.            gtFront:         FrontBack(MinPt.Y);
  1471.         end;
  1472.   end;
  1473. {==========================================================================}
  1474.  
  1475. end.
  1476.