NetNews Usenet Archive 1992 #31/NN_1992_31.iso/spool/comp/lang/tcl/2186

Internet Message Format | 1992-12-21 | 9.9 KB

Path: sparky!uunet!cs.utexas.edu!news-is-not-mail
From: [e-mail] (Charles Read)
Newsgroups: comp.lang.tcl
Subject: two more clocks
Date: 21 Dec 1992 11:24:18 -0600
Organization: CS Dept, University of Texas at Austin
Lines: 395
Message-ID: <[e-mail]>
NNTP-Posting-Host: im4u.cs.utexas.edu
Keywords: Tk2.3, tclX6.4, clock

Here are a couple more clocks.
They are poorly sync'ed
with the actual time, but still neat.

-------------------------------first clock-----------------------------------
#!/usr/local/bin/wish -f
#
# c. read, 11-20-92
#
# Usage: clock [-width <number>] [-height <number>] \
#              [-second <color>] [-minute <color>] [-hour <color>]
#
# Required: tk2.3, tclX6.4

# useful global variables
set width 150.0
set height 150.0
set secondCol yellow
set minuteCol green
set hourCol white
set backGround ""

# Make arcs for second, minute, and hour hands.
proc layoutClock {c cwidth cheight} {
  global backGround

  canvas $c.bg -width $cwidth -height $cheight -relief raised
  bind $c.bg <Double-1> exit
  bind $c.bg <q> exit

  # Get background of canvas.
  set backGround [lindex [$c.bg configure -bg] 4]

  # layout stuff
  pack append $c $c.bg {expand fill}

  # make arc items for hours.
  set szX [expr {.98 * $cwidth}]
  set szY [expr {.98 * $cheight}]

  set startX [expr {.01 * $cwidth}]
  set startY [expr {.01 * $cheight}]
  set extentX [expr {$startX + $szX}]
  set extentY [expr {$startY + $szY}]
  for {set i 1} {$i <= 12} {incr i} {
    set startDeg [expr {90 - 30 * $i}]
    $c.bg create arc $startX $startY $extentX $extentY -start $startDeg \
      -extent 30 -fill $backGround -tags hour_$i -outline ""
  }

  # bounding box of minute arcs
  set szX [expr {.62 * $cwidth}]
  set szY [expr {.62 * $cheight}]
  set startMinX [expr {.19 * $cwidth}]
  set startMinY [expr {.19 * $cheight}]
  set extentMinX [expr {$startMinX + $szX}]
  set extentMinY [expr {$startMinY + $szY}]

  # bounding box of second arcs
  set szX [expr {.32 * $cwidth}]
  set szY [expr {.32 * $cheight}]
  set startSecX [expr {.34 * $cwidth}]
  set startSecY [expr {.34 * $cheight}]
  set extentSecX [expr {$startSecX + $szX}]
  set extentSecY [expr {$startSecY + $szY}]

  for {set i 1} {$i <= 60} {incr i} {
    set startDeg [expr {90 - 6 * $i}]
    $c.bg create arc $startMinX $startMinY $extentMinX \
      $extentMinY -start $startDeg -extent 6 -fill $backGround \
      -tags minute_$i -outline ""
    $c.bg create arc $startSecX $startSecY $extentSecX \
      $extentSecY -start $startDeg -extent 6 -fill $backGround \
      -tags second_$i -outline ""
  }
}

proc startTicking {c} {
  global secondCol minuteCol hourCol

  # initialize hour, minute, and second hands.
  set rightNow [fmtclock [getclock] {%I %M %S}]
  set hourHand [expr {[concat "1[lvarpop rightNow 0]"] - 100}]
  set minuteHand [expr {[concat "1[lvarpop rightNow 0]"] - 100}]
  set secondHand [expr {[concat "1[lvarpop rightNow 0]"] - 100}]
  for {set i 1} {$i <= $hourHand} {incr i} {
    $c.bg itemconfigure hour_$i -fill $hourCol
  }
  for {set i 1} {$i <= $minuteHand} {incr i} {
    $c.bg itemconfigure minute_$i -fill $minuteCol
  }
  for {set i 1} {$i <= $secondHand} {incr i} {
    $c.bg itemconfigure second_$i -fill $secondCol
  }
  update

  # start the ticking.
  while {1} {
    sleep 1
    incr secondHand
    if {$secondHand == 61} then {
      set secondHand 1
      restartSecondClock $c
    }
    $c.bg itemconfigure second_$secondHand -fill $secondCol
    if {$secondHand == 60} then {
      incr minuteHand
      if {$minuteHand == 61} then {
    set minuteHand 1
    restartMinuteClock $c
      }
      $c.bg itemconfigure minute_$minuteHand -fill $minuteCol
      if {$minuteHand == 60} then {
    incr hourHand
    if {$hourHand == 13} then {
      set hourHand 1
      restartHourClock $c
    }
    $c.bg itemconfigure hour_$hourHand -fill $hourCol
      }
     }
    update
  }
}

proc restartSecondClock {c} {
  global backGround
  for {set i 1} {$i <= 60} {incr i} {
    $c.bg itemconfigure second_$i -fill $backGround
  }
}

proc restartMinuteClock {c} {
  global backGround
  for {set i 1} {$i <= 60} {incr i} {
    $c.bg itemconfigure minute_$i -fill $backGround
  }
}

proc restartHourClock {c} {
  global backGround
  for {set i 1} {$i <= 12} {incr i} {
    $c.bg itemconfigure hour_$i -fill $backGround
  }
}

proc parseArgs {argc argv} {
  global width height secondCol minuteCol hourCol
  while {[llength $argv] > 0} {
    set arg [lvarpop argv 0]
    case $arg {
      -width {
    set width [lvarpop argv 0]
      }
      -height {
    set height [lvarpop argv 0]
      }
      -second {
    set secondCol [lvarpop argv 0]
      }
      -minute {
    set minuteCol [lvarpop argv 0]
      }
      -hour {
    set hourCol [lvarpop argv 0]
      }
    }
  }
}

parseArgs $argc $argv

wm withdraw .
toplevel .clock
wm title .clock "a clock for mae"
layoutClock .clock $width $height

# exit on interrupts.
signal trap SIGINT exit

startTicking .clock

-------------------------------second clock-------------------------
#!/usr/local/bin/wish -f
#
# c. read, 11-20-92
#
# henke's world.
#
# Usage: clock [-width <number>] [-height <number>] \
#              [-second <color>] [-minute <color>] [-hour <color>]
#
# Required: tk2.3, tclX6.4

# radii of circles
set secondRad ""
set minuteRad ""
set hourRad ""

# position of hour and minute circles.
set hourX ""
set hourY ""
set minuteX ""
set minuteY ""

# color of circles
set secondCol yellow
set minuteCol green
set hourCol white

# useful globals
set width 150.0
set height 150.0
set pi 3.1415926

# Make hour oval; compute radius of minor axis.
proc initLayout {c cwidth cheight} {
  global secondRad minuteRad hourRad

  canvas $c.bg -width $cwidth -height $cheight -relief raised
  bind $c.bg <Double-1> exit
  bind $c.bg <q> exit

  # set radii
  if {$cwidth <= $cheight} then {
    set hourRad [expr {$cwidth / 4.0}]
  } else {
    set hourRad [$cheight {$cheight / 4.0}]
  }
  set minuteRad [expr {$hourRad / 4.0}]
  set secondRad [expr {$minuteRad / 4.0}]

  # layout canvas
  pack append $c $c.bg {expand fill}

  # make hour oval
  $c.bg create oval 0 0 $cwidth $cheight
}

proc startRolling {c} {
  global pi width height
  global hourX hourY minuteX minuteY

  # center of canvas
  set cx [expr {$width / 2.0}]
  set cy [expr {$height / 2.0}]

  # current time
  set rightNow [fmtclock [getclock] {%I %M %S}]
  set hourHand [expr {[concat "1[lvarpop rightNow 0]"] - 100}]
  set minuteHand [expr {[concat "1[lvarpop rightNow 0]"] - 100}]
  set secondHand [expr {[concat "1[lvarpop rightNow 0]"] - 100}]

  # initial time
  moveToHour $c $cx $cy $hourHand
  moveToMinute $c $minuteHand
  moveToSecond $c $secondHand
  update

  while {1} {
    sleep 1
    incr secondHand
    if {$secondHand == 60} then {
      set secondHand 0
      incr minuteHand
      if {$minuteHand == 60} then {
    set minuteHand 0
    incr hourHand
    if {$hourHand == 13} then {
      set hourHand 1
    }
    $c.bg delete hour
    moveToHour $c $cx $cy $hourHand
      }
      $c.bg delete minute
      moveToMinute $c $minuteHand
    }
    $c.bg delete second
    moveToSecond $c $secondHand
    update
  }
}

proc moveToHour {c cx cy hourHand} {
  global pi hourRad hourX hourY hourCol

  # angle of hour hand.
  set angle [expr {$pi/2.0 - $hourHand * $pi/6}]

  # center of hour circle.
  set hourY [expr {[sin $angle] * ($cy - $hourRad)}]
  set hourX [expr {[cos $angle] * ($cx - $hourRad)}]

  # translate into canvas coordinate-system.
  set hourY [expr {$cy - $hourY}]
  set hourX [expr {$cx + $hourX}]

  # make bbox for hour circle.
  set topleftX [expr {$hourX - $hourRad}]
  set topleftY [expr {$hourY - $hourRad}]
  set botrightX [expr {$hourX + $hourRad}]
  set botrightY [expr {$hourY + $hourRad}]

  # create the hour circle
  $c.bg create oval $topleftX $topleftY $botrightX $botrightY \
    -fill $hourCol -tags hour
}

proc moveToMinute {c minuteHand} {
  global pi hourRad minuteRad minuteCol
  global minuteX minuteY hourX hourY

  # angle of minute hand.
  set angle [expr {$pi/2.0 - $minuteHand * $pi/30}]

  # center of minute circle.
  set minuteY [expr {[sin $angle] * ($hourRad - $minuteRad)}]
  set minuteX [expr {[cos $angle] * ($hourRad - $minuteRad)}]

  # translate into hour circle
  set minuteY [expr {$hourY - $minuteY}]
  set minuteX [expr {$hourX + $minuteX}]

  # make bbox for minute circle.
  set topleftX [expr {$minuteX - $minuteRad}]
  set topleftY [expr {$minuteY - $minuteRad}]
  set botrightX [expr {$minuteX + $minuteRad}]
  set botrightY [expr {$minuteY + $minuteRad}]

  #create the minute circle.
  $c.bg create oval $topleftX $topleftY $botrightX $botrightY \
    -fill $minuteCol -tags minute
}

proc moveToSecond {c secondHand} {
  global pi minuteRad secondRad minuteX minuteY secondCol

  # angle of second hand.
  set angle [expr {$pi/2.0 - $secondHand * $pi/30}]

  # center of second circle.
  set secondY [expr {[sin $angle] * ($minuteRad - $secondRad)}]
  set secondX [expr {[cos $angle] * ($minuteRad - $secondRad)}]

  # translate into minute circle
  set secondY [expr {$minuteY - $secondY}]
  set secondX [expr {$minuteX + $secondX}]

  # make bbox for second circle.
  set topleftX [expr {$secondX - $secondRad}]
  set topleftY [expr {$secondY - $secondRad}]
  set botrightX [expr {$secondX + $secondRad}]
  set botrightY [expr {$secondY + $secondRad}]

  #create the second circle.
  $c.bg create oval $topleftX $topleftY $botrightX $botrightY \
    -fill $secondCol -tags second
}

# FIXME -- should allow relative lengths of radii of circles
# to be settable.
proc parseArgs {argc argv} {
  global width height secondCol minuteCol hourCol
  while {[llength $argv] > 0} {
    set arg [lvarpop argv 0]
    case $arg {
      -width {
    set width [lvarpop argv 0]
      }
      -height {
    set height [lvarpop argv 0]
      }
      -second {
    set secondCol [lvarpop argv 0]
      }
      -minute {
    set minuteCol [lvarpop argv 0]
      }
      -hour {
    set hourCol [lvarpop argv 0]
      }
    }
  }
}

parseArgs $argc $argv

wm withdraw .
toplevel .clock
initLayout .clock $width $height

# exit on interrupts
signal trap SIGINT exit

startRolling .clock