# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application textblock 999999.0a1.0
# Meta platform     tcl
# Meta license      <unspecified>
# @@ Meta End



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Requirements
##e.g package require frobz
#package require punk
package require punk::args
package require punk::char
package require punk::lib
package require patternpunk
package require overtype
package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional?
package require textutil


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#
#Note: A textblock does not necessarily have lines the same length - either in number of characters or print-width
#
namespace eval textblock {
    namespace export block width
    namespace eval cd {
        #todo - save and restore existing namespace export in case macros::cd has default exports in future
        namespace eval ::term::ansi::code::macros::cd {namespace export *}
        namespace import ::term::ansi::code::macros::cd::*
        namespace eval ::term::ansi::code::macros::cd {namespace export -clear}
    }

    #return a homogenous block of characters - ie lines all same length, all same character
    #printing-width in terminal columns is not necessarily same as blockwidth even if a single char is passed (could be full-width unicode character)
    proc block {blockwidth blockheight {char " "}} {
        if {$blockwidth < 0} {
            error "textblock::block blockwidth  must be an integer greater than or equal to zero"
        }
        if {$blockheight <= 0} {
            error "textblock::block blockheight must be a positive integer"
        }
        if {$char eq ""} {return ""}
        if {[string length $char] == 1} {
            set row [string repeat $char $blockwidth]
            set mtrx [lrepeat $blockheight $row]
            return [::join $mtrx \n]
        } else {
            set charblock [string map [list \r\n \n] $char] 
            if {[string first \n $charblock] >= 0} {
                if {$blockwidth > 1} {
                    set row [.= val $charblock {*}[lrepeat [expr {$blockwidth -1}] |> piper_blockjoin $charblock]]
                } else {
                    set row $charblock
                }
            } else {
                set row [string repeat $char $blockwidth]
            }
            set mtrx [lrepeat $blockheight $row]
            return [::join $mtrx \n]
        }
    }

    proc width {textblock} {
        if {$textblock eq ""} {
            return 0
        }
        set textblock [textutil::tabify::untabify2 $textblock]
        if {[string first \n $textblock] >= 0} {
            return [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width [stripansi $v]}]]
        }
        return [punk::char::string_width [stripansi $textblock]] 
    } 
    proc height {textblock} {
        #empty string still has height 1 (at least for left-right/right-left languages) 
        set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list
        return [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le
    }
    #MAINTENANCE - same as overtype::blocksize?
    proc size {textblock} {
        if {$textblock eq ""} {
            return [dict create width 0 height 1] ;#no such thing as zero-height block - for consistency with non-empty strings having no line-endings
        }
        set textblock [textutil::tabify::untabify2 $textblock]
        #stripansi on entire block in one go rather than line by line - result should be the same - review - make tests
        set textblock [punk::ansi::stripansi $textblock]
        if {[string first \n $textblock] >= 0} {
            set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width $v}]]
        } else {
            set width [punk::char::string_width $textblock] 
        }
        set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list
        #our concept of block-height is likely to be different to other line-counting mechanisms
        set height [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le

        return [dict create width $width height $height] ;#maintain order in 'image processing' standard width then height - caller may use lassign [dict values [blocksize <data>]] width height
    }
    #must be able to handle block as string with or without newlines
    #if no newlines - attempt to treat as a list
    #must handle whitespace-only string,list elements, and/or lines.
    #reviewing 2024 - this seems like too much magic!
    proc width1 {block} {
        if {$block eq ""} {
            return 0
        }
        set block [textutil::tabify::untabify2 $block]
        if {[string first \n $block] >= 0} {
            return [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $block] {::punk::char::string_width [stripansi $v]}]]
        }
        if {[catch {llength $block}]} {
            return [::punk::char::string_width [stripansi $block]]
        }
        if {[llength $block] == 0} {
            #could be just a whitespace string
            return [string length $block]
        }
        return [tcl::mathfunc::max {*}[lmap v $block {::punk::char::string_width [stripansi $v]}]]
    }
    pipealias ::textblock::padleft .= {list $input [string repeat " " $indent]} |/0,padding/1> punk:lib::lines_as_list -- |> .= {lmap v $data {overtype::right $padding $v}} |> punk::lib::list_as_lines -- <input/0,indent/1|
    pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- <input/0,colsize/1|
    proc ::textblock::pad {block args} {
        set defaults [dict set\
            -padchar " "\
            -which  "right"\
            -width  ""\
            -overflow 0\
        ]
        set usage "pad ?-padchar <character>? ?-which right|left|centre? -width <int>"
        foreach {k v} $args {
            if {$k ni [dict keys $defaults]} {
                error "textblock::pad unrecognised option '$k'. Usage: $usage"
            }
        }
        set opts [dict merge $defaults $args]
        # -- --- --- --- --- --- --- --- --- ---
        set padchar         [dict get $opts -padchar]
        # -- --- --- --- --- --- --- --- --- ---
        set known_whiches [list l left r right c center centre]
        set which           [string tolower [dict get $opts -which]]
        if {$which in [list centre center]}     {set which "c"}
        if {$which in [list left]}              {set which "l"}
        if {$which in [list right]}             {set which "r"}
        if {$which ni $known_whiches} {
            error "textblock::pad unrecognised value for -which option. Known values $known_whiches"
        }
        # -- --- --- --- --- --- --- --- --- ---
        set width           [dict get $opts -width]
        # -- --- --- --- --- --- --- --- --- ---

        if {$width = ""} {

        }


    }


    pipealias ::textblock::join_width .= {list $lhs [string repeat " " $w1] $rhs [string repeat " " $w2]} {|
                /2,col1/1,col2/3
                >} punk::lib::lines_as_list -- {|
                data2
                >} .=lhs> punk::lib::lines_as_list -- {|
                >} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
                >} punk::lib::list_as_lines -- <lhs/0,w1/1,rhs/2,w2/3|
                

    pipealias ::textblock::joinpair .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
                /2,col1/1,col2/3
                >} .=> punk::lib::lines_as_list -- {|
                data2
                >} .=lhs> punk::lib::lines_as_list -- {|
                >} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
                >} punk::lib::list_as_lines -- <lhs/0,rhs/1|            

    proc ::textblock::join {args} {
        lassign [punk::args::opts_values {
            blocks -type string -multiple 1
        } $args] _o opts _v values
        set blocks [dict get $values blocks]

        set idx 0
        set fordata [list]
        foreach b $blocks {
            set c($idx) [string repeat " " [width $b]]
            lappend fordata "v($idx)" [punk::lib::lines_as_list -- $b] 
            incr idx
        }
        set outlines [list]
        foreach {*}$fordata {
            set row ""
            foreach colidx [lsort -integer -increasing [array names c]] {
                append row [overtype::left $c($colidx) $v($colidx)]
            }
            lappend outlines $row
        }
        return [punk::lib::list_as_lines -- $outlines]
    }

    proc ::textblock::trim {block} {
        set trimlines []
    }

    pipealias ::textblock::join_right .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
                /2,col1/1,col2/3
                >} .=> punk::lib::lines_as_list -- {|
                data2
                >} .=lhs> punk::lib::lines_as_list -- {|
                >} .= {lmap v $data w $data2 {val "[overtype::right $col1 $v][overtype::right $col2 $w]"}} {|
                >} punk::lib::list_as_lines <lhs/0,rhs/1|            

    proc example {{text "test\netc\nmore text"}} {
        package require patternpunk
        .= textblock::join [punk::lib::list_as_lines -- [list 1 2 3 4 5 6 7]] [>punk . lhs] |> .=>1 textblock::join " " |> .=>1 textblock::join $text |>  .=>1 textblock::join [>punk . rhs]  |> .=>1 textblock::join [punk::lib::list_as_lines -- [lrepeat 7 " | "]]
    }
    proc example2 {{text "test\netc\nmore text"}} {
        package require patternpunk
        .= textblock::join\
             [punk::lib::list_as_lines -- [list 1 2 3 4 5 6 7 8]]\
             [>punk . lhs]\
             " "\
             $text\
             [>punk . rhs]\
             [punk::lib::list_as_lines -- [lrepeat 8 " | "]]
    }

    proc frame {args} {
        package require punk::char

        set contents [lindex $args end]
        set arglist [lrange $args 0 end-1]
        if {[llength $arglist] % 2 != 0} {
            error "Usage frame ?-ansi 0|1? <contents>"
        }
        #todo args -justify left|centre|right (center)

        set defaults [dict create\
            -ansi 0\
        ]
        set opts [dict merge $defaults $arglist]
        # -- --- --- --- --- --- 
        set ansi        [dict get $opts -ansi]
        # -- --- --- --- --- --- 

        set contents [textutil::tabify::untabify2 $contents]
        set contents [string map [list \r\n \n] $contents]
        if {[string first \n $contents] >= 0} {
            set width [width $contents]
        } else {
            set width [width [list $contents]]
        }
        set lines [split $contents \n]

        if {$ansi} {
            #old style ansi escape sequences with alternate graphics page G0
            append fs [cd::tlc][string repeat [cd::hl] $width][cd::trc]\n
            foreach l $lines {
                append fs [cd::vl]${l}[string repeat " " [expr {$width-[::punk::char::string_width [stripansi $l]]}]][cd::vl]\n
            }
            append fs [cd::blc][string repeat [cd::hl] $width][cd::brc]
            return [cd::groptim $fs]
        } else {
            #unicode box drawing set
            set hz [punk::char::charshort boxd_lhz] ;# light horizontal
            append fs [punk::char::charshort boxd_ldr][string repeat $hz $width][punk::char::charshort boxd_ldl]\n
            set vl [punk::char::charshort boxd_lv] ;#light vertical
            foreach l $lines {
                append fs $vl${l}[string repeat " " [expr {$width-[::punk::char::string_width [stripansi $l]]}]]$vl\n
            }
            append fs [punk::char::charshort boxd_lur][string repeat $hz $width][punk::char::charshort boxd_lul]
            return $fs
        }

    }
    proc gcross {{size 1} args} {
        if {$size == 0} {
            return ""
        }

        set defaults [list\
            -max_cross_size 0
        ]
        set opts [dict merge $defaults $args]
        set opt_max_cross_size [dict get $opts -max_cross_size]

        #set fit_size [punk::lib::greatestOddFactor $size]
        set fit_size $size 
        if {$opt_max_cross_size == 0} {
            set max_cross_size $fit_size 
        } else {
            #todo - only allow divisors
            #set testsize [expr {min($fit_size,$opt_max_cross_size)}]

            set factors [punk::lib::factors $size]
            #pick odd size in list that is smaller or equal to test_size
            set max_cross_size [lindex $factors end]
            set last_ok [lindex $factors 0]
            for {set i 0} {$i < [llength $factors]} {incr i} {
                set s [lindex $factors $i]
                if {$s > $opt_max_cross_size} {
                    break
                }
                set last_ok $s
            }
            set max_cross_size $last_ok
        }
        set crosscount [expr {$size / $max_cross_size}]

        package require punk::char
        set x [punk::char::charshort boxd_ldc]
        set bs [punk::char::charshort boxd_ldgullr]
        set fs [punk::char::charshort boxd_ldgurll]

        set onecross ""
        set crossrows [list]
        set armsize [expr {int(floor($max_cross_size /2))}]
        set row [lrepeat $max_cross_size " "]    
        #toparm
        for {set i 0} {$i < $armsize} {incr i} {
            set r $row
            lset r $i $bs
            lset r end-$i $fs
            #append onecross [::join $r ""] \n
            lappend crossrows [::join $r ""]
        }

        if {$max_cross_size % 2 != 0} {
            #only put centre cross in for odd sized crosses
            set r $row
            lset r $armsize $x
            #append onecross [::join $r ""] \n
            lappend crossrows [::join $r ""]
        }

        for {set i [expr {$armsize -1}]} {$i >= 0} {incr i -1} {
            set r $row
            lset r $i $fs
            lset r end-$i $bs
            #append onecross [::join $r ""] \n
            lappend crossrows [::join $r ""]
        }
        #set onecross [string trimright $onecross \n]
        set onecross [::join $crossrows \n]

        #fastest to do row first then columns - because textblock::join must do line by line

        if {$crosscount > 1} {
            package require textblock
            set row [textblock::join {*}[lrepeat $crosscount $onecross]]
            set rows [lrepeat $crosscount $row]
            set out [::join $rows \n]
        } else {
            set out $onecross
        }

        return $out
    }

    #Test we can join two coloured blocks 
    proc test_colour {} {
        set b1 [a= red]1\n2\n3[a=]
        set b2 [a= green]a\nb\nc[a=]
        set result [textblock::join $b1 $b2]
        puts $result
        return [list $b1 $b2 $result]
    }
    namespace import ::punk::ansi::stripansi
}


namespace eval ::textblock::piper {
    namespace export *
    proc join {rhs pipelinedata} {
        tailcall ::textblock::join $pipelinedata $rhs
    }
}
interp alias {} piper_blockjoin {} ::textblock::piper::join



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Ready   
package provide textblock [namespace eval textblock {
    variable version
    set version 999999.0a1.0 
}]
return