
{  3/11/87  17:12   clock}

%begin
%include "sm:formats.inc"
%include "Level1:graphinc.imp"
%include "inc:maths.imp"
%include "inc:fs.imp"
%include "sm:utils.inc"
%include "inc:util.imp"

%recordformat alarmf(%record(alarmf)%name next, prev, %integer d, h, m, s, r)
%record(alarmf)%name ak, al
%recordformat alarmlistf(%record(alarmf)%name head, tail)
%record(alarmlistf) alarm list
%record %format pointfm(%integer x, y)
%record %format dialfm(%string(2) num, %record(pointfm) loc)
%record %format linefm(%integer x0, x1, y)

%constinteger no='n', yes='y'

%string(31) alarm time
%integer alarm, alarm width
%integer background=black
%constinteger bl=16_7800, grn=16_3C0, rd=16_1e, flashing=16_8000
%const %integer cx=344
%integer cy=256, ccy=768
%string(31) digital date
%integer datey=0, datey1=0
%integer d, dt=0
%integer dialfnt, dr, dw
%constintegerarray daysin(1:12)=31,28,31,30,31,30,31,31,30,31,30,31
%integer facecolour=white, figscolour=black,
first=yes, fnt, h, hourcolour=black, hhh, hr, i,
%integer last alarm width, last date width, last time width
%routinespec list alarms(%string(80) s)
%integer m, mil, minutecolour=black, mr, mmm
%real piov6, piov30, piov60, piov1500
%integer r, ring, s, secscolour=black, size=250, sr, setting, state, sym
%integer t, text x, text y, timey=0, timey1=0, ttt
%string(31) u,v
%integer x
%real xt
%integer y
%real yt
%string(255) z

%record(pointfm) a, b, c, ha, hb, hc, ma, mb, mc, mma, mmb, mmc,
     hha, hhb, hhc
%record(dialfm) %array da(0:11)
%half %integer %array colmap(0:255)


%routine print record(%record(alarmf)%name a, %string(255) s)
%string(255) x, y
  print string(s); newline
  %if a==nil %then x="nil record" %elsestart
    %if a_d=0 %then x="  " %else x="+ "
    y=itod(a_h); y="0".y %if length(y)=1
    x=x." ".y
    y=itod(a_m); y="0".y %if length(y)=1
    x=x." ".y
    y=itod(a_s); y="0".y %if length(y)=1
    x=x." ".y
    %if a_r=0 %then x=x."  " %else x=x." R"
  %finish
  print string(x.snl)
%end

%routine paint board(%integer col, x, y, width, depth)
  colour(col)
  fill(x, y-depth, x+width, y)
  fill(x, y+512-depth, x+width, y+512)
%end

%routine display string(%string(255) s, %integer x, y, strwdth, back, col, fnt)
  font(fnt)
  paint board( %c
  back, x, y+font height, strwdth, font height)
  colour(col)
  text at(x,y); show string(s)
  text at(x,y+512); show string(s)
%end

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

%string(255)%fn digital alarm(%record(alarmf)%name a)
%string(15) x
  %if a==nil %or (a_d=0 %and a_h=0 %and a_m=0 %and a_s=0 %and a_r=0) %c
  %then x="" %elsestart
    x=digital time(a_h, a_m, a_s)
    x="+ ".x %if a_d=1
    %if a_r=0 %then x=x."  " %else x=x." R"
  %finish
  %result=x
%end

%routine clean boards
%string(255) s
  font(0)
  paint board(background, 8, 511, 200, 40)
  paint board(background, 8, 511, alarm width, 170)
  paint board(background, 8, 5*font height, alarm width, 3*font height)
  display string("Alarm time :", 8, cy-248, 200, background, white, 0)
  text x=112
%end

%routine centre string(%string(255) s, %integer max,y)
  font(fnt)
  colour(facecolour)
  fill(cx-max//2,y-font depth,cx+max//2,y+font height)
  text at(cx-string width(s)//2,y)
  colour(figscolour)
  show string(s)
%end

%routine display alarm
%string(15) alarm time
%integer width
  alarm time=digital alarm(al)
  alarm time="" %if alarm time="nil"
  font(0)
  text x=112; text y=8
  display string(alarm time, text x, text y, last alarm width, background,
  white, 0)
  last alarm width=string width(alarm time)
  last alarm width=alarm width %if last alarm width<alarm width
%end

%routine draw clock(%integer cy)
%integer i, figr
%real figh, xr, yr
%string(3) num
  font(0)
  colour(white)
  text at(8, cy-248)
  show string("Alarm time :")
  piov6=pi
  piov30=piov6/30
  piov60=piov6/60
  piov1500=piov6/1500
  piov6=piov6/6
  font(dialfnt)
  dr=size*31//32
  dw=size//32
  sr=size*29//32
  figh=font height/2
  figr=sr
  mr=figr-font height//2-2
  hr=mr-font height
  colour(facecolour)
  disc(cx, cy, size)
  colour(figscolour)
  %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
    text at(a_x,a_y)
    show string(num)
  %repeat
  a_x=cx
  a_y=cy
  ha=a
  hb=a
  hc=a
  ma=a
  mb=a
  mc=a
  hha=a
  hhb=a
  hhc=a
  mma=a
  mmb=a
  mmc=a
%end

%routine squeak
%integer wait
  wait=cputime+20
  print symbol(7) %while cputime<=wait
%end

%routine show time(%integer hrs, mins, secs)
%integer temp, x, wait
%string(3) num
%owninteger ss=0,sss=0
!  Swop writing positions with half-frame not being displayed.
  temp=cy
  cy=ccy
  ccy=temp
  temp=timey
  timey=timey1
  timey1=temp
  temp=datey
  datey=datey1
  datey1=temp
!  Obliterate hands.
  colour(facecolour)
  triangle(hha_x, hha_y, hhb_x, hhb_y, hhc_x, hhc_y)
  triangle(mma_x, mma_y, mmb_x, mmb_y, mmc_x, mmc_y)
  yt=sss*piov30
  line(cx, cy, cx+intpt(sin(yt)*sr), cy+intpt(cos(yt)*sr))
!  Reinstate figures where second-hand has been.
  temp=rem((2+sss)//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,a_y)
  show string(num)
!  Draw hour hand.
  colour(hourcolour)
  x=rem(hrs,12)
  yt=(75-x*5-mins/12)*piov30
  xt=cos(yt)
  yt=sin(yt)
  a_x=cx+intpt(xt*hr)
  a_y=cy+intpt(yt*hr)
  b_x=cx+intpt(yt*dw)
  b_y=cy+intpt(-xt*dw)
  c_x=cx+intpt(-yt*dw)
  c_y=cy+intpt(xt*dw)
  hha=ha
  hhb=hb
  hhc=hc
  ha=a
  hb=b
  hc=c
  triangle(a_x, a_y, b_x, b_y, c_x, c_y)
!  Draw minute hand.
  colour(minutecolour)
  yt=(75-mins-secs/3000)*piov30
  xt=cos(yt)
  yt=sin(yt)
  a_x=cx+intpt(xt*mr)
  a_y=cy+intpt(yt*mr)
  b_x=cx+intpt(yt*dw)
  b_y=cy+intpt(-xt*dw)
  c_x=cx+intpt(-yt*dw)
  c_y=cy+intpt(xt*dw)
  mma=ma
  mmb=mb
  mmc=mc
  ma=a
  mb=b
  mc=c
  triangle(a_x, a_y, b_x, b_y, c_x, c_y)
!  Draw seconds-hand.
  colour(secscolour)
  yt=secs*piov30
  line(cx, cy, cx+intpt(sin(yt)*sr), cy+intpt(cos(yt)*sr))
  disc(cx, cy, dw)
  sss=ss
  ss=secs
!  Display digital date and time.
  centre string(digital date, last date width, datey)
  centre string(digital date, last date width, datey1)
  last date width=string width(digital date)
  centre string(digital time(h, m, s), last time width, timey)
  last time width=string width(digital time(h, m, s))
  font(0)
!  Display new half-frame.
  offset(0, cy-256)
!  Wait or sound alarm.
  wait=cpu time+20
  %while cpu time<=wait %cycle
    print symbol(7) %unless ring=0
  %repeat
%end

!  This does not yet deal with leap-years.

%string(15)%fn increment date
%integer day, month, year
%string(15) x,y,z
  digital date->x.(" ").y
  y->y.(" ").z
  day=dtoi(x); month=dtoi(y); year=dtoi(z)
  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

%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

%record(alarmf)%map new alarm
%record(alarmf) pattern
%record(alarmf)%name p
  p==new(pattern)
  p_next==nil; p_prev==nil
  p_d=0; p_h=0; p_m=0; p_s=0; p_r=0
  %result==p
%end

%routine update alarm list
%record(alarmf)%name p, q
  dispose(al)
  al==new alarm
  p==alarm list_head
  %while p##nil %cycle
    %if p_d=0 %thenstart
      q==p; p==p_next
      excise cell(q,alarm list)
      dispose(q)
      q==nil
    %finishelsestart
      p_d=0
      p==p_next
    %finish
  %repeat
%end

%integerfn precedence(%record(alarmf)%name a,b)
  %result=0 %if a_d=b_d %and a_h=b_h %and a_m=b_m %and a_s=b_s
  %result=-1 %if a_d<b_d %or (a_d=b_d %and a_h<b_h) %c
             %or (a_d=b_d %and a_h=b_h %and a_m<b_m) %c
             %or (a_d=b_d %and a_h=b_h %and a_m=b_m %and a_s<b_s)
  %result=1
%end

%record(alarmf)%map pop
%record(alarmf)%name p
  p==alarm list_head
  %if p==nil %thenstart
    alarm list_tail==nil
    %result==nil
  %finish
  alarm list_head==p_next
  %if alarm list_head==nil %then alarm list_tail==nil %c
  %else alarm list_head_prev==nil
  p_next==nil; p_prev==nil
  %result==p
%end

%routine put into store(%record(alarmf)%name a)
%record(alarmf)%name p, q
%integer i
  %return %if a==nil
  p==new alarm
  p=a
  q==alarm list_head
  %while q##nil %cycle
   i=precedence(p,q)
   %return %if i=0
   insert cell before(p,q,alarm list) %and %c
   %return %if i=-1
   q==q_next
  %repeat
  append cell(p,alarm list)
%end

%routine reset alarm
  al==pop
  %if al==nil %then al==new alarm %and alarm=0 %else alarm=1
  %if al_d=1 %thenstart
    put into store(al)
    al==new alarm
    alarm=0
  %finish
  put into store(al) %if al_r=1
  display alarm
  list alarms("")
%end

%routine advance time
%owninteger flag=no
%string(15) sspd
!  Advance time.
  %if cputime-ttt>=1000 %thenstart
    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
          update alarm list
          reset alarm
        %finish
      %finish
    %finish
!  Display time.
    show time(h, m, s)
  %finish
  %if alarm=0 %thenstart
! Alarm time not yet set.
    ring=0
    colour map(0)=1    ;! Fudge to avoid using the read before write instruction.
  %finishelsestart
!  Alarm time set.
    %if alarm=1 %and al_h=h %and al_m=m %and al_s=s %thenstart
      ring=1
      colour map(0)=flashing+rd+grn+bl
    %finish
  %finish
%end

%routine stop alarm
  ring=0
  colour map(0)=1
  dispose(al)
  al==new alarm
  reset alarm
%end

%routine read rest of line(%string(*)%name a)
%integer j
  text y=8
  %cycle
    advance time
    j=test symbol
    %if j>0 %thenstart
      %exit %if j=nl
!  Deal with Erase.
      %if j=127 %thenstart
        %if length(a)>0 %thenstart
          colour(white)
          length(a)=length(a)-1
          text x=text x-8
          display string(a, 112, 8, last alarm width, white, background, 0)
        %finishelse squeak
!  Deal with general characters.
      %finishelse %c
      %if '0'<=j<='9' %or j=' ' %or j='+' %c
      %or 'a'<=j<='z' %or 'A'<=j<='Z' %thenstart
        font(0)
        colour(white)
        a=a.tostring(j)
        text at(text x,text y); show symbol(j)
        text at(text x,text y+512); show symbol(j)
        text x=text x+8
      %finish
    %finish
  %repeat
%end

%routine purify(%string(*)%name a)
%integer i, j, k
  k=0
  %for i=1,1,length(a) %cycle
    j=charno(a,i)
    j=' ' %if i>1 %and (j=':' %or j='.')
    %if '0'<=j<='9' %or (j=' ' %and (k=0 %or (k>0 %and charno(a,k)#' '))) %c
    %or j='+' %or 'a'<=j<='z' %or 'A'<=j<='Z' %or j='.' %thenstart
      k=k+1
      j=j-'A'+'a' %if 'A'<=j<='Z'
      charno(a,k)=j
    %finish
  %repeat
  length(a)=k
%end

%routine trim leading space(%string(*)%name a)
  %return %if a=""
  %if charno(a,1)=' ' %thenstart
    charno(a,1)=length(a)-1
    a=string(addr(charno(a,1)))
  %finish
%end

%record(alarmf)%map al of(%string(255) s)
%string(255) u
%record(alarmf)%name ak
  ak==new alarm
  purify(s)
  %if s->("+").s %then ak_d=1 %and trim leading space(s) %else ak_d=0
  u=s %and s="" %unless s->u.(" ").s
  ak_h=rem(dtoi(u),24)
  u=s %and s="" %unless s->u.(" ").s
  ak_m=rem(dtoi(u),60)
  u=s %and s="" %unless s->u.(" ").s
  ak_s=rem(dtoi(u),60)
  ak_s=1 %if ak_h=0 %and ak_m=0 %and ak_s=0
  %if s->("r").s %then ak_r=1 %else ak_r=0
  %result==ak
%end

%routine store alarm(%record(alarmf)%name a)
%record(alarmf)%name p
%integer i
!  Compare new alarm time with current time.
  p==new alarm
  p_h=h; p_m=m; p_s=s
  i=precedence(a,p)
  %return %if i<=0
!  Compare new alarm time with current alarm time.
  %if alarm=0 %or (al_d=0=al_h %and al_m=0=al_s)  %thenstart
!  No active alarm times in use.
    al=a
    alarm=1
  %finishelsestart
!  Some alarm time already active.
    alarm=1
    p=a
    i=precedence(p,al)
    %if i<0 %then put into store(al) %and al==p %c
    %else %if i>0 %then put into store(p)
  %finish
  display alarm
  list alarms("")
%end

%routine list alarms(%string(80) s)
%constinteger testcolour1=white
%constinteger testcolour2=blue
%constinteger testcolour3=red
%integer d, y
%owninteger old depth=0, old width=0
%string(31) x
%record(alarmf)%name p
  font(0)
!  Count alarm times to be displayed.
  %if al==nil %or (al_h=0=al_m %and al_s=0) %then d=0 %else d=1
  p==alarm list_head
  %while p##nil %cycle
    d=d+1
    p==p_next
  %repeat
!  Clean off old display.
  y=511
  %if old width#0 %thenstart
    paint board(background, 8, y, old width, font height+font depth)
    y=y-font height-font depth
  %finish
  %if old depth#0 %thenstart
    paint board(background, 8, y, alarm width, old depth)
  %finish
!  Display.
  old depth=d*font height
  old width=length(s)
  y=511
  %if s#"" %thenstart
    paint board(testcolour1, 8, y, old width, font height+font depth)
    y=y-fontheight
    colour(testcolour3)
    text at(8,y); show string(s)
    text at(8,y+512); show string(s)
    y=y-font depth
  %finish
  %return %if old depth=0
  paint board(testcolour1, 8, y, alarm width, old depth)
  %if al##nil %and (al_h#0 %or al_m#0 %or al_s#0) %thenstart
    x=digital alarm(al)
    colour(testcolour2)
    y=y-font height
    text at(8,y); show string(x)
    text at(8,y+512); show string(x)
  %finish
  p==alarm list_head
  %while p##nil %and y>200 %cycle
    y=y-fontheight
    x=digital alarm(p)
    text at(8,y); show string(x)
    text at(8,y+512); show string(x)
    p==p_next
  %repeat
%end

%routine delete alarms(%string(255) s)
%integer j
%string(255) u
%record(alarmf)%name p, q
  font(0)
  u="" %unless s->s.(" ").u
  %if u="all" %or u="*" %thenstart
    delete list(alarm list)
    clean boards
    reset alarm
    %return
  %finish
  prefix cell(al,alarm list)
  al==new alarm
  alarm time=""
  p==alarm list_head
  display string("Delete? ", 8, 4*fontheight, alarm width, white, blue, 0) %c
  %unless p==nil
  %while p##nil %cycle
    u=digital alarm(p)
    display string(u, 8, 3*fontheight, alarm width, white, blue, 0)
    %cycle
      advance time
      j=test symbol
      %exit %if j>0 %and (j='n' %or j='y' %or j='N' %or j='Y' %or j=nl)
    %repeat
    %if j='y' %or j='Y' %thenstart
      q==p
      p==p_next
      excise cell(q,alarm list)
      dispose(q)
      list alarms("")
    %finishelse p==p_next
  %repeat
  paint board(background, 8, 5*fontheight, alarm width, 3*fontheight)
  reset alarm
%end

%routine set manual time
  prompt("Hr:")
  read(h)
  h=rem(h, 24)
  prompt("Min:")
  read(m)
  m=rem(m, 60)
  prompt("Sec:")
  read(s)
  s=rem(s,60)
  t=test symbol %until t=nl    ;!  To get rid of rest of line including NL.
%end

%string(15) %function datime
   %string(255) s
   length(s) = fcommr('G0',"",charno(s,1),255)
   %result = s
%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)
%end

%routine help
%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

%string(255)%fn obey command(%string(255) s)
%string(255) u
  %if s->(".c").u %then clean boards %else %c
  %if s->(".d").u %then delete alarms(u) %else %c
  %if s->(".h").u %then help %else %c
  %if s->(".l").u %then list alarms("") %else %c
  %if s->(".r").u %then %result="exit"
  display alarm
  %result=""
%end

%routine initial settings
!  Read font and set-up space for digital date and time.
  read font("level1:Timesr8",dialfnt)
  read font("level1:Timesb7",fnt)
  font(fnt)
  datey=cy+3*font height; datey1=ccy-cy+datey
  timey=cy-3*font height; timey1=ccy-cy+timey
  digital date=""
  ttt=0
  font(0)
!  Set date from system service
  digital date=spdate
! Set time.
  %if first=yes %then set system time %and first=no %else set manual time
  mil=0
  ttt=cputime
!  Draw clock-face.
  clear
  offset(0, 0)
  draw clock(256)
  draw clock(768)
  last date width=string width("56 56 56")
  last time width=last date width
!  Initial setting of organisation for alarm.
  alarm=0; alarm time=""
  ak==new alarm; al==new alarm
  ring=0
  text x=112
  font(0)
  alarm width=string width("+ 56 56 56 R")
  last alarm width=alarm width
  alarm list_head==nil; alarm list_tail==nil
%end

{Main Program}


  %cycle
    initial settings
!  Cycle, displaying time and looking for alarm setting.
    %cycle
      sym=test symbol
      advance time
      %if sym>0 %thenstart
        font(0)
        text x=112
!  If alarm ringing then switch off alarm and reset alarm time.
        stop alarm  %and %continue %if ring=1
!  Ignore irrelevant characters.
        %continue %unless sym='.' %or '0'<=sym<='9' %or sym='+' %c
        %or sym='h' %or sym='H' %or sym='?' %or sym=nl
!  Start of line so clear display area for alarm time.
        paint board(background, text x, 8+font height,
        last alarm width, font height+font depth)
        reset alarm %and %continue %if sym=nl
        colour(white)
        text at(text x,8); show symbol(sym)
        text at(text x,520); show symbol(sym)
        text x=text x+8
!  Read whole line.
        %if sym='h' %or sym='H'  %or sym='?'%then z=".h" %else z=tostring(sym)
        read rest of line(z)
        purify(z)
        trim leading space(z) %while charno(z,1)=' '
        text x=112
        display string(z, text x, cy-248, 100, background, white, 0)
        %if charno(z,1)='?' %then help %else %c
        %if charno(z,1)='.' %thenstart
          %exit %if obey command(z)="exit"
        %finishelsestart
          ak==al of(z)
          store alarm(ak)
        %finish
      %finish
    %repeat
  %repeat

%end %of %program

