← Back to branch summary

~ubuntu-branches/ubuntu/hoary/scilab/hoary

« back to all changes in this revision

Viewing changes to tcl/sciGUI/sciGUI.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2005-01-09 22:58:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20050109225821-473xr8vhgugxxx5j
Tags: 3.0-12
http://bugs.debian.org/255869
changed configure.in to build scilab's own malloc.o, closes: #255869

Show diffs side-by-side

added added

removed removed

Lines of Context:
tcl/sciGUI/sciGUI.tcl
 
1
# sciGUI.tcl
 
2
# Main TK/TCL
 
3
# This file is part of sciGUI toolbox
 
4
# Copyright (C) 2004 Jaime Urzua Grez
 
5
# mailto:jaime_urzua@yahoo.com
 
6
# rev. 0.1 - 2004/06/13
 
7
 
 
8
# ----------------------------------------------------------------------------
 
9
# Initial declarations and global variables
 
10
# ----------------------------------------------------------------------------
 
11
global sciGUITable
 
12
global tcl_platform
 
13
 
 
14
 
 
15
# ----------------------------------------------------------------------------
 
16
# Function    : sciGUIGenFileName
 
17
# Parameters  : 
 
18
# Description : Return an incremental filename
 
19
# ----------------------------------------------------------------------------
 
20
proc sciGUIGenFileName { } {
 
21
        global sciGUITable
 
22
        incr sciGUITable(internal,gname)
 
23
        return "sciGUI_$sciGUITable(internal,gname).txt"
 
24
}
 
25
 
 
26
 
 
27
# ----------------------------------------------------------------------------
 
28
# Function    : sciGUILoadExtra
 
29
# Parameters  : 
 
30
# Description : Load external libs
 
31
# ----------------------------------------------------------------------------
 
32
proc sciGUILoadExtra { } {
 
33
        global sciGUITable
 
34
        global tcl_platform
 
35
        global auto_path
 
36
        set ff [file join $sciGUITable(internal,path) "tcl" "sciGUI" "local_extra"]
 
37
        # The html reader
 
38
        source [file join $ff "HelpSystem-1.5" "help.tcl"]
 
39
        # Balloonn help
 
40
        source [file join $ff "balloonhelp.tcl"]
 
41
        # Notebook
 
42
        source [file join $ff "rnotebook.tcl"]
 
43
        # Spin button
 
44
        source [file join $ff "spinbutton.tcl"]
 
45
        # Combo Box
 
46
        source [file join $ff "combobox-2.3" "combobox.tcl"]
 
47
}
 
48
 
 
49
 
 
50
# ----------------------------------------------------------------------------
 
51
# Function    : sciGUIDOInit
 
52
# Parameters  : path
 
53
# Description : Initialice Tk/Tcl sciGUI core
 
54
# ----------------------------------------------------------------------------
 
55
proc sciGUIDoInit { {path ""} } {
 
56
        global sciGUITable
 
57
        global tcl_platform
 
58
        set sciGUITable(internal,gname) 0
 
59
        set sciGUITable(internal,path) $path
 
60
        set sciGUITable(win,id) 0
 
61
        set sciGUITable(win,0,type) "null"
 
62
        set sciGUITable(icon,name) ""
 
63
        set sciGUITable(font,1) {-*-helvetica-bold-r-*-*-24}
 
64
        set sciGUITable(font,2) {-*-helvetica-normal-r-*-*-10}
 
65
        sciGUIIconLoad
 
66
        sciGUIGifLoad
 
67
        sciGUILoadExtra
 
68
        return 1
 
69
}
 
70
 
 
71
# ----------------------------------------------------------------------------
 
72
# Function    : sciGUIGetType
 
73
# Parameters  : winId
 
74
# Description : Return type of window
 
75
# ----------------------------------------------------------------------------
 
76
proc sciGUIGetType { winId } {
 
77
        global sciGUITable
 
78
        set pos [lsearch $sciGUITable(win,id) $winId]
 
79
        set rt ""
 
80
        if {$pos!=-1} {
 
81
                set rt "$sciGUITable(win,$winId,type)"
 
82
        }
 
83
        return $rt      
 
84
}
 
85
 
 
86
 
 
87
# ----------------------------------------------------------------------------
 
88
# Function    : sciGUIName
 
89
# Parameters  : winId
 
90
# Description : Return window name
 
91
# ----------------------------------------------------------------------------
 
92
proc sciGUIName { winId } {     
 
93
        return ".sciGUIwin$winId"
 
94
}
 
95
 
 
96
 
 
97
# ----------------------------------------------------------------------------
 
98
# Function    : sciGUIDestroy
 
99
# Parameters  : winId
 
100
# Description : Destroy window and basic information asociated
 
101
# ----------------------------------------------------------------------------
 
102
proc sciGUIDestroy { winId } {
 
103
        global sciGUITable
 
104
        if { [sciGUIExist $winId]==1 } {
 
105
                destroy [sciGUIName $winId]
 
106
                set ind [lsearch $sciGUITable(win,id) $winId]
 
107
                set sciGUITable(win,id) [lreplace $sciGUITable(win,id) $ind $ind]
 
108
                unset sciGUITable(win,$winId,type)
 
109
                unset sciGUITable(win,$winId,data)                      
 
110
        }
 
111
        return $winId
 
112
}
 
113
 
 
114
 
 
115
# ----------------------------------------------------------------------------
 
116
# Function    : sciGUICreate
 
117
# Parameters  : winId type wdestroy
 
118
# Description : Create windows
 
119
# ----------------------------------------------------------------------------
 
120
proc sciGUICreate { {winId -1} {type "none"} } {
 
121
        global sciGUITable
 
122
        set winId2 $winId
 
123
        if { $winId == -1 } {
 
124
                set winId2 [lindex $sciGUITable(win,id) end]
 
125
                set pass 1
 
126
                while { $pass==1 } {
 
127
                        set pass [sciGUIExist $winId2]
 
128
                        if { $pass==1 } { incr winId2 }
 
129
                }
 
130
        }
 
131
        set wname [sciGUIName $winId2]
 
132
        catch { destroy $wname }
 
133
        toplevel $wname
 
134
        wm title $wname ""      
 
135
        lappend sciGUITable(win,id) $winId2
 
136
        set sciGUITable(win,$winId2,type) $type
 
137
        set sciGUITable(win,$winId2,data) ""
 
138
        return $winId2
 
139
}
 
140
 
 
141
 
 
142
# ----------------------------------------------------------------------------
 
143
# Function    : sciGUIExist
 
144
# Parameters  : winId
 
145
# Description : Retur 1 if window exist, else 0
 
146
# ----------------------------------------------------------------------------
 
147
proc sciGUIExist { winId } {
 
148
        global sciGUITable
 
149
        set exist [lsearch $sciGUITable(win,id) $winId]
 
150
        set output 0
 
151
        if { $exist > -1 } { set output 1 }
 
152
        return $output
 
153
}
 
154
 
 
155
 
 
156
# ----------------------------------------------------------------------------
 
157
# Function    : sciGUIGifLoad
 
158
# Parameters  : 
 
159
# Description : Load initial gif files
 
160
# ----------------------------------------------------------------------------
 
161
proc sciGUIGifLoad { } {
 
162
        global sciGUITable
 
163
        set fid [open [file join $sciGUITable(internal,path) "tcl" "sciGUI" "data" "giftable.txt"] r]
 
164
        while { [eof $fid]==0 } {
 
165
                gets $fid lineRead
 
166
                set lineRead [string trimleft $lineRead]
 
167
                set li [string first ":" "$lineRead"]
 
168
                if { $li>-1 } {
 
169
                        #set pos [llength $sciGUITable(icon,name)]
 
170
                        set nam [string range "$lineRead" 0 [expr $li-1]]
 
171
                        set lfile [string range "$lineRead" [expr $li+1] end]
 
172
                        if { [string first "#" "$nam"] < 0 } {
 
173
                                set filename [file join $sciGUITable(internal,path) "tcl" "sciGUI" "data" $lfile]
 
174
                                image create photo sciGUITable(gif,$nam) -file $filename
 
175
                        }                       
 
176
                }       
 
177
                
 
178
        }
 
179
        close $fid
 
180
}
 
181
 
 
182
 
 
183
# ----------------------------------------------------------------------------
 
184
# Function    : sciGUIIconLoad
 
185
# Parameters  : 
 
186
# Description : Load initial icons
 
187
# ----------------------------------------------------------------------------
 
188
proc sciGUIIconLoad { } { 
 
189
        global sciGUITable
 
190
        set fid [open [file join $sciGUITable(internal,path) "tcl" "sciGUI" "data" "icontable.txt"] r]
 
191
        while { [eof $fid]==0 } {
 
192
                gets $fid lineRead
 
193
                set lineRead [string trimleft $lineRead]
 
194
                set li [string first ":" "$lineRead"]
 
195
                if { $li>-1 } {
 
196
                        set pos [llength $sciGUITable(icon,name)]
 
197
                        set nam [string range "$lineRead" 0 [expr $li-1]]
 
198
                        lappend sciGUITable(icon,name) $nam
 
199
                        set sciGUITable(icon,$pos) [string range "$lineRead" [expr $li+1] end]
 
200
                        image create photo sciGUITable(icon,$nam) -data $sciGUITable(icon,$pos)
 
201
                }       
 
202
        }
 
203
        close $fid
 
204
}
 
205
 
 
206