##+##########################################################################
#
# Jeopardy
# by Keith Vetter 2019-11-06
# Uses the JService API to Jeopardy clues database
# See http://jservice.io/
#

package require json
package require http
package require textutil
package require Tk

font create titleFont -family Helvetica -size 24 -weight bold
font create moneyFont -family Helvetica -size 36 -weight bold
font create questionFont -family Helvetica -size 24 -weight bold

set S(wrap,length) 10
set S(color,border) aquamarine
set S(color,board) blue
set S(color,money) yellow
set S(color,title) white
set S(color,question,border) aquamarine
set S(color,question,bg) gainsboro
set S(color,question,fg) black

set SPINNERS {
    {boxBounce 120 { ▖ ▘ ▝ ▗ }}
    {line 130 { - \\ | / }}
    {dots 80 { ⠋ ⠙ ⠹ ⠸ ⠼ ⠴ ⠦ ⠧ ⠇ ⠏ }}
    {pipe 100 { ┤ ┘ ┴ └ ├ ┌ ┬ ┐ }}
}
set SPINNER [lindex $SPINNERS 0]


proc DoDisplay {} {
    global J

    wm title . "Jeopardy"

    set padding ".05i"
    . config -bg $::S(color,border) -padx $padding -pady $padding
    pack [frame .f -bg black -padx $padding -pady $padding] -fill both -expand 1
    for {set col 0} {$col < 6} {incr col} {
        set J(title,$col) "Title $col"
        label .title_$col -textvariable J(title,$col) -font titleFont -fg $::S(color,title) \
            -bg $::S(color,board)
        grid .title_$col -row 0 -column $col -padx $padding -pady $padding -pady $padding \
            -ipadx .2i -ipady .3i -sticky news -in .f
    }
    for {set row 1} {$row < 6} {incr row} {
        for {set col 0} {$col < 6} {incr col} {
            set w .clue_${row}_${col}
            set J(clue,$row,$col) "$[expr {$row * 100}]"
            label $w -textvariable J(clue,$row,$col) -font moneyFont -fg $::S(color,money) \
                -bg $::S(color,board)
            grid $w -row $row -column $col -sticky news -padx $padding -pady $padding \
                -ipadx .2i -ipady .3i -sticky news -in .f
            bind $w <1> [list ClickQuestion $w $row $col]
        }
    }
    grid columnconfig .f all -uniform a

    ::ttk::button .new -text New -command {NewGame new}
    ::ttk::button .reset -text Reset -command {NewGame reset}
    pack .reset .new -side right -pady .1i -padx .1i
}
proc NewGame {how} {
    global questions
    destroy .q
    if {$how ne "reset"} {
        Spinner start
        set questions [::JServiceAPI::GetAllQuestions 6]
        destroy .q
    }
    FillInBoard $questions
}

proc FillInBoard {questions} {
    global J
    set J(questions) $questions

    for {set col 0} {$col < 6} {incr col} {
        set title [dict get [lindex $questions $col] title]
        set title [::textutil::adjust $title -length $::S(wrap,length)]

        # TODO:
        #   make sure at most 2 lines ?
        #   adjust font to fit better

        set J(title,$col) [string toupper $title]
    }
    for {set row 1} {$row < 6} {incr row} {
        for {set col 0} {$col < 6} {incr col} {
            set w .clue_${row}_${col}
            set J(clue,$row,$col) "$[expr {$row * 100}]"
            $w config -font moneyFont -fg $::S(color,money)
        }
    }
}

proc ClickQuestion {w row col} {
    global J

    destroy .q
    if {$J(clue,$row,$col) eq ""} return
    set J(clue,$row,$col) ""
    set category [lindex $J(questions) $col]
    set offset [dict get $category offset]
    set clue [lindex [dict get $category clues] [expr {$offset+$row-1}]]
    set question [dict get $clue question]
    set answer [dict get $clue answer]

    ShowQuestion $question $answer
}
proc ShowQuestion {question answer} {
    global J

    if {$question ne "%answer%"} {
        set text $question
        set btext "Answer"
        set cmd [list ShowQuestion "%answer%" $answer]
    } else {
        set text [CleanupAnswer $answer]
        set btext "Close"
        set cmd [list destroy .q]
    }

    set wrap 20
    while {1} {
        set text [::textutil::adjust $text -length $wrap]
        set lcount [regsub -all {\n} $text {\n} .]
        if {$lcount < 5} break
        incr wrap 10
        if {$wrap > 80} break
    }

    destroy .q
    frame .q -bg $::S(color,question,border) -bd 0 -padx .1i -pady .1i
    pack [frame .q.q -bg $::S(color,question,bg) -bd 10 -relief solid -padx .5i -pady .5i] -fill both -expand 1

    label .q.q.question -text $text -font questionFont -fg $::S(color,question,fg) -bg $::S(color,question,bg)
    button .q.q.answer -text $btext -command $cmd -font questionFont -padx .2i
    pack .q.q.question -side top
    pack .q.q.answer -side bottom -padx .2i -pady {.2i 0}

    place .q -in . -relx .5 -rely .3 -anchor n
}
proc CleanupAnswer {txt} {
    set txt [regsub -all {</?.>} $txt ""]
    set txt [regsub -all {\\'} $txt ']
    return $txt
}
proc _Loading {} {
    destroy .q
    frame .q -bg $::S(color,question,border) -bd 0 -padx .1i -pady .1i
    pack [frame .q.q -bg $::S(color,question,bg) -bd 10 -relief solid -padx .5i -pady .5i] -fill both -expand 1

    label .q.q.question -text "Loading_" -font moneyFont -fg $::S(color,question,fg) -bg $::S(color,question,bg) -width 8
    pack .q.q.question -side top
    place .q -in . -relx .5 -rely .3 -anchor n
    return .q.q.question
}

proc Spinner {{start ""}} {
    global SPINNERS SPINNER

    if {$start ne ""} {
        set widget [_Loading]
        lassign [lindex $SPINNERS [expr {int(rand() * [llength $SPINNERS])}]] . freq chars
        set SPINNER [list 0 $freq $chars $widget]
    }

    lassign $SPINNER idx freq chars widget

    if {! [winfo exists $widget]} return

    set idx [expr {($idx + 1) % [llength $chars]}]
    set newChar [lindex $chars $idx]
    set oldText [$widget cget -text]
    $widget config -text [string replace $oldText end end $newChar]

    set SPINNER [list $idx $freq $chars $widget]
    set aid [after $freq Spinner]
}

proc DumpQuestions {{col -}} {
    global J

    set lo 0
    set hi end
    if {$col ne "-"} { set lo $col ; set hi $col }
    foreach category [lrange $J(questions) $lo $hi] {
        set title [dict get $category title]
        puts "\n$title\n[string repeat = [string length $title]]"
        set offset [dict get $category offset]
        set clues [dict get $category clues]

        foreach clue [lrange $clues $offset $offset+4] {
            set question [dict get $clue question]
            set answer [dict get $clue answer]
            puts "  Q: $question"
            puts "  A:                  $answer"
        }
    }
}


namespace eval ::JServiceAPI {
    variable MAX_CATEGORY 18414   ;# As of 2019-10-28
    variable URL_JSERVICE http://jservice.io/api/
}

proc ::JServiceAPI::GetAllQuestions {{how_many 6}} {
    variable MAX_CATEGORY
    set results {}
    for {set i 0} {$i < $how_many} {incr i} {
        set id [expr {int(rand() * $MAX_CATEGORY)}]
        set jdata [::JServiceAPI::JServiceAPI category id=$id]

        set count [dict get $jdata clues_count]
        set offset [expr {5 * int(rand() * ($count / 5))}]
        dict set jdata offset $offset
        lappend result $jdata
    }
    return $result
}

proc ::JServiceAPI::JServiceAPI {service args} {
    variable URL_JSERVICE
    variable url

    set url "${URL_JSERVICE}$service"
    if {$args ne ""} {
        append url "?$args"
    }
    set token [::http::geturl $url]
    set ncode [::http::ncode $token]
    set code [::http::code $token]
    set data [::http::data $token] ; list
    ::http::cleanup $token

    if {$ncode != 200} { error "bad response from server: $code" }
    set jdata [::json::json2dict $data]
    return $jdata
}

DoDisplay
NewGame new