Power-Programmierung/CD1.mdf/pascal/library/dos/signs/ask.pas

Pascal/Delphi Source File | 1989-10-01 | 15.5 KB | 447 lines

PROCEDURE ask_t;    {f/sign format}
VAR char_ans : CHAR;       {used for single char inut}
BEGIN
    WRITELN('One can change to type of sign to format the output horizontally');
    WRITELN('across page (sign) or vertically down page (banner).  Do you want');
    WRITE('a Sign or Banner? (S/B) -> ');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'B','b' : sign_type := banner;
        'S','s' : sign_type := sign
    END; {case}
    disp_t;
    avail_space
END; {procedure ask_t}


PROCEDURE ask_b;    {f/block type}
VAR char_ans : CHAR;       {used for single char inut}
     siz_ans : STRING[3];  {used for number input}
     num,err : INTEGER;
BEGIN
    WRITELN('The graphic characters may be made of the letter of the character');
    WRITELN('itself, two different type of blocks, or Graphic bits.  Do you want to print');
    WRITE('Single-strike Blocks, Overstrike blocks, Letters, or Bits? (S/O/L/B) -> ');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'S','s' : BEGIN
                      block_type := block;
                      GOTORC(22,1); CLREOL; lowvideo;
                      WRITE('Enter decimal number of character to use ->'); highvideo;
                      READLN(siz_ans);
                      IF siz_ans <> '' THEN BEGIN
                          VAL(siz_ans,num,err);
                          block_char := CHR(num)
                      END
                  END;
        'L','l' : block_type := letter;
        'O','o' : block_type := overstrike;
        'B','b' : IF output_device <> printr THEN BEGIN
                       WRITELN;
                       WRITE('Bits aren''t available for this output device');
                       sak
                  END ELSE
                       block_type := bit;
    END; {case}
    disp_b;
    disp_d;
    disp_p;
    disp_l;
    disp_v;
    avail_space;
END; {procedure_ask_b}


PROCEDURE ask_f;    {f/font file}
VAR strng_ans1,strng_ans2 : S14; {used for filename input}
    ok : BOOLEAN;
BEGIN
    ok := TRUE;
    WRITELN('The HP-LaserJet compatible soft font file and associated MkFntNfx-created');
    WRITELN('index defines all characters.  The default extension for the HP font is .FNT');
    WRITELN('and .FNX for the index.  The index filename must match the HP font filename');
    WRITE('Enter FileName of HP Font File -> ');
    highvideo; READLN(strng_ans1);
    IF POS('.',strng_ans1) <> 0 THEN
        strng_ans2 := COPY(strng_ans1,1,POS('.',strng_ans1)-1)
    ELSE
        strng_ans2 := strng_ans1;
    init_ff(strng_ans1,strng_ans2,ok);
    disp_fs;
    disp_f
END; {procedure ask_f}


PROCEDURE ask_w;    {f/width multiplier}
VAR            err : INTEGER;    {err code from strng-to-num convert}
           siz_ans : STRING[3];  {used for number input}
BEGIN
    WRITELN('One can make the letters of the sign or banner bigger in width');
    WRITELN('by entering a multiplier.  2 doubles size, 3 triples, etc.');
    WRITE('Enter multiplier for width -> ');
    highvideo; READLN(siz_ans);
    IF siz_ans <> '' THEN VAL(siz_ans,mult_w,err);
    disp_w
END; {procedure ask_w}


PROCEDURE ask_h;    {f/height multiplier}
VAR            err : INTEGER;    {err code from strng-to-num convert}
           siz_ans : STRING[3];  {used for number input}
BEGIN
    WRITELN('One can make the letters of the sign or banner bigger in height');
    WRITELN('by entering a multiplier.  2 doubles size, 3 triples, etc.');
    WRITE('Enter multiplier for height -> ');
    highvideo; READLN(siz_ans);
    IF siz_ans <> '' THEN VAL(siz_ans,mult_h,err);
    disp_h
END; {procedure ask_h}


PROCEDURE ask_v;    {f/inverse video}
VAR char_ans : CHAR;       {used for single char inut}
BEGIN
    WRITELN('This option reverses spaces to characters and vice-versa, effectively');
    WRITELN('changing the output to reverse video.  The background is the defined single');
    WRITE('block character.  Do you want Reverse Video output?  (Y/N) -> ');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'N','n' : inv_video := FALSE;
        'Y','y' : inv_video := TRUE
    END; {case}
    disp_v
END; {procedure ask_v}


PROCEDURE ask_a;    {f/auto-centering}
VAR char_ans : CHAR;       {used for single char inut}
BEGIN
    WRITELN('This option is active only if the given left margin is zero.');
    WRITELN('Output can be centered within the maximum output width.');
    WRITE('Should output be automatically centered?  (Y/N) -> ');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'N','n' : centering := FALSE;
        'Y','y' : centering := TRUE
    END; {case}
    disp_a
END; {procedure ask_a}


PROCEDURE ask_m;    {f/given left margin}
VAR            err : INTEGER;    {err code from strng-to-num convert}
           siz_ans : STRING[3];  {used for number input}
BEGIN
    WRITELN('One can enter a given left margin to position banners and signs');
    WRITELN('on the paper.  If the given left margin is zero, automatic centering');
    WRITE('can also be done.  Enter number for left margin -> ');
    highvideo; READLN(siz_ans);
    IF siz_ans <> '' THEN BEGIN
        VAL(siz_ans,given_offset,err);
        centering := FALSE
    END;
    disp_a;
    disp_m
END; {procedure ask_m}


PROCEDURE ask_g;    {f/given device size}
VAR            err : INTEGER;    {err code from strng-to-num convert}
           siz_ans : STRING[3];  {used for number input}
BEGIN
    WRITELN('If this option is non-zero it will override any of the other');
    WRITELN('output size commands.  One can enter a defined output device');
    WRITE('size (max=',Max_Length,') which will be used for checks and centering -> ');
    highvideo; READLN(siz_ans);
    IF siz_ans <> '' THEN VAL(siz_ans,given_width,err);
    avail_space;
    disp_g
END; {procedure ask_g}


PROCEDURE ask_q;    {f/abort exit}
VAR ans : CHAR;
BEGIN
    WRITE('Do you want to abort ''SIGNS'' and quit?  (Y/N) -> '^G);
    highvideo; ans := READKEY;
    IF ans IN ['y','Y'] THEN BEGIN
        GOTORC(24,1);
        WRITELN('aborting SIGNS ...');
        HALT
    END
END; {procedure ask_q}


PROCEDURE ask_x(VAR all_ok,font_f_open,out_f_open : BOOLEAN;
                old_ff,old_of : S14);    {f/exiting to input}
LABEL quick_exit;
VAR err : INTEGER;   {for results of VAL procedure}
    temp1,temp2 : s14; {temporary, for type conversion STRING[14] = S14}
BEGIN
    all_ok := TRUE;
    temp1 := font_fn; temp2 := font_fni;
    IF NOT ff_open OR (old_ff <> font_fn) THEN init_ff(temp1,temp2,all_ok);
             {open font file if not open or if changed}
    IF sign_type = Banner THEN BEGIN
        space_needed := (ndx_array[0].height * mult_h) + given_offset;
        IF space_needed > avail_width THEN BEGIN
            GOTORC(24,1); WRITE('Warning: Banner is too tall to fit across the output page!'^G);
            sak;
        END
    END ELSE
        space_needed := given_offset;
    GOTORC(17,25); CLREOL; highvideo; WRITE(space_needed);

    IF input_device = text_file THEN BEGIN     {open input file}
        ASSIGN(in_file,in_fn);
        {$I-} RESET(in_file); {$I+}
        err := IORESULT;
        IF err <> 0 THEN BEGIN
            in_fn := '????';
            GOTORC(24,1); highvideo;
            WRITELN('ERR:',err,' opening Input file, check it!'^G);
            sak;
            all_ok := FALSE;
            GOTO quick_exit
        END {if bad open}
    END; {if input from file}
    IF out_f_open AND (output_device <> recd_file) THEN BEGIN
            {if output is open and no needed, close old it}
        {$I-} CLOSE(out_file); {$I+}             {close old file}
        err := IORESULT;
        IF err <> 0 THEN BEGIN
            out_fn := '????';
            GOTORC(24,1); highvideo;
            WRITELN('ERR:',err,' closing output file, check it!'^G);
            sak;
            all_ok := FALSE;
            GOTO quick_exit
        END
    END; {if no more file output}
    IF output_device = recd_file THEN BEGIN
        IF NOT out_f_open THEN BEGIN   {open it}
            ASSIGN(out_file,out_fn);  {start file output}
            {$I-} REWRITE(out_file); {$i+}
            err := IORESULT;
            IF err <> 0 THEN BEGIN
                out_fn := '????';
                GOTORC(24,1); highvideo;
                WRITELN('ERR:',err,' opening output file, check it!'^G);
                sak;
                disp_e;
                all_ok := FALSE;
                GOTO quick_exit
            END ELSE
                out_f_open := TRUE;
        END; {if new file output}
        IF out_f_open AND (out_fn <> old_of) THEN BEGIN {change output file}
            {$I-} CLOSE(out_file); {$I+}             {close old file}
            err := IORESULT;
            IF err <> 0 THEN BEGIN
                out_fn := '????';
                GOTORC(24,1); highvideo;
                WRITELN('ERR:',err,' closing old output file, check it!'^G);
                sak;
                all_ok := FALSE;
                GOTO quick_exit
            END;
            ASSIGN(out_file,out_fn);
            {$I-} REWRITE(out_file); {$I+}            {open new file}
            err := IORESULT;
            IF err <> 0 THEN BEGIN
                out_fn := '????';
                GOTORC(24,1); highvideo;
                WRITELN('ERR:',err,' opening new output file, check it!'^G);
                sak;
                disp_e;
                all_ok := FALSE;
                GOTO quick_exit
            END
        END {if file output was changed}
    END; {if file output is wanted}
quick_exit:
END; {procedure ask_x}


PROCEDURE ask_i;    {f/input device}
VAR char_ans : CHAR;       {used for single char inut}
BEGIN
    WRITELN('Input can come from the keyboard in which is is entered one line');
    WRITELN('at a time or in a bunch from a external file.  Do you want to read');
    WRITE('input from the Keyboard or File?  (K/F) -> ');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'F','f' : input_device := text_file;
        'K','k' : input_device := keyboard
    END; {case}
    disp_r;
    disp_n;
    disp_i
END; {procedure ask_i}


PROCEDURE ask_r;    {f/text input file}
VAR strng_ans : STRING[14]; {used for filename input}
BEGIN
    WRITELN('This entry is only active if input is read from a file.');
    WRITELN('Enter filename of the text file to read that contains the');
    WRITE('line(s) to be output  -> ');
    highvideo; READLN(strng_ans);
    IF strng_ans <> '' THEN in_fn := strng_ans;
    disp_r
END; {procedure ask_r}


PROCEDURE ask_n;    {f/number of copies}
VAR err : INTEGER;
char_ans : CHAR;       {used for single char inut}
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? -> ');
    highvideo; char_ans := READKEY;
    IF char_ans <> '' THEN VAL(char_ans,num_copies,err);
    disp_n
END; {procedure ask_n}


PROCEDURE ask_o;    {f/output device}
VAR char_ans : CHAR;       {used for single char inut}
BEGIN
    WRITELN('Output may be directed to the console screen, a file or the printer.');
    WRITELN('File output is ',Max_Length,' wide unless specified otherwise.  Do you');
    WRITE('want to output to a File, Screen or Printer?  (S/F/P) -> ');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'P','p' : output_device := printr;
        'S','s' : output_device := screen;
        'F','f' : output_device := recd_file
    END; {case}
    disp_y;
    disp_p;
    disp_l;
    disp_c;
    disp_e;
    disp_o;
    avail_space
END; {procedure ask_o}


PROCEDURE ask_s;    {f/device size}
VAR char_ans : CHAR;       {used for single char inut}
BEGIN
    WRITELN('Enter (N) if the output device is either an 8" wide printer or');
    WRITELN('80 char CRT; or (W) if it is a  14" printer or 132 char screen.');
    WRITE('Is output device size Normal or Wide?  (N/W) -> ');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'W','w' : device_size := wide;
        'N','n' : device_size := normal
    END; {case}
    avail_space;
    disp_s
END; {procedure ask_s}


PROCEDURE ask_y;    {f/given device size}
VAR            err : INTEGER;    {err code from strng-to-num convert}
          char_ans : CHAR;       {used for single char input}
BEGIN
    WRITELN('Several printer drivers are available.  Enter (E)pson, (I)DS [also works');
    WRITELN('for DataProducts] (H)p LaserJet, or (D)umb.  Dumb sends no control codes.');
    WRITE('Printer?  (E/I/H/D?) -> ');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'E','e' : prt_type := epson;
        'I','i' : prt_type := ids;
        'H','h' : prt_type := hp;
        'D','d' : prt_type := dumb
    END; {case}
    avail_space;
    disp_y
END; {procedure ask_y}


PROCEDURE ask_p;     {f/pitch}
VAR char_ans : CHAR;       {used for single char inut}
BEGIN
    WRITELN('This entry is active only if outputting to the printer.  It controls');
    WRITELN('character spacing or pitch:  Enter (P)ica for 10 cpi, (E)lite for');
    WRITE('12 cpi, (S)queezed for 16.5 cpi, (T)iny for 20 cpi?  (P/E/S/T?) -> ');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'P','p' : prt_cpi := pica;
        'E','e' : prt_cpi := elite;
        'S','s' : prt_cpi := squeezed;
        'T','t' : prt_cpi := tiny
    END; {case}
    avail_space;
    disp_p
END; {procedure ask_p}


PROCEDURE ask_l;    {f/line per inch}
VAR char_ans : CHAR;       {used for single char inut}
BEGIN
    WRITELN('This entry is active only if outputting to the printer.');
    WRITELN('This controls line spacing:  Enter (S) for 6 lpi,');
    WRITE('(E)ight for 8 lpi, (T)en, or tWelve lpi?  (S/E/T/W) -> ');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'S','s' : prt_lpi := six;
        'E','e' : prt_lpi := eight;
        'T','t' : prt_lpi := ten;
        'W','w' : prt_lpi := twelve
    END; {case}
    disp_l
END; {procedure ask_l}


PROCEDURE ask_c;    {f/color}
VAR char_ans : CHAR;       {used for single char inut}
BEGIN
    WRITELN('This entry is active only if outputting to the printer.');
    WRITELN('Printer can print in (R)ed, (G)reen, b(L)ue or (B)lack.');
    WRITE('Enter color desired?  (R/G/L/B) ->');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'B','B' : prt_color := black;
        'R','r' : prt_color := red;
        'G','g' : prt_color := green;
        'L','l' : prt_color := blue
    END; {case}
    disp_c
END; {procedure ask_c}


PROCEDURE ask_d;    {f/color}
VAR char_ans : CHAR;       {used for single char inut}
BEGIN
    WRITELN('This entry is active only if outputting to the printer and bit output');
    WRITELN('is requested.  Options are (S)ingle, (D)ouble, (T)riple, or (Q)uad');
    WRITE('Graphic Density.  Enter (S/D/T/Q?) ->');
    highvideo; char_ans := READKEY;
    CASE char_ans OF
        'S','s' : graphic_dens := single;
        'D','d' : graphic_dens := double;
        'T','t' : graphic_dens := triple;
        'Q','q' : graphic_dens := quad
    END; {case}
    avail_space;
    disp_d
END; {procedure ask_d}


PROCEDURE ask_e;    {f/record file}
VAR strng_ans : STRING[14]; {used for filename output}
BEGIN
    WRITELN('This entry is only active if output is to be recorded in');
    WRITE('a file.  Enter filename to record output into -> ');
    highvideo; READLN(strng_ans);
    IF strng_ans <> '' THEN out_fn := strng_ans;
    avail_space;
    disp_e
END; {procedure ask_e}