
{  2/10/87  09:14   Clock}

%begin
%include "staff:sm:formats.inc"
%include "Level1:graphinc.imp"
%include "inc:maths.imp"
%include "inc:fs.imp"
%include "staff: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, facecolour=white, figscolour=black,
first=yes, fnt, h, hourcolour=black, hhh, hr, i, just off,
%integer last alarm width, last date width, last time width
%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, timey=0, timey1=0, ttt
%string(31) u,v
%integer x
%real xt
%integer y
%real yt
%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 display 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

%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="nil" %elsestart
    x=digital time(a_h, a_m, a_s)
    %if a_d=0 %then x="  ".x %else x="+ ".x
    %if a_r=0 %then x=x."  " %else x=x." R"
  %finish
  %result=x
%end

%routine display alarm(%record(alarmf)%name al)
%string(15) alarm time
%integer width
  alarm time=digital alarm(al)
  alarm time="" %if alarm time="nil"
  colour map(0)=1
  font(0)
  colour(background)
  text x=112
  fill(text x,8,text x+last alarm width,8+font height)
  fill(text x,520,text x+last alarm width,520+font height)
  colour(white)
  text at(text x,8); show string(alarm time)
  text at(text x,520); show string(alarm time)
  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 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.
  display string(digital date,last date width,datey)
  last date width=string width(digital date)
  display 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

%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

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

%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 %return %if i=-1
   q==q_next
  %repeat
  append cell(p,alarm list)
%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
  %if i<0 %thenstart
    a_d=1
    put into store(a)
    alarm=1
    %return
  %finish
!  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
%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
  %finishelse alarm=1
  put into store(al) %if al_r=1
%end

%routine update alarm list
%record(alarmf)%name p, q
  p==alarm list_head
  %while p##nil %cycle
    p_d=p_d-1
    %if p_d<0 %thenstart
      q==p; p==p_next
      excise cell(q,alarm list)
      dispose(q)
      q==nil
    %finishelse p==p_next
  %repeat
%end

%routine list alarms(%string(80) s)
%integer testcolour1=white
%integer testcolour2=blue
%integer y
%string(31) x
%record(alarmf)%name p
  colour(testcolour1)
  fill(0,200,alarm width,511)
  fill(0,712,alarm width,1023)
colour(green)
text at(0,491); show string(s)
text at(0,1003); show string(s)
  x=digital alarm(al)
  colour(testcolour2)
  text at(0,471); show string("HEAD:")
  text at(0,451); show string(x)
  text at(0,983); show string("HEAD:")
  text at(0,963); show string(x)
  p==alarm list_head
  y=411
  %while p##nil %and y>200 %cycle
    x=digital alarm(p)
    text at(0,y); show string(x)
    text at(0,y+512); show string(x)
    p==p_next
    y=y-20
  %repeat
%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
!  Read time from manual setting of clock.
  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.
  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)
  just off=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}


  initial settings
!  Cycle, displaying time and looking for alarm setting.
  %cycle
    sym=test symbol
    %if sym>0 %thenstart
!  If alarm ringing then switch off alarm and reset alarm time.
      %if ring=1 %thenstart
        ring=0
        dispose(al)
        al==new alarm
        reset alarm
        display alarm(al)
        just off=1
      %finish
!  Deal with delete.
      %if sym=127 %thenstart
        %if length(alarm time)>0 %thenstart
          length(alarm time)=length(alarm time)-1
          text x=text x-8
          font(0)
          colour(background)
          fill(text x,8,text x+8,8+font height)
          fill(text x,520,text x+8,520+font height)
        %finish
      %finishelse %if sym=nl %thenstart
!  Deal with NL.
        %if alarm time="" %thenstart
          %if just off=0 %then reset alarm %else %c
          %if al==nil %or (al_h=0=al_m %and al_s=0) %then alarm=0
        %finishelsestart
          ak==new alarm %if ak==nil
          alarm time=u."$".v %while alarm time->u.(" ").v %c
          %or alarm time->u.(":").v %or alarm time->u.(".").v
          alarm time=u."$".v %while alarm time->u.("$$").v
          alarm time=u." ".v %while alarm time->u.("$").v
          v=alarm time
          %if v->("+").v %then ak_d=1 %else ak_d=0
          u=v %and v="" %unless v->u.(" ").v
          ak_h=dtoi(u)
          ak_h=rem(ak_h,24)
          u=v %and v="" %unless v->u.(" ").v
          ak_m=dtoi(u)
          ak_m=rem(ak_m,60)
          u=v %and v="" %unless v->u.(" ").v
          ak_s=dtoi(u)
          ak_s=rem(ak_s,60)
          ak_s=1 %if ak_h=0 %and ak_m=0 %and ak_s=0
          %if v->("r").v %then ak_r=1 %else ak_r=0
          store alarm(ak)
          alarm=1
          first=yes
        %finish
        display alarm(al)
        alarm time=""
      %finishelsestart
        %if first=yes %thenstart
          colour map(0)=1
          font(0)
          colour(background)
          text x=112
          fill(text x,8,text x+last alarm width,8+font height)
          fill(text x,520,text x+last alarm width,520+font height)
          colour(white)
        %finish
!  Deal with general characters.
        %if '0'<=sym<='9' %or (first=yes %and sym='+') %c
        %or (first=no %and (sym=' ' %or sym=':' %or sym='.' %or sym='r' %c
             %or sym='R')) %thenstart
          font(0)
          colour(white)
          text at(text x,8)
          show symbol(sym)
          text at(text x,520)
          show symbol(sym)
          text x=text x+8
          alarm time=alarm time.tostring(sym)
          first=no
        %finish
      %finish
    %finish
    just off=0
!  Advance time.
    %if cputime-ttt>=1000 %thenstart
      ttt=ttt+1000
      s=s+1
      %if s=60 %thenstart
        s=0
        m=m+1
        %if m=60 %thenstart
          m=0
          h=h+1
          %if h=24 %thenstart
            h=0
            digital date=spdate
            update alarm list
          %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 al##nil %and al_h=h %and al_m=m %and al_s=s %thenstart
        ring=1
        colour map(0)=flashing+rd+grn+bl
      %finish
    %finish
  %repeat
%end %of %program

