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