package require http

global region
# あなたの地域を設定してください。
set region hirosima
###################
global browser
# あなたのWWWブラウザを設定してください。
set browser "D:\\Program Files\\Internet Explorer\\IEXPLORE.EXE"
################################################################
proc ShowChoices { parent varname choices procedure args } {
    set f [frame $parent.$choices -borderwidth 5]
    set b 0
    foreach item $args {
        radiobutton $f.$b -variable $varname \
            -text $item -value $item \
            -command $procedure
        pack $f.$b -side left
        incr b
    }
    pack $f -side top
}
global url
set url ""
wm title . "Get! TVGuide"
global day whatday
ShowChoices {} day choices0 SetWhatday \
昨日 今日 明日 明後日 明々後日 4日後 5日後
global time
ShowChoices {} time choices1 SetDate 4時 7時 10時 13時 16時 19時 21時 23時 1時
global mode
ShowChoices {} mode choices2 SetUrl 内容 Gコード
frame .entry
label .entry.l -text "Current URL:" -padx 0
entry .entry.e -width 20 -relief sunken \
    -textvariable url
pack .entry.l -side left
pack .entry.e -side left -fill x -expand true
pack .entry -side top -fill both -expand true
frame .t
set log [text .t.log -width 80 -height 10 \
    -borderwidth 2 -relief raised -setgrid true \
    -yscrollcommand {.t.scroll set}]
scrollbar .t.scroll -command {.t.log yview}
pack .t.scroll -side right -fill y
pack .t.log -side left -fill both -expand true
pack .t -side top -fill both -expand true

proc SetUrl {} {
    global region browser mode date url
    set url "http://www.tvguide.or.jp/$region/"
    if { $mode == "内容" } {
        append url "table/" $date "tb.htm"
        catch {exec $browser $url &}
    } else {
        append url "tableg/" $date "tb.htm"
        GetGcode
    }
}
proc GetGcode {} {
    global url log
    set token [::http::geturl $url]
    $log delete 1.0 end
    upvar #0 $token state
    foreach line [split $state(body) \n] {
        regsub -all "</\[AB\]+>" $line "" newline
        regsub -all "<img src\[^\>\]+>" $newline "" newnewline
        if {[regexp "\[^\<\>\]+\\(\[0-9\]+\\)" $newnewline str]} {
            $log insert end $str\n
            $log see end
        }
    }
}
proc SetDate {} {
    global time date whatday
    set date [clock format [clock scan $whatday] -format "%m%d"]
    regexp {([0-9]+)時} $time match timenum
    set strlen [string length $timenum]
    if {$strlen == 1} {
        append date 0 $timenum
    } else {
        append date $timenum
    }
}
proc SetWhatday {} {
    global day whatday
    if { $day == "昨日" } {
        set whatday yesterday
    } elseif { $day == "今日" } {
        set whatday today
    } elseif { $day == "明日" } {
        set whatday tomorrow
    } elseif { $day == "明後日" } {
        set whatday "today 2 day"
    } elseif { $day == "明々後日" } {
        set whatday "today 3 day"
    } elseif { $day == "4日後" } {
        set whatday "today 4 day"
    } elseif { $day == "5日後" } {
        set whatday "today 5 day"
    }
}