## -*- tcl -*-
# ### ### ### ######### ######### #########

## Manipulate image orientation (rotation, flips along various axes).
## CPS style (request + completion callback).
## Fully parallel with the main tasks due to use of Threads (pool).

# ### ### ### ######### ######### #########
## Requisites

package require Tcl 8.5
package require Debug
package require snit
package require threadpool
package require uevent::job::queue

# ### ### ### ######### ######### #########
## Tracing

Debug off img/orientation

# ### ### ### ######### ######### #########
## Implementation

snit::type img::orientation {
    # ### ### ### ######### ######### #########
    ## API

    typemethod limit {n} {
	$ourpool configure -limit $n
	return
    }

    delegate typemethod {rotate ccw}      to ourselves as {Schedule left}
    delegate typemethod {rotate cw}       to ourselves as {Schedule right}
    delegate typemethod {rotate up}       to ourselves as {Schedule up}
    delegate typemethod {flip horizontal} to ourselves as {Schedule fliph}
    delegate typemethod {flip vertical}   to ourselves as {Schedule flipv}
    delegate typemethod transpose         to ourselves as {Schedule transpose}
    delegate typemethod transverse        to ourselves as {Schedule transverse}
    typecomponent ourselves ;# == $type (see typeconstructor)

    # ### ### ### ######### ######### #########
    ## Internal helpers

    typemethod Schedule {operation imagefile future} {
	Debug.img/orientation {[list $type Schedule $operation $imagefile $future]}

	# This code is different from the img::geometry handler
	# because here we modify the image, making order important. We
	# cannot put the completion callbacks for one image together.
	# But we can and do manage a queue per imagefile which injects
	# the request into the threadpool not only in the proper
	# order, but each also only after the previous request
	# completed.

	if {![info exists ourpending($imagefile)]} {
	    # No job queue for the image file yet. Create it.
	    set ourpending($imagefile) \
		[uevent::job::queue ${type}::%AUTO% \
		     -gate-command [mytypemethod CanRunNext $imagefile]]
	    set ourlocked($imagefile) 0
	}

	# Put the operation into the existing queue, then wake it up,
	# iff no job is currently running.
	$ourpending($imagefile) put \
	    [mytypemethod Run $operation $imagefile $future]

	if {$ourlocked($imagefile)} return
	$ourpending($imagefile) wake
	return
    }

    typemethod Run {operation imagefile future} {
	Debug.img/orientation {[list $type Run $operation $imagefile $future]}

	$ourpool put \
	    [list $operation $imagefile] \
	    [mytypemethod Done $operation $imagefile $future]
	set ourlocked($imagefile) 1
	return
    }

    typemethod CanRunNext {imagefile} {
	return [expr {!$ourlocked($imagefile)}]
    }

    typemethod Done {operation imagefile future what detail} {
	Debug.img/orientation {[list $type Done $operation $imagefile $future $what $detail]}

	set ourlocked($imagefile) 0

	# Run completion callback.
	if {$what eq "ok"} {
	    $future return $detail
	} else {
	    $future error $detail
	}

	# Wake the next job, iff there is any, and if no error occured.
	if {$what eq "error"} {
	    $ourpending($imagefile) drain
	} elseif {[$ourpending($imagefile) size]} {
	    $ourpending($imagefile) wake
	}
	return
    }

    # ### ### ### ######### ######### #########
    ## Initialization/Setup

    typeconstructor {
	Debug.img/orientation {$type typeconstructor ... Initialize internal threadpool}

	set ourselves $type

	set ourpool [threadpool ${type}::POOL \
	    -policy queue \
	    -setup {
		package require fileutil

		proc up {input} {
		    # Use jhead's facilities for auto-rotation to set
		    # the image upright. This handles any stored
		    # thumbnail automatically.
		    exec jhead -autorot $input
		    return
		}

		proc left       {input} { DO $input -rotate 270 }
		proc right      {input} { DO $input -rotate 90  }
		proc fliph      {input} { DO $input -flip horizontal }
		proc flipv      {input} { DO $input -flip vertical   }
		proc transpose  {input} { DO $input -transpose  }
		proc transverse {input} { DO $input -transverse }

		proc DO {input args} {
		    # Using jhead and jpegtran to transform loss-lessly,
		    # and keeping the thumbnail in sync

		    # NOTE: This kills a stored thumbnail.
		    if {[catch {
			set r  [fileutil::tempfile imgorient_res_]
			set s  [fileutil::tempfile imgorient_thumbres_]
			set t  [fileutil::tempfile imgorient_thumb_]
			exec jpegtran -copy all {*}$args $input > $r
			exec jhead -st $t $r
			exec jpegtran -copy all {*}$args $t > $s
			exec jhead -rt $s $r
			file rename -force $r $input
			file delete $s $t
		    }]} {
			return -code error $::errorInfo
		    }
		    return
		}
	    }]
	return
    }

    # ### ### ### ######### ######### #########
    ## State

    typecomponent ourpool              ; # Thread pool handling the orientation jobs.
    typevariable  ourpending -array {} ; # Map for the per-image queues.
    typevariable  ourlocked  -array {} ; # Map for the per-image queue locks.

    # ### ### ### ######### ######### #########
    ## Configuration

    pragma -hasinstances   no ; # singleton
    pragma -hastypeinfo    no
    pragma -hastypedestroy no
    pragma -hasinfo        no
    pragma -simpledispatch yes

    ##
    # ### ### ### ######### ######### #########
}

# ### ### ### ######### ######### #########
## Ready
package provide img::orientation 0.1
