home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_07 / PURE_P_2.LZH / PURE_P_2.MSA / RESOURCE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-12  |  11KB  |  296 lines
  1. { ------------------------------------------------------------ }
  2. { UNIT  RESOURCES                                              }
  3. { (c) 1992 Pure Software GmbH                                  }
  4. {                                                              }
  5. { this unit enables the usage of linked-in GEM resource files. }
  6. { therefore the .RSC-file must be converted into an object     }
  7. { file using BINOBJ.                                           }
  8. {                                                              }
  9. {                                                              }
  10. { 1. Execute BINOBJ to create an object file, i.e.             }
  11. {      BINOBJ myrsc.rcs myrsc MyResource                       }
  12. {                                                              }
  13. { 2. Include the object file into the primary file using the   }
  14. {    $L-directive.                                             }
  15. {                                                              }
  16. { 3. Declare the entry point for the resource file which must  }
  17. {    be the same identifier used at 1., i.e.                   }
  18. {      procedure  MyResource; external; (*$L myrsc *)          }
  19. {                                                              }
  20. { 4. Initialize the linked-in resource file:                   }
  21. {      resourcePool := InitResourcePool( @MyResource );        }
  22. {                                                              }
  23. { 5. now the variable resourcePool can be used to inquire the  }
  24. {    start address of an AESTree:                              }
  25. {      menuTree := GetResource( resourcePool, MYMENU );        }
  26. {      menu_bar( menuTree, 1 );                                }
  27. {                                                              }
  28. { 6. before program termination you must call FreeResourcePool }
  29. {      FreeResourcePool( resourcePool );                       }
  30. { ------------------------------------------------------------ }
  31.  
  32. unit Resources;
  33.  
  34. interface
  35.  
  36. uses Gem;
  37.  
  38. type
  39.     TResource = AESTreePtr;
  40.     TResourcePoolPtr = ^TResourcePool;
  41.     TResourcePool = Pointer;
  42.  
  43.  
  44. function    InitResourcePool( unfixedResource : Pointer ) : TResourcePoolPtr;
  45. procedure    FreeResourcePool( pool : TResourcePoolPtr );
  46. function    GetResource( pool : TResourcePoolPtr; poolIndex : Word ) : TResource;
  47.  
  48.  
  49. { ============================================================ }
  50.  
  51. implementation
  52.  
  53. {$X+}
  54.  
  55. { ------------------------------------------------------------ }
  56. { these are the maximum numbers of the named data structures   }
  57. { a resource file can contain.                                 }
  58. { ------------------------------------------------------------ }
  59.  
  60. const
  61.     MaxAESObjects = 2730;
  62.     MaxTedinfos = 2340;
  63.     MaxIconBlocks = 1820;
  64.     MaxBitBlocks = 4681;
  65.  
  66. { ------------------------------------------------------------ }
  67. { the following record describes the header of a resource      }
  68. { files. for further information see the GEM literature.       }
  69. { ------------------------------------------------------------ }
  70.  
  71. type
  72.     ResourceHeaderTypePtr = ^ResourceHeaderType;
  73.     ResourceHeaderType = record
  74.         rsh_vrsn :        Word;
  75.         rsh_object :    Word;
  76.         rsh_tedinfo :    Word;
  77.         rsh_iconblk :    Word;
  78.         rsh_bitblk :    Word;
  79.         rsh_frstr :        Word;
  80.         rsh_string :    Word;
  81.         rsh_imdata :    Word;
  82.         rsh_frimg :        Word;
  83.         rsh_trindex :    Word;
  84.         rsh_nobs :        Word;
  85.         rsh_ntree :        Word;
  86.         rsh_nted :        Word;
  87.         rsh_nib :        Word;
  88.         rsh_nbb :        Word;
  89.         rsh_nstring :    Word;
  90.         rsh_nimages :    Word;
  91.         rsh_rssize :    Word;
  92.     end;
  93.  
  94. { ------------------------------------------------------------ }
  95. { this variant record allows convenient accessing the resource }
  96. { file bytewise and also the resource header.                  }
  97. { ------------------------------------------------------------ }
  98.  
  99.     ResourceFileTypePtr = ^ResourceFileType;
  100.     ResourceFileType = record
  101.         case Integer of
  102.             1:        ( resourceHeader :    ResourceHeaderType );
  103.             2:        ( resourceData :    Array[0..65535] of Byte );
  104.     end;
  105.  
  106. { ------------------------------------------------------------ }
  107. { some data structures to deal with the different components   }
  108. { of a resource file.                                          }
  109. { ------------------------------------------------------------ }
  110.  
  111.     TedinfoArrayPtr = ^TedinfoArray;
  112.     TedinfoArray = Array[0..MaxTedinfos] of TEDINFO;
  113.     IconBlockArrayPtr = ^IconBlockArray;
  114.     IconBlockArray = Array[0..MaxIconBlocks] of ICONBLK;
  115.     BitBlockArrayPtr = ^BitBlockArray;
  116.     BitBlockArray = Array[0..MaxBitBlocks] of BITBLK;
  117.     AESTreePtrArrayPtr = ^AESTreePtrArray;
  118.     AESTreePtrArray = Array[0..MaxAESObjects] of AESTreePtr;
  119.  
  120. { ------------------------------------------------------------ }
  121. { FIXRSC means that the relative addresses of the components   }
  122. { of the resource file should be fixed to absolute addresses.  }
  123. { UNFIXRSC is the counteroperation.                            }
  124. { ------------------------------------------------------------ }
  125.  
  126.     FixMode = ( FIXRSC, UNFIXRSC );
  127.  
  128.  
  129. { ------------------------------------------------------------ }
  130. { the gem function rsrc_obfix transforms relative coordinates  }
  131. { to absolute ones. this procedure works the the other way     }
  132. { round.                                                       }
  133. { the low byte of a relative coordinate contains a character-  }
  134. { distance and the high byte a remaining pixel distance.       }
  135. { ------------------------------------------------------------ }
  136.  
  137. procedure    AbsToRelCoords( var coord : Integer; defCharSize : Integer );
  138. var
  139.     px, ch : Integer;
  140. begin
  141.     ch := coord div defCharSize;
  142.     px := coord mod defCharSize;
  143.     coord := ( px shl 8 ) + ch;
  144. end;
  145.  
  146.  
  147. { ------------------------------------------------------------ }
  148. { since there seem to be some problems using rsrc_obfix we     }
  149. { will do it ourselves.                                        }
  150. { ------------------------------------------------------------ }
  151.  
  152. procedure    RelToAbsCoords( var coord : Integer; defCharSize : Integer );
  153. var
  154.     px, ch : Integer;
  155. begin
  156.     ch := ( coord and $00ff ) * defCharSize;
  157.     px := coord shr 8;
  158.     coord := ch + px;
  159. end;
  160.  
  161.  
  162. { ------------------------------------------------------------ }
  163. { the procedure FixResourcePool handles, depending on the      }
  164. { parameter mode, the fixing respectively the un-fixing of the }
  165. { relative addresses of a resource file by adding or           }
  166. { substracting the start address of the resource file.         }
  167. { ------------------------------------------------------------ }
  168.  
  169. procedure    FixResourcePool( unfixedResource : Pointer; mode : FixMode );
  170. var
  171.     resourceFile : ResourceFileTypePtr;
  172.     resourceHeader : ResourceHeaderTypePtr;
  173.     tree : AESTreePtr;
  174.     treePool : AESTreePtrArrayPtr;
  175.     tedinfo : TedinfoArrayPtr;
  176.     iconblk : IconBlockArrayPtr;
  177.     bitblk : BitBlockArrayPtr;
  178.     obj, objCnt, objType :    Integer;
  179.     defWidth, defHeight, dummy : Integer;
  180.     offset : LongInt;
  181.  
  182. begin
  183.     offset := LongInt( unfixedResource );
  184.     if mode = UNFIXRSC then
  185.         offset := -offset;
  186.     resourceFile := unfixedResource;
  187.     resourceHeader := @resourceFile^.resourceHeader;
  188.     graf_handle( defWidth, defHeight, dummy, dummy );
  189.  
  190.     tree := @resourceFile^.resourceData[resourceHeader^.rsh_object];
  191.     for obj := 0 to resourceHeader^.rsh_nobs - 1 do
  192.     begin
  193.         if mode = FIXRSC then
  194.         begin
  195.             RelToAbsCoords( tree^[obj].ob_x, defWidth );
  196.             RelToAbsCoords( tree^[obj].ob_y, defHeight );
  197.             RelToAbsCoords( tree^[obj].ob_width, defWidth );
  198.             RelToAbsCoords( tree^[obj].ob_height, defHeight );
  199.         end
  200.         else
  201.         begin
  202.             AbsToRelCoords( tree^[obj].ob_x, defWidth );
  203.             AbsToRelCoords( tree^[obj].ob_y, defHeight );
  204.             AbsToRelCoords( tree^[obj].ob_width, defWidth );
  205.             AbsToRelCoords( tree^[obj].ob_height, defHeight );
  206.         end;
  207.  
  208.         objType := tree^[obj].ob_type;
  209.         if ( objType = G_TEXT ) or ( objType = G_BOXTEXT )
  210.                 or ( objType = G_FTEXT ) or ( objType = G_FBOXTEXT )
  211.                 or ( objType = G_BUTTON ) or ( objType = G_STRING )
  212.                 or ( objType = G_TITLE ) or ( objType = G_ICON )
  213.                 or ( objType = G_IMAGE ) then
  214.         begin
  215.             Inc( tree^[obj].ob_spec.index, offset );
  216.         end;
  217.     end;
  218.  
  219.     tedinfo := @resourceFile^.resourceData[resourceHeader^.rsh_tedinfo];
  220.     for obj := 0 to resourceHeader^.rsh_nted - 1 do
  221.     begin
  222.         Inc( LongInt( tedinfo^[obj].te_ptext ), offset );
  223.         Inc( LongInt( tedinfo^[obj].te_ptmplt ), offset );
  224.         Inc( LongInt( tedinfo^[obj].te_pvalid ), offset );
  225.     end;
  226.  
  227.     iconblk := @resourceFile^.resourceData[resourceHeader^.rsh_iconblk];
  228.     for obj := 0 to resourceHeader^.rsh_nib - 1 do
  229.     begin
  230.         Inc( LongInt( iconblk^[obj].ib_pmask ), offset );
  231.         Inc( LongInt( iconblk^[obj].ib_pdata ), offset );
  232.         Inc( LongInt( iconblk^[obj].ib_ptext ), offset );
  233.     end;
  234.  
  235.     bitblk := @resourceFile^.resourceData[resourceHeader^.rsh_bitblk];
  236.     for obj := 0 to resourceHeader^.rsh_nbb - 1 do
  237.         Inc( LongInt( bitblk^[obj].bi_pdata ), offset );
  238.  
  239.     treePool := @resourceFile^.resourceData[resourceHeader^.rsh_trindex];
  240.     for obj := 0 to resourceHeader^.rsh_ntree - 1 do
  241.         Inc( LongInt( treePool^[obj] ), offset );
  242. end;
  243.  
  244.  
  245. { ------------------------------------------------------------ }
  246. { this procedure start the un-fixing process.                  }
  247. { ------------------------------------------------------------ }
  248.  
  249. procedure    FreeResourcePool( pool : TResourcePoolPtr );
  250. begin
  251.     FixResourcePool( pool, UNFIXRSC );
  252. end;
  253.  
  254.  
  255. { ------------------------------------------------------------ }
  256. { this procedure initializes the resource file and the GEM!    }
  257. { ------------------------------------------------------------ }
  258.  
  259. function    InitResourcePool( unfixedResource : Pointer ) : TResourcePoolPtr;
  260. var
  261.     resourceFile : ResourceFileTypePtr;
  262.     resourceHeader : ResourceHeaderTypePtr;
  263.     treePool : AESTreePtrArrayPtr;
  264. begin
  265.     FixResourcePool( unfixedResource, FIXRSC );
  266.     resourceFile := unfixedResource;
  267.     resourceHeader := @resourceFile^.resourceHeader;
  268.     treePool := @resourceFile^.resourceData[resourceHeader^.rsh_trindex];
  269.     GEM_pb.global[5] := Word( LongInt( treePool ) shr 16 );
  270.     GEM_pb.global[6] := Word( treePool );
  271.     InitResourcePool := unfixedResource;
  272. end;
  273.  
  274.  
  275. { ------------------------------------------------------------ }
  276. { this function returns the address of a specific AESTree of   }
  277. { the resource file.                                           }
  278. { ------------------------------------------------------------ }
  279.  
  280. function    GetResource( pool : TResourcePoolPtr; poolIndex : Word ) : TResource;
  281. var
  282.     resourceFile : ResourceFileTypePtr;
  283.     resourceHeader : ResourceHeaderTypePtr;
  284.     treePool : AESTreePtrArrayPtr;
  285. begin
  286.     resourceFile := ResourceFileTypePtr( pool );
  287.     resourceHeader := @resourceFile^.resourceHeader;
  288.     treePool := @resourceFile^.resourceData[resourceHeader^.rsh_trindex];
  289.     GetResource := treePool^[poolIndex];
  290. end;
  291.  
  292.  
  293. end.
  294.  
  295. { ============================================================ }
  296.