rem clock
rem copyright Marc Gale (Xalthorn) 2001

gosub initialise

gosub draw_clock

gosub read_time

repeat
  gosub flip_screen

  gosub draw_time

  buttons=peek("port1")

until (buttons=16384)

exit

label draw_clock
  f=pi/180
  for a=1 to 2
    gosub flip_screen
    clear window
    setrgb 1,100,100,100
    circle scx,scy,facesize

    for angle=6 to 360 step 6
      if mod(angle,30)=0 then
        setrgb 1,255,255,255
        tx=scx+((facesize+20)*cos((angle-90)*f))
        ty=scy+((facesize+20)*sin((angle-90)*f))
        text tx,ty,str$(angle/30)

        inner=0.8
      else
        inner=0.9
      fi

      setrgb 1,100,100,100

      xs=scx+((facesize*inner)*cos(angle*f))
      ys=scy+((facesize*inner)*sin(angle*f))
      xf=scx+(facesize*cos(angle*f))
      yf=scy+(facesize*sin(angle*f))
      line xs,ys to xf,yf
    next angle
  next a
return

label read_time
  dim cut$(1)
  t$=time$

  num=token(t$,cut$(),"-")

  h$=cut$(1)
  m$=cut$(2)
  s$=cut$(3)
return

label draw_time
  gosub undraw_hands
  gosub read_time

  setrgb 1,255,255,255
  text 320,380,h$+":"+m$+":"+s$

  seco=val(s$)
  rs=int(facesize*0.7)
  as=seco*6
  ws=0

  minu=val(m$)
  rm=int(facesize*0.6)
  am=(minu*6)+int(seco/10)
  wm=6

  hour=val(h$)
  if hour>12 then hour=hour-12 fi
  rh=int(facesize*0.4)
  ah=(hour*30)+int(minu/2)
  wh=8

  gosub draw_hands
return

label undraw_hands
  setrgb 1,0,0,0
  fill circle scx,scy,(facesize*0.8)
return

label draw_hands
  setrgb 1,0,150,0
  ang=ah
  r=rh
  w=wh
  gosub draw_hand

  setrgb 1,0,0,150
  ang=am
  r=rm
  w=wm
  gosub draw_hand

  setrgb 1,150,0,0
  ang=as
  r=rs
  w=ws
  gosub draw_hand
return

label draw_hand
  f=pi/180
  ang=ang-90
  xs=scx+((r*0.25)*cos((ang-180)*f))
  ys=scy+((r*0.25)*sin((ang-180)*f))
  xl=scx+(w*cos((ang-90)*f))
  yl=scy+(w*sin((ang-90)*f))
  xr=scx+(w*cos((ang+90)*f))
  yr=scy+(w*sin((ang+90)*f))
  xf=scx+(r*cos(ang*f))
  yf=scy+(r*sin(ang*f))

  if w=0 then
    line xs,ys to xf,yf
  else
    fill triangle xs,ys to xl,yl to xr,yr
    fill triangle xl,yl to xr,yr to xf,yf
  fi
return

label flip_screen
  setdispbuf d 
  d=1-d
  setdrawbuf d
return

label initialise
  sw=640
  sh=512
  scx=sw/2
  scy=sh/2
  facesize=int(scy/4)*3

  d=1

  poke "textalign","cc"
  open window sw,sh
  clear window
return