home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 037.lha / DU / MyMisc.mod < prev    next >
Encoding:
Modula Implementation  |  1987-05-17  |  7.5 KB  |  282 lines
  1. IMPLEMENTATION MODULE MyMisc;
  2.  
  3. (*$S-,$T-,$A+*)
  4.  
  5. (* MODULE to read the directory of a current device or directory and
  6.    place names/sizes into DirTable  - also to Sort them in alphabetical
  7.    order (case insensitive)
  8. *)
  9.  
  10. FROM SYSTEM             IMPORT  NULL,TSIZE,BYTE,ADR;
  11. FROM Strings            IMPORT  Assign,Length,Copy,Concat,Insert;
  12. FROM Conversions        IMPORT  ConvertToString;
  13. FROM Memory             IMPORT  MemReqSet, MemPublic,MemClear, AllocMem,
  14.                                 FreeMem,AvailMem,MemFast,MemChip;
  15. FROM Ports              IMPORT  GetMsg,ReplyMsg,MessagePtr;
  16. FROM DOSFiles           IMPORT  Lock, Unlock, Examine, ExNext, FileLock,
  17.                                 FileInfoBlock, FileInfoBlockPtr;
  18. FROM Intuition          IMPORT  PrintIText;
  19. FROM Gadgets            IMPORT  RemoveGadget,AddGadget,RefreshGadgets;
  20. FROM MyGlobals          IMPORT  MyWindowPtr,WBColors,JamTwo,FileText,MyX,
  21.                                 MyY,MyMsg,MyClass,MyGadPtr,GadGot,RefreshMe,
  22.                                 IOStringInfo,GadgetNames,MyGads,IOString,
  23.                                 MaxMax,MaxScreenFiles,DirInfo,IntRead,
  24.                                 DirEntries,DirTable,MaxFiles,DirPtr,
  25.                                 NullReqPtr,GotOne;
  26. FROM MyWindow           IMPORT  ResetSlider;
  27.  
  28. TYPE
  29.   CharPtr       = POINTER TO CHAR;
  30.  
  31. VAR
  32. (* local variables *)
  33.   fib           : FileInfoBlockPtr;
  34.   lock          : FileLock;
  35.   StrNr         : ARRAY[0..33] OF CHAR;
  36.   Dun           : BOOLEAN;
  37.   GPString      : ARRAY[0..38] OF CHAR;
  38.  
  39. (*--------------------*)
  40. PROCEDURE ShowMem;
  41. VAR l:LONGCARD;
  42. BEGIN
  43.     l := AvailMem(MemReqSet{MemChip})+AvailMem(MemReqSet{MemFast});
  44.     ConvertToString(l,10,FALSE,GPString,Dun);
  45.     WHILE Length(GPString)<10 DO Insert(" ",GPString,0) END;
  46.     WITH FileText DO
  47.       FrontPen  := BYTE(ORD(Green));
  48.       BackPen   := BYTE(ORD(Blue));
  49.       DrawMode  := BYTE(JamTwo);
  50.       LeftEdge  := 400;
  51.       TopEdge   := 1;
  52.       ITextFont := NULL;
  53.       IText     := ADR(GPString);
  54.       NextText  := NULL;
  55.     END;
  56.     PrintIText(MyWindowPtr^.RPort^,FileText,0,0);
  57. END ShowMem;
  58.  
  59.  
  60.  
  61. PROCEDURE CheckMessages():BOOLEAN;
  62. BEGIN
  63.   MyMsg := GetMsg(MyWindowPtr^.UserPort);
  64.   IF MyMsg = NULL THEN RETURN FALSE END;
  65.   MyClass := MyMsg^.Class;
  66.   MyX := MyMsg^.MouseX;
  67.   MyY := MyMsg^.MouseY;
  68.   MyGadPtr := MyMsg^.IAddress;
  69.   ReplyMsg(MessagePtr(MyMsg));
  70.   GadGot := GadgetNames(MyGadPtr^.GadgetID);
  71.   RETURN TRUE;
  72. END CheckMessages;
  73.  
  74.  
  75. PROCEDURE Interrupt():BOOLEAN;
  76. BEGIN
  77.   RETURN (CheckMessages() AND (MyClass = GotOne));
  78. END Interrupt;
  79.  
  80. PROCEDURE ReplaceRSDM(g:GadgetNames;VAR a:ARRAY OF CHAR);
  81. VAR d:INTEGER;
  82. BEGIN
  83.   d := RemoveGadget(MyWindowPtr,MyGads[g]);
  84.   Assign(IOString[g],a);
  85.   IF g = msg THEN Insert(" ",IOString[g],0) END;
  86.   IOStringInfo[g].NumChars := Length(a);
  87.   IOStringInfo[g].DispPos := 0;
  88.   d := AddGadget(MyWindowPtr,MyGads[g],d);
  89.   RefreshGadgets(MyGads[g],MyWindowPtr,NullReqPtr^);
  90. END ReplaceRSDM;
  91.  
  92.  
  93. PROCEDURE ReadDirectory(lock:FileLock):BOOLEAN;
  94. VAR good:BOOLEAN;
  95. (* Returns true if good read
  96.  
  97.    DirTable[0] contains the directory record and name.
  98.    DirTable[1] - DirTable[DirEntries] contains filenames & other info *)
  99.  
  100. BEGIN
  101.   fib := AllocMem(TSIZE(FileInfoBlock),MemReqSet{MemPublic});
  102.   IF (fib = NULL) THEN RETURN FALSE END;
  103.   IF Examine(lock,fib^) AND (fib^.fibDirEntryType > 0) THEN
  104.     ReplaceRSDM(msg,"Getting files!");
  105.     DirEntries := 0;
  106.     REPEAT
  107.       IF (Interrupt()) AND (GadGot = slider) THEN IntRead := TRUE END;
  108.       WITH fib^ DO
  109.         Assign(DirTable[DirEntries]^.FileName,fibFileName);
  110.         DirTable[DirEntries]^.IsDir      := (fibDirEntryType > 0);
  111.         DirTable[DirEntries]^.FileSize   := fibSize;
  112.         DirTable[DirEntries]^.WasSelected := FALSE;
  113.         DirTable[DirEntries]^.IsSelected := FALSE;
  114.       END;
  115.       INC(DirEntries);
  116.     UNTIL (ExNext(lock,fib^)=FALSE) OR (DirEntries > MaxFiles) OR (IntRead);
  117.     IF IntRead THEN
  118.       ReplaceRSDM(msg,"READ interrupt!")
  119.     ELSIF (DirEntries > MaxFiles) THEN
  120.       ReplaceRSDM(msg,"250 File MAX hit!")
  121.     END;
  122.     good := TRUE;
  123.     DEC(DirEntries);
  124.   ELSE
  125.     good := FALSE;
  126.   END;
  127.   FreeMem(fib,TSIZE(FileInfoBlock));
  128.   RETURN good;
  129. END ReadDirectory;
  130.  
  131. (*------------*)
  132.  
  133. PROCEDURE FirstHigher (VAR lower,upper : ARRAY OF CHAR): BOOLEAN;
  134. (* Compare dirtable entries filename part      *)
  135. VAR i : CARDINAL;
  136.  BEGIN
  137.   FOR i := 0 TO 30 DO
  138.         (* Test end-of-string cases *)
  139.     IF (upper[i] = 0C) THEN
  140.       IF (lower[i] = 0C) THEN RETURN FALSE ELSE RETURN TRUE END
  141.     ELSIF (lower[i] = 0C) THEN
  142.       RETURN FALSE
  143.     END;
  144.         (* If here, test character values *)
  145.     IF (CAP(lower[i]) > CAP(upper[i])) THEN
  146.       RETURN TRUE
  147.     ELSIF (CAP(lower[i]) < CAP(upper[i])) THEN
  148.       RETURN FALSE
  149.     END;
  150.   END;
  151.   RETURN FALSE;
  152. END FirstHigher;
  153.  
  154.  
  155. PROCEDURE QSort;
  156. VAR i,j : CARDINAL; Swap : BOOLEAN;
  157. (* Sort the directory - DirEntries is top 1 is bottom   *)
  158. (* QuickSort recursive calling *)
  159.  
  160.  PROCEDURE Sort(l,r:CARDINAL);
  161.  VAR i,j:CARDINAL;
  162.      x,w:DirPtr;
  163.  BEGIN
  164.    i := l; j := r;
  165.    x := DirTable[(l + r) DIV 2];
  166.    REPEAT
  167.      WHILE FirstHigher(x^.FileName,DirTable[i]^.FileName) DO INC(i) END;
  168.      WHILE FirstHigher(DirTable[j]^.FileName,x^.FileName) DO DEC(j) END;
  169.      IF i <= j THEN
  170.        w := DirTable[i];
  171.        DirTable[i] := DirTable[j];
  172.        DirTable[j] := w;
  173.        INC(i);
  174.        DEC(j);
  175.      END;
  176.    UNTIL (i > j);
  177.    IF l < j THEN Sort(l,j) END;
  178.    IF i < r THEN Sort(i,r) END;
  179.  END Sort;
  180.  
  181. BEGIN
  182.   Sort(1,DirEntries);
  183. END QSort;
  184.  
  185. (*----------*)
  186.  
  187. PROCEDURE MoveString(VAR tgt,src:ARRAY OF CHAR; po,le:CARDINAL);
  188. (* move max of 'le' chars of src to tgt[po] *)
  189. (* not including ending null                *)
  190. VAR s:CARDINAL;
  191. BEGIN
  192.   s := 0;
  193.   WHILE (s < le) AND (src[s] <> 0C) DO;
  194.     tgt[po+s] := src[s];
  195.     INC(s);
  196.   END;
  197. END MoveString;
  198.  
  199. PROCEDURE DisplayName(file,pos:CARDINAL);
  200. VAR m,t:CARDINAL;f,b:WBColors;
  201. BEGIN
  202.   WITH DirTable[file]^ DO
  203.     m := Length(FileName);
  204.     IF m>28 THEN m := 28 END;
  205.     GPString := "                                   "; (*35char*)
  206.     f := Black; b := Blue;
  207.     t := (pos * 8) + 16;
  208.     IF (file>DirEntries) THEN
  209.       b := Black;
  210.     ELSIF IsDir THEN
  211.       MoveString(GPString,FileName,0,m);
  212.       IF IsSelected THEN
  213.         b:= Green
  214.       ELSE
  215.         f := Green; b:= Black;
  216.       END;
  217.     ELSE
  218.       MoveString(GPString,FileName,0,m);
  219.       ConvertToString(FileSize,10,FALSE,StrNr,Dun);
  220.       m := Length(StrNr);
  221.       MoveString(GPString,StrNr,35-m,m);
  222.       IF IsSelected THEN
  223.         f := Black; b := White
  224.       ELSE
  225.         f := White; b := Black
  226.       END;
  227.     END;
  228.     WITH FileText DO
  229.       FrontPen  := BYTE(ORD(f));
  230.       BackPen   := BYTE(ORD(b));
  231.       DrawMode  := BYTE(JamTwo);
  232.       LeftEdge  := 6;
  233.       TopEdge   := t;
  234.       ITextFont := NULL;
  235.       IText     := ADR(GPString);
  236.       NextText  := NULL;
  237.     END;
  238.     PrintIText(MyWindowPtr^.RPort^,FileText,0,0);
  239.   END;
  240. END DisplayName;
  241.  
  242. PROCEDURE DisplayFiles(ind:CARDINAL);
  243. VAR i:CARDINAL;
  244. BEGIN
  245.   FOR i := 1 TO MaxScreenFiles DO DisplayName(i+ind-1,i) END;
  246.   ShowMem;
  247. END DisplayFiles;
  248.  
  249.  
  250. PROCEDURE NewDir;
  251. VAR Vbod : CARDINAL;
  252. (* Display a new directory *)
  253. BEGIN
  254.   Vbod := 0FFFFH;
  255.   IF DirEntries > MaxScreenFiles THEN
  256.     Vbod := 0FFFFH DIV DirEntries;
  257.     Vbod := Vbod * MaxScreenFiles;
  258.   END;
  259.   ResetSlider(Vbod);
  260.   DisplayFiles(1);
  261. END NewDir;
  262.  
  263. PROCEDURE ClearTable;
  264. VAR i:CARDINAL;
  265. BEGIN
  266.   FOR i := 0 TO MaxFiles DO
  267.     FreeMem(DirTable[i],TSIZE(DirInfo));
  268.   END;
  269. END ClearTable;
  270.  
  271.  
  272. BEGIN
  273.   MaxFiles := 0;
  274.   REPEAT
  275.     DirTable[MaxFiles] := AllocMem(TSIZE(DirInfo),MemReqSet{MemPublic,MemClear});
  276.     INC(MaxFiles);
  277.   UNTIL  (MaxFiles > MaxMax) OR (DirTable[MaxFiles-1] = NULL);
  278.   DEC(MaxFiles);
  279.  
  280. END MyMisc.
  281.  
  282.