{  20/7/87  10:03   smnview}

!  Modified slightly by SM.

!!!!!  Simple emulation of EMAS VIEW for VAX/VMS and APM  !!!!!
!!!!!!!!!            Hamish Dewar  April 1983         !!!!!!!!!
!Implements VIEW commands on a VMS/APM text file:
!  only basic commands implemented; index generated on fly
! 29/04/84:   double parameter & cursor control
!

%externalstring(255)%fnspec CLIPARAM
!$IF VAX

%recordformat line80f( %c
%record(line80f)%name next,prev,%string(80) line)
%recordformat line80listf( %c
%record(line80f)%name head, tail)

%include "inc:util.imp"           
%include "inc:vtlib.imp"
%include "utils.inc"
!

%routine pss(%integer a,len,lim)
%integer i
  print string(itoh(a)); spaces(2)
  print string(itoh(shortinteger(a))); space
  %for i=2,1,len+3 %cycle
    %exit %if a+i>=lim
    print symbol(byteinteger(a+i))
  %repeat
  newline
%end

%externalroutine VIEW(%string(255) param,topic)
%constinteger header=2
!$IF APM
{%externalroutinespec CONNECT FILE(%string(255) f,%integer mode,
{                                  %integername start,len)
{!
{%begin
{%conststring(5) DEFAULTDIR="VIEW:"
{%conststring(3) DEFAULTFILE="APM"
{%routine VIEW(%string(255) param,topic)
{%constinteger header=0
!$FINISH
!
%constinteger esc=27
!Current status variables:
%constinteger MAXLINE=20, MAXCOL=80, LET=32
%owninteger COL=0, SKIPPING=0, LINE=0, MORE=0
%integer IDENT,PAGE,TEXTAD,SIZE
%integer STARTAD,LIMAD,FOUND,FINISHED
!Directive index:
%constinteger DIRBOUND=1000, PAGEBOUND=100
%integer DIRMAX,PAGEMAX,MAXPAGE,MAXTEXTPAGE
%recordformat DIRINFO(%integer address,
                      %byteinteger level,number,
                      %shortinteger parent,brother)
%record(dirinfo)%array DIR(0:dirbound)
!  Page information for current section only
%integerarray PSTART(1:pagebound)

%integerarray FOUNDID(1:maxline)
%constinteger EVEN=\1

%routine pdirrec(%integer id)
%integer ad
%record(dirinfo)%name p
  p==dir(id)
  ad=p_address
  write(id,2); space
  print string(itoh(ad))
  write(p_level,2)
  write(p_number,2)
  write(p_parent,2)
  write(p_brother,2)
  newline
  pss(ad,length(topic),ad+shortinteger(ad)+1)
  newline
%end

%routine print directory(%string(255) s)
%integer id
  newline %and print string(s) %if s#""
  newline
  print string("Dirmax="); write(dirmax,0); newline
  pdirrec(id) %for id=0,1,dirmax
  newline
%end

%routine INIT
%string(255) filename
  %on %event 4,9 %start
    %if topic # "" %start
      printstring("Main HELP file not available")
      newline
      %stop
    %finish
    topic = param;  param = ""
  %finish

!$IF VAX
  filename = param
!$IF APM
{  param = defaultfile %if param = ""
{  filename = param
{  i = length(filename)
{  i = i-1 %while i # 0 %and charno(filename,i) # ':'
{  filename = defaultdir.filename %if i = 0
!$FINISH
  connect file(filename,0,startad,limad)
%end    ;!  End of INIT.

%routine SKIP LINE
  %return %if textad >= limad
!$IF VAX
  textad = textad+(shortinteger(textad)+3)&even
!$IF APM
{  textad = textad+1 %until byteinteger(textad-1) < ' '
!$FINISH
%end    ;!  End of SKIP LINE.

%routine CREATE DIRECTORY(%integer parent,level)
! Set up DIR for all sections and sub-sections,
! TEXTAD pointing at first sub-section of PARENT
%record(dirinfo)%name d
%integer num,code,p
  num = 1
  %cycle
    dirmax = dirmax+1;  p = dirmax
    d == dir(p)
    d_address = textad
    d_level = level;  d_number = num
    d_parent = parent
    %cycle
      d_brother = -(dirmax+1)
      %cycle
        skip line
        %return %if textad >= limad
!$IF VAX
      %repeat %until shortinteger(textad) >= 2 %and byteinteger(textad+2) = '!'
!$IF APM
{      %repeat %until byteinteger(textad) = '!'
!$FINISH
      code = byteinteger(textad+1+header)
      %if code = '>' %start;  !end-of-section
        %return %if p = 0
        p = 0
      %finish
      %if code = '<' %start
        %exit %if p = 0;  !brother
        create directory(p,level+1);  !sons
        p = 0
      %finish
    %repeat
    d_brother = dirmax+1;  num = num+1
  %repeat
%end    ;!CREATE DIRECTORY.

%routine NEWLINE
  print symbol(nl) %if skipping = 0
  line = line+1;  col = 0
%end    ;!  End of NEWLINE.

%routine SPACES(%integer n)
  %while  n > 0 %cycle
    print symbol(' ');  col = col+1;  n = n-1
  %repeat
%end    ;!  End of SPACES.

%routine PUT NUM(%integer n)
  put num(n//10) %and n = n-n//10*10 %if n >= 10
  print symbol(n+'0');  col = col+1
%end    ;!  End of PUT NUM.

%routine PRINT IDENT(%integer id)
%record(dirinfo)%name d
  d == dir(id)
  %if d_parent # 0 %start
    print ident(d_parent);  print symbol('.');  col = col+1
  %finish
  put num(d_number)
%end    ;!  End of PRINT IDENT.

%routine PRINT TITLE(%integer id)
%integer ad,size
!$IF VAX
  ad = dir(id)_address;  size = shortinteger(ad)-2
  col = col+size
  ad = ad+4;  !past length bytes & '!<'
  %while size > 0 %cycle
    print symbol(byteinteger(ad))
    ad = ad+1;  size = size-1
  %repeat
!$IF APM
{  ad = dir(id)_address+2
{  %while byteinteger(ad) >= ' ' %cycle
{    print symbol(byteinteger(ad))
{    ad = ad+1;  col = col+1
{  %repeat
!$FINISH
%end    ;!  End of PRINT TITLE.

%routine PRINT LINE
%integer ad,size
!$IF VAX
  ad = textad;  size = shortinteger(ad)
  textad = textad+(size+3)&even
  ad = ad+2
  %while size > 0 %cycle
    print symbol(byteinteger(ad))
    ad = ad+1;  size = size-1
  %repeat
  newline
!$IF APM
{  %cycle
{    print symbol(byteinteger(textad))
{    textad = textad+1
{  %repeat %until byteinteger(textad-1) < ' '
{  line = line+1;  col = 0
!$FINISH
%end    ;!  End of PRINT LINE.

%routine RULE LINE
%integer i
  print symbol('-') %for i = 1,1,maxcol
{  set shade(graphical+intense)}
{  print symbol('`') %for i = 1,1,maxcol}
  set shade(0)
  newline
%end    ;!  End of RULE LINE.

%routine SET IDENT(%integer i)
  ident = i;  page = 1
  pagemax = 0;  maxpage = 999;  maxtextpage = 999
%end    ;!  End of SET IDENT.

%routine PRINT CONTENT(%integer page)
%owninteger max,maxid,maxnum
%integer col1,blanks,code,id
%record(dirinfo)%name d

%integerfn LINELENGTH(%integer ad)
%integer ad1
  ad1 = ad
  ad = ad+1 %until byteinteger(ad-1) < ' '
  %result = ad-ad1-1
%end    ;!  End of LINELENGTH.

  blanks = 0;  more = 0;  line = 0
  %if page <= maxtextpage %start
    textad = pstart(page)
    %cycle
      %return %if textad >= limad
!$IF VAX
      size = shortinteger(textad)
      %exit %if size >= 2 %and byteinteger(textad+2) = '!'
      %if size = 0 %start
        textad = textad+2;  blanks = blanks+1
!$IF APM
{      %exit %if byteinteger(textad) = '!'
{      %if byteinteger(textad) < ' ' %start
{        textad = textad+1;  blanks = blanks+1
!$FINISH
      %finish %else %start
        more = textad %and %return %if line+blanks+1 > maxline
        %if skipping = 0 %start
          newline %and blanks = blanks-1 %while blanks > 0
          print line
        %finish %else %start
          line = line+blanks+1;  blanks = 0
          skip line
        %finish
      %finish
    %repeat
!   Directive located
    code = byteinteger(textad+1+header)
    %if code!let = 'p' %start;  !"!PAGE"
      skip line;  more = textad
      %return
    %finish
    create directory(0,0) %if ident = 0 %and dirmax = 0
    maxtextpage = page
    %return %if ident = dirmax %or skipping < 0
    id = ident+1
    %return %if dir(id)_parent # ident;  !no subsections
   !Explore  subsections to find number,maxwidth
    d == dir(id)
!$IF VAX
    max = shortinteger(d_address)
    %while d_brother > 0 %cycle
      d == dir(d_brother)
      max = shortinteger(d_address) %if shortinteger(d_address) > max
    %repeat
!$IF APM
{    max = linelength(d_address)
{    %while d_brother > 0 %cycle
{      d == dir(d_brother)
{      k = linelength(d_address)
{      max = k %if k > max
{    %repeat
{    max = max+2
!$FINISH
    maxnum = d_number
    maxid = d_level+d_level+3;  maxid = maxid+1 %if maxnum > 9
  %finish %else id = pstart(page)
!  Contents
  col1 = 0
  %cycle
    newline %and blanks = 0 %if blanks # 0;  !restrict to 1
    more = id %and %return %if line >= maxline
    col1 = col1+maxid
    %if skipping = 0 %start
      print ident(id)
      spaces(col1-col)
      print title(id)
    %finish
    id = dir(id)_brother
    %exit %if id <= 0
    col1 = col1+max
    %if col1+maxid+max <= maxcol %start
      spaces(col1-col) %if skipping = 0
    %finish %else %start
      newline;  col1 = 0
    %finish
  %repeat
  newline
%end    ;!  PRINT CONTENT.

%routine TOUPPER(%string(*)%name s)
%integer i
  %for i = 1,1,length(s) %cycle
    charno(s,i) = charno(s,i)+('A'-'a') %if 'a' <= charno(s,i) <= 'z'
  %repeat
%end

%routine PRINT PAGE
  %while pagemax < page %cycle
    more = 0
    %if pagemax = 0 %start
      %if ident = 0 %then textad = startad %c
      %else textad = dir(ident)_address %and skip line
      more = textad
    %finish %else %if pagemax # maxpage %start
      skipping = 1
      print content(pagemax)
      skipping = 0
    %finish
    %if more = 0 %start
      maxpage = pagemax;  page = maxpage
      %exit
    %finish
    pagemax = pagemax+1;  pstart(pagemax) = more
  %repeat
  vt at(0,0);  clear frame
  spaces(10);  col = 10
  %if ident = 0 %start    ;!  At start of file
    toupper(param)
    printstring(" HELP Information for ".param)
    spaces(20);  printstring("'?' for commands")
  %finish %else %start
    print title(ident)
    spaces(60-col)
    print ident(ident)
    print symbol('/') %and put num(page) %if page > 1
  %finish
  newline
  rule line
  print content(page)
  %if more = 0 %start
    maxpage = pagemax
  %finish %else %if pagemax = page %start
    pagemax = pagemax+1;  pstart(pagemax) = more
  %finish
%end    ;!  PRINT PAGE

%routine SEARCH FOR STRING
%integer id,i,len=length(topic)

%integerfn MATCHED
%integer a,k,ad,lim
!$IF VAX
  ad = dir(id)_address;  lim = ad+shortinteger(ad)+2
  ad = ad+4    ;!  Past length bytes & '!<'
  %while ad+len <= lim %cycle    ;!  Only < in HMD's version.
    %if byteinteger(ad)!let = charno(topic,1)!let %start    ;!  first char match
      %if len = 1 %start
        %result = 1 %if ad+1 = lim %or byteinteger(ad+1) = ' '
      %else
        a = ad;  k = 1
        %cycle
          a = a+1;  k = k+1
          %result = 1 %if k > len
        %repeat %until byteinteger(a)!let # charno(topic,k)!let
      %finish
    %finish
    ad = ad+1 %until ad = lim %or byteinteger(ad) = ' '
    ad = ad+1
  %repeat
  %result = 0
!$IF APM
{  ad = dir(id)_address+2
{  %cycle
{    %while byteinteger(ad) <= ' ' %cycle
{      %result = 0 %if byteinteger(ad) < ' '
{      ad = ad+1
{    %repeat
{    %if byteinteger(ad)!let = charno(topic,1) %start    ;!  First char match
{      %if len = 1 %start    ;!  One char -- partial match silly
{        %result = 1 %if byteinteger(ad+1) <= ' '
{      %else
{        a = ad;  k = 1
{        %cycle
{          a = a+1;  k = k+1
{          %result = 1 %if k > len
{        %repeat %until byteinteger(a)!let # charno(topic,k)
{      %finish
{    %finish
{    ad = ad+1 %until byteinteger(ad) <= ' '
{  %repeat
!$FINISH
%end    ;!  End of MATCHED.

  found = 0;  id = 1
  %while id <= dirmax %cycle
    %if matched # 0 %start
      found = found+1;  foundid(found) = id
      %exit %if found = maxline-1
      id = |dir(id)_brother|    ;!  don't look at descendants too
    %finish %else id = id+1
  %repeat
  %if found = 1 %start
    set ident(foundid(1))
  %else
    %if skipping < 0 %start
      skipping = 0
      set ident(0)
      print page
    %finish
    %if found = 0 %start
      vt at(23,0);  print string("No references found for """.topic."""")
      clear line
    %else
     vt at(maxline+1-found,0);  newline
      %for i = 1,1,found %cycle
        %if i # maxline-1 %start
          spaces(2)
          print ident(foundid(i))
          spaces(10-col)
          print title(foundid(i))
        %finish %else print string("   and so on")
        newline
      %repeat
    %finish
  %finish
%end;  !SEARCH FOR STRING

%routine READ COMMAND
! Read response and adjust IDENT and PAGE for required page
%integer sym

%on %event 9 %start
  finished = 1
  %return
%finish

%routine READ(%integername j)
  j = -1;  %return %unless '0' <= sym <= '9'
  j = 0
  %cycle
    j = j*10+sym-'0';  j = 99 %if j > 99
    read symbol(sym)
  %repeat %until %not '0' <= sym <= '9'
%end    ;!  End of READ.

%routine READ IDENT
!First character in SYM
%integer i,j
  found = 0
  %if sym # '/' %start
    i = 0;  i = ident %if sym = '.'
    %cycle
      read symbol(sym) %if sym = '.'
      read(j)
      %return %if j < 0 %or i >= dirmax %or dir(i+1)_parent # i
      i = i+1
      %cycle
        j = j-1
        %exit %if j <= 0
        i = dir(i)_brother
        %return %if i <= 0
      %repeat
    %repeat %until sym # '.'
    set ident(i)
  %finish
  read symbol(sym) %and read(page) %if sym = '/'
  found = 1 %if page > 0
%end    ;!  End of READ IDENT.

%routine top
  set ident(0)
%end    ;!  End of TOP.

%routine up
  set ident(dir(ident)_parent)
%end    ;!  End of UP.

%routine on
  %if more # 0 %then page = page+1 %c
  %else %if ident < dirmax %then set ident(ident+1)
%end    ;!  End of ON.

%routine explain
 vt at(17,0);  newline
  printstring("     RETURN: next page       -:     previous page")
  newline
  printstring("     HOME:   top of file     CUP:   up one level")
  newline
  printstring("     <n>:    section <n>     x...x: locate 'x...x'")
  newline
  printstring("    ^Z:      quit program")
  newline
%end    ;!  End of EXPLAIN.

  %cycle
    vt at(22,0)
    %if more # 0 %then printstring("...more  ") %c
    %else %if ident >= dirmax %then printstring("End.  ")
    printstring("View:");  clear line
    read symbol(sym) %until sym # ' '
    read symbol(sym) %and sym = sym+128 %if sym = esc
    %if sym > 128 %start;  !escape sequence
      up %and %return %if sym = 'A'+128 {up}
      on %and %return %if sym = 'B'+128 {down}
      set ident(0) %and %return %if sym = 'H'+128  {back to top}
      explain
      %continue
    %finish
    %if sym < ' ' %start;  !control key
      %if sym = 'z'&31 %start  {CTRL+Z}
        finished = 1
        %return
      %finish
      on
      %return
    %finish
    %if sym = '-' %start
      %if page > 1 %then page = page-1 %c
      %else %if ident # 0 %then set ident(ident-1) %and page = 99
      read symbol(sym) %while sym >= ' '
      %return
    %finish
    %if '0' <= sym <= '9' %or sym = '.' %or sym = '/' %start
      read ident
      read symbol(sym) %while sym >= ' '
      %return %if found = 1
      vt at(23,0);  print string(" No such section");  clear line
      %continue
    %finish
    %if sym = '?' %start
      read symbol(sym) %until sym < ' '
      explain
      %continue
    %finish
    topic = ""
    %cycle
      sym = sym+('a'-'A') %if 'A' <= sym <= 'Z'
      topic = topic.tostring(sym)
      read symbol(sym)
    %repeat %until sym < ' '
    search for string
    %return %if found = 1
  %repeat
%end;  !READ COMMAND

!
!Start of VIEW: connect file
  init
  limad = limad+startad
  dir(0) = 0;  dir(0)_address = startad
  dirmax = 0
  set ident(0)
  found = 1;  finished = 0
  %if topic # "" %start
!  Create directory
    more = startad
    skipping = -1
    %cycle
      pstart(page) = more
      print content(page)
    %repeat %until more = 0
    search for string
    skipping = 0
  %finish
  %cycle
    %if found = 1 %thenstart
      print page
    %finish
    read command
    found = 1
  %repeat %until finished # 0
%end    ;!  End of VIEW.

!$IF VAX
!Final part only for compilation as runnable program
{%begin}
{%string(255) file,topic
{  define video(-1)
{  set video mode(screenmode)
{  file = cliparam
{  topic = "" %unless file -> file.(",").topic
{  view(file,topic)
{  set video mode(0)
{%end    ;!  END OF PROGRAM.

%endoffile

!$IF APM
{%string(255) file,topic
{  set video mode(screenmode&(\single))
{  prompt("")
{  file = cliparam
{  topic = "" %unless file -> file.(",").topic
{  view(file,topic)
{  set video mode(0)
{  print ch(nl)
{%endofprogram

!$FINISH