scripts/splash.itk

   1 # vim: foldmarker=<<<,>>>
   2
   3 proc tlc::splash {pathName args} {
   4         uplevel tlc::Splash $pathName $args
   5 }
   6
   7
   8 class tlc::Splash {
   9         inherit tlc::Module
  10
  11         constructor {args} {}
  12         destructor {}
  13
  14         public {
  15                 variable splashfile             ""      rerender
  16
  17                 method progress {{int {}} {msg {}}}
  18         }
  19
  20         private {
  21                 variable general
  22                 variable bar
  23                 variable text
  24                 variable progress       0
  25
  26                 method parsefile {filename}
  27                 method rerender {}
  28         }
  29 }
  30
  31
  32 body tlc::Splash::constructor {args} { #<<<1
  33         array set general       {}
  34
  35         option add *$wdb*Tile   ""
  36
  37         eval itk_initialize $args
  38 }
  39
  40
  41 body tlc::Splash::destructor {} { #<<<1
  42         catch {image delete $general(image)}
  43 }
  44
  45
  46 body tlc::Splash::progress {{int {}} {msg {}}} { #<<<1
  47         if {$int == ""} {
  48                 return $progress
  49         }
  50         set range       [expr {$bar(x2) - $bar(x1)}]
  51         set sofar       [expr {double($range) * $int/100.0}]
  52         $w.splash coords bar \
  53                 $bar(x1) $bar(y1) \
  54                 [expr {$bar(x1) + $sofar}] $bar(y2)
  55         $w.splash itemconfigure text -text $msg
  56         set progress    $int
  57
  58         update
  59 }
  60
  61
  62 body tlc::Splash::parsefile {filename} { #<<<1
  63         set dirname             [file dirname $filename]
  64         set fp                  [open $filename r]
  65         set dat                 [read -nonewline $fp]
  66         close $fp
  67
  68         if {[catch {array set info      $dat} err]} {
  69                 usererror "Error parsing splash screen file: ($filename)\n$err"
  70         }
  71
  72         set reqfields   {image bar}
  73         foreach reqfield {image bar} {
  74                 if {![info exists info($reqfield)]} {
  75                         usererror "Error parsing splash screen file: ($filename)\nMust have at least ($reqfields) defined"
  76                 }
  77         }
  78         set general(imagefile)  $info(image)
  79         set bar(x1)                             [lindex $info(bar) 0]
  80         set bar(y1)                             [lindex $info(bar) 1]
  81         set bar(x2)                             [lindex $info(bar) 2]
  82         set bar(y2)                             [lindex $info(bar) 3]
  83
  84         # Defaults for optional params
  85         set general(bg)                         $::cfg(background)
  86         set general(borderwidth)        4
  87         set general(relief)                     raised
  88         set bar(colour) "blue"
  89         set text(x)                     [expr {($bar(x2) - $bar(x1)) / 2.0 + $bar(x1)}]
  90         set text(y)                     [expr {($bar(y2) - $bar(y1)) / 2.0 + $bar(y1)}]
  91         set text(anchor)        "center"
  92         set text(colour)        "black"
  93         set text(font)          $tlc::config(normalfont)
  94
  95         # Optional params (should have reasonable defaults set above
  96         if {[info exists info(background)]}     {set general(bg)        $info(background)}
  97         if {[info exists info(borderwidth)]}    {set general(borderwidth)       $info(borderwidth)}
  98         if {[info exists info(relief)]}         {set general(relief)    $info(relief)}
  99         if {[info exists info(bar_colour)]} {set bar(colour)    $info(bar_colour)}
 100         if {[info exists info(text)]}           {
 101                 set text(x)             [lindex $info(text) 0]
 102                 set text(y)             [lindex $info(text) 1]
 103         }
 104         if {[info exists info(text_anchor)]} {set text(anchor)  $info(text_anchor)}
 105         if {[info exists info(text_colour)]} {set text(colour)  $info(text_colour)}
 106         if {[info exists info(text_font)]}       {set text(font)        $info(text_font)}
 107         if {[string tolower $text(font)] == "bold"} {
 108                 set text(font)  $tlc::config(boldfont)
 109         }
 110
 111         set general(imagefile)  [file join $dirname $general(imagefile)]
 112         set general(image)              [image create photo -file $general(imagefile)]
 113 }
 114
 115
 116 body tlc::Splash::rerender {} { #<<<1
 117         if {$splashfile == ""} return
 118
 119         catch {eval destroy [winfo children $w]}
 120
 121         parsefile $splashfile
 122
 123         canvas $w.splash \
 124                         -borderwidth $general(borderwidth) \
 125                         -relief $general(relief) \
 126                         -highlightthickness 0 \
 127                         -width [image width $general(image)] \
 128                         -height [image height $general(image)] \
 129                         -background $general(bg)
 130
 131         $w.splash create image 0 0 -anchor nw -image $general(image)
 132
 133         $w.splash create rectangle \
 134                 $bar(x1) $bar(y1) \
 135                 $bar(x1) $bar(y2) \
 136                 -outline $bar(colour) \
 137                 -fill $bar(colour) -tags bar
 138
 139         $w.splash create text \
 140                 $text(x) $text(y) \
 141                 -anchor $text(anchor) -fill $text(colour) -font $text(font) -tags text
 142
 143         $w.splash yview moveto 0.0
 144         $w.splash xview moveto 0.0
 145
 146         table $w \
 147                 $w.splash       1,1 -fill both
 148
 149         table configure $w r1 c1 -resize none
 150
 151         if {$general(bg) != ""} {
 152                 configure -background $general(bg)
 153         }
 154
 155         wm overrideredirect $w 1
 156         center_on_screen
 157 }
 158
 159