#! /usr/bin/perl -w

# A Tk interface to cdchanger.
#  Richard Sharman <rsharman@magma.ca>
# Released under the GNU GPL,  see file COPYING for details.

use strict ;
use Tk ;

my $main = new MainWindow ;

# ------------- Preferences ------------------------------------

# These control the size and starting positions of the circles:
my $size = 20 ;
my $incr = 30 ;
my ($startx,  $starty ) = (10, 10) ;


# This makes the backspace key work as expected!:
$main->bind ( 'all',  '<Delete>', "Backspace") ;

# This means you don't have to click to enter text in an
# entry widget:
$main->bind( 'Tk::Entry',  '<Enter>', [ 'focus'  ] ) ;

my $PROG = "cdchanger 2>&1 " ;

my $DISK_PRESENT_BG_COL = "yellow" ;
my $DISK_PRESENT_NUM_COL = "black" ;
my $DISK_PRESENT_OUTLINE_COL = "black" ;
my $DISK_PRESENT_OUTLINE_WIDTH = "1" ;

my $CURR_DISK_BG_COL = "green" ;
my $CURR_DISK_NUM_COL = "red" ;
my $CURR_DISK_OUTLINE_COL = "black" ;
my $CURR_DISK_OUTLINE_WIDTH = "1" ;

my $BUSY_DISK_BG_COL =  $DISK_PRESENT_BG_COL ;
my $BUSY_DISK_NUM_COL = $DISK_PRESENT_NUM_COL ;
my $BUSY_DISK_OUTLINE_COL =  "green" ;
my $BUSY_DISK_OUTLINE_WIDTH = "2" ;

# Since itemconfigure doesn't allow  -fill => "" 
# we need to specifically find the background colour to make
# the circle look empty.
my $SLOT_EMPTY_COLOUR =  ($main -> configure('background'))[4] ; 


# --------------------------------------------------------------



my ( $current_slot, $slot, @status, @disk_present ) ;

my $status_msg = "" ;
my $busy_slot = 0 ;
my $device = "" ;
my $previous_device = "" ;
my $mount_point = "" ;
my $mount_at = "" ;
my $wait_flag = 0 ;
my $extra_options = "" ;

my $canvas = "" ;
my $num_buttons = 0 ;
my $flag = 0 ;

# do_change_cmd("", "") ;	# done below now

my $c ;

if ( $#ARGV >= 0 ) {
    $previous_device = $device = $ARGV[0] ;
}

my $options_frame = "" ;

if (0) {
$c->bind( 'Tk::Menubutton', '<3>', "Tk::Menubutton::ButtonDown") ;

$c->bind( 'Tk::Menubutton', "<ButtonRelease-3>",
	    'Tk::Menubutton::ButtonUp');

$c->bind( 'Tk::Menu', '<3>', "Tk::Menu::ButtonDown") ;

$c->bind( 'Tk::Menu', "<ButtonRelease-3>",
	    'Tk::Menu::ButtonUp');
}


my $config_frame = "" ;

&config_check ;

MainLoop ;

# ------------------------------------------------------------------------

sub config_check {
    my ($f) ;

    $f = $main -> Frame ;
    $f->Label(-text => "Initialzing...") -> pack ;
    $f->pack ;
    $main -> update ;

    do_change_cmd("", "") ;
    $f -> destroy ;
    if ( $num_buttons > 0 ) {
	&configure_circles ;
	if ( $options_frame ) {
	    $options_frame -> destroy ;
	    $options_frame = "" ;
	    return ;
	}
    } else {
	&configure_error ;
    }
}

sub configure_circles {
    my ( $i, $x, $y ) ;
    $x = $startx ; $y = $starty ;

    if ( $canvas eq "" ) {
	$canvas = $main->Canvas ;
	$c = $canvas ;
    }

    for $i ( 1 .. $num_buttons ) {
	my ($circle, $text, $colour) ;
	
	$circle = $c -> create('oval', $x, $y, $x+$size, $y+$size,
			       -tag => "button-$i" ) ;
	$text = $c -> create('text', $x+($size/2), $y+($size/2),
			     -tag => "text-$i" ,
			     -text => $i) ;
	$x += $incr ;
	$c -> bind($circle, '<1>' => sub {handle_circle($i, 1) } ) ;
	$c -> bind($text, '<1>' => sub {handle_circle($i, 1) } ) ;
	$c -> bind($circle, '<2>' => sub {handle_circle($i, 2) } ) ;
	$c -> bind($text, '<2>' => sub {handle_circle($i, 2) } ) ;
	$c -> bind($circle, '<3>' => sub {handle_circle($i, 3) } ) ;
	$c -> bind($text, '<3>' => sub {handle_circle($i, 3) } ) ;
    }

    $y = $y + 1.5 * $size ;

    $c->Tk::bind($c, '<1>', sub{refresh()}) ;
    $c->Tk::bind($c, '<3>', sub{popup_options()}) ;

    &update_colours() ;


    $c -> configure  ( -width => $x, height => $y ) ;
    $c->pack (  -fill => 'both') ;

    # This restores the natural size in case user has resized it.
    # Without this,  any user-selected size remains as is.
    $main -> geometry("") ;

}

sub configure_error {
    if ($config_frame) {
	return ;
    }
    my $f ;

    if (! $options_frame ) {
	&popup_options() ;
    }
    if ( !$config_frame ) {
	$config_frame = $options_frame -> Frame ;
    }
    $f = $config_frame ;
    $f->Label(-text => 'Error!
Device was not specified, 
device is not a changer,
or device could not be opened.

Try using the options popup window to set the device,
then press the OK button') -> pack ;
    $f -> Button(-text => 'OK' ,
		 -command => sub{config_check()}) -> pack ;
    $f->pack ;
}


sub do_cmd {
    my ( $item ) = @_ ;
    print "Item $item selected\n" ;
}

sub handle_circle {
    my ($slot, $button) = @_;
    my $option = "" ;
    $flag = 1 ;		# We are inside a circle, so ignore
			# other the mouse event for the frame itself.

    if ( $button == 3 ) {
	# The nifty code for this isn't written yet!
	return ;
    }
    $busy_slot = $slot ;
    &update_colours() ;

    $main -> update ;
    
    if ( $button == 2 ) {
	$option = "-e " ;
	if ( $wait_flag ) {
	    $option .= "-w " ;
	}
    }
    do_change_cmd( $option, 
		  , "$slot" ) ;
    $busy_slot = 0 ;
    &update_colours() ;
}


sub update_status {
    my ($new_msg) = @_ ;
    if ( $new_msg ) {
	$status_msg = $new_msg ;
    }
}

sub do_change_cmd {
    my ( $options, $slot ) = @_ ;
    if ($slot) {
	$current_slot = $slot ;
    } else {
	$current_slot = 0 ;
    }
    if ($canvas) {
	&update_status("- busy -") ;
	&update_colours() ;
	$main -> update ;
    }
    open(PROG, "$PROG -v $extra_options $options $device $slot |") ||
	die("cannot open program $PROG") ;
    $status_msg = "" ;
    while ( <PROG> ) {
	if ( /Current slot: ([0-9]+)/ ) {
	    $current_slot = $1 ;
	    next ;
	} elsif ( /Total slots available: ([0-9]+)/ ) {
	    $num_buttons = $1 ;
	    next ;
	} elsif ( m/Slot *([0-9]+): ([A-Za-z ]+)/ ) {
	    $slot = $1 ;
	    $status[$slot] = $2 ;
	    $disk_present[$slot] = ( $2 =~ m/Disc present/ ) ;
	    next ;
	} elsif ( /Mounted as: ([^ \n]+)/ ) {
	    $mount_point = $1 ;
	    $main->title( $mount_point ) ;
	    $status_msg .= $_ ;
	    next ;
	} elsif ( /Not currently mounted/ ) {
	    $status_msg .= $_ ;
	    $main->title( $0 ) ;
	    next ;
	} elsif ( /^Drive status: ([^.]+)/ ) {
	    $status_msg .= "$1\n" ;
	} elsif ( /^Device: (.*)/) {
	    $device = $1 ;
	} else {
	    $status_msg .= $_ ;
	}
    }
    close PROG ;
    chop $status_msg ;	# remove final newline
    if ($canvas) {
	&update_colours ;
	$main -> update ;
    }
    &update_status("") ;
}

    

sub update_colours {
    for $slot ( 1 .. $num_buttons ) {
	my ($circle, $text, $colour, $out_colour, $out_width) ;
	my ($text_colour, $temp) ;

	if ( $disk_present[$slot] ) {
	    $colour = $DISK_PRESENT_BG_COL ;
	} else {
	    $colour = $SLOT_EMPTY_COLOUR ;
	}
	$out_colour = $DISK_PRESENT_OUTLINE_COL ;
	$out_width = $DISK_PRESENT_OUTLINE_WIDTH ;
	$text_colour = $DISK_PRESENT_NUM_COL ;

	if ( $slot == $current_slot ) {
	    if ($disk_present[$slot]) {
		$colour = $CURR_DISK_BG_COL ;
	    }
	    $out_colour = $CURR_DISK_OUTLINE_COL ;
	    $out_width = $CURR_DISK_OUTLINE_WIDTH ;
	    $text_colour = $CURR_DISK_NUM_COL ;
	}

	if ( $slot == $busy_slot ) {
	    # While we are doing an operation,  revese the colours
	    # of the circle and the text.
	    $temp = $text_colour ;
	    $text_colour = $colour ;
	    $colour = $temp ;
	}

	$c -> itemconfigure("button-$slot",  -outline => $out_colour) ;
	$c -> itemconfigure("button-$slot",  -width => $out_width) ;
	$c -> itemconfigure("button-$slot",  -fill => $colour) ;
	
	$c -> itemconfigure("text-$slot",  -fill => $text_colour) ;
    }
}




sub popup_options {
    if ( $flag ) {
	$flag = 0 ;
	return ;
    }
    if ( $options_frame ) {
	$options_frame -> destroy ;
	$options_frame = "" ;
	return ;
    }
    my($x, $y) = ($main->pointerx, $main->pointery) ;
    my $f ;

    $options_frame = $main->Toplevel ;

    $x += 5 ;
    $y += 5 ;
    $options_frame -> geometry("+$x+$y") ;
    $options_frame -> title ("$0 options") ;

    $f = $options_frame->Frame ;
    $f -> Button(-text => 'Mount' ,
		 -command => sub{do_mount()})
	-> pack(-side => 'left') ;
    $f->Label(-text => 'at: ') -> pack(-side => 'left') ;
    $f->Entry(-textvariable => \$mount_at) -> pack(-side => 'left') ;
    $f->pack ;

    $f = $options_frame->Frame ;
    $f -> Button(-text => 'Unmount' ,
		 -command => sub{do_umount()})
	-> pack(-side => 'left') ;
    $f->pack ;

    $f = $options_frame->Frame ;
    $f->Checkbutton(-text => 'Wait for new disk on eject',
		    -variable => \$wait_flag) -> pack(-side => 'left') ;
    $f->pack ;

    $f = $options_frame->Frame ;
    $f->Label(-text => 'Other options: ')-> pack(-side => 'left') ;
    $f->Entry(-textvariable => \$extra_options) -> pack(-side => 'left' ) ;
    $f->pack ;

    $f = $options_frame->Frame ;
    my $temp ;
    $f = $options_frame->Frame ;
    $f->Label(-text => 'Device name: ')
	-> pack(-side => 'left') ;
    $temp = $f->Entry(-textvariable => \$device) 
	-> pack(-side => 'left' ) ;
    $f->pack ;

    $temp -> bind( '<Return>', sub{check_device_name()}  ) ;

    $f = $options_frame->Frame ;
    $f->Label(-textvariable => \$status_msg) -> pack(-side => 'left') ;
    $f->pack ;
    
    if (0) {    
	$f = $options_frame->Frame ;
	$f->Button(-text => 'Show',
		   -command => sub{do_show()} 
		   ) -> pack(-side => 'left') ;
	$f->Button(-text => 'Dismiss options',
		   -command => sub{dismiss($options_frame)} ) -> pack ;
	$f->pack ;
    }
    
}

sub do_mount {
    my $options = "" ;
    if ( $mount_at =~ m/^ *$/ ) {
	$options .= '-m ""' ;
    } else {
	$options .= "-m $mount_at" ;
    }
    do_change_cmd($options, "") ;
}
    
sub refresh {
    if ( $flag ) {
	$flag = 0 ;
	return ;
    }
    do_change_cmd("", "") ;
}

sub do_umount {
    my  $param = $device ;
    if ( $param eq "" ) {
	if ( $mount_point eq "" ) {
	    $status_msg = "Cannot unmount,  don't know device!" ;
	    return ;
	} else {
	    $param = $mount_point ;
	}
    } 
    $status_msg = `umount $param 2>&1` ;
    if ($status_msg eq "") {
	$status_msg = "unmounted." ;
    }
}

sub check_device_name {
    if ( $device ne  $previous_device ) {
	$previous_device = $device ;
	$num_buttons = 0 ;
	if ($canvas) {
	    $canvas->destroy ;
	    $canvas = "" ;
	}
	&config_check ;
    }
}


    
