home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PROGRAMS / LIST / MSIGNS12.ARK / GSIGNS12.SRC < prev   
Text File  |  1986-12-24  |  26KB  |  743 lines

  1. PROGRAM GSigns;
  2.  
  3. {******************************************************************************
  4. **
  5. **  Robert W. Bloom
  6. **
  7. **  Function:  This program reads input from the terminal and creates signs.
  8. **             The sign can be either horizontal or vertical in a number of
  9. **             formats.  The file CHARS.DAT is used to read the fonts of the
  10. **             input characters.
  11. **
  12. **  Notes:  This is a generic Pascal version of Signs.
  13. **          See Signs.DOC for more information
  14. **
  15. *****************************************************************************}
  16.  
  17. CONST
  18.           Date = '30 Apr 86'; {date of last revision of this prog}
  19.      MaxHeight = 12;          {10 plus 2 for desenders}
  20.       MaxWidth = 10;          {actual character may be smaller}
  21.      MaxLength = 220;         {max number of characters on a output line}
  22.                                { TRUNC(16.5cpi * 14" line) }
  23. TYPE
  24.     CHARREC = RECORD  {record type used for random access}
  25.       character : CHAR;        {the character}
  26.           width : INTEGER;     {how wide is it}
  27.          height : INTEGER;     {how high}
  28.             pic : ARRAY[1..MaxHeight,1..MaxWidth] OF CHAR
  29.     END; {record}              {its 'picture'}
  30.  
  31.      FFTYPE = FILE OF CHARREC;
  32.            S80 = STRING[80];   {for input}
  33.      SIGNARRAY = ARRAY[1..MaxHeight,1..MaxLength] OF CHAR;
  34.  
  35. VAR
  36.       fontfile : FFTYPE;
  37. infile,outfile : TEXT;
  38.     availchars : INTEGER;          {width of output device}
  39.         chrrec : CHARREC; {global's easier than passing pointers!}
  40.  
  41.         fontfn : STRING[14];       {global problem parameters}
  42.       signtype : (sign,banner);
  43.      blocktype : (letter,overstrike);
  44.        osstrng : STRING[10];
  45.          multw : INTEGER;
  46.          multh : INTEGER;
  47.    inputdevice : (keyboard,textfile);
  48.           infn : STRING[14];
  49.      numcopies : INTEGER;
  50.   outputdevice : (screen,recdfile);
  51.          outfn : STRING[14];
  52.     devicesize : (wide,normal);
  53.    givenoffset : INTEGER;
  54.     givenwidth : INTEGER;
  55.      centering : (yes,no);
  56.  
  57.  
  58. {************************* Procedures called: ********************************}
  59.  
  60. EXTERNAL PROCEDURE @HLT;
  61. PROCEDURE main;                                                   FORWARD;
  62. PROCEDURE menu;                                                   FORWARD;
  63. PROCEDURE askparameters(VAR ffopen : BOOLEAN);                  FORWARD;
  64. FUNCTION  outputparameters          : BOOLEAN;                   FORWARD;
  65. PROCEDURE calcavailch;                                          FORWARD;
  66. PROCEDURE outsign     (VAR inpline : S80);                      FORWARD;
  67. PROCEDURE outbanner   (VAR inpline : S80);                      FORWARD;
  68. FUNCTION  checksign       (inpline : S80;
  69.                     VAR actualwidth : INTEGER;
  70.                        VAR outarray : SIGNARRAY) : BOOLEAN;     FORWARD;
  71. PROCEDURE findrec              (inp : S80;
  72.                             position : INTEGER);                  FORWARD;
  73. PROCEDURE outchar            (ochar : CHAR);                     FORWARD;
  74.  
  75.  
  76. {************************* Start of Program ****************************}
  77.  
  78.  
  79. PROCEDURE main;
  80. {******************************************************************************
  81. ** Purpose:  puts entry into input line or takes appropriate branch
  82. ******************************************************************************}
  83. LABEL 1;
  84. VAR         ans : CHAR;
  85.       textinput : S80;
  86.     done,ffopen : BOOLEAN;
  87.      result,lcv : INTEGER;
  88. BEGIN
  89.         fontfn := 'GChars.Dat';        {initialize parameters}
  90.       signtype := sign;
  91.      blocktype := letter;
  92.        osstrng := 'IMW';
  93.          multw := 1;
  94.          multh := 1;
  95.    inputdevice := keyboard;
  96.           infn := 'Signs.in';
  97.      numcopies := 1;
  98.   outputdevice := screen;
  99.          outfn := 'Signs.Out';
  100.     devicesize := normal;
  101.    givenoffset := 0;
  102.     givenwidth := 0;
  103.      centering := yes;
  104.  
  105.     done := FALSE;
  106.     ffopen := FALSE;
  107.     WHILE NOT done DO BEGIN
  108.         menu;
  109.         WRITE('Entry -->');
  110.         READLN(ans);
  111.         CASE ans OF
  112.             '?' : WRITELN;    {redisplay menu}
  113.         'p','P' : BEGIN       {change parameters}
  114.                       askparameters(ffopen);
  115.                   END;
  116.         'x','X' : BEGIN       {quit}
  117.                       WRITELN('<done>');
  118.                       done := TRUE
  119.                   END;
  120.         'i','I' : BEGIN       {input a line}
  121.                       WRITE('enter input line to signize -->');
  122.                       READLN(textinput);
  123.                       IF LENGTH(textinput) = 0 THEN GOTO 1;
  124.                       IF NOT ffopen THEN BEGIN
  125.                           calcavailch;
  126.                           ASSIGN(fontfile,fontfn);
  127.                           RESET(fontfile);
  128.                           ffopen := TRUE;
  129.                       END; {if font file isn't open yet}
  130.                       IF inputdevice = textfile THEN
  131.                           FOR lcv := 1 TO numcopies DO BEGIN
  132.                                WHILE NOT EOF(infile) DO BEGIN
  133.                                   READLN(infile,textinput);
  134.                                   IF signtype = sign THEN
  135.                                       outsign(textinput)
  136.                                   ELSE
  137.                                       outbanner(textinput)
  138.                                   {if sign}
  139.                               END; {while not eof}
  140.                               RESET(infile)
  141.                           END {for each copy wanted}
  142.                       ELSE
  143.                           IF signtype = sign THEN
  144.                               outsign(textinput)
  145.                           ELSE
  146.                               outbanner(textinput);
  147.                           {if sign}
  148.                       {if input from file}
  149.                       WRITELN;
  150.                   END; {process line}
  151.              ELSE WRITELN('That''s not an option!');
  152.         END {case}
  153.     END; {while not done}
  154. 1:  IF ffopen THEN CLOSE(fontfile,result);
  155.     IF outputdevice = recdfile THEN CLOSE(outfile,result);
  156.     IF inputdevice = textfile THEN CLOSE(infile,result)
  157. END; {PROCEDURE main}
  158.  
  159.  
  160. PROCEDURE outsign;
  161. {******************************************************************************
  162. ** Arguments: (VAR inpline : S80);
  163. ** Purpose: given a input line, outputs it in sign form
  164. ******************************************************************************}
  165. VAR   pageoffset,pgoslcv : INTEGER;
  166.   widthlcv,heightlcv,multhlcv : INTEGER;
  167. strikes,oslcv : INTEGER;
  168.      outarray : SIGNARRAY; {'Sign' output line is built into this}
  169.     linewidth : INTEGER;
  170.   overflowerr : BOOLEAN;
  171.         ochar : CHAR;
  172. BEGIN
  173.     overflowerr := checksign(inpline,linewidth,outarray);
  174.     IF (NOT overflowerr) OR (inputdevice = textfile) THEN BEGIN
  175.         IF centering = yes THEN
  176.             pageoffset := ROUND((availchars - linewidth) / 2)
  177.         ELSE
  178.             IF overflowerr THEN
  179.                pageoffset := 0
  180.             ELSE
  181.                pageoffset := givenoffset;
  182.             {if overflow}
  183.         {if centering}
  184.         IF (outputdevice <> screen) OR (inputdevice = keyboard) THEN BEGIN
  185.             WRITELN('Available line width -> ',availchars:1);
  186.             WRITELN('Actual width of line -> ',linewidth:1);
  187.             WRITELN('Added leading spaces -> ',pageoffset:1)
  188.         END;
  189.         IF blocktype = overstrike THEN
  190.             strikes := LENGTH(osstrng)
  191.         ELSE
  192.             strikes := 1;
  193.         {end if}
  194.         FOR heightlcv := 1 TO MaxHeight DO            {output line}
  195.             FOR multhlcv := 1 TO multh DO BEGIN
  196.                 FOR oslcv := 1 TO strikes DO BEGIN
  197.                     FOR pgoslcv := 1 TO pageoffset DO outchar(' ');
  198.                     FOR widthlcv := 1 TO linewidth DO BEGIN
  199.                         IF (blocktype = overstrike) AND
  200.                            (outarray[heightlcv,widthlcv] <> ' ') THEN
  201.                             ochar := osstrng[oslcv]
  202.                         ELSE
  203.                             ochar := outarray[heightlcv,widthlcv];
  204.                         outchar(ochar)
  205.                     END; {for width}
  206.                     IF (strikes <> 0) AND (strikes <> oslcv) THEN outchar(CHR(13))
  207.                 END; {for overstrikes}
  208.                 outchar(CHR(13));
  209.                 outchar(CHR(10))
  210.             END; {for height multiplier}
  211.         {end for height}
  212.         outchar(CHR(13));
  213.         outchar(CHR(10));
  214.         inpline := '' {zero input}
  215.     END ELSE
  216.         WRITELN('Input line is too long, correct or re-enter!')
  217. END; {PROCEDURE outsign}
  218.  
  219.  
  220. PROCEDURE outbanner;
  221. {******************************************************************************
  222. ** Arguments: (inpline : S80)
  223. ** Purpose: given an input line, outputs it in banner form
  224. ******************************************************************************}
  225. VAR pageoffset,pgoslcv : INTEGER;
  226.  oslcv,strikes,charnum : INTEGER;
  227.     widthlcv,heightlcv : INTEGER;
  228.      multwlcv,multhlcv : INTEGER;
  229.                  ochar : CHAR;
  230. BEGIN
  231.     IF centering = yes THEN
  232.         pageoffset := ROUND((availchars - (MaxHeight * multh)) / 2)
  233.     ELSE
  234.         pageoffset := givenoffset;
  235.     IF (outputdevice <> screen) OR (inputdevice = keyboard) THEN BEGIN
  236.         WRITELN('Available line width  -> ',availchars:1);
  237.         WRITELN('Actual height of line -> ',(MaxHeight*multh):1);
  238.         WRITELN('Added leading spaces  -> ',pageoffset:1);
  239.         IF outputdevice <> screen THEN WRITE('processing ... ')
  240.     END;
  241.     IF blocktype = overstrike THEN
  242.         strikes := LENGTH(osstrng)
  243.     ELSE
  244.         strikes := 1;
  245.     {end if}
  246.     FOR charnum := 1 TO LENGTH(inpline) DO
  247.         IF ORD(inpline[charnum]) >= 32 THEN BEGIN  {skip bad input}
  248.             findrec(inpline,charnum);
  249.             FOR widthlcv := 1 TO chrrec.width DO
  250.                 FOR multwlcv := 1 TO multw DO BEGIN
  251.                     FOR oslcv := 1 TO strikes DO BEGIN
  252.                         FOR pgoslcv := 1 TO pageoffset DO outchar(' ');
  253.                         FOR heightlcv := MaxHeight DOWNTO 1 DO
  254.                             FOR multhlcv := 1 TO multh DO BEGIN
  255.                                 IF (blocktype = overstrike) AND
  256.                                    (chrrec.pic[heightlcv,widthlcv] <> ' ') THEN
  257.                                     ochar := osstrng[oslcv]
  258.                                 ELSE
  259.                                     ochar := chrrec.pic[heightlcv,widthlcv];
  260.                                 outchar(ochar)
  261.                             END; {for multiplier horizontally}
  262.                         {end for height}
  263.                         IF (strikes <> 0) AND (strikes <> oslcv) THEN outchar(CHR(13))
  264.                     END; {for overstrikes}
  265.                     outchar(CHR(13));
  266.                     outchar(CHR(10))
  267.                 END; {for multiplier vertically}
  268.             {end for width}
  269.             outchar(CHR(13));
  270.             outchar(CHR(10))
  271.         END; {if char is in proper print range}
  272.     {end for each input char}
  273.     inpline := ''
  274. END; {PROCEDURE outbanner}
  275.  
  276.  
  277. FUNCTION checksign;
  278. {******************************************************************************
  279. ** Arguments: (inpline : S80; VAR actualwidth : INTEGER) : BOOLEAN;
  280. ** Purpose: creates outarray for sign, checks for overflow
  281. ******************************************************************************}
  282. LABEL 2;
  283. VAR heightlcv,widthlcv : INTEGER;
  284.               multwlcv : INTEGER;
  285.                charnum : INTEGER;
  286.                    err : BOOLEAN;
  287. BEGIN
  288.     err := FALSE;
  289.     FOR heightlcv := 1 to MaxHeight DO
  290.         FOR widthlcv :=1 TO MaxLength DO
  291.             outarray[heightlcv,widthlcv] := ' '; {initialize line array}
  292.     IF (outputdevice <> screen) OR (inputdevice = keyboard) THEN
  293.         WRITE('processing ... ');
  294.     actualwidth := 1;
  295.     FOR charnum := 1 TO LENGTH(inpline) DO         {build line}
  296.         IF ORD(inpline[charnum]) >= 32 THEN BEGIN  {skip bad input}
  297.             findrec(inpline,charnum);
  298.             IF (outputdevice <> screen) OR (inputdevice = keyboard) THEN
  299.                 WRITE(chrrec.character);
  300.             IF (actualwidth+(chrrec.width*multw)) > availchars THEN BEGIN
  301.                 WRITELN('<- overflow!',CHR(7));
  302.                 err := TRUE;
  303.                 GOTO 2
  304.             END; {if overflow}
  305.             FOR widthlcv := 1 TO chrrec.width DO
  306.                 FOR multwlcv := 1 TO multw DO BEGIN
  307.                     FOR heightlcv := 1 TO chrrec.height DO
  308.                         outarray[heightlcv,actualwidth] :=
  309.                             chrrec.pic[heightlcv,widthlcv];
  310.                     {end for height}
  311.                     actualwidth := actualwidth + 1
  312.                 END; {for width multiplier}
  313.             {end for width of char}
  314.             actualwidth := actualwidth + 1      {one space between chars}
  315.         END; {if char in in printing range}
  316.     {end for each input char}
  317.     IF givenoffset <> 0 THEN BEGIN
  318.         IF (actualwidth + givenoffset) > availchars THEN BEGIN
  319.             WRITELN('<- Overflow of available space due to given offset!',CHR(7));
  320.             err := TRUE
  321.         END {if the given offset overflows}
  322.     END; {if given the offset, check for overflow}
  323. 2:  WRITELN;
  324.     checksign := err
  325. END; {PROCEDURE checksign}
  326.  
  327.  
  328. PROCEDURE menu;
  329. {******************************************************************************
  330. ** Arguments: none
  331. ** Purpose: contains menu of command line options
  332. ******************************************************************************}
  333. BEGIN
  334.     WRITELN('  P - To review and/or change parameters');
  335.     WRITELN('  ? - To display this menu');
  336.     WRITELN('  X - To exit program');
  337.     WRITELN('  I - To process a input line');
  338.     WRITELN
  339. END;
  340.  
  341.  
  342. PROCEDURE findrec;
  343. {******************************************************************************
  344. ** Arguments: (inp : S80; position : INTEGER);
  345. ** Purpose: puts a picture into the global record variable 'chrrec'
  346. ******************************************************************************}
  347. VAR  searchchar : CHAR;
  348.       recnumber : INTEGER;
  349. BEGIN
  350.     searchchar := inp[position];
  351.      recnumber := ORD(searchchar) - 32;
  352.     SEEKREAD(fontfile,recnumber);
  353.         chrrec := fontfile^
  354. END;
  355.  
  356.  
  357. PROCEDURE outchar;
  358. {******************************************************************************
  359. ** Arguments: (ochar : CHAR)
  360. ** Purpose: outputs a character to appropriate device
  361. ******************************************************************************}
  362. BEGIN
  363.     CASE outputdevice OF
  364.         recdfile : WRITE(outfile,ochar);
  365.           screen : WRITE(ochar)
  366.     END {case}
  367. END; {procedure outchar}
  368.  
  369.  
  370. PROCEDURE calcavailch;
  371. {******************************************************************************
  372. ** Arguments: none
  373. ** Purpose: calculates the available space for output
  374. ******************************************************************************}
  375. VAR  pitch : REAL;
  376. BEGIN
  377.     IF givenwidth = 0 THEN BEGIN
  378.         IF devicesize = wide THEN
  379.             availchars := 132
  380.         ELSE
  381.             availchars := 80
  382.     END ELSE
  383.         availchars := givenwidth
  384.     {if width was not given}
  385. END; {procedure calcavailch}
  386.  
  387.  
  388. PROCEDURE optx(VAR ok,done,outfopen,ffopen : BOOLEAN;VAR oldof,oldff : STRING);
  389. VAR result : INTEGER;
  390. BEGIN
  391.     IF ok THEN BEGIN
  392.         calcavailch;
  393.         done := TRUE;
  394.  
  395.         IF outfopen AND (outputdevice <> recdfile) THEN
  396.             CLOSE(outfile,result);
  397.         {end if no more file output}
  398.         IF NOT outfopen AND (outputdevice = recdfile) THEN BEGIN
  399.             ASSIGN(outfile,outfn);  {start file output}
  400.             REWRITE(outfile);
  401.             outfopen := TRUE;
  402.         END; {if new file output}
  403.         IF outfopen AND (outputdevice = recdfile) AND
  404.             (outfn <> oldof) THEN BEGIN {change output file}
  405.             CLOSE(outfile,result);             {close old file}
  406.             ASSIGN(outfile,outfn);
  407.             REWRITE(outfile)            {open new file}
  408.         END; {if file output was changed}
  409.  
  410.         IF (oldff <> fontfn) OR NOT ffopen THEN BEGIN
  411.             ASSIGN(fontfile,fontfn);
  412.             RESET(fontfile);
  413.             ffopen := TRUE
  414.         END; {if font filename was changed}
  415.         IF inputdevice = textfile THEN BEGIN
  416.             ASSIGN(infile,infn);
  417.             RESET(infile);
  418.         END {if input from file}
  419.     END ELSE
  420.         WRITELN('Banner is too big to fit on output!');
  421.     {END}
  422. END;
  423.  
  424.  
  425. PROCEDURE optf;
  426. VAR strngans : STRING[13];
  427. BEGIN
  428.     WRITELN('The font file contains the definitions for all characters');
  429.     WRITELN('It is created with ''MAKEFONT'' from a ASCII file.');
  430.     WRITE('Enter FileName of Font File -> ');
  431.     READLN(strngans);
  432.     IF strngans <> '' THEN fontfn := strngans
  433. END;
  434.  
  435.  
  436. PROCEDURE opts;
  437. VAR charans : CHAR;
  438. BEGIN
  439.     WRITELN('One can format signs horizontally across page or');
  440.     WRITELN('banners vertically down page.  Do you want a');
  441.     WRITE('Sign or Banner? (S/B) -> ');
  442.     READLN(charans);
  443.     CASE charans OF
  444.         'B','b' : signtype := banner;
  445.         'S','s' : signtype := sign
  446.     END; {case}
  447. END;
  448.  
  449.  
  450. PROCEDURE optb;
  451. VAR charans : CHAR;
  452. BEGIN
  453.     WRITELN('The graphic characters may be made of the letter of');
  454.     WRITELN('the character itself, or blocks.  Do you want to');
  455.     WRITE('print Overstrike blocks, or Letters? (L/O) -> ');
  456.     READLN(charans);
  457.     CASE charans OF
  458.         'L','l' : blocktype := letter;
  459.         'O','o' : blocktype := overstrike
  460.     END; {case}
  461. END;
  462.  
  463.  
  464. PROCEDURE optw;
  465. VAR sizans : INTEGER;
  466. BEGIN
  467.     WRITELN('One can make the letters of the sign or banner bigger');
  468.     WRITELN('by entering a multiplier.  2 doubles size, 3 triples, etc.');
  469.     WRITE('Enter multiplier for width -> ');
  470.     READLN(sizans);
  471.     IF sizans <> 0 THEN multw := sizans
  472. END;
  473.  
  474.  
  475. PROCEDURE opth;
  476. VAR sizans : INTEGER;
  477. BEGIN
  478.     WRITELN('One can make the letters of the sign or banner bigger');
  479.     WRITELN('by entering a multiplier.  2 doubles size, 3 triples, etc.');
  480.     WRITE('Enter multiplier for height -> ');
  481.     READLN(sizans);
  482.     IF sizans <> 0 THEN multh := sizans
  483. END;
  484.  
  485.  
  486. PROCEDURE optm;
  487. VAR sizans : INTEGER;
  488. BEGIN
  489.     WRITELN('One can enter a given left margin to position banners and');
  490.     WRITELN('signs on the paper.  If zero, one can select automatic');
  491.     WRITE('centering.  Enter number for left margin? -> ');
  492.     READLN(sizans);
  493.     IF sizans <> 0 THEN BEGIN
  494.         givenoffset := sizans;
  495.         centering := no
  496.     END
  497. END;
  498.  
  499.  
  500. PROCEDURE opta;
  501. VAR charans : CHAR;
  502. BEGIN
  503.     WRITELN('This option is active only if the given left margin is zero.');
  504.     WRITELN('Output can be centered between maximum left and right margins.');
  505.     WRITE('Should output be automatically centered N/Y? -> ');
  506.     READLN(charans);
  507.     CASE charans OF
  508.         'N','n' : centering := no;
  509.         'Y','y' : centering := yes
  510.     END {case}
  511. END;
  512.  
  513.  
  514. PROCEDURE optg;
  515. VAR sizans : INTEGER;
  516. BEGIN
  517.     WRITELN('If this option is non-zero it will override any of the');
  518.     WRITELN('other output size commands.  One can enter a defined output');
  519.     WRITE('device size which will be used for checks and centering -> ');
  520.     READLN(sizans);
  521.     IF sizans <> 0 THEN givenwidth := sizans
  522. END;
  523.  
  524.  
  525. PROCEDURE opti;
  526. VAR charans : CHAR;
  527. BEGIN
  528.     WRITELN('Input can come from the keyboard which is entered');
  529.     WRITELN('one line at a time or in a bunch from a file.  Do you want');
  530.     WRITE('input from the Keyboard or File K/F? -> ');
  531.     READLN(charans);
  532.     CASE charans OF
  533.        'F','f' : inputdevice := textfile;
  534.        'K','k' : inputdevice := keyboard
  535.     END {case}
  536. END;
  537.  
  538.  
  539. PROCEDURE optt;
  540. VAR strngans : STRING[13];
  541. BEGIN
  542.     WRITELN('This entry is only active if input is from a file.');
  543.     WRITELN('Enter filename of the text file that contains each');
  544.     WRITE('line to be output  ->');
  545.     READLN(strngans);
  546.     IF strngans <> '' THEN infn := strngans
  547. END;
  548.  
  549.  
  550. PROCEDURE optn;
  551. VAR sizans : INTEGER;
  552. BEGIN
  553.     WRITELN('This entry is only active if input is from a file.');
  554.     WRITELN('Multiple copies are separated by formfeeds.');
  555.     WRITE('How many copies do you want? ->');
  556.     READ(sizans);
  557.     IF sizans <> 0 THEN numcopies := sizans
  558. END;
  559.  
  560.  
  561. PROCEDURE opto;
  562. VAR charans : CHAR;
  563. BEGIN
  564.     WRITELN('Output may be directed to either the console screen');
  565.     WRITELN('or a file. Do you want to output to');
  566.     WRITE('the Screen or a file S/F? -> ');
  567.     READLN(charans);
  568.     CASE charans OF
  569.         'F','f' : BEGIN
  570.                       outputdevice := recdfile;
  571.                       givenwidth := MaxLength
  572.                   END;
  573.         'S','s' : outputdevice := screen
  574.     END {case}
  575. END;
  576.  
  577.  
  578. PROCEDURE optd;
  579. VAR charans : CHAR;
  580. BEGIN
  581.     WRITELN('Enter (N) if the output device is a');
  582.     WRITELN('80 char screen; or (W) if it is 132 char screen.');
  583.     WRITE('Is output device size Normal or Wide? (N/W)  -> ');
  584.     READLN(charans);
  585.     CASE charans OF
  586.         'W','w' : devicesize := wide;
  587.         'N','n' : devicesize := normal
  588.     END {case}
  589. END;
  590.  
  591.  
  592. PROCEDURE askparameters;
  593. {******************************************************************************
  594. ** Arguments: (VAR ffopen : BOOLEAN);
  595. ** Purpose: sets (or changes) up program parmeters
  596. ******************************************************************************}
  597. VAR  ans,charans : CHAR;
  598.           sizans : INTEGER;
  599.         strngans : STRING[14];
  600. outfopen,done,ok : BOOLEAN;
  601.      oldof,oldff : STRING[14];
  602. BEGIN
  603.     IF outputdevice = recdfile THEN
  604.         outfopen := TRUE
  605.     ELSE
  606.         outfopen := FALSE;
  607.     oldof := outfn;
  608.     oldff := fontfn;
  609.     done := FALSE;
  610.     ok := outputparameters;
  611.     WHILE NOT done DO BEGIN
  612.         WRITELN;
  613.         WRITE('Enter letter of option to change -> ');
  614.         READLN(ans);
  615.         CASE ans OF
  616.             '?' : ok := outputparameters;
  617.         'X','x' : optx(ok,done,outfopen,ffopen,oldof,oldff);
  618.         'F','f' : optf;
  619.         'S','s' : opts;
  620.         'B','b' : optb;
  621.         'W','w' : optw;
  622.         'H','h' : opth;
  623.         'M','m' : optm;
  624.         'A','a' : opta;
  625.         'G','g' : optg;
  626.         'I','i' : opti;
  627.         'T','t' : optt;
  628.         'N','n' : optn;
  629.         'O','o' : opto;
  630.         'D','d' : optd;
  631.         'Z','z' : @HLT;
  632.         ELSE      BEGIN
  633.                       WRITELN('Bad character entered, try again (''?'' for menu)');
  634.                   END
  635.         END; {case}
  636.     END; {while not done}
  637. END; {procedure askparameters}
  638.  
  639.  
  640. FUNCTION outputparameters;
  641. {******************************************************************************
  642. ** Arguments: none, returns boolean
  643. ** Purpose: displays program parameters, returns TRUE if all ok.
  644. ******************************************************************************}
  645. VAR    ans : CHAR;
  646.         ok : BOOLEAN;
  647. BEGIN
  648.     WRITELN;
  649.     WRITELN('Options List');
  650.     WRITELN;
  651.     WRITELN('F:         Font File -> ',FontFn,'   ');
  652.  
  653.     WRITE('S:         Sign type -> ');
  654.     IF signtype = sign THEN
  655.         WRITELN('Sign  ')
  656.     ELSE
  657.         WRITELN('Banner');
  658.  
  659.     WRITE('B: Block/Letter type -> ');
  660.     CASE blocktype OF
  661.         letter     : WRITELN('Letters     ');
  662.         overstrike : WRITELN('OverStrikeBk')
  663.     END; {case}
  664.  
  665.     WRITELN('W:  Width Multiplier -> ',multw:1,'  ');
  666.     WRITELN('H: Height Multiplier -> ',multh:1,'  ');
  667.  
  668.     WRITELN('M: Given left margin -> ',givenoffset:1,'  ');
  669.  
  670.     IF givenoffset = 0 THEN BEGIN
  671.         WRITE('A:    Auto-Centering -> ');
  672.         IF centering = yes THEN
  673.             WRITELN('Yes')
  674.         ELSE
  675.             WRITELN('No ')
  676.     END;
  677.  
  678.     WRITELN('G:       Given Width -> ',givenwidth:1);
  679.  
  680.     WRITE('I:      Input Device -> ');
  681.     IF inputdevice = keyboard THEN
  682.         WRITELN('Keyboard')
  683.     ELSE BEGIN
  684.         WRITELN('File    ');
  685.     END; {if}
  686.  
  687.     IF inputdevice = textfile THEN BEGIN
  688.         WRITELN('T:     Text FileName -> ',infn,'   ');
  689.         WRITELN('N:  Number of Copies -> ',numcopies:1,'  ')
  690.     END;
  691.  
  692.     WRITE('O:     Output device -> ');
  693.     IF outputdevice = screen THEN
  694.         WRITELN('Screen ')
  695.     ELSE
  696.         WRITELN('File   ');
  697.  
  698.     IF givenwidth = 0 THEN BEGIN
  699.         WRITE('D:       Device size -> ');
  700.         IF devicesize = normal THEN
  701.             WRITELN('Normal')
  702.         ELSE
  703.             WRITELN('Wide  ')
  704.     END;
  705.  
  706.     IF outputdevice = recdfile THEN BEGIN
  707.         WRITELN('R:  Record Output in -> ',outfn);
  708.     END;
  709.  
  710.     WRITELN('X: Exit Parameters, return to entry menu');
  711.     WRITELN('Z: Zap Program, return to operating system');
  712.     calcavailch;
  713.     WRITELN;
  714.     WRITELN('Calculated width available -> ',availchars:1,'  ');
  715.  
  716.     ok := TRUE;
  717.     IF signtype = sign THEN BEGIN     {est based on 8+1 spaces/char}
  718.         WRITE('Approximate number of *input* characters allowed per line -> ');
  719.         WRITELN((TRUNC(availchars/(multw*(MaxWidth-1)))):1,'  ')
  720.     END ELSE BEGIN
  721.         WRITELN('The given parameters require a line ',((MaxHeight *
  722.             multh) + givenoffset):1,' long.');
  723.         IF ((MaxHeight * multh) + givenoffset) > availchars THEN BEGIN
  724.             WRITELN('Error: Output will overflow the available space!');
  725.             ok := FALSE
  726.         END
  727.     END; {if sign output approx max input line}
  728.     outputparameters := ok
  729. END; {Procedure outputparameters}
  730.  
  731.  
  732. {************************** main (dummy) program *************************}
  733. BEGIN
  734.     WRITELN('<<< program -- GSigns, ',Date,' -- started >>>');
  735.     WRITELN;
  736.     main;
  737.     WRITELN;
  738.     WRITELN('<<< program -- GSigns -- completed >>>')
  739. END.
  740. ,Date,' -- started >>>');
  741.     WRITELN;
  742.     main;
  743.