(**********************************************************************

:Program.    SimpleType
:Contens.    Ein Textanzeigeprogramm mit Hilfe des Moduls NewInOut
:Author.     Bernd Braun
:Address.    Lippestr. 11, D-3300 Braunschweig
:Phone.      0531/845498
:Copyright.  Public Domain
:Language.   Modula-2
:Translator. M2Amiga A+L V3.3d
:Imports.    NewInOut
:History.    V1.0 8.Jul.1989 Amiga-DOS Version
:History.    V1.1 8.Nov.1989 Angepasst an NewInOut

***********************************************************************)

(* $R- $V- $S- $F- *) (* Programm läuft bisher ohne Fehler. *)

MODULE More; 

   FROM Arguments IMPORT 
      NumArgs, GetArg;
   FROM NewInOut IMPORT 
      FILE, Open, ReadFile, WriteFile, Close, WriteStringFile, done, 
      WriteString, ModeNew, ModeOld, WriteLn, eol, WriteHexFile;
   FROM ASCII IMPORT
      cr, esc, eof;

   CONST 
      len        = 80;
      maxline    = 25;
      hexperline = 16;

   VAR 
      Datei, Flagge, Raw : ARRAY [ 1 .. len ] OF CHAR;
      Parameter          : CARDINAL;
      arglen             : INTEGER;
      c                  : CHAR;
      infile, outfile    : FILE;
      asciimode, hexmode : BOOLEAN;
       
   PROCEDURE Gebrauch;
   BEGIN
      WriteString ( 'More (C) 1990 by Bernd Braun' ); 
      WriteLn; WriteLn;
      WriteString ( 'Aufruf vom CLI:' );              WriteLn;
      WriteString ( '   More Datei [ a | b ]' );      WriteLn;
      WriteString ( '   Option a : Ascii Modus für Binärfiles erzwingen.' ); 
      WriteLn;
      WriteString ( '          h : Hex Modus für Textfiles erzwingen.' ); 
      WriteLn; WriteLn;
      WriteString ( 'Aufruf von Workbench:' );        WriteLn;
      WriteString ( '   More - Icon anklicken, dann Shift - Taste' );
      WriteLn;
      WriteString ( '   drücken und gleichzeitig zweimal das ');
      WriteLn;
      WriteString ( '   Datei - Icon anklicken. ');
      WriteLn;
   END Gebrauch;

   PROCEDURE CloseAll;
   BEGIN
      IF infile # NIL THEN
         Close ( infile );
      END;
      IF outfile # NIL THEN
         Close ( outfile );
      END;
   END CloseAll;

   (* Auf nächsten Tastendruck warten. *)
   PROCEDURE WarteORQuit ( warte : BOOLEAN ) : BOOLEAN;
      VAR
         inchar : CHAR;
   BEGIN
      WriteFile ( outfile, eol );
      WriteFile ( outfile, esc );
      WriteStringFile ( outfile, '[3m' );
      IF warte THEN
         WriteStringFile 
         ( outfile, 'Press any Key for more. q for quit. ' );
      ELSE
         WriteStringFile 
         ( outfile, 'End of File. Press any Key for quit.' );
      END;
      WriteFile ( outfile, esc );
      WriteStringFile ( outfile, '[0m' );
      ReadFile ( outfile, inchar );
      WriteFile ( outfile, cr );
      WriteStringFile 
         ( outfile, '                                    ' );
      WriteFile ( outfile, cr );
      IF inchar = 'q' THEN
         RETURN TRUE;
      ELSE
         RETURN FALSE;
      END;
   END WarteORQuit;

   (* Hexadezimale Ausgabe der Datei. *)
   PROCEDURE HexPrint;
      VAR
         Puffer  : ARRAY [ 0 .. hexperline - 1 ] OF CHAR;
         Ptr, n  : CARDINAL;
         Adr     : LONGCARD;
         schluss : BOOLEAN;
   BEGIN
      Adr := 0;
      REPEAT
         Ptr := 0;
         REPEAT
            ReadFile ( infile, c );
            Puffer [ Ptr ] := c;
            INC ( Ptr );
         UNTIL NOT done OR ( Ptr >= hexperline  );
         schluss := NOT done;
         (* done zwischenspeichern. *)
         WriteHexFile ( outfile, Adr, 6 );
         WriteStringFile ( outfile, ": " );
         FOR n := 0 TO Ptr - 1 DO
            WriteHexFile ( outfile, CARDINAL ( Puffer [ n ] ), 2 );
            WriteFile    ( outfile, ' ' );
         END;
         FOR n := 0 TO Ptr - 1 DO
            c := Puffer [ n ];
            IF ( c >= ' ' ) AND ( c <= '~' ) OR
               ( c >= 240C) AND ( c <= 377C) THEN
               (* alle druckbaren Zeichen anzeigen. *)
               WriteFile ( outfile, c );
            ELSE
               WriteFile ( outfile, '.' );
            END;
         END;
         INC ( Adr, hexperline );
         IF Adr MOD ( maxline * hexperline ) = 0 THEN
            IF WarteORQuit ( TRUE ) THEN
               CloseAll;
               RETURN;
            END;
         ELSE
            WriteFile ( outfile, eol );
         END;
      UNTIL schluss;
      IF WarteORQuit ( FALSE ) THEN END;
   END HexPrint;

   (* Datei normal anzeigen. *)
   PROCEDURE AsciiPrint;
      VAR
         NewLine : CARDINAL;
   BEGIN
      NewLine := 0;
      REPEAT
         ReadFile ( infile, c );
         IF c = eol THEN
            INC ( NewLine );
            IF NewLine MOD maxline = 0 THEN
               NewLine := 0;
               IF WarteORQuit ( TRUE ) THEN
                  CloseAll;
                  RETURN;
               END;
            ELSE
               WriteFile ( outfile, c );
            END;
         ELSIF ( c >= ' ' ) AND ( c <= '~' ) OR
            ( c >= 240C) AND ( c <= 377C) THEN
            (* alle druckbaren Zeichen anzeigen. *)
            WriteFile ( outfile, c );
         END;
      UNTIL NOT done;
      IF WarteORQuit ( FALSE ) THEN END;
   END AsciiPrint;

BEGIN
   Raw := "raw:0/0/640/256/More (C) 1990 by Bernd Braun";
   asciimode := FALSE;
   hexmode   := FALSE;
   Parameter := NumArgs();
   IF Parameter < 1 THEN
      Gebrauch;
   ELSE
      GetArg ( 1, Datei, arglen);
      IF Datei [ 1 ] = '?' THEN
         Gebrauch;
      ELSE
         IF Parameter = 2 THEN
            GetArg ( 2, Flagge, arglen );
            c := Flagge [ 1 ];
            IF c = 'a' THEN
               asciimode := TRUE;
            ELSIF c = 'h' THEN
               hexmode   := TRUE;
            END;
         END;
         infile := Open ( Datei, ModeOld );
         IF NOT done THEN
            WriteString ( 'Kann Datei nicht öffnen!' );
            WriteLn;
         ELSE
            outfile := Open ( Raw, ModeNew );
            IF NOT done THEN
               WriteString ( 'Kann Window nicht öffnen!' );
               WriteLn;
            ELSE
               ReadFile ( infile, c );
               Close ( infile );
               infile := Open ( Datei, ModeOld );
               IF ( c = 0C ) AND NOT asciimode THEN
                  HexPrint;
               ELSIF asciimode THEN
                  AsciiPrint;
               ELSIF hexmode THEN
                  HexPrint;
               ELSE
                  AsciiPrint;
               END;
            END;
         END;
      END;
   END;
   CloseAll;
END More.