00001 # Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> 00002 # 00003 # This file is free software; as a special exception the author gives 00004 # unlimited permission to copy and/or distribute it, with or without 00005 # modifications, as long as this notice is preserved. 00006 # 00007 # This program is distributed in the hope that it will be useful, but 00008 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the 00009 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00010 00011 ## ---------------------------------------------------------------------------- 00012 ## StartUp - startup-screen 00013 ## 00014 ## \author Dietmar Fünning, Michael Daum 00015 ## $Id: startup.tcl,v 1.7 2004/10/11 15:23:31 micha Exp $ 00016 ## ---------------------------------------------------------------------------- 00017 class StartUp { 00018 inherit ::itk::Toplevel 00019 00020 itk_option define -height height Height 798 00021 itk_option define -width width Width 599 00022 00023 # public 00024 public method step {n}; ## \type TclNumber 00025 00026 destructor {} 00027 constructor {args} {}; ## \type TclList 00028 00029 # private 00030 private method _drawScreen {} 00031 00032 private variable _picture; ## \type TclCommand 00033 private variable _red 4095 00034 private variable _green 0 00035 private variable _progress 0 00036 private variable _oldProgress 0 00037 private variable _ratio 0 00038 private variable _percent "0%" 00039 private variable _stepTimer 0 00040 private variable _totalTimer 0 00041 }; 00042 00043 ##----------------------------------------------------------------------------- 00044 ## destructor 00045 ##----------------------------------------------------------------------------- 00046 body StartUp::destructor {} { 00047 00048 set now [clock clicks] 00049 set duration [expr ($now - $_totalTimer) / 1000.0] 00050 # puts "PROFILE: total startup $duration ms" 00051 00052 image delete $_picture 00053 } 00054 00055 ## ---------------------------------------------------------------------------- 00056 ## constructor 00057 ## ---------------------------------------------------------------------------- 00058 body StartUp::constructor {args} { 00059 00060 global env 00061 00062 set _picture [image create photo $this.picture -file $env(XCDG_LIB)/xcdglogo.gif] 00063 00064 itk_component add canvas { 00065 canvas $itk_interior.canvas -background white 00066 } {} 00067 00068 pack $itk_component(canvas) \ 00069 -fill both \ 00070 -expand 1 00071 00072 eval itk_initialize $args 00073 00074 set wd [winfo screenwidth $itk_component(hull)] 00075 set ht [winfo screenheight $itk_component(hull)] 00076 set rwd $itk_option(-height) 00077 set rht $itk_option(-width) 00078 set x [expr ($wd - $rwd) / 2 ] 00079 set y [expr ($ht - $rht) / 2 ] 00080 wm geometry $itk_component(hull) "+$x+$y" 00081 00082 _drawScreen 00083 update idletask 00084 00085 set _stepTimer [clock clicks] 00086 set _totalTimer $_stepTimer 00087 } 00088 00089 ##----------------------------------------------------------------------------- 00090 ## option -height. 00091 ## set the overall height of the application 00092 ##----------------------------------------------------------------------------- 00093 configbody StartUp::height { 00094 wm geometry $itk_component(hull) \ 00095 $itk_option(-height)x$itk_option(-width) 00096 } 00097 00098 ##----------------------------------------------------------------------------- 00099 ## option -width. 00100 ## set the overall width of the application 00101 ##----------------------------------------------------------------------------- 00102 configbody StartUp::width { 00103 wm geometry $itk_component(hull) \ 00104 $itk_option(-height)x$itk_option(-width) 00105 } 00106 00107 ##----------------------------------------------------------------------------- 00108 ## well, draw the opening screen 00109 ##----------------------------------------------------------------------------- 00110 body StartUp::_drawScreen {} { 00111 00112 set cv $itk_component(canvas) 00113 set height $itk_option(-height) 00114 set width $itk_option(-width) 00115 set midPos [expr $width / 2.0 + 85] 00116 00117 $cv create image -11 -11 -image $_picture -anchor nw 00118 00119 set x1 [expr $midPos - 260] 00120 set y1 [expr $height / 2.0 -150 - 7] 00121 set x2 [expr $midPos + 280] 00122 set y2 [expr $height / 2.0 -150 + 7] 00123 set _ratio [expr ($x2 - $x1) / 100.0] 00124 00125 $cv create rect $x1 $y1 $x2 $y2 -fill gray60 \ 00126 -tag feedyBackground 00127 $cv create rect $x1 $y1 $x1 $y2 \ 00128 -fill red \ 00129 -tag feedyForeground 00130 00131 set midPos [expr $midPos + 7] 00132 $cv create text $midPos 320 -text $_percent \ 00133 -font *times-medium-r-*-*-18* -tag Percent 00134 } 00135 00136 ##----------------------------------------------------------------------------- 00137 ## update and display progress 00138 ##----------------------------------------------------------------------------- 00139 body StartUp::step { n } { 00140 set cv $itk_component(canvas) 00141 set _progress $n 00142 00143 set bbox [$cv coords feedyForeground] 00144 scan $bbox "%f %f %f %f" x1 y1 x2 y2 00145 00146 set i $_oldProgress 00147 while { $i < $_progress } { 00148 incr i 00149 set _red [expr $_red - 18] 00150 set _green [expr $_green + 40] 00151 set color [format "#%03x%03x%03x" $_red $_green 1100 ] 00152 $cv coords feedyForeground $x1 $y1 [expr $x1 + $i * $_ratio] $y2 00153 $cv itemconfigure feedyForeground -fill $color 00154 $cv itemconfigure Percent -text [format "%3d%%" $i] 00155 update idletask 00156 } 00157 set _oldProgress $_progress 00158 00159 00160 set now [clock clicks] 00161 set duration [expr ($now - $_stepTimer) / 1000.0] 00162 00163 00164 # puts "PROFILE: step $n after $duration ms ([expr ($duration / 2729.726) * 100] %)" 00165 } 00166 00167