Return to uae-ui.tk CVS log

Up to [UNIX Amiga Emulator] / uae

Annotation of uae/uae-ui.tk, revision 1.1

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.