!TITLE  Source of WIDELIST
!<

%external %integer %fn %spec   UINFI (%integer PARM) { 15 = terminal width }
%SYSTEM %ROUTINE %SPEC         FILL(%INTEGER  LENGTH,START,CHARACTER)
%SYSTEM %ROUTINE %SPEC         IOCP(%INTEGER  EPNO,PARM)
%SYSTEM %ROUTINE %SPEC         P SYSMES(%INTEGER ROOT,ERROR)
%SYSTEM %STRING(15) %FN %SPEC  ITOS(%INTEGER I)
%SYSTEM %INTEGER %FN %SPEC     PSTOI(%STRING(15) S)
%EXTERNAL %INTEGER %FN %SPEC   RETURN CODE
%EXTERNAL %ROUTINE %SPEC       CLEAR(%STRING(255) STREAM)
%EXTERNAL %ROUTINE %SPEC       DEFINE(%STRING(255) STREAMS)
%EXTERNAL %ROUTINE %SPEC       DESTROY(%STRING(255) FILE)
%SYSTEM %ROUTINE %SPEC         SET F NAME(%STRING(255) S)
%EXTERNAL %ROUTINE %SPEC       SS F OFF
%EXTERNAL %ROUTINE %SPEC       SS F ON
%EXTERNAL %ROUTINE %SPEC       NEW SMFILE(%STRING(255) FILE AND SIZE)
%EXTERNAL %INTEGER %FN %SPEC   SM ADDR(%INTEGER CHANNEL, %INTEGER %NAME LENGTH)
%SYSTEM %INTEGER %FN %SPEC     PD ADDR(%STRING(255) FILE)
%EXTERNAL %ROUTINE %SPEC       PROMPT(%STRING(15) TEXT)


%EXTERNAL %ROUTINE  WIDELIST(%STRING(255) PARAMETER)

%CONST %INTEGER   FIRST LINE=0, %C
                  FF=12

%INTEGER  TO BEGIN WITH, %C
          LP PAGE LENGTH, %C
          MIN COL WIDTH, %C
          COLUMN GAP, %C
          LP PAGE WIDTH, %C
          PAGE SIZE, %C
          LAST LINE, %C
          BUFFER WIDTH


%INTEGER  LINE WIDTH, %C
          WIDTH, %C
          LINE COUNT, %C
          FILE, %C
          BUFFER, %C
          START, %C
          BUFFER START, %C
          BUFFER LENGTH, %C
          LINE START, %C
          TOP MARGIN, %C
          BOTTOM MARGIN, %C
          RIGHT, %C
          HOLD, %C
          END OF FILE

%ROUTINE  EXAMINE NEXT(%INTEGERNAME  PAGE WIDTH)
%INTEGER  LNS,WD,PTR

   PAGE WIDTH=MIN COL WIDTH; LNS=0; WD=0; PTR=FILE
   %WHILE PTR#END OF FILE %CYCLE
      PAGE WIDTH=WD %IF WD>PAGE WIDTH
      %IF BYTEINTEGER(PTR)=NL %START
         LNS=LNS+1; WD=0
         %RETURN %IF LNS=LP PAGE LENGTH-BOTTOM MARGIN
      %FINISH %ELSE %START
         %RETURN %IF BYTEINTEGER(PTR)=FF
         WD=WD+1
      %FINISH
      PTR=PTR+1
   %REPEAT
%END

%ROUTINE  GET A PAGE(%INTEGER  MARGIN USED)
   LINE COUNT=TOP MARGIN
   BUFFER=BUFFER START+1+MARGIN USED + LINE COUNT*BUFFER WIDTH
   LINE START=BUFFER START + LINE COUNT*BUFFER WIDTH
   %WHILE FILE#END OF FILE %CYCLE
      %IF BYTEINTEGER(FILE)=NL %START
         BUFFER=LINE START+BUFFER WIDTH
         LINE START=BUFFER; BUFFER=BUFFER+MARGIN USED+1
         FILE=FILE+1; LINE COUNT=LINE COUNT+1
         %RETURN %IF LINE COUNT=LP PAGE LENGTH-BOTTOM MARGIN
      %FINISH %ELSE %START
         FILE=FILE+1 %AND %RETURN %IF BYTEINTEGER(FILE)=FF
         BYTEINTEGER(BUFFER)=BYTEINTEGER(FILE) %C
            %UNLESS BUFFER>=LINE START+BUFFER WIDTH
         FILE=FILE+1; BUFFER=BUFFER+1
      %FINISH
   %REPEAT
%END

%ROUTINE  OUTPUT PAGE
   %CYCLE  START=BUFFER START+FIRST LINE,BUFFER WIDTH,BUFFER START+LAST LINE-BUFFER WIDTH
      BYTE INTEGER(START)=LP PAGE WIDTH
      BYTE INTEGER(START)=BYTE INTEGER(START)-1 %C
         %WHILE BYTEINTEGER(START+BYTEINTEGER(START))=' '
      IOCP(15,START)
      NEWLINE
   %REPEAT
   %IF HOLD=1 %START
      SKIP SYMBOL %AND FILE=ENDOFFILE %IF NEXT SYMBOL='*'
      SKIP SYMBOL %WHILE NEXT SYMBOL#NL;SKIPSYMBOL
   %FINISH
%END

%ROUTINE  CLEAR BUFFER
   FILL(PAGE SIZE,BUFFER START,' ')
%END

%ROUTINE DO(%STRING(255) TEXT)
%STRING(255) NAME,VALUE,FULL
%INTEGER NUMBER
   %RETURN %IF TEXT=""
   NAME=TEXT
   FULL="HOLD"; %IF FULL->(TEXT).FULL %THEN HOLD=1 %AND %RETURN
   %IF TEXT->NAME.("=").VALUE %START
   
      NUMBER=PSTOI(VALUE)
      SET F NAME(VALUE) %AND P SYSMES(29,202) %AND %STOP %IF NUMBER<0
   
      FULL="WIDTH"; %IF FULL->(NAME).FULL  %THEN LP PAGE WIDTH=NUMBER %AND %RETURN
      FULL="RIGHT"; %IF FULL->(NAME).FULL  %THEN RIGHT=NUMBER %AND %RETURN
      FULL="LENGTH"; %IF FULL->(NAME).FULL %AND LENGTH(NAME)>2 %THEN LP PAGE LENGTH=NUMBER %AND %RETURN
      FULL="PAGE"; %IF FULL->(NAME).FULL %THEN LP PAGE LENGTH=NUMBER %AND %RETURN
      FULL="MARGIN"; %IF FULL->(NAME).FULL  %THEN TO BEGIN WITH=NUMBER %AND %RETURN
      FULL="LEFT"; %IF FULL->(NAME).FULL %AND LENGTH(NAME)>2 %THEN TO BEGIN WITH=NUMBER %AND %RETURN
      FULL="GAP"; %IF FULL->(NAME).FULL  %THEN COLUMN GAP=NUMBER %AND %RETURN
      FULL="SEP"; %IF FULL->(NAME).FULL %THEN COLUMN GAP=NUMBER %AND %RETURN
      FULL="COLUMN"; %IF FULL->(NAME).FULL  %THEN MIN COL WIDTH=NUMBER %AND %RETURN
      FULL="TOP"; %IF FULL->(NAME).FULL  %THEN TOP MARGIN=NUMBER %AND %RETURN
      FULL="BOTTOM"; %IF FULL->(NAME).FULL  %THEN BOTTOM MARGIN=NUMBER %AND %RETURN
   %FINISH
   
   SET F NAME(NAME)
   P SYSMES(29,202)
   %STOP
%END

%STRING(255) INPUT,OUTPUT,OPTIONS,ONE OPTION
%INTEGER CONAD

   TO BEGIN WITH=0
   MIN COL WIDTH=0
   LP PAGE LENGTH=66
   LP PAGE WIDTH=132
   BUFFER WIDTH=LP PAGE WIDTH+1
   COLUMN GAP=1
   PAGE SIZE=BUFFER WIDTH*(LP PAGE LENGTH+1)
   LAST LINE=BUFFER WIDTH*(LP PAGE LENGTH)
   TOP MARGIN=0
   BOTTOM MARGIN=0
   RIGHT=0
   HOLD=0

   %IF PARAMETER->PARAMETER.("/").OPTIONS %START
   
      %WHILE OPTIONS->ONE OPTION.("/").OPTIONS %CYCLE
         DO(ONE OPTION)
      %REPEAT
   
   DO(OPTIONS)
   %FINISH

   LP PAGE WIDTH=LP PAGE WIDTH-RIGHT
   BUFFER WIDTH=LP PAGE WIDTH+1
   PAGE SIZE=BUFFER WIDTH*(LP PAGE LENGTH+1)
   LAST LINE=BUFFER WIDTH*LP PAGE LENGTH

   %IF PARAMETER->INPUT.(",").OUTPUT %START
   %FINISH %ELSE INPUT=PARAMETER %AND OUTPUT=".OUT"
   
   P SYSMES(29,263) %AND %STOP %IF INPUT=""
   
   SS F OFF
   CLEAR("1")
   CLEAR("4")
   DEFINE("1,T#PAGER")
   DEFINE("4,".OUTPUT)
   SS F ON
   
   P SYSMES(29,RETURN CODE) %AND %STOP %IF RETURN CODE#0
   
   CONAD = pd addr(INPUT)
   P SYSMES(29,-CONAD) %IF CONAD<0
   SET F NAME(INPUT)
   P SYSMES(29, 288) %IF CONAD=0
   %STOP %IF CONAD<=0
   
   FILE = CONAD+INTEGER(CONAD+4)
   END OF FILE = CONAD+INTEGER(CONAD)
   
   P SYSMES(29,267) %AND %STOP %IF INTEGER(CONAD+12)#3
   
   SS F OFF
   NEW SM FILE("T#PAGER,".ITOS(PAGE SIZE))
   SS F ON
   
   BUFFER START = SM ADDR(1,BUFFER LENGTH)
   
   SELECT OUTPUT(4)
   
   PROMPT("")
   
   %IF OUTPUT->(".").PARAMETER %THEN NEWPAGE
   
   %WHILE FILE#END OF FILE %CYCLE
      CLEAR BUFFER
      EXAMINE NEXT(LINE WIDTH)
      GET A PAGE(TO BEGIN WITH)
      LINE WIDTH=LINE WIDTH+TO BEGIN WITH
      %WHILE FILE#ENDOFFILE %CYCLE
         EXAMINE NEXT(WIDTH)
         %EXIT %IF LINE WIDTH+WIDTH+COLUMN GAP>LP PAGE WIDTH
         LINE WIDTH=LINE WIDTH+COLUMN GAP
         GET A PAGE(LINE WIDTH)
         LINE WIDTH=LINE WIDTH+WIDTH
      %REPEAT
      OUTPUT PAGE
   %REPEAT
   
   SS F OFF
   DESTROY("T#PAGER")
   SS F ON
   
%END

%external %routine        PERUSE(%string(255) File)
   WIDE LIST(File."/WI=".ITOS(UINFI(15)-1)."/PA=23/HO")
%end

%end %of %file
!>