世界地圖

地圖.tcl

#!/usr/bin/env tcl
package require Tk
package require http

set universes [encoding convertfrom utf-8 [http::data [http::geturl http://ekd123.org/map.tcl]]]
set universe {}
set lastIDs  {}

wm title . "地圖"
ttk::combobox .switcher -values [dict keys $universes] -state readonly
ttk::button .btn -text "切換" -command refresh
canvas .c -bg white

grid .switcher -sticky we
grid .btn -column 1 -row 0 -sticky ""
grid .c -columnspan 2 -sticky news
grid columnconfigure . .switcher -weight 1
grid rowconfigure . .c -weight 1

proc convert2Pixel {x y} {
	return [list [expr $x*20] [expr $y*20]]
}

proc refresh {} {
	global universes universe lastIDs counter
	foreach id $lastIDs {
		.c delete $id
		set lastIDs {}
	}
	set universe [dict get $universes [.switcher get]]
	foreach nation $universe {
		foreach area [dict get $nation land] {
			set pixel [convert2Pixel {*}[split $area ,]]
			set id [.c create rect {*}$pixel {*}[lmap a $pixel {expr $a+20}] -fill [dict get $nation color]]
			lappend lastIDs $id
			.c bind $id <ButtonPress> [list apply {{nation msg} {tk_messageBox -message "$nation\n\n$msg"}} [dict get $nation name] [dict get $nation info]]
		}
	}
}

.switcher set [lindex [dict keys $universes] 0]
refresh