################################################################################
# jigsaw-create.tcl
# 
# Package to implement creation of Jigsaw net and Jigsaw cutting
# 
# Author: David Easton
################################################################################

namespace eval jigsaw-create {
}

###################################################
# jigsaw-create::reverseCoords
#
# Reverse a list of coordinates
###################################################
proc jigsaw-create::reverseCoords { initList } {
    set revList [list]
    foreach {x y} $initList {
        set revList [linsert $revList 0 $x $y]
    }
    return $revList
}

###################################################
# jigsaw-create::setupPointCoords
#
# Sets up the points that act as intersections
# between the puzzle pieces
###################################################
proc jigsaw-create::setupPointCoords { width height pointRand} {
    variable data

    set numx $data(numx)
    set numy $data(numy)

    # height and width of 1 piece
    set dw [expr {double($width)/$numx}]
    set dh [expr {double($height)/$numy}]

    for {set nx 0} {$nx <= $numx} {incr nx} {
        for {set ny 0} {$ny <= $numy} {incr ny} {
            set x [expr {int($dw*$nx)}]
            set y [expr {int($dh*$ny)}]

            # Add a random variation if this is not the edge
            # The magnitude is controlled by the pointRand variable
            if { $nx != 0 && $nx != $numx } {
                incr x [expr {int(($pointRand/100.0)*($dw/2.0)*(rand()-0.5))}]
            }
            if { $ny != 0 && $ny != $numy } {
                incr y [expr {int(($pointRand/100.0)*($dh/1.5)*(rand()-0.5))}]
            }
            set data(point:$nx,$ny) [list $x $y]
        }
    }
}

###################################################
# jigsaw-create::setupLineCoords
#
# Connects the points at the corner of puzzle
# pieces with lines in the shape of one edge of
# a puzzle piece.
###################################################
proc jigsaw-create::setupLineCoords {holePosRand holeSize} {
    variable data

    set numx $data(numx)
    set numy $data(numy)

    for {set nx 0} {$nx <= $numx} {incr nx} {
        for {set ny 0} {$ny <= $numy} {incr ny} {
            set nx2 [expr {$nx+1}]
            set ny2 [expr {$ny+1}]
            
            # Vertical lines
            if {$ny < $numy } {
                # If it is an edge piece, make it a straight line
                if { $nx == 0 || $nx == $numx } {
                    set data(line:$nx,$ny:$nx,$ny2) [concat $data(point:$nx,$ny) $data(point:$nx,$ny2)]
                } else {
                    # Decide if the join should stick out on the left or right
                    if {[expr {($nx+$ny)%2}] == 0} {
                        set inOut 1.0
                    } else {
                        set inOut -1.0
                    }

                    # Modify inOut by using holePosRand
                    # Value 0 = no change, Value 100 = random change
                    if {[expr {int(200*rand())}] < $holePosRand} {
                        set inOut [expr {-1.0 * $inOut}]
                    }

                    jigsaw-create::randomizeLine $holeSize
                    set data(line:$nx,$ny:$nx,$ny2) [jigsaw-create::getLineCoords $data(point:$nx,$ny) $data(point:$nx,$ny2) $inOut]
                }
                # Now make the line data going from point2 to point 1
                set data(line:$nx,$ny2:$nx,$ny) [jigsaw-create::reverseCoords $data(line:$nx,$ny:$nx,$ny2)]
            }
            
            # Horizontal lines
            if {$nx < $numx } {
                # If it is an edge piece, make it a straight line
                if { $ny == 0 || $ny == $numy } {
                    set data(line:$nx,$ny:$nx2,$ny) [concat $data(point:$nx,$ny) $data(point:$nx2,$ny)]
                } else {
                    # Decide if the join should stick out on the left or right
                    if {[expr {($nx+$ny)%2}] == 0} {
                        set inOut 1.0
                    } else {
                        set inOut -1.0
                    }

                    # Modify inOut by using holePosRand
                    # Value 0 = no change, Value 100 = random change
                    if {[expr {int(200*rand())}] < $holePosRand} {
                        set inOut [expr {-1.0 * $inOut}]
                    }

                    jigsaw-create::randomizeLine $holeSize
                    set data(line:$nx,$ny:$nx2,$ny) [jigsaw-create::getLineCoords $data(point:$nx,$ny) $data(point:$nx2,$ny) $inOut]
                }
                # Now make the line data going from point2 to point 1
                set data(line:$nx2,$ny:$nx,$ny) [jigsaw-create::reverseCoords $data(line:$nx,$ny:$nx2,$ny)]
            }
        }
    }
}

###################################################
# jigsaw-create::setupPolyCoords
#
# Create a smoothed polygon in the shape of a
# puzzle piece by joining together 4 lines
# already calculated to join the corners
#
# type: full   - Create full puzzle piece
#       bottom - Only bottom looks like puzzle piece
#       right  - Only right looks like puzzle piece
###################################################
proc jigsaw-create::setupPolyCoords { type } {
    variable data

    set numx $data(numx)
    set numy $data(numy)
 
    for {set nx 0} {$nx < $numx} {incr nx} {
        for {set ny 0} {$ny < $numy} {incr ny} {
            set nx2 [expr {$nx+1}]
            set ny2 [expr {$ny+1}]

            switch -- $type {
                full {
                    set pStr "poly"
                    set data($pStr:$nx,$ny) [concat \
                                           $data(line:$nx,$ny:$nx2,$ny) \
                                           $data(line:$nx2,$ny:$nx2,$ny2) \
                                           $data(line:$nx2,$ny2:$nx,$ny2) \
                                           $data(line:$nx,$ny2:$nx,$ny) ]
                }

                bottom {
                    set pStr "poly,b"
                    # Want right angles except for the bottom side
                    set rx1 [lindex $data(point:$nx,$ny2) 0]
                    set rx2 [lindex $data(point:$nx2,$ny2) 0]
                    set ry1 [lindex $data(point:$nx,$ny) 1]
                    set ry2 [lindex $data(point:$nx2,$ny) 1]
                    if {$ry1 <= $ry2} {
                        set ry $ry1
                    } else {
                        set ry $ry2
                    } 
                    set data($pStr:$nx,$ny) [concat \
                                           $rx1 $ry $rx2 $ry \
                                           $rx2 $ry $data(point:$nx2,$ny2) \
                                           $data(line:$nx2,$ny2:$nx,$ny2) \
                                           $data(point:$nx,$ny2) $rx1 $ry]
                }

                right {
                    set pStr "poly,r"
                    # Want right angles except for the right side
                    set rx1 [lindex $data(point:$nx,$ny) 0]
                    set rx2 [lindex $data(point:$nx,$ny2) 0]
                    set ry1 [lindex $data(point:$nx2,$ny) 1]
                    set ry2 [lindex $data(point:$nx2,$ny2) 1]
                    if {$rx1 <= $rx2} {
                        set rx $rx1
                    } else {
                        set rx $rx2
                    } 
                    set data($pStr:$nx,$ny) [concat \
                                           $rx $ry1 $data(point:$nx2,$ny) \
                                           $data(line:$nx2,$ny:$nx2,$ny2) \
                                           $data(point:$nx2,$ny2) $rx $ry2 \
                                           $rx $ry2 $rx $ry1]
                }

                default {
                    # Unknown definition
                    puts stderr "jigsaw-create::setupPolyCoords called with unknown type: $type"
                    return -code error
                }
            }

            # Tcl polygon drawing sometimes smooths the start/end
            # so change the inital coords to fix this

            set data($pStr:$nx,$ny) [lreplace $data($pStr:$nx,$ny) 0 0 [expr {[lindex $data($pStr:$nx,$ny) 0]-0.01}]]
        }
    }    
}

proc jigsaw-create::drawPolys {c polyColor} {
    variable data
    variable id
 
    set numx $data(numx)
    set numy $data(numy)

    # Remove any existing polys
    $c delete poly

    for {set nx 0} {$nx < $numx} {incr nx} {
        for {set ny 0} {$ny < $numy} {incr ny} {
              set id(poly:$nx,$ny) [$c create poly $data(poly:$nx,$ny) -outline $polyColor -width 1 -smooth 1 -tag poly]
        }
    }
}

# c    - Canvas in which to draw net
# numx - Number of pieces horizontally
# numy - Number of pieces vertically
# image - Image (used for size of net)
# holePosRand - Number (0-100) controlling where to place holes in pieces
# pointRand   - Number (0-100) controlling position of points intersecting pieces
# holeSize    - Number (0-100) controlling size of holes on pieces
# ployColor   - Color of piece polygons.
proc jigsaw-create::createNet {c numx numy image holePosRand pointRand holeSize polyColor} {
    variable id
    variable data
 
    set data(numx) $numx
    set data(numy) $numy
    set data(image) $image

    bind $c <Configure> {}

    # Remove 1 as canvas is starting at 0,0 not 1,1
    set data(max,x) [expr {[image width $image] -1}]
    set data(max,y) [expr {[image height $image] -1}]

    # Now configure the scrollregion to include all this area
    $c configure -scrollregion "0 0 $data(max,x) $data(max,y)"

    # Remove existing pieces
    $c delete piece

    jigsaw-create::setupPointCoords $data(max,x) $data(max,y) $pointRand
    jigsaw-create::setupLineCoords $holePosRand $holeSize
    jigsaw-create::setupPolyCoords full
    jigsaw-create::drawPolys $c $polyColor
}

###################################################
# jigsaw-create::randBetweenMinMax
#
# Returns a random integer between min and max
###################################################
proc jigsaw-create::randBetweenMinMax { min max } {
    return [expr {int($min + rand()*($max-$min))}]
}

###################################################
# jigsaw-create::connectLine
#
# Defines points in terms of angle and distance
# to the first point.
###################################################
proc jigsaw-create::connectLine {pcArrayName} {
    variable line
    upvar $pcArrayName pointCoords

    set cList {}
    set line(numPoints) 6

    foreach i [list 1 2 3 4 5 6] {
        foreach {mx my} $pointCoords($i) break
        lappend cList $mx $my

        if { $i == 1 } {
            set p1(x) $mx
            set p1(y) $my

            # Work out distance and angle to final point
            foreach {fx fy} $pointCoords(6) break

            set diffx [expr {$fx - $p1(x)}]
            set diffy [expr {$fy - $p1(y)}]

            set angf [expr {atan2($diffx,$diffy)}]
            set disf [expr {hypot($diffx,$diffy)}]
        } else {
            # Work out angle and distance from this point compared to point 1
            set diffx [expr {$mx - $p1(x)}]
            set diffy [expr {$my - $p1(y)}]

            set ang [expr {(atan2($diffx,$diffy)) - $angf}]
            set dis [expr {hypot($diffx,$diffy) / $disf}]

            set line($i) [list $ang $dis]
        }
    }
}

###################################################
# jigsaw-create::jigsaw-create::getLineCoords
#
# Apply the shape of the control line to the 2 points
# p1 and p2, warping the line as necessary
###################################################
proc jigsaw-create::getLineCoords { p1 p2 inOut} {
    variable id
    variable line

    # Get x & y coordinates of the 2 points
    foreach {px1 py1} $p1 {px2 py2} $p2 {break}

    # Initial coords of line
    set cList [list $px1 $py1]

    # Work out the angle and distance between the two points
    set diffx [expr {$px2 - $px1}]
    set diffy [expr {$py2 - $py1}]

    # Angle and dist from px1,py1 -> px2,py2
    set ang [expr {atan2($diffx,$diffy)}]
    set dis [expr {hypot($diffx,$diffy)}]

    # Now apply shape to create the line
    for {set i 2} {$i <= $line(numPoints)} {incr i} {
        foreach {angl disl} $line($i) {
            # Angle of next point
            set angn [expr {$ang + ($inOut * $angl)}]

            # Distance is ratio to be applied to
            # distance of next point on square
            set disn [expr {$dis * $disl}]

            # So the point becomes
            set xn [expr {$px1 + ($disn * sin($angn))}]
            set yn [expr {$py1 + ($disn * cos($angn))}]

            lappend cList $xn $yn
        }
    }
    return $cList
}

###################################################
# jigsaw-create::jigsaw-create::randomizeLine
#
# Randomize the control points used to define the
# shape of the edge of a puzzle piece
###################################################
proc jigsaw-create::randomizeLine {holeSize} {
    set y1 [jigsaw-create::randBetweenMinMax 30 50]
    set y6 [expr {$y1 + 110}]

    # Use holeSize to alter size of knob/hole
    set diff [expr {int($holeSize / 5.0) - 10}]
    incr y1 $diff
    set y6 [expr {$y6 - $diff}]
 
    set pointCoords(1) [list [jigsaw-create::randBetweenMinMax 45 55] $y1]
    set pointCoords(2) [list [jigsaw-create::randBetweenMinMax 52 58] [jigsaw-create::randBetweenMinMax 94 98]]
    set pointCoords(3) [list [jigsaw-create::randBetweenMinMax 28 35] [jigsaw-create::randBetweenMinMax 80 85]]
    set pointCoords(4) [list [jigsaw-create::randBetweenMinMax 28 35] [jigsaw-create::randBetweenMinMax 115 120]]
    set pointCoords(5) [list [jigsaw-create::randBetweenMinMax 52 58] [jigsaw-create::randBetweenMinMax 102 106]]
    set pointCoords(6) [list [jigsaw-create::randBetweenMinMax 45 55] $y6]
 
    jigsaw-create::connectLine pointCoords
}

###################################################
# jigsaw-create::jigsaw-create::blankOneCorner
#
# Blank one corner of an image
###################################################
proc jigsaw-create::blankOneCorner {image x1 x2 y1 y2 px py} {
    for {set y $y1} {$y < $y2} {incr y} { 
        for {set x $x1} {$x < $x2} {incr x} {
            if {$x != $px || $y != $py} { 
                $image transparency set $x $y 1 
            }
        } 
    } 
}

###################################################
# jigsaw-create::jigsaw-create::blankCorners
#
# Blank the corners of an image
###################################################
proc jigsaw-create::blankCorners {image p1 p2 p3 p4 bbox} {
    foreach {x1 y1 x2 y2} $bbox {break} 
    set w [expr {$x2-$x1}] 
    set h [expr {$y2-$y1}]
 
    # Top left 
    foreach {px py} $p1 {break}
    incr px -$x1
    incr py -$y1
    jigsaw-create::blankOneCorner $image 0 $px 0 $py $px $py

    # Top right 
    foreach {px py} $p2 {break}  
    incr px -$x1
    incr py -$y1
    jigsaw-create::blankOneCorner $image $px $w 0 $py $px $py

    # Bottom right 
    foreach {px py} $p3 {break}
    incr px -$x1
    incr py -$y1
    jigsaw-create::blankOneCorner $image $px $w $py $h $px $py

    # Bottom left 
    foreach {px py} $p4 {break}  
    incr px -$x1
    incr py -$y1
    jigsaw-create::blankOneCorner $image 0 $px $py $h $px $py
} 

###################################################
# jigsaw-create::jigsaw-create::createImages
#
# Create an image for each puzzle piece, the same
# size as the bounding box of the corresponding
# polygon and copy part of the original image.
###################################################
proc jigsaw-create::createImages {c} {
    variable data
    variable img
    variable id

    for {set ny 0} {$ny < $data(numy)} {incr ny} {
        for {set nx 0} {$nx < $data(numx)} {incr nx} {
            # Calculate size of each image
            foreach {x1 y1 x2 y2} [$c bbox $id(poly:$nx,$ny)] {break}

            # Do not allow coords outside the original image
            if { $x1 < 0 } {set x1 0}
            if { $y1 < 0 } {set y1 0}
            if { $x2 > $data(max,x) } {set x2 $data(max,x)}
            if { $y2 > $data(max,y) } {set y2 $data(max,y)}

            set data(size:$nx,$ny) [list $x1 $y1 $x2 $y2]

            # Now make the image
            set w [expr {$x2-$x1}]
            set h [expr {$y2-$y1}]

            set img($nx,$ny) [image create photo -width $w -height $h]
            $img($nx,$ny) copy $data(image) -from $x1 $y1 $x2 $y2
        }
    }
}

###################################################
# jigsaw-create::makePuzzle
#
# Cut the jigsaw - i.e. Go through all the puzzle
# piece images and make them the same shape as the
# corresponding smoothed polygon that represents
# the puzzle piece shape
#
# Information required for the jigsaw-play functions
# is stored in the arrName array.  This is:
#     $arrName(x,y:image)  - Image name for piece x,y
#     $arrName(x,y:pos)    - Position of image x,y
#    
#
###################################################
proc jigsaw-create::makePuzzle {c progressVar arrName} {
    variable id
    variable img
    variable imgPos
    variable data

    upvar $arrName playdata
    upvar $progressVar numDone

    set numx $data(numx)
    set numy $data(numy)

    set total [expr {$numx * $numy}]
    set px -1
    set py -1

    set ovCount 0
    set pieceNo 0

    jigsaw-create::createImages $c

    $c delete poly
    array unset id "poly:*"

    # Use simpler polygons for faster "find overlapping"
    jigsaw-create::setupPolyCoords bottom
    jigsaw-create::setupPolyCoords right

    set playdata(stackOrder) [list]
    set playdata(image) $data(image)

    for {set ny 0} {$ny < $numy} {incr ny} {
        for {set nx 0} {$nx < $numx} {incr nx} {
            incr pieceNo

            # Create minimum number of polygons at a time as
            # "find overlapping" is much slower with 
            # many polygons on the canvas
            set px $nx
            set py $ny
            set mx [expr {$nx+1}]
            set my [expr {$ny+1}]

            foreach {ax1 ay1 ax2 ay2} $data(size:$nx,$ny) {break}

            if { $my < $numy } {
                # Now process the area between piece $nx,$ny and $ny,$my
                set polyId [$c create poly $data(poly,b:$nx,$ny) -fill white -smooth 1 -tag poly] 

                foreach {cx1 cy1 cx2 cy2} $data(size:$nx,$my) {break}

                set x1 [lindex $data(point:$nx,$my) 0]
                set x2 [lindex $data(point:$mx,$my) 0]

                for {set y $cy1} {$y < $ay2} {incr y} {
                    set tryAll 1
                    for {set x $x1} {$x < $x2} {incr x} {
                        incr ovCount
                        set overlapList [$c find overlapping $x $y $x $y]

                        if {[lsearch $overlapList $polyId] == -1 } {
                            # See if all the remaining pixels on this line can
                            # be covered in one go
                            if { $tryAll == 1 } {
                                incr ovCount
                                if {[lsearch [$c find overlapping $x $y $x2 $y] $polyId] == -1} {
                                    #puts "X-Saves $x2 $x: [expr {$x2-$x-1}]"
                                    while {$x < $x2} {
                                        $img($nx,$ny) transparency set [expr {$x-$ax1}] [expr {$y-$ay1}] 1
                                        incr x
                                    }
                                    break
                                }
                                set tryAll 0
                            }
                            $img($nx,$ny) transparency set [expr {$x-$ax1}] [expr {$y-$ay1}] 1
                        } else {
                            $img($nx,$my) transparency set [expr {$x-$cx1}] [expr {$y-$cy1}] 1
                            set tryAll 1
                        }
                    }
                }

                $c delete $polyId
            }

            if { $mx < $numx } {
                # Now process the area between piece $nx,$ny and $mx,$ny
                set polyId [$c create poly $data(poly,r:$nx,$ny) -fill white -smooth 1 -tag poly] 

                foreach {bx1 by1 bx2 by2} $data(size:$mx,$ny) {break}

                set y1 [lindex $data(point:$mx,$ny) 1]
                set y2 [lindex $data(point:$mx,$my) 1]

                for {set y $y1} {$y < $y2} {incr y} {
                    set tryAll 1
                    for {set x $bx1} {$x < $ax2} {incr x} {
                        incr ovCount
                        set overlapList [$c find overlapping $x $y $x $y]

                        if {[lsearch $overlapList $polyId] == -1 } {
                            # See if all the remaining pixels on this line can
                            # be covered in one go
                            if { $tryAll == 1 } {
                                incr ovCount
                                if {[lsearch [$c find overlapping $x $y $ax2 $y] $polyId] == -1} {
                                    #puts "X-Saves $ax2 $x: [expr {$ax2-$x-1}]"
                                    while {$x < $ax2} {
                                        $img($nx,$ny) transparency set [expr {$x-$ax1}] [expr {$y-$ay1}] 1
                                        incr x
                                    }
                                    break
                                }
                                set tryAll 0
                            }
                            $img($nx,$ny) transparency set [expr {$x-$ax1}] [expr {$y-$ay1}] 1
                        } else {
                            $img($mx,$ny) transparency set [expr {$x-$bx1}] [expr {$y-$by1}] 1
                            set tryAll 1
                        }
                    }
                }

                $c delete $polyId
            }

            # Need to blank all 4 corners
            jigsaw-create::blankCorners $img($nx,$ny) \
                         $data(point:$nx,$ny) $data(point:$mx,$ny) \
                         $data(point:$mx,$my) $data(point:$nx,$my) \
                         $data(size:$nx,$ny) 

            set cid [$c create image $ax1 $ay1 -anchor nw -image $img($nx,$ny) -tag piece]
            set id(piece:$nx,$ny) $cid
            set playdata($nx,$ny:image) $img($nx,$ny)
            set playdata($nx,$ny:pos) [list $ax1 $ay1]
            lappend playdata(stackOrder) "$nx,$ny"
            set imgPos(id:$cid)    [list $ax1 $ay1]

            # Update progress tracking variable
            set numDone $pieceNo

            # Keep GUI alive (update idletasks is not enough)
            update
        }
    }

    # Delete any remaining polygons
    foreach entry [array names id "poly:*"] {
        $c delete $id($entry)
        unset id($entry)
    }
}
