CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol022/zptex.pas

Pascal/Delphi Source File | 1984-04-29 | 8.0 KB | 312 lines

(****************************************************************)
(*                                *
 *  PROGRAM TITLE:    Z - P R I N T   T E X T            *
 *                                *
 *  WRITTEN BY:        Raymond E. Penley            *
 *  DATE WRITTEN:    17 NOV 1979                *
 *                                *
 *  PROGRAM SUMMARY:                        *
 *                                *
 * A very simple text formatter program.            *
 *                                *
 * Command Directives:                        *
 *    ^P    New Paragraph.                    *
 *    ^$    End of Text.                    *
 *    ^I    Indent/space.                    *
 *    ^N    New Line but not New Paragraph.            *
 *    ^B    Break/Pause. Continue on any console input.    *
 *                                *
 * NOTE - Command directives may be in either upper or        *
 *      lower case.                        *
 *                                *
 * MODIFICATION RECORD:                        *
 *      1.0    19 Nov 79 Original Program 'PWORD.PAS'        *
 *        An attempt to extract "WORDS" from text        *
 *        and print them.                    *
 *      1.1  25 Nov 79 -Analyze, Bump, ProcessCommand        *
 *         Newline, Page                    *
 *      1.2  26 Nov 79 -From the the Program Text Formatter(1)*
 *        Adjustline, Appendblank, Appendword,        *
 *        Printline, Roomfor, StartParagraph        *
 *      1.3  28 Nov 79                    *
 *        -Added File selection from the console        *
 *      1.4  19 Aug 80 -Slight mods to program.        *
 *        -Rewrote READWORD.                *
 *                                *
 *    (1)PASCAL, An Introduction to                *
 *       Methodical Programming                *
 *       Authors: W.Findlay & D.A. Watt            *)
(****************************************************************)
PROGRAM ZPTEX;
CONST
 MAXLENGTH     = 255;    (* GROSS MAXIMUM LINE LENGTH *)
 MAXWORDLENGTH    = 30;    (* GET THOSE REALLY BIG WORDS *)
 MAXLINEWIDTH    = 80;    (* SET TO VIDEO TERMINAL WIDTH  *)
 MINLINEWIDTH    = 30;    (* It isn't a co-incidence that Max Word Length *)
            (* and Min Line Width are equal.        *)
 SPACE         = ' ';
TYPE
  BYTE = 0..255;    (* POSITIVE SINGLE BYTE INTEGER *)
  STRING14   = PACKED ARRAY [ 1..14 ] OF CHAR;
  STRINGTYPE = RECORD
         LENGTH : 0..MAXLENGTH;
         IMAGE  : PACKED ARRAY [ 1..MAXLENGTH ] OF CHAR
           END;
VAR
  BLANKINDEX    : 0..MAXWORDLENGTH;
  DIRCH        : CHAR;    (* Char to mark a Command *)
  FATALERROR    : BOOLEAN;
  TEXTFILE    : TEXT;
  FILEID    : STRING14;    (* FILE NAME *)
  INDENT    : BYTE;
  LINE        : PACKED ARRAY [ 1..MAXLINEWIDTH ] OF CHAR;
  LINEWIDTH    : BYTE;
  POS        : BYTE; (* GLOBAL INDEXER *)
  POSITION    : 0..MAXLINEWIDTH;
  TAB        : CHAR;    (* ASCII TAB character *)
  WORD        : STRINGTYPE;

    (**************************)

PROCEDURE CLEAR(* OUTPUT *);
VAR
  I: BYTE;
BEGIN
  FOR I:=1 TO 24 DO WRITELN;
END; (* CLEAR *)

PROCEDURE SKIP( LINES : BYTE );
VAR
  I: BYTE;
BEGIN
  FOR I := 1 TO LINES DO WRITELN
END;

PROCEDURE PRINTLINE;
BEGIN
  FOR POS:=1 TO POSITION DO WRITE( LINE[ POS ]);
  WRITELN
END;

PROCEDURE STARTLINE;
BEGIN
  POSITION := 0
END;

PROCEDURE READWORD;
VAR    CH: CHAR;

    PROCEDURE GETC(VAR CH: CHAR);
    BEGIN
      IF NOT EOF(TEXTFILE) THEN
         READ(TEXTFILE, CH);
      (* Classify the character just read *)
      IF CH=TAB THEN CH := SPACE;
      IF EOF(TEXTFILE) THEN
         CH := SPACE;
    END;

(*$C- [Control-C OFF]**********************************)

BEGIN
  CH := SPACE;
  WHILE (NOT EOF(TEXTFILE)) AND (CH=SPACE) DO (* skipblanks *)
    GETC(CH);
  WITH WORD DO BEGIN
    LENGTH := 0;
    WHILE (NOT EOF(TEXTFILE)) AND (CH<>SPACE) DO
      BEGIN (* accept only non space *)
    IF LENGTH < MAXWORDLENGTH THEN
      BEGIN (* store the char *)
        LENGTH := LENGTH + 1;
        IMAGE[ LENGTH ] := CH;
      END;
    GETC(CH);
      END; (* WHILE *)
(**
    WE NOW HAVE ONE "WORD" IN WORD.IMAGE
    WORD.LENGTH IS THE LENGTH OF THIS WORD
**)
   IF LENGTH >= BLANKINDEX THEN
     BLANKINDEX := LENGTH
   ELSE
     REPEAT
       IMAGE[ BLANKINDEX ] := SPACE;
       BLANKINDEX := PRED(BLANKINDEX);
     UNTIL BLANKINDEX=LENGTH;
  END; (* WITH *)
END; (* READWORD *)

PROCEDURE ANALYZE;
VAR
  PAUSE: CHAR;

    PROCEDURE APPENDWORD;
    BEGIN
      FOR POS:=1 TO WORD.LENGTH DO
        BEGIN
          POSITION := POSITION +1;
          LINE[ POSITION ] := WORD.IMAGE[ POS ]
        END
    END;

    PROCEDURE APPENDBLANK;
    BEGIN
      POSITION := POSITION +1;
      LINE[ POSITION ] := SPACE
    END;

    FUNCTION ROOMFOR( NMROFCHARS: INTEGER ): BOOLEAN;
    BEGIN
      ROOMFOR := (POSITION + NMROFCHARS) <= LINEWIDTH
    END;

    PROCEDURE ADJUSTLINE;
    VAR
      EXTRABLANKS,
      NMROFGAPS,
      WIDENING,
      LEFTMOST,
      RIGHTMOST: 0..MAXLINEWIDTH;
    BEGIN
      (*    Make LeftMost the POSition of    *
       *    the LeftMost non:blank        *)
      LEFTMOST := 1;
      WHILE LINE[ LEFTMOST ] = SPACE DO
        LEFTMOST := SUCC(LEFTMOST);
      (*    Make RightMost the POSition of    *
       *    the RightMost non-blank        *)
      RIGHTMOST := POSITION;
      WHILE LINE[ RIGHTMOST ] = SPACE DO
        RIGHTMOST := PRED(RIGHTMOST);
      (*    Make NMROFGAPS the number of inter-word gaps *)
      NMROFGAPS := 0;
      FOR POS := LEFTMOST TO RIGHTMOST DO
        IF (LINE[ POS ] = SPACE) THEN NMROFGAPS := NMROFGAPS +1;
      EXTRABLANKS := LINEWIDTH - RIGHTMOST;
      FOR POS := 1 TO RIGHTMOST DO
        IF (POS > LEFTMOST) AND (LINE[ POS ] = SPACE) THEN
          BEGIN (* this Char is an inter-WORD gap *)
            WIDENING := EXTRABLANKS DIV NMROFGAPS;
            WRITE( SPACE:(WIDENING+1) );
            EXTRABLANKS := EXTRABLANKS - WIDENING;
            NMROFGAPS := NMROFGAPS -1
          END(* If *)
        ELSE
          WRITE( LINE[ POS ] );
      WRITELN
    END; (* ADJUSTLINE *)

    PROCEDURE NEWLINE;
    (*
        Print the current LINE without adjustment and
        move to the next line.
    *)
    BEGIN
      PRINTLINE;
      STARTLINE
    END;

    PROCEDURE STARTPARAGRAPH;
    (*
       Write the current LINE without adjustment
     *)
    BEGIN
      PRINTLINE;
      WRITELN;
      FOR POSITION := 1 TO INDENT DO
        LINE[ POSITION ] := SPACE;
      POSITION := INDENT
    END;

    FUNCTION VALIDCOMMAND( THISCHAR : CHAR ) : BOOLEAN;
    BEGIN
      VALIDCOMMAND :=
         (THISCHAR IN [ '$','p','P','i','I','n','N','b','B' ] )
    END;

    PROCEDURE BUMP;
    BEGIN
      IF (POSITION < LINEWIDTH) THEN
        BEGIN
        POS := 0;
        REPEAT
          POS := POS + 1;
          APPENDBLANK
        UNTIL (POS = INDENT) OR (POSITION = LINEWIDTH);
        END(* IF *)
    END; (* BUMP *)

BEGIN (*** ANALYZE ***)
  (* All Command Directives must start a Word *)
  IF WORD.IMAGE[ 1 ] = DIRCH THEN
    BEGIN
      IF VALIDCOMMAND( WORD.IMAGE[ 2 ] ) THEN
    BEGIN
      CASE WORD.IMAGE[ 2 ] OF
          '$':    FATALERROR := TRUE;(* Force termination *)
          'P','p':    STARTPARAGRAPH;
          'I','i':    BUMP;
          'N','n':    NEWLINE;
          'B','b':    BEGIN
            NEWLINE;
            READLN( PAUSE )
            END
      END (* CASE WORD.IMAGE *)
    END(* IF VALIDCOMMAND *)
    END(* IF *)
  ELSE
    (* Output the WORD followed by a blank, right-adjusting
       the old Line and starting a new line if necessary  *)
    BEGIN
      IF NOT ROOMFOR(WORD.LENGTH) THEN
    BEGIN
      ADJUSTLINE;      (* Right-justify the Current Line *)
      STARTLINE
    END;
     APPENDWORD;
     IF ROOMFOR(1) THEN APPENDBLANK
   END (* ELSE *)
END; (* ANALYZE *)

(*$C+ [Control-C ON]*********************************)

PROCEDURE INITIALIZE;
BEGIN
  BLANKINDEX    := MAXWORDLENGTH;(* start at the extreme right *)
  DIRCH        := '^';     (* Default for Command Character *)
  INDENT    := 6;        (* Default for all indents *)
  TAB        := CHR(9);    (* ASCII TAB CHARACTER *)
  FATALERROR    := FALSE;
  REPEAT
    WRITELN;
    WRITE('Line width?');
    READLN( LINEWIDTH );
    IF LINEWIDTH < MINLINEWIDTH THEN
      WRITELN('Minimum line width is', MINLINEWIDTH:3, '. Please reenter');
  UNTIL (LINEWIDTH>=MINLINEWIDTH) AND (LINEWIDTH<=MAXLINEWIDTH);
  WRITE('Enter text file name ');
  READLN( FILEID );
  (* OPEN file "FILEID" for READ assign TEXTFILE *)
      RESET( FILEID, TEXTFILE );
  CLEAR(* OUTPUT *);
END;

BEGIN (*** Z-PRINT TEXT ***)
  INITIALIZE;
  IF EOF(TEXTFILE) THEN
    WRITELN('File ', FILEID, 'not found')
  ELSE
    BEGIN
      STARTLINE;
      READWORD; (*** Attempt to read a word ***)
      WHILE NOT ( EOF(TEXTFILE) OR FATALERROR ) DO
    BEGIN
      ANALYZE;
      READWORD;    (*** Attempt to read another word ***)
    END; (* WHILE *)
      PRINTLINE; (*** Write the current line without adjustment ***)
    END; (* else *)
  SKIP(4);
END. (*** Z-PRINT TEXT ***)