Return to uae-ui.tk CVS log

Up to [UNIX Amiga Emulator] / uae

uae-0.6.8

set Program(Name)    "UAE Control"
set Program(Version) "0.6.8"


wm title      . "$Program(Name)"
wm iconname   . "$Program(Name)"
wm grid       . 1 1 1 1

    set amiga [image create bitmap -data "#define amiga_width 60
#define amiga_height 24
static unsigned char amiga_bits[] = {
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x0f, 0x00, 0x00, 0x00,
  0x00, 0x00, 0x00, 0xc0, 0x0f, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xe1,
  0xcf, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xff, 0xf0, 0xcf, 0xff, 0xff, 0x01,
  0x00, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xbc,
  0x0f, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x3f, 0x9e, 0xcf, 0xff, 0xff, 0x01,
  0xf8, 0xff, 0x1f, 0x8f, 0xcf, 0xff, 0xff, 0x01, 0x00, 0x00, 0x80, 0x87,
  0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x83, 0x0f, 0x00, 0x00, 0x00,
  0xf8, 0xff, 0xe3, 0x81, 0xcf, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xf1, 0x80,
  0xcf, 0xff, 0xff, 0x01, 0x00, 0x00, 0x78, 0x80, 0x0f, 0x00, 0x00, 0x00,
  0x00, 0x00, 0xfc, 0xff, 0x0f, 0x00, 0x00, 0x00, 0xf8, 0x3f, 0xfe, 0xff,
  0xcf, 0xff, 0xff, 0x01, 0xf8, 0x1f, 0xff, 0xff, 0xcf, 0xff, 0xff, 0x01,
  0x00, 0x80, 0x07, 0x80, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x80,
  0x0f, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x80, 0x0f, 0x00, 0x00, 0x00,
  0x00, 0xf8, 0x07, 0xc0, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xc0,
  0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  };"]

    set tip [image create bitmap -data "#define tip_width 44
#define tip_height 16
static unsigned char tip_bits[] = {
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  0x00, 0x00, 0x00, 0xc0, 0xf3, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x79, 0x00,
  0x00, 0x00, 0x00, 0xf0, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x78, 0x1e, 0x00,
  0x00, 0x00, 0x00, 0x3c, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x9e, 0x07, 0x00,
  0x00, 0x1c, 0x07, 0xcf, 0x03, 0x00, 0x00, 0x3c, 0x8f, 0xe7, 0x01, 0x00,
  0x00, 0x78, 0xde, 0xf3, 0x00, 0x00, 0x00, 0xf0, 0xfc, 0x79, 0x00, 0x00,
  0x00, 0xe0, 0xf9, 0x3c, 0x00, 0x00, 0x00, 0xc0, 0x73, 0x1e, 0x00, 0x00,
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  };"]


    set disk0 [image create bitmap -data "#define disk0_width 35
#define disk0_height 17
static unsigned char disk0_bits[] = {
  0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01,
  0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8,
  0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff,
  0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00,
  0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80, 0x05, 0x80, 0x07,
  0x0f, 0x80, 0x05, 0x80, 0x07, 0x0f, 0x80, 0x05, 0x80, 0x07, 0x0f, 0x80,
  0x05, 0x80, 0x07, 0x09, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80,
  0x07, };"]

set disk1 [image create bitmap -data "#define disk1_width 35
#define disk1_height 17
static unsigned char disk1_bits[] = {
  0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01,
  0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8,
  0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff,
  0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00,
  0x80, 0x07, 0x0f, 0x00, 0x02, 0x80, 0x07, 0x0f, 0x80, 0x03, 0x80, 0x07,
  0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00,
  0x03, 0x80, 0x07, 0x09, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80,
  0x07, };"]

set disk2 [image create bitmap -data "#define disk2_width 35
#define disk2_height 17
static unsigned char disk2_bits[] = {
  0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01,
  0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8,
  0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff,
  0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00,
  0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80, 0x06, 0x80, 0x07,
  0x0f, 0x00, 0x06, 0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80,
  0x01, 0x80, 0x07, 0x09, 0x80, 0x07, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80,
  0x07, };"]

set disk3 [image create bitmap -data "#define disk3_width 35
#define disk3_height 17
static unsigned char disk3_bits[] = {
  0xff, 0x01, 0x00, 0xf8, 0x01, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01,
  0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8, 0x07, 0xff, 0x01, 0xe0, 0xf8,
  0x07, 0xff, 0x03, 0x00, 0xfc, 0x07, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff,
  0xff, 0xff, 0xff, 0x07, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x0f, 0x00, 0x00,
  0x80, 0x07, 0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x80, 0x06, 0x80, 0x07,
  0x0f, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x06, 0x80, 0x07, 0x0f, 0x80,
  0x06, 0x80, 0x07, 0x09, 0x00, 0x03, 0x80, 0x07, 0x0f, 0x00, 0x00, 0x80,
  0x07, };"]



proc Bye {} {
  global outpipe
  puts $outpipe "bye"
  flush $outpipe
  close $outpipe
  exit
}

proc Eject {num} {
    global outpipe
    puts $outpipe "eject"
    puts $outpipe "$num"
    flush $outpipe
}

proc Nuke {} {
    global outpipe
    puts $outpipe "reset"
    flush $outpipe
}

proc Dbug {} {
    global outpipe
    puts $outpipe "debug"
    flush $outpipe
}


proc readdata {} {
  global inpipe
  global file0
  global file1
  global file2
  global file3

  set command [gets $inpipe]

  if {[string compare $command "power 0"] == 0} {
    .brs.powerled config -bg #000000000000
  } elseif {[string compare $command "power 1"] == 0} {
    .brs.powerled config -bg #ffff00000000
  } elseif {[string compare $command "driveled 1"] == 0} {
    set command [gets $inpipe]
    .drives.x$command.led config -bg #ffffffff0000
  } elseif {[string compare $command "driveled 0"] == 0} {
    set command [gets $inpipe]
    .drives.x$command.led config -bg #000000000000
  } elseif {[string compare $command "drivename"] == 0} {
    set number [gets $inpipe]
    set file$number [gets $inpipe]
  } 
}

proc OpenPipes {} {
  global env
  global outpipe
  global inpipe
  set args $env(ARGS)

  if {[llength $args] != 2} {
      exit
  }
  set outpipe [open [lindex $args 0] "w"]
  set inpipe [open [lindex $args 1] "r"]
  puts $outpipe "Startup"
  flush $outpipe
}

frame .drives -relief raised -borderwidth 2 -bg #cccccccccccc
    label .drives.title -text "Floppy drives" -bg #cccccccccccc
    frame .drives.x3 -relief sunken -borderwidth 2 -bg #cccccccccccc
    button .drives.x3.insert -relief groove -image $disk3 -command {File 3}
    frame .drives.x3.f
    label .drives.x3.f.file -width 35 -relief groove -textvariable file3
    button .drives.x3.eject -image $tip -relief groove -command {Eject 3} -bg #cccccccccccc

    frame .drives.x3.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
    pack .drives.x3 -side bottom -expand yes -fill both 
    pack .drives.x3.insert -side left
    pack .drives.x3.f -side left
    pack .drives.x3.f.file -side left
    pack .drives.x3.led -side right
    pack .drives.x3.eject -side right

    frame .drives.x2 -relief sunken -borderwidth 2 -bg #cccccccccccc
    button .drives.x2.insert -relief groove -image $disk2 -command {File 2}
    frame .drives.x2.f
    label .drives.x2.f.file -width 35 -relief groove -textvariable file2 
    button .drives.x2.eject -image $tip -relief groove -command {Eject 2} -bg #cccccccccccc
    frame .drives.x2.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
    pack .drives.x2 -side bottom -expand yes -fill both 
    pack .drives.x2.insert -side left
    pack .drives.x2.f -side left
    pack .drives.x2.f.file -side left
    pack .drives.x2.led -side right
    pack .drives.x2.eject -side right

    frame .drives.x1 -relief sunken -borderwidth 2 -bg #cccccccccccc
    button .drives.x1.insert -relief groove -image $disk1 -command {File 1}
    frame .drives.x1.f
    label .drives.x1.f.file -width 35 -relief groove -textvariable file1
    button .drives.x1.eject -image $tip -relief groove -command {Eject 1} -bg #cccccccccccc
    frame .drives.x1.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
    pack .drives.x1 -side bottom -expand yes -fill both 
    pack .drives.x1.insert -side left
    pack .drives.x1.f -side left
    pack .drives.x1.f.file -side left
    pack .drives.x1.led -side right
    pack .drives.x1.eject -side right

 
    frame .drives.x0 -relief sunken -borderwidth 2 -bg #cccccccccccc
    button .drives.x0.insert -relief groove -image $disk0 -command {File 0}
    frame .drives.x0.f 
    label .drives.x0.f.file -width 35 -relief groove -textvariable file0
    button .drives.x0.eject -image $tip -relief groove -command {Eject 0} -bg #cccccccccccc
    frame .drives.x0.led -width 1c -height .3c -relief groove -borderwidth 2 -background #000000000000
    pack .drives.x0 -side bottom -expand yes -fill both 
    pack .drives.x0.insert -side left
    pack .drives.x0.f -side left
    pack .drives.x0.f.file -side left
    pack .drives.x0.led -side right
    pack .drives.x0.eject -side right     
    pack .drives.title -side top


  frame .brs -relief raised -borderwidth 2 -bg #cccccccccccc
  label .brs.amiga -image $amiga -bg #cccccccccccc
  frame .brs.powerled -width 1c -height .3c -relief groove -borderwidth 2 -background #ffff00000000
  button .brs.reset -text "Hard reset" -relief groove -command { Nuke } -bg #cccccccccccc
  button .brs.debug -text "Debug" -relief groove -command { Dbug } -bg #cccccccccccc
  button .brs.quit -text "Exit" -relief groove -command { Bye } -bg #cccccccccccc
  pack .brs.amiga -side left
  pack .brs.reset -side left
  pack .brs.debug -side left
  pack .brs.quit -side left
  pack .brs.powerled -side right

pack .drives -side bottom -fill x
pack .brs -side bottom -fill x
.brs.powerled config -bg #000000000000
OpenPipes
fileevent $inpipe readable {readdata}


proc loadDir w {
    global dirName

    $w.f.list delete 0 end
    foreach i [lsort [glob $dirName/*]] {
	$w.f.list insert end [file tail $i]
    }
}

# loadImage --
# Given the name of the toplevel window of the demo and the mouse
# position, extracts the directory entry under the mouse and loads
# that file into a photo image for display.
#
# Arguments:
# w -			Name of the toplevel window of the demo.
# x, y-			Mouse position within the listbox.


proc loadFile {w x y num} {
    global dirName
    global outpipe
    global inpipe

    puts $outpipe "insert"
    puts $outpipe "$num"

    flush $outpipe

    set isok [gets $inpipe]
    if {[string compare $isok "ok"] == 0} {
    set file $dirName/[$w.f.list get @$x,$y]

    puts $outpipe $file
    flush $outpipe	
    destroy 
    } else {
      tk_dialog .foo {UAE Disk Error} {You must use Eject first!} {} 0 OK 
    }
}

proc File {drive} {
    global dirName

set w .filereq
catch {destroy $w}

toplevel $w -bg #cccccccccccc
wm title $w "File Request for df$drive:" 
wm iconname $w "File Request"

frame $w.buttons -bg #cccccccccccc 
pack  $w.buttons -side bottom -expand y -fill x -pady 2m
button $w.buttons.dismiss -text Cancel -relief groove -command "destroy $w" -bg #cccccccccccc
pack $w.buttons.dismiss -side left -expand 1

label $w.dirLabel -text "Directory:" -bg #cccccccccccc
set dirName ../Disks
entry $w.dirName -width 30 -relief groove -textvariable dirName
bind $w.dirName <Return> "loadDir $w"
label $w.fileLabel -text "Double-Click to select file:" -bg #cccccccccccc
frame $w.f
pack $w.dirLabel $w.dirName $w.fileLabel $w.f -side top -anchor w

listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set"
scrollbar $w.f.scroll -command "$w.f.list yview"
pack $w.f.list $w.f.scroll -side left -fill y -expand 1
bind $w.f.list <Double-1> "loadFile $w %x %y $drive" 

catch {image delete image2a}
 $w.f.list delete 0 end
    foreach i [lsort [glob $dirName/*]] {
	$w.f.list insert end [file tail $i]
    }
}

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.