home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 037.lha / DU / MyType.mod < prev    next >
Text File  |  1987-05-16  |  8KB  |  305 lines
  1. IMPLEMENTATION MODULE MyType;
  2.  
  3. (*$S-*)(*$T-*)(*$A+*)
  4.  
  5. (*
  6.      Written by Greg Browne from ideas in duIII.c - many thanks to
  7.      Chris Nicotra, Dave Jobusch, Ed Alford, and many others whose
  8.      names I have not seen on the source files who have worked on
  9.      the development and extension of that fine directory utility program.
  10.  
  11.    PURPOSE      A self-contained, IMPORTable pair of procedures to allow
  12.                 a screen display - or printer copy - in Hex or ASCII of
  13.                 any disk files.
  14.  
  15.    CHANGES      1/24/87         Built original.
  16.                 4/25/87         Added Backspace for Restart option
  17.  
  18. *)
  19.  
  20. FROM SYSTEM             IMPORT  ADR,ADDRESS,CODE;
  21. FROM Strings            IMPORT  InitStringModule,Concat,Assign;
  22. FROM DOSFiles           IMPORT  FileHandle,ModeOldFile,ModeNewFile,Close,
  23.                                 Open,Read,Write,Lock,Unlock,AccessRead,
  24.                                 FileLock;
  25. FROM DOSLibrary         IMPORT  DOSName,DOSBase;
  26. FROM Libraries          IMPORT  OpenLibrary,CloseLibrary;
  27.  
  28. (*COMMENTS*)
  29.  
  30. (* This module tries to open the DOSLibrary for use in case it is not open.
  31.    IT DOES NOT CLOSE IT.  The user is left with that chore.             *)
  32.  
  33. (* All constants and variables are internal.  Nothing but PROCEDURES
  34.    are available to the user.                                           *)
  35.  
  36.  
  37. CONST
  38.  dot = ".";
  39.  
  40.  
  41.  
  42.  
  43. VAR
  44.   HexCh         : ARRAY [0..16] OF CHAR;
  45.   Diskhandle,
  46.   Displayhandle : FileHandle;
  47.   fp            : ARRAY[0..3] OF CARDINAL;
  48.   c             : CHAR;
  49.   len,len2,
  50.   i,
  51.   top,
  52.   linecount,
  53.   nextout       : CARDINAL;
  54.   Result        : LONGINT;
  55.   OnScreen,
  56.   Quit          : BOOLEAN;
  57.   t2            : ARRAY[1..20] OF CHAR;
  58.   iobuffer      : ARRAY[0..512] OF CHAR;
  59.   nam           : ARRAY[0..60] OF CHAR;
  60.   pfeed         : CHAR;
  61.   Hbuf          : ARRAY[0..1] OF CHAR;
  62.  
  63. (* INTERNAL PROCEDURES - NOT IN .def FILE AND NOT IMPORTABLE *)
  64.  
  65. (* Following are CODE equivalents of pause messages.  Done this way
  66.    to save space over variables and allow static inclusion of <ESC>
  67.    which a constant won't do.
  68. *)
  69.  
  70. (*$P-*)
  71. PROCEDURE expl;
  72. BEGIN
  73.   CODE(1B5BH,3333H,6D3CH,4253H,3E1BH,5B32H,6D3DH,7265H);
  74.   CODE(7769H,6E64H,201BH,5B33H,336DH,3C43H,523EH,1B5BH);
  75.   CODE(326DH,3D6CH,696EH,6520H,1B5BH,3333H,6D3CH,5350H);
  76.   CODE(4143H,453EH,1B5BH,326DH,3D70H,6167H,6520H,1B5BH);
  77.   CODE(3333H,6D3CH,4553H,433EH,1B5BH,326DH,3D61H,626FH);
  78.   CODE(7274H,201BH,5B30H,6D00H);
  79. END expl;
  80. (* above is code for this with added color change stuff *)
  81. (*  <BS>=rewind <CR>=line <SPACE>=page <ESC>=abort ";  LENGTH = 87*)
  82.  
  83. (*$P-*)
  84. PROCEDURE wipe;
  85. BEGIN
  86.   CODE(0D20H);
  87.   CODE(2020H,2020H,2020H,2020H,2020H,2020H,2020H,2020H);
  88.   CODE(2020H,2020H,2020H,2020H,2020H,2020H,2020H,2020H);
  89.   CODE(2020H,2020H,2020H,2020H,2020H,2020H,2020H,2020H);
  90.   CODE(2020H,2020H,2020H,2020H,2020H,2020H,2020H,2020H);
  91.   CODE(2020H,0D00H);
  92. END wipe;
  93. (* above is code for <CR> + 67 spaces + <CR>  LENGTH = 69*)
  94.  
  95. (*$P-*)
  96. PROCEDURE last;
  97. BEGIN
  98.   CODE(1B5BH,3333H,6D44H,6F6EH,6521H,2050H);
  99.   CODE(7265H,7373H,203CH,5350H,4143H,453EH);
  100.   CODE(201BH,5B30H,6D00H);
  101. END last;
  102.  
  103. (* above is code for this with color changes *)
  104. (* Done! Press <SPACE> LENGTH = 29           *)
  105.  
  106. (*$P+ *)
  107.  
  108. PROCEDURE MyOpen(VAR ufn:ARRAY OF CHAR):BOOLEAN;
  109. VAR i:CARDINAL;lk:FileLock;
  110. BEGIN
  111.   Assign(nam,ufn);
  112.   linecount := 0;
  113.   Quit := FALSE;
  114.   Diskhandle := Open(ufn,ModeOldFile);
  115.   IF Diskhandle = 0 THEN
  116.     RETURN FALSE
  117.   ELSE
  118.     IF OnScreen THEN
  119.       Concat("RAW:0/0/640/200/Listing of: ",nam,iobuffer);
  120.     ELSE
  121.       iobuffer := "PRT:"
  122.     END;
  123.     Displayhandle := Open(iobuffer,ModeNewFile);
  124.     IF Displayhandle = 0 THEN
  125.       Close(Diskhandle);              (* if here - Disk is open *)
  126.       RETURN FALSE
  127.     ELSE
  128.       Quit := FALSE;
  129.       RETURN TRUE
  130.     END
  131.   END
  132. END MyOpen;
  133.  
  134. (* read (with wait) single character from 'f' (here it is keyboard) *)
  135.  
  136. PROCEDURE ReadChar(f:FileHandle;VAR c:CHAR);
  137. BEGIN
  138.   Result := Read(f,ADR(c),1);
  139.   IF Result < 1 THEN c := 0C END
  140. END ReadChar;
  141.  
  142. (* Press Space message and wait for continue-nextline-cancel *)
  143.  
  144. PROCEDURE Pause;
  145. BEGIN
  146.   IF OnScreen THEN
  147.     linecount := 1;
  148.     Result := Write(Displayhandle,ADDRESS(expl),LONGCARD(87));
  149.     REPEAT
  150.       ReadChar(Displayhandle,c);
  151.       IF c = CHR(27) THEN
  152.         Quit := TRUE;
  153.       ELSIF c = CHR(13) THEN
  154.         linecount := 21
  155.       ELSIF (c = 10C) THEN
  156.         Close(Diskhandle);
  157.         Diskhandle := Open(nam,ModeOldFile);
  158.         len2 := 1000;
  159.       END
  160.     UNTIL (Quit) OR (c = 15C) OR (c = 40C) OR (c = 10C);
  161.     Result :=Write(Displayhandle,ADDRESS(wipe),LONGCARD(69));
  162.   END;
  163. END Pause;
  164.  
  165. (* End - press space message & wait for space *)
  166.  
  167. PROCEDURE Finish;
  168.   BEGIN
  169.     IF OnScreen THEN
  170.       Result := Write(Displayhandle,ADDRESS(last),LONGCARD(29));
  171.       REPEAT ReadChar(Displayhandle,c) UNTIL (c = 40C);
  172.     ELSE
  173.       Result := Write(Displayhandle,ADR(pfeed),LONGCARD(1))
  174.     END;
  175.   END Finish;
  176.  
  177. (* Closes the disk file and screen (or printer) - NOT DOS Library *)
  178.  
  179. PROCEDURE CloseTheFile;
  180. BEGIN
  181.   IF (Displayhandle <> 0) THEN Close(Displayhandle) END;
  182.   IF (Diskhandle <> 0) THEN Close(Diskhandle) END;
  183. END CloseTheFile;
  184.  
  185. (* internal procedure for the HexDisplay                                *)
  186. (* Converts a character to a 3 byte (null terminated 3d byte) string    *)
  187. (*  in hex format with leading '0'                                      *)
  188.  
  189. PROCEDURE ToHex(c:CHAR);
  190. VAR v:CARDINAL;
  191. BEGIN
  192.   v := CARDINAL(ORD(c));
  193.   Hbuf[0] := HexCh[v DIV 16];
  194.   Hbuf[1] := HexCh[v MOD 16];
  195. END ToHex;
  196.  
  197. (* kludge to quickly convert a 4 byte (artificial LONGCARD) thingy into
  198.    an increasing file position - used 4 byte since very big files should
  199.    really be taken into account - as if anyone is going to dump a file
  200.    that long - oh, well, it will address it properly if they do         *)
  201.  
  202. PROCEDURE MakeHexAddr;
  203.  
  204. VAR i,j:CARDINAL;
  205. BEGIN
  206.   j := 7;
  207.   FOR i := 0 TO 3 DO
  208.     ToHex(CHR(fp[i]));
  209.     iobuffer[j] := Hbuf[1];iobuffer[j-1] := Hbuf[0];
  210.     DEC(j,2);
  211.   END;
  212.   INC(fp[0],16);
  213.   FOR i := 0 TO 2 DO
  214.     IF fp[i] = 256 THEN INC(fp[i+1]); fp[i] := 0 END;
  215.   END;
  216.   IF fp[3] = 256 THEN fp[i] := 0 END;
  217. END MakeHexAddr;
  218.  
  219. (* FINALLY THE FIRST IMPORTABLE PROCEDURE       *)
  220. (* SET ToScreen FALSE to go to PRT: device      *)
  221.  
  222. PROCEDURE DisplayASCII(VAR filnam:ARRAY OF CHAR;ToScreen:BOOLEAN);
  223. BEGIN
  224.   OnScreen := ToScreen;
  225.   IF MyOpen(filnam) THEN
  226.     REPEAT
  227.       len := CARDINAL(Read(Diskhandle,ADR(iobuffer),512));
  228.       len2 := 0;
  229.       WHILE (NOT Quit) AND (len2 < len) DO
  230.         i := len2;
  231.         WHILE (i < 511) AND (iobuffer[i] <> 12C) DO INC(i) END;
  232.         Result := Write(Displayhandle,ADR(iobuffer[len2]),LONGCARD(i-len2+1));
  233.         len2 := i + 1;
  234.         INC(linecount);
  235.         IF (linecount > 21) AND (iobuffer[i] = 12C) THEN Pause END;
  236.       END;
  237.     UNTIL (len <> 512) OR (Quit);
  238.     Finish;
  239.   END;  (* IF NOT Quit *)
  240.   CloseTheFile;
  241. END DisplayASCII;
  242.  
  243.  
  244. PROCEDURE DisplayHex(VAR filnam:ARRAY OF CHAR;ToScreen:BOOLEAN);
  245. VAR ad:ARRAY[0..7] OF CHAR;
  246. BEGIN
  247.   OnScreen := ToScreen;
  248.   IF MyOpen(filnam) THEN
  249.     FOR i := 0 TO 3 DO fp[i] := 0 END;
  250.     REPEAT
  251.       FOR i := 0 TO 70 DO iobuffer[i] := 40C END;
  252.       top := CARDINAL(Read(Diskhandle,ADR(t2),16));
  253.       nextout := 10;
  254.       IF top > 0 THEN
  255.         FOR i := 1 TO top DO
  256.           ToHex(t2[i]);
  257.           iobuffer[nextout] := Hbuf[0];
  258.           iobuffer[nextout+1] := Hbuf[1];
  259.           INC(nextout,2);
  260.           IF (i MOD 4)=0 THEN INC(nextout) END;
  261.         END;
  262.         nextout := 48;  (* 39 IF i MOD 8 is left in *)
  263.         FOR i := 1 TO top DO
  264.           IF (t2[i]>177C) OR (t2[i]<40C) THEN
  265.             iobuffer[nextout] := dot
  266.           ELSE
  267.             iobuffer[nextout] := t2[i]
  268.           END;
  269.           INC(nextout);
  270.         END;
  271.         iobuffer[69] := 12C;
  272.         iobuffer[70] := 0C;
  273.         MakeHexAddr;
  274.         Result := Write(Displayhandle,ADR(iobuffer),70);
  275.         INC(linecount);
  276.         IF (linecount > 21) THEN
  277.           Pause;
  278.           IF (c = 10C) THEN
  279.             FOR i := 0 TO 3 DO
  280.               fp[i] := 0
  281.             END
  282.           END;
  283.         END;
  284.       END; (* IF top > 0 *)
  285.     UNTIL (top < 16) OR (Quit);
  286.     Finish
  287.   END;
  288.   CloseTheFile
  289. END DisplayHex;
  290.  
  291.  
  292. (* Initialization items *)
  293.  
  294.  
  295. BEGIN
  296.  
  297.   IF DOSBase = 0 THEN DOSBase := OpenLibrary(DOSName,0) END;
  298.  
  299.   InitStringModule;
  300.  
  301.   HexCh  := "0123456789ABCDEF";
  302.   pfeed  := 14C;
  303.  
  304. END MyType.
  305.