PROGRAM GSigns;

{******************************************************************************
**
**  Robert W. Bloom
**
**  Function:  This program reads input from the terminal and creates signs.
**             The sign can be either horizontal or vertical in a number of
**             formats.  The file CHARS.DAT is used to read the fonts of the
**             input characters.
**
**  Notes:  This is a generic Pascal version of Signs.
**          See Signs.DOC for more information
**
*****************************************************************************}

CONST
          Date = '30 Apr 86'; {date of last revision of this prog}
     MaxHeight = 12;          {10 plus 2 for desenders}
      MaxWidth = 10;          {actual character may be smaller}
     MaxLength = 220;         {max number of characters on a output line}
                               { TRUNC(16.5cpi * 14" line) }
TYPE
    CHARREC = RECORD  {record type used for random access}
      character : CHAR;        {the character}
          width : INTEGER;     {how wide is it}
         height : INTEGER;     {how high}
            pic : ARRAY[1..MaxHeight,1..MaxWidth] OF CHAR
    END; {record}              {its 'picture'}

     FFTYPE = FILE OF CHARREC;
           S80 = STRING[80];   {for input}
     SIGNARRAY = ARRAY[1..MaxHeight,1..MaxLength] OF CHAR;

VAR
      fontfile : FFTYPE;
infile,outfile : TEXT;
    availchars : INTEGER;          {width of output device}
        chrrec : CHARREC; {global's easier than passing pointers!}

        fontfn : STRING[14];       {global problem parameters}
      signtype : (sign,banner);
     blocktype : (letter,overstrike);
       osstrng : STRING[10];
         multw : INTEGER;
         multh : INTEGER;
   inputdevice : (keyboard,textfile);
          infn : STRING[14];
     numcopies : INTEGER;
  outputdevice : (screen,recdfile);
         outfn : STRING[14];
    devicesize : (wide,normal);
   givenoffset : INTEGER;
    givenwidth : INTEGER;
     centering : (yes,no);


{************************* Procedures called: ********************************}

EXTERNAL PROCEDURE @HLT;
PROCEDURE main;                                                   FORWARD;
PROCEDURE menu;                                                   FORWARD;
PROCEDURE askparameters(VAR ffopen : BOOLEAN);                  FORWARD;
FUNCTION  outputparameters          : BOOLEAN;                   FORWARD;
PROCEDURE calcavailch;                                          FORWARD;
PROCEDURE outsign     (VAR inpline : S80);                      FORWARD;
PROCEDURE outbanner   (VAR inpline : S80);                      FORWARD;
FUNCTION  checksign       (inpline : S80;
                    VAR actualwidth : INTEGER;
                       VAR outarray : SIGNARRAY) : BOOLEAN;     FORWARD;
PROCEDURE findrec              (inp : S80;
                            position : INTEGER);                  FORWARD;
PROCEDURE outchar            (ochar : CHAR);                     FORWARD;


{************************* Start of Program ****************************}


PROCEDURE main;
{******************************************************************************
** Purpose:  puts entry into input line or takes appropriate branch
******************************************************************************}
LABEL 1;
VAR         ans : CHAR;
      textinput : S80;
    done,ffopen : BOOLEAN;
     result,lcv : INTEGER;
BEGIN
        fontfn := 'GChars.Dat';        {initialize parameters}
      signtype := sign;
     blocktype := letter;
       osstrng := 'IMW';
         multw := 1;
         multh := 1;
   inputdevice := keyboard;
          infn := 'Signs.in';
     numcopies := 1;
  outputdevice := screen;
         outfn := 'Signs.Out';
    devicesize := normal;
   givenoffset := 0;
    givenwidth := 0;
     centering := yes;

    done := FALSE;
    ffopen := FALSE;
    WHILE NOT done DO BEGIN
        menu;
        WRITE('Entry -->');
        READLN(ans);
        CASE ans OF
            '?' : WRITELN;    {redisplay menu}
        'p','P' : BEGIN       {change parameters}
                      askparameters(ffopen);
                  END;
        'x','X' : BEGIN       {quit}
                      WRITELN('<done>');
                      done := TRUE
                  END;
        'i','I' : BEGIN       {input a line}
                      WRITE('enter input line to signize -->');
                      READLN(textinput);
                      IF LENGTH(textinput) = 0 THEN GOTO 1;
                      IF NOT ffopen THEN BEGIN
                          calcavailch;
                          ASSIGN(fontfile,fontfn);
                          RESET(fontfile);
                          ffopen := TRUE;
                      END; {if font file isn't open yet}
                      IF inputdevice = textfile THEN
                          FOR lcv := 1 TO numcopies DO BEGIN
                               WHILE NOT EOF(infile) DO BEGIN
                                  READLN(infile,textinput);
                                  IF signtype = sign THEN
                                      outsign(textinput)
                                  ELSE
                                      outbanner(textinput)
                                  {if sign}
                              END; {while not eof}
                              RESET(infile)
                          END {for each copy wanted}
                      ELSE
                          IF signtype = sign THEN
                              outsign(textinput)
                          ELSE
                              outbanner(textinput);
                          {if sign}
                      {if input from file}
                      WRITELN;
                  END; {process line}
             ELSE WRITELN('That''s not an option!');
        END {case}
    END; {while not done}
1:  IF ffopen THEN CLOSE(fontfile,result);
    IF outputdevice = recdfile THEN CLOSE(outfile,result);
    IF inputdevice = textfile THEN CLOSE(infile,result)
END; {PROCEDURE main}


PROCEDURE outsign;
{******************************************************************************
** Arguments: (VAR inpline : S80);
** Purpose: given a input line, outputs it in sign form
******************************************************************************}
VAR   pageoffset,pgoslcv : INTEGER;
  widthlcv,heightlcv,multhlcv : INTEGER;
strikes,oslcv : INTEGER;
     outarray : SIGNARRAY; {'Sign' output line is built into this}
    linewidth : INTEGER;
  overflowerr : BOOLEAN;
        ochar : CHAR;
BEGIN
    overflowerr := checksign(inpline,linewidth,outarray);
    IF (NOT overflowerr) OR (inputdevice = textfile) THEN BEGIN
        IF centering = yes THEN
            pageoffset := ROUND((availchars - linewidth) / 2)
        ELSE
            IF overflowerr THEN
               pageoffset := 0
            ELSE
               pageoffset := givenoffset;
            {if overflow}
        {if centering}
        IF (outputdevice <> screen) OR (inputdevice = keyboard) THEN BEGIN
            WRITELN('Available line width -> ',availchars:1);
            WRITELN('Actual width of line -> ',linewidth:1);
            WRITELN('Added leading spaces -> ',pageoffset:1)
        END;
        IF blocktype = overstrike THEN
            strikes := LENGTH(osstrng)
        ELSE
            strikes := 1;
        {end if}
        FOR heightlcv := 1 TO MaxHeight DO            {output line}
            FOR multhlcv := 1 TO multh DO BEGIN
                FOR oslcv := 1 TO strikes DO BEGIN
                    FOR pgoslcv := 1 TO pageoffset DO outchar(' ');
                    FOR widthlcv := 1 TO linewidth DO BEGIN
                        IF (blocktype = overstrike) AND
                           (outarray[heightlcv,widthlcv] <> ' ') THEN
                            ochar := osstrng[oslcv]
                        ELSE
                            ochar := outarray[heightlcv,widthlcv];
                        outchar(ochar)
                    END; {for width}
                    IF (strikes <> 0) AND (strikes <> oslcv) THEN outchar(CHR(13))
                END; {for overstrikes}
                outchar(CHR(13));
                outchar(CHR(10))
            END; {for height multiplier}
        {end for height}
        outchar(CHR(13));
        outchar(CHR(10));
        inpline := '' {zero input}
    END ELSE
        WRITELN('Input line is too long, correct or re-enter!')
END; {PROCEDURE outsign}


PROCEDURE outbanner;
{******************************************************************************
** Arguments: (inpline : S80)
** Purpose: given an input line, outputs it in banner form
******************************************************************************}
VAR pageoffset,pgoslcv : INTEGER;
 oslcv,strikes,charnum : INTEGER;
    widthlcv,heightlcv : INTEGER;
     multwlcv,multhlcv : INTEGER;
                 ochar : CHAR;
BEGIN
    IF centering = yes THEN
        pageoffset := ROUND((availchars - (MaxHeight * multh)) / 2)
    ELSE
        pageoffset := givenoffset;
    IF (outputdevice <> screen) OR (inputdevice = keyboard) THEN BEGIN
        WRITELN('Available line width  -> ',availchars:1);
        WRITELN('Actual height of line -> ',(MaxHeight*multh):1);
        WRITELN('Added leading spaces  -> ',pageoffset:1);
        IF outputdevice <> screen THEN WRITE('processing ... ')
    END;
    IF blocktype = overstrike THEN
        strikes := LENGTH(osstrng)
    ELSE
        strikes := 1;
    {end if}
    FOR charnum := 1 TO LENGTH(inpline) DO
        IF ORD(inpline[charnum]) >= 32 THEN BEGIN  {skip bad input}
            findrec(inpline,charnum);
            FOR widthlcv := 1 TO chrrec.width DO
                FOR multwlcv := 1 TO multw DO BEGIN
                    FOR oslcv := 1 TO strikes DO BEGIN
                        FOR pgoslcv := 1 TO pageoffset DO outchar(' ');
                        FOR heightlcv := MaxHeight DOWNTO 1 DO
                            FOR multhlcv := 1 TO multh DO BEGIN
                                IF (blocktype = overstrike) AND
                                   (chrrec.pic[heightlcv,widthlcv] <> ' ') THEN
                                    ochar := osstrng[oslcv]
                                ELSE
                                    ochar := chrrec.pic[heightlcv,widthlcv];
                                outchar(ochar)
                            END; {for multiplier horizontally}
                        {end for height}
                        IF (strikes <> 0) AND (strikes <> oslcv) THEN outchar(CHR(13))
                    END; {for overstrikes}
                    outchar(CHR(13));
                    outchar(CHR(10))
                END; {for multiplier vertically}
            {end for width}
            outchar(CHR(13));
            outchar(CHR(10))
        END; {if char is in proper print range}
    {end for each input char}
    inpline := ''
END; {PROCEDURE outbanner}


FUNCTION checksign;
{******************************************************************************
** Arguments: (inpline : S80; VAR actualwidth : INTEGER) : BOOLEAN;
** Purpose: creates outarray for sign, checks for overflow
******************************************************************************}
LABEL 2;
VAR heightlcv,widthlcv : INTEGER;
              multwlcv : INTEGER;
               charnum : INTEGER;
                   err : BOOLEAN;
BEGIN
    err := FALSE;
    FOR heightlcv := 1 to MaxHeight DO
        FOR widthlcv :=1 TO MaxLength DO
            outarray[heightlcv,widthlcv] := ' '; {initialize line array}
    IF (outputdevice <> screen) OR (inputdevice = keyboard) THEN
        WRITE('processing ... ');
    actualwidth := 1;
    FOR charnum := 1 TO LENGTH(inpline) DO         {build line}
        IF ORD(inpline[charnum]) >= 32 THEN BEGIN  {skip bad input}
            findrec(inpline,charnum);
            IF (outputdevice <> screen) OR (inputdevice = keyboard) THEN
                WRITE(chrrec.character);
            IF (actualwidth+(chrrec.width*multw)) > availchars THEN BEGIN
                WRITELN('<- overflow!',CHR(7));
                err := TRUE;
                GOTO 2
            END; {if overflow}
            FOR widthlcv := 1 TO chrrec.width DO
                FOR multwlcv := 1 TO multw DO BEGIN
                    FOR heightlcv := 1 TO chrrec.height DO
                        outarray[heightlcv,actualwidth] :=
                            chrrec.pic[heightlcv,widthlcv];
                    {end for height}
                    actualwidth := actualwidth + 1
                END; {for width multiplier}
            {end for width of char}
            actualwidth := actualwidth + 1      {one space between chars}
        END; {if char in in printing range}
    {end for each input char}
    IF givenoffset <> 0 THEN BEGIN
        IF (actualwidth + givenoffset) > availchars THEN BEGIN
            WRITELN('<- Overflow of available space due to given offset!',CHR(7));
            err := TRUE
        END {if the given offset overflows}
    END; {if given the offset, check for overflow}
2:  WRITELN;
    checksign := err
END; {PROCEDURE checksign}


PROCEDURE menu;
{******************************************************************************
** Arguments: none
** Purpose: contains menu of command line options
******************************************************************************}
BEGIN
    WRITELN('  P - To review and/or change parameters');
    WRITELN('  ? - To display this menu');
    WRITELN('  X - To exit program');
    WRITELN('  I - To process a input line');
    WRITELN
END;


PROCEDURE findrec;
{******************************************************************************
** Arguments: (inp : S80; position : INTEGER);
** Purpose: puts a picture into the global record variable 'chrrec'
******************************************************************************}
VAR  searchchar : CHAR;
      recnumber : INTEGER;
BEGIN
    searchchar := inp[position];
     recnumber := ORD(searchchar) - 32;
    SEEKREAD(fontfile,recnumber);
        chrrec := fontfile^
END;


PROCEDURE outchar;
{******************************************************************************
** Arguments: (ochar : CHAR)
** Purpose: outputs a character to appropriate device
******************************************************************************}
BEGIN
    CASE outputdevice OF
        recdfile : WRITE(outfile,ochar);
          screen : WRITE(ochar)
    END {case}
END; {procedure outchar}


PROCEDURE calcavailch;
{******************************************************************************
** Arguments: none
** Purpose: calculates the available space for output
******************************************************************************}
VAR  pitch : REAL;
BEGIN
    IF givenwidth = 0 THEN BEGIN
        IF devicesize = wide THEN
            availchars := 132
        ELSE
            availchars := 80
    END ELSE
        availchars := givenwidth
    {if width was not given}
END; {procedure calcavailch}


PROCEDURE optx(VAR ok,done,outfopen,ffopen : BOOLEAN;VAR oldof,oldff : STRING);
VAR result : INTEGER;
BEGIN
    IF ok THEN BEGIN
        calcavailch;
        done := TRUE;

        IF outfopen AND (outputdevice <> recdfile) THEN
            CLOSE(outfile,result);
        {end if no more file output}
        IF NOT outfopen AND (outputdevice = recdfile) THEN BEGIN
            ASSIGN(outfile,outfn);  {start file output}
            REWRITE(outfile);
            outfopen := TRUE;
        END; {if new file output}
        IF outfopen AND (outputdevice = recdfile) AND
            (outfn <> oldof) THEN BEGIN {change output file}
            CLOSE(outfile,result);             {close old file}
            ASSIGN(outfile,outfn);
            REWRITE(outfile)            {open new file}
        END; {if file output was changed}

        IF (oldff <> fontfn) OR NOT ffopen THEN BEGIN
            ASSIGN(fontfile,fontfn);
            RESET(fontfile);
            ffopen := TRUE
        END; {if font filename was changed}
        IF inputdevice = textfile THEN BEGIN
            ASSIGN(infile,infn);
            RESET(infile);
        END {if input from file}
    END ELSE
        WRITELN('Banner is too big to fit on output!');
    {END}
END;


PROCEDURE optf;
VAR strngans : STRING[13];
BEGIN
    WRITELN('The font file contains the definitions for all characters');
    WRITELN('It is created with ''MAKEFONT'' from a ASCII file.');
    WRITE('Enter FileName of Font File -> ');
    READLN(strngans);
    IF strngans <> '' THEN fontfn := strngans
END;


PROCEDURE opts;
VAR charans : CHAR;
BEGIN
    WRITELN('One can format signs horizontally across page or');
    WRITELN('banners vertically down page.  Do you want a');
    WRITE('Sign or Banner? (S/B) -> ');
    READLN(charans);
    CASE charans OF
        'B','b' : signtype := banner;
        'S','s' : signtype := sign
    END; {case}
END;


PROCEDURE optb;
VAR charans : CHAR;
BEGIN
    WRITELN('The graphic characters may be made of the letter of');
    WRITELN('the character itself, or blocks.  Do you want to');
    WRITE('print Overstrike blocks, or Letters? (L/O) -> ');
    READLN(charans);
    CASE charans OF
        'L','l' : blocktype := letter;
        'O','o' : blocktype := overstrike
    END; {case}
END;


PROCEDURE optw;
VAR sizans : INTEGER;
BEGIN
    WRITELN('One can make the letters of the sign or banner bigger');
    WRITELN('by entering a multiplier.  2 doubles size, 3 triples, etc.');
    WRITE('Enter multiplier for width -> ');
    READLN(sizans);
    IF sizans <> 0 THEN multw := sizans
END;


PROCEDURE opth;
VAR sizans : INTEGER;
BEGIN
    WRITELN('One can make the letters of the sign or banner bigger');
    WRITELN('by entering a multiplier.  2 doubles size, 3 triples, etc.');
    WRITE('Enter multiplier for height -> ');
    READLN(sizans);
    IF sizans <> 0 THEN multh := sizans
END;


PROCEDURE optm;
VAR sizans : INTEGER;
BEGIN
    WRITELN('One can enter a given left margin to position banners and');
    WRITELN('signs on the paper.  If zero, one can select automatic');
    WRITE('centering.  Enter number for left margin? -> ');
    READLN(sizans);
    IF sizans <> 0 THEN BEGIN
        givenoffset := sizans;
        centering := no
    END
END;


PROCEDURE opta;
VAR charans : CHAR;
BEGIN
    WRITELN('This option is active only if the given left margin is zero.');
    WRITELN('Output can be centered between maximum left and right margins.');
    WRITE('Should output be automatically centered N/Y? -> ');
    READLN(charans);
    CASE charans OF
        'N','n' : centering := no;
        'Y','y' : centering := yes
    END {case}
END;


PROCEDURE optg;
VAR sizans : INTEGER;
BEGIN
    WRITELN('If this option is non-zero it will override any of the');
    WRITELN('other output size commands.  One can enter a defined output');
    WRITE('device size which will be used for checks and centering -> ');
    READLN(sizans);
    IF sizans <> 0 THEN givenwidth := sizans
END;


PROCEDURE opti;
VAR charans : CHAR;
BEGIN
    WRITELN('Input can come from the keyboard which is entered');
    WRITELN('one line at a time or in a bunch from a file.  Do you want');
    WRITE('input from the Keyboard or File K/F? -> ');
    READLN(charans);
    CASE charans OF
       'F','f' : inputdevice := textfile;
       'K','k' : inputdevice := keyboard
    END {case}
END;


PROCEDURE optt;
VAR strngans : STRING[13];
BEGIN
    WRITELN('This entry is only active if input is from a file.');
    WRITELN('Enter filename of the text file that contains each');
    WRITE('line to be output  ->');
    READLN(strngans);
    IF strngans <> '' THEN infn := strngans
END;


PROCEDURE optn;
VAR sizans : INTEGER;
BEGIN
    WRITELN('This entry is only active if input is from a file.');
    WRITELN('Multiple copies are separated by formfeeds.');
    WRITE('How many copies do you want? ->');
    READ(sizans);
    IF sizans <> 0 THEN numcopies := sizans
END;


PROCEDURE opto;
VAR charans : CHAR;
BEGIN
    WRITELN('Output may be directed to either the console screen');
    WRITELN('or a file. Do you want to output to');
    WRITE('the Screen or a file S/F? -> ');
    READLN(charans);
    CASE charans OF
        'F','f' : BEGIN
                      outputdevice := recdfile;
                      givenwidth := MaxLength
                  END;
        'S','s' : outputdevice := screen
    END {case}
END;


PROCEDURE optd;
VAR charans : CHAR;
BEGIN
    WRITELN('Enter (N) if the output device is a');
    WRITELN('80 char screen; or (W) if it is 132 char screen.');
    WRITE('Is output device size Normal or Wide? (N/W)  -> ');
    READLN(charans);
    CASE charans OF
        'W','w' : devicesize := wide;
        'N','n' : devicesize := normal
    END {case}
END;


PROCEDURE askparameters;
{******************************************************************************
** Arguments: (VAR ffopen : BOOLEAN);
** Purpose: sets (or changes) up program parmeters
******************************************************************************}
VAR  ans,charans : CHAR;
          sizans : INTEGER;
        strngans : STRING[14];
outfopen,done,ok : BOOLEAN;
     oldof,oldff : STRING[14];
BEGIN
    IF outputdevice = recdfile THEN
        outfopen := TRUE
    ELSE
        outfopen := FALSE;
    oldof := outfn;
    oldff := fontfn;
    done := FALSE;
    ok := outputparameters;
    WHILE NOT done DO BEGIN
        WRITELN;
        WRITE('Enter letter of option to change -> ');
        READLN(ans);
        CASE ans OF
            '?' : ok := outputparameters;
        'X','x' : optx(ok,done,outfopen,ffopen,oldof,oldff);
        'F','f' : optf;
        'S','s' : opts;
        'B','b' : optb;
        'W','w' : optw;
        'H','h' : opth;
        'M','m' : optm;
        'A','a' : opta;
        'G','g' : optg;
        'I','i' : opti;
        'T','t' : optt;
        'N','n' : optn;
        'O','o' : opto;
        'D','d' : optd;
        'Z','z' : @HLT;
        ELSE      BEGIN
                      WRITELN('Bad character entered, try again (''?'' for menu)');
                  END
        END; {case}
    END; {while not done}
END; {procedure askparameters}


FUNCTION outputparameters;
{******************************************************************************
** Arguments: none, returns boolean
** Purpose: displays program parameters, returns TRUE if all ok.
******************************************************************************}
VAR    ans : CHAR;
        ok : BOOLEAN;
BEGIN
    WRITELN;
    WRITELN('Options List');
    WRITELN;
    WRITELN('F:         Font File -> ',FontFn,'   ');

    WRITE('S:         Sign type -> ');
    IF signtype = sign THEN
        WRITELN('Sign  ')
    ELSE
        WRITELN('Banner');

    WRITE('B: Block/Letter type -> ');
    CASE blocktype OF
        letter     : WRITELN('Letters     ');
        overstrike : WRITELN('OverStrikeBk')
    END; {case}

    WRITELN('W:  Width Multiplier -> ',multw:1,'  ');
    WRITELN('H: Height Multiplier -> ',multh:1,'  ');

    WRITELN('M: Given left margin -> ',givenoffset:1,'  ');

    IF givenoffset = 0 THEN BEGIN
        WRITE('A:    Auto-Centering -> ');
        IF centering = yes THEN
            WRITELN('Yes')
        ELSE
            WRITELN('No ')
    END;

    WRITELN('G:       Given Width -> ',givenwidth:1);

    WRITE('I:      Input Device -> ');
    IF inputdevice = keyboard THEN
        WRITELN('Keyboard')
    ELSE BEGIN
        WRITELN('File    ');
    END; {if}

    IF inputdevice = textfile THEN BEGIN
        WRITELN('T:     Text FileName -> ',infn,'   ');
        WRITELN('N:  Number of Copies -> ',numcopies:1,'  ')
    END;

    WRITE('O:     Output device -> ');
    IF outputdevice = screen THEN
        WRITELN('Screen ')
    ELSE
        WRITELN('File   ');

    IF givenwidth = 0 THEN BEGIN
        WRITE('D:       Device size -> ');
        IF devicesize = normal THEN
            WRITELN('Normal')
        ELSE
            WRITELN('Wide  ')
    END;

    IF outputdevice = recdfile THEN BEGIN
        WRITELN('R:  Record Output in -> ',outfn);
    END;

    WRITELN('X: Exit Parameters, return to entry menu');
    WRITELN('Z: Zap Program, return to operating system');
    calcavailch;
    WRITELN;
    WRITELN('Calculated width available -> ',availchars:1,'  ');

    ok := TRUE;
    IF signtype = sign THEN BEGIN     {est based on 8+1 spaces/char}
        WRITE('Approximate number of *input* characters allowed per line -> ');
        WRITELN((TRUNC(availchars/(multw*(MaxWidth-1)))):1,'  ')
    END ELSE BEGIN
        WRITELN('The given parameters require a line ',((MaxHeight *
            multh) + givenoffset):1,' long.');
        IF ((MaxHeight * multh) + givenoffset) > availchars THEN BEGIN
            WRITELN('Error: Output will overflow the available space!');
            ok := FALSE
        END
    END; {if sign output approx max input line}
    outputparameters := ok
END; {Procedure outputparameters}


{************************** main (dummy) program *************************}
BEGIN
    WRITELN('<<< program -- GSigns, ',Date,' -- started >>>');
    WRITELN;
    main;
    WRITELN;
    WRITELN('<<< program -- GSigns -- completed >>>')
END.