| Bsoft 2.0.5 Bernard's software package

bshow_file.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_file.tcl
3 #
4 # @brief Procedures to manage file I/O
5 #
6 # @author Bernard Heymann
7 # @date Created: 20010516
8 # @date Modified: 20191112
9
10 set img_load_phase 0
11 set filter "*"
12
13 ## @brief Menu for opening and closing image files and quiting
14 #
15
16 proc setupFileMenu {} {
17 global filename
18
19 .menuBar add cascade -menu .menuBar.file -label "File" -underline 0
20 menu .menuBar.file -tearoff 0
21 .menuBar.file add command -label "Open ..." -command { fileDialog "open" } \
22 -underline 0 -accelerator "Ctrl-o"
23 .menuBar.file add command -label "Save" -command { fileDialog "save" } \
24 -underline 0
25 .menuBar.file add command -label "Save as ..." -command { fileDialog "saveAs" } \
26 -underline 0 -accelerator "Ctrl-S"
27 .menuBar.file add command -label "Save region ..." -command { extractImage } \
28 -underline 0
29 .menuBar.file add command -label "File browser" -command { fileBrowserWindow .fb } \
30 -underline 0
31 .menuBar.file add command -label "Revert" -command { loadImage $filename -1 } \
32 -underline 0 -accelerator "Ctrl-u"
33 .menuBar.file add command -label "Get info" -command { getInfo $filename } \
34 -underline 0 -accelerator "Ctrl-i"
35 .menuBar.file add command -label "Write PostScript" -command { writePostScript } \
36 -underline 0
37 .menuBar.file add command -label "Quit" -command { Quit } -underline 0 \
38 -accelerator "Ctrl-q"
39 }
40
41 # Type names Extension(s) Mac File Type(s)
42 #
43 #---------------------------------------------------------
44 set filetypes {
45 {"All files" *}
46 {"CCP4" {.map .MAP} }
47 {"MRC" {.mrc .MRC .stk .STK .st .ST .ali .ALI .rec .REC} }
48 {"PIF" {.pif .PIF} }
49 {"EM" {.em .EM } }
50 {"IMAGIC" {.img .IMG .hed .HED} }
51 {"SPIDER" {.spi .SPI} }
52 {"SUPRIM" {.sup .SUP .spm .SPM} }
53 {"DM3" {.dm3 .DM3} }
54 {"DM4" {.dm4 .DM4} }
55 {"SER" {.ser .SER} }
56 {"TIFF" {.tif .tiff .TIF .TIFF} }
57 {"PNG" {.png .PNG} }
58 {"PNM" {.pbm .pgm .ppm .PBM .PGM .PPM} }
59 {"JPEG" {.jpg .jpeg .JPG .JPEG} }
60 {"ASCII" {.txt .asc .ascii .TXT .ASC .ASCII} }
61 }
62
63 ## @brief Selects a file for reading or writing using a standard dialog
64 #
65 # @param operation "open", "save" or "saveAs".
66
67 proc fileDialog { operation } {
68 global theimg
69 global filename imgdir
70 global filetypes
71 global paramfile
72 set currdir $imgdir
73 if { [string length $currdir] < 2 } { set currdir [pwd]}
74 # puts "Image directory: $imgdir"
75 if { [string compare $operation "open"] == 0 } {
76 set new_filename [tk_getOpenFile -title "Open image file" \
77 -filetypes $filetypes -initialdir $currdir]
78 if { [string length $new_filename] < 1 } { return}
79 set filename [relativePath [pwd] $new_filename]
80 set imgdir [file dirname $filename]
81 # tk_messageBox -icon info -type ok -title "Directory and file name" -message \
82 # "imgdir = $imgdir\nfilename = $filename"
83 loadImage $filename -1
84 } else {
85 if { [string compare $operation "saveAs"] == 0 } {
86 set new_filename [tk_getSaveFile -filetypes $filetypes \
87 -initialfile [file tail $filename] -initialdir $currdir \
88 -defaultextension .pif]
89 if { [string length $new_filename] < 1 } { return}
90 set filename [relativePath [pwd] $new_filename]
91 }
92 Bimage set $theimg pixel_size [.pixel_size.entry get]
93 Bimage save $theimg $filename
94 writeSettingsFile
95 }
96 # puts "Image directory: $imgdir"
97 # tk_messageBox -icon info -type ok -title "Directory and file name" -message \
98 # "$imgdir $filename"
99 if [Bmg exists] { setMgParam}
100 wm title . [list $filename ":" $paramfile]
101 }
102
103
104 ## @brief Populates a file browser tree node
105 #
106 # @param tree File browser tree.
107 # @param node File browser node.
108
109 proc openNode {tree node} {
110 global filter
111
112 if {[$tree set $node type] ne "directory"} {
113 return
114 }
115
116 set path [$tree set $node fullpath]
117 $tree delete [$tree children $node]
118
119 foreach f [lsort -dictionary [glob -nocomplain -dir $path *]] {
120 # set r [string match "./$filter" $f]
121 # puts "$f $r"
122 if [string match "./$filter" $f] {
123 set type [file type $f]
124 set id [$tree insert $node end -text [file tail $f] \
125 -values [list $f $type]]
126
127 if {$type eq "directory"} {
128 ## Make it so that this node is openable
129 $tree insert $id 0 -text dummy ;# a dummy
130 $tree item $id -text [file tail $f]/
131
132 } elseif {$type eq "file"} {
133 set size [file size $f]
134 ## Format the file size nicely
135 if {$size >= 1024*1024*1024} {
136 set size [format %.1f\ GB [expr {$size/1024/1024/1024.}]]
137 } elseif {$size >= 1024*1024} {
138 set size [format %.1f\ MB [expr {$size/1024/1024.}]]
139 } elseif {$size >= 1024} {
140 set size [format %.1f\ kB [expr {$size/1024.}]]
141 } else {
142 append size " bytes"
143 }
144 $tree set $id size $size
145 }
146 }
147 }
148
149 # Stop this code from rerunning on the current node
150 $tree set $node type processedDirectory
151 }
152
153 ## @brief Points the file browser to the current directory
154 #
155 # @param w File browser tree.
156
157 proc setupFileBrowser { w } {
158 global filter
159
160 $w.tree set {} fullpath "./"
161 $w.tree set {} type "directory"
162
163 set filter [$w.filter.e get]
164 if { $filter eq "" } {
165 set filter "*"
166 $w.filter.e insert 0 $filter
167 }
168
169 openNode $w.tree {}
170 }
171
172 ## @brief Opens a file indicated by a double-click in the file browser
173 #
174 # @param wtree File browser tree.
175
176 proc openFileFromTree { wtree } {
177 global filename imgdir
178 set type [$wtree set [$wtree focus] type]
179 if { $type eq "file" || $type eq "link" } {
180 set fn [$wtree set [$wtree focus] fullpath]
181 set tbt [exec file $fn]
182 if [string match "*text*" $tbt] {
183 editTextFile $fn
184 } else {
185 set ft [fileType $fn]
186 if { $ft == 1 } {
187 set filename [relativePath [pwd] $fn]
188 set imgdir [file dirname $filename]
189 loadImage $fn -1
190 } else {
191 tk_messageBox -icon info -type ok \
192 -title "Error" -message "File type not supported!"
193 }
194 }
195 }
196 }
197
198
199
200 ## @brief Sets up the file browser window
201 #
202 # @param w Window name.
203
204 proc fileBrowserWindow { w } {
205 global filter
206
207 catch {destroy $w}
208 toplevel $w
209 wm title $w "File browser"
210 wm iconname $w "Browser"
211 wm geometry $w 500x800+500+50
212
213 ## Buttons
214 ttk::frame $w.buttons
215 ttk::button $w.buttons.close -text "Close" \
216 -command [list destroy [winfo toplevel $w]]
217 ttk::button $w.buttons.code -text "Refresh" \
218 -command [list setupFileBrowser $w]
219 pack $w.buttons.code $w.buttons.close -side left
220 pack $w.buttons -side bottom -padx 2 -pady 2
221
222 ## Filter
223 labelframe $w.filter -text "File filter" -labelanchor nw
224 ttk::entry $w.filter.e
225 $w.filter.e insert 0 $filter
226 pack $w.filter.e -side left -expand yes -fill x
227 pack $w.filter -side bottom -fill x -padx 2 -pady 2
228
229 ## Create the tree and set it up
230 ttk::treeview $w.tree -columns {fullpath type size} -displaycolumns {size} \
231 -yscroll "$w.vsb set" -xscroll "$w.hsb set"
232 if {[tk windowingsystem] ne "aqua"} {
233 ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview"
234 ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
235 } else {
236 scrollbar $w.vsb -orient vertical -command "$w.tree yview"
237 scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
238 }
239 $w.tree heading \#0 -text "File"
240 $w.tree heading size -text "Size"
241 $w.tree column size -stretch 0 -width 70
242
243 setupFileBrowser $w
244
245 ## Arrange the tree and its scrollbars in the toplevel
246 lower [ttk::frame $w.gframe]
247 pack $w.gframe -fill both -expand 1
248 grid $w.tree $w.vsb -sticky nsew -in $w.gframe
249 grid $w.hsb -sticky nsew -in $w.gframe
250 grid columnconfigure $w.gframe 0 -weight 1
251 grid rowconfigure $w.gframe 0 -weight 1
252
253 bind $w.tree <<TreeviewOpen>> {openNode %W [%W focus]}
254 bind $w.tree <Double-Button-1> {openFileFromTree %W }
255 bind $w <Return> [list setupFileBrowser $w]
256 }
257
258 ## @brief Loads the selected file into a photo image for display.
259 #
260 # @param filename Image file name.
261 # @param img_num Sub-image number.
262
263 proc loadImage { filename img_num } {
264 global theimg
265 global imgdir
266 global paramfile modelfile
267 global mode
268 global window_width window_height window_scale rem_scale
269 global img_load_phase
270 global avg_check kernel
271 if { [string length $filename] < 1 } { return}
272 if { ![winfo exists .] } { return}
273 set imgdir [file dirname $filename]
274 set filename [file tail $filename]
275 # tk_messageBox -icon info -type ok -title "Directory and file name" -message \
276 # "$imgdir $filename"
277 if { [Bmg exists] } {
278 wm title . [list $filename ":" $paramfile]
279 } elseif { [Bmodel exists] } {
280 wm title . [list $filename ":" $modelfile]
281 } else {
282 wm title . $filename
283 }
284 # puts "Opening image $imgdir/$filename ($img_num)"
285
286 if { [catch { set nimages [Bimage open $theimg $imgdir/$filename $img_num]} err] } {
287 # bgerror $err
288 fileDialog "open"
289 return
290 }
291 # puts "Image opened with $nimages sub-images"
292 if { $nimages < 1 } { return}
293 set nslices [Bimage get $theimg nslices]
294 # puts "Image opened with $nslices slices"
295 if { $nslices < 1 } { return}
296
297 if { $avg_check } {
298 # puts "Average filtering kernel: $kernel"
299 Bimage average $theimg $kernel $kernel $kernel
300 }
301
302 set c [getImageCanvas $theimg]
303 set wc [getControlWindow $theimg]
304 # puts "Loading: $window_width $window_height $window_scale"
305 set img_load_phase 1
306 set width [Bimage get $theimg width]
307 set height [Bimage get $theimg height]
308 # set pixel_size [Bimage get $theimg pixel_size]
309 # set pixel_size [expr 0.001*floor(1000 * $pixel_size)]
310 set origin [Bimage get $theimg origin]
311 # puts $origin
312 if { $img_num < 0 } { set img_num 0}
313 # puts "Image opened with origin $origin"
314 set oz [lindex $origin 2]
315 if { $oz < 0 } { set oz 0}
316 if { $oz >= $nslices } { set oz 0}
317 set scale $window_scale
318 # $wc.scale.scale set $window_scale
319 if { $window_width < 2 || $rem_scale == 0 } {
320 set scale 1.0
321 set window_width 512
322 set window_height 512
323 if { $width > $window_width } { set scale [expr 0.1*(($window_width*10)/$width)]}
324 }
325 if { $scale < 0.1 } { set scale 0.1}
326 set window_scale $scale
327 # puts "Image scale = $scale mode = $mode"
328 set width [expr $width * $scale]
329 set height [expr $height * $scale]
330 set size "0 0 $width $height"
331 if { $width < 200 } { set width 200}
332 if { $height < 200 } { set height 200}
333 if { $width > $window_width } { set width $window_width}
334 if { $height > $window_height } { set height $window_height}
335 set window_width $width
336 set window_height $height
337 # puts "Width $width height $height scrollregion $size"
338 $c configure -width $width -height $height -scrollregion $size
339 # $c configure -scrollregion $size
340 # puts "Loading2: $window_width $window_height $window_scale"
341 reconfigureRangeStep
342 # puts "Range step reconfigured"
343 reconfigureScales
344 # puts "Scales reconfigured"
345 if { ![ regexp {^([0-9.]+)$} $oz] } { set oz 0}
346 $wc.image.scale set $img_num
347 $wc.slice.scale set $oz
348 $wc.scale.scale set $scale
349 updatePixelsize
350 # puts "Pixel size updated"
351 update
352 set img_load_phase 0
353 Update 1
354 }
355
356 ## @brief Derives the relative path from an absolute one relative to a given directory.
357 #
358 # @param cdir Current directory.
359 # @param path Absolute path to convert.
360
361 proc relativePath { cdir path } {
362 if { $cdir == "/" } { return $path}
363 set dlist [file split $cdir]
364 set plist [file split $path]
365 set len [llength $dlist]
366 # tk_messageBox -icon info -type ok -title "Current directory and path in relativePath" -message \
367 # "Directory = $cdir ($len) Path = $path [lindex $dlist 0]"
368 # puts "Current directory: $cdir Path: $path"
369 if { [lindex $dlist 0] == [lindex $plist 0] } {
370 for { set i 0} { ( $i < $len ) && ( [lindex $dlist $i] == [lindex $plist $i] ) } { incr i 1} {
371 }
372 set path ""
373 for { set j $i} { $j < $len } { incr j 1} {
374 append path "../"
375 }
376 set len [llength $plist]
377 for { set j $i} { $j < $len } { incr j 1} {
378 set path [file join $path [lindex $plist $j]]
379 }
380 } elseif { [lindex $plist 0] == ".." } {
381 }
382 # puts "Relative path: $path"
383 # tk_messageBox -icon info -type ok -title "Modified path in relativePath" -message "$path"
384 return $path
385 }
386
387 ## @brief Loads the information for the current image file into a text window for display.
388 #
389 # @param filename Image file name.
390
391 proc getInfo { filename } {
392 global Bsoft
393 global imgdir
394 # puts "$Bsoft $imgdir $filename"
395 if ![winfo exists .info] {
396 toplevel .info
397 frame .info.buttons
398 pack .info.buttons -side bottom -fill x
399 button .info.buttons.dismiss -text Dismiss \
400 -default active -command "destroy .info"
401 pack .info.buttons.dismiss -side left -expand 1 -pady 2
402 frame .info.frame
403 pack .info.frame -expand yes -fill both -padx 1 -pady 1
404 text .info.text -height 40 -width 100 -wrap word -background white\
405 -xscrollcommand ".info.xscroll set" \
406 -yscrollcommand ".info.yscroll set" \
407 -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
408 scrollbar .info.xscroll -command ".info.text xview" \
409 -highlightthickness 0 -orient horizontal
410 scrollbar .info.yscroll -command ".info.text yview" \
411 -highlightthickness 0 -orient vertical
412
413 grid .info.text -in .info.frame -padx 1 -pady 1 \
414 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
415 grid .info.yscroll -in .info.frame -padx 1 -pady 1 \
416 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
417 grid rowconfig .info.frame 0 -weight 1 -minsize 0
418 grid columnconfig .info.frame 0 -weight 1 -minsize 0
419 } else {
420 wm deiconify .info
421 raise .info
422 }
423 set filename [file tail $filename]
424 wm title .info $filename
425 wm iconname .info $filename
426 # puts "$Bsoft/bin/bhead -verbose 7 -info $imgdir/$filename"
427 catch { exec $Bsoft/bin/bhead -verbose 7 -info $imgdir/$filename} theinfo
428 .info.text delete 1.0 end
429 .info.text insert 1.0 $theinfo
430 .info.text mark set insert 1.0
431 }
432
433 ## @brief Writes the current canvas to a postscript file.
434 #
435
436 proc writePostScript { } {
437 global theimg
438 global imgdir
439 global filename
440 set currdir $imgdir
441 if { [string length $currdir] < 2 } { set currdir [pwd]}
442 # puts "Image directory: $imgdir"
443 set init_filename [file rootname $filename]
444 append init_filename .ps
445 set ps_filename [tk_getSaveFile -filetypes {{"PostScript" {.ps .PS} }} \
446 -initialfile $init_filename -initialdir $currdir -defaultextension .ps]
447 if { [string length $ps_filename] < 1 } { return}
448 set c [getImageCanvas $theimg]
449 set wc [getControlWindow $theimg]
450 set scale [$wc.scale.scale get]
451 set w [expr [Bimage get $theimg width] * $scale]
452 set h [expr [Bimage get $theimg height] * $scale]
453 $c postscript -file $ps_filename -pageanchor sw -x 0 -y 0 -width $w -height $h
454 # tk_messageBox -icon info -type ok -title "Directory and file name" -message \
455 # "$imgdir $filename"
456 }
457
458