## Dice

Keith Vetter 2006-10-21 : For grins, I'm writing a multiple-player version of Dice Wars [L1 ], 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 2019-04-28 : 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
#    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)]}
}

set p0 \$P(0,b)
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
}
##+##########################################################################
#
#
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
}

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```