[Keith Vetter] 2006-10-21 : For grins, I'm writing a multiple-player version of Dice Wars [http://www.gamedesign.jp/flash/dice/dice.html], 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. ---- [Jeff Smith]Below is an online demo using [CloudTk] <> <> ---- ====== ##+########################################################################## # # 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 return ====== ---- **Screenshots Section** [Dice screen.png] [gold] added pix <> Games | Toys