The ModulAtor

Ublantis' 1st Independent Oberon & Modula-2 Technical Publication

Nr. 94, Oct-2015

ModulaTor logo, 7.8KB

R. Singer, G. Dotzel: WildFiles - The Final Wildcard Directory Walker in Modula-2 for DEC PDP-11/RT-11

Copyright © (2015) by Guenter Dotzel, modulAware.com

More information on Modula-2 for DEC PDP-11/RT-11 and SharePlus, see history.

WildFiles - The Final Wildcard Directory Walker was used in SilList* only.

DEFINITION MODULE WildFiles;
(*
   alpha = 'A' | .. | 'Z' | 'a' | .. | 'z' | '0' | .. | '9' .
   wild = '*'.
   singlewild = '%'.
   leftB = '('.
   rightB = ')'.
   seperator = ','.
   devsign = ':'.
   extsign = '.'.

   wildalpha = alpha | wild | singlewild.

   brackets = leftB alpha {alpha} { ',' alpha {alpha} } rightB.
   wildbrackets =
       leftB wildalpha {wildalpha} { seperator wildalpha {wildalpha} } rightB.

   expression = {alpha {alpha} [brackets] | {alpha} brackets }.
   wildexpression =
       {wildalpha {wildalpha} [wildbrackets] | {wildalpha} wildbrackets }.

   device = expression devsign.
   name = wildexpression
   ext = extsign wildexpression.

   wildcard = [ device ] [ name ] [ ext ].

 Legal wildstring formats:
   wildcard { seperator wildcard }.

   Examples of valid wildstrings:

   DU1:   
   .COM   
         gives all .COM files in all .DSK files of DU1:

   DU(0,1):  for devices DU0, DU1
   DEMO(A,B).D%% 
         gives all DEMOA.D%% and DEMOB.D%% files in all .DSK files
         of DU0: and DU1:

   DEMO*.(DEF,MOD),.(SAV,SYS,SYG) 
         gives all DEMO*.MOD and DEMO*.DEF and .SAV and
         and .SYS and .SYG files of DK:

   D(A,B,C)(A,B).*(A,B,C)*,DEMO2.MO(D,B) 
         gives all DAA and DAB and DBA and DBB and DCA and DCB files
         each with extension *A* or *B* or *C*
         and all DEMO2.MOB and DEMO2.MOD files of DK:

   D(U,Y)(0,1):  for devices DU0, DU1, DY0, DY1
     same as
   DU(0,1),DY(0,1):  for devices DU0, DU1, DY0, DY1

   Semantics of the wildcard specification: see RT-11 Directory command.
   Works only with standard RT11A directories.
   Doesn't work currently with the VM device of SHAREplus.
*)
FROM WildCards IMPORT FileName, Ext; IMPORT WildCards;
CONST maxWildLen = 79;
TYPE WILDSTRING = ARRAY [0..maxWildLen-1] OF CHAR;
  Time = WildCards.Time;
PROCEDURE WildFilesInit (Wildcard: WILDSTRING; DefExt: Ext;
  VAR OK: BOOLEAN);
PROCEDURE GetNextFileName (VAR fn: ARRAY OF CHAR; VAR Size: CARDINAL;
  VAR Protected: BOOLEAN; VAR Date: Time; VAR found: BOOLEAN);
PROCEDURE Close;
END WildFiles.

IMPLEMENTATION MODULE WildFiles; (* > > (c) Copyright (1986) by Gunter Dotzel, ModulaWare.com > *) FROM WildCards IMPORT FWILD, FNEXT, FCLOSE, Name, Ext, FileName, Time, WildCard; FROM ASCII IMPORT ESC, NUL, BS; CONST maxPartLen = 6; NILL = maxWildLen + 1; emptyFile = " "; maxPuffLen = 20; DevLen = 2; maxDevExpansion = 9; TYPE PartType = (nil,dev,nam,ext); Dev = ARRAY[0..DevLen] OF CHAR; VAR WildString: WILDSTRING; z, nf, nbl: CARDINAL; ok: BOOLEAN; ch: CHAR; DevExpFiles: ARRAY[0..maxDevExpansion] OF FileName; NWild, NDevExp: CARDINAL; Mixed: BOOLEAN; Wild: ARRAY[0..maxPuffLen-1] OF WildCard; DevPuff: ARRAY[0..maxPuffLen-1] OF Dev; DCount: CARDINAL; DefaultExt: Ext; PROCEDURE Length (s: ARRAY OF CHAR): CARDINAL; VAR j: CARDINAL; BEGIN j := 0; WHILE (j <= HIGH (s)) & (s[j] # 0C) DO INC (j); END; RETURN j; END Length; PROCEDURE GetWildList (VAR W: ARRAY OF CHAR; VAR Wild: ARRAY OF WildCard; VAR NWild: CARDINAL; ext: Ext); VAR i, j, NCount, ECount: CARDINAL; ExtPuff: ARRAY[0..maxPuffLen-1] OF Ext; NamPuff: ARRAY[0..maxPuffLen-1] OF Name; PROCEDURE GetFName (VAR WildString: ARRAY OF CHAR; VAR ok: BOOLEAN); TYPE PS = ARRAY[0..maxPartLen-1] OF CHAR; VAR OPCount, NPCount, len, i: CARDINAL; Del: CHAR; LastType: PartType; Brack: BOOLEAN; OPartPuff, NPartPuff: ARRAY[0..maxPuffLen-1] OF PS; PartString: PS; PROCEDURE Copy (VAR s: ARRAY OF CHAR; ss: ARRAY OF CHAR); VAR i: CARDINAL; BEGIN i := 0; WHILE (i <= HIGH(ss)) & (i <= HIGH(s)) & (ss[i]#NUL) DO s[i] := ss[i]; INC(i); END; IF i <= HIGH(s) THEN s[i] := NUL; ELSIF (i <= HIGH (ss)) & (ss[i] # NUL) THEN ok := FALSE; END; END Copy; PROCEDURE Concat (s1,s2: ARRAY OF CHAR; VAR ss: ARRAY OF CHAR); VAR i, k: CARDINAL; BEGIN i := 0; WHILE (i <= HIGH (s1)) & (s1[i] # NUL) DO ss[i] := s1[i]; INC (i); END; k := i; IF i > HIGH (s1) THEN ok := FALSE; ELSE WHILE (i <= HIGH (s1)) & (s2[i-k] # NUL) DO ss[i] := s2[i-k]; INC (i); END; IF (i > HIGH (s1)) & (s2[i-k] # NUL) THEN ok := FALSE; ELSIF i <= HIGH (ss) THEN ss[i] := NUL; END; END; END Concat; PROCEDURE Insert (VAR s: PS; VAR ok: BOOLEAN); VAR str: ARRAY[0..maxPartLen-1] OF CHAR; BEGIN IF Brack THEN IF Length (s) = 0 THEN s[0] := '*'; s[1] := NUL; END; IF OPCount = 0 THEN NPartPuff[NPCount] := s; INC (NPCount); ELSE i := 0; WHILE i < OPCount DO Concat (OPartPuff[i], s, str); IF ok THEN Copy (NPartPuff[NPCount], str); INC (NPCount); END; INC (i); END; END; ELSE IF Length (s) > 0 THEN IF OPCount = 0 THEN OPartPuff[OPCount] := s; INC (OPCount); ELSE i := 0; WHILE i < OPCount DO Concat (OPartPuff[i], s, str); IF ok THEN Copy (OPartPuff[i], str); END; INC (i); END; END; END; END; END Insert; PROCEDURE Scan (VAR str, s: ARRAY OF CHAR; VAR sc: CHAR; VAR len: CARDINAL); VAR j: CARDINAL; BEGIN len := 0; s[0] := NUL; LOOP IF len > (HIGH (s)+1) THEN len := NILL; EXIT; END; IF (str[len] = ':') OR (str[len] = '.') OR (str[len] = NUL) OR (str[len] = ',') OR (str[len] = '(') OR (str[len] = ')') THEN j := 0; WHILE j < len DO s[j] := str[j]; INC (j); END; IF j <= HIGH (s) THEN s[j] := NUL; END; sc := str[j]; INC (j); IF sc = NUL THEN str[j] := NUL; END; WHILE (j <= HIGH (str)) & (str[j] # NUL) DO str[j-len-1] := str[j]; INC (j); END; str[j-len-1] := NUL; EXIT; ELSE INC (len); END; END; END Scan; BEGIN LastType := nil; OPCount := 0; Brack := FALSE; ok := TRUE; LOOP IF NOT ok THEN EXIT; END; Scan (WildString, PartString, Del, len); IF len = NILL THEN ok := FALSE; EXIT; END; CASE Del OF ',': Insert (PartString, ok); IF NOT Brack THEN CASE LastType OF nil, dev: i:= 0; WHILE i < OPCount DO Copy (NamPuff[i], OPartPuff[i]); INC (NCount); INC (i); END; |nam: i:= 0; WHILE i < OPCount DO Copy (ExtPuff[i], OPartPuff[i]); INC (ECount); INC (i); END; ELSE ok := FALSE; END; EXIT; END; |'(': IF Brack THEN ok := FALSE; EXIT; ELSE Insert (PartString, ok); Brack := TRUE; NPCount := 0; END; |NUL: Insert (PartString, ok); IF Brack THEN OPartPuff := NPartPuff; OPCount := NPCount; END; IF ok THEN CASE LastType OF nil, dev: i:= 0; WHILE i < OPCount DO Copy (NamPuff[i], OPartPuff[i]); INC (NCount); INC (i); END; |nam: i:= 0; WHILE i < OPCount DO Copy (ExtPuff[i], OPartPuff[i]); INC (ECount); INC (i); END; ELSE ok := FALSE; END; END; EXIT; |')': IF Brack THEN Insert (PartString, ok); Brack := FALSE; OPartPuff := NPartPuff; OPCount := NPCount; ELSE ok := FALSE; EXIT; END; |'.': IF Brack OR (LastType > dev) THEN ok := FALSE; EXIT; ELSE Insert (PartString, ok); IF ok THEN LastType := nam; i := 0; WHILE i < OPCount DO Copy (NamPuff[i], OPartPuff[i]); INC (NCount); INC (i); END; OPCount := 0; ELSE EXIT; END; END; |':': IF Brack OR (LastType > nil) THEN ok := FALSE; EXIT; ELSE Insert (PartString, ok); IF ok THEN LastType := dev; i := 0; WHILE i < OPCount DO Copy (DevPuff[i], OPartPuff[i]); INC (DCount); INC (i); END; OPCount := 0; ELSE EXIT; END; END; END;(*CASE*) END;(*LOOP*) END GetFName; BEGIN DCount := 0; NCount := 0; ECount := 0; GetFName (W, ok); IF ok THEN IF DCount = 0 THEN DevPuff[DCount] := 'DK '; INC (DCount); ELSIF Mixed THEN Mixed := FALSE; DevPuff[0] := 'DK '; DCount := 1; END; IF NCount = 0 THEN NamPuff[NCount,0] := '*'; NamPuff[NCount,1] := NUL; INC (NCount); END; IF ECount = 0 THEN ExtPuff[ECount] := ext; INC (ECount); END; i := 0; WHILE i < NCount DO j := 0; WHILE j < ECount DO WITH Wild[NWild] DO n := NamPuff[i]; e := ExtPuff[j]; END; INC (j); INC (NWild); END; INC (i); END; END; END GetWildList; PROCEDURE NextWild (VAR W: WILDSTRING); VAR OWild, f, b: CARDINAL; OW: WILDSTRING; BEGIN INC (z); FCLOSE (f,b); IF z < NDevExp THEN FWILD (DevExpFiles[z], NWild, Wild, ok); ELSE Init (W, ok); END; END NextWild; PROCEDURE Init (VAR W: WILDSTRING; VAR ok: BOOLEAN); VAR OWild, f, b: CARDINAL; OW: WILDSTRING; BEGIN NWild := 0; IF Mixed THEN REPEAT OW := W; OWild := NWild; GetWildList (W, Wild, NWild, DefaultExt); IF NOT ok THEN RETURN; END; UNTIL (Length (W) = 0) OR (NOT Mixed); IF NOT Mixed THEN NWild := OWild; W := OW; IF NWild = 0 THEN GetWildList (W, Wild, NWild, DefaultExt); IF NOT ok THEN RETURN; END; END; END; ELSE GetWildList (W, Wild, NWild, DefaultExt); IF NOT ok THEN RETURN; END; END; NDevExp := 0; WHILE NDevExp < DCount DO DevExpFiles[NDevExp] := emptyFile; z := 0; WHILE (z <= DevLen) & (DevPuff[NDevExp,z] # NUL) DO DevExpFiles[NDevExp,z] := DevPuff[NDevExp,z]; INC (z); END; INC (NDevExp); END; z := 0; FWILD (DevExpFiles[z], NWild, Wild, ok); END Init; PROCEDURE WildFilesInit (Wildcard: WILDSTRING; DefExt: Ext; VAR OK: BOOLEAN); BEGIN OK := TRUE ; END WildFilesInit; PROCEDURE GetNextFileName (VAR fn: ARRAY OF CHAR; VAR b: CARDINAL; VAR prot: BOOLEAN; VAR t: Time; VAR found: BOOLEAN); BEGIN found:=FALSE; END GetNextFileName; PROCEDURE Close; VAR a,b: CARDINAL; BEGIN FCLOSE(a,b); WildString[0] := NUL; z := NDevExp; END Close; END WildFiles.

Notes:
*) SilList is a tool that draws thumbnails of SIL (Simple Illustrator) files on a hardware specific graphics display. Wildcards determine which files are included in the thumbnail overview.

Optionally SilList (like SIL) also generates a PostScript (PS) via module SilDraw which calls the corresponding SilPostScript procedures which emits PS, for example:


MODULE SilDraw;
...
 PROCEDURE PaintVector (k, x, y, w, h: INTEGER);

 CONST all={0..15};
 BEGIN 
   IF PS THEN SilPostScript.PaintVector(I(objectcolor),x,y,w,h);END;
   ...

END SilDraw.

MODULE SilPostScript;
...
  PROCEDURE W(ch:CHAR);
  BEGIN
    WriteChar(f,ch);
  END W;

  PROCEDURE P(s:ARRAY OF CHAR);
  BEGIN
    UnivOutput.WriteString(W,s);
  END P;

  PROCEDURE N(s:ARRAY OF CHAR);
  BEGIN
    UnivOutput.WriteString(W,s);Writeln(W);
  END N;

  PROCEDURE PaintRectangle (k, x, y, w, h: INTEGER);
  BEGIN 
    IF (w > 0) & (h > 0) THEN
      WriteInt (W,k,0);
      P(' 0 ');WriteInt (W,-h,0); W(' ');
      WriteInt (W,w,0); P(' 0 0 '); WriteInt (W,h,0); W(' ');
      WriteInt (W,x,0); W(' '); WriteInt (W,y,0); N(' R');
    END;
  END PaintRectangle;
...
END SilPostScript.

The PS function R, whose call is emitted in N(' R'), uses PS function SG:
  N('/SG {2 idiv 7 exch sub 7 div setgray} def %-setgray-');
and assumes gray value and four coordinate pairs on stack:
  N('/R {moveto rlineto rlineto rlineto closepath SG fill} def %-rectangle-');
Thus if dummy display implementation modules are used in SilDraw, the visualized PS (or converted PDF) file can instead replace the display.
(Last revised 27-Oct-2015)
IMPRESSUM: The ModulAtor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements; all source code is experimental — use at your own risk. Articles are published at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. You're welcome to submit articles for publication by writing to the Editor

ModulaWare.com website navigator

[ Home | Site_index | Contact | Legal | OpenVMS_compiler | Alpha_Oberon_System | ModulAtor | Bibliography | Oberon[-2]_links | Modula-2_links | modulAware.com's Alpha Oberon System home page (Alignment Trap) | General book recommendations ]

Copyright © (2002-2016) by modulAware.com