home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / sysext / fkey / codesuck.cpt / CodeSuckerFKEY / Sources / GlobalRoutines.p < prev    next >
Encoding:
Text File  |  1991-12-12  |  7.1 KB  |  178 lines
  1. {****************************************************}
  2. {GlobalRoutines.p                                                                            }
  3. {}
  4. {Some miscellaneous routines used by the CodeSucker FKEY}
  5. {}
  6. {Written using Think Pascal v3.0}
  7. {Requires at least System 6 to run}
  8. {}
  9. {⌐ 1991  Mike van Kleef    -    All rights Reserved}
  10. {----------------------------------------------------}
  11. {Address (mail & network) until September 1992 : }
  12. {    42 Melford Road, London,  E11-4PS, England}
  13. {    vankleef@uk.ac.qmc.dcs   [Queen Mary College, London] }
  14. {Address after September 1992 :}
  15. {    Flat 5, 4 St. Quintin Ave., London, W10-6NU, England}
  16. {----------------------------------------------------}
  17. {CodeSucker is distributed in the hope that it will be useful , but WITHOUT ANY WARRANTY}
  18. {Absolutely no-one on Earth accepts responsibility for the consequences of using this program}
  19. {Everyone is hereby granted permission to delete, copy, modify & redistribute CodeSucker}
  20. {}
  21. {Last Change 10/12/91}
  22. {****************************************************}
  23.  
  24. unit GlobalRoutines;
  25.  
  26. interface
  27.  
  28.     const
  29.         OptionKey = $3A;    {Keyboard code for the Option-Key}
  30.  
  31.     type
  32.         IntPtr = ^Integer;
  33.         LongPtr = ^LongInt;
  34.  
  35.     function KeyIsDown (theKeyCode: integer): Boolean;
  36.     procedure GetRsrcFile (var fName: Str255; var fRef: Integer; index: Integer);
  37.     procedure SetFont (fStr: Str255; fSize: Integer; fStyle: Style);
  38.     procedure CheckOnlyThisItem (theMenu: MenuHandle; theItem: Integer);
  39.  
  40. implementation
  41. {-----------------------------------------}
  42.     const
  43.         FSFCBLen = $3F6;    {System Global, Length of each individual FCB (File Control Block)}
  44.         FCBsPtr = $34E;        {System Global, Pointer to File Control Block buffer}
  45.         FCBoffset = 2;        {Offset from base of FCBsPtr to the FCB's. These leading 2 bytes contain the FCB buffer length}
  46.  
  47.     type
  48.         FileName = string[31];    {Used for the filename in the FCB & FileList}
  49.  
  50.         FCBPtr = ^FCB;
  51.         FCB = record        {File Control Block, See Inside Macintosh vol.IV-178}
  52.                 fcbFlNum: LongInt;                        {File number}
  53.                 fcbMdRByt: Integer;        {Should be byte length, but Pascal can't do this}
  54.          {fcbTypByt: Byte;         Edited out to keep FCB length correct}
  55.                 fcbSBlk: Integer;                            {First allocation block of file}
  56.                 fcbEOF: LongInt;                            {Logical End-Of-File}
  57.                 fcbPLen: LongInt;                            {Physical End-Of-File}
  58.                 fcbCrPs: LongInt;                            {Mark}
  59.                 fcbVPtr: Ptr;                                {Pointer to volume control block}
  60.                 fcbBfAdr: Ptr;                            {Pointer to access buffer path}
  61.                 fcbFlPos: Integer;                        {used internally}
  62.                 fcbClmpSize: LongInt;                    {File clump size}
  63.                 fcbBTCBPtr: Ptr;                            {Pointer to B* tree control block}
  64.                 fcbExtRec: array[0..2] of LongInt;    {First three file extents}
  65.                 fcbFType: ResType;                        {File Type (eg.'APPL', 'TEXT',etc.)}
  66.                 fcbCatPos: LongInt;                        {used internally}
  67.                 fcbDirID: LongInt;                        {File's parent ID}
  68.                 fcbCName: FileName;                        {Name of open file}
  69.             end;
  70.  
  71. {-----------------------------------------}
  72.     function KeyIsDown (theKeyCode: integer): Boolean;
  73.         var
  74.             theKeys: KeyMap;
  75.     begin
  76.         GetKeys(theKeys);
  77.         KeyIsDown := theKeys[theKeyCode];
  78.     end;
  79.  
  80. {-----------------------------------------}
  81. {Will return the entry in the FCB buffer at the given index.}
  82. {If (1 <= index <= fcbEntries) then index=index, else index=fcbEntries}
  83. {The function result is the FCB which corresponds with index.}
  84. {To do this it makes use of the File Control Block buffer, in which various information about}
  85. {currently open files are stored.   This routine makes various assumptions about the}
  86. {structure of the FCB : Warning -> Apple say that the FCB format may change in the}
  87. {future (Inside Macintosh vol.IV-181)}
  88.     function ReturnFCB (var index: Integer): FCBPtr;
  89.         var
  90.             fcbLength: Integer;        {Length of each FCB entry in the buffer}
  91.             fcbBase: Ptr;            {Pointer to the base of the FCB buffer}
  92.             fcbTotalSize: LongInt;    {Total size of FCB buffer (=first word of fcbBase)}
  93.             currentFCB: FCBPtr;    {FCB currently pointed at}
  94.             localCount: Integer;    {loop for going through the items in the FCB buffer}
  95.             endOfList: Boolean;        {True=End of FCB buffer reached, else False}
  96.             fcbEntries: Integer;    {total number of FCB entries in the FCB list}
  97.     begin
  98.         fcbLength := IntPtr(FSFCBLen)^;                        {Get length of each entry in the FCB buffer}
  99.         fcbBase := Ptr(LongPtr(FCBsPtr)^ + FCBoffset);        {Get base address of the FCB buffer}
  100.         fcbTotalSize := IntPtr(LongPtr(FCBsPtr)^)^;            {Get the size of the FCB buffer}
  101.         localCount := 0;
  102.         endOfList := False;
  103.         fcbEntries := fcbTotalSize div fcbLength;
  104.         repeat
  105.             currentFCB := FCBPtr((localCount * fcbLength) + LongInt(fcbBase));
  106.             if (currentFCB^.fcbFlNum = 0) then
  107.                 endOfList := True
  108.             else
  109.                 localCount := localCount + 1
  110.         until endOfList or (localCount >= fcbEntries) or (localCount = index);
  111.         index := localCount;
  112.         ReturnFCB := currentFCB;
  113.     end;
  114.  
  115. {-----------------------------------------}
  116. {This routine returns the open resource file refNum+fileName's at the given index in the FCB}
  117. {The index takes only the resource files into account. Eg, if there are 3 files in the FCB :}
  118. {[Rsrc,Data,Rsrc] then index=2 will return with the second resource file in the FCB. OK ?}
  119. {If the resource file could not be accessed (due to MFinder etc) the routine returns fref=-1}
  120. {If the index given is larger than the number of resource file entried in the FCB then fref=0}
  121.     procedure GetRsrcFile (var fName: Str255; var fRef: Integer; index: Integer);
  122.         var
  123.             currentFCB: FCBPtr;            {Pointer to curent FCB buffer entry}
  124.             totalIndex: Integer;            {index counter for entries in teh FCB buffer}
  125.             theFref: Integer;                {Reference number of open resource file}
  126.             rsrcIndex: Integer;            {Counts through just the resource files in the FCB buffer}
  127.             tmpResFile: Integer;            {store the current resource file}
  128.     begin
  129.         tmpResFile := CurResFile;
  130.         totalIndex := 0;
  131.         rsrcIndex := 0;
  132.         repeat
  133.             totalIndex := totalIndex + 1;
  134.             currentFCB := ReturnFCB(totalIndex);
  135.             if BTST(currentFCB^.fcbMdRByt, 9) then        {Open file is a resource file}
  136.                 begin
  137.                     theFref := LoWord(LongInt(currentFCB) - LongInt(LongPtr(FCBsPtr)^));    {Get resource file number}
  138.                     UseResFile(theFref);
  139.                     if ResError = 0 then
  140.                         fRef := theFref            {No problem accessing file's resource fork}
  141.                     else
  142.                         fRef := -1;                {Can't access this file's resource fork}
  143.                     fName := currentFCB^.fcbCName;
  144.                     rsrcIndex := rsrcIndex + 1;
  145.                 end;
  146.         until (currentFCB^.fcbFlNum = 0) or (rsrcIndex = index);
  147.         if rsrcIndex <> index then
  148.             fRef := 0;                    {No file found at the given index}
  149.         UseResFile(tmpResFile);
  150.     end;
  151.  
  152. {-----------------------------------------}
  153. {Set up a given font & font size for the current port}
  154.     procedure SetFont (fStr: Str255; fSize: Integer; fStyle: Style);
  155.         var
  156.             fNum: Integer;    {Font number}
  157.     begin
  158.         GetFNum(fStr, fNum);
  159.         TextFont(fNum);
  160.         TextSize(fSize);
  161.         TextFace(fStyle);
  162.     end;
  163.  
  164. {-----------------------------------------}
  165. {This routine put a tick character in front of the specified menu item, and un-ticks all the}
  166. {iother items in the given menu}
  167.     procedure CheckOnlyThisItem (theMenu: MenuHandle; theItem: Integer);
  168.         var
  169.             loop: Integer;    {Loop through all the menu items}
  170.     begin
  171.         for loop := 1 to CountMItems(theMenu) do
  172.             if loop = theItem then
  173.                 CheckItem(theMenu, loop, True)
  174.             else
  175.                 CheckItem(theMenu, loop, False);
  176.     end;
  177.  
  178. end.