
{  24/7/90  16:42   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 aj, 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, alwdth
%integer background=black
%constinteger bl=16_7800, grn=16_3C0, rd=16_1e, flashing=16_8000
%integer cx, cy, ccy
%string(31) digital date="00 00 00"
%integer datecolour=blue, 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=cyan
%real figh
%integer figr, figscolour=red, 
firstdate=yes, firsttime=yes, fnt, h, hourcolour=red, hhh, hr, i, 
%integer last date width, last time width
%routinespec list alarms(%string(80) s)
%integer m, mil, minutecolour=red, mr, mmm
%conststring(5)%array mth(1:12)= %c
"jan", "feb", "mar", "april", "may", "june", "july", "aug", "sept", "oct",
"nov", "dec"
%integer nilcolour=black, nilpart
%real piov6, piov30, piov60, piov1500
%integer r, ring, s, secscolour=red, size=250, sr, setting
%string(63) start
%integer state, sym
%integer t, textcolour=white, text x, text y, tick=15, tickcolour=black
%integer timecolour=blue
%integer timey=0, timey1=0, ttt
%string(31) u, v, w
%integer w1, w2, x
%integer y, yoff, yyoff
%string(255) z, zz

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

%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(63) 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)
    %if a_d=1 %then x=" + ".x %else x="   ".x
    %if a_r=0 %then x=x."  " %else x=x." R"
  %finish
  %result=x
%end

%routine trace alarm(%record(alarmf)%name a, %string(255) s)
%string(15) x
  x=digital alarm(a)
  %if x="" %then x="No alarm set."
  trace(s.snl.x)
%end

%routine trace alarm list(%string(255) s)
%record(alarmf)%name p
  trace alarm(al, s)
  p==alarm list_head
  %if p==nil %thenstart
    trace("Nill Alarm List.")
    %return
  %finish
  trace alarm(p, "Alarm List.")
  %cycle
    p==p_next
    %exit %if p==nil
    trace alarm(p, "")
  %repeat
%end

%routine print record(%record(alarmf)%name a, %string(255) s)
%string(255) x, y
  print string(s.snl.digital alarm(a).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 show sym(%integer j)
  %return %if j<=0
  text at(text x, text y); show symbol(j)
  text at(text x, text y+512); show symbol(j)
  text x=text x+string width(tostring(j))
%end

%routine show str(%string(80) s)
%integer i
  %return %if s=""
  show sym(charno(s, i)) %for i=1, 1, length(s)
%end

%routine display string(%string(255) s, %integer x, y, strwdth, back, col, fnt)

  font(fnt)
  paint board(back, x, y+font height, strwdth, font height+font depth)
  colour(col)
  text x=x; text y=y
  show str(s)
%end

%routine mssg(%string(255) s)
  %return %if s=""
  paint board(background, 8, 490, 200, 20)
  display string(s, 8, 490, 200, background, textcolour, 0)
%end

%routine display alarm
%string(80) alarm time
%integer width
%owninteger last width=0

  alarm time=digital alarm(al)
  alarm time="" %if alarm time="nil"
  alarm time="Alarm Time:".alarmtime
  font(0)
  text x=8; text y=cy-248+font height
  paint board(background, text x, text y, 250, font height+font depth)
  text x=8; text y=cy-248
  last width=string width(alarm time)
  display string(alarm time, text x, text y, last width,
  background, textcolour, 0)
%end

%routine clean boards
%string(255) s
  font(0)
  paint board(background, 8, 511, 200, 40)
  paint board(background, 8, 490, 150, 60)
  paint board(background, 8, cy-248+font height, 250, 15)
  paint board(background, 8, 5*font height, 128, 3*font height)
  display alarm
%end

%routine centre string(%string(255) s, %integername max, %integer y, colr)
  %return %if s=""
  font(fnt)
  colour(facecolour)
  fill(cx-max//2, y-font depth, cx+max//2, y+font height)
  colour(colr)
  max=string width(s)
!  To avoid interference with other displays.
  text at(cx-max//2, y)
  show string(s)
%end

%routine draw ticks(%integer tick, tickcolour)
%integer i
%real u, v, x, y, z
  colour(tickcolour)
  %for i=0, 1, 59 %cycle
    x=sin(i*piov30)
    u=tick*x; x=size*x
    y=cos(i*piov30)
    v=tick*y; y=size*y
    line(cx+int(x), cy+int(y), cx+int(x-u), cy+int(y-v))
    line(cx+int(x), ccy+int(y), cx+int(x-u), ccy+int(y-v))
  %repeat
%end

%routine setup clock
%record(pointfm) a
%integer i
%real xr, yr
%string(3) num
  yoff=0; yyoff=512
  cx=344
  cy=yoff+256; ccy=yyoff+256
  font(0)
  text x=8; text y=cy-248
  piov30=pi/30
  piov60=pi/60
  piov1500=pi/1500
  piov6=pi/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
  %for i=0, 1, 11 %cycle
    %if i=0 %then num="12" %else num=itod(i)
    xr=sin(i*piov6)*figr-string width(num)/2
    yr=cos(i*piov6)*figr-0.6*font height/2
    a_x=intpt(xr)
    a_y=intpt(yr)
    da(i)_num=num
    da(i)_loc=a
  %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
  sa=a; sb=a; sc=a
  ssa=a; ssb=a; ssc=a
%end

%routine draw clock(%integer cy)
%integer i
  colour(textcolour)
  text x=8; text y=cy-248
  display alarm
  font(dialfnt)
  colour(facecolour)
  disc(cx, cy, size)
  colour(figscolour)
  %for i=0, 1, 11 %cycle
    text x=cx+da(i)_loc_x; text y=cy+da(i)_loc_y
    show str(da(i)_num)
  %repeat
  draw ticks(tick, tickcolour)
%end

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

%routine show time(%integer hrs, mins, secs)
%record(pointfm) a
%integer temp, x, wait
%string(3) num
%owninteger ss=0, sss=0
%real xt, yt
!  Swop writing positions with half-frame not being displayed.
  temp=yoff
  yoff=yyoff
  yyoff=temp
  cy=yoff+256; ccy=yyoff+256
  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)
  triangle(ssa_x, ssa_y, ssb_x, ssb_y, ssc_x, ssc_y)
!  Reinstate figures where second-hand has been.
  temp=rem((2+sss)//5, 12)
  a_x=da(temp)_loc_x+cx; a_y=da(temp)_loc_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/60)*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=(75-secs)*piov30
  xt=cos(yt)
  yt=sin(yt)
  a_x=cx+intpt(xt*sr)
  a_y=cy+intpt(yt*sr)
  b_x=cx+intpt(yt*dw/8)
  b_y=cy+intpt(-xt*dw/8)
  c_x=cx+intpt(-yt*dw/8)
  c_y=cy+intpt(xt*dw/8)
  ssa=sa; ssb=sb; ssc=sc
  sa=a; sb=b; sc=c
  triangle(a_x, a_y, b_x, b_y, c_x, c_y)
!  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, datecolour)
  centre string(digital time(h, m, s), last time width, timey, timecolour)
  font(0)
!  Display new half-frame.
  offset(0, yoff)
!  Wait or sound alarm.
  wait=cpu time+20
  %while cpu time<=wait %cycle
    print symbol(7) %unless ring=0
  %repeat
%end

%routine set system date
%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.(" ")
  digital date=x." ".y." ".z
%end

!  This does not yet deal with leap-years.

%string(15)%fn increment date
%integer day, flag, month, year
%string(15) x, y, z
  digital date->x.(" ").y
  y->y.(" ").z
  day=dtoi(x)
  flag=no
  %if '1'<=charno(y, 1)<='9' %then month=dtoi(y) %elsestart
    %for month=1, 1, 12 %cycle
      flag=yes %and %exit %if mth(month)=y
    %repeat
    %if flag=no %then set system date %and %result=digital date
  %finish
  %if length(z)>2 %thenstart
    charno(z, 1)=charno(z, length(z)-1)
    charno(z, 2)=charno(z, length(z))
    length(z)=2
  %finish
  year=dtoi(z)
  day=day+1
  %if day>days in(month) %thenstart
    day=1
    month=month+1
    %if month>12 %thenstart
      month=1
      year=year+1
    %finish
  %finish
  %if flag=no %then y=itod(month) %else y=mth(month)
  %result=itod(day)." ".y." ".itod(year)
%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

%integerfn precedence(%record(alarmf)%name a, b)
  %if a_d<b_d %then %result=-1
  %if a_d=b_d %thenstart
    %if a_h<b_h %then %result=-1
    %if a_h=b_h %thenstart
      %if a_m<b_m %then %result=-1
      %if a_m=b_m %thenstart
        %if a_s<b_s %then %result=-1
        %if a_s=b_s %then %result=0
      %finish
    %finish
  %finish
  %result=1
%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 update alarm list
%record(alarmf)%name p, q
  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
      %if p_r=1 %thenstart
        al=p
        al_r=0
        al_d=0
        put into store(al)
      %finishelse p_d=0
      p==p_next
    %finish
  %repeat
%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 reset alarm

  al==new alarm
  al=alarm list_head %if alarm list_head##nil
  %if al_d=1 %then al=0
  %if al_d=0=al_h %and al_m=0=al_s %then alarm=0 %else alarm=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
!  Further fudge to correct for the loss of 1 second per day.
      ttt=ttt-1
      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
          ak=pop
        %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
      al==pop
      reset alarm
      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, %string(63) start)
%integer j
  %cycle
    advance time
    font(0)
    j=test symbol
    %if j>0 %thenstart
      %exit %if j=nl
!  Deal with Erase.
      %if j=127 %thenstart
        %if length(a)>0 %thenstart
          length(a)=length(a)-1
          text x=8
          display string(start.a, text x, text y, 150,
          background, textcolour, 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'%or j='*' %thenstart
        a=a.tostring(j)
        colour(textcolour)
        show sym(j)
      %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 spaces(%string(*)%name a)
  a->(" ").a %while length(a)>0 %and charno(a, 1)=' '
%end

%record(alarmf)%map al of(%string(255) s)
%string(255) u
%record(alarmf)%name ak

  ak==new alarm
  purify(s)
  trim leading spaces(s)
  lower(s)
  %if s->("+").s %then ak_d=1 %and trim leading spaces(s) %else ak_d=0
  u=s %and s="" %unless s->u.(" ").s
  %if '0'<=charno(u, 1)<='9' %thenstart
    ak_h=rem(dtoi(u), 24)
    u=s %and s="" %unless s->u.(" ").s
    %if '0'<=charno(u, 1)<='9' %thenstart
      ak_m=rem(dtoi(u), 60)
      u=s %and s="" %unless s->u.(" ").s
      %if '0'<=charno(u, 1)<='9' %thenstart
        ak_s=rem(dtoi(u), 60)
      %finish
    %finish
  %finish
  ak_s=1 %if ak_h=0 %and ak_m=0 %and ak_s=0
  %if s->("r").s %or charno(u, 1)='r' %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
  alarm=1
!  Compare new alarm time with current alarm time.
  put into store(a)
  %if alarm=0 %or (al_d=0=al_h %and al_m=0=al_s)  %thenstart
!  No active alarm times in use.
    al=a
  %finishelsestart
!  Some alarm time already active.
    i=precedence(a, al)
    %if i<0 %then al==a
  %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.
  d=0; 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, alwdth, old depth)
  %finish
!  Display.
  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 x=8; text y=y
    show str(s)
    y=y-font depth
  %finish
  old depth=d*(font height+font depth)
  %return %if d=0
  paint board(testcolour1, 8, y, alwdth, old depth)
  colour(testcolour2)
  p==alarm list_head
  %while p##nil %and y>200 %cycle
    y=y-fontheight
    x=digital alarm(p)
    text x=8; text y=y
    show str(x)
    p==p_next
    y=y-font depth
  %repeat
  display alarm
%end

%routine delete alarms(%string(255) s)
%integer j
%string(255) u
%record(alarmf)%name p, q

  font(0)
  u="" %unless s->(".d ").u
  %if u="all" %or u="*" %thenstart
    delete list(alarm list)
    alarm time=""
    clean boards
    reset alarm
    %return
  %finish
  alarm time=""
  p==alarm list_head
  %while p##nil %cycle
    display string("Delete? ", 8, 4*fontheight, alwdth, textcolour, blue, 0)
    u=digital alarm(p)
    display string(u, 8, 3*fontheight, alwdth, textcolour, 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
    q==p
    p==p_next
    %if j='y' %or j='Y' %thenstart
      excise cell(q, alarm list)
      dispose(q)
      list alarms("")
    %finish
    j=test symbol %until j=nl
  %repeat
  clean boards
  list alarms("")
  reset alarm
%end

%integerfn skip spaces
%integer j
  %cycle
    advance time
    j=test symbol
    %exit %if j>0
  %repeat
  %result=j
%end

%integerfn read word(%string(*)%name a)
%integer j
  %cycle
    advance time
    j=test symbol
    %if j>0 %thenstart
      show sym(j)
      %exit %if j=' ' %or j=nl
      a=a.tostring(j)
    %finish
  %repeat
  %result=j
%end

%routine set manual date
%integer j
%string(31) day, month, year
%string(80) y, z
  digital date->day.(" ").year
  year ->month.(" ").year
  z="Day Month Year: "
  text x=8; text y=cy-248
  display string(z, text x, text y, 180, background, textcolour, 0)
  advance time %and j=test symbol %until '0'<=j<='9' %or j=nl
  %if j#nl %thenstart
    y=tostring(j)
    colour(textcolour)
    text x=8+string width(z)
    show sym(j)
    read rest of line(y, z)
    purify(y)
    trim leading spaces(y)
    z=z.y
    text x=8
    display string(z, text x, text y, 180, background, textcolour, 0)
    digital date=y
    centre string(digital date, last date width, datey, datecolour)
    centre string(digital date, last date width, datey1, datecolour)
  %finish
  display alarm
%end

%routine set manual time
%integer j
%string(63) y, z
  z="Hr:Min:Sec  "
  text x=8; text y=cy-248
  display string(z, text x, text y, 180 , background, textcolour, 0)
  advance time %and j=test symbol %until '0'<=j<='9' %or j=nl
  %if j#nl %thenstart
    y=tostring(j)
    colour(textcolour)
    text x=8+string width(z)
    show sym(j)
    read rest of line(y, z)
    purify(y)
    trim leading spaces(y)
    z=z.y
    text x=8; text y=cy-248
    display string(z, text x, text y, 250, background, textcolour, 0)
    aj==al of(y)
    h=aj_h; m=aj_m; s=aj_s
    show time(h, m, s)
  %finish
  text x=8; text y=cy-248
  display alarm
%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

%integerfn col(%string(255) s)
  s->(" ").s %while charno(s, 1)=' '
  %if s="black" %then %result=black
  %if s="blue" %then %result=blue
  %if s="cyan" %then %result=cyan
  %if s="green" %then %result=green
  %if s="magenta" %then %result=magenta
  %if s="orange" %then %result=red+yellow
  %if s="red" %then %result=red
  %if s="white" %then %result=white
  %if s="yellow" %then %result=yellow %elsestart
    mssg(s." is not a colour")
    %result=white
  %finish
%end

%routine colour clock
  draw clock(256)
  draw clock(768)
%end

%integermap prt(%string(15) part)
  %if part->("back").part %then %result==background
  %if part->("fig").part %then %result==figscolour
  %if part="date" %then %result==datecolour
  %if part="face" %or part="dial" %then %result==facecolour
  %if part="time" %then %result==timecolour
  %if part="hour" %then %result==hourcolour
  %if part->("min").part %then %result==minutecolour
  %if part ->("sec").part %then %result==secscolour
  %if part="tick" %then %result==tickcolour
  mssg(part." is not known.")
  %result==nilpart
%end

%routine set colour(%string(255) s)
%record(pointfm) a
%integer i
%string(15) colr
%string(3) num
%integername p
%string(15) part
  s->(" ").s %while charno(s, 1)=' '
  part=s %and colr="black" %unless s->part.(" ").colr
  colr->(" ").colr %while charno(colr, 1)=' '
  %if part="hands" %thenstart
    hourcolour=col(colr)
    minutecolour=hourcolour
    secscolour=hourcolour
  %finishelsestart
    p==prt(part)
    p=col(colr)
  %finish
  %if part="figs" %thenstart
    colour(figscolour)
    font(dialfnt)
    %for i=0, 1, 11 %cycle
      a=da(i)_loc
      num=da(i)_num
      text at(a_x+cx, a_y+cy)
      show string(num)
      text at(a_x+cx, a_y+ccy)
      show string(num)
    %repeat
  %finishelse %c
  %if part="tick" %thenstart
    draw ticks(tick, tickcolour)
  %finishelse %c
  colour clock
%end

%routine reset(%string(31) s)
%integer da, ti
%string(31) u, v
  %if s->u.("date").v %then da=yes %else da=no
  %if s->u.("time").v %then ti=yes %else ti=no
  font(0)
!  Set date.
  %if da=yes %thenstart
    %if firstdate=yes %then set system date %and firstdate=no %c
    %else set manual date
  %finish
! Set time.
  %if ti=yes %thenstart
    %if firsttime=yes %then set system time %and firsttime=no %c
    %else set manual time
  %finish
%end

%routine initial settings(%string(31) s)
!  Read font and set-up space for digital date and time.
  read font("level1:Timesr8", dialfnt)
  read font("level1:Timesb7", fnt)
  setup clock
  font(fnt)
  datey=cy+3*font height; datey1=ccy-cy+datey
  timey=cy-3*font height; timey1=ccy-cy+timey
  ttt=0
  reset(s)
  mil=0
  ttt=cputime
  w1=string width("Alarm Time: ")
!  Initial setting of organisation for alarm.
  alarm=0; alarm time=""
  ak==new alarm; al==new alarm
  ring=0
  text x=8; text y=cy-248
  font(0)
  last date width=string width("56 56 56")
  last time width=string width("56 56 56")
  alwdth=string width(" + 56 56 56 R ")
  alarm list_head==nil; alarm list_tail==nil
!  Draw clock-face.
  clear
  offset(0, 0)
  draw clock(256)
  draw clock(768)
  text x=8; text y=cy-248
%end

%routine obey command(%string(255) s)
%integer i
%string(255) u
%real x, y

  lower(s)
  trim leading spaces(s)
  %if s=".a" %then clean boards %else %c
  %if s->(".c").u %then set colour(u) %else %c
  %if s->(".d").u %then delete alarms(s) %else %c
  %if s->(".h").u %then help %else %c
  %if s->(".l").u %then list alarms("") %else %c
  %if s->(".r").u %then reset(u) %else %c
  %if s->(".s").u %then %stop %else mssg(s." is not known.")
  text x=8; text y=cy-248+font height
  paint board(background, text x, text y, 180, font height+font depth)
  display alarm
%end

{Main Program}


  initial settings("date, time")
!  Cycle, displaying time and looking for alarm setting or a command.
  %cycle
    sym=test symbol
    advance time
    %if sym>0 %thenstart
      font(0)
!  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.
      text x=8; text y=cy-248
      paint board( %c
      background, text x, text y+font height, 180, font height+font depth)
      colour(textcolour)
      show str("Alarm Time: ")
      show string(alarm time) %and %continue %if sym=nl
      show sym(sym)
!  Read whole line.
      %if sym='h' %or sym='H'  %or sym='?'%then z=".h" %else z=tostring(sym)
      start="Alarm Time: "
      read rest of line(z, start)
      purify(z)
      trim leading spaces(z)
      text x=8; text y=cy-248
      %if z="" %then z=alarm time
      zz="Alarm Time: ".z
      text x=8
      display string(zz, text x, text y, 180, background, textcolour, 0)
      %if charno(z, 1)='?' %then help %else %c
      %if charno(z, 1)='.' %then obey command(z) %else %c
      %if '0'<=charno(z, 1)<='9' %or charno(z, 1)='+' %thenstart
        ak==al of(z)
        store alarm(ak)
        reset alarm
      %finish
    %finish
  %repeat

%end %of %program

