Razzle Dazzle

Keith Vetter 2019-04-24 : Razzle Dazzle is a carnival game with extremely poor odds for the player. Here's a youtube video showing a sucker losing a lot of money , and here's another one explaining why it's a scam .

The game consists of a playing board with numbered holes upon which eight marbles are tossed from a cup. The numbers of the holes the marbles land in are summed, and that sum is looked up on a score card to determine the outcomeof that roll. Some scores add points to the player's total, while others add an additional prize or double the betting amount.

The player bets $1 per roll and keeps going until he achieves 100 points--the player doesn't "lose" until he walks away.

Mathematically, the game is a scam: rolling eight marbles is equivalent to rolling eight dice resulting in a bell curve distribution. All the most likely outcomes are worthless, and only the most rare outcomes achieve points.

Furthermore, most razzle games also rely on a fast count by the game operator to trick the player into believing he has a better number total than he actually rolled. This is used to keep the player hooked into the game, increasing his point total periodically, causing him to invest more and more into the game. Increasingly the player believes that walking away would be a disaster: he only needs one or two more points. Unfortunately for the player, he never actually gets that last point.

razzle_dazzle_screen_small


Jeff Smith 2019-04-25 : Below is an online demo using CloudTk. Click on the Control Bar and select Fullscreen to view the whole game.

##+##########################################################################
#
# razzledazzle.tcl -- Simulation of the Razzle Dazzle carnival game
# by Keith Vetter 2019-04-22
#

package require Tk

set SCORE(score) 0
set SCORE(prizes) 1
set SCORE(cost) 1
set SCORE(cost,money) "\$1"
set SCORE(spent) 0
set SCORE(spent,money) "\$0"

set S(shuffle,rounds) 10
set S(shuffle,delay) 50

foreach font {titleFont scoreUFont scoreLFont boardFont goFont} { catch { font delete $font }}
font create titleFont {*}[font actual TkDefaultFont] -size 48 -weight bold
font create scoreUFont {*}[font actual TkDefaultFont] -size 36 -weight bold
font create scoreLFont {*}[font actual TkDefaultFont] -size 12 -weight bold
font create boardFont {*}[font actual TkDefaultFont] -size 24 -weight bold
font create goFont {*}[font actual TkDefaultFont] -size 36 -weight bold

set CLRS(score,num) red
set CLRS(score,prize) green

# https://i.imgur.com/MTeyAL5.jpg
set SCORECARD {
    {{29 "PAY DOUBLE"} . . . . . . {29 "PAY DOUBLE"}}
    {{18 PRIZE} {42 "20 PTS"} {38 PRIZE} {15 "15 PTS"} {19 PRIZE} {41 "15 PTS"} {37 PRIZE} {14 "20 PTS"}}
    {{9 "100 PTS"} {28 } {48 "100 PTS"} {26 } {8 "100 PTS"} {30 } {47 "100 PTS"} {27 }}
    {{32 } {44 "50 PTS"} {25 } {13 "50 PTS"} {31 } {43 "50 PTS"} {24 } {12 "50 PTS"}}
    {{46 "50 PTS"} {34 } {11 "30 PTS"} {23 } {45 "30 PTS"} {33 } {10 "50 PTS"} {22 }}
    {{36 PRIZE} {16 "10 PTS"} {21 PRIZE} {40 "5 PTS"} {35 PRIZE} {17 "5 PTS"} {20 PRIZE} {39 "5 PTS"}}
}

# https://proxy.duckduckgo.com/iu/?u=https://tse4.mm.bing.net/th?id=OIP.UKwwWr7PWLV4ES_7cJXaigHaGD&pid=Api&f=1

# board:
# http://www.goodmagic.com/websales/midway/photos/razzle2.jpg
# https://youtu.be/527F51qTcTg?t=242

set BOARD {
    {4 3 2 4 1 3 2 3 6 4 5 3 4}
    {3 4 5 3 6 4 5 4 1 3 2 4 5}
    {4 3 2 4 1 3 2 3 6 4 5 3 4}
    {3 4 5 3 6 4 5 4 1 3 2 4 2}
    {4 3 2 4 1 3 2 3 6 4 5 3 4}
    {3 4 5 3 6 4 5 4 1 3 2 4 2}
    {4 3 2 4 1 3 2 3 6 4 5 3 4}
    {3 4 5 3 6 4 5 4 1 3 2 4 5}
    {4 3 2 4 1 3 2 3 6 4 5 3 4}
    {3 4 5 3 6 4 5 4 1 3 2 4 5}
    {4 3 2 4 1 3 2 3 6 4 5 3 4}
}

proc DoDisplay {} {
    wm title . "Razzle Dazzle"

    frame .play
    pack .play -side left -expand 1 -fill both
    DrawPlay .play

    frame .s
    pack .s -side top -fill both -expand 1
    DrawScoreCard .s

    frame .b
    pack .b -side top -fill both
    DrawBoard .b

}
proc DrawPlay {f} {

    canvas $f.c -width 200 -height 200 -bd 0 -highlightthickness 0
    MakeBall $f.c
    grid $f.c -row 0 -column 0 -columnspan 2 -pady 1i
    $f.c bind all <1> StartRoll
    $f.c bind all <ButtonRelease-1> EndRoll

    set data {
        1 score "Score so far:" ::SCORE(score)
        2 prizes "Prizes you can win:" ::SCORE(prizes)
        3 cost "Cost per roll:" ::SCORE(cost,money)
        4 spent "Money spent so far:" ::SCORE(spent,money)
        5 roll "Roll value:" ::SCORE(sum)
    }
    foreach {row w text var} $data {
        label $f.$w -text $text -font boardFont
        label $f.$w,2 -textvariable $var -font boardFont -width 4
        grid $f.$w $f.$w,2 -row $row -sticky e
    }
    label $f.msg -textvariable ::SCORE(msg) -font boardFont -fg red
    grid $f.msg -row 6 -columnspan 2 -sticky ew


    ::ttk::button .about -text About -command About
    grid rowconfigure $f 7 -weight 1
    grid .about -in $f -row 8 -columnspan 2 -sticky s -pady .2i
    FlashingLights
}
proc DrawBoard {f} {
    global BOARD
    $f config -bd 5 -relief solid
    for {set row 0} {$row < [llength $BOARD]} {incr row} {
        set ROW [lindex $BOARD $row]
        for {set col 0} {$col < [llength $ROW]} {incr col} {
            set value [lindex $ROW $col]
            set w "$f.b$row,$col"
            label $w -text $value -bd 1 -font boardFont -relief solid
            grid $w -row $row -column $col -sticky news
        }
    }
    grid columnconfigure $f all -uniform a -weight 1
}
proc DrawScoreCard {f} {
    destroy {*}[winfo child $f]
    $f config -bd 5 -relief solid
    for {set row 0} {$row < [llength $::SCORECARD]} {incr row} {
        set ROW [lindex $::SCORECARD $row]
        for {set col 0} {$col < [llength $ROW]} {incr col} {
            lassign [lindex $ROW $col] num text
            if {$num eq "."} continue
            set w $f.s$num
            if {[winfo exists $w]} { set w $f.ss$num }
            _ScoreCardCell $w $num $text
            grid $w -row $row -column $col -sticky news
        }
    }
    label $f.s -text "RAZZLE DAZZLE" -font titleFont -bd 1 -relief solid
    grid $f.s -row 0 -column 1 -columnspan 6 -sticky news
    grid columnconfigure $f all -uniform a
}
proc LightColor {} {
    # Pick random RGB color, convert to HSV and check V > .7
    set light [expr {255 * .7}]                 ;# Value threshold
    while {1} {
        set r [expr {int (255 * rand())}]
        set g [expr {int (255 * rand())}]
        set b [expr {int (255 * rand())}]
        set v [expr {max($r, $g, $b)}]
        if {$v > $light} break
    }
    return [format "\#%02x%02x%02x" $r $g $b]
}

proc _ScoreCardCell {w num text} {
    set clr black
    if {[string match {[0-9]*} $text]} { set clr $::CLRS(score,num) }
    if {$text eq "PRIZE"} { set clr $::CLRS(score,prize) }
    frame $w -bd 1 -relief solid
    label $w,u -text $num -font scoreUFont -fg $clr
    label $w,l -text $text -font scoreLFont -fg $clr
    pack $w,u $w,l -side top -fill both -expand 1 -in $w
    return $w
}

proc HighlightNumber {num} {
    foreach w [winfo child .s] {
        $w config -bg white
    }
    set w .s.s$num
    if {! [winfo exists $w]} { return "" }
    $w,u config -bg lightgreen
    $w,l config -bg lightgreen
    if {$num == 29} {
        set w .s.ss$num
        $w,u config -bg lightgreen
        $w,l config -bg lightgreen
    }
    return [$w,l cget -text]
}

proc Shuffle {l} {
    set len [llength $l]
    while {$len} {
        set n [expr {int($len*rand())}]
        set tmp [lindex $l $n]
        lset l $n [lindex $l [incr len -1]]
        lset l $len $tmp
    }
    return $l
}
proc RollingMarbles {action} {
    global S

    if {$action eq "stop"} {set S(shuffle,stop) 1}
    if {$S(shuffle,stop)} return

    if {$action eq "start"} {
        set S(shuffle,cells) [Shuffle [winfo child .b]]
        foreach cell $S(shuffle,cells) { $cell config -bg white }
        set S(shuffle,active) [lrange $S(shuffle,cells) 0 6]
        foreach cell $S(shuffle,active) { $cell config -bg red }
        set S(shuffle,idx) 6
    }
    incr S(shuffle,idx)
    if {$S(shuffle,idx) >= [llength $S(shuffle,cells)] - 8} return

    set cell [lindex $S(shuffle,cells) $S(shuffle,idx)]
    $cell config -bg red
    lappend S(shuffle,active) $cell

    if {[llength $S(shuffle,active)] > 8} {
        set cell [lindex $S(shuffle,active) 0]
        set S(shuffle,active) [lrange $S(shuffle,active) 1 end]
        $cell config -bg white
    }
    set values [lmap cell $S(shuffle,active) { $cell cget -text }]
    set ::SCORE(sum) [tcl::mathop::+ {*}$values]
    FlashingLights
    update
    after $S(shuffle,delay) RollingMarbles continue
}
proc FlashingLights {} {
    set color [LightColor]
    foreach w [concat .play [winfo child .play]] {
        $w config -background $color
    }
}
proc StartRoll {} {
    global SCORE S

    .play.c itemconfig txt -text "Let Go!"
    incr SCORE(spent) $SCORE(cost)
    set SCORE(spent,money) "\$$SCORE(spent)"
    set SCORE(msg) ""

    set S(shuffle,stop) 0
    RollingMarbles start
}
proc EndRoll {} {
    global S SCORE
    .play.c itemconfig txt -text "Press\nMe!"
    set S(shuffle,stop) 1
    set values [lmap cell $S(shuffle,active) { $cell cget -text }]
    set SCORE(sum) [tcl::mathop::+ {*}$values]

    set reward [HighlightNumber $SCORE(sum)]

    set SCORE(msg) "Nothing!  Roll again"
    if {$reward eq ""} return
    if {$reward eq "PRIZE"} {
        incr SCORE(prizes)
        set SCORE(msg) "Bonus Prize!"
    } elseif {$reward eq "PAY DOUBLE"} {
        incr SCORE(prizes)
        incr SCORE(cost) $SCORE(cost)
        set SCORE(cost,money) "\$$SCORE(cost)"
        set SCORE(msg) "Bonus Prize!\nDouble cost"
    } elseif {[regexp {(\d+) PTS} $reward . pts]} {
        incr SCORE(score) $pts
        set SCORE(msg) $reward
        if {$SCORE(score) >= 100} {
            tk_messageBox -icon info -message "You Win!"
            set SCORE(msg) "You Win!"
            set SCORE(score) 0
            set SCORE(prizes) 1
            set SCORE(cost) 1
            set SCORE(cost,money) "\$1"
            set SCORE(spent) 0
            set SCORE(spent,money) "\$0"
        }
    }
}
proc GradientSteps {n c1 c2} {
    # Get RGB in 0 to 255 range
    foreach var {r1 g1 b1 r2 g2 b2} v [concat [winfo rgb . $c1] [winfo rgb . $c2]] {
        set $var [expr {$v * 255 / 65535}]
    }

    set grad {}
    for {set i 0} {$i <= $n} {incr i} {
        set r [expr {int($r1 + (($r2 - $r1) * $i / double($n)))}]
        set g [expr {int($g1 + (($g2 - $g1) * $i / double($n)))}]
        set b [expr {int($b1 + (($b2 - $b1) * $i / double($n)))}]
        lappend grad [format "#%.2X%.2X%.2X" $r $g $b]
    }
    return $grad
}
proc MakeBall {c} {
    set n 90

    set steps [GradientSteps $n \#ddd blue]
    set centre 100
    $c create oval 10 10 190 190 -tag o -outline black -width 10
    for {set i $n} {$i > 0} {incr i -1} {
        #set centre [expr $centre - 0.55]
        set centre [expr $centre - 0.45]
        set x1     [expr $centre - $i]
        set x2     [expr $centre + $i]
        set color [lindex $steps $i]
        $c create oval  $x1 $x1  $x2 $x2 -fill $color -outline $color
    }
    FitFont goFont 170 "Let Go!"
    $c create text 100 100 -tag txt -anchor c -justify c -fill black -font goFont
    $c itemconfig txt -text "Press\nMe!"
}
proc FitFont {myFont width txt} {
    for {set size 10} {$size < 100} {incr size} {
        font configure $myFont -size $size
        set w [font measure $myFont $txt]
        if {$w > $width} break
    }
    incr size -1
    font configure $myFont -size $size
    set ::SCORE(msg) "font size $size"
}

proc About {} {
    set title "Razzle Dazzle"
    set msg ""
    append msg "Keith Vetter   April, 2019"
    append msg "\n\n"
    append msg "Razzle Dazzle is a carnival game with extremely poor odds for the player."
    append msg "\n\n"
    append msg "The game consists of a playing board with numbered holes upon which "
    append msg "eight marbles are tossed from a cup. The numbers of the holes the marbles "
    append msg "land in are summed, and that sum is looked up on a score card to determine "
    append msg "the outcomeof that roll. Some scores add points to the player's total, while "
    append msg "others add an additional prize or double the betting amount."
    append msg "\n\n"
    append msg "The player bets \$1 per roll and keeps going until he achieves 100 points--"
    append msg "the player doesn't \"lose\" until he walks away."
    append msg "\n\n"
    append msg "Mathematically, the game is a scam: rolling eight marbles is equivalent to rolling "
    append msg "eight dice resulting in a bell curve distribution. All the most likely outcomes "
    append msg "are worthless, and only the most rare outcomes achieve points. "
    append msg "\n\n"
    append msg "Furthermore, most razzle games also rely on a fast count by the game operator "
    append msg "to trick the player into believing he has a better number total than he actually "
    append msg "rolled. This is used to keep the player hooked into the game, increasing his "
    append msg "point total periodically, causing him to invest more and more into the game. "
    append msg "Increasingly the player believes that walking away would be a disaster: he only "
    append msg "needs one or two more points. Unfortunately for the player, he never actually "
    append msg "gets that last point."
    tk_messageBox -icon info -message $title -detail $msg
}

################################################################

DoDisplay
return