1## -*- tcl -*- 2## (C) 2010 Andreas Kupries <andreas_kupries@users.sourceforge.net> 3## BSD Licensed 4# # ## ### ##### ######## ############# ###################### 5 6# 7# application on top of the diagram drawing package. 8# 9 10## Use Cases 11## (1) Reading a single diagram file and showing it on a canvas. 12 13## (1a) Like (1), for multiple input files. This requires an additional 14## selection step before the diagram is shown. 15 16## (2) Convert one or more diagram files into raster images in various 17## formats. 18 19# # ## ### ##### ######## ############# ##################### 20## Command syntax 21 22## (Ad 1) show picfile 23## (Ad 1a) show picfile picfile... 24 25## (Ad 2) convert -o output-file-or-dir format picfile 26## convert -o output-dir format picfile picfile... 27 28# # ## ### ##### ######## ############# ##################### 29## Requirements 30 31package require Tcl 8.5 32package require Tk 8.5 33package require fileutil 34 35wm withdraw . ; # Hide the main toplevel until we actually need it, if 36 # ever. 37namespace eval ::diagram::application {} 38 39# # ## ### ##### ######## ############# ##################### 40## Implementation 41 42proc ::diagram::application {arguments} { 43 variable application::mode 44 application::ProcessCmdline $arguments 45 application::Run::$mode 46 return 47} 48 49proc ::diagram::application::showerror {text} { 50 global argv0 51 puts stderr "$argv0: $text" 52 exit 1 53} 54 55# # ## ### ##### ######## ############# ##################### 56## Internal data and status 57 58namespace eval ::diagram::application { 59 # Path to where the output goes to. Depending on the chosen mode 60 # this information may be irrelevant, a file, or a directory. 61 # Specified through the option '-o' where suitable. 62 63 variable output "" 64 65 # Paths of the documents to convert. Always a list, even in the 66 # case of a single input file. Specified through the trailing 67 # arguments on the command line. The relative path of a file under 68 # 'input' also becomes its relative path under 'output'. 69 70 variable input "" 71 72 # The name of the format to convert the diagram documents 73 # into. Used as extension for the generated files as well when 74 # converting multiple files. Internally this is the name of the 75 # canvas::* or img::* package for the image format. The two cases 76 # are distinguished by the value of the boolean flag "snap". True 77 # indicates a raster format via img::*, false a canvas::* dump 78 # package ... FUTURE :: Should have a 'canvas::write::*' or 79 # somesuch family of packages which hide this type of difference 80 # from us. 81 82 variable format "" 83 variable snap 0 84 85 # Name of the found processing mode. Derived during processing all 86 # arguments on the command line. This value is used during the 87 # dispatch to the command implementing the mode, after processing 88 # the command line. 89 # 90 # Possible/Legal values: Meaning 91 # --------------------- ------- 92 # --------------------- ------- 93 94 variable mode "" 95} 96 97# # ## ### ##### ######## ############# ##################### 98## 99 100proc ::diagram::application::ProcessCmdline {arguments} { 101 variable input {} ; # Set defaults. 102 variable output "" ; # 103 variable format "" ; # 104 variable mode "" ; # 105 106 # syntax: show file... 107 # convert -o output format file... 108 109 if {[llength $arguments] < 2} Usage 110 set arguments [lassign $arguments command] 111 112 switch -exact -- $command { 113 show {ProcessShow $arguments} 114 convert {ProcessConvert $arguments} 115 default Usage 116 } 117 118 set mode $command 119 return 120} 121 122proc ::diagram::application::ProcessShow {arguments} { 123 if {[llength $arguments] < 1} Usage 124 variable input {} 125 variable trusted 0 126 127 # Basic option processing and validation. 128 while {[llength $arguments]} { 129 set opt [lindex $arguments 0] 130 if {![string match "-*" $opt]} break 131 132 switch -exact -- $opt { 133 -t { 134 if {[llength $arguments] < 1} Usage 135 set arguments [lassign $arguments _opt_] 136 set trusted 1 137 } 138 default Usage 139 } 140 } 141 142 set input $arguments 143 CheckInput 144 return 145} 146 147proc ::diagram::application::ProcessConvert {arguments} { 148 variable output "" 149 variable input {} 150 variable format "" 151 variable trusted 0 152 153 if {[llength $arguments] < 4} Usage 154 155 # Basic option processing and validation. 156 while {[llength $arguments]} { 157 set opt [lindex $arguments 0] 158 if {![string match "-*" $opt]} break 159 160 switch -exact -- $opt { 161 -o { 162 if {[llength $arguments] < 2} Usage 163 set arguments [lassign $arguments _opt_ output] 164 } 165 -t { 166 if {[llength $arguments] < 1} Usage 167 set arguments [lassign $arguments _opt_] 168 set trusted 1 169 } 170 default Usage 171 } 172 } 173 # Format and at least one file are expected. 174 if {[llength $arguments] < 2} Usage 175 set input [lassign $arguments format] 176 177 ValidateFormat 178 CheckInput 179 CheckOutput 180 return 181} 182 183# # ## ### ##### ######## ############# ##################### 184 185proc ::diagram::application::Usage {} { 186 showerror "wrong#args, expected: show file...|convert -o outputpath format file..." 187 # not reached ... 188} 189 190# # ## ### ##### ######## ############# ##################### 191## Various complex checks on the arguments 192 193proc ::diagram::application::ValidateFormat {} { 194 variable format 195 variable snap 196 if {![catch { 197 package require canvas::snap 198 package require img::$format 199 set snap 1 200 } msgA]} return 201 202 if {![catch { 203 package require canvas::$format 204 } msgB]} return 205 206 showerror "Unable to handle format \"$format\", because of: $msgA and $msgB" 207 return 208} 209 210proc ::diagram::application::CheckInput {} { 211 variable input 212 foreach f $input { 213 if {![file exists $f]} { 214 showerror "Unable to find picture \"$f\"" 215 } elseif {![file readable $f]} { 216 showerror "picture \"$f\" not readable (permission denied)" 217 } 218 } 219 if {[llength $input] < 1} { 220 showerror "No picture(s) specified" 221 } 222 return 223} 224 225proc ::diagram::application::CheckOutput {} { 226 variable input 227 variable output 228 229 if {$output eq ""} { 230 showerror "No output path specified" 231 } 232 233 set base [file dirname $output] 234 if {$base eq ""} {set base [pwd]} 235 236 # Multiple inputs: Output must either exist as directory, or 237 # output base writable so that we can create the directory. 238 # Single input: As above except existence as file. 239 240 if {![file exists $output]} { 241 if {![file exists $base]} { 242 showerror "Output base path \"$base\" not found" 243 } 244 if {![file writable $base]} { 245 showerror "Output base path \"$base\" not writable (permission denied)" 246 } 247 } else { 248 if {![file writable $output]} { 249 showerror "Output path \"$output\" not writable (permission denied)" 250 } 251 252 if {[llength $input] > 1} { 253 if {![file isdirectory $output]} { 254 showerror "Output path \"$output\" not a directory" 255 } 256 } else { 257 if {![file isfile $output]} { 258 showerror "Output path \"$output\" not a file" 259 } 260 } 261 } 262 return 263} 264 265# # ## ### ##### ######## ############# ##################### 266## 267 268namespace eval ::diagram::application::Run::GUI {} 269 270proc ::diagram::application::Run::show {} { 271 variable ::diagram::application::input 272 273 GUI::Show 274 275 if {[llength $input] == 1} { 276 after 100 { 277 .l selection clear 0 end 278 .l selection set 0 279 event generate .l <<ListboxSelect>> 280 } 281 } 282 283 vwait __forever__ 284 return 285} 286 287proc ::diagram::application::Run::convert {} { 288 variable ::diagram::application::input 289 variable ::diagram::application::output 290 291 set dip [MakeInterpreter] 292 GUI::Convert 293 PrepareOutput 294 295 if {[llength $input] > 1} { 296 foreach f $input { 297 Convert $dip $f [GetDestination $f] 298 } 299 } else { 300 set f [lindex $input 0] 301 if {[file exists $output] && [file isdirectory $output]} { 302 Convert $dip $f [GetExtension $output/[file tail $input]] 303 } else { 304 Convert $dip $f $output 305 } 306 } 307 308 interp delete $dip 309 GUI::Close 310 return 311} 312 313proc ::diagram::application::Run::Convert {dip src dst} { 314 variable ::diagram::application::format 315 variable ::diagram::application::snap 316 317 puts ${src}... 318 set pic [fileutil::cat $src] 319 320 if {[catch { 321 $dip eval [list D draw $pic] 322 } msg]} { 323 puts "FAIL $msg : $src" 324 } elseif {$snap} { 325 set DIA [canvas::snap .c] 326 $DIA write $dst -format $format 327 image delete $DIA 328 } else { 329 # Direct canvas dump ... 330 fileutil::writeFile $dst [canvas::$format .c] 331 } 332 333 # Wipe controller state, no information transfer between pictures. 334 $dip eval {D reset} 335 return 336} 337 338proc ::diagram::application::Run::GUI::Show {} { 339 package require widget::scrolledwindow 340 #package require crosshair 341 342 set dip [::diagram::application::Run::MakeInterpreter] 343 344 button .e -text Exit -command ::exit 345 widget::scrolledwindow .sl -borderwidth 1 -relief sunken 346 widget::scrolledwindow .sc -borderwidth 1 -relief sunken 347 listbox .l -width 40 -selectmode single -listvariable ::diagram::application::input 348 canvas .c -width 800 -height 600 -scrollregion {-4000 -4000 4000 4000} 349 350 .sl setwidget .l 351 .sc setwidget .c 352 353 pack .e -fill none -expand 0 -side bottom -anchor e 354 355 #panedwindow .p -orient vertical 356 #.p add .sl .sc 357 #.p paneconfigure .sl -width 100 358 359 pack .sl -fill both -expand 1 -padx 4 -pady 4 -side left 360 pack .sc -fill both -expand 1 -padx 4 -pady 4 -side right 361 362 bind .l <<ListboxSelect>> [list ::diagram::application::Run::GUI::ShowPicture $dip] 363 364 365 # Panning via mouse 366 bind .c <ButtonPress-2> {%W scan mark %x %y} 367 bind .c <B2-Motion> {%W scan dragto %x %y} 368 369 # Cross hairs ... 370 #.c configure -cursor tcross 371 #crosshair::crosshair .c -width 0 -fill \#999999 -dash {.} 372 #crosshair::track on .c TRACK 373 374 wm deiconify . 375 return 376} 377 378proc ::diagram::application::Run::GUI::ShowPicture {dip} { 379 380 set selection [.l curselection] 381 if {![llength $selection]} return 382 383 $dip eval {catch {D destroy}} 384 $dip eval {diagram D .c} 385 386 set pic [fileutil::cat [.l get $selection]] 387 388 after 0 [list $dip eval [list D draw $pic]] 389 return 390} 391 392proc ::diagram::application::Run::GUI::Convert {} { 393 canvas .c -width 800 -height 600 -scrollregion {0 0 1200 1000} 394 grid .c -row 0 -column 0 -sticky swen 395 396 grid rowconfigure . 0 -weight 1 397 grid columnconfigure . 0 -weight 1 398 399 wm attributes . -fullscreen 1 400 wm deiconify . 401 tkwait visibility . 402 return 403} 404 405proc ::diagram::application::Run::GUI::Close {} { 406 wm withdraw . 407 destroy . 408 return 409} 410 411proc ::diagram::application::Run::PrepareOutput {} { 412 variable ::diagram::application::input 413 variable ::diagram::application::output 414 415 if {[llength $input] > 1} { 416 file mkdir [file dirname $output] 417 } 418 return 419} 420 421proc ::diagram::application::Run::GetDestination {f} { 422 variable ::diagram::application::output 423 424 if {[file pathtype $f] ne "relative"} { 425 return set f [file join $output {*}[lrange [file split $f] 1 end]] 426 } else { 427 set f $output/$f 428 } 429 file mkdir [file dirname $f] 430 return [GetExtension $f] 431} 432 433proc ::diagram::application::Run::GetExtension {f} { 434 variable ::diagram::application::format 435 return [file rootname $f].$format 436} 437 438proc ::diagram::application::Run::MakeInterpreter {} { 439 variable ::diagram::application::trusted 440 set sec [expr {[lindex [time { 441 if {$trusted} { 442 puts {Creating trusted environment, please wait...} 443 set dip [interp create] 444 $dip eval [list set auto_path $::auto_path] 445 } else { 446 puts {Creating safe environment, please wait...} 447 set dip [::safe::interpCreate] 448 } 449 interp alias $dip .c {} .c ; # Import of canvas 450 interp alias $dip tk {} tk ; # enable tk scaling 451 $dip eval {package require diagram} 452 $dip eval {diagram D .c} 453 }] 0]/double(1e6)}] 454 puts "... completed in $sec seconds." 455 after 100 456 return $dip 457} 458 459# # ## ### ##### ######## ############# ##################### 460package provide diagram::application 1.1 461return 462