# Module:         poImgPages
# Copyright:      Paul Obermeier 2015-2025 / paul@poSoft.de
# First Version:  2021 / 09 / 02
#
# Distributed under BSD license.
#
# Module for handling sub images, aka images with pages.

namespace eval poImgPages {
    variable ns [namespace current]
    variable sPageCache

    namespace ensemble create

    namespace export GetNumPages
    namespace export ClearCache
    namespace export Clear
    namespace export Create
    namespace export Update

    proc _CheckIndex { fileName fmt ind } {
        set retVal [catch {image create photo -file $fileName -format "$fmt -index $ind"} phImg]
        if { $retVal == 0 } {
            image delete $phImg
            return true
        }
        return false
    }

    proc _GetNumImgs { fileName fmt inc } {
        if { [_CheckIndex $fileName $fmt 1] } {
            set ind $inc
            while { [_CheckIndex $fileName $fmt $ind] } {
                incr ind $inc
            }
            incr ind -1
            while { ! [_CheckIndex $fileName $fmt $ind] } {
                incr ind -1
            }
            return [expr { $ind + 1 }]
        }
        return 1
    }

    proc GetNumPages { fileName args } {
        variable sPageCache

        set opts [dict create \
            -password "" \
        ]

        foreach { key value } $args {
            if { [dict exists $opts $key] } {
                if { $value eq "" } {
                    error "GetNumPages: No value specified for key \"$key\""
                }
                dict set opts $key $value
            } else {
                error "GetNumPages: Unknown option \"$key\" specified"
            }
        }

        if { ! [file exists $fileName] } {
            return -1
        }

        set fileName [poMisc QuoteTilde $fileName]
        if { [info exists sPageCache($fileName)] } {
            return $sPageCache($fileName)
        }

        set typeDict [poType GetFileType $fileName]
        set numPages 0
        if { [dict exists $typeDict fmt] } {
            set fmt [string tolower [dict get $typeDict fmt]]
            switch -exact -- $fmt {
                "pdf" {
                    set numPages [poImgPdf GetNumPages $fileName -password \"[dict get $opts "-password"]\"]
                }
                "ps" {
                    set numPages [_GetNumImgs $fileName "ps" 10]
                }
                "graphic" {
                    if { [poImgMisc HaveImageMetadata] } {
                        set imgDict [image metadata -file $fileName]
                        if { [dict exists $imgDict numpages] } {
                            set numPages [dict get $imgDict numpages]
                        }
                    }
                    if { $numPages == 0 && [dict exists $typeDict subfmt] } {
                        set subfmt [string tolower [dict get $typeDict subfmt]]
                        switch -exact -- $subfmt {
                            "gif"  -
                            "ico"  -
                            "tiff" {
                                set numPages [_GetNumImgs $fileName $subfmt 5]
                            }
                            default {
                                set numPages 1
                            }
                        }
                    } else {
                        set numPages 1
                    }
                }
            }
        }
        set sPageCache($fileName) $numPages
        return $numPages
    }

    proc ClearCache {} {
        variable sPageCache

        catch { unset sPageCache }
    }

    proc _ShowPreview { tableId row } {
        variable sett

        set labelId $sett($tableId,preview)
        set fileName [$tableId rowattrib $row "FileName"]
        set sw [expr { [winfo width  $labelId] - 5 }]
        set sh [expr { [winfo height $labelId] - 5 }]
        if { [info exists sett($tableId,phImg)] } {
            catch { image delete $sett($tableId,phImg) }
        }
        set retVal [catch { poImgMisc LoadImgScaled $fileName $sw $sh -index $row } imgDict]
        if { $retVal == 0 } {
            set phImg [dict get $imgDict phImg]
            $labelId configure -image $phImg
            set sett($tableId,phImg) $phImg
        }
    }

    proc _ShowPreviewFromTable { tableId labelId } {
        variable sett

        set rowList [$tableId curselection]
        if { [llength $rowList] > 0 } {
            set row [lindex $rowList 0]
            _ShowPreview $tableId $row
        }
    }

    proc _TouchpadCB { tableId labelId delta count } {
        if { $count % 5 == 0 } {
            lassign [::tk::PreciseScrollDeltas $delta] deltaX deltaY
            set rowList [$tableId curselection]
            if { [llength $rowList] > 0 } {
                set row [lindex $rowList 0]
                if { $deltaX > 0 || $deltaY > 0 } {
                    incr row
                } elseif { $deltaX < 0 || $deltaY < 0 } {
                    incr row -1
                }
                if { $row < 0 } {
                    set row 0
                } elseif { $row >= [$tableId size] } {
                    set row [expr { [$tableId size] - 1 }]
                }
                $tableId selection clear 0 end
                $tableId selection set $row
                $tableId see $row
                _ShowPreview $tableId $row
            }
        }
        return -code break
    }

    proc Create { masterFr { title "Preview pages" } } {
        variable sett
        variable ns

        set tableFr   $masterFr.tableFr
        set previewFr $masterFr.previewFr
        frame $tableFr   -bg yellow
        frame $previewFr -bg green
        grid $tableFr   -row 0 -column 0 -sticky ns
        grid $previewFr -row 0 -column 1 -sticky news
        grid rowconfigure    $masterFr 0 -weight 1
        grid columnconfigure $masterFr 0 -weight 0
        grid columnconfigure $masterFr 1 -weight 1

        set tableId [poWin CreateScrolledTablelist $tableFr true "" \
                    -exportselection false \
                    -columns { 0 "#"      "left"
                               0 "Image"  "center"
                               0 "Width"  "right"
                               0 "Height" "right" } \
                    -width 40 -height 10 \
                    -selectmode browse \
                    -stripebackground [poAppearance GetStripeColor] \
                    -showseparators 1]

        ttk::label $previewFr.l
        pack $previewFr.l -expand true -fill both
        set sett($tableId,preview) $previewFr.l

        $tableId columnconfigure 0 -showlinenumbers true
        bind $tableId <<TablelistSelect>> "${ns}::_ShowPreviewFromTable $tableId $previewFr.l"
        set bodyTag [$tableId bodytag]
        bind $bodyTag <KeyRelease-Up>   "${ns}::_ShowPreviewFromTable $tableId $previewFr.l"
        bind $bodyTag <KeyRelease-Down> "${ns}::_ShowPreviewFromTable $tableId $previewFr.l"

        if {[llength [info commands ::tk::PreciseScrollDeltas]] != 0} {
            bind $previewFr.l <TouchpadScroll> "${ns}::_TouchpadCB $tableId %W %D %#"
        }
        return $tableId
    }

    proc Update { tableId fileName } {
        variable sett

        # Delete the content already stored in the tablelist and the preview label.
        Clear $tableId

        set phImgList [list]
        if { [namespace exists ::poImgBrowse] } {
            set thumbSize [poImgBrowse GetThumbSize]
        } else {
            set thumbSize 80
        }
        set numPages [poImgPages GetNumPages $fileName]

        for { set row 0 } { $row < $numPages } { incr row } {
            set retVal [catch { poImgMisc LoadImgScaled $fileName $thumbSize $thumbSize -index $row } imgDict]
            if { $retVal == 0 } {
                set phImg  [dict get $imgDict phImg]
                set width  [dict get $imgDict width]
                set height [dict get $imgDict height]
                $tableId insert end [list "" "" $width $height]
                $tableId cellconfigure $row,1 -image $phImg
                $tableId rowattrib $row "FileName" $fileName
                lappend phImgList $phImg
            }
        }
        set sett($tableId,phImgList) $phImgList

        $tableId selection set 0
        $tableId activate 0
        _ShowPreview $tableId 0
        focus $tableId
    }

    proc Clear { tableId } {
        variable sett

        catch { image delete $sett($tableId,phImg) }
        if { [info exists sett($tableId,phImgList)] } {
            foreach phImg $sett($tableId,phImgList) {
                catch { image delete $phImg }
            }
        }
    }
}
