#!/usr/bin/wish

wm focusmodel . passive
wm geometry . 300x416+168+185; update
wm minsize . 256 200
wm overrideredirect . 0
wm resizable . 1 1
wm deiconify .
wm title . "Hack-O-Matic"
#    vTcl:FireEvent $base <<Create>>
#    }

if {$tcl_platform(platform) == "windows"} {
    # just to remind me what the syntax is to detect platform at runtime
} else {
    # just to remind me what the syntax is to detect platform at runtime
}

menu .menubar
menu .menubar.file
menu .menubar.help
.menubar.file add command -label "Open" -command fileopen
.menubar.file add command -label "Save As..." -command filesave
.menubar.file add command -label "Exit" -command exit
.menubar add cascade -label "File" -menu .menubar.file
.menubar.help add command -label "About..." -command helpabout
.menubar add cascade -label "Help" -menu .menubar.help

. config -menu .menubar

scrollbar .scr -orient vertical -command ".can yview"
canvas .can -yscrollcommand ".scr set" -width 240

for {set y 0} {$y<10} {incr y} {
    for {set x 0} {$x< 8} {incr x} {
	set base [ expr $y * 20 ]
	array set a [list $y,$x [ .can create polygon [ expr $x * 20 ] $base [ expr $x * 20 + 19 ] $base [ expr $x * 20 + 19 ] [ expr $base + 19 ] [ expr $x * 20 ] [ expr $base + 19 ] -fill white -outline black -tag $y,$x ]]
	.can bind $y,$x <Button-1> "set col \[.can itemcget $y,$x -fill\] ; if \[expr \[string compare \$col \"white\" \] == 0\] { .can itemconfigure $y,$x -fill black } else { .can itemconfigure $y,$x -fill white } "
    }
}

pack .can -fill both -expand 1 -side left
pack .scr -fill y -expand 0 -side left

set y 0
set data {}

proc niy {} {
    tk_messageBox -type ok -icon info -title Debug -message "Not implemented yet!"

}

proc helpabout {} {
    tk_messageBox -type ok -icon info -title "About..." -message "Hack-O-Matic 0.01\nCopyright 2002 Rob Kudla\nSubject to terms of the\nGNU General Public License"
}

proc filesave {} {
    global a
    global y
    global data
    set filename [tk_getSaveFile]
    if [expr [string compare $filename ""] != 0] {
	set f [open $filename w]
	fconfigure $f -translation binary
#	for { set j 0 } {$j < $y} {incr j} {
#	    puts -nonewline "."
#	    flush stdout
#	    set curbyte 0
#	    for {set x 0} {$x < 8} {incr x} {
#		if [string equal [.can itemcget $j,$x -fill] "black"] {
#		    set curbyte [expr $curbyte | (1 << (7 - $x))]
#		}
#	    }
#	    puts -nonewline $f [chr $curbyte]
#	}
	puts -nonewline $f $data
	close $f
    }
    
}

proc fileopen {} {
    global a
    global y
    global data
    set filename [tk_getOpenFile]
    if [expr [string compare $filename ""] != 0] {
	if [expr [file size $filename] <= 65536] {
	    
	    foreach v [array names a] {
		.can delete $a($v)
	    }

	    set f [open $filename r]
	    fconfigure $f -translation binary
	    set data [read $f]
	    for {set y 0} {$y < [string length $data]} {incr y} {
		set byte [string range $data $y $y]
		flush stdout
		binary scan $byte B8 bits
		binary scan [binary format S $y] H* curpos
		.can create text 0 [expr $y * 20] -text $curpos -anchor nw

		for {set x 0} {$x < 8} {incr x} {
		    set base [ expr $y * 20 ]
		    set offset 32
		    if [string equal [string range $bits $x $x] "0"] {
			set fillcol white
		    } else {
			set fillcol black
		    }
		    array set a [list $y,$x [ .can create polygon [ expr $x * 20 + $offset ] $base [ expr $x * 20 + 19 + $offset ] $base [ expr $x * 20 + 19 + $offset ] [ expr $base + 19 ] [ expr $x * 20 + $offset ] [ expr $base + 19 ] -fill $fillcol -outline black -tag $y,$x ]]
		    .can bind $y,$x <Button-1> " set col \[.can itemcget $y,$x -fill\] ; if \[expr \[string compare \$col \"white\" \] == 0\] { .can itemconfigure $y,$x -fill black } else { .can itemconfigure $y,$x -fill white } ; global data; binary scan \[string range \$data $y $y\] c1 oldchar; set data \[string replace \$data $y $y \[chr \[expr \$oldchar ^ (1 << (7 - $x))\]\]\]"
		}
	    }
	    set y [string length $data]
	    set scrollreg [expr 20 * $y]
	    .can configure -scrollregion [list 0 0 0 $scrollreg]
	    close $f
	}
    }
}

proc chr {c} {
    return [binary format c1 $c]
}