home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / deltaFileSelect.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-23  |  5.1 KB  |  142 lines  |  [TEXT/3PRM]
  1. implementation module deltaFileSelect;
  2.  
  3. import StdClass,StdBool,StdChar,StdInt,StdMisc,StdString, StdFile,StdArray;
  4. import    standard_file,files,pointer,quickdraw;
  5. import    deltaEventIO, ioState;
  6.  
  7. SelectorWidth  :== 350;
  8. SelectorHeight :== 250;
  9.  
  10. String64 :: String;
  11. String64 = string32 +++ string32;
  12.     where {
  13.         string32 = "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@";
  14.     };
  15.  
  16. Error_i    :: !String !Int -> .x;
  17. Error_i string i = abort (string +++ toString i);
  18.  
  19. Get_parent_id_of_file :: !Int !String !Toolbox -> (!Int, !Toolbox);
  20. Get_parent_id_of_file volumeNumber fileName tb
  21. |    0 == osError    = (parentId, tb1);
  22.                     = Error_i "Error code returned by GetCatInfo: " osError;
  23.     where {
  24.         (osError,parentId,tb1) = GetCatInfo1 volumeNumber fileName tb;
  25.     };
  26.  
  27. Get_working_directory_info :: !Int !Toolbox -> (!Int,!Int,!Toolbox);
  28. Get_working_directory_info workingDirectoryId tb
  29. |    osError == 0    = (volumeNumber,directoryId,tb1);
  30.                     = Error_i "Error code returned by GetWDInfo: " osError;
  31.     where {
  32.         (osError,volumeNumber,directoryId,tb1) = GetWDInfo workingDirectoryId tb;
  33.     };
  34.  
  35. Get_name_and_parent_id_of_directory :: !Int !Int !Toolbox -> (!String,!Int,!Toolbox);
  36. Get_name_and_parent_id_of_directory volumeNumber directoryId tb
  37.     | osError==0
  38.         = (folderName,parentId,tb1);
  39.         = Error_i "Error code returned by BPGetCatInfo: " osError;
  40.     where {
  41.         (osError,folderName,parentId,tb1) = GetCatInfo2 volumeNumber directoryId String64 tb;
  42.     };
  43.  
  44. Get_directory_path :: !Int !Int !String !Toolbox -> (!String, !Toolbox);
  45. Get_directory_path volumeNumber directoryId path tb
  46.     | directoryId==2
  47.         = (folderName +++ ":" +++ path, tb1);
  48.         = Get_directory_path volumeNumber parentId (folderName +++ ":" +++ path) tb1;
  49.     where {
  50.         (folderName, parentId, tb1) = Get_name_and_parent_id_of_directory volumeNumber directoryId tb;
  51.     };
  52.  
  53. SelectInputFile    :: !*s !(IOState *s) -> (!Bool,!String,!*s,!IOState *s);
  54. SelectInputFile programState ioState
  55. |    good    = (True,  pathName,    programState, IOStateSetToolbox tb4 ioState1);
  56.             = (False, "",        programState, IOStateSetToolbox tb2 ioState1);
  57.     where {
  58.         (tb, ioState1)        = IOStateGetToolbox ioState;
  59.         (selectorPos, tb1)    = SelectorPosition tb;
  60.         (good,copy,fType,vRefNum,version,fName,tb2)
  61.                             = SFGetFile selectorPos "" 0 (-1) "" 0 String64 tb1;
  62.         (directoryId,tb3)    = Get_parent_id_of_file vRefNum fName tb2;
  63.         (pathName,     tb4)    = Get_directory_path vRefNum directoryId fName tb3;
  64.     };
  65.  
  66. Find_colon :: !String !Int -> (!Bool,!Int);
  67. Find_colon s p = Find_colon2 s p (dec (size s));
  68.  
  69. Find_colon2 :: String !Int !Int -> (!Bool,!Int);
  70. Find_colon2 s p l
  71. |    p >= l                = (False,p);
  72. |    s.[p] == ':'    = (True,p);
  73.                         = Find_colon2 s (inc p) l;
  74.  
  75. Get_directory_and_file_name :: !String !Toolbox -> (!Int,!Int,!String,!Toolbox);
  76. Get_directory_and_file_name pathName tb
  77. |    not colon                    = (sfSaveDisk, curDirStore, pathName,tb1);
  78. |    pathName.[0] == ':'        = Get_directory_and_file_name2 pathName 0 sfSaveDisk curDirStore tb1;
  79. |    0 == result                    = Get_directory_and_file_name2 pathName colonPosition volumeNumber 2 tb`;
  80.                                 = (sfSaveDisk`,curDirStore`,pathName,tb``);
  81.     where {
  82.         (colon,colonPosition)            = Find_colon pathName 0;
  83.         (sfSaveDisk, curDirStore, tb1)    = Get_stored_dir_and_file tb;
  84.         (result,volumeNumber,tb`)        = GetVInfo (pathName % (0, colonPosition)) tb;
  85.         (sfSaveDisk`,curDirStore`,tb``)    = Get_stored_dir_and_file tb`;
  86.     };
  87.  
  88. Get_stored_dir_and_file :: !Toolbox -> (!Int,!Int,!Toolbox);
  89. Get_stored_dir_and_file tb
  90.     =    (sfSaveDisk,curDirStore,tb2);
  91.     where {
  92.         (saveDisk,tb1)        = LoadWord 532 tb;
  93.         sfSaveDisk            = 0 - saveDisk;
  94.         (curDirStore,tb2)    = LoadLong 920 tb1;
  95.     };
  96.  
  97. Get_directory_and_file_name2 :: !String !Int !Int !Int !Toolbox -> (!Int,!Int,!String,!Toolbox);
  98. Get_directory_and_file_name2 pathName p v d tb
  99.     | (p >= l) || (pathName.[p] <> ':')
  100.         = (v,d,pathName % (p, l_sub_1),tb);
  101.     | colon && (0 == result) && (0 <> (16 bitand attrib))
  102.         = Get_directory_and_file_name2 pathName p2 v d2 tb1;
  103.         = (v,d, pathName % (inc p, l_sub_1),tb1);
  104.     where {
  105.         l_sub_1                    = dec l;
  106.         (colon,p2)                = Find_colon pathName (inc p);
  107.         (result,attrib,d2,tb1)    = GetCatInfo3 v d (pathName % (inc p, dec p2)) tb;
  108.         l                        = size pathName;
  109.     };
  110.  
  111. Set_directory :: !Int !Int !Toolbox -> Toolbox;
  112. Set_directory v d tb
  113.     =    tb2;
  114.     where {
  115.         tb1 = StoreWord 532 (0-v) tb;
  116.         tb2 = StoreLong 920 d tb1;
  117.     };
  118.  
  119. SelectOutputFile:: !String !String !*s !(IOState *s) -> (!Bool, !String,!*s,!IOState *s);
  120. SelectOutputFile prompt originalName programState ioState
  121. |    good    = (True,  pathName,    programState, IOStateSetToolbox tb6 ioState1);
  122.             = (False, "",        programState, IOStateSetToolbox tb4 ioState1);
  123.     where {
  124.         (tb, ioState1)                    = IOStateGetToolbox ioState;
  125.         (selectorPos, tb1)                = SelectorPosition tb;
  126.         (v,d,fileName,tb2)                = Get_directory_and_file_name originalName tb1;
  127.         tb3                                = Set_directory v d tb2;
  128.         (good,copy,fType,vRefNum,version,fName,tb4)
  129.                                         = SFPutFile selectorPos prompt fileName 0 String64 tb3;
  130.         (volumeNumber,directoryId,tb5)    = Get_working_directory_info vRefNum tb4;
  131.         (pathName, tb6)                    = Get_directory_path vRefNum directoryId fName tb5;
  132.     };
  133.  
  134. SelectorPosition :: !Toolbox -> (!(!Int,!Int),!Toolbox);
  135. SelectorPosition tb
  136.     =    ((hPos,vPos), tb1);
  137.     where {
  138.         hPos                = (sr-sl-SelectorWidth ) / 2;
  139.         vPos                = (sb-st-SelectorHeight) / 3;
  140.         (sl,st, sr,sb, tb1)    = QScreenRect tb;
  141.     };
  142.