%%s 0/0/0
%%d D 1.1 25-Mar-82 12:02:09 v1.1 1 0
%%c Version 1.1 is the Spring 1982 Distribution of the LBL/Hughes release
%%c of the Software Tools Virtual Operating System software and documentation.
%%T
%%I 1
#-h- cbox             739  asc  25-mar-82 07:23:02  v1.1 (sw-tools v1.1)
## CBox -- Common block for ``box''.

common / cbox /	entabf,
		grfoff(3),
		grfon(3),
		grfprf,
		grfblk,
		nwcorn,
		necorn,
		swcorn,
		secorn,
		hedge,
		vedge

integer		entabf	# YES => entab lines before outputting.

character	grfoff	# string to turn graphics-mode OFF
character	grfon	# string to turn graphics-mode ON
character	grfprf	# prefix character for graphics-mode; EOS if none.
character	grfblk	# character which prints as a BLANK in graphics mode.
character	nwcorn	# north-west corner character
character	necorn	# north-east corner character
character	swcorn	# south-west corner character
character	secorn	# south-east corner character
character	hedge	# horizontal edge character
character	vedge	# vertical   edge character
#-h- cfd              148  asc  25-mar-82 07:23:02  v1.1 (sw-tools v1.1)
## CFd    -- Common block for box's file descriptors.

common / cfd /	ifd, ofd

filedes ifd	# Input stream to be boxed.
filedes ofd	# Ouput stream.
#-h- ctabs            128  asc  25-mar-82 07:23:03  v1.1 (sw-tools v1.1)
## CTabs   -- Common block for tab-stop array.

common / ctabs / tabs(MAXLINE)

integer tabs	# YES => TAB set in column tab(i).
#-h- box.r          12387  asc  25-mar-82 07:23:05  v1.1 (sw-tools v1.1)
#-h- defns            200  asc  25-mar-82 07:22:34  v1.1 (sw-tools v1.1)
## Defns -- Definitions for ``box''.

define(NORTH_WEST_CORNER,1)
define(NORTH_EAST_CORNER,2)
define(SOUTH_WEST_CORNER,3)
define(SOUTH_EAST_CORNER,4)
define(HORIZONTAL_EDGE,5)
define(VERTICAL_EDGE,6)
#-h- box             1162  asc  25-mar-82 07:22:34  v1.1 (sw-tools v1.1)
## Box -- Draw boxes around block structure of RatFor or C programs.

DRIVER(box)

character fil(FILENAMESIZE), lin(MAXLINE)
filedes   nxtfil # function(s)
integer   begblk, getarg, getlin, stmode, note # function(s)
integer   i, marker(2), maxlen, maxlvl, ndx, omode, junk

include   cfd

call query( "usage:  box [-e] [-d{device}] [-] file ..." )
call boxarg		# Process option flags
ofd = STDOUT
omode = stmode( ofd, RARE)
call putch( LF, ofd)	# Don't overwrite our own command line.
ndx = 1
repeat
{
  ifd = nxtfil( fil, ndx)
  ndx = ndx + 1
  if( ifd == EOF )
      break

  while( getlin( lin, ifd) != EOF )
  {
  
    if( begblk(lin) == NO )
    {
      for( i = 1 ; lin(i) != EOS ; i = i + 1 )
      {
        if( lin(i) != '@n' )
          call putch( lin(i), ofd)
        else
        {
          if( omode != COOKED )
           call putch( CR, ofd)
          call putch( '@n', ofd)
        }
      }
    }
    else
    {
      junk = note ( marker, ifd)
      call measur( maxlen, maxlvl)
      call seek( marker, ifd)
      call proces( maxlen, maxlvl)
    }
  }
  if( ifd != STDIN )
    call close(ifd)
}
  
omode = stmode( ofd, COOKED)
DRETURN
end
#-h- begblk           269  asc  25-mar-82 07:22:35  v1.1 (sw-tools v1.1)
# BegBlk - Return YES if line "starts" with begin block symbol.

integer function begblk(lin)

character lin(MAXLINE)
integer   i

for( i = 1 ; (lin(i) == ' ' | lin(i) == '@t') & lin(i) != EOS ; i = i + 1 )
  ;

if( lin(i) == '{' )
  return(YES)
else
  return(NO)

end
#-h- boxarg          1749  asc  25-mar-82 07:22:36  v1.1 (sw-tools v1.1)
## BoxArg -- Process argument flags for `box'.

subroutine boxarg

integer    i
integer    equal, getarg # function(s)
character  arg(FILENAMESIZE)
include    cbox		# Graphic control information and ``entabf'' flag.
include    ctabs	# Tab stop array.

# Initialize graphic-control strings and characters to default values.

data grfoff(1)	/ EOS /
data grfon(1)	/ EOS /
data grfprf	/ EOS /
data grfblk	/ ' ' /
data nwcorn	/ '+' /
data necorn	/ '+' /
data swcorn	/ '+' /
data secorn	/ '+' /
data hedge	/ '-' /
data vedge	/ '|' /

data entabf	/ NO /		# Assume no entab as default.

call settab( EOS, tabs)		# Initialize '@t' stop array.

for( i = 1 ; getarg( i, arg, FILENAMESIZE) != EOF ; i = i + 1 )
{
  if( arg(1) == '-' & arg(2) != EOS )	# We have an option specifier.
  {
    call fold(arg)
    if( arg(2) == 'd' )	# Device type specification.
    {
      if( equal( arg(3), "vt100") == YES )
      {
        call strcpy( "(0", grfon)
        call strcpy( "(B", grfoff)
        grfprf = ESC
        grfblk = '_'
        nwcorn = 'l'
        necorn = 'k'
        swcorn = 'm'
        secorn = 'j'
        hedge  = 'q'
        vedge  = 'x'
      }
      else if( equal( arg(3), "h19") == YES )
      {
        call strcpy( "F", grfon)
        call strcpy( "G", grfoff)
        grfprf = ESC
        grfblk = ' '
        nwcorn = 'f'
        necorn = 'c'
        swcorn = 'e'
        secorn = 'd'
        hedge  = 'a'
        vedge  = '`'
      }
      else
      call boxerr( "I don't know about a ", arg(3), " device.")
    }
    else if( arg(2) == 'e' )	# Entab option flag.
      entabf = YES
    else
      call boxerr( "I don't know about a ", arg(2), " option.")
    call delarg(i)
    i = i - 1		# Compensate for ``delarg''.
  }
}

return
end
#-h- boxerr           394  asc  25-mar-82 07:22:37  v1.1 (sw-tools v1.1)
## BoxErr -- Output error message for ``box''.

subroutine boxerr( str1, str2, str3)

character  str1(ARB), str2(ARB), str3(ARB)
string     boxstr "? Box: "
string     qst1 "``"
string     qst2 "''"

call putlin( boxstr, ERROUT)
call putlin( str1, ERROUT)
call putlin( qst1, ERROUT)
call putlin( str2, ERROUT)
call putlin( qst2, ERROUT)
call remark( str3)
call putch( '@n', ERROUT)

return
end
#-h- boxlin          1297  asc  25-mar-82 07:22:37  v1.1 (sw-tools v1.1)
## BoxLin -- Translate BOX codes and output line on `ofd'

subroutine boxlin(inplin)

character inplin(ARB), lin(MAXLINE)
integer   i
include   cbox
include   cfd
include   ctabs

if( entabf == YES )
  call entabl( inplin, lin, tabs)
else
  call strcpy( inplin, lin)

for( i = 1 ; lin(i) != EOS ; i = i + 1 )
{
  if( lin(i) == NORTH_WEST_CORNER )
  {
    call grafic( grfon, ofd)
    call putch( nwcorn, ofd)
    for( i = i + 1 ; lin(i) == HORIZONTAL_EDGE ; i = i + 1 )
      call putch( hedge, ofd)
    if( lin(i) == NORTH_EAST_CORNER )
      call putch( necorn, ofd)
    else
      i = i - 1
    call grafic( grfoff, ofd)
  }
  else if( lin(i) == SOUTH_WEST_CORNER )
  {
    call grafic( grfon, ofd)
    call putch( swcorn, ofd)
    for( i = i + 1 ; lin(i) == HORIZONTAL_EDGE ; i = i + 1 )
      call putch( hedge, ofd)
    if( lin(i) == SOUTH_EAST_CORNER )
      call putch( secorn, ofd)
    else
      i = i - 1
    call grafic( grfoff, ofd)
  }
  else if( lin(i) == VERTICAL_EDGE )
  {
    call grafic( grfon, ofd)
    for( ; lin(i) == VERTICAL_EDGE | lin(i) == ' ' ; i = i + 1 )
    {
      if( lin(i) == ' ' )
        call putch( grfblk, ofd)
      else
        call putch( vedge, ofd)
    }
    call grafic( grfoff, ofd)
    i = i - 1
  }
  else
    call putch( lin(i), ofd)
}

return
end
#-h- detabl           467  asc  25-mar-82 07:22:38  v1.1 (sw-tools v1.1)
## DeTabL -- Detab `in' into `out' using `tabs'

subroutine detabl( in, out, tabs)

character  in(ARB), out(ARB)
integer    i, j, ondx, tabs(ARB)
integer    tabpos # function(s)

ondx = 1
for( i = 1 ; in(i) != EOS ;  i = i + 1 )
{
  if( in(i) == '@t' )
  {
    j = i
    repeat
    {
      call chcopy( ' ', out, ondx)
      j = j + 1
      if( tabpos( j, tabs) == YES )
        break
    }
  }
  else
    call chcopy( in(i), out, ondx)
}
out(ondx) = EOS

return
end
#-h- dobot            280  asc  25-mar-82 07:22:39  v1.1 (sw-tools v1.1)
## DoBot -- Output bottom of box.

integer function dobot( lin, start, stop)

character  lin(ARB)
integer    i, start, stop

i = start

call chcopy( SOUTH_WEST_CORNER, lin, i)

for( ; i <= stop ; i = i + 1 )
  lin(i) = HORIZONTAL_EDGE

lin(i) = SOUTH_EAST_CORNER

return(i+1)
end
#-h- doleft           266  asc  25-mar-82 07:22:39  v1.1 (sw-tools v1.1)
## DoLeft -- Output left side(s) of boxes.

integer function doleft( lin, ndx, count)

character  lin(ARB)
integer    count, i, n, ndx

i = ndx

for( n = count ; n > 0 ; n = n - 1 )
{
  call chcopy( VERTICAL_EDGE, lin, i)
  lin(i) = ' '
  i = i + 1
}

return(i)
end
#-h- dorite           268  asc  25-mar-82 07:22:40  v1.1 (sw-tools v1.1)
## DoRite -- Output right side(s) of boxes.

integer function dorite( lin, ndx, count)

character  lin(ARB)
integer    count, i, n, ndx

i = ndx

for( n = count ; n > 0 ; n = n - 1 )
{
  call chcopy( ' ', lin, i)
  call chcopy( VERTICAL_EDGE, lin, i)
}

return(i)
end
#-h- dotop            277  asc  25-mar-82 07:22:40  v1.1 (sw-tools v1.1)
## DoTop -- Output top of box.

integer function dotop( lin, start, stop)

character  lin(ARB)
integer    i, start, stop

i = start

call chcopy( NORTH_WEST_CORNER, lin, i)

for( ; i <= stop ; i = i + 1 )
  lin(i) = HORIZONTAL_EDGE

lin(i) = NORTH_EAST_CORNER

return(i+1)
end
#-h- endblk           269  asc  25-mar-82 07:22:41  v1.1 (sw-tools v1.1)
# EndBlk - Return YES if line "starts" with an end block symbol.

integer function endblk(lin)

character lin(MAXLINE)
integer   i

for( i = 1 ; (lin(i) == ' ' | lin(i) == '@t' ) & lin(i)!=EOS ; i = i + 1 )
  ;

if( lin(i) == '}' )
  return(YES)
else
  return(NO)

end
#-h- entabl           550  asc  25-mar-82 07:22:41  v1.1 (sw-tools v1.1)
## EnTabL -- Entab `in' into `out' using `tabs'.

subroutine entabl( in, out, tabs)

character  in(ARB), out(ARB)
integer    col, newcol, ondx, tabs(ARB)
integer    tabpos # function(s)

ondx = 1
for( col = 1 ; in(col) != EOS ; col = col + 1 )
{
  newcol = col
  while( in(newcol) == ' ' )
  {
    newcol = newcol + 1
    if( tabpos( newcol, tabs) == YES )
    {
      call chcopy( '@t', out, ondx)
      col = newcol
    }
  }
  for( ; col < newcol ; col = col + 1 )
    call chcopy( ' ', out, ondx)
  call chcopy( in(col), out, ondx)
}

return
end
#-h- grafic           218  asc  25-mar-82 07:22:42  v1.1 (sw-tools v1.1)
## Grafic -- Turn graphics mode ON or OFF on `fd'

subroutine grafic( str, fd)

character  str(ARB)
filedes    fd
include    cbox


if( grfprf != EOS )
{
  call putch( grfprf, fd)
  call putlin( str, fd)
}

return
end
#-h- measur           391  asc  25-mar-82 07:22:42  v1.1 (sw-tools v1.1)
## Measur -- Measure maximum line length and nesting level for block.

subroutine measur( maxlen, maxlvl)

integer   i, level, linlen, maxlen, maxlvl
integer   readln # function(s)
character lin(MAXLINE)

maxlen = 0
maxlvl = 0

for( level = 1 ; level > 0 ; linlen = readln( lin, level) )
{
  if( level > maxlvl )
    maxlvl = level

  if( linlen > maxlen )
    maxlen = linlen
}

return
end
#-h- nxtfil           474  asc  25-mar-82 07:22:43  v1.1 (sw-tools v1.1)
## NxtFil -- Get (and open) next file from arg. list.  Open STDIN for `-'.

filedes function nxtfil( fil, ndx)

character fil(ARB)
filedes   fd
integer   ndx
integer   getarg, open # function(s)

if( getarg( ndx, fil, FILENAMESIZE) != EOF )
{
  if( fil(1) == '-' & fil(2) == EOS )
    return(STDIN)

  fd = open( fil, READ)
  if( fd == ERR )
    call cant(fil)
  else
    return(fd)
}
else if( ndx == 1 )	# Use STDIN if no file args.
  return(STDIN)
else
  return(EOF)

end
#-h- proces          1468  asc  25-mar-82 07:22:44  v1.1 (sw-tools v1.1)
## Proces -- Prettyprint all lines until nesting level falls to 0.

subroutine proces( maxlen, maxlvl)

character lin(MAXLINE)
integer   i, j, maxlen, maxlvl
integer   dobot, doleft, dorite, dotop # function(s)
integer   lcil # last  column in level
integer   fcil # first column in level
integer   level, linlen
integer   begblk, endblk, readln # function(s)


string lbrnl "{@n"
string crlf "@r@l"


call strcpy( lbrnl, lin)
for( level = 1 ; level > 0 ; linlen = readln( lin, level) )
{
  fcil = level * 2 - 1
  lcil = maxlen + (maxlvl - level) * 2 + 2

  if( begblk(lin) == YES )	# Beginning of block.
  {
    i = 1
    i = doleft( lin, i, level - 1 )
    i = dotop( lin, i, lcil - 1)
    i = dorite( lin, i, level - 1)
    call scopy( crlf, 1, lin, i)
    call boxlin(lin)
  }
  else if( endblk(lin) == YES )	# End of block.
  {
    i = 1
    i = doleft( lin, i, level)
    i = dobot( lin, i, lcil - 3)
    i = dorite( lin, i, level)
    call scopy( crlf, 1, lin, i)
    call boxlin(lin)
  }
  else # not begblk or endblk
  {
    i = 1
    i = doleft( lin, i, level)

    if( i <= linlen )
      i = linlen + 1

    for( ; i <= lcil - 2 ; i = i + 1 )
      lin(i) = ' '

    i = dorite( lin, i, level)

    call scopy( crlf, 1, lin, i)
    call boxlin(lin)
  }
}

# put out final end block

for( i = 1 ; i < fcil ; i = i + 1 )
  lin(i) = ' '

i = 1

i = doleft( lin, i, level)
i = dobot( lin, i, lcil - 1)
call scopy( crlf, 1, lin, i)
call boxlin(lin)

return
end
#-h- readln          1074  asc  25-mar-82 07:22:45  v1.1 (sw-tools v1.1)
## ReadLn -- Read a line from `ifd', removing trailing comments.
#  Return the length of the resulting line.

integer function readln( lin, level)

character inplin(MAXLINE), lin(MAXLINE)
integer   i, level
integer   begblk, endblk, getlin, length # function(s)

include   ctabs
include   cfd

string lbrnl "{@n"
string rbrnl "}@n"

if( getlin( inplin, ifd) != EOF )
{

  call detabl( inplin, lin, tabs)
  if( begblk(lin) == YES )
  {
    level = level + 1
    call strcpy( lbrnl, lin)
    return(1)
  }
  else if( endblk(lin) == YES )
  {
    level = level - 1
    call strcpy( rbrnl, lin)
    return(1)
  }
  else # not begblk or endblk
  {
    i = length(lin)

    if( lin(i) == '@n' & i > 1 )
      i = i - 1

    if( lin(i) == '#' )
    {
      i = i - 1

      for( ; (lin(i) == ' ' | lin(i) == '#') & i > 1 ; i = i - 1 )
        ;

      lin(i+1) = '@n'
      lin(i+2) = EOS
    }

    return(i)
  }
}
else # we ran out of input
{
  call remark( "Premature EOF encountered.  EndBlock line inserted.")
  level = level - 1
  call strcpy( rbrnl, lin)
  return(1)
}

end
#-h- box.fmt         1075  asc  25-mar-82 07:23:09  v1.1 (sw-tools v1.1)
.so ~bin/manhdr
.hd Box (1) 23-Jul-81
draw boxes around block structure of RatFor or C programs
.sy
box [-e] [-d{device}] [-] file ...
.ds
Box draws boxes around statement groups (beginning with "{" and
ending with "}") to make them more legible.
It is designed to be used as a pretty-printer for RatFor or C code
that is indented as follows:

.in +8
.nf
level 0
{
  level 1
  {
    level 2
  }
  level 1
}
level 0

For this input, box generates:

level 0
+-------------+
| level 1     |
| +---------+ |
| | level 2 | |
| +---------+ |
| level 1     |
+-------------+
level 0

.in -8
.fi
The alignment of the "{" and "}" characters and the indentation of
2 spaces per level are required for proper operation.
If TABs are present in the input, they are replaced with blanks, on
the assumption of 8 spaces per TAB.
The "-d" option takes advantage of the line-drawing character sets
on certain devices; currently the DEC vt100 and the Heath h19 are
supported.
.ex
box -dvt100 myfile

box the file "myfile" to STDOUT (assumed to be a vt100)
.au
Dave Martin (Hughes Aircraft)
.bu
%%E 1