Version 1 of iKnow: a pocket quiz

if 0 {Richard Suchenwirth 2003-05-15 - As yet another Tcltoy (runnable on a PocketPC of course), here is a quiz vaguely inspired by popular TV shows. You get a question and four possible answers, one of which is right. Click on the right one to improve your statistics as displayed at top.

Besides the fun and the cool name, what interested me in this is again the creation of a little language which doesn't look like Tcl, but much more natural. The iKnow package creates two public commands:

Questions: without arguments (looks like headline, but creates the UI)
- q? ar? af? af? af?

The - command adds a question to the database, with the right answer first and then three wrong ones, and uses question marks as separators between arguments, so the specification of questions looks very natural - see examples below. (Of course for practical usability, one would have to collect hundreds or thousands of questions...) }

 namespace eval iKnow {
        variable version 1.0 tries 0 right 0
 }
 proc Questions: {} {
    frame .f
    label .f.s -textvar stats -width 35
    button .f.x -text X -command exit
    eval pack [winfo chil .f] -side left
    label .q -textvar q -height 4 -bg white
    frame .a
    foreach i {0 1 2 3} {
       button .a.$i -textvar $i -width 18 \
          -command [list iKnow::judge .a.$i]
    }
    grid .a.0 .a.1 -sticky news
    grid .a.2 .a.3 -sticky news
    eval pack [winfo children .] -fill x
    after idle iKnow::ask
    if {$::tcl_platform(os)=="Windows CE"} {wm geometry . +0+0}
 }
 proc - args {
    lappend iKnow::questions [split $args ?]
 }
 proc iKnow::ask {} {
    variable questions; variable correct
    if ![llength $questions] {
       set ::q "GAME OVER"; return
    }
    set question [ldraw questions]
    set ::q [lindex $question 0]?
    set correct1 [lindex $question 1]
    set ans [lrange $question 1 4]
    foreach i {0 1 2 3} {
       set ::$i [ldraw ans]
       if {[set ::$i]==$correct1} {set correct $i}
    }
 }
 proc iKnow::judge w {
    variable tries; variable right
    variable correct
    incr tries
    set number [string index $w end]
    set bg [$w cget -bg]
    if {$number==$correct} {
       incr right
       $w config -bg green
    } else {
       $w config -bg red
       set w2 [string range $w 0 end-1]$correct
       $w2 config -bg green
       after 1000 $w2 config -bg $bg
    }
    after 500 $w config -bg $bg
    set perc [expr {$tries? 100*$right/$tries: "--"}]
    set ::stats "$right / $tries = $perc %"
    after 1000 iKnow::ask
 }  
 proc ldraw varName {
    upvar 1 $varName var
    set pos [expr int(rand()*[llength $var])]
    set res [lindex $var $pos]
    set var [lreplace $var $pos $pos]
    set res
 }
 package provide iKnow $iKnow::version

#-- self-test and demo (data files would look like this):

 if {[info exists argv0] && [file tail $argv0]==[file tail [info script]]} {
 package require iKnow
 Questions:
 - Capital of Switzerland? Bern? Zurich? Basel? Geneva?
 - Who created the Tcl language? John Ousterhout? Larry Wall?\
     Guido van Rossum? Brent Welch?
 - National currency in Turkey? Lira? Pound? Peso? Dinar?
 - French 'canard' means? duck? dog? channel? ocean liner?
 - When did the 30-years War end? 1648? 1789? 1618? 1918?
 }