##+##########################################################################
#
# Dice -- draws nice looking dice
# by Keith Vetter, Oct 20, 2006
#
# Three functions:
# ::Dice::DrawDie -- draws one die
# ::Dice::DrawStack -- draw many dice in stacks of four
# ::Dice::Size -- gets or sets the size of one edge of a die
#
namespace eval ::Dice {
variable S ;# Size information
variable D ;# Side color darkening
variable F ;# Face information
variable PIPS ;# Pip orientation
variable PPIP ;# Pip placement on face
array set S {sz 50 dx 15 dy 10 notch .2}
array set D {t 90 l 70 r 40 c4 80 c2 40 c6 100 c0 15} ;# Darkness factor
array set F {r {0,a 1,b 1,a 2,b 2,c 6,a 6,c 0,c}
t {6,a 2,c 2,a 3,b 3,a 4,b 4,c 6,b} l {0,c 6,c 6,b 4,c 4,a 5,b 5,a 0,b}
c0 {0,a 0,c 0,b} c2 {2,a 2,c 2,b} c4 {4,a 4,c 4,b} c6 {6,a 6,b 6,c}
R {0 1 2 6} T {6 2 3 4} L {0 6 4 5}}
array set PIPS {1 {2 3 5 4 2} 2 {1 4 6 3 1} 3 {1 2 6 5 1}
4 {1 5 6 2 1} 5 {1 3 6 4 1} 6 {2 4 5 3 2}}
array set PPIP {1 {1} 2 {0 2} 3 {0 1 2} 4 {0 2 3 4}
5 {0 1 2 3 4} 6 {0 2 3 4 5 6}}
}
##+##########################################################################
#
# ::Dice::DrawDie -- draws 1 die
# w -- canvas widget
# x,y -- canvas location
# pip -- number on top of the die
# clr -- color for the die
# shadow -- size of shadow (0 is no shadow)
# tag -- tag to apply to all pieces of the die
#
proc ::Dice::DrawDie {w x y pip clr shadow tag} {
variable S
variable F
variable D
variable PIPS
set l $S(sz) ;# Size of one edge
set dx [expr {$S(dx)*$l/hypot($S(dx),$S(dy))}] ;# Scale to cube size
set dy [expr {$S(dy)*$l/hypot($S(dx),$S(dy))}]
set V(r) [list $dx -$dy] ;# Edge vectors
set V(l) [list -$dx -$dy]
set V(u) [list 0 -$l]
set V(rr) [list $l 0]
# Compute all vertices (both actual corners and notches on the corner)
set P(0) [list $x $y] ;# Bottom middle vertex
set s1 $S(notch) ; set s2 [expr {1 - $s1}] ;# Corner notch
set vtx [list 1 0 r 1 2 1 u 1 3 2 l 1 5 0 l 1 4 5 u 1 6 0 u 1 \
0,a 0 r $s1 0,b 0 l $s1 0,c 0 u $s1 1,a 1 u $s1 1,b 0 r $s2 \
2,a 2 l $s1 2,b 1 u $s2 2,c 6 r $s2 3,a 4 r $s2 3,b 2 l $s2 \
4,a 5 u $s2 4,b 4 r $s1 4,c 6 l $s2 5,a 0 l $s2 5,b 5 u $s1 \
6,a 6 r $s1 6,b 6 l $s1 6,c 0 u $s2]
foreach {who from dir sc} $vtx {
set P($who) [::Dice::_VAdd $P($from) $V($dir) $sc]
}
# Compute all faces
foreach f [array names F] {
set XY($f) {}
foreach vtx $F($f) { set XY($f) [concat $XY($f) $P($vtx)]}
}
# Draw shadow if needed
if {$shadow > 0} {
set p0 $P(0,b)
set p1 [::Dice::_VAdd $p0 $V(rr) $shadow]
set p2 [::Dice::_VAdd $p1 $V(r)]
set p3 [::Dice::_VAdd $p2 $V(l)]
set p4 [::Dice::_VAdd $p3 $V(rr) -$shadow]
set xy [concat $p0 $p0 $p1 $p2 $p3 $p4]
.c create poly $xy -tag $tag -smooth 1
}
# Draw all the faces
foreach f {r t l c0 c2 c4 c6} {
set clr2 [::tk::Darken $clr $D($f)]
.c create poly $XY($f) -fill $clr2 -width 0 -outline $clr2 -tag $tag
}
# Draw pips on the three visible faces, pick random orientation
set n [expr {int(rand()*4)}]
set n 0
set pips [concat $pip [lrange $PIPS($pip) $n [expr {$n+1}]]]
foreach n $pips f {T L R} {
::Dice::_DrawPip $w $n $XY($f) $D([string tolower $f]) $tag
}
}
##+##########################################################################
#
# ::Dice::DrawStack -- draw many dice in stacks of 4
# w -- canvas widget
# x,y -- canvas location
# cnt -- how many dice in stack
# pip -- number on top of the die
# clr -- color of the die
# tag -- tag to apply to all pieces of the die
#
proc ::Dice::DrawStack {w x y cnt pip clr tag} {
variable S
set dy [expr {int(round($S(sz) * -1.1))}]
set dx2 [expr {int(round($S(sz) * 1.1))}] ;# Multiple stack offset
set dy2 [expr {int(round($S(sz) * .6))}]
set numCols [expr {($cnt+3) / 4}]
set x [expr {$x - ($numCols-1)*$dx2}]
set y [expr {$y - ($numCols-1)*$dy2}]
while {$cnt > 0} { ;# Multiple columns
set n [expr {$cnt > 4 ? ($cnt % 4) : $cnt}]
if {$n == 0} {set n 4}
incr cnt -$n
set yy $y
for {set i 0} {$i < $n} {incr i} {
set shadow [expr {($i == 0 && $cnt == 0) ? (1 + ($n-1)*.3) : 0}]
::Dice::DrawDie $w $x $yy $pip $clr $shadow $tag
incr yy $dy
}
incr x $dx2
incr y $dy2
}
}
##+##########################################################################
#
# ::Dice::Size -- gets or sets the size of one edge of a die
#
proc ::Dice::Size {args} {
if {[llength $args] > 1} {
error "wrong \# args: should be \"::Dice::Size ?newValue?\""
}
if {[llength $args] == 1} {
set value [lindex $args 0]
if {! [string is double -strict $value]} {
error "expected number but got \"$value\""
}
set ::Dice::S(sz) $value
}
return $::Dice::S(sz)
}
##+##########################################################################
#
# ::Dice::_DrawPip -- draws pips on a one face
#
proc ::Dice::_DrawPip {w num xy perc tag} {
variable PPIP
set clr [::tk::Darken white $perc]
foreach {x0 y0 x1 y1 x2 y2 x3 y3} $xy break
set D1 [::Dice::_VAdd [list $x2 $y2] [list $x0 $y0] -1]
set D2 [::Dice::_VAdd [list $x3 $y3] [list $x1 $y1] -1]
set V(0) [::Dice::_VAdd [list $x0 $y0] $D1 .25]
set V(1) [::Dice::_VAdd [list $x0 $y0] $D1 .5]
set V(2) [::Dice::_VAdd [list $x0 $y0] $D1 .75]
set V(3) [::Dice::_VAdd [list $x1 $y1] $D2 .25]
set V(4) [::Dice::_VAdd [list $x1 $y1] $D2 .75]
set D3 [::Dice::_VAdd $V(2) $V(4) -1]
set V(5) [::Dice::_VAdd $V(4) $D3 .5]
set V(6) [::Dice::_VAdd $V(0) $D3 .5]
set sc [expr {$num == 1 ? .2 : .1}] ;# Single pip is bigger
foreach v $PPIP($num) {
set xy [::Dice::_MakeRhombus $V($v) $D1 $D2 $sc]
$w create poly $xy -fill $clr -tag $tag -smooth 1
}
}
##+##########################################################################
#
# ::Dice::_MakeRhombus -- returns 4 corners of a rhombus at PP given
# two diagonals vectors with a scaling factor.
#
proc ::Dice::_MakeRhombus {PP D1 D2 sc} {
set p [::Dice::_VAdd $PP $D1 $sc]
set q [::Dice::_VAdd $PP $D2 $sc]
set r [::Dice::_VAdd $PP $D1 -$sc]
set s [::Dice::_VAdd $PP $D2 -$sc]
set xy [concat $p $q $r $s]
return $xy
}
##+##########################################################################
#
# ::Dice::_VAdd -- adds two vectors, possibly scaling the second one
#
proc ::Dice::_VAdd {P V {sc 1}} {
foreach {x y} $P {dx dy} $V break
return [list [expr {$x+$sc*$dx}] [expr {$y+$sc*$dy}]]
}
################################################################
#
# DEMO
#
package require Tk
if {! [catch {package require tile}]} {
interp alias {} scale {} ::ttk::scale
}
proc Demo {{newSize ""}} {
if {$newSize ne ""} {::Dice::Size $newSize}
.c delete all
RowOfDiceTest 125 0
RowOfDiceTest 250 1
StackedDiceTest 550
}
proc RowOfDiceTest {y shadows} {
set x 50
set pips 0
foreach clr $::colors {
if {[incr pips] > 6} {set pips 1}
::Dice::DrawDie .c $x $y $pips $clr $shadows a
incr x 150
}
}
proc StackedDiceTest {y} {
for {set i 1} {$i <= 8} {incr i} {
set xx [expr {50 + ($i-1)*150}]
set clr [lindex $::colors [expr {$i-1}]]
set pip [expr {1+($i%6)}]
::Dice::DrawStack .c $xx $y $i $pip $clr x
}
}
################################################################
wm title . "Drawing Dice"
set colors {red yellow green cyan blue deeppink orange \#00FA9A}
canvas .c -width 1250 -height 600 -bd 2 -highlightthickness 0 -relief ridge
pack .c -fill both -expand 1 -side top
scale .sc -from 10 -to 50 -command Demo -orient h
.sc set $::Dice::S(sz)
pack .sc -side bottom -pady 10 -before .c
Demo
returnKeith Vetter 2006-10-21 : For grins, I'm writing a multiple-player version of Dice Wars [1], and for that I needed some nice looking dice. I initially grabbed some clipart off the web, but that approach doesn't scale well.So instead I went and wrote this package to draw dice using canvas commands. I went to a bit of effort to make them look nice: each die face has a different shading, the corners are notched, you can have a shadow drawn, etc. and you can control the size.Two main functions are exposed: ::Dice::DrawDie which draws a single die, and ::Dice::DrawStack which draws many dice in stacks of four.As usual, I've included a demo.
gold added pix
Page contents
Getting started
Home • Recent changes • Help • Create new page • Search • Add comments
• Edit