home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / GrafSys 2.0 / GrafSys 2.0 source / ResourceAccess2.p < prev    next >
Encoding:
Text File  |  1993-07-21  |  10.3 KB  |  394 lines  |  [TEXT/PJMM]
  1. unit ResourceAccess;
  2.  
  3. (* this unit handles loading the 3D resources for objects  *)
  4. (* and converting them to the format used by the grafsys *)
  5. interface
  6.     uses
  7.         Matrix, Transformations, OffscreenCore, GrafSysCore, GrafSysScreen, GrafSysObject;
  8.  
  9. (* LoadObjRes loads the '3Dob' Resource with the ID given and converts the data found there to *)
  10. (* the data structure the Grafsys requires                                                                                *)
  11.  
  12.     procedure LoadObjRes (ID: integer; var theObject: TSObject3D);
  13.     procedure LoadNamedObjRes (name: str255; var theObject: TSObject3D);
  14.     procedure SaveObjRes (ID: integer; name: Str255; theObject: TSObject3D);
  15.     procedure SaveNamedObjRes (var ID: integer; name: Str255; theObject: TSObject3D);
  16.  
  17. implementation
  18.  
  19.     const
  20. (* formula for maxpoly is not correct *)
  21. {MaxByte = 2 + MXP * 4 * 3 + 2 + MXL * 2 * 2 + 2 + MXPoly * MaxPolyLine * 2;}
  22. (* how did we get MaxByte ? *)
  23. (*    2 Byte # of Points  *)
  24. (*    3 Coords * 4 Byte * MaxPoints for point data *)
  25. (*    2 Byte # of lines *)
  26. (*    2 Pointindex * 2 Bytes * MaxLines *)
  27. (*    2 Byte # of Polygons *)
  28. (*    MaxPolyLine * 2 * MaxPolygons *)
  29.  
  30.         dummyConst = 0;
  31.  
  32.     type
  33.         TypeMagic = record (* used for type casting... very dirty *)
  34.                 case integer of
  35.                     1: (
  36.                             leftWord: integer;
  37.                             rightWord: integer;
  38.                     );
  39.  
  40.                     2: (
  41.                             theReal: real
  42.                     );
  43.  
  44.             end;
  45.  
  46.         Point3D = array[1..4] of real;
  47.  
  48.         ResBufH = ^ResBufPtr;
  49.         ResBufPtr = ^ResBuf;
  50.         ResBuf = array[1..1] of integer; (* size is irrelevant *)
  51.  
  52.     var
  53.         theRes: ResBufH;
  54.  
  55.     function GetInt (theBuf: ResBufH; var index: integer): integer;
  56.  
  57.     begin
  58.         GetInt := theBuf^^[index];
  59.         index := index + 1;
  60.     end;
  61.  
  62.     procedure PutInt (theBuf: ResBufH; var index: integer; theValue: integer);
  63.  
  64.     begin
  65.         theBuf^^[index] := theValue;
  66.         index := index + 1;
  67.     end;
  68.  
  69.     procedure DoResLoad (var theObject: TSObject3D);
  70.  
  71.         var
  72.             PointCount: integer;
  73.             BigHack: TypeMagic;
  74.             thePoint: Point3D;
  75.             fromIndex, toIndex: integer;
  76.             LineCount: integer;
  77.             index: integer;
  78.             PolyCount: integer;
  79.             Poly: Polygon;
  80.             dummyLong: Longint;
  81.             pt, ln, py: integer;
  82.  
  83.     begin
  84.  
  85.         index := 1; (* index is our byte counter. now points to first byte (# of points ) *)
  86.         Pt := GetInt(theRes, index);
  87.         if Pt > 0 then
  88.             for PointCount := 1 to pt do (* read in Pt Points *)
  89.                 begin
  90.                     BigHack.leftWord := GetInt(theRes, index);
  91.                     BigHack.rightWord := GetInt(theRes, index);
  92.                     thePoint[1] := (BigHack.theReal);
  93.                     BigHack.leftWord := GetInt(theRes, index);
  94.                     BigHack.rightWord := GetInt(theRes, index);
  95.                     thePoint[2] := (BigHack.theReal);
  96.                     BigHack.leftWord := GetInt(theRes, index);
  97.                     BigHack.rightWord := GetInt(theRes, index);
  98.                     thePoint[3] := (BigHack.theReal);
  99.                     thePoint[4] := 1;
  100.                     dummyLong := theObject.AddPoint(thePoint[1], thePoint[2], thePoint[3]);
  101.                 end;
  102.  
  103.         Ln := GetInt(theRes, index);
  104.         if Ln > 0 then
  105.             for LineCount := 1 to Ln do
  106.                 begin
  107.                     fromIndex := GetInt(theRes, index);
  108.                     toIndex := GetInt(theRes, index);
  109.                     dummyLong := theObject.AddLine(fromIndex, toIndex);
  110.                 end;
  111.  
  112.         py := GetInt(theRes, index);
  113.         if py > 0 then
  114.             for PolyCount := 1 to py do
  115.                 begin
  116. (* do nothing *)
  117.                 end;
  118.  
  119. (* now that resource is loaded, we must deallocate it, since it is only a template *)
  120.         ReleaseResource(Handle(theRes));
  121.     end;
  122.  
  123.  
  124. (* GetResColor : Try to load a 'lClr' resource with given ID into object *)
  125. (*                     lClr is zero-delimited list. *)
  126. (*                        first word         :    misc info                *)
  127. (*                        second word    :     line number or zero    *)
  128. (*                           third word    :    Red value                *)
  129. (*                        fourth word    :    Green value            *)
  130. (*                        fifth word    :    Blue value                *)
  131.  
  132.  
  133.     procedure GetResColor (var theObject: TSObject3D; theID: integer);
  134.  
  135.         var
  136.             index, i: integer;
  137.             theColor: RGBColor;
  138.             lineIndex: integer;
  139.             dummyBool: Boolean;
  140.             ChangeCount: Integer;
  141.  
  142.     begin
  143.         theRes := ResBufH(GetResource(Res3DColor, theID));
  144.         if theRes = nil then
  145.             Exit(GetResColor);
  146.  
  147.         index := 1; (* index is counter for resource access *)
  148.         ChangeCount := GetInt(theRes, index); (* ignored *)
  149.         i := 1;
  150.  
  151.         while i <= ChangeCount do
  152.             begin
  153.                 lineIndex := GetInt(theRes, index);
  154.                 theColor.Red := GetInt(theRes, index);
  155.                 theColor.Green := GetInt(theRes, index);
  156.                 theColor.Blue := GetInt(theRes, index);
  157.                 dummyBool := theObject.ChangeLineColor(lineIndex, theColor);
  158.                 i := 1 + 1;
  159.             end;
  160.         ReleaseResource(Handle(theRes));
  161.     end;
  162.  
  163.     procedure LoadObjRes (ID: integer; var theObject: TSObject3D);
  164.  
  165.     begin
  166.         theRes := ResBufH(GetResource(Res3D, ID));
  167.         if theRes <> nil then
  168.             begin
  169.                 DoResLoad(theObject); (* releases resource, too *)
  170.                 GetResColor(theObject, ID);
  171.             end
  172.         else
  173.             begin
  174.                 theObject.ErrorCode := cCantLoadRes;
  175.             end;
  176.     end;
  177.  
  178.     procedure LoadNamedObjRes (name: str255; var theObject: TSObject3D);
  179.         var
  180.             aName: Str255;
  181.             theID: Integer;
  182.             aType: ResType;
  183.  
  184.     begin
  185.         theRes := ResBufH(GetNamedResource(Res3D, name));
  186.         if theRes <> nil then
  187.             begin
  188.                 GetResInfo(Handle(theRes), theID, aType, aName);
  189.                 DoResLoad(theObject);
  190.                 GetResColor(theObject, theID);
  191.             end
  192.         else
  193.             begin
  194.                 theObject.ErrorCode := cCantLoadRes;
  195.             end;
  196.     end;
  197.  
  198. (* Save in current open resourcefile the object's definition as a resource *)
  199.  
  200.     procedure DoSaveRes (theObject: TSObject3D);
  201.  
  202.         var
  203.             theSize: longInt;
  204.             LineCount, PointCount: integer;
  205.             fromIndex, toIndex: longint;
  206.             thePoint: Point3D;
  207.             index: integer;
  208.             BigHack: TypeMagic;
  209.             dummyBool: Boolean;
  210.             pt, ln, py: integer;
  211.  
  212.     begin
  213.  
  214. (* begin with calculating the required size *)
  215.         Pt := theObject.numPoints;
  216.         Ln := theObject.numLines;
  217.         py := 0;
  218.  
  219.         theSize := 2 + Pt * 12 + 2 + Ln * 4 + 2 + py * 10 * 2;
  220.         theRes := ResBufH(NewHandle(theSize)); (* NOTE: HACK HACK HACK! The size is not the size of *)
  221.         index := 1; (*                                                            the original data structure!!!!                         *)
  222.         if theRes = nil then
  223.             begin
  224.                 theObject.ErrorCode := cOutOfMem;
  225.                 Exit(DoSaveRes);
  226.             end;
  227.  
  228.         PutInt(theRes, index, theObject.numPoints); (* save # of points *)
  229.         if Pt > 0 then
  230.             for PointCount := 1 to pt do (* read in Pt Points *)
  231.                 begin
  232.                     with BigHack do
  233.                         begin
  234.                             theObject.GetPoint(PointCount, thePoint[1], thePoint[2], thePoint[3]);
  235.                             theReal := (thePoint[1]);
  236.                             PutInt(theRes, index, leftWord);
  237.                             PutInt(theRes, index, rightWord);
  238.                             theReal := (thePoint[2]);
  239.                             PutInt(theRes, index, leftWord);
  240.                             PutInt(theRes, index, rightWord);
  241.                             theReal := (thePoint[3]);
  242.                             PutInt(theRes, index, leftWord);
  243.                             PutInt(theRes, index, rightWord);
  244.                         end (* with bighack *)
  245.                 end;
  246.  
  247.  
  248.         PutInt(theRes, index, theObject.numLines);
  249.         if Ln > 0 then
  250.             for LineCount := 1 to Ln do
  251.                 begin
  252.                     theObject.GetLine(LineCount, fromIndex, toIndex);
  253.                     PutInt(theRes, index, fromIndex);
  254.                     PutInt(theRes, index, toIndex);
  255.                 end;
  256.  
  257.         PutInt(theRes, index, 0); (* zero polygons until now *)
  258.  
  259.     end;
  260.  
  261. (* Save rescolor: build memory structure for lClr resource *)
  262.     procedure SaveResColor (theObject: TSObject3D);
  263.  
  264.         var
  265.             lineIndex: Integer;
  266.             changeCount: integer;
  267.             index: integer;
  268.             theColor: RGBColor;
  269.             isChange: Boolean;
  270.             theSize: longint;
  271.             dummyBool: Boolean;
  272.             MiscInfo: integer;
  273.  
  274.     begin
  275. (* first, count the number of changes to calculate the required memsize *)
  276.         lineIndex := 1;
  277.         changeCount := 0;
  278.         while lineIndex <= theObject.numLines do
  279.             begin
  280.                 dummyBool := theObject.GetLineColor(lineIndex, theColor, isChange);
  281.                 if isChange then
  282.                     changeCount := changeCount + 1;
  283.                 lineIndex := lineIndex + 1;
  284.             end;
  285.  
  286.         theSize := changeCount * (sizeOf(lineIndex) + sizeOf(theColor)) + sizeOf(changeCount);
  287.         theRes := ResBufH(NewHandle(theSize));
  288.         lineIndex := 1;
  289.         index := 1;
  290.         PutInt(theRes, index, changeCount);
  291.         while lineIndex <= theObject.numLines do
  292.             begin
  293.                 dummyBool := theObject.GetLineColor(lineIndex, theColor, isChange);
  294.                 if isChange then
  295.                     begin
  296.                         PutInt(theRes, index, lineIndex);
  297.                         PutInt(theRes, index, theColor.red);
  298.                         PutInt(theRes, index, theColor.green);
  299.                         PutInt(theRes, index, theColor.blue);
  300.                     end;
  301.                 lineIndex := lineIndex + 1;
  302.             end;
  303.     end;
  304.  
  305. (* replaces resource with same id *)
  306.     procedure SaveObjRes (ID: integer; name: Str255; theObject: TSObject3D);
  307.  
  308.         var
  309.             aRes: Handle;
  310.             theErr: integer;
  311.  
  312.     begin
  313.         DoSaveRes(theObject);
  314.         if theRes = nil then
  315.             Exit(SaveObjRes);
  316.  
  317.     (* check if we have to delete a resource of the same id before saving *)
  318.         aRes := GetResource(Res3D, ID);
  319.         if aRes <> nil then
  320.             begin
  321.                 RmveResource(aRes);
  322.                 DisposHandle(aRes);
  323.             end;
  324.         AddResource(Handle(theRes), Res3D, ID, name);
  325.         UpdateResFile(CurResFile);
  326.         ReleaseResource(Handle(theRes)); (* Deallocate Mem *)
  327.         theRes := nil;
  328.  
  329. (* handle color information *)
  330.         SaveResColor(theObject); (* build color information resource in global theRes *)
  331.         if theRes = nil then
  332.             Exit(SaveObjRes);
  333.     (* check if we have to delete a resource of the same id before saving *)
  334.         aRes := GetResource(Res3DColor, ID);
  335.         if aRes <> nil then
  336.             begin
  337.                 RmveResource(aRes);
  338.                 DisposHandle(aRes);
  339.             end;
  340.  
  341.         AddResource(Handle(theRes), Res3DColor, ID, name);
  342.         theErr := ResError;
  343.         UpdateResFile(CurResFile);
  344.         theErr := ResError;
  345.         ReleaseResource(Handle(theRes)); (* Deallocate Mem *)
  346.     end;
  347.  
  348. (* replace res with same name *)
  349.     procedure SaveNamedObjRes (var ID: integer; name: Str255; theObject: TSObject3D);
  350.         var
  351.             aRes: Handle;
  352.             aType: ResType;
  353.             aName: Str255;
  354.             theErr: Integer;
  355.  
  356.     begin
  357.         DoSaveRes(theObject);
  358.         if theRes = nil then
  359.             Exit(SaveNamedObjRes);
  360.  
  361. (* check if we have to delete a resource of the same id before saving *)
  362.         aRes := GetNamedResource(Res3D, name);
  363.         if aRes <> nil then
  364.             begin
  365.                 GetResInfo(aRes, ID, aType, aName); (* get ID for later save of replacement *)
  366.                 RmveResource(aRes);
  367.                 DisposHandle(aRes);
  368.             end
  369.         else
  370.             ID := UniqueID(Res3D);
  371.  
  372.         AddResource(Handle(theRes), Res3D, ID, name);
  373.         UpdateResFile(CurResFile);
  374.         ReleaseResource(Handle(theRes)); (* Deallocate Mem *)
  375.  
  376. (* handle color information *)
  377.         SaveResColor(theObject); (* build color information resource in global theRes *)
  378.         if theRes = nil then
  379.             Exit(SaveNamedObjRes);
  380.     (* check if we have to delete a resource of the same id before saving *)
  381.         aRes := GetResource(Res3DColor, ID);
  382.         if aRes <> nil then
  383.             begin
  384.                 RmveResource(aRes);
  385.                 DisposHandle(aRes);
  386.             end;
  387.         AddResource(Handle(theRes), Res3DColor, ID, name);
  388.         theErr := ResError;
  389.         UpdateResFile(CurResFile);
  390.         theErr := ResError;
  391.         ReleaseResource(Handle(theRes)); (* Deallocate Mem *)
  392.     end;
  393.  
  394. end.