#!/bin/sh
## -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

# # ## ### ##### ######## ############# #####################
## Copyright (c) 2010 Andreas Kupries.
#
# This software is BSD licensed.
# # ## ### ##### ######## ############# #####################

## Command line application wrapped around the flow packages.

# # ## ### ##### ######## ############# #####################
## Requirements, extended package management for local packages.

lappend auto_path [file normalize [file join [file dirname [info script]] lib]]

#puts stdout *\t[join $::auto_path \n*\t]

package require Tcl 8.5  ; # Required runtime.

# # ## ### ##### ######## ############# #####################
## Global settings for tracing.

package require Thread
package require debug
::apply {{} {
    set    parts {}
    append parts {[thread::id] | }
    append parts {[clock format [clock seconds]] | }
    append parts {[format %3d [info level]] | }
    append parts {[string repeat {    } [info level]] | }
    debug prefix :: $parts
    return
} ::}

debug off bookflow
#debug on bookflow
Debug.bookflow {Starting the application...}

# # ## ### ##### ######## ############# #####################

package require bookflow ; # Main functionality.

# # ## ### ##### ######## ############# #####################
## Execution

bookflow run $argv
exit 0

# # ## ### ##### ######## ############# #####################

Overview
========

	Bookflow is an application processing the JPEG images found in
	a directory into zero or more 'books'.

	The directory is also called a 'project'.

	Each project may contain zero or more books.

Syntax
======

	bookflow <directory> ?... range of passes, other options...?

Overall behaviour
=================

(1)	If the <directory> contains a file named BOOKFLOW:

	(a)    Check that it is a valid bookflow state file.	[R1]
	       Report an error, if not.

	(b)    Run the specified passes.			[R2]
	       If no passes where specified, run them all.	[R3]

(2)	The <directory> does not contain a file named BOOKFLOW:

	Scan the directory for JPEG files. The scanning is not	[R4]
	recursive, i.e. only images in the directory itself
	count. Subdirectories and their contents are ignored.

	Report an error if none are present.			[R5]

	Create BOOKFLOW with the found JPEG files recorded	[R6]
	in it.

		The BOOKFLOW file will contain, per JPEG image
		=	Name,
		=	Size
		=	SHA1 checksum.


	Proceed with (1).					[R6]

Validation [R1]
===============

	A valid BOOKFLOW file is a sqlite3 database.		[R11]

	The database contains an entry for all JPEG files	[R12]
	found in the directory.

		"No files were added since the last bookflow run"

	The database contains no entries for which there	[R13]
	is no JPEG file in the directory.

		"No files were removed since the last bookflow run"

	The SHA1 checksums recorded for a JPEG file matches    [R14]
	the SHA1 checksum of the file in the directory

		"No files were modified since the last bookflow run"

Passes, General
===============

	Each pass has three phases, namely			[R21]
		initialization, execution, and finalization.

	Passes come in monolithic and parallel varieties.	[R22]

	The first means  that the actions of the pass for	[R23]
	each image in the BOOKFLOW are tied together and
	cannot be separated.

	Conversely the latter means that the actions of the	[R24]
	pass for each image in the BOOKFLOW can be separated
	from each other and performed concurrently.

	If the initialization phase of a pass is run, then	[R25]
	this is done before its execution and finalization
	phases.

	If the execution phase of a pass is run, then this	[R26]
	is done after its initialization and before its
	finalization phases.
		
	If the finalization phase of a pass is run, then	[R27]
	this is done after its initialization and execution
	phases.

	The passes of bookflow have a fixed order, which is
	specified later.

	For a monolithic pass A executed before a pass B all	[R28]
	phases of A which are run, are run before any of the
	phases of B.

	For a pass A executed before a monolithic pass B all	[R29]
	phases of A which are run, are run before any of the
	phases of B.

	For a parallel pass A executed before a parallel	[R210]
	pass B all the phases of A which are run for a
	specific image, are run before any of the phases of B
	for the same image.

	When performing the passes from A to B, with A a pass
	coming before B in the order of passes the following
	phases are run, with their order constrained by the
	rules above:

		The initialization phases from the first	[R211]
		pass to pass B.

		The finalization phases from pass A to the	[R212]
		last pass.

		The execution phases from pass A to pass B.	[R213]

Passes, Bookflow
================

	Bookflow uses the following passes to process
	the images in the directory/project.


	A.	Parallel.
		Compute brightness of all images.

	B.	Monolithic.
		Sort the brightness values into 3 classes based on
		their, using k-Means classification.

		The classes in question are:

		- marker black
		- marker white
		- book page

	C.	Parallel.
		Mark all images with their class.

	D.	Monolithic.
		Use the image names to impose an order on the images,
		then use the image class information to locate the
		various multi-image markers, i.e.

		black/black/white   - SOB    Start of Book, Even pages begin.
		black/white/black   - MOB    Middle of Book, Odd pages begin.
		white/black/black   - EOB    End of Book.

		Reclassify the images as

		- marker, ignored     
		- book page, even     images between SOB and MOB
		- book page, odd      images between MOB and EOB
		- ignored	      images between EOB and SOB
				      images before first SOB
				      images after last EOB.

		and separate them into books (images between SOB and EOB).

		Error conditions:

		- No SOB, MOB, and EOB found.
		- No MOB between SOB and EOB.

	E.	Parallel.
		Rotate the book page images upright, with the rotation
		dependent on the classification as even or odd.

		Note:	  This modifies the images in the project directory.
			  We have to remember this in the project so that we
			  won't try to rotate them later again, and we have
			  to update the size/checksum info.

		Alternative: The rotated images are stored in a sub-directory,
		and the originals are left untouched. We still remember the
		information in the bookflow file so that we can skip this
		action when needed.

	F.	Parallel.
		For each image generate a downsampled copy to make the later
		passes faster (less pixels to process).

	G.	Parallel.
		Determine the DPI of all images marked as book pages.

		[[ Initially: Manual assigment, via cmdline, or GUI ]].


	X.	Manual classification (or heuristics:): inner marker =>
		ignore previous image.

	X.	Have special image with DPI marker (color square/circle).
		Maybe even in the regular marker panels
		=> black! + red circle (The white marker is already the
		lightfield, we cannot interfere with that.

	X.	Use white markers to compute light fields, and apply them
		for regularization of the book pages.

	X.	Book Information

		per book	- title
				- isbn
				- author (list)
				- publisher
				- print year
				- print edition

	X.	Use the even/odd information per book to arrange a final
		order of display (page increasing), and separate the
		front/back cover pages.

	X.	LAT (local adaptive thresholding).
	=>	global histogram for global threshold (median)
	=>	and per-pixel histogram (median => median filter)

======================================================================

Internal achitecture (modules and their interaction)

(1)	 Engine and Frontends are separate packages / libraries.

	 Two frontends are provided

	 (a)	A pure command line.
	 (b)	A graphical interface.

(2)	 Engine and Frontend are run in different threads.
	 Communication is handles via thread::send.
	 Bulk data (images) is communicated via the filesystem,
	 using file names in the commands issued through 'thread::send'.

(3)	 The engine has to be interuptible, for the graphical frontend
	 able to take control at an arbitrary point.

	 The ability to cancel a phase in progress is required too.

	 This should be built, if at all possible, into the phase
	 support- and execution framework, i.e. the phase manager.

(4)	The engine may use additional, internal, threads to
	concurrently perform actions. -- Threadpool.

======================================================================

User Experience
===============

(i) Start bookflow

    (a) With a single argument - Open the GUI, see (1) for continued
	behaviour

    (b) With no argument

        Open the GUI, see (1) for continued behaviour using the
	current working directory as the argument.

    (c) With more than one argument.

        Throw an error for the user to acknowledge and abort.
	- How to decide where to show the error, GUI or stdout ?
	- Or treat as case (b) ?
	- Or treat as case (a), ignoring the superfluous arguments ?






	Vertical notebook:

	Panel 1:	Images
	Panel 2+:	Book Information. See above.
			Including just the images in the book,
			sorted and ordered by page number.

	Show the images as thumbnails, in a grid, dynamically resizable.
	The thumbnails display has to contain markers (icon, color, etc)
	to make it easy to separate chaff/wheat.


===================================================================

bookflow	       <=> bookflow process CWD
bookflow <dir>         <=> bookflow process <dir>
bookflow process <dir>
bookflow images
bookflow books
bookflow statistics

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

south
box "Frontend (Thread)" "Cmdline | GUI" width [8 cm] fillcolor lightgreen
move
box "Engine (Thread)" width [8 cm] fillcolor lightyellow
group {
    arrow \
	from [0.33 between [[2nd last box] sw] [[2nd last box] se]] \
	to   [0.33 between [[last box]     nw] [[last box]     ne]] \
	"Commands " rjust
    arrow \
	from [0.33 between [[last box]     ne] [[last box]     nw]] \
	to   [0.33 between [[2nd last box] se] [[2nd last box] sw]] \
	" Responses" ljust
}
block {
    set movelength [1 cm]
    east
    box "Worker-\nthread" fillcolor salmon
    group { arrow <-> from [[last box] n] north }
    move
    box same
    group { arrow <-> from [[last box] n] north }
    move
    box same
    group { arrow <-> from [[last box] n] north }
    set E [[last box] e]
    set W [[3rd last box] w]
}
group {
    east
    arrow <-> from [[last box] e] stroke 4
    box height [8 cm] width [4 cm] "Filesystem" fillcolor lightblue
    arrow <-> stroke 4 from [[last block] E]
    arrow <-> stroke 4 from [0.75 between [[1st box] ne] [[1st box] se]]
}
group {
    west
    arrow <-> from [[2nd last box] w] stroke 4
    drum height [8 cm] width [4 cm] "BOOKFLOW" "(Database)" fillcolor lightblue aspect 0.1
    arrow <-> stroke 4 from [[last block] W]
}

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

proc t {name script args} {
    block {
	south
	set fields [block {
	    circle radius 1 fillcolor red color red
	    eval $script
	}]
	box at [last block] \
	    width  [expr {[[last block] width]  + [5 mm]}] \
	    height [expr {[[last block] height] + [5 mm]}]
	box text $name fillcolor white height [7 mm] with sw at [last box nw]
	set X [[last box] e]
    } {*}$args
}

proc f {type name notes args} {
    set $name [text "$type :: $name ($notes)" with nw at [[last] sw] {*}$args]
}

proc n {text args} {
   text "$text" textcolor red with nw at [[last] sw] {*}$args
}

proc pk {type name args} {
    f $type $name [join $args {, }] textcolor blue
}

proc d {rows} {
    block {
	south
	foreach r $rows {
	    block {
		east
		foreach c $r {
		    box height [7 mm] $c
		}
	    }
	}
    }
}

##########################################

south

t bookflow {
    f int dpi {}
}

move

t book {
    pk int  bid  {not null, auto-increment}
    f  text name {unique, not null}
}

east
arrow <- bid above

set image [t image {
    pk int    iid  {not null, auto-increment}
    f  text   path {not null, unique}
    f  int    bid  {not null, references book}
    f  int    ord  {not null}
    n "unique (bid, ord)"
}]

east
group {
    arrow <- right right iid above

   t is1 {
	f int iid {not null}
	f int sid {not null}
    }

    arrow right right sid above

    t state1 {
	pk int   sid   {not null}
	f string label {not null, unique}
    }

    arrow from [[last block] X] right right right data above

    d {
	{0 "white"}
	{1 "black"}
	{2 "page"}
    }
}

group {
    arrow <- down down down right then right iid above
    east
    t is2 {
	f int iid {not null}
	f int sid {not null}
    }

    arrow right right sid above

    t state2 {
	pk int   sid   {not null}
	f string label {not null, unique}
    }

    arrow from [[last block] X] right right right data above

    d {
	{ 0 "sob1" {! "black"}}
	{ 1 "sob2" {! "black"}}
	{ 2 "sob3" {! "white"}}
	{ 3 "mob1" {! "black"}}
	{ 4 "mob2" {! "white"}}
	{ 5 "mob3" {! "black"}}
	{ 6 "eob1" {! "white"}}
	{ 7 "eob2" {! "black"}}
	{ 8 "eob3" {! "black"}}
	{ 9 "even" {! "page"}}
	{10 "odd"  {! "page"}}
	{11 "none" {! "page"}}
    }
}

group {
    arrow <- down down down down down down right then right iid above
    east
    t it {
	f int iid {not null}
	f int tid {not null}
    }

    arrow right right tid above

    t type {
	pk int   tid   {not null}
	f string label {not null, unique}
    }

    arrow from [[last block] X] right right right data above

    d {
	{ 0 "frontc" {! "odd"}}
	{ 1 "backc"  {! "even"}}
	{ 2 "page"   {! "page"}}
    }
}


group {
    arrow <- up up up right then right iid above
    east
    set istate [t brightness {
	f int iid   {not null}
	f int value {not null}
    }]

}

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

######################################################################

proc portrait {h args} {
    box height $h width [expr {0.75*$h}] {*}$args
}

proc landscape {w args} {
    box width $w height [expr {0.75*$w}] {*}$args
}

proc thumb {args} {
    landscape [16 mm] "Thumb" {*}$args
}

proc sthumb {args} {
    thumb {*}$args stroke 3
}

proc ellipsis {} {
    move same ; circle rad [1 mm] fillcolor black
    move same ; circle same
    move same ; circle same
}

proc leftarrow {args} {
    box {*}$args ; group {
	line \
	    from [[[last box] ne] by [2 mm] sw] \
	    then [[[last box]  w] by [2 mm]  e] \
	    then [[[last box] se] by [2 mm] nw] \
	    to   [[[last box] ne] by [2 mm] sw]
    }
}

proc rightarrow {args} {
    box {*}$args ; group {
	line \
	    from [[[last box] nw] by [2 mm] se] \
	    then [[[last box]  e] by [2 mm]  w]  \
	    then [[[last box] sw] by [2 mm] ne] \
	    to   [[[last box] nw] by [2 mm] se]
    }
}


proc bseries {args} {
    block {
	block {
	    east
	    portrait [9 cm] "Left page" "Odd"
	    move right [5 mm]
	    portrait [9 cm] "Right page" "Even"
	}

	set sl [box with s at [[[last block] n] by [5 mm] n] width [[last block] width]]
	block {
	    east              ; thumb
	    move right [2 mm] ; thumb
	    ellipsis
	    move same ; sthumb
	    move same ; sthumb
	    ellipsis
	    move same ; thumb
	    move same ; thumb
	} with c at [[last box] c]

	leftarrow   with e at [[$sl w] by [2 mm] w]
	rightarrow  with w at [[$sl e] by [2 mm] e]

    } {*}$args
}

proc wrap {e} {
    # e = element to wrap.

    set x [[arc rad [5 mm] from [[$e sw] by [5 mm] left]] start]
    line right [$e width]
    arc rad [5 mm]
    line up [$e height]
    arc rad [5 mm]
    line left [$e width]
    arc rad [5 mm]
    tabB Images
    tab  {Book 1}
    tabA ...
    tabA {Book N}
    line to $x
}

proc tab {{text {}}} {
    arc rad [5 mm] cw ; line ; tablabel $text
    arc rad [5 mm]    ; line down [5 mm]
    arc rad [5 mm]    ; line
    arc rad [5 mm] cw
    return
}
proc tabB {{text {}}} {
    group {
	arc rad [5 mm] cw ; line ; tablabel $text
	arc rad [5 mm]    ; line down [5 mm]
	arc rad [5 mm]
    }
    line down [15 mm]
}

proc tabA {{text {}}} {
    group {
	west
	arc rad [5 mm] from [[2nd last arc] end]
	line down [5 mm]
	arc rad [5 mm] ; line ; tablabel $text up
	arc rad [5 mm] cw
    }
}

proc tablabel {text {dir down}} {
    if {$text eq {}} return
    group {
	text text $text with c at [[[last line] c] by [7.5 mm] $dir]
    }
    return
}

######################################################################

text "Notebook Page \"Book Image Series\""
move south [1 cm]
wrap [bseries]
move

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

######################################################################


proc nbpage {args} {
    box width [18.4 cm] height [11.5 cm] {*}$args
}

proc wrap2 {e} {
    # e = element to wrap.

    set x [[arc rad [5 mm] from [[$e sw] by [5 mm] left] color red] start]
    line right [$e width]
    arc rad [5 mm]
    line up [$e height]
    arc rad [5 mm]
    line left [$e width]
    arc rad [5 mm]
    line to $x
}

proc wrap {e} {
    # e = element to wrap.

    set x [[arc rad [5 mm] from [[$e sw] by [5 mm] left]] start]
    line right [$e width]
    arc rad [5 mm]
    line up [$e height]
    arc rad [5 mm]
    line left [$e width]
    arc rad [5 mm]
    tabB Images
    tab  {Book 1}
    tabA ...
    tabA {Book N}
    line to $x
}

proc tab {{text {}}} {
    arc rad [5 mm] cw ; line ; tablabel $text
    arc rad [5 mm]    ; line down [5 mm]
    arc rad [5 mm]    ; line
    arc rad [5 mm] cw
    return
}
proc tabB {{text {}}} {
    group {
	arc rad [5 mm] cw ; line ; tablabel $text
	arc rad [5 mm]    ; line down [5 mm]
	arc rad [5 mm]
    }
    line down [15 mm]
}

proc tabA {{text {}}} {
    group {
	west
	arc rad [5 mm] from [[2nd last arc] end]
	line down [5 mm]
	arc rad [5 mm] ; line ; tablabel $text up
	arc rad [5 mm] cw
    }
}

proc tablabel {text {dir down}} {
    if {$text eq {}} return
    group {
	text text $text with c at [[[last line] c] by [7.5 mm] $dir]
    }
    return
}

######################################################################

text "Overall gui, image notebook + rightside action log"
move south [1 cm]

wrap2 [block {
    block { wrap [nbpage "Notebook page"] }
    east
    move east [5 mm]
    box height [[last block] height] width [6 cm] "Log of Engine Activity"
}]
move

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

######################################################################

proc portrait {h args} {
    box height $h width [expr {0.75*$h}] {*}$args
}

proc landscape {w args} {
    box width $w height [expr {0.75*$w}] {*}$args
}

proc thumb {args} {
    landscape [32 mm] "Thumb" {*}$args
}

proc sthumb {args} {
    thumb {*}$args stroke 3
}

proc ellipsis {} {
    move same ; circle rad [1 mm] fillcolor black
    move same ; circle same
    move same ; circle same
}

proc iseries {args} {
    block {
	box width [12 cm] height [9 cm]
	block {
	    east              ; thumb
	    move right [2 mm] ; sthumb
	    ellipsis
	} with nw at [[[last box] nw] by [5 mm] se]
	block {
	    east              ; ellipsis
	    move right [2 mm] ; thumb
	    move right [2 mm] ; thumb
	} with se at [[[last box] se] by [5 mm] nw]
    } {*}$args
}

proc wrap {e} {
    # e = element to wrap.

    set x [[arc rad [5 mm] from [[$e sw] by [5 mm] left]] start]
    line right [$e width]
    arc rad [5 mm]
    line up [$e height]
    arc rad [5 mm]
    line left [$e width]
    arc rad [5 mm]
    tab Images
    tabA  {Book 1}
    tabA ...
    tabA {Book N}
    line to $x
}

proc tab {{text {}}} {
    arc rad [5 mm] cw ; line ; tablabel $text
    arc rad [5 mm]    ; line down [5 mm]
    arc rad [5 mm]    ; line
    arc rad [5 mm] cw
    return
}
proc tabB {{text {}}} {
    group {
	arc rad [5 mm] cw ; line ; tablabel $text
	arc rad [5 mm]    ; line down [5 mm]
	arc rad [5 mm]
    }
    line down [15 mm]
}

proc tabA {{text {}}} {
    group {
	west
	arc rad [5 mm] from [[2nd last arc] end]
	line down [5 mm]
	arc rad [5 mm] ; line ; tablabel $text up
	arc rad [5 mm] cw
    }
}

proc tablabel {text {dir down}} {
    if {$text eq {}} return
    group {
	text text $text with c at [[[last line] c] by [7.5 mm] $dir]
    }
    return
}

######################################################################

text "Notebook Page \"Image Series\" (Alternative I)"
move south [1 cm]
wrap [iseries]
move

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

######################################################################

proc portrait {h args} {
    box height $h width [expr {0.75*$h}] {*}$args
}

proc landscape {w args} {
    box width $w height [expr {0.75*$w}] {*}$args
}

proc thumb {args} {
    landscape [16 mm] "Thumb" {*}$args
}

proc sthumb {args} {
    thumb {*}$args stroke 3
}

proc ellipsis {} {
    move same ; circle rad [1 mm] fillcolor black
    move same ; circle same
    move same ; circle same
}

proc leftarrow {args} {
    box {*}$args ; group {
	line \
	    from [[[last box] ne] by [2 mm] sw] \
	    then [[[last box]  w] by [2 mm]  e] \
	    then [[[last box] se] by [2 mm] nw] \
	    to   [[[last box] ne] by [2 mm] sw]
    }
}

proc rightarrow {args} {
    box {*}$args ; group {
	line \
	    from [[[last box] nw] by [2 mm] se] \
	    then [[[last box]  e] by [2 mm]  w]  \
	    then [[[last box] sw] by [2 mm] ne] \
	    to   [[[last box] nw] by [2 mm] se]
    }
}

proc iseries {args} {
    block {
	block {
	    east
	    move right [47.5 mm]
	    portrait [9 cm] "Current page"
	    move right [47.5 mm]
	}

	set sl [box with s at [[[last block] n] by [5 mm] n] width [[last block] width]]
	block {
	    east              ; thumb
	    move right [2 mm] ; thumb
	    ellipsis
	    move same ; sthumb
	    ellipsis
	    move same ; thumb
	    move same ; thumb
	    move same ; thumb
	} with c at [[last box] c]

	leftarrow   with e at [[$sl w] by [2 mm] w]
	rightarrow  with w at [[$sl e] by [2 mm] e]

    } {*}$args
}

proc wrap {e} {
    # e = element to wrap.

    set x [[arc rad [5 mm] from [[$e sw] by [5 mm] left]] start]
    line right [$e width]
    arc rad [5 mm]
    line up [$e height]
    arc rad [5 mm]
    line left [$e width]
    arc rad [5 mm]
    tab  Images
    tabA  {Book 1}
    tabA ...
    tabA {Book N}
    line to $x
}

proc tab {{text {}}} {
    arc rad [5 mm] cw ; line ; tablabel $text
    arc rad [5 mm]    ; line down [5 mm]
    arc rad [5 mm]    ; line
    arc rad [5 mm] cw
    return
}
proc tabB {{text {}}} {
    group {
	arc rad [5 mm] cw ; line ; tablabel $text
	arc rad [5 mm]    ; line down [5 mm]
	arc rad [5 mm]
    }
    line down [15 mm]
}

proc tabA {{text {}}} {
    group {
	west
	arc rad [5 mm] from [[2nd last arc] end]
	line down [5 mm]
	arc rad [5 mm] ; line ; tablabel $text up
	arc rad [5 mm] cw
    }
}

proc tablabel {text {dir down}} {
    if {$text eq {}} return
    group {
	text text $text with c at [[[last line] c] by [7.5 mm] $dir]
    }
    return
}

######################################################################

text "Notebook Page \"Image Series\" (Alternative II)"
move south [1 cm]
wrap [iseries]
move

Interaction between a display of multiple images (view + controller)
and a model holding the images to show.
====================================================================

The model is a container of images, i.e.:

* It holds a list of images. Note that 'list' implies an order on the images.
* It has the following information per image (all optional (*))
  - name of the image, relative to the project directory
  - path of the thumbnail image, relative to the project directory
  - classification 0: use/ignore
  - classification 1: black/white/page
  - classification 2: sob/mob/eob/even/odd
  - classification 3: na/content/front/back

  (*) To allow the use of placeholders for missing pieces, be they
      pages or the various markers.

The model broadcasts events on changes to its contents, i.e:

* An image is added
* The state of an image changes
  - name becomes known
  - thumbnail becomes known or changes.
  - classification X becomes known or changes.

Views for a model are driven by these events, having bound to the
model and them.

Notes on the information and their constraints:

(a) An image without name is a placeholder for missing data.
(b) A placeholder has the classifications which describe the type of
    the missing piece.
(c) A missing thumbnail is a temporary condition the model will
    rectify as fast as possible.

(d) Classification 0 is orthogonal to the classifications 1-3. Where
    the latter describe what the image is, in increasing detail, this
    one tells us whether to use the image later, or not.

(e) The classifications 1, 2, and 3 are building on each other,
    i.e. the higher numbered classifications can be known if and
    only if the lower-numbered classifications are available. In
    addition a number of constraints are put on the values restricting
    the set of legal combinations.

    1-unknown => 2-unknown => 3-unknown

    2-sob  => 1-black|1-white
    2-mob  => 1-black|1-white
    2-eob  => 1-black|1-white
    2-even => 1-page
    2-odd  => 1-page

    3-content     => 2-even|2-odd
    3-front       => 2-odd
    3-back        => 2-even
    3-na	  => 2-sob|2-mob|2-eob

    Based on these constraints the legal combinations are shown
    below. On the right additional notes on how the combination is
    shown by a view.

	c1	c2	c3		view
	------------------------	--------
*	unknown	unknown	unknown		plain name, thumbnail (when present)
	------------------------	--------
	black	unknown	unknown		3 pixel wide black border
		----------------	--------
		sob	unknown		3 pixel wide green border
			na		ditto
		----------------	--------
		mob	unknown		3 pixel wide yellow border
			na		ditto
		----------------	--------
		eob	unknown		3 pixel wide magenta border
			na		ditto
	------------------------	--------
	white	unknown	unknown		3 pixel wide salmon border
		----------------	--------
		sob	unknown		3 pixel wide green border
			na 		ditto			
		----------------	--------
		mob	unknown		3 pixel wide yellow border
			na 		ditto			
		----------------	--------
		eob	unknown		3 pixel wide magenta border
			na 		ditto			
	------------------------	--------
*	page	unknown	unknown		plain name, thumbnail (when present)
		----------------	--------
*		even	unknown		plain name, thumbnail (when present)
			content		3 pixel wide blue border
			back		3 pixel wide orange border
		----------------	--------
*		odd	unknown		plain name, thumbnail (when present)
			content		3 pixel wide blue border
			front		3 pixel wide orange border
	------------------------	--------

	The starred entries are currently visually undistinguishable.

	See if the treecontrol allows for dashed and dotted borders /
	rectangles around items for additional ways of distinguishing
	states.

Two open issues, which are related to each other

(1) How do we communicate the order of images in the model, and
(2) How do we communicate changes to the order between images.

====================================================================

The view is also a controller, i.e. actions taken by the user are
communicated to the 











- The model has to announce the presence of new images
- The model has to annonce when the thumbnail for an image is available.
- The model has to announce when the thumbnail of an image is changed.
- The model has to announce the removal of images
- The model has to announce changes to the information about an image
  (status, type, ...)

Interactions between producers, users, and invalidators of data
===============================================================

Using the handling of thumbnail images as example and template for the
pattern.

Producer
--------

(1) The producer monitors the scoreboard (take) for the appearance of
    tuples matching the pattern {!THUMBNAIL *}.

    When appearing the second word of the taken tuple is treated as
    the path of the image I whose thumbnail is to be invalidated.

    The producer cleans up all data pertaining to the thumbnail of I,
    ensuring that the next time the thumbnail for I is requested it
    will be full regenerated from the base data, i.e. I itself.

    Part of this cleanup is the removal of the {THUMBNAIL <I>} tuple
    for this image. This action triggers (5), in the user, see below.


(2) The producer monitors the scoreboard (bind missing) for queries,
    i.e. patterns of tuples matching the pattern {THUMBNAIL * *}.
    (Missing events trigger when a pattern to 'take' and 'wpeek'
    matches no tuple at all).

    When a miss is reported the second word of the reported pattern is
    treated as the path of the image I whose thumbnail has been
    requested but not known.

    The producer generates and places a tuple {THUMBNAIL <I> <T>} into
    the scoreboard, fulfilling the request, with I the path of the
    image and T the path of the thumbnail image to use. The generation
    of this tuple is trivial if T already exists in the filesystem, a
    simply packaging up of the information. Otherwise the producer
    launches a task actually generating T, using CRIMP to scale down I
    to thumbnail size.

Invalidator
-----------

(3) When actions by some task or other make the contents of the
    thumbnail for image I obsolete the task or other places a tuple
    matching {!THUMBNAIL <I>} into the scoreboard.

    This then triggers (1), in the producer, see above.

User
----

(4) When the thumbnail T of an image I is required the user asks
    (wpeek) for a tuple matching {THUMBNAIL <I> *}. If a matching
    tuple is present its third word is treated as the path to the
    requested thumbnail.

    If it is not present the query triggers (2) in the producer, see
    above, causing the tuple to be generated in time.

    Because of the delay possible in fulfulling the request the user
    should be prepared for the possibility that by the time the
    request is actually fulfilled the need for the data has passed.

(5) The user monitors the scoreboard (bind take) for the removal
    of {THUMBNAIL <I> *} tuples, signaling content invalidation.

    When the removal is reported, and the user still has need of the
    thumbnail then (4), see above, is invoked to request an updated
    and valid thumbnail.


Notes
~~~~~

(a) The image paths mentioned in the various actions above are all
    relative to the project directory.

(b) The parts of the system are not restricted to a single role in the
    above. For example, the producer of brightness data for the images
    is also the user of greyscale conversions of same images.

Possible scan errors
====================

duplicate pages
missing markers	- insert fake marker
missing pages	- insert fake (empty) page/placeholder
missing cover	- insert fake cover (see fake page)
missing lightfield - synthesize

cover scanned out of order (last instead of first, or in the middle).

Heuristics
==========

detect marker
detect lightfield
synthesize lightfield
page brightness (-> grey -> mean, or hsv -> value -> mean)
page color (-> hsv -> hue -> mean)
picture orientation
detect page number => orientation cue, even/odd cue, number itself for
order
compare pages (similarity = detect duplicate)
first order by image name

crimp - ppm file - save/read HSV!
crimp - up/down sample x/y separate

auto-dpi = 6 lines/height
auto-dpi via markers (square lines - also perspective warp, global)

auto-crop


---
scan tailor mixed mode tiff image

If I flip the pure-black pixels to white, I have the graphical version
of the image. If I flip non-pure-black pixels to white, I have the
textual version of the image. Yes?

== pure black = text
== grey-scale = grey images, never going up to pure black (255)

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

proc mbox {args} {
    box width [8 cm] fillcolor lightgreen {*}$args
}
proc pbox {args} {
    box width [8 cm] fillcolor lightyellow {*}$args
}

east
drum width [4 cm] height [8 cm] aspect 0.1 "BOOKFLOW DB" fillcolor lightblue
move ; move

set p [block {
    south
    set movelength [1 cm]
    set sd [mbox "Scan Directory" "(Implied to have an order)"]
    group {
	southwest
	arrow
	pbox "Create thumbnail"
    }
    southeast
    arrow
    set gr1 [pbox "Convert to greyscale (I)"]
    south
    arrow
    set cb [pbox "Compute brightness"]
    arrow
    set cl [mbox "Classify The Brightness"]
    arrow
    set ci [pbox "Classify By Brightness" "MarkerB | MarkerW | Page | Unknown"]
    group {
	southwest
	arrow down left left
	set bm [pbox "Detect SOB | MOB | EOB"]
	group {
	    south
	    arrow
	    mbox "Separate multiple books"
	    arrow
	    mbox "Separate even|odd|not pages"
	    group { east ; line ; arrow }
	    arrow
	    mbox "Separate cover pages" "& reorder"
	}
    }
    group {
	south
	arrow
	set lf [pbox "Detect light field"]
	arrow
	set no [pbox "Normalize background"]
	arrow
	pbox "Rotate upright"
	arrow
	pbox "Unwarp perspective"
	group {
	    southeast ; arrow down right right
	    pbox "Compute DPI"
	}
	arrow
	set gr2 [pbox "Convert to greyscale (II)"]
	arrow
	set re [pbox "Reduce size"]
	arrow
	pbox "Determine rough page borders"
	arrow
	mbox "Inter-page border exchange"
	arrow
	pbox "Finalize page borders"
	arrow
	pbox "Segment page" "Text | Images | Lines"
	arrow
	pbox "Line shape"
	arrow
	pbox "Unwarp lines"
    }
    group {
	southeast
	arrow down right right
	set dp [pbox "Find fiducials (DPI & perspective)" "(original image)"]
	south
	arrow down down down down down down then down left left left left left left
    }
}]

move ; move
circle radius [4 cm] fillcolor grey "ScoreBoard" "(in memory)"

Handling of regular images by the book manager.
===============================================

Two places/situations will request a regular sized page image.

    (i) selection, i.e. when page X is selected, system gets its
	image.

    (ii) background pre-generation, i.e. for all images found we
	 request them once, to ensure that they are created if they do
	 not exist yet.

Of these two (i) is a high-priority thing, as the user wishes to see
the image. It is also something we must be able to cancel. I.e. when
the user switches to a different page and the image for the previously
current one has not arrived yet then this old request should either
get normal priority or not be done at all.

Situation (ii) on the other hand is something which can be defered
until after all the thumbnails have been done. This one should look
towards (i) to know which pages are already done while the user was
browsing.

The problem with (i) and cancellation is that the user is, in
principle, isolated from the internals of the producers. Miss the
requested tuple, and the producer automatically starts the generation
process. And the consumer automatically waits for the result/return
event.

As such a switch to a different image will simply make another
request, if the data was missing.

Prioritization has happen in the producer. I.e. the producer, knowing
that a particular request has priority then takes the necessary
actions to get it into the scaling tasks as fast as possible, if that
is required at all.

The dispatcher then also has to keep track of the requests waiting for
execution, so that it can take lower-priority request back to make
place for the high priority one. And putting them back when it knows
that the high-priority request is taken and executing.

... side note ... Make dataflow diagrams for the producer internals,
showing direct and indirect control flow ...

Scoreboard API
==============

put <tuple>...

	Places the specified tuples into the scoreboard.
	May return before the tuples are fully stored.
	May release 'take' requests waiting on a pattern matching any of the tuples.
	May trigger 'added' notifications for patterns matching the tuples.

take <pattern> <cmd>

	Asks the scoreboard to invoke <cmd> when a tuple matching the
	<pattern> is present, with the matching tuple as argument.

	At the time of invokation the tuple is removed from the
	scoreboard.

	Returns before <cmd> is invoked.

	If no matching tuple is present the system will wait until
	such a tuple exists. Possibly waiting indefinitely.

	Multiple 'take' requests waiting on tuples are served in order
	of arrival. I.e. the earliest request matching a tuple is
	invoked, with the remainder waitng for the next tuple. As new
	requests are adding to the end of this list each request R
	will be served at some point if enough tuples matching its
	pattern are added to the scoreboard. Matching requests coming
	after R cannot pre-empt it.

	May trigger 'removed' notifications, for patterns matching the
	taken tuple.

	May trigger 'missing' notifications, for patterns not matching
	a tuple at the time of the request.

takeall <pattern> <cmd>

	Like 'take', with two differences.

	It doesn't wait for matching tuples to be present.

	If none are there <cmd> is invoked with the empty list.

	If tuples match however then all of them are removed
	from the scoreboard and given to <cmd>.

	May trigger 'removed' notifications for patterns matching the
	taken tuples.

peek <pattern> <cmd>

	Like 'takeall', except that the matching tuples are not
	removed from the scoreboard. As such it will not generate
	'take' notifications either.

wpeek <pattern> <cmd>

	The 'waiting peek' is like peek in that it doesn't remove a
	tuple matching the pattern. It is however like 'take', waiting
	for the appearance of a matching tuple is no such is present
	when the request is made.


bind put     <pattern> <cmd>
bind take    <pattern> <cmd>
bind missing <pattern> <cmd>

	These methods bind a <cmd> callback to a particular action
	(put/take) and tuple <pattern>. Each occurence of the action
	for a tuple matching the pattern causes an invokation of the
	callback.

	The contents of the scoreboard are not modified.

	In this manner it is possible to wait for a tuple to appear,
	like 'take', but without actually removing the tuple.

	Note that if a tuple is added via 'put' and immediately
	'take'n two notifications may be generation, for both the
	'put', and the 'take', in this order.

	The 'missing' event is invoked if a 'take' or 'wpeek' had to
	wait for a matching tuple, and the pattern, treated as tuple,
	matched the pattern for the event.

unbind ...

	Remove event bindings.

# -*- tcl -*-
#
# Documentation of the tuples stored in the scoreboard, their
# meanings, and associated code, i.e. creators, users, etc.

tuple {PROJECT CREATE} {
    Signal from the directory scanner to the creation task to generate
    a new project (database).
} {
}

tuple {PROJECT VERIFY} {
    Signal from the directory scanner to the verification task to
    cross-check an existing project (database).
} {
}

tuple {PROJECT ERROR <msg>} {
    Message for the user interface to post.
} {
}

tuple {PROJECT SERVER <thread>} {
    Access to project database is mediated by the thread with id <thread>.
} {
}

tuple {AT <path>} {
    The location of the current project (directory), as absolute path.
} {
}

tuple {DATABASE <name>} {
    The name/path of the database file, relative to the project directory.
    Also a signal to the project database access layer to provide access.
} {
}

tuple {FILE <path>} {
    Name/path of an image file found by the scanner, relative to the project
    directory. Used by either creation or verification task, i.e. make
    them images, or compare to current images.
} {
}

tuple {BOOK <name>} {
    Name of a book found in the project (database).
} {
}

tuple {IMAGE <path> <serial> <book>} {
    Name/path of a verified page image file in the project,
    with reference to the book it belongs to, and a serial
    number providing the ordering within the book.
} {
}

tuple {!THUMBNAIL <path> <size>} {
    Signal to invalidate the <size>d thumbnail of page
    image <path>.
} {
}

tuple {THUMBNAIL <path> <size> <dstpath>} {
    <dstpath> is the location of the <sized>d thumbnail for
    page image <path>. All paths are relative to the project
    (directory).
} {
}

tuple {SCALE <path> <size> <dst>} {
    Order to resize page image <path> to <size>, and store the
    result in <dst>.
} {
}

tuple {!GREYSCALE <path>} {
    Signal to invalidate the greyscale derivation of page
    image <path>.
} {
}

tuple {GREYSCALE <path> <dstpath>} {
    <dstpath> is the location of the greyscale derivation of
    page image <path>. All paths are relative to the project
    (directory).
} {
}

tuple {GREYCONVERT <path> <dst>} {
    Order to compute the greyscale of page image <path> and
    store the result in <dst>.
} {
}

tuple {!STATISTICS <path>} {
    Signal to invalidate the statistics of page image <path>.
} {
}

tuple {STATISTICS <path> <stats>} {
    <stats> are the statistics of page image <path>.
} {
}

tuple {STATSQ <path>} {
    Order to compute the statistics of page image <path>.
} {
}

# -*- tcl -*-
document {
    description {
	Task Documentation.

	Listing all tasks with the package implementing them, the
	pre-conditions, i.e. scoreboard contents (tuple existence), it
	triggers on, the results (new and removed tuples), again scoreboard
	contents, and additional scoreboard data which is accessed during the
	execution of the task.
    }

    task bookflow::scan {
	description {
	    Scan the project directory, locate the project database and the
	    images to process. One shot task, exits after the scan is complete.
	    Initial task. Automatically triggered.
	}
	thread
	trigger {}
	behavior {
	    (1) {
		action  { Scan directory for database, images}
		output  {
		    add	{AT <dir>}
		}
	    }
	    (2) {
		guard  { Neither images nor project database found }
		output {
		    add	{PROJECT ERROR *}
		}
	    }
	    (3) {
		guard  { Images found, but no project database }
		output {
		    add {FILE *}
		    add	{PROJECT CREATE}
		}
	    }
	    (4) {
		guard  { Images and project database are found }
		output {
		    add {FILE *}
		    add {DATABASE *}
		    add	{PROJECT VERIFY}
		}
	    }
	}
    }

    task bookflow::error {
	description {
	    Waits for other tasks to signal an error and reports it.
	    Continuous task.
	}
	event
	trigger {
	    {PROJECT ERROR *}
	}
	behaviour {
	    (1) {
		action { Report the error held by the tuple }
		output {}
	    }
	}
    }

    task bookflow::verify {
	description {
	    Load the database and check its contents against
	    the set of images found by the scanner.
	    One shot task, exits after the check is done.
	}
	thread
	trigger {
	    {PROJECT VERIFY}
	}
	behaviour {
	    (1) {
		action {
		    {AT *}
		    {DATABASE *}
		    {FILE *}

		    Open database, load set of images known to it.
		    Get the set of found images.
		    Compare for missing and additional images.
		}
	    }
	    (2) {
		guard {
		    The set of images in the directory does not match
		    the set of images in the project.
		}
		output {
		    add {PROJECT ERROR *}
		    NOTE { --- Allow corrective action by the user ? --- }
		    NOTE { --- Auto-correction?
			i.e. Ignore additional images
			and. Mark missing images as such and ignore further.
		    }
		}
	    }
	    (3) {
		guard {
		    The set of images in the directory is consistent
		    with the set of images in the project.
		}
		action {
		}
		output {
		    remove {FILE *}
		    add    {BOOK <name> <...>}
		    add    {IMAGE <file> ...}
		    add    {PART <book> <file>}
		}
	    }
	}
    }

    task bookflow::create {
	description {
	    Create a fresh project database in the project directory
	    and populate it with the found images.
	    One shot task, exits after the creation is done.
	}
	thread
	trigger {
	    {PROJECT CREATE}
	}
	behaviour {
	    (1) {
		action {
		    {AT *}
		    {DATABASE *}

		    Get the set of found images.
		    Open database, write images and basic status to it.
		    Fill the scoreboard based on the information.
		}
		output {
		    remove {FILE *}
		    add    {DATABASE *}
		    add    {BOOK <name> <...>}
		    add    {IMAGE <file> ...}
		    add    {PART <book> <file>}
		}

	    }
	}
    }
}

While I want bookflow to be mostly automatic when identifying pages,
markers and processing everything, writing the automatics will take
time and I wish to process the books I have now. So, some commands
have to be implemented which go towards that goal.

This actually may have another advantage. Training data. Perfectly
labeled images which can used to train some type of system for the
image classification.

Most interactivity is through the keyboard, which is generally quicker.

	Key	Note	Command		Notes
	---	----	-------		-----
(i)	SPACE		show next
(ii)	->	cursor	show next	change of selection, active item
(iii)	<-	cursor	show previous	s.a.
	---	----	-------		-----
(iv)	b		label as black marker
(v)	w		label as white marker = lightfield
(vi)	c		label as cover (front, back automatic based on the
				       section we are in)
	---	----	-------		----

The commands (iv) and (v) are enough for the system to then
automatically determine the locations of the composite markers
delimiting the various sections (garbage, even, odd), and label the
pages in the sections. The command (vi) is needed to fix the pages
which are the covers and likely mislabled as plain pages.

When all pages (for a book) are labeled we can trigger the next phase,
which

(a) places them into a separate (new) book
(b) associates each page with the nearest preceding lightfield in
    imaging order.
(c) re-orders them front to back
(d) rotates the derived images (thumbnail, page display) upright

    NOTE: the base images are not modified.
    NOTE: this is done by invalidating the data and then using the
	  labels in the scaler tasks to determine the use of rotations.
    NOTE: rotate after scaling, less data to handle.

    A problem, we have to note somewhere which thumbnails have been
    rotated, and which don't. Likely in the project database, as an
    annotation.

## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2010 Andreas Kupries.
## BSD License

## Main package of the book scanning workflow application, aka
## bookflow.

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5         ; # Required runtime.
package require Tk
package require blog            ; # End-user visible activity logging,
package require widget::log     ; # and the display for it.
package require widget::toolbar
package require scoreboard
package require bookflow::scan            ; # Task. Scan project directory for images and database
package require bookflow::error           ; # Task. Post error reports to the user.
package require bookflow::create          ; # Task. Create project database when missing and images available.
package require bookflow::verify          ; # Task. Verify project database when existing, and pre-load cached data.
package require bookflow::thumbnail       ; # Task. Generate thumbnails for page images.
package require bookflow::greyscale       ; # Task. Generate greyscale for page images.
package require bookflow::bright          ; # Task. Compute brightness of page images.
package require bookflow::project::server ; # Task. In-application database server.
package require bookw                     ; # Book Display

namespace eval ::bookflow {}

# # ## ### ##### ######## ############# #####################
## API

proc ::bookflow::run {arguments} {
    MakeGUI
    after idle [list after 10 [namespace code [list Start $arguments]]]
    vwait __forever
    return
}

# # ## ### ##### ######## ############# #####################
## Internals

proc ::bookflow::MakeGUI {} {
    wm withdraw .

    Widgets
    Layout
    Bindings

    wm deiconify .
    return
}

proc ::bookflow::Start {arguments} {
    variable project

    Log.bookflow Booting...

    if {![llength $arguments]} {
	set project [pwd]
    } else {
	set project [lindex $arguments 0]
    }

    Log.bookflow {Project in $project}

    bookflow::create         ; # Watch for request to create new project database.
    bookflow::verify         ; # Watch for request to verify existing project database.
    bookflow::error          ; # Watch for error reports
    bookflow::thumbnail      ; # Watch for thumbnail generation requests.
    bookflow::greyscale      ; # Watch for greyscale generation requests.
    bookflow::bright         ; # Watch for brightness calculation requests.
    bookflow::scan $project  ; # Scan project directory

    # TODO :: Launch the other tasklets monitoring the scoreboard for
    # TODO :: their trigger conditions.

    return
}

proc ::bookflow::Widgets {} {
    # Re-style the notebook to use left-side tab-buttons
    ttk::style configure VerticalTabsLeft.TNotebook -tabposition wn

    widget::toolbar .toolbar
    ttk::notebook   .books -style VerticalTabsLeft.TNotebook
    ::widget::log   .log -width 120 -height 2

    .toolbar add button exit -text Exit -command ::exit -separator 1
    return
}

proc ::bookflow::Layout {} {
    pack .toolbar -side top    -fill both -expand 0
    pack .books   -side top    -fill both -expand 1
    pack .log     -side bottom -fill both -expand 0
    return
}

proc ::bookflow::Bindings {} {
    # Redirect log writing into the widget
    ::log on :: 0 .log
    ::log on bookflow

    # Watch and react to scoreboard activity
    # Here: Extend the notebook when new books are announced
    scoreboard bind put {BOOK *} [namespace code BookNew]
    return
}

# # ## ### ##### ######## ############# #####################

# TODO :: Analyse BookNew/Del for race conditions when a book B is
# TODO :: rapidly added and removed multiple times.

proc ::bookflow::BookNew {tuple} {
    variable bookcounter
    variable project
    lassign $tuple _ name

    set w .books.f$bookcounter
    incr bookcounter

    ::bookw $w $name $project -log Log.bookflow
    .books add $w -sticky nsew -text $name ; # TODO : -image book-icon -compound

    # Watch and react to scoreboard activity
    # Here: Update (shrink) the notebook when this book is removed.
    scoreboard bind take [list BOOK $name] [namespace code [list BookDel $w]]
    return
}

proc ::bookflow::BookDel {w tuple} {
    # Drop the panel from the notebook, and remove the binding which invoked us.
    .books forget $w
    destroy $w
    scoreboard unbind take [list BOOK $name] [namespace code [list BookDel $w]]
    return
}

# # ## ### ##### ######## ############# #####################
## Ready

namespace eval ::bookflow {
    namespace export {[a-z]*}
    namespace ensemble create

    variable bookcounter 0
    variable project     {}
}

package provide bookflow 1.0
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookflow 1.0 [list source [file join $dir bookflow.tcl]]

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

# The main window for each book found in the project.

# NOTES
# (1) Consider moving the chart and attendant structures and methods
#     into its own megawidget.
# (2) Consider moving the thumbnail load handling into a helper class
#     too. Re-usable for the regular images ?

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

package require Tcl 8.5
package require Tk
package require snit
package require iq
package require scoreboard
package require img::strip ; # Strip of thumbnail images at the top.
package require img::page  ; # Page spread, single or double.
package require debug
package require debug::snit
package require blog
package require img::png
package require rbc
package require uevent::onidle
package require struct::set
package require math::statistics
package require bookflow::thumbnail ; # Request encapsulation

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

debug prefix bookw {[::debug::snit::call] }
debug off    bookw
#debug on     bookw

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

snit::widgetadaptor ::bookw {
    option -log -default {}

    # ### ### ### ######### ######### #########
    ##

    constructor {book project args} {
	Debug.bookw {}

	installhull using ttk::frame

	install myrbright using uevent::onidle ${selfns}::RBG [mymethod RefreshBright]
	install mytqueue  using iq             ${selfns}::QT 4 -emptycmd [mymethod Refill]
	; # TODO : Query producer for allowed rate.
	install mysqueue  using iq             ${selfns}::QB 4 ; # TODO : Query producer for allowed rate.

	set myproject $project
	set mybook    $book
	set mypattern [list IMAGE * $book]

	$self Widgets
	$self Layout
	$self Bindings

	# Note: We are peek'ing because at this time images for the
	# named book might have already been added to the scoreboard,
	# which won't be caught by the 'put' event we are registering.

	scoreboard peek      $mypattern [mymethod BookImages]
	scoreboard bind put  $mypattern [mymethod BookImageNew]
	scoreboard bind take $mypattern [mymethod BookImageDel]

	$self configurelist $args

	Debug.bookw {/}
	return
    }

    destructor {
	Debug.bookw {}

	scoreboard unbind put  $mypattern [mymethod BookImageNew]
	scoreboard unbind take $mypattern [mymethod BookImageDel]

	Debug.bookw {/}
	return
    }

    # ### ### ### ######### ######### #########
    ##

    method Widgets {} {
	# Chart of brightness values for the page images.
	rbc::graph $win.chart -height 200
	#rbc::graph $win.chart -height 400

	$win.chart axis configure y  -min 0 -max 256
	$win.chart axis configure y2 -hide 0

	rbc::vector create ${selfns}::O ; # X-axis, page serial, ordering.
	rbc::vector create ${selfns}::B ; # page brightness
	rbc::vector create ${selfns}::D ; # page brightness differences
	rbc::vector create ${selfns}::S ; # page brightness std deviation

	# Chart: Page brightness
	$win.chart element create b \
	    -xdata ${selfns}::O \
	    -ydata ${selfns}::B \
	    -color blue -symbol none -label B

	# Chart: Page brightness delta to previous
	$win.chart element create bd \
	    -xdata ${selfns}::O \
	    -ydata ${selfns}::D \
	    -mapy y2 -color red -symbol none -label D

	# Chart: Page brightness standard deviation.
	$win.chart element create bv \
	    -xdata ${selfns}::O \
	    -ydata ${selfns}::S \
	    -color orange -symbol none -label S

	# Chart: Vertical line for current selection.
	# Starting outside of the axes = invisible.
	$win.chart marker create line -name selection \
	    -fill green -outline green \
	    -coords {-1 -Inf -1 Inf}
	$win.chart marker create text -name tselectionr \
	    -coords {-1 10} -text {} -outline green -anchor w
	$win.chart marker create text -name tselectionl \
	    -coords {-1 250} -text {} -outline green -anchor e

	# Chart: Scatter plot for the points of interest. Enough for
	# all the regular chart plots.
	rbc::vector create ${selfns}::XB
	rbc::vector create ${selfns}::YB
	rbc::vector create ${selfns}::XD
	rbc::vector create ${selfns}::YD
	rbc::vector create ${selfns}::XV
	rbc::vector create ${selfns}::YV

	$win.chart element create boutlier \
	    -xdata ${selfns}::XB \
	    -ydata ${selfns}::YB \
	    -color blue -symbol circle -label {} \
	    -linewidth 0

	$win.chart element create doutlier \
	    -xdata ${selfns}::XD \
	    -ydata ${selfns}::YD \
	    -color red -symbol square -label {} \
	    -linewidth 0 -mapy y2

	$win.chart element create voutlier \
	    -xdata ${selfns}::XV \
	    -ydata ${selfns}::YV \
	    -color orange -symbol diamond -label {} \
	    -linewidth 0

	# Strip of thumbnails for the page images.
	img::strip $win.strip -orientation vertical

	# Single/double page spread.
	img::page  $win.pages
	return
    }

    method Layout {} {
	pack $win.strip    -side left   -fill both -expand 0
	pack $win.chart    -side top    -fill both -expand 0
	#pack $win.strip    -side top    -fill both -expand 0
	pack $win.pages    -side top    -fill both -expand 1
	return
    }

    method Bindings {} {

	bind $win.strip <<SelectionChanged>> \
	    [mymethod Selection %d]

	bind $win.chart <1> [mymethod ChartSelection %x]
	return
    }

    # ### ### ### ######### ######### #########

    method Selection {selection} {
	Debug.bookw {}

	if {![llength $selection]} return

	set token  [lindex $selection 0]
	set path   $mypath($token)
	set serial $myorder($path)

	Debug.bookw { | $token -> $path -> $serial}

	# Move the seletion marker and its associated texts (all in
	# the chart) to the new location.

	$win.chart marker configure selection \
	    -coords [list $serial -Inf $serial Inf]

	$win.chart marker configure tselectionr \
	    -coords [list $serial 10] -text $serial

	$win.chart marker configure tselectionl \
	    -coords [list $serial 250] -text $serial

	$self Select $serial

	Debug.bookw {/}
	return
    }

    method ChartSelection {x} {
	Debug.bookw {}

	# Screen to graph coordinates, then select the associated image.
	$self Select [expr {int([$win.chart axis invtransform x $x])}]

	Debug.bookw {/}
	return
    }

    method Select {serial} {
	# x coordinate to image path, to the token used by the strip.

	Debug.bookw {}

	if {![info exists myopath($serial)]} {
	    after idle [list after 0 [info level 0]]
	    Debug.bookw {/ defered}
	}

	set path  $myopath($serial)
	set token $mytoken($path)

	if {$myshown eq $path} return
	set myshown $path

	# Set the selection in the strip, this comes back to us via
	# 'Selection' above, which then updates the chart.
	$win.strip selection set $token

	# Request the regular page (still scaled down) for the page
	# spread underneath the chart, to the right of the strip.
	$self GetRegular $path 1

	Debug.bookw {/ shown = $myshown}
	return
    }

    # ### ### ### ######### ######### #########

    method BookImages {tuples} {
	# tuples = list ((IMAGE path serial book)...)
	Debug.bookw {}

	# For ease of processing we simply run these through
	# BookImageNew...

	foreach t $tuples {
	    $self BookImageNew $t
	}

	Debug.bookw {/}
	return
    }

    method BookImageNew {tuple} {
	# tuple = (IMAGE path serial book)
	Debug.bookw {}

	lassign $tuple _ path serial book
	# TODO : Should assert that book is the expected one.

	incr mycountimages
	$self Log "Book $book ($path /$mycountimages)"

	set token [$win.strip new]
	$win.strip itemconfigure $token \
	    -label   "$path ($serial)" \
	    -order   $serial \
	    -message {Creating thumbnail...}

	set mytoken($path)     $token
	set mypath($token)     $path
	set myorder($path)     $serial
	set myopath($serial)   $path

	# Issue requests for the derived data needed by the widget.
	$self GetThumbnail  $path
	$self GetStatistics $path

	# Handling of the medium size thumbnail. First one request
	# immediately for display. Also immediately if all small
	# thumbnails known. Otherwise defer to to when the issue queue
	# emptied (of small thumbnails).

	if {$mycountimages < 2} {
	    after idle [mymethod Select 0]
	} elseif {$mycountthumbsmall == $mycountimages} {
	    $self GetRegular $path 1
	} else {
	    lappend mympending $path
	}

	$win.chart axis configure x -min 0 -max $mycountimages

	Debug.bookw {/}
	return
    }

    method BookImageDel {tuple} {
	# tuple = (IMAGE path serial book)
	Debug.bookw {}

	lassign $tuple _ path serial book
	# TODO : Should assert that book is the expected one.

	incr mycountimages      -1
	incr mycountthumbsmall  -1
	incr mycountthumbmedium -1
	incr mycountstat        -1
	$self Log "Book $book ($path /$mycountimages)"

	# doc/interaction_pci.txt (5), release monitor
	scoreboard unbind take [list THUMBNAIL $path *] [mymethod InvalidThumbnail]
	# doc/interaction_pci.txt (4) - A waiting wpeek cannot released/canceled.
	#scoreboard wpeek [list THUMBNAIL $path *] [mymethod HaveThumbnail]

	# doc/interaction_pci.txt (5), release monitor
	scoreboard unbind take [list STATISTICS $path *] [mymethod InvalidStatistics]
	# doc/interaction_pci.txt (4) - A waiting wpeek cannot released/canceled.
	#scoreboard wpeek [list STATISTICS $path *] [mymethod HaveThumbnail]

	set token  $mytoken($path)
	set serial $myorder($path)

	unset mytoken($path)
	unset mypath($token)
	unset myorder($path)
	unset myopath($serial)

	$win.strip drop $token
	$myrbright request

	$win.chart axis configure x -min 0 -max $mycountimages

	Debug.bookw {/}
	return
    }

    # ### ### ### ######### ######### #########

    method GetThumbnail {path} {
	Debug.bookw {}

	set request [bookflow::thumbnail::request $path 160];# x120

	# doc/interaction_pci.txt (5).
	scoreboard bind take $request [mymethod InvalidThumbnail]

	# doc/interaction_pci.txt (4). Uses rate-limiting queue
	$mytqueue put $request [mymethod HaveThumbnail]

	Debug.bookw {/}
	return
    }

    # doc/interaction_pci.txt (5).
    method InvalidThumbnail {tuple} {
	# tuple = (THUMBNAIL image-path size thumbnail-path)
	Debug.bookw {}

	lassign $tuple _ path size thumb
	if {$size != 160} { error {Size mismatch} }

	# Ignore invalidation of a small thumbnail when its image is
	# not used here any longer.

	if {![info exists mytoken($path)]} {
	    Debug.bookw {ignored/}
	    return
	}

	incr mycountthumbsmall -1
	$self Log "Refresh TS $path $mycountthumbsmall/$mycountimages"

	# Still using the image, therefore request a shiny new valid
	# small thumbnail. doc/interaction_pci.txt (4).

	$win.strip itemconfigure $mytoken($path) \
	    -message {Invalidated...}

	$mytqueue put [bookflow::thumbnail::request $path $size] [mymethod HaveThumbnail]

	Debug.bookw {/}
	return
    }

    # doc/interaction_pci.txt (4).
    method HaveThumbnail {tuple} {
	# tuple = (THUMBNAIL image-path size thumbnail-path)
	# Paths are relative to the project directory
	Debug.bookw {}

	lassign $tuple _ path size thumb
	if {$size != 160} { error {Size mismatch} }

	# Ignore the incoming thumbnail when its image is not used
	# here any longer.

	if {![info exists mytoken($path)]} {
	    Debug.bookw {ignored/}
	    return
	}

	incr mycountthumbsmall
	$self Log "Thumbnail S $path $mycountthumbsmall/$mycountimages"

	# Load small thumbnail and place it into the strip
	# proper. Careful, retrieve and destroy any previously shown
	# thumbnail first.

	set photo [$win.strip itemcget $mytoken($path) -image]
	if {$photo ne {}} {
	    image delete $photo
	}

	set photo [image create photo -file $myproject/$thumb]
	$win.strip itemconfigure $mytoken($path) \
	    -image   $photo \
	    -message {}

	Debug.bookw {/}
	return
    }

    # ### ### ### ######### ######### #########

    method Refill {args} {
	if {![llength mympending]} return
	foreach path $mympending {
	    $self GetRegular $path
	}
	set mympending {}
	return
    }

    # ### ### ### ######### ######### #########

    method GetRegular {path {fasttrack 0}} {
	Debug.bookw {}

	if {![string match {IMG_*} $path]} { error {Bad Path} }

	set request [bookflow::thumbnail::request $path 800];# x600

	# doc/interaction_pci.txt (5).
	scoreboard bind take $request [mymethod InvalidRegular]

	# doc/interaction_pci.txt (4). Uses rate-limiting queue. The
	# same as the 160er thumbnails.
	if {$fasttrack} {
	    # Bypass queue for fast track issue.
	    scoreboard wpeek $request [mymethod HaveRegular]
	} else {
	    $mytqueue put $request [mymethod HaveRegular]
	}

	Debug.bookw {/}
	return
    }

    # doc/interaction_pci.txt (5).
    method InvalidRegular {tuple} {
	# tuple = (THUMBNAIL image-path size thumbnail-path)
	Debug.bookw {}

	lassign $tuple _ path size thumb
	if {$size != 800} { error {Size mismatch} }

	# Ignore invalidation of a medium thumbnail when its image is
	# not used here any longer. Ditto if the image is used, but
	# not shown.

	if {![info exists mytoken($path)] ||
	    ($myshown ne $path)} {
	    Debug.bookw {ignored/}
	    return
	}

	incr mycountthumbmedium -1
	$self Log "Refresh TM $path $mycountthumbmedium/$mycountimages"

	# Still using the image, therefore request a shiny new valid
	# medium thumbnail. doc/interaction_pci.txt (4).

	# TODO : Get and destroy currently shown image...

	$win.pages even image {}
	$win.pages even text  {Invalidated...}

	$mytqueue put [bookflow::thumbnail::request $path $size] [mymethod HaveRegular]

	Debug.bookw {/}
	return
    }

    # doc/interaction_pci.txt (4).
    method HaveRegular {tuple} {
	# tuple = (THUMBNAIL image-path size thumbnail-path)
	# Paths are relative to the project directory.
	Debug.bookw {}

	lassign $tuple _ path size thumb
	if {$size != 800} { error {Size mismatch} }

	incr mycountthumbmedium
	$self Log "Regular M $path $mycountthumbmedium/$mycountimages"

	# Ignore the incoming medium thumbnail when its image is not
	# used here any longer. Ditto if the image is used, but not
	# shown.

	if {![info exists mytoken($path)] ||
	    ($myshown ne $path)} {
	    Debug.bookw {ignored/ [info exists mytoken($path)], ($myshown ne $path)? $myshown = $path}
	    return
	}

	# Load medium thumbnail and place it into the page spread
	# proper. Careful, retrieve and destroy any previously shown
	# image first.

	# TODO - get and delte previous image
	#set photo [$win.strip itemcget $mytoken($path) -image]
	#if {$photo ne {}} { image delete $photo }

	set photo [image create photo -file $myproject/$thumb]

	$win.pages even text  {}
	$win.pages even image $photo

	Debug.bookw {/}
	return
    }

    # ### ### ### ######### ######### #########

    method GetStatistics {path} {
	Debug.bookw {}

	# doc/interaction_pci.txt (5).
	scoreboard bind take [list STATISTICS $path *] [mymethod InvalidStatistics]

	# doc/interaction_pci.txt (4). Uses rate-limiting queue
	$mysqueue put [list STATISTICS $path *] [mymethod HaveStatistics]

	Debug.bookw {/}
	return
    }

    # doc/interaction_pci.txt (5).
    method InvalidStatistics {tuple} {
	# tuple = (STATISTICS image-path statistics)
	Debug.bookw {}

	lassign $tuple _ path statistics

	# Ignore invalidation of statistics when its image is not used
	# here any longer.

	if {![info exists mytoken($path)]} {
	    Debug.bookw {/}
	    return
	}

	incr mycountstat -1
	$self Log "Refresh S $path $mycountstat/$mycountimages"

	# Still using the image, therefore request shiny new valid
	# statistics for it. doc/interaction_pci.txt (4).

	unset mystat($path)
	$myrbright request

	$mysqueue put [list STATISTICS $path *] [mymethod HaveStatistics]

	Debug.bookw {/}
	return
    }

    # doc/interaction_pci.txt (4).
    method HaveStatistics {tuple} {
	# tuple = (STATISTICS image-path statistics)
	# Paths are relative to the project directory
	Debug.bookw {}

	lassign $tuple _ path statistics

	# Ignore the incoming statistics when its image is not
	# used here any longer.

	if {![info exists mytoken($path)]} {
	    Debug.bookw {/}
	    return
	}

	incr mycountstat
	$self Log "Statistics $path $mycountstat/$mycountimages"

	set mystat($path) $statistics
	$myrbright request

	Debug.bookw {/}
	return
    }

    method RefreshBright {} {
	Debug.bookw {}

	# Pull the currently known statistics out of our data
	# structures, put the brightnesses into the proper order, then
	# stuff the result into the chart.

	set o {}
	set b {}
	set s {}
	set d {}
	set l {}

	set bxy {}

	foreach serial [lsort -dict [array names myopath]] {
	    set path $myopath($serial)
	    if {![info exists mystat($path)]} continue

	    lassign $mystat($path) _ _ mean _ _ stddev _ _
	    # brightness = mean.
	    lappend o $serial
	    lappend b $mean
	    lappend s $stddev
	    lappend d [expr {($l eq {}) ? 0 : ($mean - $l)}]
	    set l $mean

	    # dict form of x/y, mapping x to y, for the fusing below.
	    lappend bxy $serial $mean 
	}

	Debug.bookw { O = ($o)}
	Debug.bookw { B = ($b)}
	Debug.bookw { D = ($d)}
	Debug.bookw { S = ($s)}

	${selfns}::O set $o
	${selfns}::B set $b
	${selfns}::D set $d
	${selfns}::S set $s

	# Outliers, computed from global statistics of the page brightness.
	if {[llength $o]} {
	    # Get 2-sigma outliers for page brightness
	    lassign [Outlier $o $b] bx by
	    # Get 2-sigma outliers for page brightness differences
	    lassign [Outlier $o $d] dx dy
	    # Get 2-sigma outliers for page brightness stddev
	    lassign [DownOutlier $o $s] vx vy

	    # Fuse the results. Points of interest are the locations of
	    # stddev outliers and the locations where both brightness and
	    # brightness deltas indicate outliers. Compute the y locations
	    # for these using the bxy map.

	    set ix [lsort -integer [struct::set union $vx [struct::set intersect $bx $dx]]]
	    set iy {} ; foreach x $ix { lappend iy [dict get $bxy $x] }

	    ${selfns}::XB set $ix
	    ${selfns}::YB set $iy

	    #${selfns}::XD set $dx
	    #${selfns}::YD set $dy

	    #${selfns}::XV set $vx
	    #${selfns}::YV set $vy
	}

	Debug.bookw {/}
	return
    }

    # Find the t-sigma outliers above and below the yseries average.
    proc Outlier {xseries yseries {t 2}} {
	lassign [math::statistics::basic-stats $yseries] \
	    avg min max n stddev var pstddev pvar

	set t [expr {$t * $stddev}]
	set xo {}
	set yo {}
	foreach x $xseries y $yseries {
	    if {abs($y - $avg) < $t} continue
	    lappend xo $x
	    lappend yo $y
	}

	return [list $xo $yo]
    }

    # Find the t-sigma outliers below the yseries average
    proc DownOutlier {xseries yseries {t 2}} {
	lassign [math::statistics::basic-stats $yseries] \
	    avg min max n stddev var pstddev pvar

	set t [expr {$t * $stddev}]
	set xo {}
	set yo {}
	foreach x $xseries y $yseries {
	    if {($avg - $y) < $t} continue
	    lappend xo $x
	    lappend yo $y
	}

	return [list $xo $yo]
    }

    # ### ### ### ######### ######### #########

    method Log {text} {
	if {$options(-log) eq {}} return
	uplevel #0 [list {*}$options(-log) $text]
	return
    }

    # ### ### ### ######### ######### #########
    ##

    variable myproject ; # Path of project directory.
    variable mybook    ; # Name of the book this is connected to
    variable mypattern ; # Scoreboard pattern for images of this book.

    variable mytoken -array {}  ; # Map image PATHs to the associated
				  # TOKEN in the strip of images.
    variable mypath  -array {}  ; # Map tokens back to their image PATHs.
    variable myorder -array {}  ; # Map image PATHs to the associated
				  # order in the strip of images, and
				  # chart of page brightness,
    variable myopath -array {}  ; # Map serial order to image PATH.
    variable mystat  -array {}  ; # Map image PATHs to the associated
				  # page statistics.

    variable myrbright    {} ; # onidle collator for brightness refresh
    variable mytqueue     {} ; # Issue queue for thumbnails
    variable mysqueue     {} ; # Issue queue for statistics

    variable mycountimages      0 ; # Number of managed images
    variable mycountthumbsmall  0 ; # Number of managed small thumbnails
    variable mycountthumbmedium 0 ; # Number of managed medium thumbnails
    variable mycountstat        0 ; # Number of managed brightness values

    variable myshown {} ; # PATH of currently shown/selected page.

    variable mympending {} ; # List of pages for which the medium
			     # sized thumbnails are pending.

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

# ### ### ### ######### ######### #########
## Ready

package provide bookw 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookw 0.1 [list source [file join $dir bookw.tcl]]

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

# Background task. Continuous.
# Calculating the basic statistica values for page images.

# Called 'brightness' for historical reasons. That was the only value
# computed here at first (mean).

# A producer in terms of "doc/interaction_pci.txt"
# A consumer as well, of page greyscale images.
#
# Calculated statistical values are cached in the project database.

# Limits itself to no more than four actual threads in flight,
# i.e. computing image statistics. The computing tasks do not exit on
# completion, but wait for more operations to perform. Communication
# and coordination is done through the scoreboard. As usual.

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

package require debug
package require blog
package require task
package require scoreboard
package require bookflow::project

namespace eval ::bookflow::bright {}

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

debug off    bookflow/bright
#debug on     bookflow/bright

# ### ### ### ######### ######### #########
## API & Implementation

proc ::bookflow::bright {} {
    Debug.bookflow/bright {Bookflow::Bright Watch}

    scoreboard wpeek {AT *} [namespace code bright::BEGIN]

    Debug.bookflow/bright {/}
    return
}

proc ::bookflow::bright::BEGIN {tuple} {
    # tuple = (AT project)

    Debug.bookflow/bright {Bookflow::Bright BEGIN <$tuple>}

    lassign $tuple _ project

    ::bookflow::project::ok [namespace code [list INIT $project]]

    Debug.bookflow/bright {Bookflow::Bright BEGIN/}
    return
}

proc ::bookflow::bright::INIT {project} {
    Debug.bookflow/bright {Bookflow::Bright INIT}

    # Monitor for invalidation of statistics
    # doc/interaction_pci.txt (1)
    scoreboard take {!STATISTICS *} [namespace code INVALIDATE]

    # Launch the tasks doing the actual resizing.
    variable max
    for {set i 0} {$i < $max} {incr i} {
	task launch [list ::apply {{project} {
	    package require bookflow::bright
	    bookflow::bright::STATISTICS $project
	}} $project]
    }

    # Monitor for bright creation requests.
    # doc/interaction_pci.txt (2)
    scoreboard bind missing {STATISTICS *} [namespace code MAKE]

    Debug.bookflow/bright {Bookflow::Bright INIT/}
    return
}

# ### ### ### ######### ######### #########
## Internals. Bright invalidation. See doc/interaction_pci.txt (1).

proc ::bookflow::bright::INVALIDATE {tuple} {
    # tuple = (!STATISTICS path)
    lassign $tuple _ path

    Debug.bookflow/bright {Bookflow::Bright INVALIDATE $path}

    scoreboard takeall [list STATISTICS $path *] [namespace code [list RETRACT $path]]

    Debug.bookflow/bright {Bookflow::Bright INVALIDATE/}
    return
}

proc ::bookflow::bright::RETRACT {path tuples} {
    Debug.bookflow/bright {Bookflow::Bright RETRACT $path}

    ::bookflow::project statistics unset $path

    # Look for more invalidation requests
    scoreboard take {!STATISTICS *} [namespace code INVALIDATE]

    Debug.bookflow/bright {Bookflow::Bright RETRACT/}
    return
}

# ### ### ### ######### ######### #########
## Internals. Bright creation. See doc/interaction_pci.txt (2).

proc ::bookflow::bright::MAKE {pattern} {
    # pattern = (STATISTICS path *)
    Debug.bookflow/bright {Bookflow::Bright MAKE <$pattern>}

    lassign $pattern _ path

    set statistics [::bookflow::project statistics get $path]

    if {$statistics ne {}} {
	# The requested values already existed in the project database,
	# simply make them available.

	# TODO :: Have the verify task-to-be load existing brightness
	# TODO :: information to shortcircuit even this fast bailout.
	# TODO :: Note however that we will then need some way to
	# TODO :: prevent the insertion of duplicate or similar tuples.

	RESULT $path $statistics
    } else {
	# Statistics are not known. Put in a request for the computing
	# tasks to generate them. This will also put the proper result
	# into the scoreboard on completion.

	scoreboard put [list STATSQ $path]
    }

    Debug.bookflow/bright {Bookflow::Bright MAKE/}
    return
}

proc ::bookflow::bright::RESULT {path statistics} {
    scoreboard put [list STATISTICS $path $statistics]
    return
}

# ### ### ### ######### ######### #########
## Internals. Implementation of the calculation tasks.

proc ::bookflow::bright::STATISTICS {project} {
    package require debug
    Debug.bookflow/bright {Bookflow::Bright STATISTICS}

    # Requisites for the task
    package require bookflow::bright
    package require bookflow::project
    package require scoreboard
    package require crimp ; wm withdraw .
    package require fileutil

    # Start waiting for requests.
    ::bookflow::project::ok [namespace code [list READY $project]]

    Debug.bookflow/bright {Bookflow::Bright STATISTICS/}
    return
}

proc ::bookflow::bright::READY {project} {
    # Wait for more requests.
    scoreboard take {STATSQ *} [namespace code [list STAT $project]]
    return
}

proc ::bookflow::bright::STAT {project tuple} {
    # tuple = (STATSQ path)

    # Decode request
    lassign $tuple _ path
    Debug.bookflow/bright {Bookflow::Bright STAT $path}

    # Get the greyscale form of the image
    scoreboard take [list GREYSCALE $path *] [namespace code [list MEAN $project]]

    Debug.bookflow/bright {Bookflow::Bright STAT/}
    return
}

proc ::bookflow::bright::MEAN {project tuple} {
    # tuple = (GREYSCALE path grey-path)

    lassign $tuple _ path grey
    Debug.bookflow/bright {Bookflow::Bright MEAN $path |$grey}

    set data  [fileutil::cat -translation binary $project/$grey]
    Debug.bookflow/bright {  read ok       $path}

    set image [crimp read pgm $data]
    Debug.bookflow/bright {  pgm read ok   $path}

    set stats [crimp statistics basic $image]
    Debug.bookflow/bright {  statistics ok $path}

    array set s [dict get $stats channel luma]
    Debug.bookflow/bright {  statistics ok $path}

    set statistics [list $s(min) $s(max) $s(mean) $s(middle) $s(median) $s(stddev) $s(variance) $s(hf)]

    # Save/Cache result in the project.
    ::bookflow::project statistics set $path {*}$statistics
    Debug.bookflow/bright {  db ok         $path}

    # Push result
    RESULT $path $statistics

    # Wait for more requests.
    READY $project

    Debug.bookflow/bright {Bookflow::Bright MEAN $path = $statistics/}
    return
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::bookflow::bright {
    # Number of parallel calculation tasks.
    variable max 4
}

# ### ### ### ######### ######### #########
## Ready

package provide bookflow::bright 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookflow::bright 0.1 [list source [file join $dir bright.tcl]]

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

# Background task.
# Waiting for requests to create an initial project database.
# Launches the task when the request is found.

# Creates the specified directory, looking for the BOOKFLOW database and
# JPEG images.

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

package require debug
package require blog
package require task

namespace eval ::bookflow::create {}

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

debug off    bookflow/create
#debug on     bookflow/create

# ### ### ### ######### ######### #########
## API & Implementation

proc ::bookflow::create {} {
    Debug.bookflow/create {Bookflow::Create Watch}

    scoreboard take {PROJECT CREATE} [namespace code create::RUN]

    Debug.bookflow/create {/}
}

# ### ### ### ######### ######### #########
## Internals

proc ::bookflow::create::RUN {tuple} {
    Debug.bookflow/create {Bookflow::Create RUN}

    Log.bookflow {Creating project database...}

    task launch [list ::apply {{} {
	package require bookflow::create
	bookflow::create::TASK
    }}]

    Debug.bookflow/create {Bookflow::Create RUN/}
    return
}

proc ::bookflow::create::TASK {} {
    package require debug
    Debug.bookflow/create {Bookflow::Create TASK}

    # Requisites for the task
    package require scoreboard
    package require bookflow::create
    package require bookflow::project ; # client

    scoreboard wpeek {AT *} [namespace code BEGIN]

    Debug.bookflow/create {Bookflow::Create TASK/}
    return
}

proc ::bookflow::create::BEGIN {tuple} {
    # tuple = (AT project)
    variable defaultfile

    Debug.bookflow/create {Bookflow::Create BEGIN <$tuple>}

    # Get the payload
    lassign $tuple _ projectdir

    # Declare database presence, triggers creation.
    Log.bookflow {% Project database $defaultfile}
    scoreboard put    [list DATABASE $defaultfile]

    # At this point the server thread will complete initialization and
    # provide access to the database. We wait until it has done so:

    ::bookflow::project::ok [namespace code [list WaitForServerStart $projectdir]]

    Debug.bookflow/create {Bookflow::Create BEGIN/}
    return
}

proc ::bookflow::create::WaitForServerStart {project} {
    Debug.bookflow/create {Bookflow::Create WaitForServerStart}

    # Fill the database using the image files found by the scanner.
    scoreboard takeall {FILE*} [namespace code [list FILES $project]]

    Debug.bookflow/create {Bookflow::Create WaitForServerStart/}
    return
}

proc ::bookflow::create::FILES {project tuples} {
    Debug.bookflow/create {Bookflow::Create FILES}
    # tuples = list ((FILE *)...)

    # ... pull books out of the database and declare them ...
    # ... push files into the @scratch book, and declare
    # them as images, with book link ...

    foreach b [::bookflow::project books] {
	Debug.bookflow/create {                   BOOK $b}
	scoreboard put [list BOOK $b]
    }

    # Sorted by file name (like IMG_nnnn), this is the initial order.
    foreach def [lsort -dict -index 1 $tuples] {
	lassign $def _ jpeg
	set serial [::bookflow::project book extend @SCRATCH $jpeg \
			[file mtime $project/$jpeg]]

	Debug.bookflow/create {                   IMAGE $jpeg $serial @SCRATCH}
	scoreboard put [list IMAGE $jpeg $serial @SCRATCH]
    }

    Debug.bookflow/create {Bookflow::Create FILES/}

    task::exit
    return
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::bookflow {
    namespace export create
    namespace ensemble create

    namespace eval create {
	variable defaultfile BOOKFLOW
    }
}

# ### ### ### ######### ######### #########
## Ready

package provide bookflow::create 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookflow::create 0.1 [list source [file join $dir create.tcl]]

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

# Access to a bookflow database, file identification, creation, etc.

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

package require debug
package require debug::snit
package require snit
package require sqlite3

namespace eval ::bookflow::db {}

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

debug prefix bookflow/db {[::debug::snit::call] }
debug off    bookflow/db
#debug on     bookflow/db

# ### ### ### ######### ######### #########
## API & Implementation

snit::type ::bookflow::db {
    # ### ### ### ######### ######### #########

    typemethod isBookflow {path} {
	if {![file exists $path]} { return 0 }
	if {![file isfile $path]} { return 0 }

	# FUTURE :: Extend fileutil::fileType
	# readable, sqlite database ?
	if {[catch {
	    set c [open $path r]
	    fconfigure $c -translation binary
	}]} { return 0 }
	set head [read $c 15]
	close $c
	if {$head ne {SQLite format 3}} { return 0 }

	# check for the bookflow tables
	set db ${type}::DB
	sqlite3 $db $path
	set ok [expr {[Has $db bookflow] &&
		      [Has $db book] &&
		      [Has $db image] &&
		      [Has $db statistics]}]
	$db close
	return $ok
    }

    proc Has {db table} {
	return [llength [$db eval {
	    SELECT name
	    FROM sqlite_master
	    WHERE type = 'table'
	    AND   name = $table
	    ;
	}]]
    }

    # ### ### ### ######### ######### #########

    typemethod new {path} {
	Debug.bookflow/db { @ $path}

	# Create the database file at the specified location, and fill
	# it with the necessary tables.

	set db ${type}::DB
	sqlite3 $db $path
	$db eval {
	    -- Global, per project information
	    CREATE TABLE bookflow (
	       dpi INTEGER NOT NULL -- dots per inch for the whole project.
	    );

	    -- A project is subdivided into one or more books.
	    -- Note that each project internally uses two standard
	    -- 'books'. These are the 'scratchpad' holding all
	    -- images not assigned to a user-created book, and the
	    -- 'trash' holding the data about images which are gone,
	    -- for their eventual resurrection.

	    CREATE TABLE book (
	       bid  INTEGER  NOT NULL  PRIMARY KEY  AUTOINCREMENT,
	       name TEXT     NOT NULL  UNIQUE

	       -- FUTURE : More book information, like author, isbn,
	       -- FUTURE : printing datum, etc. Possibly in a separate
	       -- FUTURE : table for meta data.
	    );

	    -- The @ character is illegal in user-specified book names,
	    -- ensuring that the standard books can never be in conflict
	    -- with the user's names.

	    INSERT INTO book VALUES (0,'@SCRATCH');
	    INSERT INTO book VALUES (1,'@TRASH');

	    -- All images, which always belong to a single book.
	    -- Images have an order imposed on them (see field 'ord'),
	    -- which is unique within a book.

	    CREATE TABLE image (
	       iid   INTEGER  NOT NULL  PRIMARY KEY  AUTOINCREMENT,
	       path  TEXT     NOT NULL  UNIQUE,
	       bid   INTEGER  NOT NULL  REFERENCES book,
	       ord   INTEGER  NOT NULL,
	       mtime INTEGER  NOT NULL,
	       UNIQUE (bid, ord)
	    );

	    -- Statistical data for all images. Used to classify
            -- images, distinguishing markers from regular pages.
            -- Actually the whole slew of basic statistics. Just in
            -- case. (Machine-learning over lots of prjects ?!).

	    CREATE TABLE statistics (
	       iid       INTEGER  NOT NULL  REFERENCES image,
	       min       INTEGER  NOT NULL,
	       max       INTEGER  NOT NULL,
	       mean      REAL     NOT NULL,
	       middle    REAL     NOT NULL,
	       median    INTEGER  NOT NULL,  
	       stddev    REAL     NOT NULL,
	       variance  REAL     NOT NULL,
	       histogram TEXT     NOT NULL,
	       UNIQUE (iid)
	    );
	}
	$db close

	Debug.bookflow/db {}
	return [$type create %AUTO% $path]
    }

    # ### ### ### ######### ######### #########

    constructor {path} {
	Debug.bookflow/db { @ $path}

	set mydb ${selfns}::DB
	sqlite3 $mydb $path

	Debug.bookflow/db {}
	return
    }

    # ### ### ### ######### ######### #########

    method books {} {
	Debug.bookflow/db {}
	return [$mydb eval { SELECT name FROM book }]
    }

    method {book extend} {book file mtime} {
	Debug.bookflow/db {}

	$mydb transaction {
	    # Locate the named book, and retrieve its id.
	    set bid [lindex [$mydb eval {
		SELECT bid FROM book WHERE name = $book
	    }] 0]

	    # Get the last (= highest) ordering number for images in this book.
	    set ord [lindex [$mydb eval {
		SELECT MAX (ord) FROM image WHERE bid = $bid
	    }] 0]

	    # The new images is added behind the last-highest images.
	    if {$ord eq {}} { set ord -1 }
	    incr ord

	    Debug.bookflow/db { /book $bid, @$ord}

	    # And enter the image into the database.
	    $mydb eval {
		INSERT INTO image
		VALUES (NULL, $file, $bid, $ord, $mtime)
	    }
	}

	Debug.bookflow/db {/}
	return $ord
    }

    method {book holding} {file} {
	Debug.bookflow/db {}
	return [lindex [$mydb eval {
	    SELECT name FROM book
	    WHERE bid = (SELECT bid FROM image
			 WHERE path = $file)
	}] 0]
    }

    method {book files} {book} {
	Debug.bookflow/db {}
	return [$mydb eval {
	    SELECT path, ord
	    FROM image
	    WHERE bid = (SELECT bid FROM book
			 WHERE name = $book)
	}]
    }

    # NOTE: Moves leave gaps in the serial numbering of the origin
    # books. While this doesn't affect the ordering in itself, other
    # parts using the serial number may assume that there are no
    # gaps. Example: The book manager widget uses the serial numbers
    # for the x-axis of the brightness chart, and gaps will show up
    # there. Consider some mechanism to remove/prevent such gaps.

    method {book move} {book file} {
	Debug.bookflow/db {}

	$mydb transaction {
	    # Locate the named book, and retrieve its id.
	    set bid [lindex [$mydb eval {
		SELECT bid FROM book WHERE name = $book
	    }] 0]

	    # Get the last (= highest) ordering number for images in this book.
	    set ord [lindex [$mydb eval {
		SELECT MAX (ord) FROM image WHERE bid = $bid
	    }] 0]

	    # The new images is added behind the last-highest images.
	    if {$ord eq {}} { set ord -1 }
	    incr ord

	    Debug.bookflow/db { /book $bid, @$ord}

	    # And change the image in the database.
	    $mydb eval {
		UPDATE image
		SET bid = $bid,
		    ord = $ord
		WHERE path = $file
	    }
	}

	Debug.bookflow/db {/}
	return $ord
    }

    method files {} {
	Debug.bookflow/db {}
	return [$mydb eval { SELECT path FROM image }]
    }

    method {file mtime} {file} {
	Debug.bookflow/db {}
	return [$mydb eval { SELECT mtime FROM image WHERE path = $file }]
    }


    method {statistics set} {file min max mean middle median stddev variance histogram} {
	Debug.bookflow/db {}

	$mydb transaction {
	    # Locate the id of the file.
	    set iid [lindex [$mydb eval {
		SELECT iid
		FROM   image
		WHERE  path = $file
	    }] 0]

	    # And enter the value into the database.
	    $mydb eval {
		INSERT INTO statistics
		VALUES ($iid, $min, $max, $mean, $middle, $median, $stddev, $variance, $histogram)
	    }
	}

	Debug.bookflow/db {/}
	return
    }

    method {statistics unset} {file} {
	Debug.bookflow/db {}

	$mydb transaction {
	    # Remove the statistics value.
	    $mydb eval {
		DELETE FROM statistics
		WHERE iid IN (SELECT iid FROM image WHERE path = $file)
	    }
	}

	Debug.bookflow/db {/}
	return
    }

    method {statistics get} {file} {
	Debug.bookflow/db {}

	$mydb transaction {
	    set res [$mydb eval {
		SELECT min, max, mean, middle, median, stddev, variance, histogram
		FROM   statistics
		WHERE iid IN (SELECT iid FROM image WHERE path = $file)
	    }]
	}

	#lassign $res min max mean middle median stddev variance histogram
	Debug.bookflow/db {= $res /}
	return $res
    }

    ### Accessors and manipulators

    # ### ### ### ######### ######### #########
    ##

    variable mydb ; # Handle of the sqlite database. Object command.

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

# ### ### ### ######### ######### #########
## Ready

package provide bookflow::db 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookflow::db 0.1 [list source [file join $dir db.tcl]]

# Debug - a debug narrative logger -- Colin McCormack / Wub server utilities
#
# Debugging areas of interest are represented by 'tokens' which have 
# independantly settable levels of interest (an integer, higher is more detailed)
#
# Debug narrative is provided as a tcl script whose value is [subst]ed in the 
# caller's scope if and only if the current level of interest matches or exceeds
# the Debug call's level of detail.  This is useful, as one can place arbitrarily
# complex narrative in code without unnecessarily evaluating it.
#
# TODO: potentially different streams for different areas of interest.
# (currently only stderr is used.  there is some complexity in efficient
# cross-threaded streams.)

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

package require Tcl 8.5

namespace eval ::debug {}

# ### ### ### ######### ######### #########
## API & Implementation

proc ::debug::noop {args} {}

proc ::debug::debug {tag message {level 1}} {
    variable detail
    if {$detail($tag) < $level} {
	#puts stderr "$tag @@@ $detail($tag) >= $level"
	return
    }

    variable prefix
    variable fds
    set fd $fds($tag)

    # Integrate global and tag prefixes with the user message.
    set themessage ""
    if {[info exists prefix(::)]}   { append themessage $prefix(::)   }
    if {[info exists prefix($tag)]} { append themessage $prefix($tag) }
    append themessage $message

    # Resolve variables references and command invokations embedded
    # into the message with plain text.
    set code [catch {
	uplevel 1 [list ::subst -nobackslashes $themessage]
    } result eo]

    if {$code} {
	if {[catch {
	    set x [info level -1]
	}]} { set x GLOBAL }
	puts -nonewline $fd @@[string map {\n \\n \r \\r} "(DebugError from $tag [if {[string length $x] < 1000} {set x} else {set x "[string range $x 0 200]...[string range $x end-200 end]"}] ($eo)):"]
    } else {
	if {[string length $result] > 4096} {
	    set result "[string range $result 0 2048]...(truncated) ... [string range $result end-2048 end]"
	}
	puts $fd "$tag | [join [split $result \n] "\n$tag |  "]"
    }
    return
}

# names - return names of debug tags
proc ::debug::names {} {
    variable detail
    return [lsort [array names detail]]
}

proc ::debug::2array {} {
    variable detail
    set result {}
    foreach n [lsort [array names detail]] {
	if {[interp alias {} Debug.$n] ne "::Debug::noop"} {
	    lappend result $n $detail($n)
	} else {
	    lappend result $n -$detail($n)
	}
    }
    return $result
}

# level - set level and fd for tag
proc ::debug::level {tag {level ""} {fd stderr}} {
    variable detail
    if {$level ne ""} {
	set detail($tag) $level
    }

    if {![info exists detail($tag)]} {
	set detail($tag) 1
    }

    variable fds
    set fds($tag) $fd

    return $detail($tag)
}

# set prefix to use for tag.
# The global (tag-independent) prefix is adressed through tag == '::'`.
# This works because colon (:) is an illegal character for regular tags.
proc ::debug::prefix {tag {theprefix {}}} {
    variable prefix
    set prefix($tag) $theprefix
    return
}

# turn on debugging for tag
proc ::debug::on {tag {level ""} {fd stderr}} {
    variable active
    set active($tag) 1
    level $tag $level $fd
    interp alias {} Debug.$tag {} ::debug::debug $tag
    return
}

# turn off debugging for tag
proc ::debug::off {tag {level ""} {fd stderr}} {
    variable active
    set active($tag) 1
    level $tag $level $fd
    interp alias {} Debug.$tag {} ::debug::noop
    return
}

proc ::debug::setting {args} {
    if {[llength $args] == 1} {
	set args [lindex $args 0]
    }
    set fd stderr
    if {[llength $args]%2} {
	set fd [lindex $args end]
	set args [lrange $args 0 end-1]
    }
    foreach {tag level} $args {
	if {$level > 0} {
	    level $tag $level $fd
	    interp alias {} Debug.$tag {} ::Debug::debug $tag
	} else {
	    level $tag [expr {-$level}] $fd
	    interp alias {} Debug.$tag {} ::Debug::noop
	}
    }
    return
}

namespace eval debug {
    variable detail  ; # map: TAG -> level of interest
    variable prefix  ; # map: TAG -> message prefix to use
    variable fds     ; # map: TAG -> handle of open channel to log to.

    # Notes:
    # The tag '::' is reserved, prefix() uses it to store the global message prefix.

    namespace export -clear *
    namespace ensemble create -subcommands {}
}

# ### ### ### ######### ######### #########
## Communication setup for concurrent tasks.
## Thread based.

namespace eval ::debug::thread {}

proc ::debug::thread::link {main} {
    variable ::debug::detail
    variable ::debug::prefix

    # Import main's status.
    array set detail [thread::send $main {array get ::debug::detail}]
    array set prefix [thread::send $main {array get ::debug::prefix}]
    array set active [thread::send $main {array get ::debug::active}]
    # We do not import the channels. Cannot share them among threads,
    # only transfer.

    # Replicate (in)active status of the tags.
    foreach {t a} [array get active] {
	if {$a} {
	    interp alias {} Debug.$t {} ::debug::debug $t
	} else {
	    interp alias {} Debug.$t {} ::debug::noop
	}
    }
    return
}

# ### ### ### ######### ######### #########
## Look for the magic of package task, and if found import the main's
## status to configure our settings.

::apply {{} {
    if {![info exists ::task::type]} return
    ::debug::${::task::type}::link $::task::main
    return
}}

# ### ### ### ######### ######### #########
## Ready

package provide debug 1.0
return

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

## Utility command for use as debug prefix command to un-mangle snit
## method calls.

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

package require Tcl 8.5

namespace eval ::debug::snit {}

# ### ### ### ######### ######### #########
## API & Implementation

proc ::debug::snit::call {} {
    # For snit (type)methods, rework the command line to be more
    # legible and in line with what the user would expect. To this end
    # we pull the primary command out of the arguments, be it type or
    # object, massage the command to match the original (type)method
    # name, then resort and expand the words to match the call before
    # snit got its claws into it.

    set a [lassign [info level -1] m]
    regsub {.*Snit_} $m {} m
    switch -glob $m {
	htypemethod* {
	    # primary = type, a = type
	    set a [lassign $a primary]
	    set m [string map {_ { }} [string range $m 11 end]]
	}
	typemethod* {
	    # primary = type, a = type
	    set a [lassign $a primary]
	    set m [string range $m 10 end]
	}
	hmethod* {
	    # primary = self, a = type selfns self win ...
	    set a [lassign $a _ _ primary _]
	    set m [string map {_ { }} [string range $m 7 end]]
	}
	method* {
	    # primary = self, a = type selfns self win ...
	    set a [lassign $a _ _ primary _]
	    set m [string range $m 6 end]
	}
	destructor -
	constructor {
	    # primary = self, a = type selfns self win ...
	    set a [lassign $a _ _ primary _]
	}
	typeconstructor {
	    return [list {*}$a $m]
	}
	default {
	    # Unknown
	    return [list $m {*}$a]
	}
    }
    return [list $primary {*}$m {*}$a]
}

# ### ######### ###########################
## Ready for use

package provide debug::snit 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded debug       1.0 [list source [file join $dir debug.tcl]]
package ifneeded debug::snit 0.1 [list source [file join $dir debug_snit.tcl]]

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

# Error display. Watches the scoreboard for error messages and posts
# them as tk_message. Pseudo-task using events, i.e. CPS.

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

package require debug
package require scoreboard

namespace eval ::bookflow::error {}

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

debug off    bookflow/error
#debug on     bookflow/error

# ### ### ### ######### ######### #########
## API & Implementation

proc ::bookflow::error {} {
    Debug.bookflow/error {Bookflow::Error Watch}
    scoreboard take {PROJECT ERROR *} [namespace code error::Post]
    Debug.bookflow/error {/}
    return
}

# ### ### ### ######### ######### #########
## Internals

proc ::bookflow::error::Post {tuple} {
    tk_messageBox -type ok -icon error -parent . -title Error \
	-message [lindex $tuple 2]

    # Return to watching the scoreboard, there may be more messages.
    after idle ::bookflow::error
    return
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::bookflow {
    namespace export error
    namespace ensemble create
}

# ### ### ### ######### ######### #########
## Ready

package provide bookflow::error 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookflow::error 0.1 [list source [file join $dir error.tcl]]

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

# Background task. Continuous.
# Creating and invalidating greyscales of page images.
# A producer in terms of "doc/interaction_pci.txt"
#
# Generated greyscales are cached in the directory ".bookflow/grey" of
# the project directory.

# Limits itself to no more than four actual threads in flight,
# i.e. performing image scaling. The scaling tasks do not exit on
# completion, but wait for more operations to perform. Communication
# and coordination is done through the scoreboard. As usual.

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

package require debug
package require blog
package require task
package require scoreboard

namespace eval ::bookflow::greyscale {}

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

debug off    bookflow/greyscale
#debug on     bookflow/greyscale

# ### ### ### ######### ######### #########
## API & Implementation

proc ::bookflow::greyscale {} {
    Debug.bookflow/greyscale {Bookflow::Greyscale Watch}

    scoreboard wpeek {AT *} [namespace code greyscale::BEGIN]

    Debug.bookflow/greyscale {/}
    return
}

proc ::bookflow::greyscale::BEGIN {tuple} {
    # tuple = (AT project)

    Debug.bookflow/greyscale {Bookflow::Greyscale BEGIN <$tuple>}

    lassign $tuple _ project

    # Monitor for greyscale invalidation
    # doc/interaction_pci.txt (1)
    scoreboard take {!GREYSCALE *} [namespace code [list INVALIDATE $project]]

    # Launch the tasks doing the actual conversion.
    variable max
    for {set i 0} {$i < $max} {incr i} {
	task launch [list ::apply {{} {
	    package require bookflow::greyscale
	    bookflow::greyscale::CONVERT
	}}]
    }

    # Monitor for greyscale creation requests.
    # doc/interaction_pci.txt (2)
    scoreboard bind missing {GREYSCALE *} [namespace code [list MAKE $project]]

    Debug.bookflow/greyscale {Bookflow::Greyscale BEGIN/}
    return
}

# ### ### ### ######### ######### #########
## Internals. Helper encapsulation directory structure.

proc ::bookflow::greyscale::GreyFullPath {project path} {
    return $project/[GreyPath $path]
}

proc ::bookflow::greyscale::GreyPath {path} {
    return .bookflow/grey/[file rootname $path].pgm
}

# ### ### ### ######### ######### #########
## Internals. Greyscale invalidation. See doc/interaction_pci.txt (1).

proc ::bookflow::greyscale::INVALIDATE {project tuple} {
    # tuple = (!GREYSCALE path)
    lassign $tuple _ path

    Debug.bookflow/greyscale {Bookflow::Greyscale INVALIDATE $path}

    scoreboard takeall [list GREYSCALE $path *] [namespace code [list RETRACT $project $path]]

    Debug.bookflow/greyscale {Bookflow::Greyscale INVALIDATE/}
    return
}

proc ::bookflow::greyscale::RETRACT {project path tuples} {
    Debug.bookflow/greyscale {Bookflow::Greyscale RETRACT $path}

    file delete [GreyFullPath $project $path]

    # Look for more invalidation requests
    scoreboard take {!GREYSCALE *} [namespace code [list INVALIDATE $project]]

    Debug.bookflow/greyscale {Bookflow::Greyscale RETRACT/}
    return
}

# ### ### ### ######### ######### #########
## Internals. Greyscale creation. See doc/interaction_pci.txt (2).

proc ::bookflow::greyscale::MAKE {project pattern} {
    # pattern = (GREYSCALE path *)

    lassign $pattern _ path
    Debug.bookflow/greyscale {Bookflow::Greyscale MAKE $path}

    set greyfull [GreyFullPath $project $path]
    set grey     [GreyPath $path]

    if {[file exists $greyfull]} {
	# Greyscale already exists in the filesystem cache, simply
	# make it available.

	scoreboard put [list GREYSCALE $path $grey]
    } else {
	# Greyscale not known. Put in a request for the converter
	# tasks to generate it. This will also put the proper result
	# into the scoreboard on completion.

	set r [list GREYSCALE $path $grey]
	scoreboard put [list GREYCONVERT $project/$path $greyfull $r]
    }

    Debug.bookflow/greyscale {Bookflow::Greyscale MAKE/}
    return
}

# ### ### ### ######### ######### #########
## Internals. Implementation of the resizing tasks.

proc ::bookflow::greyscale::CONVERT {} {
    package require debug
    Debug.bookflow/greyscale {Bookflow::Greyscale CONVERT}

    # Requisites for the task
    package require bookflow::greyscale
    package require scoreboard
    package require crimp ; wm withdraw .
    package require img::jpeg

    # Start waiting for requests.
    READY

    Debug.bookflow/greyscale {Bookflow::Greyscale CONVERT/}
    return
}

proc ::bookflow::greyscale::READY {} {
    # Wait for more requests.
    scoreboard take {GREYCONVERT *} [namespace code GCONV]
    return
}

proc ::bookflow::greyscale::GCONV {tuple} {
    # tuple = (GREYCONVERT path dstpath result)
    # result = (GREYSCALE path dstpath)

    # Decode request
    lassign $tuple _ path dst result
    Debug.bookflow/greyscale {Bookflow::Greyscale GCONV $path $dst}

    # Perform the conversion, writing pgm, using crimp internally.
    file mkdir [file dirname $dst]

    set photo [image create photo -file $path]
    crimp write 2file pgm-raw $dst [crimp convert 2grey8 [crimp read tk $photo]]
    image delete $photo

    # Push result
    scoreboard put $result

    # Wait for more requests.
    READY

    Debug.bookflow/greyscale {Bookflow::Greyscale GCONV $path = $dst /}
    return
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::bookflow::greyscale {
    # Number of parallel conversion tasks.
    variable max 4
}

# ### ### ### ######### ######### #########
## Ready

package provide bookflow::greyscale 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookflow::greyscale 0.1 [list source [file join $dir greyscale.tcl]]

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

# Widget showing a single or double page spread, i.e. one or two
# images. Not specific to bookflow.

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

package require Tk 8.5
package require debug
package require debug::snit
package require snit
package require tooltip
package require widget::scrolledwindow

debug prefix img/page {[::debug::snit::call] }
debug off    img/page
#debug on     img/page

# ### ### ### ######### ######### #########
##

snit::widgetadaptor img::page {

    # ### ### ### ######### ######### #########
    ##

    delegate option -borderwidth to hull
    delegate option -relief      to hull

    # ### ### ### ######### ######### #########
    ##

    constructor {args} {
	Debug.img/page {}

	installhull using ttk::frame

	$self Widgets
	$self Layout
	$self Bindings

	$self configurelist $args
	return
    }

    method {odd image}  {image} { $self Image odd  $image ; return }
    method {even image} {image} { $self Image even $image ; return }

    method {odd text}  {text} { $self Text odd  $text ; return }
    method {even text} {text} { $self Text even $text ; return }

    # ### ### ### ######### ######### #########

    method Image {frame image} {
	Debug.bookw {}

	set mystate($frame,photo) [expr {$image ne {}}]

	set w   [image width  $image]
	set h   [image height $image]
	if {$h > $w} { set max $h } else { set max $w }
	incr max 20

        $win.$frame.plate configure -scrollregion [list 0 0 $max $max]
	$win.$frame.plate itemconfigure PHOTO -image $image
	$win.$frame.plate coords        PHOTO [expr {$w/2 + 10}] [expr {$h/2 + 10}]

	if {$image eq {}} {
	    $win.$frame.plate raise TEXT
	} else {
	    $win.$frame.plate raise PHOTO
	}
	$self Relayout

	Debug.bookw {/}
	return
    }

    method Text {frame text} {
	Debug.bookw {}

	set mystate($frame,text) [expr {$text ne {}}]
	$win.$frame.plate itemconfigure TEXT -text $text
	if {$text eq {}} {
	    $win.$frame.plate raise PHOTO
	} else {
	    $win.$frame.plate raise TEXT
	}
	$self Relayout

	Debug.bookw {/}
	return
    }

    method Relayout {} {
	Debug.bookw {}

	set odd  [expr {$mystate(odd,photo)  || $mystate(odd,text)}]
	set even [expr {$mystate(even,photo) || $mystate(even,text)}]

	if {$odd && $even} {
	    pack $win.odd  -in $win -side left  -fill both -expand 1
	    pack $win.even -in $win -side right -fill both -expand 1
	} elseif {$odd} {
	    pack forget $win.even
	    pack $win.odd -in $win -side top -fill both -expand 1
	} elseif {$even} {
	    pack forget $win.odd
	    pack $win.even -in $win -side top -fill both -expand 1
	} else {
	    pack forget $win.odd
	    pack forget $win.even
	}

	Debug.bookw {/}
	return
    }

    # ### ### ### ######### ######### #########

    method Context {x y} {
	Debug.img/page {}
	event generate $win <<Context>> -data [list $x $y $myimage]
	return
    }

    # ### ### ### ######### ######### #########
    ##

    method Widgets {} {
	foreach frame {
	    odd
	    even
	} {
	    widget::scrolledwindow $win.$frame
	    canvas                 $win.$frame.plate \
		-scrollregion {0 0 1024 1024} \
		-borderwidth 2 -relief sunken

	    $win.$frame setwidget $win.$frame.plate
	    $win.$frame.plate create image 10 10 -tags PHOTO
	    $win.$frame.plate create text  10 10 -tags TEXT -anchor nw -fill red -font {-size -16} -text "Undefined"
	}
	return
    }

    method Layout {} {
	# Layout is dynamic, as images are assigned to the sides, odd
	# packed left, even packed right, both expanding.
	return
    }

    method Bindings {} {
	bind $win.odd.plate  <3> [mymethod Context %X %Y]
	bind $win.even.plate <3> [mymethod Context %X %Y]
	return
    }

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

    variable mystate -array {
	odd,photo  0
	odd,text   0
	even,photo 0
	even,text  0
    }

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

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

# ### ### ### ######### ######### #########
## Ready

package provide img::page 0.1

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded img::page 0.1 [list source [file join $dir imgpage.tcl]]

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

# Widget showing a horizontal/vertical strip of images.
# Not specific to bookflow.

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

package require Tcl 8.5
package require widget::scrolledwindow
package require treectrl
package require snit
package require debug::snit
package require debug
package require syscolor

debug off    img/strip
#debug on     img/strip
debug prefix img/strip {[::debug::snit::call] }

# ### ### ### ######### ######### #########
##

snit::widgetadaptor ::img::strip {

    # ### ### ### ######### ######### #########
    ##

    option -orientation \
	-default         horizontal \
	-configuremethod C-orient \
	-type            {snit::enum -values {horizontal vertical}}

    # ### ### ### ######### ######### #########
    ##

    delegate method * to mytree
    delegate option * to mytree
    delegate option -borderwidth to hull
    delegate option -relief      to hull

    # ### ### ### ######### ######### #########
    ##

    constructor {args} {
	Debug.img/strip {}
	installhull using widget::scrolledwindow -borderwidth 1 -relief sunken

	$self Widgets
	$self Layout
	$self Bindings

	$self S-orient horizontal
	$self STYLE

	$self configurelist $args
	return
    }

    # Add an empty image to the widget. Displayed, but without text or
    # image until such are configured. Returns a token to address the
    # item with.

    method new {} {
	Debug.img/strip {}

	set newitem [$mytree item create]
	$mytree item lastchild 0 $newitem
	$mytree item configure   $newitem -button 0
	$mytree item configure   $newitem -visible 1
	$mytree item style set   $newitem 0 STYLE
	$mytree collapse         $newitem
	$self Resort
	$self DetermineHeight
	$self DetermineWidth

	Debug.img/strip {/}
	return $newitem
    }

    method drop {token} {
	Debug.img/strip {}

	$mytree item delete $token
	# Note: Resorting not needed, the other images are staying in
	# their proper order.

	Debug.img/strip {/}
	return
    }

    method itemconfigure {token args} {
	foreach {option value} $args {
	    $self ItemConfigure $option $token $value
	}
	return
    }

    method {ItemConfigure -message} {token string} {
	Debug.img/strip {}

	$mytree item element configure $token 0 eText -text  $string

	Debug.img/strip {/}
	return
    }

    method {ItemConfigure -label} {token string} {
	Debug.img/strip {}

	$mytree item element configure $token 0 eLabel -text $string

	Debug.img/strip {/}
	return
    }

    method {ItemConfigure -order} {token string} {
	Debug.img/strip {}

	$mytree item element configure $token 0 eSerial -text $string
	$self Resort

	Debug.img/strip {/}
	return
    }

    method {ItemConfigure -image} {token photo} {
	Debug.img/strip {}

	$mytree item element configure $token 0 eImage -image $photo

	Debug.img/strip {/}
	return
    }

    method itemcget {token option} {
	return [$self ItemCget $option $token]
    }

    method {ItemCget -message} {token} {
	Debug.img/strip {}

	if {[catch {
	    set res [$mytree item element cget $token 0 eText -text]
	}]} { set res {} }

	Debug.img/strip {= $res /}
	return $res
    }

    method {ItemCget -label} {token} {
	Debug.img/strip {}

	if {[catch {
	    set res [$mytree item element cget $token 0 eLabel -text]
	}]} { set res {} }

	Debug.img/strip {= $res /}
	return $res
    }

    method {ItemCget -order} {token} {
	Debug.img/strip {}

	if {[catch {
	    set res [$mytree item element cget $token 0 eSerial -text]
	}]} { set res {} }

	Debug.img/strip {= $res /}
	return $res
    }

    method {ItemCget -image} {token} {
	Debug.img/strip {}

	if {[catch {
	    set res [$mytree item element cget $token 0 eImage -image]
	}]} { set res {} }

	Debug.img/strip {= $res /}
	return $res
    }

    method {selection set} {token} {
	$mytree selection clear
	$mytree selection add $token
	$mytree activate $token
	return
    }

    # ### ### ### ######### ######### #########
    ## Internals

    method Widgets {} {
	Debug.img/strip {}

	install mytree using treectrl $win.tree \
	    -highlightthickness 0 \
	    -borderwidth 0 \
	    -showheader 1 \
	    -xscrollincrement 20

	$mytree debug configure \
	    -enable no \
	    -display no \
	    -erasecolor pink \
	    -displaydelay 30

	$mytree configure \
	    -showroot     no \
	    -showbuttons  no \
	    -showlines    no \
	    -selectmode   single \
	    -showheader   no \
	    -scrollmargin 16 \
	    -xscrolldelay {500 50} \
	    -yscrolldelay {500 50}
	return
    }

    method Layout {} {
	Debug.img/strip {}
	$hull setwidget $mytree
	return
    }

    method Bindings {} {
	Debug.img/strip {}

	# Disable "scan" bindings on windows.
	if {$::tcl_platform(platform) eq "windows"} {
	    bind $mytree <Control-ButtonPress-3> { }
	}

	bindtags $mytree [list $mytree TreeCtrl [winfo toplevel $mytree] all]

	$mytree notify bind $mytree <ActiveItem> [mymethod ChangeActiveItem %p %c]
	$mytree notify bind $mytree <Selection>  [mymethod Selection]

	bind $mytree <Double-1> [mymethod Action        %x %y]
	bind $mytree <3>        [mymethod Context %X %Y %x %y]
	bind $win    <FocusIn>  [mymethod Focus]

	$mytree column create
	return
    }

    method STYLE {} {
	Debug.img/strip {}

	# Style for the items used for the display of images.
	#
	# Elements
	# ------------------------------------------------------------------------
	# eImage  : The image to show.
	# eText   : Transient text, feedback (like the status of image ops, etc.)
	# eLabel  : Textual label for the image.
	# eFrame  : Square rectangle around the image.
	# eShadow : A small drop shadow around eFrame.
	# eSerial : INVISIBLE text whose contents determine display order. I.e.
	#           this one is used to sort the items.
	# ------------------------------------------------------------------------

	$mytree element create eImage  image -image {} -width $oursize -height $oursize
	$mytree element create eText   text -text {}        -fill $ourtextfillcolor -justify center
	$mytree element create eLabel  text -text {}        -fill $ourtextfillcolor -justify center
	$mytree element create eFrame  rect -outlinewidth 1 -fill $ourfillcolor -outline $ouroutlinecolor
	$mytree element create eShadow rect -outlinewidth 2 -fill $ourfillcolor -outline gray \
	    -open wn -showfocus 1
	$mytree element create eSerial text -text {}

	$mytree style create   STYLE -orient vertical
	$mytree style elements STYLE {eShadow eLabel eFrame eImage eText eSerial}

	$mytree style layout   STYLE eLabel  -ipady {2 0} -expand we
	$mytree style layout   STYLE eFrame  -union { eImage eText }
	$mytree style layout   STYLE eImage  -ipady $ourgap -ipadx $ourgap -expand swen
	$mytree style layout   STYLE eShadow -padx {1 2} -pady {1 2} -iexpand xy -detach yes

	#$mytree style layout STYLE eLabel -visible 1
	#$mytree style layout STYLE eImage -visible 1
	$mytree style layout STYLE eSerial -visible 0

	TreeCtrl::SetSensitive $mytree { {0 STYLE eShadow eLabel eFrame eImage eText} }
	TreeCtrl::SetEditable  $mytree { {0 STYLE} }
	TreeCtrl::SetDragImage $mytree { {0 STYLE} }

	bindtags $mytree \
	    [list \
		 $mytree \
		 TreeCtrlFileList \
		 TreeCtrl \
		 [winfo toplevel $mytree] \
		 all]
	return
    }

    method Resort {} {
	# Regenerate the display order of items.
	# We sort them by the third text element, the invisible "eSerial".
	$mytree item sort 0 -dict -element eSerial
	return
    }

    # ### ### ### ######### ######### #########
    ##

    method ChangeActiveItem {previous current} {
	Debug.img/strip {}

	$mytree see $current
	return
    }

    method Focus {} {
	Debug.img/strip {==> $mytree}
	focus $mytree
	return
    }

    method Context {x y wx wy} {
	set idata [$mytree identify $wx $wy]
	Debug.img/strip {[list ==> $idata]}

	lassign $idata type id
	event generate $win <<Context>> -data [list $x $y $id]
	return
    }

    method Action {x y} {
	set idata [$mytree identify $x $y]
	Debug.img/strip {[list ==> $idata]}

	lassign $idata  type id
	if {$type ne "item"} return

	event generate $win <<Action>> -data $id
	return
    }

    method Selection {} {
	Debug.img/strip {}
	event generate $win <<SelectionChanged>> \
	    -data [$mytree selection get]
	return
    }

    # ### ### ### ######### ######### #########

    method C-orient {o value} {
	if {$options($o) eq $value} return
	set options($o) $value
	$self S-orient $value
	return
    }

    method S-orient {value} {
	switch -exact -- $value {
	    horizontal {

		# Tree is horizontal, no wrapping is done.

		# Each item is as high as myheight (to be determined
		# after first item added).

		# Indirectly derived from 'oursize', the w/h given to
		# the eImage element.

		# FUTURE: Pull this out of the actual image configured
		# for the first item (max of all maybe ?)

		$mytree configure -orient horizontal -wrap {}
		$hull configure -scrollbar horizontal -auto horizontal
		$self DetermineHeight
	    }
	    vertical {
		# Tree is vertical, no wrapping is done.

		# Each item is as wide as mywidth (to be determined
		# after first item added).

		# Indirectly derived from 'oursize', the w/h given to
		# the eImage element.

		# FUTURE: Pull this out of the actual image configured
		# for the first item (max of all maybe ?)

		$mytree configure -orient vertical -wrap {}
		$hull configure -scrollbar vertical -auto vertical
		$self DetermineWidth
	    }
	}
	return
    }

    method DetermineHeight {} {
	if {![info exists options(-orientation)]} return
	if {$options(-orientation) ne "horizontal"} return
	if {$myheight eq {}} {
	    set items [$mytree item children 0]
	    if {![llength $items]} return

	    lassign [$mytree item bbox [lindex $items 0]] _ _ _ myheight
	    incr myheight 40
	}

	$mytree configure -height $myheight -width 0
	return
    }

    method DetermineWidth {} {
	if {![info exists options(-orientation)]} return
	if {$options(-orientation) ne "vertical"} return
	if {$mywidth eq {}} {
	    set items [$mytree item children 0]
	    if {![llength $items]} return

	    lassign [$mytree item bbox [lindex $items 0]] _ _ mywidth _
	    #incr mywidth 40
	}

	#$mytree column configure 0 -width $mywidth
	$mytree configure -width $mywidth -height 0
	return
    }

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

    variable mywidth  {} ; # Strip width, derived from first image
    variable myheight {} ; # Strip height, derived from first image

    component mytree

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

    ## TODO :: Make these configurable (on widget creation only).

    typevariable oursize 160 ; # Maximal size of the images to expect (160x120 / 120x160)
    typevariable ourgap    4 ; # Size of the gap to put between image and text.

    typevariable ourselectcolor  \#ffdc5a
    typevariable ouroutlinecolor \#827878

    typevariable ourfillcolor
    typevariable ourtextfillcolor

    typeconstructor {
	set ourtextfillcolor [list [syscolor::highlightText] {selected focus}]
	set ourfillcolor     [list \
				  [syscolor::highlight] {selected focus} \
				  gray                  {selected !focus}]

	set ourtextfillcolor [list [syscolor::highlightText] {selected focus}]
	set ourfillcolor     [list \
				  \#ff8800 {selected focus} \
				  gray     {selected !focus}]
    }

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

# ### ### ### ######### ######### #########
## Ready

package provide img::strip 0.1

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded img::strip 0.1 [list source [file join $dir imgstrip.tcl]]

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

# Issue Queue. Use it to limit the rate of issuing requests for data
# like thumbnails etc. Instead of directly issuing the query patterns
# to the scoreboard issue them to an instance of iq and the queue will
# issue them so that only a fixed (but configurable) number of queries
# have outstanding results.

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

package require Tcl 8.5
package require snit
package require scoreboard
package require debug
package require debug::snit
package require struct::queue

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

debug prefix iq {[::debug::snit::call] }
debug off    iq
#debug on     iq

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

snit::type ::iq {
    # ### ### ### ######### ######### #########
    ##

    option -emptycmd \
	-default {}

    # ### ### ### ######### ######### #########
    ##

    constructor {limit args} {
	Debug.iq {}

	set mylimit $limit
	set myqueue [struct::queue ${selfns}::Q]

	$self configurelist $args
	Debug.iq {/}
	return
    }

    method put {pattern cmd} {
	Debug.iq {}

	if {$myflight >= $mylimit} {
	    $myqueue put [list $pattern $cmd]
	    Debug.iq {/}
	    return
	}

	$self Dispatch $pattern $cmd

	Debug.iq {/}
	return
    }

    # ### ### ### ######### ######### #########
    ##

    method Dispatch {pattern cmd} {
	Debug.iq {}

	scoreboard wpeek $pattern [mymethod Have $cmd]
	incr myflight

	Debug.iq {/}
	return
    }

    method Have {cmd tuple} {
	Debug.iq {}

	incr myflight -1
	if {($myflight < $mylimit) && [$myqueue size]} {
	    lassign [$myqueue get] pattern newcmd
	    $self Dispatch $pattern $newcmd
	    $self NotifyEmpty
	}

	uplevel #0 [list {*}$cmd $tuple]

	Debug.iq {/}
	return
    }

    # ### ### ### ######### ######### #########

    method NotifyEmpty {args} {
	if {![$myqueue size]} return
	if {![llength $options(-emptycmd)]} return
	after idle [list after 0 [list {*}$options(-emptycmd) $self]]
	return
    }

    # ### ### ### ######### ######### #########
    ##

    variable myflight 0  ; # Number of requests waiting for results
    variable mylimit  0  ; # Maximum number of requests we are allowed
			   # to keep in flight.
    variable myqueue {}  ; # Queue of requests waiting to be issued.

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

# ### ### ### ######### ######### #########
## Ready

package provide iq 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded iq 0.1 [list source [file join $dir iq.tcl]]

# Log - A narrative logger, not for debugging by the developer, but
#       end-user reporting of system activity.
# Derived from the debug logger.
#
# Logging areas of interest are represented by 'tokens' which have 
# independantly settable levels of interest (an integer, higher is more detailed)
#
# Log narrative is provided as a tcl script whose value is [subst]ed in the 
# caller's scope if and only if the current level of interest matches or exceeds
# the Log call's level of detail.  This is useful, as one can place arbitrarily
# complex narrative in code without unnecessarily evaluating it.
#
# TODO: potentially different streams for different areas of interest.
# (currently only stderr is used.  there is some complexity in efficient
# cross-threaded streams.)

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

package require Tcl 8.5
package require debug

namespace eval ::log {}

debug off log

# ### ### ### ######### ######### #########
## API & Implementation

proc ::log::noop {args} {}

proc ::log::log {tag message {level 1}} {
    variable detail

    if {$detail($tag) < $level} {
	#puts stderr "$tag @@@ $detail($tag) >= $level"
	return
    }

    variable prefix
    variable fds

    # Determine the log command, based on tag, with fallback to a
    # global setting.`
    if {[catch {
	set fd $fds($tag)
    }]} {
	set fd $fds(::)
    }

    # Integrate global and tag prefixes with the user message.
    set themessage ""
    if {[info exists prefix(::)]}   { append themessage $prefix(::)   }
    if {[info exists prefix($tag)]} { append themessage $prefix($tag) }
    append themessage $message

    # Resolve variables references and command invokations embedded
    # into the message with plain text.
    set code [catch {
	uplevel 1 [list ::subst -nobackslashes $themessage]
    } result eo]

    if {$code} {
	return -code error $result
	#set x [info level -1]
	#set x [expr {[string length $x] < 1000 ? $x : "[string range $x 0 200]...[string range $x end-200 end]"}]
	#{*}$fd puts* @@[string map {\n \\n \r \\r} "(LogError from $tag $x ($eo)):"]
    } {
	if {[string length $result] > 4096} {
	    set result "[string range $result 0 2048]...(truncated) ... [string range $result end-2048 end]"
	}
	set head $tag
	set blank [regsub -all . $tag { }]
	foreach line [split $result \n] {
	    #{*}$fd puts* $head
	    #{*}$fd puts* { | }
	    {*}$fd puts  $line
	    set head $blank
	}
    }
    return
}

# names - return names of log tags
proc ::log::names {} {
    variable detail
    return [lsort [array names detail]]
}

proc ::log::2array {} {
    variable detail
    set result {}
    foreach n [lsort [array names detail]] {
	if {[interp alias {} Log.$n] ne "::Log::noop"} {
	    lappend result $n $detail($n)
	} else {
	    lappend result $n -$detail($n)
	}
    }
    return $result
}

# level - set level and log command for tag
proc ::log::level {tag {level ""} {fd {}}} {
    variable detail
    if {$level ne ""} {
	set detail($tag) $level
    }

    if {![info exists detail($tag)]} {
	set detail($tag) 1
    }

    variable fds
    if {$fd ne {}} {
	set fds($tag) $fd
    }

    return $detail($tag)
}

# set prefix to use for tag.
# The global (tag-independent) prefix is adressed through tag == '::'`.
# This works because colon (:) is an illegal character for regular tags.
proc ::log::prefix {tag {theprefix {}}} {
    variable prefix
    set prefix($tag) $theprefix
    return
}

# turn on logging for tag
proc ::log::on {tag {level ""} {fd {}}} {
    variable active
    set active($tag) 1
    level $tag $level $fd
    interp alias {} Log.$tag {} ::log::log $tag
    return
}

# turn off logging for tag
proc ::log::off {tag {level ""} {fd {}}} {
    variable active
    set active($tag) 0
    level $tag $level $fd
    interp alias {} Log.$tag {} ::log::noop
    return
}

proc ::log::setting {args} {
    if {[llength $args] == 1} {
	set args [lindex $args 0]
    }
    set fd {}
    if {[llength $args]%2} {
	set fd [lindex $args end]
	set args [lrange $args 0 end-1]
    }
    foreach {tag level} $args {
	if {$level > 0} {
	    level $tag $level $fd
	    interp alias {} Log.$tag {} ::Log::log $tag
	} else {
	    level $tag [expr {-$level}] $fd
	    interp alias {} Log.$tag {} ::Log::noop
	}
    }
    return
}

# ### ### ### ######### ######### #########
## Communication setup for concurrent tasks.
## Thread based.

namespace eval ::log::thread {}

proc ::log::thread::link {main} {
    variable ::log::detail
    variable ::log::prefix
    variable ::log::fds

    Debug.log {  Setting up log for $main}

    # Import main's status.
    array set detail [thread::send $main {array get ::log::detail}]
    array set prefix [thread::send $main {array get ::log::prefix}]
    array set active [thread::send $main {array get ::log::active}]
    # We do not import any custom write commands.
    # Any writing goes through the global setting, which is
    # reconfigured to perform the necessary inter-thread
    # communication.

    # Replicate (in)active status of the tags.
    foreach {t a} [array get active] {
	if {$a} {
	    interp alias {} Log.$t {} ::log::log $t
	} else {
	    interp alias {} Log.$t {} ::log::noop
	}
    }

    set fds(::) [list ::log::thread::ToMain $main]

    return
}

proc ::log::thread::ToMain {main cmd text} {
    upvar 1 tag tag
    thread::send -async $main \
	[list ::log::thread::FromTask $tag $cmd $text]
    return
}

proc ::log::thread::FromTask {tag cmd text} {
    # This is a variant of log::log without all the substitutions. It
    # determines the actual write command per the tag and invokes it
    # with the specifiec method and text.

    # It is the receiver of messages coming from concurrently running
    # tasks.

    variable ::log::fds

    if {[catch {
	set fd $fds($tag)
    }]} {
	set fd $fds(::)
    }

    {*}$fd $cmd $text
    return
}

# ### ### ### ######### ######### #########
## Standard log writer command

namespace eval ::log::Write {
    namespace export puts puts*
    namespace ensemble create
}

proc ::log::Write::puts {text} {
    puts stderr $text
    return
}

proc ::log::Write::puts* {text} {
    puts stderr -nonewline $text
    flush stderr
    return
}

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

namespace eval ::log {
    variable detail  ; # map: TAG -> level of interest
    variable prefix  ; # map: TAG -> message prefix to use
    variable fds     ; # map: TAG -> command prefix to use for writing the message.
    variable active  ; # map: TAG -> boolean flag, true if tag is active.

    # Notes:
    # The tag '::' is reserved.
    # prefix() uses it to store the global message prefix.
    # fds() uses it to store a global command prefix for writing messages.

    set fds(::) ::log::Write

    namespace export -clear *
    namespace ensemble create -subcommands {}
}

# ### ### ### ######### ######### #########
## Look for the magic of package task, and if found, reconfigure
## ourselves to write to the main system. Do not forget to import the
## main's status as well.

::apply {{} {
    if {![info exists ::task::type]} return
    ::log::${::task::type}::link $::task::main
    return
}}

# ### ### ### ######### ######### #########
## Ready

package provide blog 1.0
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded blog 1.0 [list source [file join $dir log.tcl]]

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

# Access to the bookflow project database from any part of the
# application.

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

package require debug
package require scoreboard

namespace eval ::bookflow::project {}

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

debug off    bookflow/project
#debug on     bookflow/project

# ### ### ### ######### ######### #########
## API & Implementation
## Wait for the server thread to complete initialization

proc ::bookflow::project::ok {cmd} {
    Debug.bookflow/project {OK <cmd>}

    # Wait for the appearance of (PROJECT SERVER *)
    scoreboard take {PROJECT SERVER *} [list ::apply {{cmd tuple} {
	# Put tuple back for others.
	scoreboard put $tuple

	# Make delegation command usable, i.e. tell it which thread to
	# send the commands to.
	lassign $tuple _ _ thread
	variable server $thread

	# Tell the caller that the database server thread is (now)
	# ready.
	uplevel #0 $cmd
    } ::bookflow::project} $cmd]

    Debug.bookflow/project {OK/}
    return
}

# ### ### ### ######### ######### #########
## API & Implementation
## Delegate all actions to the server thread.  This serializes
## concurrent access by different parts of the application.

proc ::bookflow::project {args} {
    variable project::server
    return [thread::send $server [info level 0]]
}

# ### ### ### ######### ######### #########

namespace eval ::bookflow::project {
    variable server
}

# ### ### ### ######### ######### #########
## Ready

package provide bookflow::project 0.1
return

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

# Access to a bookflow project database. The actual access is through
# the bookflow::db package. This package simply wraps around it, to
# serialize any access from all the threads of the application, acting
# as an in-application server. This server runs in its own thread.

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

package require debug
package require bookflow::db

namespace eval ::bookflow::project {}

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

debug off    bookflow/project
#debug on     bookflow/project

# ### ### ### ######### ######### #########

::apply {{} {
    task launch [list ::apply {{} {
	package require scoreboard

	# Wait for the appearance of (DATABASE *)
	scoreboard wpeek {DATABASE *} {::apply {{tuple} {
	    lassign $tuple _ dbfile

	    # Pull the project location
	    scoreboard wpeek {AT *} [list ::apply {{dbfile tuple} {
		lassign $tuple _ project

		package require bookflow::db

		set dbfile $project/$dbfile
		if {![file exists  $dbfile]} {
		    [bookflow::db new $dbfile] destroy
		}

		::bookflow::db ::bookflow::project $dbfile

		set id [thread::id]
		scoreboard put [list PROJECT SERVER $id]
		return
	    }} $dbfile]

	    return
	}}}
    }}]
}}

# ### ### ### ######### ######### #########
## Ready

package provide bookflow::project::server 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookflow::project         0.1 [list source [file join $dir p_client.tcl]]
package ifneeded bookflow::project::server 0.1 [list source [file join $dir p_server.tcl]]

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded scoreboard 0.1 [list source [file join $dir scoreboard.tcl]]

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

# Scoreboard Client. Used by tasks (in threads) to talk to the actual
# scoreboard in the main thread. The commands are shims which redirect
# to the equivalent command in the main thread, possibly rewriting
# arguments to handle the proper back and forth for callbacks.

# ### ### ### ######### ######### #########
## API & Implementation

proc ::scoreboard::put {args} {
    thread::send -async $::task::main [info level 0]
    return
}

proc ::scoreboard::take {pattern cmd} {
    set me [info level 0]
    set me [lreplace $me end end [list ::scoreboard::Return [thread::id] [lindex $me end]]]
    thread::send -async $::task::main $me
    return
}

proc ::scoreboard::takeall {pattern cmd} {
    set me [info level 0]
    set me [lreplace $me end end [list ::scoreboard::Return [thread::id] [lindex $me end]]]
    thread::send -async $::task::main $me
    return
}

proc ::scoreboard::peek {pattern cmd} {
    set me [info level 0]
    set me [lreplace $me end end [list ::scoreboard::Return [thread::id] [lindex $me end]]]
    thread::send -async $::task::main $me
    return
}

proc ::scoreboard::wpeek {pattern cmd} {
    set me [info level 0]
    set me [lreplace $me end end [list ::scoreboard::Return [thread::id] [lindex $me end]]]
    thread::send -async $::task::main $me
    return
}

proc ::scoreboard::bind {event pattern cmd} {
    set me [info level 0]
    set me [lreplace $me end end [list ::scoreboard::Return [thread::id] [lindex $me end]]]
    thread::send -async $::task::main $me
    return
}

proc ::scoreboard::unbind {event pattern cmd} {
    set me [info level 0]
    set me [lreplace $me end end [list ::scoreboard::Return [thread::id] [lindex $me end]]]
    thread::send -async $::task::main $me
    return
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::scoreboard {
    namespace export {[a-z]*}
    namespace ensemble create
}

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

# Scoreboard, a singleton in-memory database used by the concurrent
# tasks and the main control to coordinate and communicate with each
# other. Actually a tuple-space with a bit of dressing disguising it.

# ### ### ### ######### ######### #########
## API & Implementation

proc ::scoreboard::put {args} {
    variable db

    if {![llength $args]} {
	return -code error "wrong\#args: expected tuple..."
    }

    Debug.scoreboard {put <[join $args ">\nput <"]>}

    foreach tuple $args {
	incr db($tuple)
	Notify put $tuple
    }

    Broadcast $args
    Debug.scoreboard {put/}
    return
}

proc ::scoreboard::take {pattern cmd} {
    variable db

    Debug.scoreboard {take <$pattern> (($cmd))}

    set matches [array names db $pattern]

    if {![llength $matches]} {
	Debug.scoreboard {  no matches, defer response}

	Wait take $pattern $cmd
	Debug.scoreboard {take/}
	return
    }

    set tuple [lindex $matches 0]

    Debug.scoreboard {  matches = [llength $matches]}
    Debug.scoreboard {  taken <$tuple>}

    Remove $tuple
    Notify take $tuple
    Call $cmd $tuple

    Debug.scoreboard {take/}
    return
}

proc ::scoreboard::takeall {pattern cmd} {
    variable db

    Debug.scoreboard {takeall <$pattern> (($cmd))}

    set matches [array names db $pattern]

    Debug.scoreboard {  matches = [llength $matches]}

    foreach tuple $matches {
	Debug.scoreboard {  taken <$tuple>}
	Remove $tuple
	Notify take $tuple
    }

    Call $cmd $matches

    Debug.scoreboard {takeall/}
    return
}

proc ::scoreboard::peek {pattern cmd} {
    variable db

    Debug.scoreboard {peek <$pattern> (($cmd))}

    set matches [array names db $pattern]

    Debug.scoreboard {  matches = [llength $matches]}

    Call $cmd $matches

    Debug.scoreboard {peek/}
    return
}

proc ::scoreboard::wpeek {pattern cmd} {
    variable db

    Debug.scoreboard {wpeek <$pattern> (($cmd))}

    set matches [array names db $pattern]

    if {![llength $matches]} {
	Debug.scoreboard {  no matches, defer response}

	Wait peek $pattern $cmd
	Debug.scoreboard {wpeek/}
	return
    }

    set tuple [lindex $matches 0]

    Debug.scoreboard {  matches = [llength $matches]}
    Debug.scoreboard {  peeked <$tuple>}

    Call $cmd $tuple

    Debug.scoreboard {wpeek/}
    return
}

proc ::scoreboard::bind {event pattern cmd} {
    Debug.scoreboard {bind <$event <$pattern>> (($cmd))}

    if {$event ni {put take missing}} {
	return -code error "Bad event \"$event\", expected one of missing, put, or take"
    }

    variable bind
    lappend  bind($event) [list $pattern $cmd]

    Debug.scoreboard {bind/}
    return
}

proc ::scoreboard::unbind {event pattern cmd} {
    Debug.scoreboard {unbind <$event <$pattern>> (($cmd))}

    if {$event ni {put take missing}} {
	return -code error "Bad event \"$event\", expected one of missing, put, or take"
    }

    variable bind
    set k [list $pattern $cmd]
    set pos [lsearch -exact $bind($event) $k]
    if {$pos < 0} return
    set bind($event) [lreplace $bind($event) $pos $pos]

    Debug.scoreboard {unbind/}
    return
}

# ### ### ### ######### ######### #########
## Internals

proc ::scoreboard::Return {thread cmd args} {
    thread::send -async $thread [list {*}$cmd {*}$args]
    return
}

proc ::scoreboard::Remove {tuple} {
    variable db
    incr db($tuple) -1
    if {!$db($tuple)} { unset db($tuple) }
    return
}

proc ::scoreboard::Wait {action pattern cmd} {
    variable wait
    lappend  wait [list $action $pattern $cmd]

    Notify missing $pattern
    return
}

proc ::scoreboard::Broadcast {tuples} {
    variable wait

    Debug.scoreboard {  Broadcast}
    #Debug.scoreboard {    [join $wait "\n    "]}

    set stillwaiting {}
    foreach item $wait {
	# Quick bail out if all tuples have been broadcast.

	if {![llength $tuples]} {
	    lappend stillwaiting $item
	    continue
	}

	# Bail if the pattern of the waiting request doesn't match any
	# tuple.

	lassign $item action pattern cmd
	set pos [lsearch -glob $tuples $pattern]
	if {$pos < 0} {
	    lappend stillwaiting $item
	    continue
	}

	# This request matches and is now served. It doesn't go on the
	# still-pending list. The tuple in question is removed, if and
	# only if the action was 'take'.

	Debug.scoreboard {  Broadcast : Match <$pattern>}

	set tuple [lindex $tuples $pos]
	if {$action eq "take"} {
	    set tuples [lreplace $tuples $pos $pos]

	    Debug.scoreboard {    taken <$tuple>}

	    Remove $tuple
	} else {
	    Debug.scoreboard {    peeked <$tuple>}
	}
	Call $cmd $tuple
    }

    set wait $stillwaiting

    Debug.scoreboard {  Broadcast/}
    return
}

proc ::scoreboard::Call {cmd args} {
    Debug.scoreboard {    Call $cmd ($args)}
    after idle [list after 1 [list {*}$cmd {*}$args]]
    return
}

proc ::scoreboard::Notify {event tuple} {
    Debug.scoreboard {  Notify $event}

    variable bind
    foreach item $bind($event) {
	lassign $item p c
	if {![string match $p $tuple]} continue
	Call $c $tuple
    }

    Debug.scoreboard {  Notify $event/}
    return
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::scoreboard {
    variable db       ; # tuple array: tuple -> count of instances
    variable wait  {} ; # list of pending 'take's.

    variable  bind    ; # List of bindings per event-type. Initially empty.
    array set bind {
	missing {}
	put     {}
	take    {}
    }

    namespace export {[a-z]*}
    namespace ensemble create
}

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

# Scoreboard, a singleton in-memory database used by the concurrent
# tasks and the main control to coordinate and communicate with each
# other. Actually a tuple-space with a bit of dressing disguising it.

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

package require Tcl 8.5
package require debug

namespace eval ::scoreboard {}

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

debug off    scoreboard
#debug on     scoreboard

# ### ### ### ######### ######### #########
##

# The code here checks wether the package is running in the main
# thread or a task thread, and loads the associated implementation.

::apply {{here} {
    if {![info exists ::task::type]} {
	source [file join $here sb_server.tcl]
    } else {
	switch -exact -- $::task::type {
	    thread {
	source [file join $here sb_client.tcl]
	    }
	    default {
		return -code error "Unable to handle ${::task::type}-based tasks"
	    }
	}
    }
    return
}} [file dirname [file normalize [info script]]]

# ### ### ### ######### ######### #########
## Ready

package provide scoreboard 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookflow::scan 0.1 [list source [file join $dir scan.tcl]]

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

# Background task.
# Initial task.

# Scans the specified directory, looking for the BOOKFLOW database and
# JPEG images.

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

package require debug
package require task

namespace eval ::bookflow::scan {}

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

debug off    bookflow/scan
#debug on     bookflow/scan

# ### ### ### ######### ######### #########
## API & Implementation

proc ::bookflow::scan {projectdir} {
    Debug.bookflow/scan {Bookflow::Scan <$projectdir>}

    task launch [list ::apply {{projectdir} {
	package require bookflow::scan
	bookflow::scan::TASK $projectdir
	task::exit
    }} $projectdir]

    Debug.bookflow/scan {/}
    return
}

# ### ### ### ######### ######### #########
## Internals

proc ::bookflow::scan::TASK {projectdir} {
    package require debug

    # Requisites for the task
    package require blog
    package require jpeg
    package require fileutil
    package require scoreboard
    package require bookflow::db

    #@SB AT *
    scoreboard put [list AT $projectdir]
    set dir [file normalize $projectdir]

    set hasimages  0
    set hasproject 0

    # Iteratation over the files in the project directory.
    # No traversal into subdirectories!
    # Uses 'file'-like commands to determine the type of
    # files (jpeg, bookflow database, other) for classification.

    foreach f [lsort -dict [glob -nocomplain -directory $dir *]] {
	Debug.bookflow/scan {  Processing $f}

	if {![file isfile $f]} {
	    Debug.bookflow/scan {  Directory, ignored}
	    continue
	}

	set fx [fileutil::stripPath $dir $f]

	if {[jpeg::isJPEG $f]} {
	    Debug.bookflow/scan {  Image}
	    set hasimages 1
	    Log.bookflow {* Image            $fx}
	    scoreboard put [list FILE $fx]

	} elseif {[bookflow::db isBookflow $f]} {
	    Debug.bookflow/scan {  Project database found}
	    set hasproject 1
	    Log.bookflow {% Project database $fx}
	    scoreboard put [list DATABASE $fx]

	} else {
	    Debug.bookflow/scan {  Ignored}
	}
    }

    # Scan is complete, summarize the result. This triggers other
    # tasks.

    if {$hasproject} {
	# We have a project. Might have images or not.  Signal that
	# this project needs verification, i.e. internal consistency
	# check, and checking against the set of external images
	# found.

	Debug.bookflow/scan {Bookflow::Scan -> Verify project}
	scoreboard put {PROJECT VERIFY}

    } elseif {$hasimages} {
	# While no project database is available, we have
	# images. Signal that we should create a fresh project
	# database from the images.

	Debug.bookflow/scan {Bookflow::Scan -> Create project}
	scoreboard put {PROJECT CREATE}
    } else {
	# Neither project, nor images were found. This is an abnormal
	# situation. Signal the main controller to report on this.

	Debug.bookflow/scan {Bookflow::Scan -> Nothing found}
	set msg "The chosen project directory $projectdir contains neither images to process, nor a bookflow database.\n\nNothing will be done."
	scoreboard put [list PROJECT ERROR $msg]
    }

    return
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::bookflow {
    namespace export scan
    namespace ensemble create
}

# ### ### ### ######### ######### #########
## Ready

package provide bookflow::scan 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded syscolor 0.1 [list source [file join $dir syscolor.tcl]]

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

# Determine and save system colors for use by (mega)widgets to
# visually match an application's appearance to the environment.
# Not specific to bookflow.

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

package require Tk

namespace eval ::syscolor {}

# ### ### ### ######### ######### #########
## API

proc ::syscolor::buttonFace    {} { variable buttonFace    ; return $buttonFace    }
proc ::syscolor::highlight     {} { variable highlight     ; return $highlight     }
proc ::syscolor::highlightText {} { variable highlightText ; return $highlightText }

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

namespace eval ::syscolor {
    variable buttonFace
    variable highlight
    variable highlightText
}

# ### ######### ###########################
## Initialization

::apply {{} {
    set w [listbox .__syscolor__]
    variable buttonFace    [$w cget -highlightbackground]
    variable highlight     [$w cget -selectbackground]
    variable highlightText [$w cget -selectforeground]
    destroy $w
    return
} ::syscolor}

# ### ######### ###########################
## Ready

package provide syscolor 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded task::thread 0.1 [list source [file join $dir task.tcl]]
package ifneeded task         0.1 {package require task::thread ; package provide task 0.1}

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

# Handling of (background) tasks running concurrently to the main
# system.  This implementation uses thread, via package Thread.
# Alternate implementations could use sub-processses, or coroutines
# (green threads).  The main difference between them all will be in
# the communication between main system and tasks, and between tasks,
# and setting up the per-task environment for this communication.

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

package require debug
package require Thread

namespace eval ::task {}

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

debug off    task
#debug on     task

# ### ### ### ######### ######### #########
## API & Implementation

proc ::task::launch {cmdprefix} {
    # cmdprefix = The task to run concurrently.

    Debug.task {Task <$cmdprefix>}

    # Create thread for task

    set id [thread::create]
    Debug.task {  Running in thread $id}

    # Set magic information for communication with the main
    # thread. The packages requiring special setup for proper
    # communication will look for and recognize the magic and
    # configure themselves accordingly.

    Debug.task {  Configure communication magic}

    thread::send $id [list ::apply {{main ap} {
	set ::auto_path $ap
	namespace eval ::task {}
	set ::task::type thread
	set ::task::main $main
	proc ::task::exit {} {
	    thread::exit
	}
    }} [thread::id] $::auto_path]

    # And at last, launch the task

    Debug.task {  Launch...}
    thread::send -async $id $cmdprefix

    Debug.task {/}
    return
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::task {
    namespace export -clear *
    namespace ensemble create -subcommands {}
}

# ### ### ### ######### ######### #########
## Ready

package provide task::thread 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookflow::thumbnail 0.1 [list source [file join $dir thumbnail.tcl]]

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

# Background task. Continuous.
# Creating and invalidating thumbnails.
# A producer in terms of "doc/interaction_pci.txt"
#
# Generated thumbnails are cached in the directory ".bookflow/thumb"
# of the project directory.

# Limits itself to no more than four actual threads in flight,
# i.e. performing image scaling. The scaling tasks do not exit on
# completion, but wait for more operations to perform. Communication
# and coordination is done through the scoreboard. As usual.

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

package require debug
package require blog
package require task
package require scoreboard

namespace eval ::bookflow::thumbnail {}

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

debug off    bookflow/thumbnail
#debug on     bookflow/thumbnail

# ### ### ### ######### ######### #########
## API & Implementation

proc ::bookflow::thumbnail {} {
    Debug.bookflow/thumbnail {Bookflow::Thumbnail}

    scoreboard wpeek {AT *} [namespace code thumbnail::Initialize]

    Debug.bookflow/thumbnail {/}
    return
}

proc ::bookflow::thumbnail::request {path size} {
    return [list THUMBNAIL $path $size *]
}

# ### ### ### ######### ######### #########
## Internals. Process initialization

proc ::bookflow::thumbnail::Initialize {tuple} {
    # tuple = (AT project)
    lassign $tuple _ project

    Debug.bookflow/thumbnail {Bookflow::Thumbnail Initialize <$project>}

    # Monitor for thumbnail invalidation
    WatchForInvalidation $project

    # Launch the tasks doing the actual resizing.
    variable max
    for {set i 0} {$i < $max} {incr i} {
	task launch [list ::apply {{project} {
	    package require bookflow::thumbnail
	    bookflow::thumbnail::ScalingTask $project
	}} $project]
    }

    # Monitor for thumbnail creation requests.
    WatchForMisses $project

    Debug.bookflow/thumbnail {Bookflow::Thumbnail Initialize/}
    return
}

# ### ### ### ######### ######### #########
## Internals. Invalidation processing. See doc/interaction_pci.txt (1).

proc ::bookflow::thumbnail::WatchForInvalidation {project} {
    # doc/interaction_pci.txt (1)
    Debug.bookflow/thumbnail {Bookflow::Thumbnail WatchForInvalidation}

    scoreboard take {!THUMBNAIL *} [namespace code [list Invalidate $project]]

    Debug.bookflow/thumbnail {Bookflow::Thumbnail WatchForInvalidation}
    return
}

proc ::bookflow::thumbnail::Invalidate {project tuple} {
    # tuple = (!THUMBNAIL path)
    Debug.bookflow/thumbnail {Bookflow::Thumbnail Invalidate}

    lassign $tuple _ path
    scoreboard takeall [list THUMBNAIL $path *] [namespace code [list Cleanup $project $path]]

    Debug.bookflow/thumbnail {Bookflow::Thumbnail Invalidate/}
    return
}

proc ::bookflow::thumbnail::Cleanup {project path tuples} {
    Debug.bookflow/thumbnail {Bookflow::Thumbnail Cleanup}

    file delete [ThumbFullPath $project $path]

    WatchForInvalidation $project

    Debug.bookflow/thumbnail {Bookflow::Thumbnail Cleanup/}
    return
}

# ### ### ### ######### ######### #########
## Internals. Creation request handling. See doc/interaction_pci.txt (2).

proc ::bookflow::thumbnail::WatchForMisses {project} {
    Debug.bookflow/thumbnail {Bookflow::Thumbnail WatchForMisses}

    # doc/interaction_pci.txt (2)
    scoreboard bind missing {THUMBNAIL *} [namespace code [list MakeImage $project]]

    Debug.bookflow/thumbnail {Bookflow::Thumbnail WatchForMisses}
    return
}

proc ::bookflow::thumbnail::MakeImage {project pattern} {
    # pattern = (THUMBNAIL path size *)
    Debug.bookflow/thumbnail {Bookflow::Thumbnail MakeImage}

    lassign $pattern _ path size

    set dst [Path $path $size]

    if {[file exists $project/$dst]} {
	# The requested image already exists in the filesystem cache,
	# simply make it available.

	Return $path $size $dst

	Debug.bookflow/thumbnail {Bookflow::Thumbnail MakeImage/}
	return
    }

    # The image is not known yet. Forward the request to the scaling
    # tasks to create the desired image.

    RequestCreation $path $size $dst

    Debug.bookflow/thumbnail {Bookflow::Thumbnail MakeImage/}
    return
}

proc ::bookflow::thumbnail::Return {path size dst} {
    scoreboard put [list THUMBNAIL $path $size $dst]
    return
}

# ### ### ### ######### ######### #########
## Internals. Background tasks handling the actual scaling.

proc ::bookflow::thumbnail::RequestCreation {path size dst} {
    scoreboard put [list SCALE $path $size $dst]
    return
}

proc ::bookflow::thumbnail::ScalingTask {project} {
    package require debug
    Debug.bookflow/thumbnail {Bookflow::Thumbnail ScalingTask}

    # Requisites for the task
    package require bookflow::thumbnail
    package require scoreboard
    package require crimp ; wm withdraw .
    package require img::png
    package require img::jpeg

    # Start waiting for requests.
    ReadyForRequests $project

    Debug.bookflow/thumbnail {Bookflow::Thumbnail ScalingTask/}
    return
}

proc ::bookflow::thumbnail::ReadyForRequests {project} {
    # Wait for more requests.
    scoreboard take {SCALE *} [namespace code [list ScaleImage $project]]
    return
}

proc ::bookflow::thumbnail::ScaleImage {project tuple} {
    # tuple = (SCALE path size dstpath)
    # result = (THUMBNAIL path dstpath)
    Debug.bookflow/thumbnail {Bookflow::Thumbnail ScaleImage}

    # Decode request
    lassign $tuple _ path size dst

    # Perform the scaling to requested size, reading jpeg, writing
    # png, using crimp internally.
    set photo [image create photo -file $project/$path]

    set h [image height $photo]
    set w [image width  $photo]
    if {$w > $h} {
	# Landscape.
	set h [expr {int($h*$size/$w)}]
	set w $size
    } else {
	# Portrait.
	set w [expr {int($w*$size/$h)}]
	set h $size
    }

    crimp write 2tk $photo [crimp resize [crimp read tk $photo] $w $h]
    file mkdir [file dirname $project/$dst]
    $photo write $project/$dst -format png
    image delete $photo

    Return $path $size $dst

    ReadyForRequests $project

    Debug.bookflow/thumbnail {Bookflow::Thumbnail ScaleImage/}
    return
}

# ### ### ### ######### ######### #########
## Internals. Path handling.

proc ::bookflow::thumbnail::Path {path size} {
    return .bookflow/thumb$size/[file rootname $path].png
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::bookflow::thumbnail {
    # Number of parallel scaling tasks.
    variable max 4
}

# ### ### ### ######### ######### #########
## Ready

package provide bookflow::thumbnail 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded bookflow::verify 0.1 [list source [file join $dir verify.tcl]]

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

# Background task.
# Waiting for requests to verify an exiting project database.
# Launches the task when the request is found.

# Compares found images with images in the database.

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

package require debug
package require blog
package require task

namespace eval ::bookflow::verify {}

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

debug off    bookflow/verify
#debug on     bookflow/verify

# ### ### ### ######### ######### #########
## API & Implementation

proc ::bookflow::verify {} {
    Debug.bookflow/verify {Bookflow::Verify Watch}

    scoreboard take {PROJECT VERIFY} [namespace code verify::RUN]

    Debug.bookflow/verify {/}
}

# ### ### ### ######### ######### #########
## Internals

proc ::bookflow::verify::RUN {tuple} {
    Debug.bookflow/verify {Bookflow::Verify RUN}

    Log.bookflow {Verifying project database...}

    task launch [list ::apply {{} {
	package require bookflow::verify
	bookflow::verify::TASK
    }}]

    Debug.bookflow/verify {Bookflow::Verify RUN/}
    return
}

proc ::bookflow::verify::TASK {} {
    package require debug
    Debug.bookflow/verify {Bookflow::Verify TASK}

    # Requisites for the task
    package require scoreboard
    package require struct::set
    package require bookflow::verify
    package require bookflow::project ; # client

    scoreboard wpeek {AT *} [namespace code BEGIN]

    Debug.bookflow/verify {Bookflow::Verify TASK/}
    return
}

proc ::bookflow::verify::BEGIN {tuple} {
    variable defaultfile

    Debug.bookflow/verify {Bookflow::Verify BEGIN <$tuple>}

    # tuple = (AT project)

    # Get the payload
    lassign $tuple _ projectdir

    # We wait until the server thread has completed initialization and
    # is providing access to the database.

    ::bookflow::project::ok [namespace code [list WaitForServerStart $projectdir]]

    Debug.bookflow/verify {Bookflow::Verify BEGIN/}
    return
}

proc ::bookflow::verify::WaitForServerStart {project} {
    Debug.bookflow/verify {Bookflow::Verify WaitForServerStart}

    # Fill the database using the image files found by the scanner.
    scoreboard takeall {FILE*} [namespace code [list FILES $project]]

    Debug.bookflow/verify {Bookflow::Verify WaitForServerStart/}
    return
}

proc ::bookflow::verify::FILES {project tuples} {
    Debug.bookflow/verify {Bookflow::Verify FILES}
    # tuples = list ((FILE *)...)

    # We now have the files found by the scanner...
    set scanned {}
    foreach def [lsort -dict -index 1 $tuples] {
	lassign $def _ jpeg
	lappend scanned $jpeg
    }

    # ... and the files known to the project.
    set known [::bookflow::project files]

    # Separate them into newly added, gone missing, and unchanged.
    lassign [struct::set intersect3 $scanned $known] \
	unchanged new del

    # New files are handled like the create task does, i.e. they are
    # added to the @SCRATCH book. NOTE that we are not adding them to
    # the scoreboard yet. This is done later, when all books have been
    # updated per the images.

    foreach jpeg $new {
	::bookflow::project book extend @SCRATCH $jpeg \
	    [file mtime $project/$jpeg]
    }

    # Removed files are moved from whereever they are into the @TRASH
    # book. Except those which are already there.

    foreach jpeg $new {
	set jbook [::bookflow::project book holding $jpeg]
	if {$jbook eq "@TRASH"} continue
	::bookflow::project book move @TRASH $jpeg
    }

    # Unchanged files ... Those in @TRASH have apparently been
    # restored as files, so these move to @SCRATCH. Even so, we cannot be sure that their derived data is ok,
    # forcing us to invalidate them.

    foreach jpeg $unchanged {
	set jbook [::bookflow::project book holding $jpeg]
	if {$jbook eq "@TRASH"} {
	    # FUTURE :: See if we can remember their old book
	    # FUTURE :: somewhere, and restore them to that.
	    ::bookflow::project book move @SCRATCH $jpeg
	    set modified 1
	} else {
	    # Ok, this file was present before, and is still present.
	    # Now let us check if it was modified since the project
	    # was used the last time. Because if so the derived data
	    # we have is useless and need to be regenerated.

	    set current  [file mtime $project/$jpeg]
	    set last     [::bookflow::project file mtime $jpeg]
	    set modified [expr {$current != $last}]
	}

	if {$modified} {
	    # Invalidation requests. We can do the statistics here
	    # because nobody is in a position to ask for it and we
	    # know how to do it. For the other things we rely on their
	    # producers for the invalidation.
	    ::bookflow::project statistics unset $jpeg
	    scoreboard put [list !THUMBNAIL  $jpeg]
	    scoreboard put [list !GREYSCALE  $jpeg]
	}
    }

    # Closing work ...

    # ... pull books out of the database and declare them ...

    foreach b [::bookflow::project books] {
	Debug.bookflow/verify {                   BOOK $b}
	scoreboard put [list BOOK $b]

	# ... pull files out and declare them ...
	foreach {jpeg serial} [::bookflow::project book files $b] {
	    Debug.bookflow/verify {                   IMAGE $jpeg $serial $b}
	    scoreboard put [list IMAGE $jpeg $serial $b]

	    # Pre-load any statistics information, shortcircuiting its
	    # producer.

	    set statistics [::bookflow::project statistics get $jpeg]
	    if {$statistics ne {}} {
		scoreboard put [list STATISTICS $jpeg $statistics]
	    }
	}
    }

    Debug.bookflow/verify {Bookflow::Verify FILES/}

    task::exit
    return
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::bookflow {
    namespace export verify
    namespace ensemble create

    namespace eval verify {
	variable defaultfile BOOKFLOW
    }
}

# ### ### ### ######### ######### #########
## Ready

package provide bookflow::verify 0.1
return

if {![package vsatisfies [package require Tcl] 8.5]} return
package ifneeded widget::log 0.1 [list source [file join $dir wlog.tcl]]

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

# A simple log window where system activity can be shown to the end user.
# Not specific to bookflow.

# FUTURE expansion
# Tagging of messages, allowing for customization of appearance (like
# colorization).

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

package require Tcl 8.5
package require Tk
package require snit
package require widget::scrolledwindow

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

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

snit::widgetadaptor ::widget::log {
    delegate option * to mytext

    constructor {args} {
	installhull using widget::scrolledwindow \
	    -borderwidth 1 -relief sunken

	set mytext [text $win.log -height 5 -width 80 -font {Helvetica -18}]
	$hull setwidget $mytext

	$self configurelist $args
	return
    }

    method puts {text} {
	$self puts* $text\n
	return
    }

    method puts* {text} {
	$mytext configure -state normal
	$mytext insert end $text
	$mytext see end
	$mytext configure -state disabled
	return
    }

    # ### ### ### ######### ######### #########
    ##

    variable mytext

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

# ### ### ### ######### ######### #########
## Ready

package provide widget::log 0.1
return

#!/bin/sh
# -*- tcl -*- \
exec tclsh "\$0" ${1+"$@"}
# tools
# - scan the bookflow sources for scoreboard access and generate
#   a database telling us who accesses what and how.

# ## ### ##### ######## ############# #####################

package require Tcl 8.5
package require fileutil

# ## ### ##### ######## ############# #####################

proc main {tooldir} {
    dump [sbscan [file dirname $tooldir]]
    return
}

proc sbscan {topdir} {
    #puts Scanning\ $topdir...

    set db {}
    foreach f [fileutil::findByPattern $topdir -glob -- *.tcl] {
	if {[file isdirectory $f]} continue
	if {[string match *doc_scoreboard* $f]} continue
	if {[string match *pkgIndex* $f]} continue
	lappend db {*}[scansbfile $f [fileutil::stripPath $topdir $f]]
    }
    return $db
}

proc scansbfile {f fname} {
    #puts \t$f...

    array set t {}
    set TUPLE {}

    foreach line [split [fileutil::cat $f] \n] {
	set line [string trim $line]
	switch -glob -- $line {
	    \#* {
		# ... pragmas
		if {[string match {*@SB *} $line]} {
		    regexp {@SB (.*)$} $line -> TUPLE
		}
	    }
	    package*provide* {
		# might use this in future.
		# for new we key on the file name.
		lassign $line _ _ package _
	    }
	    scoreboard* {
		#puts \t\t|$line|
		word line ; # scoreboard
		set method [word line]
		switch -exact -- $method {
		    put {
			# remainder = tuples
			while {$line ne {}} {
			    set tuple [tuple line]
			    lappend t($tuple) $method
			}
		    }
		    take -
		    takeall -
		    peek -
		    wpeek {
			set tuple [tuple line]
			lappend t($tuple) $method
		    }
		    unbind -
		    bind {
			set event [word line]
			set tuple [tuple line]
			lappend t($tuple) [list $method $event]
		    }
		    default {
			# unknown method.
			puts \tUnknown\ method \"$method\" found
		    }
		}
	    }
	}
    }

    if {![array size t]} { return }

    return [list $fname [array get t]]
    # result = dict (file -> dict (tuple -> list (action...)))
}

proc tuple {svar} {
    upvar 1 $svar string TUPLE TUPLE
    set tuple [word string]
    if {$TUPLE ne {}} {
	set tuple $TUPLE
	set TUPLE {}
    }
    return $tuple
}

proc word {svar} {
    upvar 1 $svar string
    set string [string trim $string]

    #puts "\[word \"$string\"\]"

    if {[string match "\$\{*" $string]} {
	set c varb
	regexp {(\${[^\}]+})[ 	]+(.*)$} $string -> word remainder
    } elseif {[string match "\$*" $string]} {
	set c var

	expr {[regexp {(\$[^ 	]+)[ 	]+(.*)$} $string -> word remainder] ||
	      [regexp {(\$[^ 	]+)()$} $string -> word remainder]}
    } elseif {[string match "\\\[*" $string]} {
	set c cmd
	set patterni "(\\\[\[^\]\]+\\\])\[ 	\]+(.*)$"
	set patterne "(\\\[\[^\]\]+\\\])()$"
	expr {[regexp $patterni $string -> word remainder] ||
	      [regexp $patterne $string -> word remainder]}
    } elseif {[string match "\\\{*" $string]} {
	set c w
	set patterni "(\\\{\[^\}\]+\\\})\[ 	\]+(.*)$"
	set patterne "(\\\{\[^\}\]+\\\})()$"
	expr {[regexp $patterni $string -> word remainder] ||
	      [regexp $patterne $string -> word remainder]}
	# strip the braces.
	set word [string range $word 1 end-1]
    } else {
	set c w
	regexp {([^ 	]+)[ 	]+(.*)$} $string -> word remainder
    }

    if {![info exists word]} {
	error "word error ($string)"
    }

    #puts \t$c|$word|$remainder|

    set string $remainder
    return $word
}

proc dump {db} {
    # db = dict (file -> dict (tuple -> list (action...)))

    #array set d $db
    #parray d

    # Invert the structure to make the tuple (patterns) the major index.
    # D = dict (tuple -> dict (action -> list (file...)))

    set D {}
    foreach {fname data} $db {
	foreach {tuple actions} $data {
	    set actions [lsort -unique $actions]
	    set A {}
	    foreach a $actions {
		dict lappend A $a $fname
	    }
	    dict lappend D $tuple $A
	}
    }
    set db $D
    set D {}
    foreach {tuple data} $db {
	# data = list (dict (action -> list(fname)))
	array set X {}
	foreach dict $data {
	    lassign $dict action files
	    lappend X($action) {*}$files
	}
	#parray X
	lappend D $tuple [array get X]
	array unset X
    }

    #puts $D
    #return

    # Write structure in machine- and human-readable form.
    foreach {tuple fa} [dictsort $D] {
	puts "\ntuple [list $tuple] \{"
	# todo description - get via pragma's
	puts "\} \{"
	#puts "==== $fa ===="
	foreach {action files} [dictsort $fa] {
	    set files [lsort -unique $files]
	    puts "    $action \{\n\t[join $files "\n\t"]\n    \}"
	}
	puts "\}"
    }

    #array set T $D
    #parray T
    return
}

proc dictsort {dict} {
    array set a $dict
    set out [list]
    foreach key [lsort [array names a]] {
	lappend out $key $a($key)
    }
    return $out
}

# ## ### ##### ######## ############# #####################

main [file dirname [file normalize [info script]]]
exit

#!/usr/bin/env tclsh
# -*- tcl -*-
# # ## ### ##### ######## ############# #####################
# Take the current project for the user to go over images and flag their properties
# (left/right, cover/content, exclude bad). Requires the medium size thumbnails for
# display (made by -> bookflow-gen-medium).

package require Tcl 8.5

::apply {{selfdir} {
    # selfdir == bindir
    lappend ::auto_path [file dirname $selfdir]/lib
    return
}} [file dirname [file normalize [info script]]]

# TODO: Restrict to images of a certain size and/or make (camera type).

package require Tk  8.5
package require widget::toolbar
package require widget::statusbar
package require widget::scrolledwindow

# Would prefer to have a widget::progressbar
package require BWidget ; ProgressBar::use

package require bookflow::project
package require crimp::tk  ;# crimp -> photo
package require crimp::ppm ;# crimp -> reading ppm
# XXX TODO: crimp::jpeg
package require action
package require famfamfam::silk
package require tooltip

# # ## ### ##### ######## ############# #####################

proc main {} {
    if {[catch {
	cmdline
	view
	controller
	model
    } msg]} {
	puts stderr $msg
	exit 1
    }

    # Begin event loop, and interaction
    vwait ::forever
    return
}

proc cmdline {} {
    global argv argv0
    if {[llength $argv] > 1} {
	puts stderr "Usage: $argv0 ?projectdir?"
	exit 1
    }
    if {[llength $argv] == 1} {
	cd [lindex $argv 0]
    }

    # Open the project file.
    bookflow::project BOOK [pwd]/BOOKFLOW
    return
}

# # ## ### ##### ######## ############# #####################
## View

proc view {} {
    wm withdraw .
    view/widgets
    view/layout
    wm deiconify .
    return
}

proc view/widgets {} {
    # listbox, left or right, of all images (fast switching).
    # various labels for status icons
    # label displaying the current page image
    # buttons: next, previous, first, last, exit - toolbar
    # statusbar - messages ...

    ::widget::toolbar   .tools
    ::widget::statusbar .status

    ttk::label          .status.message  \
	-textvariable ::vstatus \
	-width 1 -anchor w

    ProgressBar         .status.progress \
	-variable ::vprogress \
	-type infinite -orient horizontal \
	-bd 1 -relief sunken

    widget::scrolledwindow .sw -borderwidth 1 -relief sunken
    listbox                .images \
	-listvariable ::vimages \
	-selectmode extended

    label               .page -bd 5

    ttk::label          .orient
    ttk::label          .left
    ttk::label          .right
    ttk::label          .attention
    ttk::label          .dropped

    view/tool/add arrow_left  |<--   First    first
    view/tool/add arrow_left   <--   Previous previous
    view/tool/add arrow_right   -->  Next     next
    view/tool/add arrow_right   -->| Last     last
    view/tool/space
    view/tool/add asterisk_orange Exit Exit exit

    view/tag .
    return
}

proc view/tag {w} {
    bindtags $w [list _self {*}[bindtags $w]]
    foreach c [winfo children $w] {
	view/tag $c
    }
    return
}

proc view/tool/add {image label hint action args} {
    set     cmd {}
    lappend cmd .tools add button $label
    lappend cmd -text $label
    lappend cmd -command [list action invoke $action] {*}$args
    if {$image ne {}} {
	lappend cmd -image [famfamfam silk get $image]
    }

    {*}$cmd

    set w [.tools itemid $label]

    tooltip::tooltip $w $hint
    after 0 [list action link $action $w]
    return
}

proc view/tool/space {} {
    .tools add space  ____ -separator 1
    return
}

proc view/layout {} {
    .sw setwidget .images

    .status add .status.message -weight 1
    .status add .status.progress

    grid columnconfigure . 0 -weight 0
    grid columnconfigure . 1 -weight 0
    grid columnconfigure . 2 -weight 0
    grid columnconfigure . 3 -weight 0
    grid columnconfigure . 4 -weight 0
    grid columnconfigure . 5 -weight 1
    grid columnconfigure . 6 -weight 0

    grid rowconfigure    . 0 -weight 0
    grid rowconfigure    . 1 -weight 0
    grid rowconfigure    . 2 -weight 0
    grid rowconfigure    . 3 -weight 1
    grid rowconfigure    . 4 -weight 0

    view/layout/at .tools     0 0 1 7
    view/layout/at .sw        1 0 3 1
    view/layout/at .orient    1 1 1 1
    view/layout/at .left      1 2 1 1
    view/layout/at .attention 1 3 1 1
    view/layout/at .dropped   1 4 1 1
    view/layout/at .right     1 6 1 1
    view/layout/at .page      3 1 1 6
    view/layout/at .status    4 0 1 7
    return
}

proc view/layout/at {widget row col r c} {
    grid $widget -row $row -column $col \
	-sticky swen -rowspan $r -columnspan $c
    return
}

# # ## ### ##### ######## ############# #####################
# # ## ### ##### ######## ############# #####################
# View. Entrypoints for the controller.

proc view/status {text} {
    set ::vstatus $text
    return
}

proc view/progress/tick {} {
    .status add .status.progress
    incr ::vprogress
    return
}

proc view/progress/reset {} {
    catch { .status remove .status.progress }
    set ::vprogress 0
    return
}

proc view/show {select index image used even content attention orientation} {
    global oicon
    #puts "v/s |$select $index $image i$used e$even c$content a$attention|"
    catch { image delete [.page cget -image] }
    .page configure -image $image

    if {$attention} {
	.attention configure -image [famfamfam silk get exclamation]
    } else {
	.attention configure -image {}
    }

    if {$used} {
	.dropped configure -image {}
    } else {
	.dropped configure -image [famfamfam silk get cross]
    }

    if {$even} {
	.left  configure -image [famfamfam silk get asterisk_yellow]
	.right configure -image {}
    } else {
	.left  configure -image {}
	.right configure -image [famfamfam silk get asterisk_yellow]
    }

    .orient configure -image [famfamfam silk get $oicon($orientation)]

    if {$content} { ; # content page
	.page configure -bg blue
    } else {        ; # cover page
	.page configure -bg green
    }

    # List visualization of the flags
    .images itemconfigure $index \
	{*}[view/list/flags $used $even $content $attention $orientation]

    # Modify list
    if {$select} {
	#puts XS=$index
	.images selection clear 0 end
	.images selection set $index
	.images activate $index
	c/selection
    }
    .images see $index
    return
}

proc view/show/none {} {
    image delete [.page cget -image]

    .page      configure -image {} -bg black
    .orient    configure -image {}
    .attention configure -image {}
    .dropped   configure -image {}
    .right     configure -image {}
    .left      configure -image {}
    return
}

proc view/list/fill {images iflags} {
    set ::vimages $images
    set k 0
    foreach item $iflags {
	lassign $item _ used even content attention orientation
	.images itemconfigure $k \
	    {*}[view/list/flags $used $even $content $attention $orientation]
	incr k
    }
    return
}

proc view/list/flags {used even content attention orientation} {
    set options {}

    if {$content} {
	lappend options -fg black
    } else {
	lappend options -fg green
    }
    if {!$used} {
	lappend options -bg red
    } elseif {$attention} {
	lappend options -bg yellow
    } else {
	lappend options -bg white
    }

    return $options
}

proc view/selection {} {
    return [.images curselection]
}

# # ## ### ##### ######## ############# #####################
## Controller

proc controller {} {
    c/actions
    c/bindings

    after 0 c/launch
    return
}

proc c/actions {} {
    action define exit     ::exit

    action define next      c/show/next
    action define previous  c/show/previous
    action define first     c/show/first
    action define last      c/show/last

    action define attention c/toggle/attention
    action define drop      c/toggle/used
    action define front     c/mark/cover_front
    action define back      c/mark/cover_back
    action define left      c/mark/even 1
    action define right     c/mark/even 0
    action define cover     c/mark/content 0
    action define page      c/mark/content 1

    action define east      c/orient east
    action define south     c/orient south
    action define west      c/orient west
    action define north     c/orient north
    return
}

proc c/bindings {} {
    # Leave
    bind _self <q>      {action invoke exit ; break}

    # Navigation
    bind _self <Left>   {action invoke previous ; break}
    bind _self <Right>  {action invoke next     ; break}
    bind _self <Up>     {action invoke previous ; break}
    bind _self <Down>   {action invoke next     ; break}
    bind _self <Prior>  {action invoke previous ; break}
    bind _self <Next>   {action invoke next     ; break}
    bind _self <Home>   {action invoke first    ; break}
    bind _self <End>    {action invoke last     ; break}

    # Selection
    bind .images <<ListboxSelect>> c/selection

    # Flags
    bind _self <exclam> {action invoke attention ; break}
    bind _self <d>      {action invoke drop      ; break}
    bind _self <f>      {action invoke front     ; break}
    bind _self <b>      {action invoke back      ; break}
    bind _self <l>      {action invoke left      ; break}
    bind _self <r>      {action invoke right     ; break}
    bind _self <c>      {action invoke cover     ; break}
    bind _self <p>      {action invoke page      ; break}

    # Orientation
    bind _self <e>      {action invoke east      ; break}
    bind _self <s>      {action invoke south     ; break}
    bind _self <w>      {action invoke west      ; break}
    bind _self <n>      {action invoke north     ; break}
    return
}

proc c/launch {} {
    action disable
    action enable exit

    m/initialize c/ready
    return
}

proc c/ready {} {
    global cimages cchosen
    set cchosen {}
    lassign [m/list] cimages iflags
    view/list/fill $cimages $iflags
    c/show/first
    after 0 {action enable}
    return
}

# # ## ### ##### ######## ############# #####################
## Controller state

global cimages  ; # list of shown images
global cchosen  ; # indices of the selected images
global cshown   ; # index of the shown image
global ccurrent ; # path of the shown image
global cflags   ; # flags of the shown image

# # ## ### ##### ######## ############# #####################
# # ## ### ##### ######## ############# #####################
# Implementations for the various actions

proc c/selection {} {
    global cchosen
    set current [view/selection]
    #puts C=$current
    #puts S=$cchosen
    if {$current eq $cchosen} return
    set cchosen $current
    #puts S*$cchosen
    if {[llength $cchosen]} {
	c/show [lindex $cchosen 0] 0
    } else {
	c/show/none
    }
    return
}

proc c/load {index} {
    global cshown ccurrent cimages cflags
    # Locate image by index, then translate index (possibly symbolic,
    # or relative) to a proper integer number.
    set ccurrent [lindex $cimages $index]
    set cshown   [lsearch -exact $cimages $ccurrent]
    set cflags   [lassign [m/get $ccurrent] image]
    return
}

proc c/show {index {select 1}} {
    global cshown ccurrent cimages cflags
    # Locate image by index, then translate index (possibly symbolic,
    # or relative) to a proper integer number.
    set ccurrent [lindex $cimages $index]
    set cshown   [lsearch -exact $cimages $ccurrent]
    set cflags   [lassign [m/get $ccurrent] image]

    view/show $select $cshown $image {*}$cflags
    view/status [expr {1+$cshown}]/[llength $cimages]
    return
}

proc c/show/none {} {
    view/show/none
    view/status {}
    return
}

proc c/show/first {} {
    c/show 0
    return
}

proc c/show/last {} {
    c/show end
    return
}

proc c/show/next {} {
    c/show [c/advance]
    return
}

proc c/show/previous {} {
    c/show [c/advance -1]
    return
}

proc c/advance {{step 1}} {
    global cshown cimages
    set n $cshown
    incr n $step
    if {$n < 0} {
	set n [llength $cimages]
	incr n -1
    } elseif {$n >= [llength $cimages]} {
	set n 0
    }
    return $n
}

proc c/apply/selection {label script} {
    global cchosen cflags ccurrent cshown
    if {![llength $cchosen]} return
    action disable
    set saved $cshown
    set count 0
    set max [llength $cchosen]
    foreach sel $cchosen {
	view/status "\[$label [expr {1+$sel}]\] [incr count]/$max"
	view/progress/tick
	update
	c/load $sel
	lassign $cflags u e c a o
	eval $script
	m/set $ccurrent $u $e $c $a $o
	c/load $sel
    }
    c/show $saved 0
    action enable
    view/progress/reset
    return
}

proc c/toggle/attention {} {
    c/apply/selection {toggle attention} {
	set a [expr {!$a}]
    }
    return
}

proc c/toggle/used {} {
    c/apply/selection {toggle used} {
	set u [expr {!$u}]
    }
    return
}

proc c/mark/cover_front {} {
    c/apply/selection {front cover/west} {
	set e 0 ; # odd == right == front
	set c 0 ; # cover
	set o 2 ; # west
    }
    return
}

proc c/mark/cover_back {} {
    c/apply/selection {back cover/east} {
	set e 1 ; # even == left == back
	set c 0 ; # cover
	set o 0 ; # east
    }
    return
}

proc c/mark/even {even} {
    # Note: orientation derived from left/right
    # Explicit orientation must be done after l/r classification
    global omap
    set w [expr {$even ? "left/even" : "right/odd"}]
    set theorient [expr {$even ? "east" : "west"}]
    set orient $omap($theorient)
    c/apply/selection $w/$theorient {
	upvar 1 even even orient orient
	set e $even
	set o $orient
    }
    return
}

proc c/mark/content {page} {
    set w [expr {$page ? "content" : "cover"}]
    c/apply/selection $w {
	upvar 1 page page
	set c $page
    }
    return
}

array set omap {
    0 0 east  0
    1 1 south 1
    2 2 west  2
    3 3 north 3
}

array set oicon {
    0 arrow_right  east  arrow_right
    1 arrow_down   south arrow_down
    2 arrow_left   west  arrow_left
    3 arrow_up     north arrow_up
}

proc c/orient {theorient} {
    global omap
    set orient $omap($theorient)
    c/apply/selection $theorient {
	upvar 1 orient orient
	set o $orient
    }
    return
}

# # ## ### ##### ######## ############# #####################
## Model

proc model {} {
    # nothing at the moment
    return
}

proc m/initialize {args} {
    global mimages

    set mimages  {}
    foreach i [BOOK images-all] {
	set flags   [BOOK indicator? $i]
	dict with flags {}
	lappend mimages \
	    [list $i $used $even $content $attention]
    }
    after 0 $args
    return
}

proc m/get {imgpath} {
    set image [BOOK medium?    $imgpath]
    set flags [BOOK indicator? $imgpath]
    dict with flags {}
    return [list $image $used $even $content $attention $orientation]
}

proc m/set {imgpath used even content attention orientation} {
    #puts "m/set |$imgpath i$used e$even c$content a$attention|"
    BOOK indicator $imgpath \
	[dict create            \
	     used        $used   \
	     even        $even    \
	     content     $content  \
	     attention   $attention \
	     orientation $orientation]
    return
}

proc m/list {} {
    global mimages
    return [list [BOOK images-all] $mimages]
}

# # ## ### ##### ######## ############# #####################

main
exit