home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 8 Other / 08-Other.zip / uaexfr86.zip / uae-ui.tk < prev    next >
Text File  |  1996-02-22  |  7KB  |  226 lines
  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}
  226.