![[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.1.2 ! root 1: set Program(Name) "UAE Control" ! 2: set Program(Version) "0.6.8" 1.1 root 3: 4: 5: wm title . "$Program(Name)" 1.1.1.2 ! root 6: wm iconname . "$Program(Name)" 1.1 root 7: wm grid . 1 1 1 1 8: 1.1.1.2 ! root 9: set amiga [image create bitmap -data "#define amiga_width 60 ! 10: #define amiga_height 24 ! 11: static unsigned char amiga_bits[] = { ! 12: 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, ! 13: 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x0f, 0x00, 0x00, 0x00, ! 14: 0x00, 0x00, 0x00, 0xc0, 0x0f, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xe1, ! 15: 0xcf, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xff, 0xf0, 0xcf, 0xff, 0xff, 0x01, ! 16: 0x00, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xbc, ! 17: 0x0f, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x3f, 0x9e, 0xcf, 0xff, 0xff, 0x01, ! 18: 0xf8, 0xff, 0x1f, 0x8f, 0xcf, 0xff, 0xff, 0x01, 0x00, 0x00, 0x80, 0x87, ! 19: 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x83, 0x0f, 0x00, 0x00, 0x00, ! 20: 0xf8, 0xff, 0xe3, 0x81, 0xcf, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xf1, 0x80, ! 21: 0xcf, 0xff, 0xff, 0x01, 0x00, 0x00, 0x78, 0x80, 0x0f, 0x00, 0x00, 0x00, ! 22: 0x00, 0x00, 0xfc, 0xff, 0x0f, 0x00, 0x00, 0x00, 0xf8, 0x3f, 0xfe, 0xff, ! 23: 0xcf, 0xff, 0xff, 0x01, 0xf8, 0x1f, 0xff, 0xff, 0xcf, 0xff, 0xff, 0x01, ! 24: 0x00, 0x80, 0x07, 0x80, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x80, ! 25: 0x0f, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x80, 0x0f, 0x00, 0x00, 0x00, ! 26: 0x00, 0xf8, 0x07, 0xc0, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xc0, ! 27: 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, ! 28: };"] ! 29: ! 30: set tip [image create bitmap -data "#define tip_width 44 ! 31: #define tip_height 16 ! 32: static unsigned char tip_bits[] = { ! 33: 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, ! 34: 0x00, 0x00, 0x00, 0xc0, 0xf3, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x79, 0x00, ! 35: 0x00, 0x00, 0x00, 0xf0, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x78, 0x1e, 0x00, ! 36: 0x00, 0x00, 0x00, 0x3c, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x9e, 0x07, 0x00, ! 37: 0x00, 0x1c, 0x07, 0xcf, 0x03, 0x00, 0x00, 0x3c, 0x8f, 0xe7, 0x01, 0x00, ! 38: 0x00, 0x78, 0xde, 0xf3, 0x00, 0x00, 0x00, 0xf0, 0xfc, 0x79, 0x00, 0x00, ! 39: 0x00, 0xe0, 0xf9, 0x3c, 0x00, 0x00, 0x00, 0xc0, 0x73, 0x1e, 0x00, 0x00, ! 40: 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, ! 41: };"] ! 42: ! 43: ! 44: set disk0 [image create bitmap -data "#define disk0_width 35 ! 45: #define disk0_height 17 ! 46: static unsigned char disk0_bits[] = { ! 47: 0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, ! 48: 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, ! 49: 0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff, ! 50: 0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00, ! 51: 0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80, 0x05, 0x80, 0x07, ! 52: 0x0f, 0x80, 0x05, 0x80, 0x07, 0x0f, 0x80, 0x05, 0x80, 0x07, 0x0f, 0x80, ! 53: 0x05, 0x80, 0x07, 0x09, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80, ! 54: 0x07, };"] ! 55: ! 56: set disk1 [image create bitmap -data "#define disk1_width 35 ! 57: #define disk1_height 17 ! 58: static unsigned char disk1_bits[] = { ! 59: 0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, ! 60: 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, ! 61: 0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff, ! 62: 0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00, ! 63: 0x80, 0x07, 0x0f, 0x00, 0x02, 0x80, 0x07, 0x0f, 0x80, 0x03, 0x80, 0x07, ! 64: 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, ! 65: 0x03, 0x80, 0x07, 0x09, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80, ! 66: 0x07, };"] ! 67: ! 68: set disk2 [image create bitmap -data "#define disk2_width 35 ! 69: #define disk2_height 17 ! 70: static unsigned char disk2_bits[] = { ! 71: 0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, ! 72: 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, ! 73: 0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff, ! 74: 0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00, ! 75: 0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80, 0x06, 0x80, 0x07, ! 76: 0x0f, 0x00, 0x06, 0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80, ! 77: 0x01, 0x80, 0x07, 0x09, 0x80, 0x07, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80, ! 78: 0x07, };"] ! 79: ! 80: set disk3 [image create bitmap -data "#define disk3_width 35 ! 81: #define disk3_height 17 ! 82: static unsigned char disk3_bits[] = { ! 83: 0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, ! 84: 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, ! 85: 0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff, ! 86: 0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00, ! 87: 0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80, 0x06, 0x80, 0x07, ! 88: 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x06, 0x80, 0x07, 0x0f, 0x80, ! 89: 0x06, 0x80, 0x07, 0x09, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80, ! 90: 0x07, };"] ! 91: ! 92: ! 93: 1.1 root 94: proc Bye {} { 95: global outpipe 96: puts $outpipe "bye" 97: flush $outpipe 98: close $outpipe 99: exit 100: } 101: 102: proc Eject {num} { 103: global outpipe 104: puts $outpipe "eject" 105: puts $outpipe "$num" 106: flush $outpipe 107: } 108: 109: proc Nuke {} { 110: global outpipe 111: puts $outpipe "reset" 112: flush $outpipe 113: } 114: 115: proc Dbug {} { 116: global outpipe 117: puts $outpipe "debug" 118: flush $outpipe 119: } 120: 121: 122: proc readdata {} { 123: global inpipe 124: global file0 125: global file1 126: global file2 127: global file3 128: 129: set command [gets $inpipe] 1.1.1.2 ! root 130: 1.1 root 131: if {[string compare $command "power 0"] == 0} { 132: .brs.powerled config -bg #000000000000 133: } elseif {[string compare $command "power 1"] == 0} { 134: .brs.powerled config -bg #ffff00000000 135: } elseif {[string compare $command "driveled 1"] == 0} { 136: set command [gets $inpipe] 137: .drives.x$command.led config -bg #ffffffff0000 138: } elseif {[string compare $command "driveled 0"] == 0} { 139: set command [gets $inpipe] 140: .drives.x$command.led config -bg #000000000000 141: } elseif {[string compare $command "drivename"] == 0} { 142: set number [gets $inpipe] 143: set file$number [gets $inpipe] 144: } 145: } 146: 147: proc OpenPipes {} { 148: global env 149: global outpipe 150: global inpipe 151: set args $env(ARGS) 152: 153: if {[llength $args] != 2} { 154: exit 155: } 156: set outpipe [open [lindex $args 0] "w"] 157: set inpipe [open [lindex $args 1] "r"] 158: puts $outpipe "Startup" 159: flush $outpipe 160: } 161: 1.1.1.2 ! root 162: frame .drives -relief raised -borderwidth 2 -bg #cccccccccccc ! 163: label .drives.title -text "Floppy drives" -bg #cccccccccccc ! 164: frame .drives.x3 -relief sunken -borderwidth 2 -bg #cccccccccccc ! 165: button .drives.x3.insert -relief groove -image $disk3 -command {File 3} 1.1 root 166: frame .drives.x3.f 1.1.1.2 ! root 167: label .drives.x3.f.file -width 35 -relief groove -textvariable file3 ! 168: button .drives.x3.eject -image $tip -relief groove -command {Eject 3} -bg #cccccccccccc ! 169: 1.1 root 170: frame .drives.x3.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000 171: pack .drives.x3 -side bottom -expand yes -fill both 1.1.1.2 ! root 172: pack .drives.x3.insert -side left 1.1 root 173: pack .drives.x3.f -side left 174: pack .drives.x3.f.file -side left 1.1.1.2 ! root 175: pack .drives.x3.led -side right ! 176: pack .drives.x3.eject -side right 1.1 root 177: 1.1.1.2 ! root 178: frame .drives.x2 -relief sunken -borderwidth 2 -bg #cccccccccccc ! 179: button .drives.x2.insert -relief groove -image $disk2 -command {File 2} 1.1 root 180: frame .drives.x2.f 1.1.1.2 ! root 181: label .drives.x2.f.file -width 35 -relief groove -textvariable file2 ! 182: button .drives.x2.eject -image $tip -relief groove -command {Eject 2} -bg #cccccccccccc 1.1 root 183: frame .drives.x2.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000 184: pack .drives.x2 -side bottom -expand yes -fill both 1.1.1.2 ! root 185: pack .drives.x2.insert -side left 1.1 root 186: pack .drives.x2.f -side left 187: pack .drives.x2.f.file -side left 1.1.1.2 ! root 188: pack .drives.x2.led -side right ! 189: pack .drives.x2.eject -side right 1.1 root 190: 1.1.1.2 ! root 191: frame .drives.x1 -relief sunken -borderwidth 2 -bg #cccccccccccc ! 192: button .drives.x1.insert -relief groove -image $disk1 -command {File 1} 1.1 root 193: frame .drives.x1.f 1.1.1.2 ! root 194: label .drives.x1.f.file -width 35 -relief groove -textvariable file1 ! 195: button .drives.x1.eject -image $tip -relief groove -command {Eject 1} -bg #cccccccccccc 1.1 root 196: frame .drives.x1.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000 197: pack .drives.x1 -side bottom -expand yes -fill both 1.1.1.2 ! root 198: pack .drives.x1.insert -side left 1.1 root 199: pack .drives.x1.f -side left 200: pack .drives.x1.f.file -side left 1.1.1.2 ! root 201: pack .drives.x1.led -side right ! 202: pack .drives.x1.eject -side right 1.1 root 203: 1.1.1.2 ! root 204: ! 205: frame .drives.x0 -relief sunken -borderwidth 2 -bg #cccccccccccc ! 206: button .drives.x0.insert -relief groove -image $disk0 -command {File 0} ! 207: frame .drives.x0.f ! 208: label .drives.x0.f.file -width 35 -relief groove -textvariable file0 ! 209: button .drives.x0.eject -image $tip -relief groove -command {Eject 0} -bg #cccccccccccc 1.1 root 210: frame .drives.x0.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000 211: pack .drives.x0 -side bottom -expand yes -fill both 1.1.1.2 ! root 212: pack .drives.x0.insert -side left 1.1 root 213: pack .drives.x0.f -side left 214: pack .drives.x0.f.file -side left 1.1.1.2 ! root 215: pack .drives.x0.led -side right ! 216: pack .drives.x0.eject -side right 1.1 root 217: pack .drives.title -side top 218: 1.1.1.2 ! root 219: ! 220: frame .brs -relief raised -borderwidth 2 -bg #cccccccccccc ! 221: label .brs.amiga -image $amiga -bg #cccccccccccc 1.1 root 222: frame .brs.powerled -width 1c -height .3c -relief groove -borderwidth 2 -background #ffff00000000 1.1.1.2 ! root 223: button .brs.reset -text "Hard reset" -relief groove -command { Nuke } -bg #cccccccccccc ! 224: button .brs.debug -text "Debug" -relief groove -command { Dbug } -bg #cccccccccccc ! 225: button .brs.quit -text "Exit" -relief groove -command { Bye } -bg #cccccccccccc ! 226: pack .brs.amiga -side left 1.1 root 227: pack .brs.reset -side left 228: pack .brs.debug -side left 229: pack .brs.quit -side left 230: pack .brs.powerled -side right 231: 232: pack .drives -side bottom -fill x 233: pack .brs -side bottom -fill x 234: .brs.powerled config -bg #000000000000 235: OpenPipes 236: fileevent $inpipe readable {readdata} 1.1.1.2 ! root 237: ! 238: ! 239: proc loadDir w { ! 240: global dirName ! 241: ! 242: $w.f.list delete 0 end ! 243: foreach i [lsort [glob $dirName/*]] { ! 244: $w.f.list insert end [file tail $i] ! 245: } ! 246: } ! 247: ! 248: # loadImage -- ! 249: # Given the name of the toplevel window of the demo and the mouse ! 250: # position, extracts the directory entry under the mouse and loads ! 251: # that file into a photo image for display. ! 252: # ! 253: # Arguments: ! 254: # w - Name of the toplevel window of the demo. ! 255: # x, y- Mouse position within the listbox. ! 256: ! 257: ! 258: proc loadFile {w x y num} { ! 259: global dirName ! 260: global outpipe ! 261: global inpipe ! 262: ! 263: puts $outpipe "insert" ! 264: puts $outpipe "$num" ! 265: ! 266: flush $outpipe ! 267: ! 268: set isok [gets $inpipe] ! 269: if {[string compare $isok "ok"] == 0} { ! 270: set file $dirName/[$w.f.list get @$x,$y] ! 271: ! 272: puts $outpipe $file ! 273: flush $outpipe ! 274: destroy ! 275: } else { ! 276: tk_dialog .foo {UAE Disk Error} {You must use Eject first!} {} 0 OK ! 277: } ! 278: } ! 279: ! 280: proc File {drive} { ! 281: global dirName ! 282: ! 283: set w .filereq ! 284: catch {destroy $w} ! 285: ! 286: toplevel $w -bg #cccccccccccc ! 287: wm title $w "File Request for df$drive:" ! 288: wm iconname $w "File Request" ! 289: ! 290: frame $w.buttons -bg #cccccccccccc ! 291: pack $w.buttons -side bottom -expand y -fill x -pady 2m ! 292: button $w.buttons.dismiss -text Cancel -relief groove -command "destroy $w" -bg #cccccccccccc ! 293: pack $w.buttons.dismiss -side left -expand 1 ! 294: ! 295: label $w.dirLabel -text "Directory:" -bg #cccccccccccc ! 296: set dirName ../Disks ! 297: entry $w.dirName -width 30 -relief groove -textvariable dirName ! 298: bind $w.dirName <Return> "loadDir $w" ! 299: label $w.fileLabel -text "Double-Click to select file:" -bg #cccccccccccc ! 300: frame $w.f ! 301: pack $w.dirLabel $w.dirName $w.fileLabel $w.f -side top -anchor w ! 302: ! 303: listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set" ! 304: scrollbar $w.f.scroll -command "$w.f.list yview" ! 305: pack $w.f.list $w.f.scroll -side left -fill y -expand 1 ! 306: bind $w.f.list <Double-1> "loadFile $w %x %y $drive" ! 307: ! 308: catch {image delete image2a} ! 309: $w.f.list delete 0 end ! 310: foreach i [lsort [glob $dirName/*]] { ! 311: $w.f.list insert end [file tail $i] ! 312: } ! 313: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.