1#! /bin/sh 2# \ 3 exec wish $0 ${1+"$@"} 4# BEGIN LICENSE BLOCK 5# Version: CMPL 1.1 6# 7# The contents of this file are subject to the Cisco-style Mozilla Public 8# License Version 1.1 (the "License"); you may not use this file except 9# in compliance with the License. You may obtain a copy of the License 10# at www.eclipse-clp.org/license. 11# 12# Software distributed under the License is distributed on an "AS IS" 13# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 14# the License for the specific language governing rights and limitations 15# under the License. 16# 17# The Original Code is The ECLiPSe Constraint Logic Programming System. 18# The Initial Developer of the Original Code is Cisco Systems, Inc. 19# Portions created by the Initial Developer are 20# Copyright (C) 2006 Cisco Systems, Inc. All Rights Reserved. 21# 22# Contributor(s): 23# 24# END LICENSE BLOCK 25 26# mapcolour.tcl 27# Core Tcl side code for mapcolouring example, shared by both 28# the embedded and remote variants 29 30#---------------------------------------------------------------------- 31# Make a standard menu bar and a 'File' and 'Tools' menu 32#---------------------------------------------------------------------- 33 34wm title . "Map Colouring" 35 36# is_colouring is a global variable which indicates if the program is currently 37# colouring a map: 1 if yes, 0 if no 38set is_colouring 0 39 40. config -menu .mbar 41 42menu .mbar 43.mbar add cascade -label File -menu .mbar.file 44.mbar add cascade -label Method -menu .mbar.method 45.mbar add cascade -label Tools -menu .mbar.tools 46 47menu .mbar.file 48.mbar.file add command -label "New Map..." -command read_new_map 49.mbar.file add command -label "Map Size..." -command set_map_size 50.mbar.file add command -label Exit -command exit 51 52menu .mbar.method 53.mbar.method add cascade -label Solver -menu .mbar.file.solver 54.mbar.method add cascade -label "Value Choice" -menu .mbar.file.choice 55.mbar.method add cascade -label "Variable Selection" -menu .mbar.file.select 56 57set solver fd 58set m2 [menu .mbar.file.solver] 59$m2 add radio -label FD -variable solver -value fd 60$m2 add radio -label IC -variable solver -value ic 61$m2 add radio -label "Delay till ground" -variable solver -value delay 62$m2 add radio -label "Prolog (generate & test)" -variable solver -value prolog 63 64set choice indomain 65set m2 [menu .mbar.file.choice] 66$m2 add radio -label "indomain" -variable choice -value indomain 67$m2 add radio -label "indomain_random" -variable choice -value indomain_random 68$m2 add radio -label "rotate colours" -variable choice -value rotate 69 70set select input_order 71set m2 [menu .mbar.file.select] 72$m2 add radio -label "input order" -variable select -value input_order 73$m2 add radio -label "first-fail" -variable select -value first_fail 74$m2 add radio -label "occurence" -variable select -value occurrence 75$m2 add radio -label "most constrained" -variable select -value most_constrained 76$m2 add radio -label "antifirst-fail" -variable select -value anti_first_fail 77 78# select a new map data file and get ECLiPSe side to compile the file 79# via an ERPC call to init_map/2. The maximum size for a map using the 80# data file is returned by ECLiPSe and stored in a global variable maxmapsize 81proc read_new_map {} { 82 global is_colouring 83 84 if {$is_colouring} return ;# only allow selection if no problem is running 85 86 set file [tk_getOpenFile -defaultextension ".map" -filetypes {{{Map Data} {.map}}} -title "Select a Map" -initialdir [pwd]] 87 if {$file != ""} { 88 init_mapdata $file 89 } 90} 91 92# allow the user to set the actual map size to colour with a particular 93# map data file. An ERPC call is made to get_map_data/1 when the size is 94# selected, and the ECLiPSe side returns the information on the shape and 95# position of the countries for a map of this size. This produces the 96# initial uncoloured map 97proc set_map_size {} { 98 global mapsize maxmapsize shadowsize is_colouring 99 100 if {$is_colouring} return ;# change map size only when not colouring 101 102 if {[winfo exists .size]} { 103 wm deiconify .size 104 raise .size 105 } else { 106 toplevel .size 107 set shadowsize $mapsize 108 pack [scale .size.scale -from 1 -to $maxmapsize -orient hori -tickinterval 25 -length 80m -sliderlength 4m -variable shadowsize] -expand 1 -fill x 109 pack [frame .size.f] -side bottom -fill x 110 pack [button .size.f.make -text "Create Map" -command {change_mapsize $shadowsize}] -side left -fill x 111 pack [button .size.f.exit -text "Dismiss" -command "destroy .size"] -side right -fill x 112 } 113} 114 115# starts the map colouring process. An ERPC is made to colouring/5 116proc run {} { 117 global solver select choice mapsize solution_count is_colouring 118 119 set solution_count 0 120 .f.c itemconfigure all -fill darkgray 121 .b.run configure -state disabled 122 set is_colouring 1 123 set res [ec_rpc [list colouring $solver $select $choice $mapsize _ _] \ 124 (()()()I__)] 125 set is_colouring 0 126 set backtracks [lindex $res 5] 127 set time [lindex $res 6] 128 .m insert end "Execution time for $solver, $select, $choice, size $mapsize: $time sec, $backtracks backtracks for $solution_count solution(s)\n" 129 .m see end 130 .b.run configure -state normal 131} 132 133 134# queue handler for setup_map. This takes the shape and position information 135# sent by the ECLiPSe side and displays it 136# n is a dummy argument for compatibility with remote interface 137proc setup_map {stream {n {}}} { 138 139 ;# factor is used to scale the map to a reasonable size 140 ;# in a more sophisticated implementation, this could be calculated 141 ;# by the program 142 set factor 17 143 set stname [ec_streamnum_to_channel $stream] 144 .f.c delete all 145 146 set info [ec_read_exdr $stname] 147 while {$info != "end"} { 148 set country [lindex $info 1] 149 set x1 [expr [lindex $info 2] * $factor + 1] 150 set y1 [expr [lindex $info 3] * $factor + 1] 151 set x2 [expr [lindex $info 4] * $factor - 1] 152 set y2 [expr [lindex $info 5] * $factor - 1] 153 154 ;# the tag c$country is used to associate this 155 ;# area with the other areas for the same country 156 .f.c create rect $x1 $y1 $x2 $y2 -tag c$country -fill darkgray -outline "" 157 set info [ec_read_exdr $stname] 158 } 159 160} 161 162# queue handler for update_map. Reads the new colour for a country and updates 163# the displayed colour. 164proc update_map {stream {n {}}} { 165 set stname [ec_streamnum_to_channel $stream] 166 set info [ec_read_exdr $stname] 167 168 set country [lindex $info 1] 169 set colour [lindex $info 2] 170 ;# the tag c$country is used to update all regions of the country 171 .f.c itemconfigure c$country -fill $colour -outline "" 172} 173 174# changes the number of countries that are to be coloured (using the same 175# map data file), by making an ERPC call to get_map_data/1 176proc change_mapsize {size} { 177 global mapsize 178 179 set mapsize $size 180 ec_rpc [list get_map_data $mapsize] (I) 181} 182 183proc init_mapdata {{mapfile "map_data.map"}} { 184 global mapsize maxmapsize 185 186 set res [ec_rpc [list init_map $mapfile _] (()_)] 187 switch $res { 188 fail - 189 throw { 190 tk_messageBox -type ok -icon error -message "Unable to compile $mapfile as map data..." 191 } 192 default { 193 set maxmapsize [lindex $res 2] 194 set mapsize $maxmapsize 195 ec_rpc [list get_map_data $mapsize] (I) 196 } 197 } 198 199} 200 201# after a map has been successfully coloured, this asks the user if s/he 202# wants to continue to colour the map (find alternative solutions). 203proc continue_colouring {n} { 204 global continue_state solution_count 205 206 .b.more configure -state normal 207 .b.done configure -state normal 208 tkwait variable continue_state 209 incr solution_count 210 .b.more configure -state disabled 211 .b.done configure -state disabled 212 ec_write_exdr [ec_streamnum_to_channel $n] $continue_state () 213 ec_flush $n 214 215} 216 217# initialise the program. Sets up a default map with a default size so that 218# the map colouring can be done immediately 219proc map_init {} { 220 global tkecl 221 222 ec_tools_init .mbar.tools 223 224 frame .b 225 button .b.run -text Run -command run 226 button .b.more -text More -command "set continue_state yes" -state disabled 227 button .b.done -text Done -command "set continue_state no" -state disabled 228 pack .b -side top -fill x -expand 1 229 pack .b.run -side left -fill x -expand 1 230 pack .b.more -side left -fill x -expand 1 231 pack .b.done -side right -fill x -expand 1 232 frame .f 233 pack [canvas .f.c -width 23c -height 13c] -expand 1 -fill both 234 pack .f -expand 1 -fill both 235 pack [text .m -relief sunken -height 5] -expand 1 -fill both 236 237 ec_queue_create setup_map fromec setup_map 238 ec_queue_create update_map fromec update_map 239 ec_queue_create continue toec continue_colouring 240 241 cd [file join $tkecl(ECLIPSEDIR) lib_tcl] 242 ec_rpc [list compile mapcolour] (()) 243 init_mapdata 244} 245 246 247 248 249