1# Copyright (C) 1987-2015 by Jeffery P. Hansen 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License along 14# with this program; if not, write to the Free Software Foundation, Inc., 15# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 16# 17# Last edit by hansen on Fri Feb 13 20:46:38 2009 18# 19 20set runlogo_state -1 21set runlogo_speed 50 22set runlogo_startstate 27 23set runlogo_maxstate 50 24 25proc updateStatus args { 26 global tkg_displayFile tkg_currentModule tkg_modifiedFlag tkg_statusMessage 27 global tkg_progName tkg_progVer 28 29 if { $tkg_modifiedFlag } { 30 set mod "*" 31 } else { 32 set mod "" 33 } 34 35 .status.file configure -text "[m ifile]: $tkg_displayFile$mod" 36 .status.block configure -text "[m imodule]: $tkg_currentModule" 37 .status.msg configure -text "$tkg_statusMessage" -anchor w 38 39 wm title . "$tkg_displayFile$mod - $tkg_progName $tkg_progVer" 40 41} 42 43proc tkg_resetLogo {} { 44 global bd runlogo_state runlogo_startstate logo_w 45 46 catch { 47 $logo_w configure -image "" -image [gifI [format "run%02d.gif" $runlogo_startstate]] 48 set runlogo_state $runlogo_startstate 49 } 50} 51 52proc tkg_pauseLogo {} { 53 global bd runlogo_ev 54 55 catch { after cancel $runlogo_ev } 56} 57 58proc tkg_stepLogo {} { 59 global bd runlogo_state runlogo_speed runlogo_ev runlogo_maxstate logo_w 60 61 catch { 62 set filename [format "run%02d.gif" ${runlogo_state}] 63 $logo_w configure -image "" -image [gifI "$filename"] 64 set runlogo_state [expr $runlogo_state + 1 ] 65 if { $runlogo_state > $runlogo_maxstate } { 66 set runlogo_state 1 67 } 68 } 69} 70 71proc tkg_stepRunLogo {} { 72 global bd runlogo_state runlogo_speed runlogo_ev runlogo_maxstate logo_w 73 74 catch { 75 set filename [format "run%02d.gif" ${runlogo_state}] 76 $logo_w configure -image "" -image [gifI "$filename"] 77 set runlogo_state [expr $runlogo_state + 1 ] 78 if { $runlogo_state > $runlogo_maxstate } { 79 set runlogo_state 1 80 } 81 set runlogo_ev [after $runlogo_speed tkg_stepRunLogo] 82 } 83} 84 85proc tkg_runLogo {} { 86 global bd runlogo_speed runlogo_ev 87 88 89 catch { 90 catch { after cancel $runlogo_ev } 91 set runlogo_ev [after $runlogo_speed tkg_stepRunLogo] 92 } 93} 94 95proc tkg_editLogo {} { 96 global bd runlogo_ev logo_w 97 98 catch { 99 catch { after cancel $runlogo_ev } 100 $logo_w configure -image [gifI "gatelogo.gif"] 101 } 102} 103 104proc tkg_analysisLogo {} { 105 global bd runlogo_ev logo_w 106 107 catch { 108 catch { after cancel $runlogo_ev } 109 $logo_w configure -image [gifI "anallogo.gif"] 110 } 111} 112 113proc tkg_checkpointReq {} { 114 global tkg_wantCheckpoint tkg_checkpointEnabled tkg_checkpointFreq 115 116 if { $tkg_checkpointEnabled } { 117 set tkg_wantCheckpoint 1 118 } 119 after [expr $tkg_checkpointFreq * 1000] tkg_checkpointReq 120} 121 122############################################################################# 123# 124# Add or remove the simulation time window 125# 126proc updateSimTimeWin {w args} { 127 global simOn 128 129 if {$simOn} { 130 pack $w.simtime -side right -padx 3 -pady 3 -ipadx 2 -ipady 2 131 } else { 132 pack forget $w.simtime 133 } 134} 135 136proc makeStatus {w} { 137 global tkg_displayFile tkg_currentModule tkg_modifiedFlag tkg_statusMessage 138 global simOn currentSimTime 139 140 label $w.file -relief sunken -bg "\#ffbbbb" -width 30 -height 1 -justify left -anchor w 141 label $w.block -relief sunken -bg "\#ffbbbb" -width 25 -height 1 -justify left -anchor w 142 label $w.msg -relief sunken -bg "\#ffbbbb" -height 1 143 label $w.simtime -relief sunken -bg "\#ffbbbb" -height 1 -width 15 -textvariable ::currentSimTime -anchor w 144 145 pack $w.file -side left -padx 3 -pady 3 -ipadx 2 -ipady 2 -anchor w 146 pack $w.block -side left -padx 3 -pady 3 -ipadx 2 -ipady 2 -anchor w 147 pack $w.msg -side left -padx 3 -pady 3 -ipadx 2 -ipady 2 -fill x -expand 1 148 149 updateStatus 150 151 trace variable tkg_displayFile w updateStatus 152 trace variable tkg_currentModule w updateStatus 153 trace variable tkg_modifiedFlag w updateStatus 154 trace variable tkg_statusMessage w updateStatus 155 trace variable simOn w "updateSimTimeWin $w" 156 157 helpon $w.msg [m ho.status.msg] 158 helpon $w.block [m ho.status.block] 159 helpon $w.file [m ho.status.file] 160} 161 162proc tkg_cancel {} { 163 global tkg_statusMessage 164 set tkg_statusMessage "" 165 updateStatus 166} 167