Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/printer/isigns50.arc/PRT.PAS

Pascal/Delphi Source File | 1989-10-01 | 18.5 KB | 439 lines

PROCEDURE avail_space;
VAR  pitch : REAL;
BEGIN
    IF given_width = 0 THEN
        CASE output_device OF
            printr : BEGIN
                         IF block_type <> bit THEN BEGIN
                             CASE prt_cpi OF
                                 pica     : pitch := 10;
                                 elite    : pitch := 12;
                                 squeezed : pitch := 17;      {16.66 for IDS, HP}
                                 tiny     : pitch := 20      {n/a on IDS printer}
                             END; {case}
                             IF device_size = wide THEN
                                 avail_width := TRUNC(pitch * 14)
                             ELSE
                                 avail_width := TRUNC(pitch * 8)
                             {end}
                         END ELSE BEGIN
                             CASE prt_type OF
                                 ids : IF device_size = wide THEN
                                           avail_width := 1134
                                       ELSE avail_width := 672;
                                  hp : CASE graphic_dens OF
                                           single : avail_width := 600;
                                           double : avail_width := 800;
                                           triple : avail_width := 1200;
                                           quad   : avail_width := 2400
                                       END; {case graphic_dens}
                               epson : CASE graphic_dens OF
                                           single : IF device_size = wide THEN
                                                        avail_width := 816
                                                    ELSE avail_width := 480;
                                    double,triple : IF device_size = wide THEN
                                                        avail_width := 1632
                                                    ELSE avail_width := 960;
                                           quad   : IF device_size = wide THEN
                                                        avail_width := 3264
                                                    ELSE avail_width := 1920
                                       END {case graphic_dens}
                             END {case prt_type}
                         END {if not bit}
                     END;
            screen : IF device_size = wide THEN
                         avail_width := 131
                     ELSE
                         avail_width := 79;
         recd_file : avail_width := Max_Length
        END {case}
    ELSE {width WAS given}
        avail_width := given_width;
    {end if width was not given}

    GOTORC(16,6); lowvideo; WRITE('Width available -> ');
    highvideo; WRITE(avail_width ,'  ');
    GOTORC(17,25); CLREOL; highvideo; WRITE('---') {don't know required}
END;


PROCEDURE set_up_prt; { (reset_prt : BOOLEAN) }
BEGIN
    IF reset_prt THEN
        CASE prt_type OF
           {dumb : ;  {no action}
             ids : putchr(CHR(30)+CHR(27)+'B8$'+CHR(27)+'Q4$'); {12 cpi, 6 lpi, Black}
              hp : putchr(CHR(27)+'E');
           epson : putchr(CHR(18)+CHR(27)+'P'+CHR(27)+'2')
        END {case}
    ELSE
        CASE prt_type OF
       {dumb : ;  {no action}
         ids : BEGIN
                   putchr(CHR(27)+'R2$'); {Draft quality print}
                   CASE prt_lpi OF
                       six     : putchr(CHR(27)+'B8$');
                       eight   : putchr(CHR(27)+'B6$');
                       ten     : putchr(CHR(27)+'B5$');
                       twelve  : putchr(CHR(27)+'B4$')
                   END; {case}
                   CASE prt_cpi OF
                       pica     : putchr(CHR(29));
                       squeezed : putchr(CHR(31));
                       elite    : putchr(CHR(30));
                       tiny     : putchr(CHR(30))   {20 cpi n/a on Prism, use 16.7}
                   END; {case}
                   CASE prt_color OF
                       black    : putchr(CHR(27)+'Q4$');
                       blue     : putchr(CHR(27)+'Q3$');
                       green    : putchr(CHR(27)+'Q2$');
                       red      : putchr(CHR(27)+'Q1$')
                   END; {case}
                   putchr(CHR(13));       {and a final <cr> to return head}
                   {IF block_type = BIT THEN BEGIN
                      graphics set-up - none required
                   END;}
               END;
          hp : BEGIN
                   CASE prt_lpi OF
                       six     : putchr(CHR(27)+'&l8C');
                       eight   : putchr(CHR(27)+'&l6C');
                       ten     : putchr(CHR(27)+'&l5C');
                       twelve  : putchr(CHR(27)+'&l4C')
                   END; {case}
                   CASE prt_cpi OF
                       pica     : putchr(CHR(27)+'(s10H');
                       elite    : putchr(CHR(27)+'(s12H');
                       squeezed : putchr(CHR(27)+'(s17H');
                       tiny     : putchr(CHR(27)+'(s20H')
                   END; {case}
                   putchr(CHR(13));      {and a final <cr> to return head}
                   IF block_type = BIT THEN {graphics set-up}
                       CASE graphic_dens OF
                           single : putchr(CHR(27)+'*t75R'+CHR(27)+'*r0A');
                           double : putchr(CHR(27)+'*t100R'+CHR(27)+'*r0A');
                           triple : putchr(CHR(27)+'*t150R'+CHR(27)+'*r0A');
                           quad   : putchr(CHR(27)+'*t300R'+CHR(27)+'*r0A');
                       END {case graphic_dens}
                   {END if graphics}
               END;
       epson : BEGIN
                   putchr(CHR(27)+'x0'); {Draft quality print}
                   CASE prt_lpi OF
                       six     : putchr(CHR(27)+'2');
                       eight   : putchr(CHR(27)+'0');
                       ten     : putchr(CHR(27)+'1');
                       twelve  : putchr(CHR(27)+'3'+chr(18))
                   END; {case}
                   CASE prt_cpi OF
                       pica     : putchr(CHR(27)+'P'+chr(18));
                       squeezed : putchr(CHR(27)+'P'+chr(15));
                       elite    : putchr(CHR(27)+'M'+chr(18));
                       tiny     : putchr(CHR(27)+'M'+chr(15))
                   END; {case}
                   putchr(CHR(13));       {and a final <cr> to return head}
                   IF block_type = BIT THEN
                      putchr(CHR(27)+'A'+CHR(8));  {graphics 8/72 <lf>}
                   {END}
               END
        END {case}
    {END if reset_prt}
END; {procedure set_up prt}


PROCEDURE out_char; {(ochar,ichar,action : CHAR);}
VAR i : INTEGER;
BEGIN
    CASE action OF
        'S' : BEGIN      {Start - initialize graphic lines and clear}
                 FOR i := 1 TO Max_Length DO BEGIN
                     gout_1.chr[i] := CHR(0);
                     gout_2.chr[i] := CHR(0);
                     out_line.chr[i] := CHR(0)
                 END;
                 gout_1.len := 0;
                 gout_2.len := 0;
                 out_line.len := 0
              END;
        'C' : BEGIN
                 FOR i := 1 TO out_line.len DO out_line.chr[i] := CHR(0);
                 out_line.len := 0  {Clear - clear current line}
              END;
        'A' : BEGIN           {Add - add passed char and inverse char to line}
                  out_line.len := out_line.len + 1;
                  IF (out_line.chr[out_line.len] IN [CHR(0),' ']) OR
                    ((out_line.chr[out_line.len] <> ' ') AND (ochar <> ' '))
                    THEN BEGIN
                      out_line.chr[out_line.len] := ochar;
                      out_line.ichr[out_line.len] := ichar
                  END {don't overwrite non spaces}
              END;
    'D','E' : BEGIN         {End - line completed, output}
                  IF avail_width < out_line.len+given_offset THEN
                      page_offset := 0
                  ELSE IF centering THEN
                      page_offset := ROUND((avail_width - out_line.len)/2)
                  ELSE
                      page_offset := given_offset;
                  {end if - determine left margin}
                  IF avail_width < out_line.len THEN
                      out_line.len := avail_width;
                  {end - don't output chars that'll overflow}
                  IF block_type = bit THEN
                      IF action = 'D' THEN
                          CASE prt_type OF {Done - graphic output completed.}
                               ids : out_gl_ids;
                                hp : BEGIN
                                         out_gl_hp;
                                         putchr(CHR(27)+'*rB') {end graphics}
                                     END;
                             epson : out_gl_ep
                          END {case}
                      ELSE
                          add_gline   {add graphic line to output}
                  ELSE
                      out_nline       {output non-graphic line}
              END
    END {case}
END; {procedure out_char}


PROCEDURE out_nline;
VAR
    i,j,strikes,os_lcv : INTEGER;
BEGIN
    IF inv_video THEN
        FOR j := 1 TO out_line.len DO
            out_line.chr[j] := out_line.ichr[j];
    {END if inv_video (use inverse characters)}
    IF block_type = block THEN
        FOR j := 1 TO out_line.len DO
            IF out_line.chr[j] <> ' ' THEN
                out_line.chr[j] := block_char;
        {end}
    {end inv_video (reverse sense of space)}

    IF block_type = overstrike THEN {multiple hits?}
        strikes := LENGTH(Os_Strng)
    ELSE
        strikes := 1;
    {end}
    FOR os_lcv := 1 TO strikes DO BEGIN
        FOR j := 1 TO page_offset DO putchr(' ');
        FOR j := 1 TO out_line.len DO
            IF (block_type = overstrike) AND (out_line.chr[j] <> ' ') THEN
                putchr(Os_Strng[os_lcv])
            ELSE
                putchr(out_line.chr[j]);
        {for each char in out_line}
        putchr(CHR(13))             {<cr>}
    END; {for overstrikes}
    putchr(CHR(10))                 {<lf>}
END; {procedure out_nline}


PROCEDURE add_gline;
VAR
   add : BYTE;
     i,bit_pos,byte_pos : INTEGER;
BEGIN
    CASE prt_type OF
        ids : BEGIN
                  CASE bit_cnt OF
                      0 : add := 1;
                      1 : add := 2;
                      2 : add := 4;
                      3 : add := 8;
                      4 : add := 16;
                      5 : add := 32;
                      6 : add := 64
                  END; {case}
                  FOR i := 1 TO out_line.len DO
                      IF out_line.chr[i] <> ' ' THEN
                          gout_1.chr[i+page_offset] := {turn bit on}
                             CHR(ORD(gout_1.chr[i+page_offset]) + add);
                  IF out_line.len+page_offset > gout_1.len THEN
                      gout_1.len := out_line.len+page_offset;  {use longest length}
                  IF bit_cnt < 6 THEN
                      bit_cnt := bit_cnt + 1
                  ELSE BEGIN
                      bit_cnt := 0;
                      out_gl_ids            {dump the line}
                  END
              END;
         hp : BEGIN
                  bit_pos := 0;
                  FOR i := 1 TO out_line.len DO BEGIN
                      IF out_line.chr[i] <> ' ' THEN BEGIN
                          byte_pos := TRUNC(0.99 + ((i+page_offset)/8));
                          CASE bit_pos OF
                              0 : add := 128;
                              1 : add :=  64;
                              2 : add :=  32;
                              3 : add :=  16;
                              4 : add :=   8;
                              5 : add :=   4;
                              6 : add :=   2;
                              7 : add :=   1
                          END; {case}
                          gout_1.chr[byte_pos] := CHR(ORD(gout_1.chr[byte_pos]) + add)
                      END;
                      IF bit_pos = 7 THEN
                          bit_pos := 0
                      ELSE
                          bit_pos := bit_pos + 1
                  END; {for each char in out_line}
                  gout_1.len := TRUNC(0.99 + ((out_line.len+page_offset)/8));
                  out_gl_hp
              END;
      epson : BEGIN
                  IF graphic_dens IN [single,double] THEN
                      CASE bit_cnt OF
                          0 : add := 128;
                          1 : add := 64;
                          2 : add := 32;
                          3 : add := 16;
                          4 : add := 8;
                          5 : add := 4;
                          6 : add := 2;
                          7 : add := 1
                      END {case}
                  ELSE
                      CASE bit_cnt OF
                          0 : add := 128;
                          1 : add := 128;
                          2 : add := 64;
                          3 : add := 64;
                          4 : add := 32;
                          5 : add := 32;
                          6 : add := 16;
                          7 : add := 16;
                          8 : add := 8;
                          9 : add := 8;
                         10 : add := 4;
                         11 : add := 4;
                         12 : add := 2;
                         13 : add := 2;
                         14 : add := 1;
                         15 : add := 1;
                      END; {case}
                  {END}
                  FOR i := 1 TO out_line.len DO
                      IF out_line.chr[i] <> ' ' THEN
                          IF graphic_dens IN [single,double] THEN
                              gout_1.chr[i+page_offset] :=
                                 CHR(ORD(gout_1.chr[i+page_offset]) + add)
                          ELSE BEGIN
                              IF bit_cnt IN [0,2,4,6,8,10,12,14] THEN
                                  gout_1.chr[i+page_offset] :=
                                     CHR(ORD(gout_1.chr[i+page_offset]) + add)
                              ELSE
                                  gout_2.chr[i+page_offset] :=
                                     CHR(ORD(gout_2.chr[i+page_offset]) + add)
                              {end}
                          END;
                      {end if non blank}
                  {end for each output char}
                  IF out_line.len+page_offset > gout_1.len THEN
                      gout_1.len := out_line.len+page_offset;  {use longest length}
                  IF graphic_dens IN [single,double] THEN
                      IF bit_cnt < 7 THEN
                          bit_cnt := bit_cnt + 1
                      ELSE BEGIN
                          out_gl_ep;            {dump the line}
                          bit_cnt := 0
                      END
                  ELSE
                      IF bit_cnt < 15 THEN
                          bit_cnt := bit_cnt + 1
                      ELSE BEGIN
                          out_gl_ep;            {dump the lines}
                          bit_cnt := 0
                      END
                  {end}
              END
    END {case}
END; {procedure add_gline}


PROCEDURE out_gl_ids;
VAR i : INTEGER;
BEGIN
    putchr(CHR(3));         {into graphics}
    FOR i := 1 TO gout_1.len DO BEGIN
        putchr(gout_1.chr[i]);
        IF gout_1.chr[i] = CHR(3) THEN putchr(CHR(3))   {double all ^C's}
    END;
    putchr(CHR(3)+CHR(2)+CHR(14)); {out of graphics, <cr> and graphics <lf>}
    FOR i := 1 TO gout_1.len DO
        gout_1.chr[i] := CHR(0); {clear graphics line}
    gout_1.len := 0  {reset length}
END; {procedure out_gl_ids}


PROCEDURE out_gl_hp;
VAR i,err : INTEGER;
    slen : STRING[4];
BEGIN
    STR(gout_1.len,slen);          {convert length to string}
    putchr(CHR(27)+'*b'+slen+'W');
    FOR i := 1 TO gout_1.len DO
        putchr(gout_1.chr[i]);
    FOR i := 1 TO gout_1.len DO
        gout_1.chr[i] := CHR(0); {clear graphics line}
    gout_1.len := 0  {reset length}
END; {procedure out_gl_hp}


PROCEDURE out_gl_ep;
VAR i : INTEGER;
   n1,n2 : CHAR;
BEGIN
    n1 := CHR(gout_1.len MOD 256);
    n2 := CHR(TRUNC(gout_1.len/256));
    CASE graphic_dens OF
        single : BEGIN {60 dpi horz, 72 dpi vert}
                     putchr(CHR(27)+'K'+n1+n2);
                     FOR i := 1 TO gout_1.len DO
                         putchr(gout_1.chr[i]);
                     putchr(CHR(13)+CHR(10))
                 END;
        double : BEGIN {120 dpi horz, 72 dpi vert}
                     putchr(CHR(27)+'L'+n1+n2);
                     FOR i := 1 TO gout_1.len DO
                         putchr(gout_1.chr[i]);
                     putchr(CHR(13)+CHR(10))
                 END;
        triple : BEGIN {120 dpi horz, 144 dpi vert - interleaved lines}
                     putchr(CHR(27)+'3'+CHR(1));      {lf=1/214"}
                     putchr(CHR(27)+'L'+n1+n2);
                     FOR i := 1 TO gout_1.len DO      {first line}
                         putchr(gout_1.chr[i]);
                     putchr(CHR(13)+CHR(10));
                     putchr(CHR(27)+'3'+CHR(23));     {lf=23/214"}
                     putchr(CHR(27)+'L'+n1+n2);
                     FOR i := 1 TO gout_1.len DO      {second line}
                         putchr(gout_2.chr[i]);
                     putchr(CHR(13)+CHR(10))
                 END;
          quad : BEGIN {240 dpi horz, 144 dpi vert - interleaved lines}
                     putchr(CHR(27)+'3'+CHR(1));      {lf=1/214"}
                     putchr(CHR(27)+'Z'+n1+n2);
                     FOR i := 1 TO gout_1.len DO      {first line}
                         putchr(gout_1.chr[i]);
                     putchr(CHR(13)+CHR(10));
                     putchr(CHR(27)+'3'+CHR(23));     {lf=23/214"}
                     putchr(CHR(27)+'Z'+n1+n2);
                     FOR i := 1 TO gout_1.len DO      {second line}
                         putchr(gout_2.chr[i]);
                     putchr(CHR(13)+CHR(10))
                 END
    END; {case}
    FOR i := 1 TO gout_1.len DO BEGIN
        gout_1.chr[i] := CHR(0);
        gout_2.chr[i] := CHR(0)
    END;
    gout_1.len := 0  {reset count}
END;  {procedure out_gl_ep}