home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
037.lha
/
DU
/
MyMisc.mod
< prev
next >
Wrap
Text File
|
1987-05-16
|
8KB
|
282 lines
IMPLEMENTATION MODULE MyMisc;
(*$S-,$T-,$A+*)
(* MODULE to read the directory of a current device or directory and
place names/sizes into DirTable - also to Sort them in alphabetical
order (case insensitive)
*)
FROM SYSTEM IMPORT NULL,TSIZE,BYTE,ADR;
FROM Strings IMPORT Assign,Length,Copy,Concat,Insert;
FROM Conversions IMPORT ConvertToString;
FROM Memory IMPORT MemReqSet, MemPublic,MemClear, AllocMem,
FreeMem,AvailMem,MemFast,MemChip;
FROM Ports IMPORT GetMsg,ReplyMsg,MessagePtr;
FROM DOSFiles IMPORT Lock, Unlock, Examine, ExNext, FileLock,
FileInfoBlock, FileInfoBlockPtr;
FROM Intuition IMPORT PrintIText;
FROM Gadgets IMPORT RemoveGadget,AddGadget,RefreshGadgets;
FROM MyGlobals IMPORT MyWindowPtr,WBColors,JamTwo,FileText,MyX,
MyY,MyMsg,MyClass,MyGadPtr,GadGot,RefreshMe,
IOStringInfo,GadgetNames,MyGads,IOString,
MaxMax,MaxScreenFiles,DirInfo,IntRead,
DirEntries,DirTable,MaxFiles,DirPtr,
NullReqPtr,GotOne;
FROM MyWindow IMPORT ResetSlider;
TYPE
CharPtr = POINTER TO CHAR;
VAR
(* local variables *)
fib : FileInfoBlockPtr;
lock : FileLock;
StrNr : ARRAY[0..33] OF CHAR;
Dun : BOOLEAN;
GPString : ARRAY[0..38] OF CHAR;
(*--------------------*)
PROCEDURE ShowMem;
VAR l:LONGCARD;
BEGIN
l := AvailMem(MemReqSet{MemChip})+AvailMem(MemReqSet{MemFast});
ConvertToString(l,10,FALSE,GPString,Dun);
WHILE Length(GPString)<10 DO Insert(" ",GPString,0) END;
WITH FileText DO
FrontPen := BYTE(ORD(Green));
BackPen := BYTE(ORD(Blue));
DrawMode := BYTE(JamTwo);
LeftEdge := 400;
TopEdge := 1;
ITextFont := NULL;
IText := ADR(GPString);
NextText := NULL;
END;
PrintIText(MyWindowPtr^.RPort^,FileText,0,0);
END ShowMem;
PROCEDURE CheckMessages():BOOLEAN;
BEGIN
MyMsg := GetMsg(MyWindowPtr^.UserPort);
IF MyMsg = NULL THEN RETURN FALSE END;
MyClass := MyMsg^.Class;
MyX := MyMsg^.MouseX;
MyY := MyMsg^.MouseY;
MyGadPtr := MyMsg^.IAddress;
ReplyMsg(MessagePtr(MyMsg));
GadGot := GadgetNames(MyGadPtr^.GadgetID);
RETURN TRUE;
END CheckMessages;
PROCEDURE Interrupt():BOOLEAN;
BEGIN
RETURN (CheckMessages() AND (MyClass = GotOne));
END Interrupt;
PROCEDURE ReplaceRSDM(g:GadgetNames;VAR a:ARRAY OF CHAR);
VAR d:INTEGER;
BEGIN
d := RemoveGadget(MyWindowPtr,MyGads[g]);
Assign(IOString[g],a);
IF g = msg THEN Insert(" ",IOString[g],0) END;
IOStringInfo[g].NumChars := Length(a);
IOStringInfo[g].DispPos := 0;
d := AddGadget(MyWindowPtr,MyGads[g],d);
RefreshGadgets(MyGads[g],MyWindowPtr,NullReqPtr^);
END ReplaceRSDM;
PROCEDURE ReadDirectory(lock:FileLock):BOOLEAN;
VAR good:BOOLEAN;
(* Returns true if good read
DirTable[0] contains the directory record and name.
DirTable[1] - DirTable[DirEntries] contains filenames & other info *)
BEGIN
fib := AllocMem(TSIZE(FileInfoBlock),MemReqSet{MemPublic});
IF (fib = NULL) THEN RETURN FALSE END;
IF Examine(lock,fib^) AND (fib^.fibDirEntryType > 0) THEN
ReplaceRSDM(msg,"Getting files!");
DirEntries := 0;
REPEAT
IF (Interrupt()) AND (GadGot = slider) THEN IntRead := TRUE END;
WITH fib^ DO
Assign(DirTable[DirEntries]^.FileName,fibFileName);
DirTable[DirEntries]^.IsDir := (fibDirEntryType > 0);
DirTable[DirEntries]^.FileSize := fibSize;
DirTable[DirEntries]^.WasSelected := FALSE;
DirTable[DirEntries]^.IsSelected := FALSE;
END;
INC(DirEntries);
UNTIL (ExNext(lock,fib^)=FALSE) OR (DirEntries > MaxFiles) OR (IntRead);
IF IntRead THEN
ReplaceRSDM(msg,"READ interrupt!")
ELSIF (DirEntries > MaxFiles) THEN
ReplaceRSDM(msg,"250 File MAX hit!")
END;
good := TRUE;
DEC(DirEntries);
ELSE
good := FALSE;
END;
FreeMem(fib,TSIZE(FileInfoBlock));
RETURN good;
END ReadDirectory;
(*------------*)
PROCEDURE FirstHigher (VAR lower,upper : ARRAY OF CHAR): BOOLEAN;
(* Compare dirtable entries filename part *)
VAR i : CARDINAL;
BEGIN
FOR i := 0 TO 30 DO
(* Test end-of-string cases *)
IF (upper[i] = 0C) THEN
IF (lower[i] = 0C) THEN RETURN FALSE ELSE RETURN TRUE END
ELSIF (lower[i] = 0C) THEN
RETURN FALSE
END;
(* If here, test character values *)
IF (CAP(lower[i]) > CAP(upper[i])) THEN
RETURN TRUE
ELSIF (CAP(lower[i]) < CAP(upper[i])) THEN
RETURN FALSE
END;
END;
RETURN FALSE;
END FirstHigher;
PROCEDURE QSort;
VAR i,j : CARDINAL; Swap : BOOLEAN;
(* Sort the directory - DirEntries is top 1 is bottom *)
(* QuickSort recursive calling *)
PROCEDURE Sort(l,r:CARDINAL);
VAR i,j:CARDINAL;
x,w:DirPtr;
BEGIN
i := l; j := r;
x := DirTable[(l + r) DIV 2];
REPEAT
WHILE FirstHigher(x^.FileName,DirTable[i]^.FileName) DO INC(i) END;
WHILE FirstHigher(DirTable[j]^.FileName,x^.FileName) DO DEC(j) END;
IF i <= j THEN
w := DirTable[i];
DirTable[i] := DirTable[j];
DirTable[j] := w;
INC(i);
DEC(j);
END;
UNTIL (i > j);
IF l < j THEN Sort(l,j) END;
IF i < r THEN Sort(i,r) END;
END Sort;
BEGIN
Sort(1,DirEntries);
END QSort;
(*----------*)
PROCEDURE MoveString(VAR tgt,src:ARRAY OF CHAR; po,le:CARDINAL);
(* move max of 'le' chars of src to tgt[po] *)
(* not including ending null *)
VAR s:CARDINAL;
BEGIN
s := 0;
WHILE (s < le) AND (src[s] <> 0C) DO;
tgt[po+s] := src[s];
INC(s);
END;
END MoveString;
PROCEDURE DisplayName(file,pos:CARDINAL);
VAR m,t:CARDINAL;f,b:WBColors;
BEGIN
WITH DirTable[file]^ DO
m := Length(FileName);
IF m>28 THEN m := 28 END;
GPString := " "; (*35char*)
f := Black; b := Blue;
t := (pos * 8) + 16;
IF (file>DirEntries) THEN
b := Black;
ELSIF IsDir THEN
MoveString(GPString,FileName,0,m);
IF IsSelected THEN
b:= Green
ELSE
f := Green; b:= Black;
END;
ELSE
MoveString(GPString,FileName,0,m);
ConvertToString(FileSize,10,FALSE,StrNr,Dun);
m := Length(StrNr);
MoveString(GPString,StrNr,35-m,m);
IF IsSelected THEN
f := Black; b := White
ELSE
f := White; b := Black
END;
END;
WITH FileText DO
FrontPen := BYTE(ORD(f));
BackPen := BYTE(ORD(b));
DrawMode := BYTE(JamTwo);
LeftEdge := 6;
TopEdge := t;
ITextFont := NULL;
IText := ADR(GPString);
NextText := NULL;
END;
PrintIText(MyWindowPtr^.RPort^,FileText,0,0);
END;
END DisplayName;
PROCEDURE DisplayFiles(ind:CARDINAL);
VAR i:CARDINAL;
BEGIN
FOR i := 1 TO MaxScreenFiles DO DisplayName(i+ind-1,i) END;
ShowMem;
END DisplayFiles;
PROCEDURE NewDir;
VAR Vbod : CARDINAL;
(* Display a new directory *)
BEGIN
Vbod := 0FFFFH;
IF DirEntries > MaxScreenFiles THEN
Vbod := 0FFFFH DIV DirEntries;
Vbod := Vbod * MaxScreenFiles;
END;
ResetSlider(Vbod);
DisplayFiles(1);
END NewDir;
PROCEDURE ClearTable;
VAR i:CARDINAL;
BEGIN
FOR i := 0 TO MaxFiles DO
FreeMem(DirTable[i],TSIZE(DirInfo));
END;
END ClearTable;
BEGIN
MaxFiles := 0;
REPEAT
DirTable[MaxFiles] := AllocMem(TSIZE(DirInfo),MemReqSet{MemPublic,MemClear});
INC(MaxFiles);
UNTIL (MaxFiles > MaxMax) OR (DirTable[MaxFiles-1] = NULL);
DEC(MaxFiles);
END MyMisc.