CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol062/dotext.pas

Pascal/Delphi Source File | 1984-04-29 | 4.8 KB | 193 lines

EXTERNAL KFORMAT::DOTEXT;

{+++++++++++++++++++++++++++++++++++++++++++++++++++}
{+ DOTEXT MODULE FOR KFORMAT Text Output Processor +}
{+++++++++++++++++++++++++++++++++++++++++++++++++++}

{ compiler options for Pascal/Z compiler. }
{$C-}{ control-c checking OFF }
{$M-}{ integer mult & divd error checking OFF }
{$F-}{ floating point error checking OFF }

{
    process text
}
PROCEDURE DOTEXT(inbuf:BUFFER);
VAR    i    :int;
    wordbuf :BUFFER;

  {
    delete leading blanks & set tival
  }
  PROCEDURE LEADBL(VAR lbbuf:BUFFER);
  VAR    i :int;
  BEGIN
    DOBREAK;
    i := 1;
    WHILE ((lbbuf[i]=SPACE) and (i < LENGTH(lbbuf))) DO i := i + 1;
    IF (lbbuf[i] <> NEWLINE) THEN tival := tival + i - 1;
    IF ( i<>1 ) THEN DELETE(lbbuf,1,i-1);    { *** 3-81 *** }
  END;


  {
    width of a printed line
  }
  FUNCTION WIDTH(VAR w:BUFFER):int;
  VAR    i,wdth :int;
  BEGIN
    wdth := 0;
    FOR i := 1 TO LENGTH(w) DO
      IF (w[i]=BACKSPACE) THEN
    wdth := wdth - 1
      ELSE IF (w[i] <> NEWLINE) THEN
    wdth := wdth + 1;
    WIDTH := wdth;
  END;

  {
    centers by setting temporary indent
  }
  PROCEDURE CENTER(VAR cebuf:BUFFER);
  var    k: int;
  BEGIN
    k := ( rmval + tival - WIDTH(cebuf) ) DIV 2;
    tival := IMAX( k,0 );
  END;

  {
    replace non-white space chars with bksp, "_"
  }
  PROCEDURE UNDERLINE(VAR inbuf:BUFFER);
  VAR    u :int;
    ulstr :DSTRING;
  BEGIN
    ulstr := '  ';
    ulstr[1] := BACKSPACE;
    ulstr[2] := '_';
    u := 1;
    WHILE (u <= LENGTH(inbuf)) DO
      begin
      IF ( (inbuf[u] <> SPACE)
       AND (inbuf[u] <> TAB)
       AND (inbuf[u] <> BACKSPACE)
       AND (inbuf[u] <> NEWLINE) ) THEN
    BEGIN  INSERT(ulstr,inbuf,u+1);
           u := u + 3
    END
      ELSE
    u := u + 1;
      end;
  END;

  {
    spread words to justify right margin
  }
  PROCEDURE SPREAD(VAR outbuf:BUFFER; outp, nextra, outwds:int);
  VAR    nb,    { number blanks }
    ne,    { number extra    }
    nholes, { number holes    }
    i, j: int;
  BEGIN
    IF (nextra > 0) THEN
      BEGIN{nextra > 0}
    IF (outwds > 0) and ( spacefill ) THEN
      BEGIN
        direction := NOT direction;     { tobble bias direction }
        ne := nextra;
        nholes := outwds - 1;
        i := LENGTH(outbuf) - 1;         { point at final non-blank }
        WHILE ( ne > 0 ) DO
          BEGIN
        WHILE ( outbuf[i] <> SPACE ) DO i := i - 1;
        IF ( direction ) THEN
          nb := (ne-1) DIV nholes + 1    { rounded }
        ELSE
          nb := ne DIV nholes;        { truncated }
        ne := ne - nb;
        nholes := nholes - 1;
        WHILE ( nb > 0 ) DO        { insert extra blanks }
          BEGIN
            INSERT(' ',outbuf,i+1);
            nb := nb - 1;
          END;
        i := i - 1
          END {while ne > 0}
      END
      END {IF nextra > 0}
  END;

  {
    put a word in outbuf including margin justification
  }
  PROCEDURE PUTWORD(VAR pwbuf:BUFFER);
  VAR    w, last,
    llval, nextra: int;
  BEGIN
    w := WIDTH(pwbuf); { printable width of pwbuf }
    last := LENGTH(pwbuf) + outp + 1;    { new end of outbuf }
    llval := rmval - tival;  { printable line length }
    IF ((outp > 0)
      AND ( ((outw + w) > llval) OR (last > MAXBUF) ) ) THEN{ too big }
    BEGIN
      last := last - outp; { remember end of wrdbuf }
      nextra := llval - outw + 1; { # blanks needed to pad }
      IF ( spacefill ) THEN
        SPREAD(outbuf,outp,nextra,outwds);
      IF ((nextra > 0) AND (outwds > 1)) THEN
        outp := outp + nextra;
      DOBREAK { flush previous line }
    END;
    outp := last;
    { *  outbuf := CONCAT(outbuf,pwbuf,space);    * }
    append(outbuf,pwbuf);        { add new word to outbuf }
    append(outbuf,space);        { add a blank         }
    outw := outw + w + 1;        { update output width     }
    outwds := outwds + 1;        { increment the word count }
  END;


  {
    get a non-blank word from inbuf[] to wdbuf[] and
    advance g.  Returns length of wdbuf.
  }
  FUNCTION GETWORD(VAR inbuf: BUFFER; VAR g: int; VAR wdbuf: BUFFER):int;
  VAR    st: int;
  BEGIN
    WHILE (((inbuf[g]=SPACE) OR (inbuf[g]=TAB))
      AND (g < LENGTH(inbuf))) DO g := g + 1;
    st := g;
    SKIPCHARS(inbuf,g);
    wdbuf := COPY(inbuf,st,g-st);
    GETWORD := LENGTH(wdbuf);
  END;

BEGIN {dotext}
  IF ((inbuf[1]=SPACE) OR (inbuf[1]=NEWLINE)) THEN
    LEADBL(inbuf);            { * move left, set tival * }
  IF ( ulval > 0 ) THEN         { * underlining * }
    BEGIN
      UNDERLINE(inbuf);
      ulval := ulval - 1
    END;
  IF ( ceval > 0 ) THEN         { * centering in effect * }
    BEGIN
      CENTER(inbuf);
      PUTTEXT(inbuf);
      ceval := ceval - 1;
    END
  ELSE IF (inbuf[1]=NEWLINE) THEN    { * all blank line * }
    PUTTEXT(inbuf)
  ELSE IF ( NOT fill ) THEN        { * un-filled text passes * }
    PUTTEXT(inbuf)            { * text "as is"      * }
  ELSE                    { * filled text * }
    BEGIN
      i := 1;
      WHILE ( GETWORD(inbuf,i,wordbuf) > 0 ) DO
    PUTWORD(wordbuf);
    END;
END;  {dotext}

{END EXTERNAL}.