#!/bin/sh
#
# the folliwong line is a comment for tcl, and a command for sh \
exec wish4.0 $0 $* || exec wish4 $0 $* || exec wish $0 $*

# Now, we're wish..

# Need tk4 or later
regexp {^([0-9]*)} $tk_version  v
if "$v<4" {
    puts stderr "Tk version is less than 4\nSorry"
    exit 1
}

set devicefile /dev/cxg0pgm

# I use to "source" this file to test changes
catch {destroy [winfo children .]}

# define the bitmaps. The following line is expanded by 'Make`

##EXE cd bm; enbatch

set All "in up out   left again right   thin down thick "

# now create the images
set tmpf "/tmp/xgrab.bitmap"
foreach n $All {
    set F [open $tmpf w]; puts $F $bm($n); close $F
    image create bitmap bm.$n -file $tmpf
}

exec rm $tmpf

foreach n ".top .mid .bot .geo .file .bott" {
    pack [frame $n] -expand true -fill both
}

set bname ".top.1 .top.2 .top.3
           .mid.1 .mid.2 .mid.3
           .bot.1 .bot.2 .bot.3"

set i 0
foreach n $All {
    set name [lindex $bname $i]
    pack [button $name -image bm.$n -command "do_$n"] \
	-side left -expand true -fill both
    incr i
}

# the two entries


# should be an entry...
pack [label .geo.l -text "Geom."] -side left
pack [label .geo.e] -expand true -fill both

# and the following should simply exist...
#pack [label .file.l -text "Save as"] -side left
#pack [entry .file.e] -expand true -fill both

# the final bar

pack [button .bott.1 -text "lowres" -command "do_res 0"] \
	-side left  -expand true -fill both
pack [button .bott.2 -text "coarse-ctl" -command "do_grain"] \
	-side left  -expand true -fill both
pack [button .bott.3 -text "Quit" -command exit] \
	-side left  -expand true -fill both


# set it up

proc split {geo} {
    global wid hei x y

    set res [regexp {([0-9]*)x([0-9]*)\+([0-9]*)\+([0-9]*)} $geo foo w h _x _y]
    if !$res {error "syntax error in $geo"}
    set wid $w; set hei $h; set x $_x; set y $_y
    return
}

proc syncgeo {} {
    global wid hei x y F max devicefile

    if [expr "$wid > $max+1"] {set wid $max}
    if [expr "$hei > $max+1"] {set hei $max}
    if [set xtra [expr "$wid+$x - $max -1"]]>0 {incr $x -$xtra}
    if [set xtra [expr "$hei+$y - $max -1"]]>0 {incr $y -$xtra}
    if "$x<0" {set x 0}
    if "$y<0" {set y 0}
    
    set geo "${wid}x${hei}+${x}+${y}"
    #.geo.e delete 0 end
    #.geo.e insert 0 $geo
    .geo.e configure -text $geo
    puts $F $geo; 
    flush $F

#    grabbing config -file $devicefile
}

proc do_res {newres} {
    global max F

    if {$newres=="low"} {
	set max 256
	split "256x256+0+0"
	.bott.1 config -text "lowres"
	puts $F "L"; 
#flush $F
	syncgeo; return
    }
    if {$newres=="high"} {
	set max 512
	split "512x512+0+0"
	.bott.1 config -text hires
	puts $F "H"; 
#flush $F
	syncgeo; return
    }
    if $max==256 {
	do_res "high"
    } else {
	do_res "low"
    }
}

# and then provide commands....

proc do_grain {} {
    global coarse

    if {$coarse>1} {
	set coarse 1
	.bott.2 config -text "fine-ctl"
    } else {
	set coarse 5
	.bott.2 config -text "coarse-ctl"
    }
}

proc do_thin {} {
    global coarse wid hei x y
    incr y $coarse
    incr hei [expr -2*$coarse]
    syncgeo
}

proc do_in {} {
    global coarse wid hei x y

    incr x $coarse
    incr wid [expr -2*$coarse];
    do_thin
}

proc do_thick {} {
    global coarse wid hei x y
    incr y -$coarse
    incr hei [expr 2*$coarse]
    syncgeo
}

proc do_out {} {
    global coarse wid hei x y

    incr x -$coarse
    incr wid [expr 2*$coarse];
    do_thick
}

proc do_up {} {
    global coarse wid hei x y
    incr x -$coarse
    syncgeo
}

proc do_down {} {
    global coarse wid hei x y
    incr x $coarse
    syncgeo
}

proc do_left {} {
    global coarse wid hei x y
    incr y -$coarse
    syncgeo
}

proc do_right {} {
    global coarse wid hei x y
    incr x $coarse
    syncgeo
}

proc do_again {} {
    global devicefile
    syncgeo
    wm positionfrom .g program
    grabbing config -file $devicefile
}






################# spin the wheel


after 500 {
    toplevel .g
    image create photo grabbing -file $devicefile
    pack [label .g.l -image grabbing]
    wm title .g "Xgrab"
    wm iconname .g "Xgrab"
}

wm title . "Grab Controls"
wm iconname . "grab-ctl"
set coarse 5
update

set F [open $devicefile r+]
do_res low


