package require img::jpeg

################################################################
# proc reduceColors {image}--
#    Reduces an 24 bit image to 21 bits (7 bits per channel.
#    Gif images support a limited number of colors, and this helps
#    keep a steganographied image within size.
# Arguments
#   image	A Tcl image
# 
# Results
#   The image is modified in place.
# 
proc reduceColors {image} {
    for {set x 0} {$x < [image width $image]} {incr x} {
        for {set y 0} {$y < [image height $image]} {incr y} {
	    foreach {rd gd bd} [$image get $x $y] {}
	    set rd [expr $rd & 254]
	    set gd [expr $gd & 254]
	    set bd [expr $bd & 254]
            set color [format "#%02x%02x%02x" $rd $gd $bd]
	    $image put $color -to $x $y
	}
    }
}

################################################################
# proc insertDiagram {photo diagram}--
#    Inserts a binary diagram into a color photo image
# Arguments
#   photo	A full color image
#   diagram	A Tcl photo image with only 2 colors
# 
# Results
#   The photo image is modified in place.
# 
proc insertDiagram {photo diagram} {
    for {set x 0} {$x < [image width $diagram]} {incr x} {
        for {set y 0} {$y < [image height $diagram]} {incr y} {
	    foreach {rd gd bd} [$diagram get $x $y] {}
	    if {$bd > 2} {set blue 1} else {set blue 0}
	    foreach {rp gp bp} [$photo get $x $y] {}
	    set bp [expr $bp & 254]
	    set bp [expr $bp | $blue]
            set color [format "#%02x%02x%02x" $rp $gp $bp]
	    $photo put $color -to $x $y
	}
    }
}

################################################################
# proc extractLowBlue {photo concealedImage}--
#    Extract the low order bit from a photo image and make a 
#    black&white image
# Arguments
#   photo	Color image with concealed diagram
#   concealedImage  Tcl image to receive the binary diagram
# Results
#   The concealedImage is modified in place.
# 
proc extractLowBlue {photo concealedImage} {
    for {set x 0} {$x < [image width $photo]} {incr x} {
        for {set y 0} {$y < [image height $photo]} {incr y} {
	    foreach {rp gp bp} [$photo get $x $y] {}
	    set bp [expr $bp & 0x01]
	    if {$bp} {
	        set p 255
	    } else {
	        set p 0
	    }
            set color [format "#%02x%02x%02x" $p $p $p]
	    $concealedImage put $color -to $x $y
	}
    }
}