!!!!!  Simple emulation of EMAS VIEW for VAX/VMS and APM  !!!!!
!!!!!!!!!            Hamish Dewar  April 1983         !!!!!!!!!
!  only basic facilities implemented
!  uses VMS/APM text file: index generated on fly
!
%externalstring(255)%fnspec CLIPARAM
!$IF VAX
{%externalstring(72)%fnspec SYSMESS(%integer i)
{%externalintegerfnspec CONNECT(%string(127) file,
{                               %integername start,length)
{%include "DR0:[HMD]VTI"
{!
{%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,FLAG,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 TOUPPER(%string(*)%name s)
%integer i
  %for i = length(s),-1,1 %cycle
    charno(s,i) = charno(s,i)-32 %if 'a' <= charno(s,i) <= 'z'
  %repeat
%end

%routine INIT
%integer i
%string(255) filename
  %on %event 3,9 %start
    %if topic # "" %start
      printstring("Main HELP file not available")
      newline
      %stop
    %finish
    topic = param;  param = ""
  %finish
  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
!$IF VAX
{  %signal 3 %if connect(filename,startad,limad)&1 # 0
!$IF APM
  connect file(filename,0,startad,limad)
!$FINISH
%end

%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

%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 DIR

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

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

%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

%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

%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
%end

%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

%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

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

%routine PRINT CONTENT(%integer page)
%owninteger max,maxid,maxnum
%integer i,k,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
  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
    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 PRINT PAGE
%integer size,blanks,code
  %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
  at(0,0);  clear frame
  spaces(10);  col = 10
  %if ident = 0 %start;  !at start of file
    toupper(param)
    print string("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
{    %if byteinteger(ad)!let = charno(topic,1) %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)
{      %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
  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
      at(23,0);  print string("No references found for """.topic."""")
      clear line
    %else
      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 i,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
%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
%routine top
  set ident(0)
%end
%routine up
  set ident(dir(ident)_parent)
%end
%routine on
  %if more # 0 %then page = page+1 %c
  %else %if ident < dirmax %then set ident(ident+1)
%end
%routine explain
  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>     <topic>: locate <topic>")
  newline
  printstring("           ^Z:     quit program")
  newline
%end

  %cycle
    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
      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
    print page %if found = 1
    read command
    found = 1
  %repeat %until finished # 0
  at(23,0);  clear line
%end;  !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
{%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
