package provide pdtk_canvas 0.1

package require pd_bindings

namespace eval ::pdtk_canvas:: {

    # the untitled name prefix pd checks for using a macro in g_canvas.h,
    # a saveas panel is shown when saving a file with this name
    variable untitled_name "PDUNTITLED"
    variable untitled_len 10

    variable enable_cords_to_foreground 0

    namespace export pdtk_canvas_popup
    namespace export pdtk_canvas_editmode
    namespace export pdtk_canvas_getscroll
    namespace export pdtk_canvas_setparents
    namespace export pdtk_canvas_reflecttitle
    namespace export pdtk_canvas_menuclose
}

# store the filename associated with this window,
# so we can use it during menuclose
array set ::pdtk_canvas::::window_fullname {}

array set ::pdtk_canvas::geometry_needs_init {}

# One thing that is tricky to understand is the difference between a Tk
# 'canvas' and a 'canvas' in terms of Pd's implementation.  They are similar,
# but not the same thing.  In Pd code, a 'canvas' is basically a patch, while
# the Tk 'canvas' is the backdrop for drawing everything that is in a patch.
# The Tk 'canvas' is contained in a 'toplevel' window. That window has a Tk
# class of 'PatchWindow'.

# TODO figure out weird frameless window when you open a graph


#TODO: http://wiki.tcl.tk/11502
# MS Windows
#wm geometry . returns contentswidthxcontentsheight+decorationTop+decorationLeftEdge.
#and
#winfo rooty . returns contentsTop
#winfo rootx . returns contentsLeftEdge

if {[tk windowingsystem] eq "win32" || \
    $::tcl_version < 8.5 || \
        ($::tcl_version == 8.5 && \
             [tk windowingsystem] eq "aqua" && \
             [lindex [split [info patchlevel] "."] 2] < 13) } {
    # fit the geometry onto screen for Tk 8.4 or win32,
    # also check for Tk Cocoa backend on macOS which is only stable in 8.5.13+;
    # newer versions of Tk can handle multiple monitors so allow negative pos
    proc pdtk_canvas_wrap_window {x y w h} {
        foreach {width height} [wm maxsize .] break

        # get virtual root coordinates for minimum position
        set xmin [winfo vrootx .]
        set ymin [winfo vrooty .]

        # clip window size to screen size
        set w [expr {min($w, $width)}]
        set h [expr {min($h, $height - $::menubarsize)}]

        # get max position
        set xmax [expr {$xmin + $width - $w}]
        set ymax [expr {$ymin + $height - $h}]

        # clip given position
        set x [expr {max(min($x, $xmax), $xmin)}]
        set y [expr {max(min($y, $ymax), $ymin + $::menubarsize)}]

        return [list $x $y $w $h]
    }
} {
    proc pdtk_canvas_wrap_window {x y w h} {
        return [list ${x} ${y} ${w} ${h}]
    }
}

# this proc is split out on its own to make it easy to override. This makes it
# easy for people to customize these calculations based on their Window
# Manager, desires, etc.
proc pdtk_canvas_place_window {width height geometry} {
    # read back the current geometry +posx+posy into variables
    set w $width
    set h $height
    set xypos ""
    if { "" != ${geometry} } {
        scan $geometry {%[+]%d%[+]%d} - x - y
        foreach {x y w h} [pdtk_canvas_wrap_window $x $y $width $height] {break}
        set xypos +${x}+${y}
    }
    return [list ${w} ${h} ${w}x${h}${xypos}]
}


#------------------------------------------------------------------------------#
# canvas new/saveas

proc pdtk_canvas_new {mytoplevel width height geometry editable} {
    if { "" eq $geometry } {
        # no position set: this is a new window (rather than one loaded from file)
        # we set a flag here, so we can query (and report) the actual geometry,
        # once the window is fully created
        set ::pdtk_canvas::geometry_needs_init($mytoplevel) 1
    }

    foreach {width height geometry} [pdtk_canvas_place_window $width $height $geometry] {break;}
    set ::undo_actions($mytoplevel) no
    set ::redo_actions($mytoplevel) no

    # release the window grab here so that the new window will
    # properly get the Map and FocusIn events when its created
    ::pdwindow::busyrelease
    # set the loaded array for this new window so things can track state
    set ::loaded($mytoplevel) 0
    toplevel $mytoplevel -width $width -height $height -class PatchWindow
    wm group $mytoplevel .
    $mytoplevel configure -menu $::patch_menubar

    # we have to wait until $mytoplevel exists before we can generate
    # a <<Loading>> event for it, that's why this is here and not in the
    # started_loading_file proc.  Perhaps this doesn't make sense tho
    event generate $mytoplevel <<Loading>>

    if { "" != ${geometry} } {
        wm geometry $mytoplevel $geometry
    }
    wm minsize $mytoplevel $::canvas_minwidth $::canvas_minheight

    set tkcanvas [tkcanvas_name $mytoplevel]
    canvas $tkcanvas -width $width -height $height \
        -highlightthickness 0 -scrollregion [list 0 0 $width $height] \
        -xscrollcommand "$mytoplevel.xscroll set" \
        -yscrollcommand "$mytoplevel.yscroll set" \
        -background white
    scrollbar $mytoplevel.xscroll -orient horizontal -command "$tkcanvas xview"
    scrollbar $mytoplevel.yscroll -orient vertical -command "$tkcanvas yview"
    pack $tkcanvas -side left -expand 1 -fill both

    # for some crazy reason, win32 mousewheel scrolling is in units of
    # 120, and this forces Tk to interpret 120 to mean 1 scroll unit
    if {$::windowingsystem eq "win32"} {
        $tkcanvas configure -xscrollincrement 1 -yscrollincrement 1
    }

    ::pd_bindings::patch_bindings $mytoplevel

    # give focus to the canvas so it gets the events rather than the window
    focus $tkcanvas

    # let the scrollbar logic determine if it should make things scrollable
    set ::xscrollable($tkcanvas) 0
    set ::yscrollable($tkcanvas) 0

    # init patch properties arrays
    set ::editingtext($mytoplevel) 0
    set ::childwindows($mytoplevel) {}

    # this should be at the end so that the window and canvas are all ready
    # before this variable changes.
    set ::editmode($mytoplevel) $editable
}

# if the patch canvas window already exists, then make it come to the front
proc pdtk_canvas_raise {mytoplevel} {
    wm deiconify $mytoplevel
    raise $mytoplevel
    set mycanvas $mytoplevel.c
    focus $mycanvas
}

proc pdtk_canvas_saveas {mytoplevel initialfile initialdir destroyflag} {
    if { ! [file isdirectory $initialdir]} {set initialdir $::filenewdir}
    set filename [tk_getSaveFile -initialdir $initialdir \
                      -initialfile [::pdtk_canvas::cleanname "$initialfile"] \
                      -defaultextension .pd -filetypes $::filetypes \
                      -parent $mytoplevel]
    if {$filename eq ""} return; # they clicked cancel

    set extension [file extension $filename]
    set oldfilename $filename
    set filename [regsub -- "$extension$" $filename [string tolower $extension]]
    if { ! [regexp -- "\.(pd|pat|mxt)$" $filename]} {
        # we need the file extension even on Mac OS X
        set filename $filename.pd
    }
    # test again after downcasing and maybe adding a ".pd" on the end
    if {$filename ne $oldfilename && [file exists $filename]} {
        set answer [tk_messageBox -type okcancel -icon question -default cancel\
                        -message [_ "\"$filename\" already exists. Do you want to replace it?"]]
        if {$answer eq "cancel"} return; # they clicked cancel
    }
    set dirname [file dirname $filename]
    set basename [file tail $filename]
    pdsend "$mytoplevel savetofile [enquote_path $basename] [enquote_path \
         $dirname] $destroyflag"
    set ::filenewdir $dirname
    # add to recentfiles
    ::pd_guiprefs::update_recentfiles $filename
}

##### ask user Save? Discard? Cancel?, and if so, send a message on to Pd ######
proc ::pdtk_canvas::pdtk_canvas_menuclose {mytoplevel reply_to_pd} {
    raise $mytoplevel
    set filename [lindex [array get ::pdtk_canvas::::window_fullname $mytoplevel] 1]
    set message [_ "Do you want to save the changes you made in '%s'?" $filename]
    set answer [tk_messageBox -message $message -type yesnocancel -default "yes" \
                    -parent $mytoplevel -icon question]
    switch -- $answer {
        yes {pdsend "$mytoplevel menusave 1"}
        no {pdsend $reply_to_pd}
        cancel {}
    }
}

#------------------------------------------------------------------------------#
# mouse usage

# TODO put these procs into the pdtk_canvas namespace
proc pdtk_canvas_motion {tkcanvas x y mods} {
    set mytoplevel [winfo toplevel $tkcanvas]
    pdsend "$mytoplevel motion [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $mods"
}

proc pdtk_canvas_mouse {tkcanvas x y b f} {
    set mytoplevel [winfo toplevel $tkcanvas]
    pdsend "$mytoplevel mouse [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b $f"
}

proc pdtk_canvas_mouseup {tkcanvas x y b {f 0}} {
    set mytoplevel [winfo toplevel $tkcanvas]
    pdsend "$mytoplevel mouseup [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b $f"
}

proc pdtk_canvas_rightclick {tkcanvas x y b} {
    set mytoplevel [winfo toplevel $tkcanvas]
    pdsend "$mytoplevel mouse [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b 8"
}

# on X11, button 2 pastes from X11 clipboard, so simulate normal paste actions
proc pdtk_canvas_clickpaste {tkcanvas x y b} {
    pdtk_canvas_mouse $tkcanvas $x $y $b 0
    pdtk_canvas_mouseup $tkcanvas $x $y $b 0
    if { [catch {set pdtk_pastebuffer [selection get]}] } {
        # no selection... do nothing
    } else {
        for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} {
            set cha [string index $pdtk_pastebuffer $i]
            scan $cha %c keynum
            pdsend "[winfo toplevel $tkcanvas] key 1 $keynum 0"
        }
    }
}

#------------------------------------------------------------------------------#
# canvas popup menu

# since there is one popup that is used for all canvas windows, the menu
# -commands use {} quotes so that $::focused_window is interpreted when the
# menu item is called, not when the command is mapped to the menu item.  This
# is the same as the menubar in pd_menus.tcl but the opposite of the 'bind'
# commands in pd_bindings.tcl
proc ::pdtk_canvas::create_popup {popupid actionwindow x y} {
    if { ! [winfo exists $popupid]} {
        # the popup menu for the canvas
        menu $popupid -tearoff false

        $popupid add command -label [_ "Properties"] \
            -command "::pdtk_canvas::done_popup $actionwindow 0 $x $y"
        $popupid add command -label [_ "Open"] \
            -command "::pdtk_canvas::done_popup $actionwindow 1 $x $y"
        $popupid add command -label [_ "Help"]       \
            -command "::pdtk_canvas::done_popup $actionwindow 2 $x $y"
    }
}

proc ::pdtk_canvas::done_popup {mytoplevel action x y} {
    pdsend "$mytoplevel done-popup $action $x $y"
}

proc ::pdtk_canvas::pdtk_canvas_popup {mytoplevel xcanvas ycanvas hasproperties hasopen} {
    set toplevel [winfo toplevel $mytoplevel]
    set tkcanvas [tkcanvas_name $toplevel]
    set popup ${toplevel}.popup
    destroy $popup
    ::pdtk_canvas::create_popup ${popup} ${toplevel} ${xcanvas} ${ycanvas}
    if {$hasproperties} {
        ${popup} entryconfigure [_ "Properties"] -state normal
    } else {
        ${popup} entryconfigure [_ "Properties"] -state disabled
    }
    if {$hasopen} {
        ${popup} entryconfigure [_ "Open"] -state normal
    } else {
        ${popup} entryconfigure [_ "Open"] -state disabled
    }
    set scrollregion [$tkcanvas cget -scrollregion]
    # get the canvas location that is currently the top left corner in the window
    set left_xview_pix [expr [lindex [$tkcanvas xview] 0] * [lindex $scrollregion 2]]
    set top_yview_pix [expr [lindex [$tkcanvas yview] 0] * [lindex $scrollregion 3]]
    # take the mouse clicks in canvas coords, add the root of the canvas
    # window, and subtract the area that is obscured by scrolling
    set xpopup [expr int($xcanvas + [winfo rootx $tkcanvas] - $left_xview_pix)]
    set ypopup [expr int($ycanvas + [winfo rooty $tkcanvas] - $top_yview_pix)]
    tk_popup ${popup} ${xpopup} ${ypopup} 0
}

if {[tk windowingsystem] eq "aqua" } {
    # I don't know how to move the mouse on OSX, so skip it
    proc ::pdtk_canvas::setmouse {tkcanvas x y} { }
} else {
    proc ::pdtk_canvas::setmouse {tkcanvas x y} {
        # set the mouse to the given position
        # (same coordinate system as reported by pdtk_canvas_motion)
        event generate $tkcanvas <Motion> -warp 1 -x $x -y $y
    }
}

#------------------------------------------------------------------------------#
# procs for when file loading starts/finishes

proc ::pdtk_canvas::started_loading_file {patchname} {
    ::pdwindow::busygrab
}

# things to run when a patch is finished loading.  This is called when
# the OS sends the "Map" event for this window.
proc ::pdtk_canvas::finished_loading_file {mytoplevel} {
    # ::pdwindow::busyrelease is in pdtk_canvas_new so that the grab
    # is released before the new toplevel window gets created.
    # Otherwise the grab blocks the new window from getting the
    # FocusIn event on creation.

    # set editmode to make sure the menu item is in the right state
    pdtk_canvas_editmode $mytoplevel $::editmode($mytoplevel)
    set ::loaded($mytoplevel) 1
    # send the virtual events now that everything is loaded
    event generate $mytoplevel <<Loaded>>

    # if the window was created without a position (that is: a new window),
    # we have the opportunity to query the actual position now
    if { "" ne [array names ::pdtk_canvas::geometry_needs_init $mytoplevel ] } {
        array unset ::pdtk_canvas::geometry_needs_init $mytoplevel
        scan [wm geometry $mytoplevel] {%dx%d%[+]%d%[+]%d} width height - x - y
        # on X11, 'wm geometry' won't report a useful position until the window was moved
        # but 'winfo geometry' does (though slightly off, but we ignore this offset
        # for newly created, never moved windows)
        # other windowingsystems will already report a useful position, and luckily
        # they report the same for 'wm geometry' and 'winfo geometry'
        if { "+$x+$y" eq "+0+0" } {
            scan [winfo geometry $mytoplevel] {%dx%d%[+]%d%[+]%d} width height - x - y
            pdsend "$mytoplevel setbounds $x $y [expr $x + $width] [expr $y + $height]"
        }
    }
}

#------------------------------------------------------------------------------#
# procs for canvas events

# check or uncheck the "edit" menu item
proc ::pdtk_canvas::pdtk_canvas_editmode {mytoplevel state} {
    set ::editmode_button $state
    set ::editmode($mytoplevel) $state
    event generate $mytoplevel <<EditMode>>
}

# message from Pd to update the currently available undo/redo action
proc pdtk_undomenu {mytoplevel undoaction redoaction} {
    set ::undo_actions($mytoplevel) $undoaction
    set ::redo_actions($mytoplevel) $redoaction
    if {$mytoplevel ne "nobody"} {
        ::pd_menus::update_undo_on_menu $mytoplevel $undoaction $redoaction
    }
}

# This proc configures the scrollbars whenever anything relevant has
# been updated.  It should always receive a tkcanvas, which is then
# used to generate the mytoplevel, needed to address the scrollbars.
proc ::pdtk_canvas::pdtk_canvas_getscroll {tkcanvas} {
    # delay until we are ready
    after idle [list ::pdtk_canvas::do_getscroll $tkcanvas]
}
proc ::pdtk_canvas::do_getscroll {tkcanvas} {
    if {! [winfo exists $tkcanvas]} {
        return
    }
    set mytoplevel [winfo toplevel $tkcanvas]
    set height [winfo height $tkcanvas]
    set width [winfo width $tkcanvas]

    set bbox [$tkcanvas bbox all]
    if {$bbox eq "" || [llength $bbox] != 4} {return}
    set xupperleft [lindex $bbox 0]
    set yupperleft [lindex $bbox 1]
    if {$xupperleft > 0} {set xupperleft 0}
    if {$yupperleft > 0} {set yupperleft 0}
    set xlowerright [lindex $bbox 2]
    set ylowerright [lindex $bbox 3]
    if {$xlowerright < $width} {set xlowerright $width}
    if {$ylowerright < $height} {set ylowerright $height}
    set scrollregion [concat $xupperleft $yupperleft $xlowerright $ylowerright]
    $tkcanvas configure -scrollregion $scrollregion
    # X scrollbar
    if {[lindex [$tkcanvas xview] 0] == 0.0 && [lindex [$tkcanvas xview] 1] == 1.0} {
        set ::xscrollable($tkcanvas) 0
        pack forget $mytoplevel.xscroll
    } else {
        set ::xscrollable($tkcanvas) 1
        pack $mytoplevel.xscroll -side bottom -fill x -before $tkcanvas
    }
    # Y scrollbar, it gets touchy at the limit, so say > 0.995
    if {[lindex [$tkcanvas yview] 0] == 0.0 && [lindex [$tkcanvas yview] 1] > 0.995} {
        set ::yscrollable($tkcanvas) 0
        pack forget $mytoplevel.yscroll
    } else {
        set ::yscrollable($tkcanvas) 1
        pack $mytoplevel.yscroll -side right -fill y -before $tkcanvas
    }
}

proc ::pdtk_canvas::scroll {tkcanvas axis amount} {
    if {$axis eq "x" && $::xscrollable($tkcanvas) == 1} {
        $tkcanvas xview scroll [expr {- ($amount)}] units
    }
    if {$axis eq "y" && $::yscrollable($tkcanvas) == 1} {
        $tkcanvas yview scroll [expr {- ($amount)}] units
    }
}

#------------------------------------------------------------------------------#
# get patch window child/parent relationships

# add a child window ID to the list of children, if it isn't already there
proc ::pdtk_canvas::addchild {mytoplevel child} {
    # if either ::childwindows($mytoplevel) does not exist, or $child does not
    # exist inside of the ::childwindows($mytoplevel list
    if { [lsearch -exact [array names ::childwindows $mytoplevel]] == -1 \
             || [lsearch -exact $::childwindows($mytoplevel) $child] == -1} {
        set ::childwindows($mytoplevel) [lappend ::childwindows($mytoplevel) $child]
    }
}

# receive a list of all my parent windows from 'pd'
proc ::pdtk_canvas::pdtk_canvas_setparents {mytoplevel args} {
    # check if the user passed a list (instead of multiple arguments)
    if { [llength $args] == 1 } {set args [lindex $args 0]}
    set parents {}
    foreach parent $args {
        if { [catch {set parent [winfo toplevel $parent]}] } {
            if { [file extension $parent] eq ".c" } {set parent [file rootname $parent]}
        }
        lappend parents $parent
        addchild $parent $mytoplevel
    }
    set ::parentwindows($mytoplevel) $parents
}

# receive information for setting the info in the title bar of the window
proc ::pdtk_canvas::pdtk_canvas_reflecttitle {mytoplevel \
                                              path name arguments dirty} {
    set path [::pdtk_text::unescape $path]
    set name [::pdtk_text::unescape $name]
    set arguments [::pdtk_text::unescape $arguments]
    set name [::pdtk_canvas::cleanname "$name"]
    set ::windowname($mytoplevel) $name
    set ::pdtk_canvas::::window_fullname($mytoplevel) "$path/$name"
    if {$::windowingsystem eq "aqua"} {
        wm attributes $mytoplevel -modified $dirty
        if {[file exists "$path/$name"]} {
            # for some reason -titlepath can still fail so just catch it
            if [catch {wm attributes $mytoplevel -titlepath "$path/$name"}] {
                wm title $mytoplevel "$path/$name"
            }
        }
        wm title $mytoplevel "$name$arguments"
    } else {
        if {$dirty} {set dirtychar "*"} else {set dirtychar " "}
        wm title $mytoplevel "$name$dirtychar$arguments - $path"
    }
}

#------------------------------------------------------------------------------#
# utils

# provide a clean filename to avoid saving files with the untitled name prefix
proc ::pdtk_canvas::cleanname {name} {
    variable untitled_name
    variable untitled_len
    if {[string compare -length $untitled_len "$name" "$untitled_name"] == 0} {
        # replace untitled prefix with a display name
        # TODO localize "Untitled" & make sure translations do not contain spaces
        return [string replace "$name" 0 [expr $untitled_len - 1] "Untitled"]
    }
    return $name
}

proc ::pdtk_canvas::cords_to_foreground {mytoplevel {state 1}} {
    if {$::pdtk_canvas::enable_cords_to_foreground} {
        set col black
        if { $state == 0 } {
            set col lightgrey
        }
        foreach id [$mytoplevel find withtag {cord && !selected}] {
            # don't apply backgrouding on selected (blue) lines
            if { [lindex [$mytoplevel itemconfigure $id -fill] 4 ] ne "blue" } {
                $mytoplevel itemconfigure $id -fill $col
            }
        }
    }
}