/*
        CP/M TEXT FILE VIEWER

        THIS PROGRAM WAS WRITTEN FOR THE INTEL PL/M-80 CROSS COMPILER

        1.0 03/11/2007 UDO MUNK         INITIAL VERSION
        1.1 03/16/2007 UDO MUNK         COUNT TAB IN COLUMN CALCULATION
        1.2 04/06/2007 UDO MUNK         GLOBAL VARIABLE INITIALIZATION
        1.3 11/05/2007 UDO MUNK         STRIP PARITY BIT
*/

0100H: /* ORIGIN OF THIS PROGRAM FOR CP/M */

DECLARE         /* ASCII CONSTANTS */
    TAB         LITERALLY '9',          /* TAB */
    CR          LITERALLY '13',         /* CARRIAGE RETURN */
    LF          LITERALLY '10',         /* LINEFEED */
    CNTLZ       LITERALLY '1AH',        /* CNTL-Z */
    LQ          LITERALLY '113';        /* LOWER CASE Q */

DECLARE         /* BDOS FUNCTIONS */
    BDOS$JUMP   LITERALLY '05H',        /* BDOS JUMP VECTOR */
    BDOS$EXIT   LITERALLY '0',          /* EXIT PROGRAM */
    BDOS$GETC   LITERALLY '1',          /* GET CONSOLE CHARACTER */
    BDOS$PRINT  LITERALLY '2',          /* PRINT CONSOLE CHARACTER */
    BDOS$PRINTS LITERALLY '9',          /* PRINT CONSOLE STRING */
    BDOS$FOPEN  LITERALLY '15',         /* OPEN FILE */
    BDOS$FREAD  LITERALLY '20';         /* READ FILE */

/* JUST FOR THE FUN OF IT: A DIGITAL RESEARCH LIKE COPYRIGHT */
DECLARE
    COPYRIGHT DATA (' V1.3, COPYRIGHT (C) 2007, UDO MUNK ');

DECLARE         /* DEFAULT FILE CONTROL BLOCK */
    FCB$A       ADDRESS INITIAL(5CH),
    FCB         BASED FCB$A (33) BYTE;

DECLARE         /* DEFAULT BUFFER */
    BUFF$A      ADDRESS INITIAL(80H),
    BUFF        BASED BUFF$A (128) BYTE;

DECLARE         /* SOME MORE GLOBAL VARIABLES */
    COL         BYTE INITIAL(0),        /* CURRENT DISPLAY COLUMN */
    ROW         BYTE INITIAL(0),        /* CURRENT DISPLAY ROW */
    C           BYTE;                   /* NEXT CHARACTER FROM FILE */

/* CALL BDOS FUNCTIONS WITHOUT RETURN CODE */
BDOS1: PROCEDURE(FUNC,PARM);
    DECLARE FUNC BYTE;
    DECLARE PARM ADDRESS;
    GO TO BDOS$JUMP;
END BDOS1;

/* CALL BDOS FUNCTIONS WITH BYTE RETURN CODE */
BDOS2: PROCEDURE(FUNC,PARM) BYTE;
    DECLARE FUNC BYTE;
    DECLARE PARM ADDRESS;
    GO TO BDOS$JUMP;
END BDOS2;

/* PRINT CR AND LF */
CRLF: PROCEDURE;
    CALL BDOS1(BDOS$PRINT,CR);
    CALL BDOS1(BDOS$PRINT,LF);
END CRLF;

/* PRINT A STRING TERMINATED WITH $ CHARACTER */
PRINTS: PROCEDURE(S);
    DECLARE S ADDRESS;
    CALL BDOS1(BDOS$PRINTS,S);
END PRINTS;

/* WAIT UNTIL USER ENTERS CHARACTER */
WAIT: PROCEDURE BYTE;
    DECLARE C BYTE;
    CALL PRINTS(.('---- HIT RETURN TO CONTINUE, Q TO QUIT ----: $'));
    C = BDOS2(BDOS$GETC,0);
    CALL CRLF;
    RETURN C;
END WAIT;

/* GET NEXT CHARACTER FROM FILE */
GETCHAR: PROCEDURE BYTE;
    DECLARE C BYTE;
    DECLARE I BYTE INITIAL(128);
    IF I > 127 THEN DO;
        I = 0;
        IF (BDOS2(BDOS$FREAD,FCB$A) <> 0) THEN
            RETURN CNTLZ;
    END;
    C = BUFF(I);
    I = I + 1;
    RETURN C;
END GETCHAR;

/* OPEN FILE AND VIEW CONTENTS UNTIL EOF */
IF (BDOS2(BDOS$FOPEN,FCB$A) = 255) THEN
    CALL PRINTS(.('FILE NOT FOUND$'));
ELSE DO;
    DO WHILE (C := GETCHAR) <> CNTLZ;
        CALL BDOS1(BDOS$PRINT,(C AND 7FH));
        IF C = CR THEN DO;
            COL = 0;
            GO TO NEXTCHAR;
        END;
        IF C = LF THEN DO;
            ROW = ROW + 1;
            IF ROW > 20 THEN DO;
                IF WAIT = LQ THEN GO TO DONE;
                ROW = 0;
            END;
            GO TO NEXTCHAR;
        END;
        IF C = TAB THEN DO;
            DO WHILE (COL + 1) MOD 8 <> 0;
                COL = COL + 1;
            END;
        END;
        ELSE
            COL = COL + 1;
        IF COL > 78 THEN DO;
            ROW = ROW + 1;
            COL = 0;
            IF ROW > 20 THEN DO;
                IF WAIT = LQ THEN GO TO DONE;
                ROW = 0;
            END;
        END;
    NEXTCHAR:
    END;
DONE:
END;

CALL BDOS1(BDOS$EXIT,0); /* DONE, TERMINATE PROGRAM */

EOF