![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to uae-ui.tk CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [UNIX Amiga Emulator] / uae|
Return to uae-ui.tk CVS log | Up to [UNIX Amiga Emulator] / uae |
1.1 root 1:
2: set Program(Name) "UAE"
3: set Program(Version) "0.4"
4:
5: wm title . "$Program(Name)"
6: wm iconname . $Program(Name)
7: wm grid . 1 1 1 1
8:
9: proc Bye {} {
10: global outpipe
11: puts $outpipe "bye"
12: flush $outpipe
13: close $outpipe
14: exit
15: }
16:
17: proc Eject {num} {
18: global outpipe
19: puts $outpipe "eject"
20: puts $outpipe "$num"
21: flush $outpipe
22: }
23:
24: proc Nuke {} {
25: global outpipe
26: puts $outpipe "reset"
27: flush $outpipe
28: }
29:
30: proc Dbug {} {
31: global outpipe
32: puts $outpipe "debug"
33: flush $outpipe
34: }
35:
36: proc FilenameDialog {w title label} {
37: global win
38: global oldFocus
39: global ReturnValue
40:
41: set win $w
42: catch {destroy $win}
43: toplevel $win -class Dialog
44: wm title $win $title
45: frame $win.top -relief raised -bd 1
46: pack $win.top -side top -fill both
47: frame $win.bot -relief raised -bd 1
48: pack $win.bot -side bottom -fill both
49:
50: message $win.top.message -text $label \
51: -width 3i -justify left
52:
53: entry $win.top.entry -width 20 -relief sunken
54: $win.top.entry icursor 0
55: bind $win.top.entry <Return> {
56: set ReturnValue [$win.top.entry get]
57: catch {focus $oldFocus}
58: destroy $win
59: }
60:
61: ## Create the OK and Cancel button field
62: frame $win.bot.buttons
63: button $win.bot.buttons.ok -text "Okay" \
64: -command { set ReturnValue [$win.top.entry get]
65: catch {focus $oldFocus}
66: destroy $win
67: }
68: button $win.bot.buttons.cancel -text "Cancel" \
69: -command { set ReturnValue "";
70: catch {focus $oldFocus}
71: destroy $win
72: }
73: pack $win.bot.buttons.ok -side left -expand 1 -padx 3m -pady 2m
74: pack $win.bot.buttons.cancel -side right -expand 1 -padx 3m -pady 2m
75:
76: pack $win.top.message -side top -fill x -pady 4 -padx 4
77: pack $win.top.entry -side top -fill x -pady 4 -padx 4
78: pack $win.bot.buttons -side top -fill x -pady 4
79:
80: set oldFocus [focus]
81: grab $w
82: tkwait visibility $win
83: focus $win.top.entry
84: tkwait window $win
85: return $ReturnValue
86: }
87:
88:
89: proc Insert {num} {
90: global outpipe
91: global inpipe
92: puts $outpipe "insert"
93: puts $outpipe "$num"
94: flush $outpipe
95: set isok [gets $inpipe]
96: if {[string compare $isok "ok"] == 0} {
97: set filename [FilenameDialog .foo "Select file" "Select a diskfile for drive $num"]
98: puts $outpipe $filename
99: flush $outpipe
100: } else {
101: tk_dialog .foo {Error} {Drive is not empty. Use Eject first.} {} 0 OK
102: }
103:
104: }
105:
106: proc readdata {} {
107: global inpipe
108: global file0
109: global file1
110: global file2
111: global file3
112:
113: set command [gets $inpipe]
114: if {[string compare $command "power 0"] == 0} {
115: .brs.powerled config -bg #000000000000
116: } elseif {[string compare $command "power 1"] == 0} {
117: .brs.powerled config -bg #ffff00000000
118: } elseif {[string compare $command "driveled 1"] == 0} {
119: set command [gets $inpipe]
120: .drives.x$command.led config -bg #ffffffff0000
121: } elseif {[string compare $command "driveled 0"] == 0} {
122: set command [gets $inpipe]
123: .drives.x$command.led config -bg #000000000000
124: } elseif {[string compare $command "drivename"] == 0} {
125: set number [gets $inpipe]
126: set file$number [gets $inpipe]
127: }
128: }
129:
130: proc OpenPipes {} {
131: global env
132: global outpipe
133: global inpipe
134: set args $env(ARGS)
135:
136: if {[llength $args] != 2} {
137: exit
138: }
139: set outpipe [open [lindex $args 0] "w"]
140: set inpipe [open [lindex $args 1] "r"]
141: puts $outpipe "Startup"
142: flush $outpipe
143: }
144:
145: frame .drives -relief raised -borderwidth 2
146: label .drives.title -text "Floppy drives"
147: frame .drives.x3 -relief sunken -borderwidth 2
148: label .drives.x3.name -text "DF3:"
149: frame .drives.x3.f
150: label .drives.x3.f.file -width 30 -textvariable file3
151: button .drives.x3.eject -text "Eject" -command {Eject 3}
152: button .drives.x3.insert -text "Insert" -command {Insert 3}
153: frame .drives.x3.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
154: pack .drives.x3 -side bottom -expand yes -fill both
155: pack .drives.x3.name -side left
156: pack .drives.x3.f -side left
157: pack .drives.x3.f.file -side left
158: pack .drives.x3.eject -side left
159: pack .drives.x3.insert -side left
160: pack .drives.x3.led -side left
161:
162: frame .drives.x2 -relief sunken -borderwidth 2
163: label .drives.x2.name -text "DF2:"
164: frame .drives.x2.f
165: label .drives.x2.f.file -width 30 -textvariable file2
166: button .drives.x2.eject -text "Eject" -command {Eject 2}
167: button .drives.x2.insert -text "Insert" -command {Insert 2}
168: frame .drives.x2.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
169: pack .drives.x2 -side bottom -expand yes -fill both
170: pack .drives.x2.name -side left
171: pack .drives.x2.f -side left
172: pack .drives.x2.f.file -side left
173: pack .drives.x2.eject -side left
174: pack .drives.x2.insert -side left
175: pack .drives.x2.led -side left
176:
177: frame .drives.x1 -relief sunken -borderwidth 2
178: label .drives.x1.name -text "DF1:"
179: frame .drives.x1.f
180: label .drives.x1.f.file -width 30 -textvariable file1
181: button .drives.x1.eject -text "Eject" -command {Eject 1}
182: button .drives.x1.insert -text "Insert" -command {Insert 1}
183: frame .drives.x1.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
184: pack .drives.x1 -side bottom -expand yes -fill both
185: pack .drives.x1.name -side left
186: pack .drives.x1.f -side left
187: pack .drives.x1.f.file -side left
188: pack .drives.x1.eject -side left
189: pack .drives.x1.insert -side left
190: pack .drives.x1.led -side left
191:
192: frame .drives.x0 -relief sunken -borderwidth 2
193: label .drives.x0.name -text "DF0:"
194: frame .drives.x0.f
195: label .drives.x0.f.file -width 30 -textvariable file0
196: button .drives.x0.eject -text "Eject" -command {Eject 0}
197: button .drives.x0.insert -text "Insert" -command {Insert 0}
198: frame .drives.x0.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
199: pack .drives.x0 -side bottom -expand yes -fill both
200: pack .drives.x0.name -side left
201: pack .drives.x0.f -side left
202: pack .drives.x0.f.file -side left
203: pack .drives.x0.eject -side left
204: pack .drives.x0.insert -side left
205: pack .drives.x0.led -side left
206:
207: pack .drives.title -side top
208:
209: frame .brs -relief raised -borderwidth 2
210: label .brs.title -text "Emulator control"
211: frame .brs.powerled -width 1c -height .3c -relief groove -borderwidth 2 -background #ffff00000000
212: button .brs.reset -text "Hard reset" -command { Nuke }
213: button .brs.debug -text "Debug" -command { Dbug }
214: button .brs.quit -text "Exit" -command { Bye }
215: pack .brs.title -side top
216: pack .brs.reset -side left
217: pack .brs.debug -side left
218: pack .brs.quit -side left
219: pack .brs.powerled -side right
220:
221: pack .drives -side bottom -fill x
222: pack .brs -side bottom -fill x
223: .brs.powerled config -bg #000000000000
224: OpenPipes
225: fileevent $inpipe readable {readdata}
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.