%externalintegerfnspec vttsym


{  15/4/88  22:50   menus}

%include "consts.inc"
%include "formats.inc"
%include "graph1.5.inc"
%include "maths.inc"
%include "inc:fs.imp"
%include "utils.inc"
%include "util.inc"
%include "vti.inc"

%record %format pointfm(%integer x, y)
%record %format dialfm(%string(2) num, %record(pointfm) loc)
%recordformat trifm(%record(pointfm) a, b, c)
%record %format linefm(%integer x0, x1, y)

%externalinteger altbase=512
%owninteger background=black
%externalinteger base=0
%constinteger bl=16_7800
%owninteger cx=384
%owninteger cy=60
%string(15)%fnspec datime
%owninteger deltah, deltam, deltas
%externalstring(31) digital date
%externalinteger display clock=no
%owninteger dialfnt, dw
%ownintegerarray daysin(1:12)=31,28,31,30,31,30,31,31,30,31,30,31
%owninteger face colour=white, figs colour=black
%owninteger fnt
%externalinteger graphics=no
%constinteger grn=16_3C0
%owninteger h, hour colour=black, hr
%owninteger m, minute colour=black, mr
%owninteger normal=reverse
%ownreal piov6, piov30
%constinteger rd=16_1e
%owninteger s, secs colour=black
%owninteger size=60
%owninteger sr, state
%owninteger ttt
%ownstring(31) u
%ownreal xt
%owninteger y
%ownreal yt

%ownrecord(trifm) h0, h1, h2, m0, m1, m2, s0, s1, s2
%ownrecord(trifm)%array hh, mm, ss(0:59)
%ownrecord(dialfm) %array da(0:11)
%ownhalfintegerarray colmap(0:255)


%recordformat dataf(%string(19) name,%record(line80listf) val)
%recordformat menuf(%integer item, length, %string(19) name, %string(63) val)
%ownrecord(menuf)%array menu(0:250)

%owninteger bottomd
%ownstring(80) buff=""
%owninteger cursorx, cursory
%owninteger datastart=20
%externalstring(31) helpfile="menuhelp"
%owninteger itemno=0, linelength=80, menudepth
%externalstring(255) menu instructions=""
%owninteger topd=1
%externalroutinespec view(%string(255) param,topic)
%owninteger wdepth=16, wmin, wmax
%routinespec write menu

%externalstring(255)%fn digital time
%string(15) d, dt
  d=itod(h); d="0".d %while length(d)<=1
  dt=d
  d=itod(m); d="0".d %while length(d)<=1
  dt=dt." ".d
  d=itod(s); d="0".d %while length(d)<=1
  dt=dt." ".d
  %result=dt
%end

%string(15)%fn increment date
%string(255) date
%integer day, k,  month, year
%string(255) x, y, z
  date=digital date
  k=no
  k=yes %if date->x.("/").y
  message("Resolution of date fails at first stage.","mon") %if k=no
  k=no
  k=yes %if y->y.("/").z
  message("Resolution of date fails at second stage.","mon") %if k=no
  day=dtoi(x); month=dtoi(y); year=dtoi(z)
  %if month=2 %thenstart
    %if year&3=0 %thenstart
      k=year//100
      %if year#100*k %or (year=100*k %and k&3=0) %thenstart
        days in(2)=29
      %finish
    %finish
  %finish
  day=day+1
  %if day>days in(month) %thenstart
    day=1
    month=month+1
    %if month>12 %thenstart
      day=1
      year=year+1
    %finish
  %finish
  %result=itod(day)."/".itod(month)."/".itod(year)
%end

%routine draw clock(%integer base, cx, cy)
%integer i, figr
%real xr, yr
%string(3) num
%record(pointfm) a
  font(0)
  colour(white)
  font(dialfnt)
  figr=sr
  colour(face colour)
  disc(cx, base+cy, size)
  colour(figs colour)
  %for i=0,1,11 %cycle
    %if i=0 %then num="12" %else num=itod(i)
    xt=sin(i*piov6)
    yt=cos(i*piov6)
    xr=xt*figr-string width(num)/2
    yr=yt*figr-0.6*font height/2
    a_x=intpt(xr)
    a_y=intpt(yr)
    da(i)_num=num
    da(i)_loc=a
    a_x=a_x+cx
    a_y=a_y+cy+base
    text at(a_x,a_y)
    show string(num)
  %repeat
  a_x=cx
  a_y=cy
%end

%routine obliterate hands(%integer base, %record(trifm) h2, m2, s2)
%integer temp
%string(3) num
%record(pointfm) a
  colour(face colour)
  triangle(h2_a_x, base+h2_a_y, h2_b_x, base+h2_b_y, h2_c_x, base+h2_c_y)
  triangle(m2_a_x, base+m2_a_y, m2_b_x, base+m2_b_y, m2_c_x, base+m2_c_y)
  line(cx, base+cy, s2_a_x, base+s2_a_y)
!  Reinstate figures where second-hand has been.
  temp=rem(s-2,60)
  temp=rem((2+temp)//5, 12)
  a=da(temp)_loc
  a_x=a_x+cx; a_y=a_y+cy
  num=da(temp)_num
  colour(figscolour)
  font(dialfnt)
  text at(a_x, base+a_y)
  show string(num)
%end

%routine draw hands(%integer base, %record(trifm) h0, m0, s0)
  colour(hour colour)
  triangle(h0_a_x, base+h0_a_y, h0_b_x, base+h0_b_y, h0_c_x, base+h0_c_y)
  colour(minute colour)
  triangle(m0_a_x, base+m0_a_y, m0_b_x, base+m0_b_y, m0_c_x, base+m0_c_y)
  colour(secs colour)
  line(cx, base+cy, s0_a_x, base+s0_a_y)
  disc(cx, base+cy, dw)
%end

%externalroutine show time
%integer x
  obliterate hands(base, h2, m2, s2)
!  Prepare hour hand.
  x=rem(h,12)
  x=5*x+m//12
  h0=hh(x)
!  Prepare minute hand.
  colour(minutecolour)
  m0=mm(m)
!  Prepare seconds-hand.
  s0=ss(s)
!  Draw hands.
  draw hands(base, h0, m0, s0)
!  Store position of hands.
  h2=h1; h1=h0
  m2=m1; m1=m0
  s2=s1; s1=s0
!  The frame will be displayed by a call from the program that uses the clock.
%end

%string(15)%fn spdate
%string(15) x,y,z
  x=date
  x->x.("/").y
  y->y.("/").z
  y=y %while x->(" ").x
  x=x %while y->(" ").y
  y=y %while z->(" ").z %or z->z.(" ")
  %result=x."/".y."/".z
%end

%externalroutine advance time
  %return %if ttt=0
!  Advance time.
  %while cputime-ttt>=1000 %cycle
    ttt=ttt+1000
    s=s+1
    %if s=60 %thenstart
!  Fudge to correct for loss of 2secs per hour in Cputime.
      ttt=ttt-20
      s=0
      m=m+1
      %if m=60 %thenstart
        m=0
        h=h+1
        %if h=24 %thenstart
          ttt=ttt+1
          h=0
          digital date=increment date
        %finish
      %finish
    %finish
  %repeat
%end

%externalroutine set date(%string(80) s)
%string(80) t, u
  t="" %unless s->s.("/").t %or s->s.("-").t
  u="" %unless t->t.("/").u %or t->t.("-").u
  t="99" %if t=""
  u="99" %if u=""
  digital date=s."/".t."/".u
%end

%routine set system time
%string(31) time
  time=datime
  h=(charno(time, 11)-'0')*10+charno(time, 12)-'0'
  h=rem(h, 24)
  m=(charno(time, 14)-'0')*10+charno(time, 15)-'0'
  m=rem(m, 60)
  s=(charno(time, 17)-'0')*10+charno(time, 18)-'0'
  s=rem(s, 60)
  ttt=cputime
%end

%externalroutine set time(%string(255) t)
%string(255) u, v
  set system time
  deltah=h; deltam=m; deltas=s
  u="" %unless t->t.(":").u %or t->t.(".").u %or t->t.(" ").u
  v="" %unless u->u.(":").v %or u->u.(".").v %or u->u.(" ").v
  h=dtoi(t)
  h=rem(h, 24)
  m=dtoi(u)
  m=rem(m, 60)
  s=dtoi(v)
  s=rem(s,60)
  ttt=cputime
  deltah=h-deltah
  deltam=m-deltam
  deltas=s-deltas
%end

%string(15) %function datime
   %string(255) s
   length(s)=fcommr('G0',"",charno(s,1),255)
   %result=s
%end

%routine clockhelp
%integer j

  %on %event 9 %start
    close input
    select input(0)
    %return
  %finish

  open input(1,"office:clockhelp")
  select input(1)
  select output(0)
  %cycle
    read symbol(j)
    print symbol(j)
  %repeat
%end


%externalroutine clear clock
  h=0; m=0; s=0; ttt=cputime
  deltah=0; deltam=0; deltas=0
%end

%externalroutine restart clock(%integer x, y)
  cx=x; cy=y
  dialfnt=0; fnt=0
  font(fnt) %if display clock=yes
  set system time
  h=h+deltah; m=m+deltam; s=s+deltas
  %while s<0 %cycle
    s=s+60
    m=m-1
  %repeat
  %while s>=60 %cycle
    s=s-60
    m=m+1
  %repeat
  %while m<0 %cycle
    m=m+60
    h=h-1
  %repeat
  %while m>60 %cycle
    m=m-60
    h=h+1
  %repeat
  h=h+24 %while h<0
  h=h-24 %while h>=24
  ttt=cputime
  font(0)
!  Draw clock-face.
  %if display clock=yes %thenstart
    offset(0, 0)
    draw clock(base, cx, cy)
    draw clock(altbase, cx, cy)
  %finish
!  Initialise clock storage.
  h2_a_x=cx; h2_a_y=cy; h2_b_x=cx; h2_b_y=cy; h2_c_x=cx; h2_c_y=cy
  h1=h2
  m2=h2; m1=h2
  s2=h2; s1=h2
%end

%externalroutine start clock(%integer x, y)
%integer i
%real xt, yt
  font(0)
  piov6=pi
  piov30=piov6/30
  piov6=piov6/6
  dw=size//32
  sr=size*29//32
  mr=sr-font height//2-2
  hr=mr-font height
  %for i=0,1,59 %cycle
    yt=i*piov30
    xt=sin(yt)
    yt=cos(yt)
!  Prepare positions for hour hand.
    hh(i)_a_x=x+intpt(xt*hr)
    hh(i)_a_y=y+intpt(yt*hr)
    hh(i)_b_x=x+intpt(yt*dw)
    hh(i)_b_y=y+intpt(-xt*dw)
    hh(i)_c_x=x+intpt(-yt*dw)
    hh(i)_c_y=y+intpt(xt*dw)
! Prepare positions for minute hand.
    mm(i)_a_x=x+intpt(xt*mr)
    mm(i)_a_y=y+intpt(yt*mr)
    mm(i)_b_x=x+intpt(yt*dw)
    mm(i)_b_y=y+intpt(-xt*dw)
    mm(i)_c_x=x+intpt(-yt*dw)
    mm(i)_c_y=y+intpt(xt*dw)
!  Prepare positions for second hand.
    ss(i)_a_x=x+intpt(xt*sr)
    ss(i)_a_y=y+intpt(yt*sr)
  %repeat
  clear clock
  digital date="1/1/1"
  restart clock(x, y)
%end

%record(line80f)%map newline80
%record(line80f) pattern
%record(line80f)%name p
  p==new(pattern)
  p_next==nil; p_prev==nil
  p_line=""
  %result==p
%end

%externalroutine screen message(%string(255) s,%string(15) mon)
%integer oldout
  oldout=outstream
  select output(0)
  scroll(wdepth+1,19,-1)
  gotoxy(0,wdepth+1)
  print string(s)
  %monitor %if mon="mon"
  %stop %if mon="stop" %or mon="mon"
  gotoxy(cursorx,cursory-wmin+topd)
  select output(oldout)
%end

%routine help(%string(31) topic)
{!  If Vax.}
{%recordformat df(%integer l, a)}
{%record(df) d}
{%externalintegerfnspec spawn %alias "LIB$SPAWN"(%record(df)%name d)}
!
%string(255) x, y
  topic=x." ".y %while topic->x.("_").y
{!  If Vax.}
{  x="view ".helpfile.",".topic}
{  d_a=addr(x)+1; d_l=length(x)}
{  flag=spawn(d)}
{  message("Flag from ".x."=".itoh(flag),"") %if flag&1=0}
!
{!  If APM.}
{  view(helpfile,x)}
!
%end

%externalroutine start screen mode
{!  If Vax.}
{  define video(vttype)}
!
  select input(0); select output(0)
  set video mode(screen mode+special pad)
  set frame(0,24,0,80)
  clear frame
  gotoxy(0,0)
  cursorx=0; cursory=0
  prompt("")
%end

%externalroutine home cursor
  cursorx=0
  cursory=0
%end

%externalroutine restart screen
  clear frame
  cursorx=0
  cursory=0
%end

%externalroutine clear screen
  clear frame
%end

%externalroutine stop screen mode
  clear screen
  set shade(normal)
  set video mode(0)
%end

%routine rsl
%integer j, k
  buff=""
  %cycle
    advance time
    read symbol(j)
    %exit %if j=lf %or j=enter
    %signal %event 15,0 %if j='?'
    screen message("Stopped from console.","stop") %if j=128+esc
    %continue %if j<=31 %or j>=128
    %if j=del %thenstart
!  This supposes that del has not been dealt with at the input.
      print symbol(sp)
      k=length(buff)
      k=k-1; cursorx=cursorx-1
      k=0 %if k<0; cursorx=datastart %if cursorx<datastart
      length(buff)=k
    %finishelsestart
!  This assumes echo has been made.
      cursorx=cursorx+1
      buff=buff.tostring(j)
      %exit %if cursorx>linelength
    %finish
    gotoxy(cursorx,cursory-wmin+topd)
  %repeat
%end

%externalroutine read screen line(%string(*)%name a)
%integer j

  %on %event 15,0 %start
    read symbol(j) %until j=lf    ;!  To get rid of residual NL.
    help(menu(cursory)_name)
    write menu
  %finish

  prompt("")
  a=""
  cursorx=datastart
  gotoxy(cursorx,cursory-wmin+topd)
  clear line
  rsl %if buff=""
  a=buff
  buff=""
  cursorx=datastart; gotoxy(cursorx,cursory-wmin+topd)
  clear line; print string(a)
  cursorx=0; gotoxy(cursorx,cursory-wmin+topd)
%end

%externalroutine read screen lines(%record(line80listf)%name lines)
%record(line80f)%name p
  %cycle
    p==newline80
    read screen line(p_line)
    append cell(p,lines)
  %repeat %until p_line="*"
%end

!  The routine Set Up Menu expects the data to be given to it
!  as an array of records of format dataf.
!  Each Value is expected to be a list of lines.
!  The parameter Select gives the items in the order in which they
!  are to be expanded into the lines of the menu.

%externalroutine set up menu(%record(dataf)%arrayname data,
%integerarrayname select, %integer top, bottom, %string(15) default)
%integer i, j, k, l
%record(line80f)%name p
  itemno=0; itemno=itemno+1 %while select(itemno)>=0
  topd=top; bottomd=bottom
  menu(i)=0 %for i=0, 1, 250
  j=0
  %for i=0, 1, 250 %cycle
    k=select(i)
    %exit %if k<0
!  Copy wanted item into menu.
    p==data(k)_val_head
    l=j
    %if p==nil %thenstart
      message("Menu too long","mon") %if j>250
      menu(j)_item=k
      menu(j)_name=data(k)_name
      %if top<=i<itemno-bottom %then menu(j)_val=default %else menu(j)_val=""
      j=j+1
    %finishelsestart
      %while p##nil %cycle
        message("Menu too long","mon") %if j>250
        menu(j)_item=k
        menu(j)_name=data(k)_name
        menu(j)_val=p_line
        j=j+1
        p==p_next
      %repeat
    %finish
    message("Item(".itod(k).") named ".menu(i)_name."  too long.".snl. %c
    "L=".itod(l)."  Wdepth=".itod(wdepth)."  Topd=".itod(topd). %c
    "  Bottomd=".itod(bottomd),"mon") %c
    %if j-l>=wdepth-topd-bottomd
    menu(l)_length=j-l %for l=l,1,j-1
  %repeat
  menudepth=j-1
%end

%externalroutine write instruction(%string(255) s)
  gotoxy(0,23)
  clear line
  gotoxy(0,22)
  clear line
  gotoxy(0,21)
  clear line
  gotoxy(0,20)
  clear line
  print string(s)
  gotoxy(cursorx,cursory-wmin+topd)
%end

%routine display line(%integer y)
  %return %unless wmin-topd<=y<=wmax+bottomd
  gotoxy(0,y-wmin+topd)
  clear line
  print symbol(' ') %and  print string(menu(y)_name) %c
  %if y<=wmin %or y>=wmax %or menu(y)_item#menu(y-1)_item
  gotoxy(datastart,y-wmin+topd)
  print string(menu(y)_val)
  gotoxy(0,y-wmin+topd)
%end

%routine display item(%integer item, y)
  %return %unless wmin-topd<=y<=wmax+bottomd
  gotoxy(0, y-wmin+topd)
  clear line
  print symbol(' ')
  print string(menu(item)_name)
  gotoxy(datastart, y-wmin+topd)
  print string(menu(item)_val)
  gotoxy(0, y-wmin+topd)
%end

%externalroutine write menu
%integer d, i
!  Bring position of cursor within menu.
  %if cursorx<0 %then cursorx=0 %else %c
  %if cursorx>linelength %then cursorx=linelength
  %if cursory<0 %then cursory=0 %else %c
  %if cursory>menudepth %then cursory=menudepth
  %if menudepth<=wdepth %thenstart
!  Write whole menu.
    wmin=topd; wmax=menudepth-bottomd
    clear screen
    set shade(normal)
    display line(i) %for i=0,1,menudepth
    write instruction(menu instructions)
    gotoxy(cursorx,cursory-wmin+topd)
    %return
  %finish
  %if cursory=0 %thenstart
!  Deal with starting case, cursory=0.
    wmin=topd
    wmax=wdepth-bottomd
!  Move wmax up over multi-line item.
    wmax=wmax-1 %while menu(wmax)_item=menu(wmax-1)_item
    wmax=wmax-1 %if menu(wmax)_item=menu(wmax+1)_item
  %finishelsestart
!  Move Cursor to start of multi-line item.
    cursory=cursory-1 %while cursory>topd %and %c
    menu(cursory)_item=menu(cursory-1)_item
!  Calculate depth of page of menu.
    d=wdepth-(topd+bottomd)    ;!  Allow for escape cases.
    message("Too many fixed lines in menu.","stop") %if d<=0
!  Calculate bounds for page in menu.
    %if 0<cursory<=topd+d//2 %then wmin=topd %and wmax=wmin+d %c
    %else %c
    %if menudepth-bottomd-cursory<=d//2 %then %c
    wmax=menudepth-bottomd %and wmin=wmax-d %c
    %elsestart
      wmax=cursory+d//2
      wmax=menudepth-bottomd %if wmax>menudepth-bottomd
      wmin=wmax-d
    %finish
!  Move Wmax down past end of multi-line item.
    wmax=wmax+1 %while wmax<menudepth-bottomd %c
    %and menu(wmax)_item=menu(wmax+1)_item
!  Make sure that wmax is within window-depth of cursor.
    %if wmax>=cursory+d %thenstart
      wmax=cursory+d-1
      wmax=wmax-1 %while wmax>cursory %and menu(wmax)_item=menu(wmax-1)_item
      wmax=wmax-1 %if menu(wmax)_item=menu(wmax+1)_item
    %finish
    wmin=wmax-d; wmin=topd %if wmin<topd
    wmin=wmin+1 %while topd<wmin<cursory %and menu(wmin)_item=menu(wmin-1)_item
  %finish
!  Display menu.
  set shade(intense)
  display item(i,i+wmin-topd) %for i=0, 1, topd-1         ;!  Escape items.
  set shade(normal)
  display line(i) %for i=wmin, 1, wmax
  set shade(intense)
  display item(menudepth-bottomd+i,wmax+i) %for i=1, 1, bottomd
  set shade(normal)
  write instruction(menu instructions)
  gotoxy(cursorx,cursory-wmin+topd)
%end

%externalintegerfn cursor depth
%integer flag, j, k
  select input(0)
  prompt("")
  gotoxy(0,cursory-wmin+topd)
  %cycle
    flag=no
    %cycle
      advance time
      show time %if display clock=yes
      j=vttsym
    %repeat %until j>=0
    %exit %unless j=down %or j=up %or j='?' %or j&127=esc
    %if j=down %thenstart
!  Advance past end of multi-line item.
      cursory=cursory+1
      %while cursory<=wmax %and menu(cursory)_item=menu(cursory-1)_item %cycle
        cursory=cursory+1
        flag=yes %if cursory>wmax
      %repeat
    %finishelse %c
    %if j=up %thenstart
!  Recoil to start of multi-line item.
      cursory=cursory-1
      %while cursory>=wmin %and menu(cursory)_item=menu(cursory-1)_item %cycle
        cursory=cursory-1
        flag=yes %if cursory<wmin
      %repeat
    %finishelse %c
    %if j='?' %thenstart
      advance time %and read symbol(j) %until j=lf  ;!  get rid of rest of line.
      %if cursory<wmin %then help(menu(cursory-wmin+topd)_name) %else %c
      %if cursory>wmax %then help(menu(menudepth-bottomd+cursory-wmax-1)_name) %c
      %else help(menu(cursory)_name)
      write menu
    %finishelse %signal 15, 0
!  Restore cursor to within menu if neccessary.
    %if cursory<0 %then cursory=0 %else %c
    %if cursory>menudepth %then cursory=menudepth
    cursorx=0
    %if wmin-topd<=cursory<=wmax+bottomd %then %c
    gotoxy(cursorx,cursory-wmin+topd) %c
    %elsestart
      %if flag=no %thenstart
!  Set cursor just outside window if it leaves the screen.
        %if cursory<wmin-topd %then cursory=wmin-1 %c
        %else cursory=wmax+1
      %finish
      write menu
    %finish
  %repeat
  %if j=nl %then buff="" %and cursorx=datastart %c
  %elsestart
    cursorx=0
    gotoxy(cursorx, cursory-wmin+topd)
    print symbol(j)
    cursorx=cursorx+1
    rsl
    buff=tostring(j).buff
  %finish
  %if cursory<wmin %thenstart
    j=cursory-wmin+topd
    menu(j)_val=buff
    set shade(intense)
    display item(j,cursory)
    set shade(normal)
    %result=menu(j)_item
  %finishelse %c
  %if cursory>wmax %thenstart
    j=cursory-wmax+menudepth-bottomd
    menu(j)_val=buff
    set shade(intense)
    display item(j,cursory)
    set shade(normal)
    %result=menu(j)_item
  %finishelsestart
    set shade(normal)
    menu(cursory)_val=buff
    display line(cursory)
  %finish
  %result=menu(cursory)_item
%end


%endoffile

