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