home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / GrafSys 2.0 / GrafSys 2.0 source / GrafSysScreenGeoBench.p < prev    next >
Encoding:
Text File  |  1993-08-26  |  37.1 KB  |  1,029 lines  |  [TEXT/PJMM]

  1. unit GrafSysScreen;
  2.  
  3. interface
  4. uses
  5.     Matrix, Transformations, OffscreenCore, GrafSysCore;
  6.  
  7. const
  8. {$IFC UseFixedMath = FALSE}
  9.     MaxPointPerBuf = 1024 - 1; (* Maximum Points per Object : 256K *)
  10. {$ELSEC}
  11. { code for fixed math routines }
  12.     MaxPointPerBuf = 1024 - 1;
  13. {$ENDC}
  14.     MaxBuffers = 256 - 1;
  15. (* GrafSys constants *)
  16.     cPort3DType = '3Prt';
  17.     cGrafSysVersion = $00000001; (* = Version 0.01 *)
  18.  
  19. type
  20.     ProjectionTypes = (parallel, perspective);
  21.     clippingType = (none, arithmetic, fast);
  22.  
  23.     TPort3DPtr = ^TPort3D;
  24.     TPort3D = record
  25.             theWindow: CWindowRecord; (* piggy-back riding on the window's data we'll put everything else *)
  26.             mx, my, dx, dy: real; (* used for GrafSys adaption *)
  27.             versionType: OSType; (* used to veryfy that this record is really a 3dPort *)
  28.             theOffscreen: TOffscreenRec; (* for later use in off-screen drawing *)
  29.             ProjectionPlane: rect;
  30.             ViewPlane: rect;
  31.             left, right, top, bottom: integer;
  32.             center: point;
  33.             useEye: Boolean;    {if false, no eye transform necessary }
  34.             EyeKoord: Vector4;
  35.             ViewPoint: Vector4;
  36.             phi, theta, pitch: real;
  37.             ViewAngle: real;
  38.             d: real; {Perspective param set by viewangle }
  39.             MasterTransform: Matrix4; {matrix to transform all objects according to eye settings }
  40.             projection: ProjectionTypes;
  41.             clipping: ClippingType;
  42.             versionsID: longint; (* ID so objects can detect if the eye changed its specifications *)
  43.         end;
  44.  
  45.     TSPoint3D = object(TPoint3D)
  46.             size: integer; (* size of point *)
  47.             procedure Init;
  48.             override;
  49.             procedure Reset;
  50.             override;
  51.             procedure Draw;    {draw point as seen from the eye. xForm (and Eye) are  applied. No Transform call required }
  52.             override;                {xForm is automatically calculated if neccessary. A Graf3DPort must be active! }
  53.         end;
  54.  
  55.     TSLine3D = object(TLine3D)
  56.             procedure Draw;     {draw line as seen from the eye. xForm (and Eye) are  applied. No Transform call required }
  57.             override;                {xForm is automatically calculated if neccessary. A Graf3DPort must be active! }
  58.         end;
  59.  
  60.     Point3DEntry = record
  61.             koords: Vector4;
  62.             transformed: vector4; (* transformed point, used with clipping *)
  63.             Screenx: integer;
  64.             Screeny: integer;
  65. {transformedZ: real;}
  66.         end;
  67.  
  68.     Point3DBufPtr = ^Point3DBufRec;
  69.     Point3DBufRec = array[0..MaxPointperBuf] of Point3DEntry;
  70.  
  71.     TSGenericObject3D = object(Tabstract3DObject)     { this is the real 3D object that will be extended }
  72.             theBufs: array[0..MaxBuffers] of Point3DBufPtr;        { it contains only the points, nothing else }
  73.             currentBuf: Point3DBufPtr;
  74.             currentIndex: integer; (* index of current buffer *)
  75.             numPoints: longint; (* number of points in object *)
  76.             Bounds: rect; (* for auto-erase data gathering *)
  77.             oldBounds: Rect;
  78.             screenXform: Matrix4;                                {final xformation matrix including eye if useseye else}
  79.                                                                 {equal to xForm                                                         }
  80.             procedure Init;
  81.             override;
  82.             function Clone: TGenericObject;                    {duplicate point buffers as well }
  83.             override;
  84.             procedure Reset;                                    {reset all rots and attributes to default }
  85.             override;
  86.             procedure Kill;                                         {deallocate mem. Will kill all sons that inherit}
  87.             override;
  88.             procedure GenIndex (pointIndex: longint; var BufIndex, bufOffset: integer); {pointindex -> (buffer, offset) conversion }
  89.             function AddPoint (x, y, z: real): longint;        {add a point to the object's database. It returns the }
  90.                                                                 {points reference number if successful or -1 otherwise}
  91.                                                                 {point count is one-based, i.e. fist point is index 1. Note     }
  92.                                                                 {that this differs from the internal representation where }
  93.                                                                 {point count is zero-based. COMMON ERROR SOURCE!         }
  94.             function DeletePoint (index: longint): boolean;    {delete point with passed index from database. returns }
  95.                                                                 {false if operation could not be completed }
  96.                                                                 {delete does not deallocate mem if buffer is freed }
  97.                                                                 {all points beyond the one deleted will be moved to }
  98.                                                                 {compact mem}
  99.                                                                 {passing index <1 as index means delete all points}
  100.             procedure GetPoint (index: longint; var x, y, z: real);         {get points coordinate in model coords }
  101.                                                                                 {if point illegal, it returns 0,0,0}
  102.             function ChangePoint (index: longint; x, y, z: real): boolean;     {change points coords. true on success }
  103.             procedure Transform (forceCalc: boolean);        {calc trafo-matrix (if necessary) and convert   }
  104.                                                                 {all points to their screen representation           }
  105.                                                                             {WARNING: A 3D GrafPort must be open. The     }
  106.                                                                 {transformations are done for the currently ac-}
  107.                                                                 {tive 3D grafport's eye settings.}
  108.             procedure Transform2 (forceCalc: boolean);    (* calc trafo-matrix (if necessary) and convert    *)
  109.                                                                 (*all points to their screen representation. gather *)
  110.                                                                 (* information for auto-erasure                            *)
  111.  
  112.             function TransformedPoint (index: longint): Vector4;     {get transformed coordinates of point     }
  113.                                                                         {with index. if illegal proc will return     }
  114.                                                                         {0,0,0. Note that eye is not considered    }
  115.                                                                         {you have to use ToScreen for that        }
  116.             function ForeignPoint (p: Vector4): Vector4;    {as inherited except that eye trafo is included if}
  117.             override;                                                {useEye is set                                          }
  118.             function WorldToModel (wc: Vector4): Vector4;    {as inherited except that eye trafo is included}
  119.             override;                                                    {if useEye is set.                                    }
  120.             procedure CalcBounds;                                {calc bounds of object on screen and place it in    }
  121.                                                                 {the oldBounds variable.                                }
  122.         end;
  123.  
  124.  
  125. var
  126.     current3Dport: TPort3Dptr; (* currently active 3D port *)
  127.  
  128.  
  129. (* procedures to intialize GrafSys and return version numbers *)
  130. procedure InitGrafSysScreen; (* initialize the GrafSys and local variables such as current graf 3D port *)
  131. function GrafSysVersion: longint; (* higword: major release, lower word : minor release. Hex 00010001 means version 1.01 *)
  132. (* procedure to create new 3D windows and grafports *)
  133.  
  134. function GetNew3DWindow (ID: integer; behind: ptr): WindowPtr; (* allocate a new window from resource *)
  135. function New3DWindow (boundsRect: Rect; title: Str255; visible: BOOLEAN; procID: Integer; behind: WindowPtr; goAwayFlag: BOOLEAN; refCon: LongInt): WindowPtr;
  136. procedure Dispos3DWindow (theWindow: WindowPtr); (* close and release mem occupied by the window *)
  137.  
  138. (* procedures affecting CURRENT  3D GrafPort *)
  139. procedure Set3DPort (the3DPort: WindowPtr);     (* tells grafsys in which port to draw. This port MUST have been *)
  140.                                                             (* previously allocated with New3DWindow or GetNew3DWindow  *)
  141. procedure Get3DPort (var the3DPort: WindowPtr);     (* returns current 3D GrafPort *)
  142. function Is3DPort (thePort: WindowPtr): Boolean;    (* returns TRUE if thePort is a 3D Port *)
  143. procedure SetView (ProjectPlaneSize, ViewPlaneSize: Rect);     (* sets the viewing and projection plane parameters *)
  144.                                                                             (* of the currently active 3D GrafPort                     *)
  145.                                                                             (* this of course affects the center location             *)
  146. procedure SetCenter (x, y: Integer);                (* Sets center of current 3D grafport to given params  *)
  147. procedure SetEyeChar (UsesEye: Boolean; location: Vector4; thePhi, theTheta, thePitch, theViewangle: real; clipType: clippingType);
  148.                                                             (* Sets eye characteristics and calculates window's master trans- *)
  149.                                                             (* form                                                                              *)
  150. procedure GetEye (var UsesEye: Boolean; var location: Vector4; thePhi, theTheta, thePitch, theViewangle: real; var clipType: clippingType);
  151.                                                             (* returns eye characteristic of current active 3d grafport *)
  152.  
  153. procedure ToScreen (thePoint: Vector4; var h, v: INTEGER); { transforms a point with x,y,z to screen as seen under    }
  154.                                                                     {current eye settings                                        }
  155. procedure ProjectPoint (thePoint: Vector4; var h, v: integer);
  156.         {project 3D pointz to screen using projection type}
  157. implementation
  158.  
  159. (* global variables for the 3D package *)
  160. var
  161. {versionCount: longint;     (* used for syncing Master Transform of eye. If <> 0 a change to *)
  162.                                  (* the eye has occured and the eye has to be recalculated            *)
  163.  
  164.     lgMaxPoints: longint; (* maximum # of points in model *)
  165.  
  166. (* GetNew3DWindow will load the WIND template as specified but will also put the *)
  167. (* 3D eye data required on piggyback *)
  168.  
  169. procedure Init3DPort (var the3DPort: TPort3DPtr);
  170.     begin
  171.         with the3DPort^ do begin
  172.             versionType := cPort3DType;
  173.             theOffscreen.thePort := nil;
  174.             theOffscreen.theDevice := nil;
  175.             ProjectionPlane := theWindow.port.portRect;
  176.             ViewPlane := theWindow.port.portRect; (* the viewplane and project plane are set to the whole window *)
  177.             left := theWindow.port.portRect.left;
  178.             right := theWindow.port.portRect.right;
  179.             top := theWindow.port.portRect.top;
  180.             bottom := theWindow.port.portRect.bottom;
  181.             center.h := 0;
  182.             center.v := 0; (* GeoBench uses topleft as origin *)
  183.             center.h := (left + right) div 2;
  184.             center.v := (top + bottom) div 2; (* center is center of window *)
  185.  
  186.             useEye := False;
  187.             SetVector4(EyeKoord, 0, 0, 0);
  188.             phi := 0;
  189.             theta := 0;
  190.             pitch := 0;
  191.             ViewAngle := 0; (* parallel projection *)
  192.             d := 0;
  193.             MasterTransform := Identity;
  194.             projection := parallel;
  195.             clipping := none;
  196.             versionsID := 0; (* fresh eye *)
  197. {versionCount := versionCount + 1;}
  198.         end;
  199.     end;
  200.  
  201. procedure InitGrafSysScreen; (* initialize the GrafSys and local variables such as current graf 3D port *)
  202.     begin
  203. {versionCount := -1;}
  204.         current3Dport := nil;
  205.         lgMaxPoints := LongInt((MaxPointPerBuf + 1)) * LongInt((MaxBuffers + 1));
  206.     end;
  207.  
  208. function GrafSysVersion: longint; (* higword: major release, lower word : minor release. Hex 00010001 means version 1.01 *)
  209.     begin
  210.         GrafSysVersion := cGrafSysVersion;
  211.     end;
  212.  
  213. (* places 3D eye data piggyback to window data *)
  214. (* sets current 3D port to newly allocated window if allocated *)
  215. function GetNew3DWindow (ID: integer; behind: ptr): WindowPtr;
  216.     var
  217.         wStorage: Ptr;
  218.         theWindow: WindowPtr;
  219.  
  220.     begin
  221.         theWindow := nil;
  222.         wStorage := NewPtr(SizeOf(TPort3D));
  223.         if wStorage = nil then begin
  224.             GetNew3DWindow := nil;
  225.             Exit(GetNew3DWindow);
  226.         end;
  227.         theWindow := GetNewCWindow(ID, wStorage, Pointer(behind));
  228.         GetNew3DWindow := theWindow;
  229.         if theWindow = nil then
  230.             Exit(GetNew3DWindow); (* do not init the 3D data since window not valid. Don't set current3Dport to it *)
  231.         Init3Dport(TPort3DPtr(wStorage));
  232.         current3Dport := TPort3DPtr(wStorage);
  233.         SetPort(theWindow);
  234.     end;
  235.  
  236. (* places 3D eye data piggyback to window data *)
  237. (* sets current 3D port to newly allocated window if allocated *)
  238. function New3DWindow (boundsRect: Rect; title: Str255; visible: BOOLEAN; procID: Integer; behind: WindowPtr; goAwayFlag: BOOLEAN; refCon: LongInt): WindowPtr;
  239.     var
  240.         wStorage: Ptr;
  241.         theWindow: WindowPtr;
  242.  
  243.     begin
  244.         theWindow := nil;
  245.         wStorage := NewPtr(SizeOf(TPort3D));
  246.         if wStorage = nil then begin
  247.             New3DWindow := nil;
  248.             Exit(New3DWindow);
  249.         end;
  250.         theWindow := NewCWindow(wStorage, boundsRect, title, visible, procID, Pointer(behind), goAwayFlag, refCon);
  251.         New3DWindow := theWindow;
  252.         if theWindow = nil then
  253.             Exit(New3DWindow); (* do not init the 3D data since window not valid. Don't set current3Dport to it *)
  254.         Init3Dport(TPort3DPtr(wStorage));
  255.         current3Dport := TPort3DPtr(wStorage);
  256.         SetPort(theWindow);
  257.     end;
  258.  
  259. procedure Dispos3DWindow (theWindow: WindowPtr); (* close and release mem occupied by the window *)
  260.     var
  261.         the3DWindow: TPort3DPtr;
  262.  
  263.     begin
  264.         the3DWindow := TPort3DPtr(theWindow);
  265.         if is3DPort(theWindow) then begin
  266.             if the3DWindow^.theOffscreen.thePort <> nil then
  267.                 DisposeOffScreen(the3DWindow^.theOffscreen.thePort, the3DWindow^.theOffscreen.theDevice);
  268.         end;
  269.         CloseWindow(theWindow);
  270.         DisposPtr(ptr(theWindow));
  271.         theWindow := nil;
  272.     end;
  273.  
  274. procedure Set3DPort (the3DPort: WindowPtr);     (* tells grafsys in which port to draw. This port MUST have been *)
  275.                                                             (* previously allocated with New3DWindow or GetNew3DWindow  *)
  276.                                                             (* otherwise Set3DPort does nothing                                   *)
  277.     begin
  278.         if (GetPtrSize(Ptr(thePort)) = SizeOf(TPort3D)) and (TPort3DPtr(thePort)^.versionType = cPort3DType) then begin
  279.             current3Dport := TPort3Dptr(thePort);
  280.         end;
  281.         SetPort(the3DPort);
  282.     end;
  283.  
  284. procedure Get3DPort (var the3DPort: WindowPtr);     (* returns current 3D GrafPort *)
  285.     begin
  286.         the3Dport := WindowPtr(current3Dport);
  287.     end;
  288.  
  289.  
  290. function Is3DPort (thePort: WindowPtr): Boolean;    (* returns TRUE if thePort is a 3D Port *)
  291.     var
  292.         theResult: boolean;
  293.  
  294.     begin
  295.         theResult := GetPtrSize(Ptr(thePort)) = SizeOf(TPort3D);
  296.         if theResult then
  297.             theResult := Tport3Dptr(thePort)^.versionType = cPort3DType;
  298.         Is3Dport := theResult;
  299.     end;
  300.  
  301. procedure SetView (ProjectPlaneSize, ViewPlaneSize: Rect);     (* sets the viewing and projection plane parameters *)
  302.                                                                             (* of the currently active 3D GrafPort                     *)
  303.     begin
  304.         with current3Dport^ do begin
  305.             ProjectionPlane := ProjectPlaneSize;
  306.             ViewPlane := ViewPlaneSize;
  307.             left := ProjectPlaneSize.left;
  308.             top := ProjectPlaneSize.top;
  309.             bottom := ProjectPlaneSize.bottom;
  310.             right := ProjectPlaneSize.right;
  311.             center.h := (left + right) div 2;
  312.             center.v := (top + bottom) div 2;
  313.             versionsID := versionsID + 1; (* changes increment. Indicate we must redraw  *)
  314.         end; (* with *)
  315.         ClipRect(ViewPlaneSize);
  316.     end;
  317.  
  318.  
  319. procedure SetCenter (x, y: Integer);
  320.     begin
  321.         current3Dport^.center.h := x;
  322.         current3Dport^.center.v := y;
  323.         current3Dport^.versionsID := current3Dport^.versionsID + 1; (* changes increment. Indicate we must redraw  *)
  324.     end;
  325.  
  326. procedure SetEyeChar (UsesEye: Boolean; location: Vector4; thePhi, theTheta, thePitch, theViewangle: real; clipType: clippingType);
  327.                                                             (* Sets eye characteristics and calculates window's master trans- *)
  328.                                                             (* form                                                                              *)
  329.     var
  330.         theMatrix, theMatrixd: Matrix4;
  331.         p1, p2: Vector4;
  332.  
  333.     const
  334.         dist = 100;
  335.  
  336.  
  337.     begin
  338.         with current3Dport^ do begin
  339. (* first, assign new version ID for eye *)
  340.             versionsID := versionsID + 1;
  341. {versionCount := versionCount + 1;}
  342.             UseEye := UsesEye;
  343.             clipping := clipType;
  344. (* now we calculate the viewange. it derives the d from the viewangle and the HIGHTH of the viewwindow *)
  345. (* a setting of viewangle of zero (= nothing) or 2π  means NO PERSPECTIVE                                              *)
  346.             theViewangle := theViewangle / 2;
  347.             if (theViewangle >= 2 * Pi) or (theViewangle <= 0) then
  348.                 theViewangle := 0;
  349.             if theViewangle = 0 then
  350.                 projection := parallel
  351.             else begin
  352.                 d := 200 / tan(theViewangle);
  353.                 d := center.v / tan(theViewangle);{}
  354.                 projection := perspective;
  355.             end;
  356.             theMatrix := Identity; (* start from scratch with 0,0,0, 0,0,0 *)
  357.  
  358.  
  359. (* Zero step : translate eye to world viewpoint *)
  360.  
  361.             MTranslate(theMatrix, -location[1], -location[2], -location[3]); (* since we move world and not eye, negative sign *)
  362.  
  363. (* 1st step : direction of looking is straight up, through the XY plane *)
  364. (*                 now deviate towards Y-achsis by phi radiants . after    *)
  365. (*                 transformation z-vector lies in XZ plane                       *)
  366.  
  367.             RotX(theMatrix, -thePhi);
  368.  
  369. (* 2nd step: rotate around y so the z-vector comes to coincide with *)
  370. (*                world coordinate system                                              *)
  371.  
  372.             RotY(theMatrix, -theTheta);
  373.  
  374.  
  375. (* 3rd step: ratate according to pitch *)
  376.  
  377.             RotZ(theMatrix, -thePitch);
  378.  
  379.             MasterTransform := theMatrix;
  380.  
  381.             phi := thePhi;
  382.             theta := theTheta;
  383.             pitch := thePitch;
  384.             viewangle := theViewangle;
  385.             EyeKoord := location;
  386. (* necessary for eye position and direction *)
  387.         end; (* with *)
  388.     end;
  389.  
  390.  
  391. procedure GetEye (var UsesEye: Boolean; var location: Vector4; thePhi, theTheta, thePitch, theViewangle: real; var clipType: clippingType);
  392.                                                             (* returns eye characteristic of current active 3d grafport *)
  393.     begin
  394.         with current3Dport^ do begin
  395.             thePhi := phi;
  396.             theTheta := theta;
  397.             thePitch := pitch;
  398.             location := EyeKoord;
  399.             theViewangle := viewangle;
  400.             UsesEye := UseEye;
  401.             clipType := Clipping;
  402.         end;
  403.     end;
  404.  
  405. procedure ToScreen (thePoint: Vector4; var h, v: INTEGER); { transforms a point with x,y,z to screen as seen under    }
  406.                                                                     {current eye settings                                        }
  407.  
  408.     var
  409.         x, y, z: Real;
  410.         zbyd: Real;
  411.  
  412.     begin
  413.         if current3DPort^.useEye then
  414.             thePoint := VMult(thePoint, current3DPort^.MasterTransform); (* transform point so we can project *)
  415.         GetVector4(thePoint, x, y, z); (* return to real *)
  416.  
  417.         if current3DPort^.projection = parallel then begin
  418.             h := Trunc(x) + current3DPort^.center.h;
  419.             v := -Trunc(y) + current3DPort^.center.v
  420.         end
  421.         else begin
  422.             zbyd := 1 / (z / current3DPort^.d + 1);
  423.             h := Trunc(x * zbyd) + current3DPort^.center.h; (* do perspective transformation *)
  424.             v := -Trunc(y * zbyd) + current3DPort^.center.v;
  425.         end
  426.  
  427.     end;
  428.  
  429.  
  430. procedure ProjectPoint (thePoint: Vector4; var h, v: integer);
  431.     var
  432.         x, y, z: real;
  433.         zbyd: Real;
  434.  
  435.     begin
  436.         GetVector4(thePoint, x, y, z); (* return to real *)
  437.  
  438.         if current3DPort^.projection = parallel then begin
  439.             h := Trunc(x) + current3DPort^.center.h;
  440.             v := -Trunc(y) + current3DPort^.center.v
  441.         end
  442.         else begin
  443.             zbyd := 1 / (z / current3DPort^.d + 1);
  444.             h := Trunc(x * zbyd) + current3DPort^.center.h; (* do perspective transformation *)
  445.             v := -Trunc(y * zbyd) + current3DPort^.center.v;
  446.         end
  447.     end;
  448.  
  449.  
  450. (* procedures for the objects *)
  451.  
  452. procedure TSGenericObject3D.Init;
  453.     override;
  454.     var
  455.         i: integer;
  456.  
  457.     begin
  458.         inherited Init; (* init all inherited fields *)
  459.         if errorCode <> 0 then
  460.             Exit(init);
  461.         SetRect(Bounds, 0, 0, 0, 0);
  462.         SetRect(oldBounds, 0, 0, 0, 0);
  463.         for i := 0 to MaxBuffers do
  464.             theBufs[i] := nil;
  465.         theBufs[0] := Point3DBufPtr(NewPtr(SIZEOF(Point3DBufRec)));
  466.         currentBuf := theBufs[0];
  467.         currentIndex := -1;
  468.         numPoints := 0;
  469.         if currentBuf = nil then
  470.             ErrorCode := cOutOfMem; (* flag error condition *)
  471.     end;
  472.  
  473. procedure TSGenericObject3D.Reset;
  474.     override;
  475.     begin
  476.         inherited Reset;
  477.         SetRect(Bounds, 0, 0, 0, 0);
  478.         SetRect(oldBounds, 0, 0, 0, 0);
  479.     end;
  480.  
  481. (* extend inherited clone method to duplicate all allocated line buffers *)
  482. function TSGenericObject3D.Clone: TGenericObject;                    {duplicate point buffers as well }
  483.     override;
  484.  
  485.     var
  486.         i: integer;
  487.         theClone: TSGenericObject3D;
  488.  
  489.     begin
  490.         theClone := TSGenericObject3D(inherited Clone);
  491.         for i := 1 to MaxBuffers do begin
  492.             if theBufs[i] <> nil then begin
  493.                 theClone.theBufs[i] := Point3DBufPtr(NewPtr(SIZEOF(Point3DBufRec)));
  494.                 theClone.theBufs[i]^ := theBufs[i]^; (* copy contents *)
  495.             end
  496.             else
  497.                 theClone.theBufs[i] := nil;
  498.         end;
  499.         Clone := theClone;
  500.     end;
  501.  
  502. procedure TSGenericObject3D.Kill;                                         {deallocate mem. Will kill all sons that inherit}
  503.     override;
  504.     var
  505.         i: integer;
  506.  
  507.     begin (* first, deallocate all buffers that have been allocated *)
  508.         for i := 0 to MaxBuffers do begin
  509.             if theBufs[i] <> nil then
  510.                 DisposPtr(Ptr(theBufs[i]));
  511.         end;
  512.         inherited Kill; (* suicide with proven method, thereby killing all sons that inherit *)
  513.     end;
  514.  
  515. {GenIndex does no sanity check. Use with caution}
  516. procedure TSGenericObject3D.GenIndex (pointIndex: longint; var BufIndex, bufOffset: integer);
  517.     begin
  518.         BufIndex := pointIndex div (MaxPointPerBuf + 1);
  519.         bufOffset := pointIndex mod (MaxPointPerBuf + 1);
  520.     end;
  521.  
  522. function TSGenericObject3D.AddPoint (x, y, z: real): longint;        {add a point to the object's database. It returns the }
  523.                                                                                 {points reference number if successful or -1 otherwise}
  524.                                                                                 {check ErrorCode if function returns -1. }
  525.                                                                                 {point count is one-based, i.e. fist point is index 1. Note     }
  526.                                                                                 {that this differs from the internal representation where }
  527.                                                                                 {point count is zero-based. COMMON ERROR SOURCE!         }
  528.  
  529.     var
  530.         theBufIndex: integer;
  531.         offsetIntoBuf: integer;
  532.         pointIndex: longint;
  533.  
  534.     begin
  535.         if self.NumPoints >= lgMaxPoints then {exit with index -1 because database is full}
  536.             begin
  537.             AddPoint := -1;
  538.             ErrorCode := cTooManyPoints; (* flag error condition *)
  539.             Exit(AddPoint);
  540.         end;
  541.         pointIndex := self.numPoints; (* self.numPoints is one-based count, pointIndex zero-based *)
  542.         self.genIndex(pointIndex, theBufIndex, offSetIntoBuf);
  543.         if theBufs[theBufIndex] = nil then begin {we need to allocate a new buffer}
  544.         {checkpoint1 : the offset into buffer must be zero. check it }
  545.             if offsetIntoBuf > 0 then
  546.                 DebugStr('ATTENTION: Addpoint req. new buffer and offset > 0');
  547.             theBufs[theBufIndex] := Point3DBufPtr(NewPtr(SIZEOF(Point3DBufRec)));
  548.             if theBufs[theBufIndex] = nil then begin
  549.                 AddPoint := -1;
  550.                 ErrorCode := cOutOfMem; (* flag error condition *)
  551.                 Exit(AddPoint);
  552.             end;
  553.         end;
  554.      {if we are here, buffer has been allocated and all is well}
  555.         SetVector4(theBufs[theBufIndex]^[pointIndex].koords, x, y, z);
  556.         self.numPoints := self.numPoints + 1;  (* update the number of points in model. always 1 greater that currently *)
  557.                                                 (* active point since pointCount is 1 based, pointIndex zero-based *)
  558.         self.objChanged := TRUE;
  559.         AddPoint := self.numPoints;
  560.     end;
  561.  
  562.  
  563. function TSGenericObject3D.DeletePoint (index: longint): boolean;    {delete point with passed index from database. returns }
  564.                                                                                 {false if operation could not be completed }
  565.                                                                                 {delete does not deallocate mem if buffer is freed }
  566.                                                                                 {all points beyond the one deleted will be moved to }
  567.                                                                                 {compact mem}
  568.                                                                                 {when specifying a point, its index is zero-based}
  569.                                                                                 {passing 0 as index means delete all points}
  570.     var
  571.         temp: Point3DEntry;
  572.         buffer, offset: integer;
  573.  
  574.     begin
  575.         index := index - 1; (* make zero-based count *)
  576.         if index >= self.numPoints then begin
  577.             ErrorCode := cIllegalPointIndex;
  578.             DeletePoint := FALSE;
  579.             Exit(DeletePoint);
  580.         end;
  581.         if index <= 0 then begin
  582.             numPoints := 0;
  583.             DeletePoint := TRUE; (* remember, no memory is deallocated *)
  584.             Exit(DeletePoint);
  585.         end;
  586.         while index < self.numPoints - 1 do begin
  587.             self.GenIndex(index + 1, buffer, offset);
  588.             if theBufs[buffer] = nil then
  589.                 DebugStr('WARNING: about to access nil buffer while moving::read');
  590.             temp := theBufs[buffer]^[offset]; (* read entry *)
  591.             self.GenIndex(index, buffer, offset);
  592.             if theBufs[buffer] = nil then
  593.                 DebugStr('WARNING: about to access nil buffer while moving::write');
  594.             theBufs[buffer]^[offset] := temp; (* read entry *)
  595.             index := index + 1;
  596.         end;
  597.         self.numPoints := self.numPoints - 1;
  598.         DeletePoint := TRUE;
  599.     end;
  600.  
  601. procedure TSGenericObject3D.GetPoint (index: longint; var x, y, z: real);         {get points coordinate in model coords }
  602.     var
  603.         temp: Point3DEntry;
  604.         buffer, offset: integer;
  605.  
  606.     begin
  607.         index := index - 1; (* make zero-based count *)
  608.         if (index < 0) or (index > self.numPoints - 1) then begin
  609.             x := 0;
  610.             y := 0;
  611.             z := 0;
  612.         end
  613.         else begin
  614.             self.GenIndex(index, buffer, offset);
  615.             if theBufs[buffer] = nil then
  616.                 DebugStr('WARNING: about to access nil buffer in GetPoint');
  617.             temp := theBufs[buffer]^[offset]; (* read entry *)
  618.             GetVector4(temp.koords, x, y, z);
  619.         end;
  620.     end;
  621.  
  622.  
  623. function TSGenericObject3D.ChangePoint (index: longint; x, y, z: real): boolean;     {change points coords. true on success }
  624.     var
  625.         buffer, offset: integer;
  626.  
  627.     begin
  628.         index := index - 1; (* make zero-based count *)
  629.         if (index < 0) or (index > self.numPoints - 1) then begin
  630.             ChangePoint := FALSE;
  631.             ErrorCode := cIllegalPointIndex;
  632.             Exit(changePoint);
  633.         end;
  634.         self.GenIndex(index, buffer, offset);
  635.         SetVector4(theBufs[buffer]^[offset].koords, x, y, z);
  636.         self.objChanged := TRUE;
  637.         ChangePoint := TRUE;
  638.     end;
  639.  
  640.  
  641. procedure TSGenericObject3D.Transform (forceCalc: boolean);    (* calc trafo-matrix (if necessary) and convert *)
  642.                                                                             (*all points to their screen representation         *)
  643.  
  644.     var
  645.         buffer, offset: integer;
  646.         pointIndex: longint;
  647.         thePoint: Vector4;
  648.         x, y, z: real;
  649.         zbyd: real;
  650.         dx, dy, mx, my: real; (* geobench adaption parameters for zoom *)
  651.  
  652.     begin
  653.         dx := current3DPort^.dx;
  654.         dy := current3DPort^.dy;
  655.         mx := current3DPort^.mx;
  656.         my := current3DPort^.my;
  657.  
  658.         if forceCalc or objChanged then (* object has changed. we must recalc it *)
  659.             begin
  660.             self.CalcTransform; (* resets versionID to zero and calcs xForm, passes on etc *)
  661.             self.screenXform := self.xForm; (* transfer it in case we don't use the eye *)
  662.             versionsID := -1; (* force check for useEye later on *)
  663.         end; (* if forcecalc or version *)
  664.  
  665.         if versionsID <> current3DPort^.versionsID then begin
  666.             self.screenXform := xForm; (* failsafe in case object didn't change but eye was switched off *)
  667.             versionsID := current3DPort^.versionsID; {sync eye and object. even if we don't use the eye anymore }
  668.             if current3DPort^.useEye then begin
  669.             (* PostConcat the Eye matrix to xForm *)
  670.                 self.screenXform := MMult(xForm, current3DPort^.MasterTransform);
  671.             end; (* if useEye fails we still have last xForm in screenXform *)
  672.         end;
  673.  
  674. (* transformation is pretty simple: for all points: fetch and multiply with xForm Matrix *)
  675. (* we will use currentBuf for faster access. If index mod pointsPerBuf returnes zero we will *)
  676. (* access a new buffer, otherwise we don't calculate anything since this is all straightforward *)
  677.  
  678.         pointIndex := 0;
  679.         offset := 0;
  680.         buffer := -1; (* will be incremented to 0 right away *)
  681.         while pointIndex < self.numPoints do begin
  682.             if offset mod (MaxPointPerBuf + 1) = 0 then (* advance buffer 1 *)
  683.                 begin
  684.                 buffer := buffer + 1;
  685.                 currentBuf := theBufs[buffer];
  686.                 if currentBuf = nil then
  687.                     DebugStr('About to access nil buffer in TSGenericObject3D.Transform');
  688.                 offset := 0;
  689.             end;
  690.         (* get the point *)
  691.             thePoint := currentBuf^[offset].koords;
  692.  
  693.         (* Transform the point *)
  694. {thePoint := VMult(thePoint, screenXform); (* transform point so we can project *)
  695.             thePoint := MatrixVectorMult(screenXform, thePoint); (* geoBench adaption *)
  696.             currentBuf^[offset].transformed := thePoint; (* copy transformed point *)
  697.             GetVector4(thePoint, x, y, z); (* return to real *)
  698.  
  699. {currentBuf^[offset].transformedZ := z;}
  700.             if current3DPort^.projection = parallel then begin
  701.                 currentBuf^[offset].Screenx := Trunc(dx + mx * (x + current3DPort^.center.h)); (* geobench adaption *)
  702.                 currentBuf^[offset].Screeny := +Trunc(dy + my * (y + current3DPort^.center.v)); (* geobench adaption: down is up *)
  703.             end
  704.             else begin
  705.                 zbyd := 1 / (z / current3DPort^.d + 1);
  706.                 currentBuf^[offset].Screenx := Trunc(dx + mx * (x * zbyd + current3DPort^.center.h)); (* do perspective transformation *)
  707.                 currentBuf^[offset].Screeny := +Trunc(dy + my * (y * zbyd + current3DPort^.center.v));(* geobench adaption: down is up *)
  708. {DebugStr('Not yet adapted to geobench: mx and dx paramteres');{}
  709.             end;
  710.  
  711.             offset := offset + 1;
  712.             pointIndex := pointIndex + 1;
  713.         end; (* while *)
  714.     end; (* Transform *)
  715.  
  716. procedure TSGenericObject3D.Transform2 (forceCalc: boolean);    (* calc trafo-matrix (if necessary) and convert    *)
  717.                                                                                 (*all points to their screen representation. gather *)
  718.                                                                                 (* information for auto-erasure                            *)
  719.                                                                                 (* points with negative z will not be collected into *)
  720.                                                                                 (* bounds rectangle                                               *)
  721.  
  722.     var
  723.         buffer, offset: integer;
  724.         pointIndex: longint;
  725.         thePoint: Vector4;
  726.         x, y, z: real;
  727.         zbyd: real;
  728.         sx, sy: integer;
  729.  
  730.     begin
  731.         if forceCalc or objChanged then (* object has changed. we must recalc it *)
  732.             begin
  733.             self.CalcTransform; (* resets versionID to zero and calcs xForm, passes on etc *)
  734.             self.screenXform := self.xForm; (* transfer it in case we don't use the eye *)
  735.             versionsID := -1; (* force check for useEye later on *)
  736.         end; (* if forcecalc or version *)
  737.  
  738.         if versionsID <> current3DPort^.versionsID then (* we must postconcat eye to xForm. result in screenXform *)
  739.             begin
  740.             self.screenXform := xForm; (* failsafe in case object didn't change but eye was switched off *)
  741.             versionsID := current3DPort^.versionsID; {sync eye and object. even if we don't use the eye anymore }
  742.             if current3DPort^.useEye then begin
  743.             (* PostConcat the Eye matrix to xForm *)
  744.                 self.screenXform := MMult(xForm, current3DPort^.MasterTransform);
  745.             end; (* if useEye fails we still have last xForm in screenXform *)
  746.         end;
  747.  
  748. (* transformation is pretty simple: for all points: fetch and multiply with xForm Matrix *)
  749. (* we will use currentBuf for faster access. If index mod pointsPerBuf returnes zero we will *)
  750. (* access a new buffer, otherwise we don't calculate anything since this is all straightforward *)
  751.         oldBounds := Bounds;
  752.         SetRect(Bounds, 32760, 32760, -32760, -32760); (* set bounds to minimal empty rect *)
  753.         pointIndex := 0;
  754.         offset := 0;
  755.         buffer := -1; (* will be incremented to 0 right away *)
  756.         while pointIndex < self.numPoints do begin
  757.             if offset mod (MaxPointPerBuf + 1) = 0 then (* advance buffer 1 *)
  758.                 begin
  759.                 buffer := buffer + 1;
  760.                 currentBuf := theBufs[buffer];
  761.                 if currentBuf = nil then
  762.                     DebugStr('About to access nil buffer in TSGenericObject3D.Transform');
  763.                 offset := 0;
  764.             end;
  765.         (* get the point *)
  766.             thePoint := currentBuf^[offset].koords;
  767.  
  768.         (* Transform the point *)
  769. {thePoint := VMult(thePoint, screenXform); (* transform point so we can project *)
  770.             thePoint := MatrixVectorMult(screenXform, thePoint); (* geoBench adaption *)
  771.  
  772.             currentBuf^[offset].transformed := thePoint;
  773.             GetVector4(thePoint, x, y, z); (* return to real *)
  774.  
  775. {currentBuf^[offset].transformedZ := z;}
  776.             if current3DPort^.projection = parallel then begin
  777.                 sx := Trunc(x) + current3DPort^.center.h;
  778.                 currentBuf^[offset].Screenx := sx;
  779. {sy := -Trunc(y) + current3DPort^.center.v;{}
  780.                 sy := +Trunc(y) + current3DPort^.center.v; { GeoBench adaption: View-up is down }
  781.                 currentBuf^[offset].Screeny := sy
  782.             end
  783.             else begin
  784.                 zbyd := 1 / (z / current3DPort^.d + 1);
  785.                 sx := Trunc(x * zbyd) + current3DPort^.center.h; (* do perspective transformation *)
  786.                 currentBuf^[offset].Screenx := sx;
  787. {sy := -Trunc(y * zbyd) + current3DPort^.center.v;{}
  788.                 sy := +Trunc(y * zbyd) + current3DPort^.center.v; { GeoBench adaption: View-up is down }
  789.                 currentBuf^[offset].Screeny := sy;
  790.             end;
  791.  
  792.             if z >= 0 then (* do this only if point is drawn *)
  793.                 begin
  794.                 if sx < Bounds.left then (* gather data for autoerase *)
  795.                     Bounds.left := sx - 1;
  796.                 if sx > Bounds.right then
  797.                     Bounds.right := sx + 1;
  798.                 if sy < Bounds.top then
  799.                     Bounds.top := sy - 1;
  800.                 if sy > Bounds.bottom then
  801.                     Bounds.bottom := sy + 1;
  802.             end;
  803.  
  804.             offset := offset + 1;
  805.             pointIndex := pointIndex + 1;
  806.         end; (* while *)
  807. {insetRect(Bounds, -1, -1); {now done in draw and GetLineData }
  808.     end; (* Transform *)
  809.  
  810. procedure TSGenericObject3D.CalcBounds;            {calc bounds of object on screen and place it in }
  811.                                                                 {the oldBounds variable                            }
  812.     var
  813.         buffer, offset: integer;
  814.         pointIndex: longint;
  815.         x, y: integer;
  816.  
  817.     begin
  818.         SetRect(oldBounds, 32760, 32760, -32760, -32760); (* set bounds to minimal empty rect *)
  819.         pointIndex := 0;
  820.         offset := 0;
  821.         buffer := -1; (* will be incremented to 0 right away *)
  822.         while pointIndex < self.numPoints do begin
  823.             if offset mod (MaxPointPerBuf + 1) = 0 then (* advance buffer 1 *)
  824.                 begin
  825.                 buffer := buffer + 1;
  826.                 currentBuf := theBufs[buffer];
  827.                 if currentBuf = nil then
  828.                     DebugStr('About to access nil buffer in TSGenericObject3D.Transform');
  829.                 offset := 0;
  830.             end;
  831.  
  832.             x := currentBuf^[offset].Screenx; (* access them screen-coords *)
  833.             y := currentBuf^[offset].Screeny;
  834.             if x < oldBounds.left then (* gather data for autoerase *)
  835.                 oldBounds.left := x - 1;
  836.             if x > oldBounds.right then
  837.                 oldBounds.right := x + 1;
  838.             if y < oldBounds.top then
  839.                 oldBounds.top := y - 1;
  840.             if y > oldBounds.bottom then
  841.                 oldBounds.bottom := y + 1;
  842.  
  843.             offset := offset + 1;
  844.             pointIndex := pointIndex + 1;
  845.         end; (* while *)
  846.         insetRect(oldBounds, -1, -1);
  847.     end;
  848.  
  849. function TSGenericObject3D.TransformedPoint (index: longint): Vector4;
  850.                                                                                     {get transformed coordinates of point     }
  851.                                                                                     {with index. if illegal proc will return     }
  852.                                                                                     {0,0,0.      }
  853.                                                                                     {does not apply eye settings to it         }
  854.                                                                                     {you have to use ToScreen for that        }
  855.                                                                                     {calls transform if versionId <> 0        }
  856.  
  857.     var
  858.         buffer, offset: integer;
  859.         theVector: Vector4;
  860.  
  861.     begin
  862.         if objChanged then (* object has changed. we must recalc it *)
  863.             begin
  864.             self.CalcTransform; (* resets versionID to zero and calcs xForm, passes on etc *)
  865.             self.screenXform := self.xForm; (* transfer it in case we don't use the eye *)
  866.             versionsID := -1; (* force check for useEye later on *)
  867.         end; (* if forcecalc or version *)
  868.  
  869.         if versionsID <> current3DPort^.versionsID then (* we must postconcat eye to xForm. result in screenXform *)
  870.             begin
  871.             self.screenXform := xForm; (* failsafe in case object didn't change but eye was switched off *)
  872.             versionsID := current3DPort^.versionsID; {sync eye and object. even if we don't use the eye anymore }
  873.             if current3DPort^.useEye then begin
  874.             (* PostConcat the Eye matrix to xForm *)
  875.                 self.screenXform := MMult(xForm, current3DPort^.MasterTransform);
  876.             end; (* if useEye fails we still have last xForm in screenXform *)
  877.         end;
  878.  
  879.  
  880.         SetVector4(theVector, 0, 0, 0);
  881.         if (index < 1) or (index > self.numPoints) then begin
  882.             ErrorCode := cIllegalPointIndex;
  883.             TransformedPoint := theVector;
  884.             Exit(TransformedPoint);
  885.         end;
  886.         self.GenIndex(index - 1, buffer, offset);
  887.         theVector := theBufs[buffer]^[offset].koords;
  888.         TransformedPoint := VMult(theVector, self.screenXform);
  889.     end;
  890.  
  891. function TSGenericObject3D.ForeignPoint (p: Vector4): Vector4;
  892.     override;
  893.  
  894.     begin
  895.         if objChanged then (* object has changed. we must recalc it *)
  896.             begin
  897.             self.CalcTransform; (* resets versionID to zero and calcs xForm, passes on etc *)
  898.             self.screenXform := self.xForm; (* transfer it in case we don't use the eye *)
  899.             versionsID := -1; (* force check for useEye later on *)
  900.         end; (* if forcecalc or version *)
  901.  
  902.         if versionsID <> current3DPort^.versionsID then (* we must postconcat eye to xForm. result in screenXform *)
  903.             begin
  904.             self.screenXform := xForm; (* failsafe in case object didn't change but eye was switched off *)
  905.             versionsID := current3DPort^.versionsID; {sync eye and object. even if we don't use the eye anymore }
  906.             if current3DPort^.useEye then begin
  907.             (* PostConcat the Eye matrix to xForm *)
  908.                 self.screenXform := MMult(xForm, current3DPort^.MasterTransform);
  909.             end; (* if useEye fails we still have last xForm in screenXform *)
  910.         end;
  911.         ForeignPoint := VMult(p, self.screenXform)
  912.     end;
  913.  
  914.  
  915. function TSGenericObject3D.WorldToModel (wc: Vector4): Vector4; {xform world coordinates to model coordinates}
  916.     override;
  917.  
  918.     var
  919.         wcOrigin: Vector4;
  920.         Origin: vector4;
  921.  
  922.     begin
  923.     {we don't have to change anything because Foreign point is overriden and checks itself }
  924.     {for changes in the object and sceenXform}
  925.         SetVector4(Origin, 0, 0, 0); (* model coordinate origin *)
  926.         wcOrigin := ForeignPoint(Origin); (* get the origin in wc *)
  927.         WorldToModel := VSub(wc, wcOrigin); (* subtract global origin from global point to get local point *)
  928.     end;
  929.  
  930. procedure TSPoint3D.Reset;
  931.     begin
  932.         size := 2;
  933.         SetVector4(Koord, 0, 0, 0);
  934.         inherited Reset;
  935.     end;
  936.  
  937. procedure TSPoint3D.Init;
  938.     begin
  939.         size := 2;
  940.         SetVector4(Koord, 0, 0, 0);
  941.         inherited Init;
  942.     end;
  943.  
  944. procedure TSPoint3D.Draw;
  945.     override;
  946.     var
  947.         thePoint: Vector4;
  948.         x, y, z: real;
  949.         h, v: integer;
  950.         theRect: rect;
  951.         zbyd: real;
  952.  
  953.     begin
  954.         if (objChanged) then begin
  955.             self.CalcTransform; (* resets versionID to zero and calcs xForm, passes on etc *)
  956.         end;
  957.         if current3DPort^.useEye then begin
  958.             (* first check to see if the eye needs a recalc -- NOT IMPLEMENTED SINCE EYE ALWAYS RECALCS IMMEDIATELY *)
  959.             (* PostConcat the Eye matrix to xForm *)
  960.             self.xForm := MMult(xForm, current3DPort^.MasterTransform);
  961.         end;
  962.  
  963.         thePoint := VMult(Koord, xForm);
  964.         GetVector4(thePoint, x, y, z);
  965.         if current3DPort^.projection = parallel then
  966.  
  967.             begin
  968.             h := Trunc(x) + current3DPort^.center.h;
  969.             v := -Trunc(y) + current3DPort^.center.v
  970.         end
  971.         else begin
  972.             zbyd := 1 / (z / current3DPort^.d + 1);
  973.             h := Trunc(x * zbyd) + current3DPort^.center.h; (* do perspective transformation *)
  974.             v := -Trunc(y * zbyd) + current3DPort^.center.v;
  975.         end;
  976.         SetRect(theRect, h, v, h, v);
  977.         InsetRect(theRect, -size, -size);
  978.         PaintRect(theRect);
  979.     end;
  980.  
  981.  
  982. procedure TSLine3D.Draw;
  983.     override;
  984.     var
  985.         thePoint: Vector4;
  986.         x, y, z: real;
  987.         h, v: integer;
  988.         zbyd: real;
  989.  
  990.     begin
  991.         if (objChanged) then begin
  992.             self.CalcTransform; (* resets versionID to zero and calcs xForm, passes on etc *)
  993.         end;
  994.         if current3DPort^.useEye then begin
  995.             (* first check to see if the eye needs a recalc -- NOT IMPLEMENTED SINCE EYE ALWAYS RECALCS IMMEDIATELY *)
  996.             (* PostConcat the Eye matrix to xForm *)
  997.             self.xForm := MMult(xForm, current3DPort^.MasterTransform);
  998.         end;
  999.  
  1000.         thePoint := VMult(FromLoc, xForm);
  1001.         GetVector4(thePoint, x, y, z);
  1002.         if current3DPort^.projection = parallel then
  1003.  
  1004.             begin
  1005.             h := Trunc(x) + current3DPort^.center.h;
  1006.             v := -Trunc(y) + current3DPort^.center.v
  1007.         end
  1008.         else begin
  1009.             zbyd := 1 / (z / current3DPort^.d + 1);
  1010.             h := Trunc(x * zbyd) + current3DPort^.center.h; (* do perspective transformation *)
  1011.             v := -Trunc(y * zbyd) + current3DPort^.center.v;
  1012.         end;
  1013.         MoveTo(h, v);
  1014.         thePoint := VMult(ToLoc, xForm);
  1015.         GetVector4(thePoint, x, y, z);
  1016.         if current3DPort^.projection = parallel then
  1017.  
  1018.             begin
  1019.             h := Trunc(x) + current3DPort^.center.h;
  1020.             v := -Trunc(y) + current3DPort^.center.v
  1021.         end
  1022.         else begin
  1023.             zbyd := 1 / (z / current3DPort^.d + 1);
  1024.             h := Trunc(x * zbyd) + current3DPort^.center.h; (* do perspective transformation *)
  1025.             v := -Trunc(y * zbyd) + current3DPort^.center.v;
  1026.         end;
  1027.         LineTo(h, v);
  1028.     end;
  1029. end. {impl }