From 7c6ca9b532c48409733e993e53256648dcc70da6 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Mon, 6 May 2024 19:11:38 +1000 Subject: [PATCH] textblock::class::table feature and ansi fixes --- src/bootsupport/include_modules.config | 2 + src/bootsupport/modules/oolib-0.1.1.tm | 200 ++ src/bootsupport/modules/punk/ansi-0.1.1.tm | 63 +- src/bootsupport/modules/punk/lib-0.1.1.tm | 17 +- src/bootsupport/modules/textblock-0.1.1.tm | 3076 +++++++++++++++++ .../man/files/punk/_module_lib-0.1.1.tm.n | 20 + .../md/doc/files/punk/_module_lib-0.1.1.tm.md | 122 +- .../doc/files/punk/_module_lib-0.1.1.tm.html | 108 +- src/modules/punk/ansi-999999.0a1.0.tm | 63 +- src/modules/punk/lib-999999.0a1.0.tm | 17 +- src/modules/textblock-999999.0a1.0.tm | 2096 +++++++++-- 11 files changed, 5315 insertions(+), 469 deletions(-) create mode 100644 src/bootsupport/modules/oolib-0.1.1.tm create mode 100644 src/bootsupport/modules/textblock-0.1.1.tm diff --git a/src/bootsupport/include_modules.config b/src/bootsupport/include_modules.config index 51b8bdd..ca03f8d 100644 --- a/src/bootsupport/include_modules.config +++ b/src/bootsupport/include_modules.config @@ -53,6 +53,8 @@ set bootsupport_modules [list\ modules punk::repo\ modules punk::tdl\ modules punk::winpath\ + modules textblock\ + modules oolib\ ] #each entry - base subpath diff --git a/src/bootsupport/modules/oolib-0.1.1.tm b/src/bootsupport/modules/oolib-0.1.1.tm new file mode 100644 index 0000000..ecf2cca --- /dev/null +++ b/src/bootsupport/modules/oolib-0.1.1.tm @@ -0,0 +1,200 @@ +#JMN - api should be kept in sync with package patternlib where possible +# +package provide oolib [namespace eval oolib { + variable version + set version 0.1.1 +}] + +namespace eval oolib { + oo::class create collection { + variable o_data ;#dict + variable o_alias + constructor {} { + set o_data [dict create] + } + method info {} { + return [dict info $o_data] + } + method count {} { + return [dict size $o_data] + } + method isEmpty {} { + expr {[dict size $o_data] == 0} + } + method names {{globOrIdx {}}} { + if {[llength $globOrIdx]} { + if {[string is integer -strict $globOrIdx]} { + set idx $globOrIdx + if {$idx < 0} { + set idx "end-[expr {abs($idx + 1)}]" + } + if {[catch {lindex [dict keys $o_data] $idx} result]} { + error "[self object] no such index : '$idx'" + } else { + return $result + } + } else { + #glob + return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx] + } + } else { + return [dict keys $o_data] + } + } + #like names but without globbing + method keys {} { + dict keys $o_data + } + method key {{posn 0}} { + if {$posn < 0} { + set posn "end-[expr {abs($posn + 1)}]" + } + if {[catch {lindex [dict keys $o_data] $posn} result]} { + error "[self object] no such index : '$posn'" + } else { + return $result + } + } + method hasKey {key} { + dict exists $o_data $key + } + method get {} { + return $o_data + } + method items {} { + return [dict values $o_data] + } + method item {key} { + if {[string is integer -strict $key]} { + if {$key >= 0} { + set valposn [expr {(2*$key) +1}] + return [lindex $o_data $valposn] + } else { + set key "end-[expr {abs($key + 1)}]" + return [lindex $o_data $key] + #return [lindex [dict keys $o_data] $key] + } + } + if {[dict exists $o_data $key]} { + return [dict get $o_data $key] + } + } + #inverse lookup + method itemKeys {value} { + set value_indices [lsearch -all [dict values $o_data] $value] + set keylist [list] + foreach i $value_indices { + set idx [expr {(($i + 1) *2) -2}] + lappend keylist [lindex $o_data $idx] + } + return $keylist + } + method search {value args} { + set matches [lsearch {*}$args [dict values $o_data] $value] + if {"-inline" in $args} { + return $matches + } else { + set keylist [list] + foreach i $matches { + set idx [expr {(($i + 1) *2) -2}] + lappend keylist [lindex $o_data $idx] + } + return $keylist + } + } + #review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists? + method alias {newAlias existingKeyOrAlias} { + if {[string is integer -strict $newAlias]} { + error "[self object] collection key alias cannot be integer" + } + if {[string length $existingKeyOrAlias]} { + set o_alias($newAlias) $existingKeyOrAlias + } else { + unset o_alias($newAlias) + } + } + method aliases {{key ""}} { + if {[string length $key]} { + set result [list] + foreach {n v} [array get o_alias] { + if {$v eq $key} { + lappend result $n $v + } + } + return $result + } else { + return [array get o_alias] + } + } + #if the supplied index is an alias, return the underlying key; else return the index supplied. + method realKey {idx} { + if {[catch {set o_alias($idx)} key]} { + return $idx + } else { + return $key + } + } + method add {value key} { + if {[string is integer -strict $key]} { + error "[self object] collection key must not be an integer. Use another structure if integer keys required" + } + if {[dict exists $o_data $key]} { + error "[self object] col_processors object error: key '$key' already exists in collection" + } + dict set o_data $key $value + return [expr {[dict size $o_data] - 1}] ;#return index of item + } + method remove {idx {endRange ""}} { + if {[string length $endRange]} { + error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time" + } + if {[string is integer -strict $idx]} { + if {$idx < 0} { + set idx "end-[expr {abs($idx+1)}]" + } + set key [lindex [dict keys $o_data] $idx] + set posn $idx + } else { + set key $idx + set posn [lsearch -exact [dict keys $o_data] $key] + if {$posn < 0} { + error "[self object] no such index: '$idx' in this collection" + } + } + dict unset o_data $key + return + } + method clear {} { + set o_data [dict create] + return + } + method reverse_the_collection {} { + #named slightly obtusely because reversing the data when there may be references held is a potential source of bugs + #the name reverse_the_collection should make it clear that the object is being modified in place as opposed to simply 'reverse' which may imply a view/copy. + #todo - consider implementing a get_reverse which provides an interface to the same collection without affecting original references, yet both allowing delete/edit operations. + set dictnew [dict create] + foreach k [lreverse [dict keys $o_data]] { + dict set dictnew $k [dict get $o_data $k] + } + set o_data $dictnew + return + } + #review - cmd as list vs cmd as script? + method map {cmd} { + set seed [list] + dict for {k v} $o_data { + lappend seed [uplevel #0 [list {*}$cmd $v]] + } + return $seed + } + method objectmap {cmd} { + set seed [list] + dict for {k v} $o_data { + lappend seed [uplevel #0 [list $v {*}$cmd]] + } + return $seed + } + } + +} + diff --git a/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/bootsupport/modules/punk/ansi-0.1.1.tm index 23d2939..c5f6f21 100644 --- a/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -1748,6 +1748,7 @@ namespace eval punk::ansi { dict set codestate_empty bg "" ;#40-47 + 100-107 + #misnomer should have been sgr_merge_args ? :/ #as a common case optimisation - it will not merge a single element list, even if that code contains redundant elements proc sgr_merge_list {args} { if {[llength $args] == 0} { @@ -1755,9 +1756,30 @@ namespace eval punk::ansi { } elseif {[llength $args] == 1} { return [lindex $args 0] } + sgr_merge $args + } + #codes *must* already have been split so that one esc per element in codelist + #e.g codelist [a+ Yellow Red underline] [a+ blue] [a+ red] is ok + #but codelist "[a+ Yellow Red underline][a+ blue]" [a+ red] is not + #(use punk::ansi::ta::split_codes_single) + proc sgr_merge {codelist args} { variable codestate_empty set othercodes [list] + set defaults [dict create\ + -filter_fg 0\ + -filter_bg 0\ + ] + dict for {k v} $args { + switch -- $k { + -filter_fg - -filter_bg {} + default { + error "sgr_merge unknown option '$k'. Known options [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + set codestate $codestate_empty set codestate_initial $codestate_empty ;#keep a copy for resets. set did_reset 0 @@ -1772,7 +1794,7 @@ namespace eval punk::ansi { #We still output any non SGR codes in the list as they came in - preserving their CSI - foreach c $args { + foreach c $codelist { #normalize 8bit to a token of the same length so our string operations on the code are the same and we can maintain a switch statement with literals rather than escapes #.. but preserve original c #set cnorm [string map [list \x9b {8[} ] $c] @@ -1911,7 +1933,7 @@ namespace eval punk::ansi { dict set codestate hide 28 ;#reveal } 29 { - dict set codestate strik 29;#off + dict set codestate strike 29;#off } 30 - 31 - 32 - 33 - 34 - 35 - 36 - 37 { dict set codestate fg $p ;#foreground colour @@ -2067,13 +2089,38 @@ namespace eval punk::ansi { } set codemerge "" - dict for {k v} $codestate { - switch -- $v { - "" { + if {[dict get $opts -filter_fg] || [dict get $opts -filter_bg]} { + dict for {k v} $codestate { + switch -- $v { + "" { + } + default { + switch -- $k { + bg { + if {![dict get $opts -filter_bg]} { + append codemerge "${v}\;" + } + } + fg { + if {![dict get $opts -filter_fg]} { + append codemerge "${v}\;" + } + } + default { + append codemerge "${v}\;" + } + } + } } - default { - append codemerge "${v}\;" + } + } else { + dict for {k v} $codestate { + switch -- $v { + "" {} + default { + append codemerge "${v}\;" + } } } } @@ -3963,7 +4010,7 @@ namespace eval punk::ansi::ansistring { #return empty string for each index that is out of range #review - this is possibly too slow to be very useful as is. # consider converting to oo and maintaining state of ansisplits so we don't repeat relatively expensive operations for same string - #see also punk::list_index_resolve / punk::list_index_get for ways to handle tcl list/string indices without parsing them. + #see also punk::lindex_resolve / punk::lindex_get for ways to handle tcl list/string indices without parsing them. proc INDEXABSOLUTE {string args} { set payload_len -1 ;# -1 as token to indicate we haven't calculated it yet (only want to call it once at most) set testindices [list] diff --git a/src/bootsupport/modules/punk/lib-0.1.1.tm b/src/bootsupport/modules/punk/lib-0.1.1.tm index c8c594e..5b33a9a 100644 --- a/src/bootsupport/modules/punk/lib-0.1.1.tm +++ b/src/bootsupport/modules/punk/lib-0.1.1.tm @@ -211,7 +211,18 @@ namespace eval punk::lib { #} - proc list_index_resolve {list index} { + proc lindex_resolve {list index} { + #*** !doctools + #[call [fun lindex_resolve] [arg list] [arg index]] + #[para]Resolve an index which may be of the forms accepted by Tcl list commands such as end-2 or 2+2 to the actual integer index for the supplied list + #[para]Users may define procs which accept a list index and wish to accept the forms understood by Tcl. + #[para]This means the proc may be called with something like $x+2 end-$y etc + #[para]Sometimes the actual integer index is desired. + #[para]We want to resolve the index used, without passing arbitrary expressions into the 'expr' function - which could have security risks. + #[para]lindex_resolve will parse the index expression and return -1 if the supplied index expression is out of bounds for the supplied list. + #[para]Otherwise it will return an integer corresponding to the position in the list. + #[para]Like Tcl list commands - it will produce an error if the form of the + #Note that for an index such as $x+1 - we never see the '$x' as it is substituted in the calling command. We will get something like 10+1 - which we will resolve (hopefully safely) with expr if {![llength $list]} { return -1 @@ -271,7 +282,7 @@ namespace eval punk::lib { } } } - proc list_index_resolve2 {list index} { + proc lindex_resolve2 {list index} { set indices [list] ;#building this may be somewhat expensive in terms of storage and compute for large lists - we could use lseq in Tcl 8.7+ but that's likely unavailable here. for {set i 0} {$i < [llength $list]} {incr i} { lappend indices $i @@ -283,7 +294,7 @@ namespace eval punk::lib { return $idx } } - proc list_index_get {list index} { + proc lindex_get {list index} { set resultlist [lrange $list $index $index] if {![llength $resultlist]} { return -1 diff --git a/src/bootsupport/modules/textblock-0.1.1.tm b/src/bootsupport/modules/textblock-0.1.1.tm new file mode 100644 index 0000000..fc140fa --- /dev/null +++ b/src/bootsupport/modules/textblock-0.1.1.tm @@ -0,0 +1,3076 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -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 0.1.1 +# Meta platform tcl +# Meta license +# @@ Meta End + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +##e.g package require frobz +#package require punk +package require punk::args +package require punk::char +package require punk::ansi +package require punk::lib +catch {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 + +namespace eval textblock { + namespace eval class { + variable opts_table_defaults + set opts_table_defaults [dict create\ + -title ""\ + -frametype "light"\ + -frametype_header ""\ + -ansibase_header ""\ + -ansibase_body ""\ + -ansibase_footer ""\ + -ansiborder_header ""\ + -ansiborder_body ""\ + -ansiborder_footer ""\ + -ansireset "\uFFeF"\ + -framelimits_header "vll vlr hlb hlt tlc trc blc brc"\ + -frametype_body ""\ + -framelimits_body "vll vlr hlb hlt tlc trc blc brc"\ + -framemap_body [list\ + topleft {} topinner {} topright {} topsolo {}\ + middleleft {} middleinner {} middleright {} middlesolo {}\ + bottomleft {} bottominner {} bottomright {} bottomsolo {}\ + onlyleft {} onlyinner {} onlyright {} onlysolo {}\ + ]\ + -framemap_header [list headerleft {} headerinner {} headerright {} headersolo {}]\ + -show_edge 1\ + -show_separators 1\ + -show_header ""\ + -show_footer ""\ + ] + variable table_border_parts + #for 'L' shaped table building pattern + set table_border_parts [dict create\ + topleft [list hlt vll tlc blc]\ + topinner [list hlt tlc]\ + topright [list hlt tlc vlr trc brc]\ + topsolo [list hlt tlc trc blc brc vl]\ + middleleft [list vll blc]\ + midleinner [list]\ + middleright [list vlr brc]\ + middlesolo [list vl blc brc]\ + bottomleft [list vll blc hlb]\ + bottominner [list hlb blc]\ + bottomright [list hlb blc brc vlr]\ + bottomsolo [list hlb blc brc tlc trc vl]\ + onlyleft [list hlt hlb vll tlc blc]\ + onlyinner [list hlt hlb tlc blc]\ + onlyright [list hlt hlb tlc blc brc trc vlr]\ + onlysolo [list hlt hlb vll vlr blc brc trc brc]\ + ] + variable table_sep_parts + set table_sep_parts [dict create\ + topleft [list blc hlb]\ + topinner [list blc hlb]\ + topright [list blc hlb brc]\ + topsolo [list blc hlb brc]\ + middleleft [list blc hlb]\ + middleinner [list blc hlb]\ + middleright [list blc hlb brc]\ + middlesolo [list blc hlb brc]\ + bottomleft [list]\ + bottominner [list]\ + bottomright [list]\ + bottomsolo [list]\ + onlyleft [list]\ + onlyinner [list]\ + onlyright [list]\ + onlysolo [list]\ + ] + variable header_border_parts + set header_border_parts [dict create\ + headerleft [list vll tlc blc hlt]\ + headerinner [list tlc hlt]\ + headerright [list tlc hlt trc vlr brc]\ + headersolo [list tlc vlr blc hlt trc brc]\ + ] + + #e.g $t configure -framemap_body [table_border_map " "] + proc table_border_map {char} { + variable table_border_parts + set map [list] + dict for {celltype parts} $table_border_parts { + set tmap [list] + foreach p $parts { + dict set tmap $p $char + } + dict set map $celltype $tmap + } + return $map + } + proc table_sep_map {char} { + variable table_sep_parts + set map [list] + dict for {celltype parts} $table_sep_parts { + set tmap [list] + foreach p $parts { + dict set tmap $p $char + } + dict set map $celltype $tmap + } + return $map + } + proc header_border_map {char} { + variable header_border_parts + set map [list] + dict for {celltype parts} $header_border_parts { + set tmap [list] + foreach p $parts { + dict set tmap $p $char + } + dict set map $celltype $tmap + } + return $map + } + if {[info commands [namespace current]::table] eq ""} { + #*** !doctools + #[subsection {Namespace textblock::class}] + #[para] class definitions + #[list_begin itemized] [comment {- textblock::class groupings -}] + # [item] + # [para] [emph {handler_classes}] + # [list_begin enumerated] + + oo::class create [namespace current]::table { + #*** !doctools + #[enum] CLASS [class interface_caphandler.registry] + #[list_begin definitions] + # [para] [emph METHODS] + variable o_opts_table + variable o_columndefs + variable o_columndata + variable o_rowdefs + variable o_rowstates + + variable o_opts_table_defaults + variable o_opts_column_defaults + variable o_opts_row_defaults + constructor {args} { + #*** !doctools + #[call class::table [method constructor] [arg args]] + upvar ::textblock::class::opts_table_defaults tdefaults + set o_opts_table_defaults $tdefaults + if {[llength $args] == 1} { + set args [list -title [lindex $args 0]] + } + if {[llength $args] %2 !=0} { + error "[namespace current]::table constructor - unexpected argument count. Require single value being title, or name value pairs" + } + dict for {k v} $args { + if {$k ni [dict keys $o_opts_table_defaults]} { + error "[namespace current]::table unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + } + } + #set o_opts_table [dict merge $o_opts_table_defaults $args] + set o_opts_table $o_opts_table_defaults + my configure {*}[dict merge $o_opts_table_defaults $args] + set o_columndefs [dict create] + set o_columndata [dict create] ;#we store data by column even though it is often added row by row + set o_rowdefs [dict create] ;#user requested row data e.g -minheight -maxheight + set o_rowstates [dict create] ;#actual row data such as -minheight and -maxheight detected from supplied row data + + } + method Get_frametypes {} { + set requested_ft [dict get $o_opts_table -frametype] + set requested_ft_header [dict get $o_opts_table -frametype_header] + set requested_ft_body [dict get $o_opts_table -frametype_body] + set ft $requested_ft + set ft_header $requested_ft_header + set ft_body $requested_ft_body + switch -- $requested_ft { + light { + if {$requested_ft_header eq ""} { + set ft_header heavy + } + if {$requested_ft_body eq ""} { + set ft_body light + } + } + default { + if {$requested_ft_header eq ""} { + set ft_header $requested_ft + } + if {$requested_ft_body eq ""} { + set ft_body $requested_ft + } + } + } + return [dict create header $ft_header body $ft_body] + } + method configure args { + if {![llength $args]} { + return $o_opts_table + } + if {[llength $args] == 1 && [lindex $args 0] in [dict keys $o_opts_table_defaults]} { + #query single option + set k [lindex $args 0] + set val [dict get $o_opts_table $k] + set infodict [dict create] + switch -- $k { + -ansibase_header - -ansibase_body - -ansiborder_header - -ansiborder_body - -ansiborder_footer { + dict set infodict debug [ansistring VIEW $val] + } + } + return [dict create option $k value $val ansireset "\x1b\[m" info $infodict] + } + if {[llength $args] %2 != 0} { + error "[namespace current]::table configure - unexpected argument count. Require name value pairs" + } + dict for {k v} $args { + if {$k ni [dict keys $o_opts_table_defaults]} { + error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + } + } + set checked_opts [list] + dict for {k v} $args { + switch -- $k { + -ansireset { + if {$v eq "\uFFEF"} { + lappend checked_opts $k "\x1b\[m" ;# [a] + } else { + error "textblock::table::configure -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" + } + } + default { + lappend checked_opts $k $v + } + } + } + set o_opts_table [dict merge $o_opts_table $checked_opts] + } + + #integrate with struct::matrix - allows ::m format 2string $table + method printmatrix {matrix} { + set matrix_rowcount [$matrix rows] + set matrix_colcount [$matrix columns] + set table_colcount [my column_count] + if {$table_colcount == 0} { + for {set c 0} {$c < $matrix_colcount} {incr c} { + my add_column -header "" + } + } + set table_colcount [my column_count] + if {$table_colcount != $matrix_colcount} { + error "textblock::table::printmatrix column count of table doesn't match column count of matrix" + } + if {[my row_count] > 0} { + my row_clear + } + for {set r 0} {$r < $matrix_rowcount} {incr r} { + my add_row [$matrix get row $r] + } + my print + } + method as_matrix {{cmd ""}} { + if {$cmd eq ""} { + set m [struct::matrix] + } else { + set m [struct::matrix $cmd] + } + $m add columns [dict size $o_columndata] + $m add rows [dict size $o_rowdefs] + dict for {k v} $o_columndata { + $m set column $k $v + } + return $m + } + method add_column {args} { + #*** !doctools + #[call class::table [method add_column] [arg args]] + set defaults [dict create\ + -header ""\ + -footer ""\ + -ansibase ""\ + -ansireset "\uFFEF"\ + -minwidth ""\ + -maxwidth ""\ + ] + #initialise -ansireset with replacement char so we can keep in appropriate dict position for initial configure and then treat as read-only + set o_opts_column_defaults $defaults + if {[llength $args] %2 != 0} { + error "[namespace current]::table::add_column unexpected argument count. Require name value pairs. Known options: [dict keys $defaults]" + } + dict for {k v} $args { + if {$k ni [dict keys $defaults]} { + error "[namespace current]::table::add_column unknown option '$k'. Known options: [dict keys $defaults]" + } + } + set opts [dict merge $defaults $args] + set colcount [dict size $o_columndefs] + + dict set o_columndata $colcount [list] + dict set o_columndefs $colcount $defaults ;#ensure record exists + if {[catch { + my configure_column $colcount {*}$opts + } errMsg]} { + #configure failed - ensure o_columndata and o_columdefs entries are removed + dict unset o_columndata $colcount + dict unset o_columndefs $colcount + error "add_column failed to configure with supplied options $opts. Err:\n$errMsg" + } + return $colcount + } + method column_count {} { + return [dict size $o_columndefs] + } + method configure_column {index_expression args} { + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + error "textblock::table::configure_column - no column defined at index '$cidx'.Use add_column to define columns" + } + if {![llength $args]} { + return [dict get $o_columndefs $cidx] + } else { + if {[llength $args] %2 != 0} { + error "textblock::table configure_column unexpected argument count. Require name value pairs. Known options: [dict keys $o_opts_column_defaults]" + } + dict for {k v} $args { + if {$k ni [dict keys $o_opts_column_defaults]} { + error "[namespace current]::table configure_column unknown option '$k'. Known options: [dict keys $o_opts_column_defaults]" + } + } + set checked_opts [list] + dict for {k v} $args { + switch -- $k { + -header { + #todo - multiline header + if {[string is integer -strict $v]} { + #review - this is inconvenient + error "textblock::table::configure_column invalid value '$v' -header cannot be an integer" + } + lappend checked_opts $k $v + } + -ansibase { + set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" + set col_ansibase_items [list] ; + foreach {pt code} $parts { + if {$pt ne ""} { + #we don't expect plaintext in an ansibase + error "Unable to interpret -ansibase value as ansi SGR codes. Plaintext detected. Consider using for example: '\[punk::ansi::a+ green]' (or alias '\[a+ green]') to build ansi. debug view: [punk::ansi::ansistring VIEW $v]" + } + if {$code ne ""} { + lappend col_ansibase_items $code + } + } + set col_ansibase [punk::ansi::codetype::sgr_merge $col_ansibase_items] + lappend checked_opts $k $col_ansibase + } + -ansireset { + if {$v eq "\uFFEF"} { + lappend checked_opts $k "\x1b\[m" ;# [a] + } else { + error "textblock::table::configure_column -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" + } + } + default { + lappend checked_opts $k $v + } + } + } + + set current_opts [dict get $o_columndefs $cidx] + set opts [dict merge $current_opts $checked_opts] + dict set o_columndefs $cidx $opts + } + } + method add_row {valuelist args} { + #*** !doctools + #[call class::table [method add_row] [arg args]] + if {[dict size $o_columndefs] > 0 && ([llength $valuelist] != [dict size $o_columndefs])} { + error "invalid number of values in row - Must match existing column count: [dict size $o_columndefs]" + } + set defaults [dict create\ + -minheight 1\ + -maxheight ""\ + -ansibase ""\ + -ansireset "\uFFEF"\ + ] + set o_opts_row_defaults $defaults + + if {[llength $args] %2 !=0} { + error "[namespace current]::table::add_row unexpected argument count. Require name value pairs. Known options: [dict keys $defaults]" + } + dict for {k v} $args { + switch -- $k { + -minheight - -maxheight - -ansibase - -ansireset {} + default { + error "Invalid option '$k' Known options: [dict keys $defaults] (-ansireset is read-only)" + } + } + } + set opts [dict merge $defaults $args] + + set rowcount [dict size $o_rowdefs] + dict set o_rowdefs $rowcount $defaults ;# ensure record exists before configure + + if {[catch { + my configure_row $rowcount {*}$opts + } errMsg]} { + #undo anything we saved before configure_row + dict unset o_rowdefs $rowcount + error "add_row failed to configure with supplied options $opts. Err:\n$errMsg" + } + + if {[dict size $o_columndefs] == 0} { + #no columns defined - auto define with defaults for each column in first supplied row + foreach el $valuelist { + my add_column + } + } + + + set c 0 + set max_height_seen 1 + foreach v $valuelist { + dict lappend o_columndata $c $v + set valheight [textblock::height $v] + if {$valheight > $max_height_seen} { + set max_height_seen $valheight + } + incr c + } + set opt_maxh [dict get $o_rowdefs $rowcount -maxheight] + if {$opt_maxh ne ""} { + dict set o_rowstates $rowcount -maxheight [expr {min($opt_maxh,$max_height_seen)}] + } else { + dict set o_rowstates $rowcount -maxheight $max_height_seen + } + } + method configure_row {index_expression args} { + set ridx [lindex [dict keys $o_rowdefs] $index_expression] + if {$ridx eq ""} { + error "textblock::table::configure_row - no row defined at index '$ridx'.Use add_row to define rows" + } + if {![llength $args]} { + return [dict get $o_rowdefs $ridx] + } + if {[llength $args] %2 != 0} { + error "textblock::table configure_row incorrect number of options following index_expression. Require name value pairs. Known options: [dict keys $o_opts_row_defaults]" + } + dict for {k v} $args { + if {$k ni [dict keys $o_opts_row_defaults]} { + error "[namespace current]::table configure_row unknown option '$k'. Known options: [dict keys $o_opts_row_defaults]" + } + } + set checked_opts [list] + dict for {k v} $args { + switch -- $k { + -ansibase { + set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" + set row_ansibase_items [list] ; + foreach {pt code} $parts { + if {$pt ne ""} { + #we don't expect plaintext in an ansibase + error "Unable to interpret -ansibase value as ansi SGR codes. Plaintext detected. Consider using for example: '\[punk::ansi::a+ green]' (or alias '\[a+ green]') to build ansi. debug view: [punk::ansi::ansistring VIEW $v]" + } + if {$code ne ""} { + lappend row_ansibase_items $code + } + } + set row_ansibase [punk::ansi::codetype::sgr_merge $row_ansibase_items] + lappend checked_opts $k $row_ansibase + } + -ansireset { + if {$v eq "\uFFEF"} { + lappend checked_opts $k "\x1b\[m" ;# [a] + } else { + error "textblock::table::configure_row -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" + } + } + default { + lappend checked_opts $k $v + } + } + } + + set current_opts [dict get $o_rowdefs $ridx] + set opts [dict merge $current_opts $checked_opts] + + #check minheight and maxheight together + set opt_minh [dict get $opts -minheight] + set opt_maxh [dict get $opts -maxheight] + if {![string is integer $opt_minh] || ($opt_maxh ne "" && ![string is integer -strict $opt_maxh])} { + error "[namespace current]::table::add_row error -minheight '$opt_minh' and -maxheight '$opt_maxh' must be integers greater than or equal to 1" + } + if {$opt_minh < 1 || ($opt_maxh ne "" && $opt_maxh < 1)} { + error "[namespace current]::table::add_row error -minheight '$opt_minh' and -maxheight '$opt_maxh' must both be 1 or greater" + } + if {$opt_maxh ne "" && $opt_maxh < $opt_minh} { + error "[namespace current]::table::add_row error -maxheight '$opt_maxh' must greater than -minheight '$opt_minh'" + } + dict set o_rowstates $ridx -minheight $opt_minh + + + dict set o_rowdefs $ridx $opts + } + method row_count {} { + return [dict size $o_rowdefs] + } + method row_clear {} { + set o_rowdefs [dict create] + set o_rowstates [dict create] + #The data values are stored by column regardless of whether added row by row + dict for {cidx records} $o_columndata { + dict set o_columndata $cidx [list] + } + } + method clear {} { + my row_clear + set o_columndefs [dict create] + set o_columndata [dict create] + } + method Get_columns_by_name {namematch_list} { + + } + #specify range with x..y + method Get_columns_by_indices {index_list} { + foreach spec $index_list { + if {[string is integer -strict $c]} { + set colidx $c + } else { + dict for {colidx coldef} $o_columndefs { + #if {[string match x x]} {} + } + } + } + } + method get_column_by_index {index_expression args} { + #index_expression may be something like end-1 or 2+2 - we can't directly use it as a lookup for dicts. + set defaults [dict create\ + -positiontype "inner"\ + ] + set valid_positiontypes [list left inner right solo] + dict for {k v} $args { + if {$k ni [dict keys $defaults]} { + error "[namespace::current]::table::get_column_by_index error invalid option '$k'. Known options [dict keys $defaults]" + } + } + set opts [dict merge $defaults $args] + set opt_posn [dict get $opts -positiontype] + + if {$opt_posn ni $valid_positiontypes} { + error "[namespace::current]::table::get_column_by_index error invalid value '$opt_posn' for -positiontype. Valid values $valid_positiontypes" + } + + set columninfo [my get_column_cells_by_index $index_expression] + set header [dict get $columninfo header] + set cells [dict get $columninfo cells] + + set columninfo [my get_column_cells_by_index $index_expression] + set topt_show_header [dict get $o_opts_table -show_header] + if {$topt_show_header eq ""} { + set allheaders "" + set all_cols [dict keys $o_columndefs] + foreach c $all_cols { + append allheaders [dict get $o_columndefs $c -header] + } + if {$allheaders eq ""} { + set do_show_header 0 + } else { + set do_show_header 1 + } + } else { + set do_show_header $topt_show_header + } + set topt_show_footer [dict get $o_opts_table -show_footer] + + + set ftypes [my Get_frametypes] + set output "" + set boxlimits "" + set joins "" + set header_boxlimits [list] + set header_joins [list] + set ftype_body [dict get $ftypes body] + if {[llength $ftype_body] >= 2} { + set ftype_body "custom" + } + switch -- $opt_posn { + left { + set header_boxlimits {hl tlc blc vll} + set header_joins [list down-$ftype_body] + set boxlimits_build {hlb blc vll} + set boxlimits {} + foreach l $boxlimits_build { + if {$l in [dict get $o_opts_table -framelimits_body]} { + lappend boxlimits $l + } + } + set boxlimits_headerless {hlb hlt blc vll tlc} + set joins {down} + } + inner { + set header_boxlimits {hl tlc blc vll} + set header_joins [list left down-$ftype_body] + set boxlimits_build {hlb blc vll} + set boxlimits {} + foreach l $boxlimits_build { + if {$l in [dict get $o_opts_table -framelimits_body]} { + lappend boxlimits $l + } + } + set boxlimits_headerless {hlb hlt blc vll tlc} + set joins {down left} + } + right { + set header_boxlimits {hl tlc blc vl trc brc} + set header_joins [list left down-$ftype_body] + set boxlimits_build {hlb blc vll vlr brc} + set boxlimits {} + foreach l $boxlimits_build { + if {$l in [dict get $o_opts_table -framelimits_body]} { + lappend boxlimits $l + } + } + set boxlimits_headerless {hlb hlt blc vll vlr brc tlc trc} + set joins {down left} + } + solo { + set header_boxlimits {hl tlc blc vl trc brc} + set header_joins [list down-$ftype_body] + set boxlimits_build {hlb blc vll vlr brc} + set boxlimits {} + foreach l $boxlimits_build { + if {$l in [dict get $o_opts_table -framelimits_body]} { + lappend boxlimits $l + } + } + set boxlimits_headerless {hlb hlt blc vl brc tlc trc} + set joins {down} + } + } + upvar ::textblock::class::opts_table_defaults tdefaults + set defaultmap [dict get $tdefaults -framemap_body] + set default_hmap [dict get $tdefaults -framemap_header] + if {![dict get $o_opts_table -show_edge]} { + set fmap [dict merge $defaultmap [textblock::class::table_border_map ""]] + set hmap [dict merge $default_hmap [textblock::class::header_border_map ""]] + } else { + set fmap [dict merge $defaultmap [dict get $o_opts_table -framemap_body]] + set hmap [dict merge $default_hmap [dict get $o_opts_table -framemap_header]] + } + set sep_elements $::textblock::class::table_sep_parts + + switch -- $opt_posn { + left { + set topmap [dict get $fmap topleft] + set botmap [dict get $fmap bottomleft] + set midmap [dict get $fmap middleleft] + set onlymap [dict get $fmap onlyleft] + set hdrmap [dict get $hmap headerleft] + set topseps [dict get $sep_elements topleft] + set midseps [dict get $sep_elements middleleft] + } + inner { + set topmap [dict get $fmap topinner] + set botmap [dict get $fmap bottominner] + set midmap [dict get $fmap middleinner] + set onlymap [dict get $fmap onlyinner] + set hdrmap [dict get $hmap headerinner] + set topseps [dict get $sep_elements topinner] + set midseps [dict get $sep_elements middleinner] + } + right { + set topmap [dict get $fmap topright] + set botmap [dict get $fmap bottomright] + set midmap [dict get $fmap middleright] + set onlymap [dict get $fmap onlyright] + set hdrmap [dict get $hmap headerright] + set topseps [dict get $sep_elements topright] + set midseps [dict get $sep_elements middleright] + } + solo { + set topmap [dict get $fmap topsolo] + set botmap [dict get $fmap bottomsolo] + set midmap [dict get $fmap middlesolo] + set onlymap [dict get $fmap onlysolo] + set hdrmap [dict get $hmap headersolo] + set topseps [dict get $sep_elements topsolo] + set midseps [dict get $sep_elements middlesolo] + } + } + + if {$do_show_header} { + #puts "boxlimitsinfo header $opt_posn: -- boxlimits $header_boxlimits -- boxmap $hdrmap" + set ansibase_header [dict get $o_opts_table -ansibase_header] + set ansiborder_header [dict get $o_opts_table -ansiborder_header] + if {[dict get $o_opts_table -frametype_header] eq "block"} { + set extrabg [punk::ansi::codetype::sgr_merge [list $ansibase_header] -filter_fg 1] + set ansiborder_final $ansibase_header$ansiborder_header$extrabg + } else { + set ansiborder_final $ansibase_header$ansiborder_header + } + set cidx [lindex [dict keys $o_columndefs] $index_expression] + set RST [a] + set colwidth [my column_width $cidx] + set hcell_line_blank [string repeat " " $colwidth] + set hval $ansibase_header$header ;#no reset + set rowh 1 ;#todo + set h_lines [lrepeat $rowh $hcell_line_blank] + set hcell_blank [join $h_lines \n] + + set hval_lines [split $hval \n] + set hval_lines [lrange $hval_lines 0 $rowh-1] + set hval_block [join $hval_lines \n] + set headercell [overtype::left -experimental test_mode $ansibase_header$hcell_blank$RST $hval_block] + + set header_frame [textblock::frame -width [expr {$colwidth+2}] -type [dict get $ftypes header]\ + -ansibase $ansibase_header -ansiborder $ansiborder_final\ + -boxlimits $header_boxlimits -boxmap $hdrmap -joins $header_joins $hval\ + ] + + #puts ">> '[ansistring VIEW $hval]' -> $header_frame" + + append output $header_frame\n + } + set r 0 + set rmax [expr {[llength $cells]-1}] + + + set blims_mid $boxlimits + set blims_top $boxlimits + set blims_top_headerless $boxlimits_headerless + if {![dict get $o_opts_table -show_separators]} { + foreach el $midseps { + set elposn [lsearch $blims_mid $el] + if {$elposn >= 0} { + set blims_mid [lremove $blims_mid $elposn] + } + } + foreach el $topseps { + set elposn [lsearch $blims_top $el] + if {$elposn >= 0} { + set blims_top [lremove $blims_top $elposn] + } + set elposn [lsearch $blims_top_headerless $el] + if {$elposn >= 0} { + set blims_top_headerless [lremove $blims_top_headerless $elposn] + } + } + } + + set colidx [lindex [dict keys $o_columndefs] $index_expression] ;#convert possible end-1,2+2 etc expression to >= 0 integer in dict range + + set opt_col_ansibase [dict get $o_columndefs $colidx -ansibase] ;#ordinary merge of codes already done in configure_column + + set body_ansibase [dict get $o_opts_table -ansibase_body] + set ansibase $body_ansibase$opt_col_ansibase ;#allow col to override body + set body_ansiborder [dict get $o_opts_table -ansiborder_body] + if {[dict get $o_opts_table -frametype] eq "block"} { + #block is the only style where bg colour can fill the frame content area exactly if the L-shaped border elements are styled + #we need to only accept background ansi codes from the columndef ansibase for this + set col_bg [punk::ansi::codetype::sgr_merge [list $opt_col_ansibase] -filter_fg 1] ;#special merge for block borders - don't override fg colours + set border_ansi $body_ansibase$body_ansiborder$col_bg + } else { + set border_ansi $body_ansibase$body_ansiborder + } + set r 0 + foreach c $cells { + #todo - joinleft,joinright,joindown based on opts in args + #append output [textblock::frame -boxlimits {vll blc hlb} $c]\n + if {[dict get $o_opts_table -frametype] eq "block"} { + set row_ansibase [dict get $o_rowdefs $r -ansibase] + set row_bg "" + if {$row_ansibase ne ""} { + set row_bg [punk::ansi::codetype::sgr_merge [list $row_ansibase] -filter_fg 1] + } + set border_ansi_final $border_ansi$row_bg + } else { + set border_ansi_final $border_ansi + } + + if {$r == 0} { + if {$r == $rmax} { + set joins [lremove $joins [lsearch $joins down*]] + set bmap $onlymap + if {$do_show_header} { + set blims $boxlimits + } else { + set blims $boxlimits_headerless + } + } else { + set bmap $topmap + if {$do_show_header} { + set blims $blims_top + } else { + set blims $blims_top_headerless + } + } + append output [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n + } else { + if {$r == $rmax} { + set joins [lremove $joins [lsearch $joins down*]] + set bmap $botmap + set blims $boxlimits + } else { + set bmap $midmap + set blims $blims_mid ;#will only be reduced from boxlimits if -show_separators was processed above + } + append output [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n + } + incr r + } + #return empty (zero content height) row if no rows + if {![llength $cells]} { + set joins [lremove $joins [lsearch $joins down*]] + #we need to know the width of the column to setup the empty cell properly + #(we didn't need it above because get_column_cells_by_index returned values of the correct width) + #even if no header displayed - we should take account of any defined column widths + set colwidth [my column_width $index_expression] + #note that if show_edge is 0 - then for this empty line - we will not see any vertical bars + #This is because the frame with no data is made entirely of corner elements + if {$do_show_header} { + append output [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $boxlimits -boxmap $onlymap -joins $joins]\n + } else { + append output [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $boxlimits_headerless -boxmap $onlymap -joins $joins] \n + } + } + return [string trimright $output \n] + } + + method get_column_cells_by_index {index_expression} { + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + set range "" + if {[dict size $o_columndefs] > 0} { + set range "0..[expr {[dict size $o_columndefs] -1}]" + } else { + set range empty + } + error "table::get_column_cells_by_index no such index $index_expression. Valid range is $range" + } + #assert cidx is integer >=0 + set cdef [dict get $o_columndefs $cidx] + set t [dict get $cdef -header] ;#may be empty string + set items [dict get $o_columndata $cidx] + + set ansibase_body [dict get $o_opts_table -ansibase_body] + set ansibase_col [dict get $cdef -ansibase] + set RST [punk::ansi::a] + + set colwidth [my column_width $cidx] + set ansibase_header [dict get $o_opts_table -ansibase_header] + set cell_line_blank [string repeat " " $colwidth] + set header_underlay $ansibase_header$cell_line_blank + set output [dict create] + if {$t ne ""} { + dict set output header [overtype::left -experimental test_mode $header_underlay $ansibase_header$t] + } else { + dict set output header $header_underlay + } + dict set output cells [list];#ensure we return something for cells key if no items in list + set r 0 + foreach cval $items { + set opt_row_ansibase [dict get $o_rowdefs $r -ansibase] + set cell_ansibase $ansibase_body$ansibase_col$opt_row_ansibase + + #todo move to row_height method + set maxdataheight [dict get $o_rowstates $r -maxheight] + set rowdefminh [dict get $o_rowdefs $r -minheight] + set rowdefmaxh [dict get $o_rowdefs $r -maxheight] + if {"$rowdefminh$rowdefmaxh" ne "" && $rowdefminh eq $rowdefmaxh} { + #an exact height is defined for the row + set rowh $rowdefminh + } else { + if {$rowdefminh eq ""} { + if {$rowdefmaxh eq ""} { + #both defs empty + set rowh $maxdataheight + } else { + set rowh [expr {min(1,$rowdefmaxh,$maxdataheight)}] + } + } else { + if {$rowdefmaxh eq ""} { + set rowh [expr {max($rowdefminh,$maxdataheight)}] + } else { + if {$maxdataheight < $rowdefminh} { + set rowh $rowdefminh + } else { + set rowh [expr {max($rowdefminh,$maxdataheight)}] + } + } + } + } + set cval $cell_ansibase$cval ;#no reset + set cell_lines [lrepeat $rowh $cell_line_blank] + set cell_blank [join $cell_lines \n] + set cval_lines [split $cval \n] + set cval_lines [lrange $cval_lines 0 $rowh-1] + set cval_block [join $cval_lines \n] + #TODO! fix overtype library + set cell [overtype::left -experimental test_mode $cell_ansibase$cell_blank$RST $cval_block] + dict lappend output cells $cell + + incr r + } + return $output + } + method get_column_values_by_index {index_expression} { + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + return + } + return [dict get $o_columndata $cidx] + } + method debug {} { + puts stdout "rowdefs: $o_rowdefs" + puts stdout "rowstates: $o_rowstates" + puts stdout "columndefs: $o_columndefs" + dict for {k coldef} $o_columndefs { + if {[dict exists $o_columndata $k]} { + set header [dict get $coldef -header] + set coldata [dict get $o_columndata $k] + set colinfo "rowcount: [llength $coldata]" + set widest [tcl::mathfunc::max {*}[lmap v [concat [list $header] $coldata] {textblock::width $v}]] + append colinfo " widest: $widest" + } else { + set colinfo "WARNING - no columndata record for column key '$k'" + } + puts stdout "column $k columndata info: $colinfo" + } + } + method column_width {index_expression} { + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + return + } + #assert cidx is now >=0 integer within the range of defined columns + set cdef [dict get $o_columndefs $cidx] + set defminw [dict get $cdef -minwidth] + set defmaxw [dict get $cdef -maxwidth] + if {"$defminw$defmaxw" ne "" && $defminw eq $defmaxw} { + #an exact width is defined for the column - no need to look at data width + set colwidth $defminw + } else { + set widest [my column_datawidth $cidx -header 1 -data 1 -footer 1] + #todo - predetermine if any items in column contain newlines and are truncated vertically due to o_rowdefs configuration. + #if so - a truncated line shouldn't be included in our width calculation + if {$defminw eq ""} { + if {$defmaxw eq ""} { + set colwidth $widest + } else { + set colwidth [expr {min(1,$defmaxw,$widest)}] + } + } else { + if {$defmaxw eq ""} { + set colwidth [expr {max($defminw,$widest)}] + } else { + if {$widest < $defminw} { + set colwidth $defminw + } else { + if {$widest > $defmaxw} { + set colwidth $defmaxw + } else { + set colwidth [expr {max($defminw,$widest)}] + } + } + } + } + } + return $colwidth + } + method column_datawidth {index_expression args} { + set defaults [dict create\ + -header 0\ + -footer 0\ + -data 1\ + ] + dict for {k v} $args { + switch -- $k { + -header - -footer - -data {} + default { + error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + return + } + #assert cidx is >=0 integer in valid range of keys for o_columndefs + set values [list] + if {[dict get $opts -header]} { + lappend values [dict get $o_columndefs $cidx -header] + } + if {[dict get $opts -data]} { + if {[dict exists $o_columndata $cidx]} { + lappend values {*}[dict get $o_columndata $cidx] + } + } + if {[dict get $opts -footer]} { + lappend values [dict get $o_columndefs $cidx -footer] + } + if {[llength $values]} { + set widest [tcl::mathfunc::max {*}[lmap v $values {textblock::width $v}]] + } else { + set widest 0 + } + return $widest + } + method print {args} { + if {![llength $args]} { + set cols [dict keys $o_columndata] + } else { + set cols [list] + foreach colspec $args { + set allcols [dict keys $o_columndata] + if {[string first .. $colspec] >=0} { + set parts [punk::ansi::ta::_perlish_split {\.\.} $colspec] + if {[llength $parts] != 3} { + error "[namespace::current]::table error invalid print specification '$colspec'" + } + lassign $parts from _dd to + if {$from eq ""} { + set from 0 + } + if {$to eq ""} { + set to end + } + set indices [lrange $allcols $from $to] + lappend cols {*}$indices + } else { + set c [lindex $allcols $colspec] + if {$c ne ""} { + lappend cols $c + } + } + } + } + set blocks [list] + set colposn 0 + set numposns [llength $cols] + foreach c $cols { + set flags [list] + if {$colposn == 0 && $colposn == $numposns-1} { + set flags [list -positiontype solo] + } elseif {$colposn == 0} { + set flags [list -positiontype left] + } elseif {$colposn == $numposns-1} { + set flags [list -positiontype right] + } else { + set flags [list -positiontype inner] + } + lappend blocks [my get_column_by_index $c {*}$flags] + incr colposn + } + if {[llength $blocks]} { + return [textblock::join {*}$blocks] + } else { + return "No columns matched" + } + } + + #*** !doctools + #[list_end] + } + #*** !doctools + # [list_end] [comment {- end enumeration provider_classes }] + #[list_end] [comment {- end itemized list textblock::class groupings -}] + } + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# +#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} + } + + proc list_as_table {datalist table_or_colcount args} { + set defaults [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_separators \uFFEF\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_separators - -frametype {} + default { + error "unrecognised option '$k'. Known options [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + + set count [llength $datalist] + + set is_new_table 0 + if {[string is integer -strict $table_or_colcount]} { + set cols $table_or_colcount + set is_new_table 1 + #defaults for new table only + if {[dict get $opts -frametype] eq "\uFFEF"} { + dict set opts -frametype "light" + } + if {[dict get $opts -show_edge] eq "\uFFEF"} { + dict set opts -show_edge 1 + } + if {[dict get $opts -show_separators] eq "\uFFEF"} { + dict set opts -show_separators 1 + } + set t [textblock::class::table new -show_header 0 -show_edge [dict get $opts -show_edge] -frametype [dict get $opts -frametype] -show_separators [dict get $opts -show_separators]] + for {set c 0} {$c < $cols} {incr c} { + $t add_column -header c$c + } + } else { + if {[namespace tail [info object class $table_or_colcount]] ne "table"} { + error "textblock::list_as_table error - table_or_colcount must be an integer or an existing table object" + } + set t $table_or_colcount + if {[dict get $opts -frametype] ne "\uFFEF"} { + $t configure -frametype [dict get $opts -frametype] + } + if {[dict get $opts -show_edge] ne "\uFFEF"} { + $t configure -show_edge [dict get $opts -show_edge] + } + $t row_clear + set cols [$t column_count] + } + set full_rows [expr {$count / $cols}] + set last_items [expr {$count % $cols}] + + + set rowdata [list] + set row [list] + set i 0 + if {$full_rows > 0} { + for {set r 0} {$r < $full_rows} {incr r} { + set j [expr {$i + ($cols -1)}] + set row [lrange $datalist $i $j] + incr i $cols + lappend rowdata $row + } + } + if {$last_items > 0} { + set idx [expr {$last_items -1}] + lappend rowdata [lrange $datalist end-$idx end] + } + foreach row $rowdata { + set shortfall [expr {$cols - [llength $row]}] + if {$shortfall > 0} { + set row [concat $row [lrepeat $shortfall ""]] + } + $t add_row $row + } + #puts stdout $rowdata + if {[dict get $opts -return] eq "string"} { + set result [$t print] + if {$is_new_table} { + $t destroy + } + return $result + } else { + return $t + } + } + #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) + #This can have ansi SGR codes - but to repeat blocks containing ansi-movements, the block should first be rendered to a static output with something like overtype::left + 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 ""} + #using string length is ok + 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 last \n $charblock] >= 0} { + if {$blockwidth > 1} { + #set row [.= val $charblock {*}[lrepeat [expr {$blockwidth -1}] |> piper_blockjoin $charblock]] ;#building a repeated "|> command arg" list to evaluate as a pipeline. (from before textblock::join could take arbitrary num of blocks ) + set row [textblock::join {*}[lrepeat $blockwidth $charblock]] + } else { + set row $charblock + } + } else { + set row [string repeat $char $blockwidth] + } + set mtrx [lrepeat $blockheight $row] + return [::join $mtrx \n] + } + } + proc testblock {size {colour ""}} { + if {$size <1 || $size > 15} { + error "textblock::testblock only sizes between 1 and 15 inclusive supported" + } + set rainbow_list [list] + lappend rainbow_list {30 47} ;#black White + lappend rainbow_list {31 46} ;#red Cyan + lappend rainbow_list {32 45} ;#green Purple + lappend rainbow_list {33 44} ;#yellow Blue + lappend rainbow_list {34 43} ;#blue Yellow + lappend rainbow_list {35 42} ;#purple Green + lappend rainbow_list {36 41} ;#cyan Red + lappend rainbow_list {37 40} ;#white Black + lappend rainbow_list {black Yellow} + lappend rainbow_list red + lappend rainbow_list green + lappend rainbow_list yellow + lappend rainbow_list blue + lappend rainbow_list purple + lappend rainbow_list cyan + lappend rainbow_list {white Red} + + + set chars [concat [punk::range 1 9] A B C D E F] + set charsubset [lrange $chars 0 $size-1] + set RST [a] + if {"rainbow" in $colour} { + #column first - colour change each column + set c [::join $charsubset \n] + + set clist [list] + for {set i 0} {$i <$size} {incr i} { + set colour2 [string map [list rainbow [lindex $rainbow_list $i]] $colour] + set ansi [a+ {*}$colour2] + + set ansicode [punk::ansi::codetype::sgr_merge_list "" $ansi] + lappend clist ${ansicode}$c$RST + } + return [textblock::join {*}$clist] + } else { + #row first - + set rows [list] + foreach ch $charsubset { + lappend rows [string repeat $ch $size] + } + set block [::join $rows \n] + if {$colour ne ""} { + set block [a+ {*}$colour]$block$RST + } + return $block + } + } + interp alias {} testblock {} textblock::testblock + + #todo - consider 'elastic tabstops' for textblocks where tab acts as a column separator and adjacent lines with the same number of tabs form a sort of table + proc width {textblock} { + #backspaces, vertical tabs ? + if {$textblock eq ""} { + return 0 + } + #textutil::tabify is a reasonable hack when there are no ansi SGR codes - but probably not always what we want even then - review + if {[string last \t $textblock] >= 0} { + if {[info exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + set textblock [textutil::tabify::untabify2 $textblock $tw] + } + if {[punk::ansi::ta::detect $textblock]} { + set textblock [punk::ansi::stripansi $textblock] + } + if {[string last \n $textblock] >= 0} { + return [tcl::mathfunc::max {*}[lmap v [split $textblock \n] {::punk::char::ansifreestring_width $v}]] + } + return [punk::char::ansifreestring_width $textblock] + } + #uses tcl's string length on each line. Length will include chars in ansi codes etc - this is not a 'width' determining function. + proc string_length_line_max textblock { + tcl::mathfunc::max {*}[lmap v [split $textblock \n] {string length $v}] + } + proc string_length_line_min textblock { + tcl::mathfunc::min {*}[lmap v [split $textblock \n] {string length $v}] + } + proc height {textblock} { + #This is the height as it will/would-be rendered - not the number of input lines purely in terms of le + #empty string still has height 1 (at least for left-right/right-left languages) + + #vertical tab on a proper terminal should move directly down. + #Whether or not the terminal in use actually does this - we need to calculate as if it does. (there might not even be a terminal) + + set num_le [expr {[string length $textblock]-[string length [string map [list \n {} \v {}] $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 + } + #strangely - string last (windows tcl8.7 anway) is faster than string first for large strings when the needle not in the haystack + if {[string last \t $textblock] >= 0} { + if {[info exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + set textblock [textutil::tabify::untabify2 $textblock $tw] + } + #stripansi on entire block in one go rather than line by line - result should be the same - review - make tests + if {[punk::ansi::ta::detect $textblock]} { + set textblock [punk::ansi::stripansi $textblock] + } + if {[string last \n $textblock] >= 0} { + #set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::ansifreestring_width $v}]] + set width [tcl::mathfunc::max {*}[lmap v [split $textblock \n] {::punk::char::ansifreestring_width $v}]] + } else { + set width [punk::char::ansifreestring_width $textblock] + } + set num_le [expr {[string length $textblock]-[string length [string map [list \n {} \v {}] $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 ]] 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 + } + if {[info exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + set block [textutil::tabify::untabify2 $block $tw] + if {[string last \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 -- punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- ? ?-which right|left|centre? -width " + 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 -- } .=> 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 -- } .=> 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 punk . rhs] + set pright [>punk . lhs] + set prightair [>punk . lhs_air] + set red [a+ red]; set redb [a+ red bold] + set green [a+ green]; set greenb [a+ green bold] + set cyan [a+ cyan];set cyanb [a+ cyan bold] + set blue [a+ blue];set blueb [a+ blue bold] + set RST [a] + set gr0 [punk::ansi::g0 abcdefghijklm\nnopqrstuvwxyz] + set punks [textblock::join $pleft $pright] + set pleft_greenb $greenb$pleft$RST + set pright_redb $redb$pright$RST + set prightair_cyanb $cyanb$prightair$RST + set cpunks [textblock::join $pleft_greenb $pright_redb] + set out "" + append out $punks \n + append out $cpunks \n + append out [textblock::join $punks $cpunks] \n + set 2frames_a [textblock::join [textblock::frame $cpunks] [textblock::frame $punks]] + append out $2frames_a \n + set 2frames_b [textblock::join [textblock::frame -ansiborder $cyanb -title "plainpunks" $punks] [textblock::frame -ansiborder $greenb -title "fancypunks" $cpunks]] + append out [textblock::frame -title "punks" $2frames_b\n$RST$2frames_a] \n + append out [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"] \n + #append out [textblock::frame -title gr $gr0] + return $out + } + + proc example3 {{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 table {args} { + upvar ::textblock::class::opts_table_defaults toptdefaults + set defaults [dict create\ + -rows [list]\ + -headers [list]\ + -return string\ + ] + + + set defaults [dict merge $defaults $toptdefaults] ;# -title -frametype -show_header etc + set opts [dict merge $defaults $args] + # -- --- --- --- + set opt_return [dict get $opts -return] + set opt_rows [dict get $opts -rows] + set opt_headers [dict get $opts -headers] + # -- --- --- --- + set topts [dict create] + set toptkeys [dict keys $toptdefaults] + dict for {k v} $opts { + if {$k in $toptkeys} { + dict set topts $k $v + } + } + set t [textblock::class::table new {*}$topts] + + foreach h $opt_headers { + $t add_column -header $h + } + if {[$t column_count] == 0} { + if {[llength $opt_rows]} { + set r0 [lindex $opt_rows 0] + foreach c $r0 { + $t add_column + } + } + } + foreach r $opt_rows { + $t add_row $r + } + + + + if {$opt_return eq "string"} { + set result [$t print] + $t destroy + return $result + } else { + return $t + } + } + + proc frame {args} { + + set expect_optval 0 + set argposn 0 + set pmax [expr {[llength $args]-1}] + set has_contents 0 ;#differentiate between empty string and no content supplied + set contents "" + set arglist [list] + foreach a $args { + if {!$expect_optval} { + if {$argposn < $pmax} { + if {[string match -* $a]} { + set expect_optval 1 + lappend arglist $a + } else { + error "textblock::frame expects -option pairs" + } + } else { + set has_contents 1 + set contents $a + } + } else { + lappend arglist $a + set expect_optval 0 + } + incr argposn + } + + #set contents [lindex $args end] + #set arglist [lrange $args 0 end-1] + if {[llength $arglist] % 2 != 0} { + error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " + } + #todo args -justify left|centre|right (center) + + set defaults [dict create\ + -etabs 0\ + -type light\ + -boxlimits [list hl vl tlc blc trc brc]\ + -boxmap {}\ + -joins [list]\ + -title ""\ + -subtitle ""\ + -width ""\ + -height ""\ + -ansiborder ""\ + -ansibase ""\ + -align "left"\ + -ellipsis 1\ + ] + set opts [dict merge $defaults $arglist] + foreach {k v} $opts { + switch -- $k { + -etabs - -type - -boxlimits - -boxmap - -joins - -title - -subtitle - -width - -height - -ansiborder - -ansibase - -align - -ellipsis {} + default { + error "frame option '$k' not understood. Valid options are [dict keys $defaults]" + } + } + } + # -- --- --- --- --- --- + set opt_etabs [dict get $opts -etabs] + set opt_type [dict get $opts -type] + set opt_boxlimits [dict get $opts -boxlimits] + set opt_joins [dict get $opts -joins] + set opt_boxmap [dict get $opts -boxmap] + set known_types [list light heavy arc double block block1 ascii altg] + set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "] + set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] + if {$opt_type ni $known_types} { + set is_custom_dict_ok 1 + if {[llength $opt_type] %2 == 0} { + #custom dict may leave out keys - but cannot have unknown keys + dict for {k v} $opt_type { + switch -- $k { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + default { + #k not in custom_keys + set is_custom_dict_ok 0 + break + } + } + } + } else { + set is_custom_dict_ok 0 + } + if {!$is_custom_dict_ok} { + error "frame option -type must be one of known types: $known_types or a dictionary with any of keys hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + set custom_frame [dict merge $default_custom $opt_type] + set frame_type custom + } else { + set frame_type $opt_type + } + set is_boxlimits_ok 1 + set exact_boxlimits [list] + foreach v $opt_boxlimits { + switch -- $v { + hl { + lappend exact_boxlimits hlt hlb + } + vl { + lappend exact_boxlimits vll vlr + } + hlt - hlb - vll - vlr - tlc - trc - blc - brc { + lappend exact_boxlimits $v + } + default { + #k not in custom_keys + set is_boxlimits_ok 0 + break + } + } + } + if {!$is_boxlimits_ok} { + error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + set exact_boxlimits [lsort -unique $exact_boxlimits] + + set is_joins_ok 1 + foreach v $opt_joins { + lassign [split $v -] direction target + switch -- $direction { + left - right - up - down {} + default { + set is_joins_ok 0 + break + } + } + switch -- $target { + "" - light - heavy - ascii - altg - arc - double - custom - block - block1 {} + default { + set is_joins_ok 0 + break + } + } + } + if {!$is_joins_ok} { + error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" + } + set is_boxmap_ok 1 + dict for {boxelement subst} $opt_boxmap { + switch -- $boxelement { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + default { + set is_boxmap_ok 0 + break + } + } + } + if {!$is_boxmap_ok} { + error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + #sorted order down left right up + #1 x choose 4 + #4 x choose 3 + #6 x choose 2 + #4 x choose 1 + #15 combos + set join_directions [list] + #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode + #e.g down-light, up-heavy + set join_targets [dict create left "" down "" right "" up ""] + foreach jt $opt_joins { + lassign [split $jt -] direction target + if {$target ne ""} { + dict set join_targets $direction $target + } + lappend join_directions $direction + } + set join_directions [lsort -unique $join_directions] + set do_joins [::join $join_directions _] + + + # -- --- --- --- --- --- + set opt_title [dict get $opts -title] + set opt_subtitle [dict get $opts -subtitle] + set opt_width [dict get $opts -width] + set opt_height [dict get $opts -height] + # -- --- --- --- --- --- + set opt_align [dict get $opts -align] + set opt_align [string tolower $opt_align] + switch -- $opt_align { + left - right - centre - center {} + default { + error "frame option -align must be left|right|centre|center - received: $$opt_align" + } + } + #these are all valid commands for overtype:: + # -- --- --- --- --- --- + set opt_ansiborder [dict get $opts -ansiborder] + set opt_ansibase [dict get $opts -ansibase] ;#experimental + set opt_ellipsis [dict get $opts -ellipsis] + # -- --- --- --- --- --- + + if {$has_contents} { + if {[string last \t $contents] >= 0} { + if {[info exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + if {$opt_etabs} { + set contents [textutil::tabify::untabify2 $contents $tw] + } + } + set contents [string map [list \r\n \n] $contents] + set actual_contentwidth [textblock::width $contents] + set actual_contentheight [textblock::height $contents] + } else { + set actual_contentwidth 0 + set actual_contentheight 0 + } + + if {$opt_title ne ""} { + set titlewidth [punk::ansi::printing_length $opt_title] + set content_or_title_width [expr {max($actual_contentwidth,$titlewidth)}] + } else { + set titlewith 0 + set content_or_title_width $actual_contentwidth + } + + if {$opt_width eq ""} { + set contentwidth $content_or_title_width + } else { + set contentwidth [expr {max(0,$opt_width - 2)}] ;#default + } + + if {$opt_height eq ""} { + set contentheight $actual_contentheight + } else { + set contentheight [expr {max(0,$opt_height -2)}] ;#default + } + if {$contentheight == 0} { + set has_contents 0 + } + + #todo - render it with vertical overflow so we can process ansi moves? + #set linecount [textblock::height $contents] + set linecount $contentheight + set rst [a] + #set column [string repeat " " $contentwidth] ;#default - may need to override for custom frame + set underlayline [string repeat " " $contentwidth] + set underlay [::join [lrepeat $linecount $underlayline] \n] + + set vll_width 1 ;#default for all except custom (printing width) + set vlr_width 1 + + #unicode box drawing only provides enough characters for seamless joining of unicode boxes light and heavy. + #e.g with characters such as \u2539 Box Drawings Right Light and Left Up Heavy. + #the double glyphs in box drawing can do a limited set of joins to light lines - but not enough for seamless table layouts. + #the arc set can't even join to itself e.g with curved equivalents of T-like shapes + #I guess + switch -- $frame_type { + "altg" { + #old style ansi escape sequences with alternate graphics page G0 + set hl [cd::hl] + set hlt $hl + set hlb $hl + set vl [cd::vl] + set vll $vl + set vlr $vl + set tlc [cd::tlc] + set trc [cd::trc] + set blc [cd::blc] + set brc [cd::brc] + #No join targets available to join altg to other box styles + switch -- $do_joins { + down { + #1 + set blc [punk::ansi::g0 t] ;#(ltj) + set brc [punk::ansi::g0 u] ;#(rtj) + } left { + #2 + set tlc [punk::ansi::g0 w] ;#(ttj) + set blc [punk::ansi::g0 v] ;#(btj) + } + right { + #3 + set trc [punk::ansi::g0 w] ;#(ttj) + set brc [punk::ansi::g0 v] ;#(btj) + } + up { + #4 + set tlc [punk::ansi::g0 t] ;#(ltj) + set trc [punk::ansi::g0 u] ;#(rtj) + } + down_left { + #5 + set blc [punk::ansi::g0 n] ;#(fwj) + set tlc [punk::ansi::g0 w] ;#(ttj) + set brc [punk::ansi::g0 u] ;#(rtj) + } + down_right { + #6 + set blc [punk::ansi::g0 t] ;#(ltj) + set trc [punk::ansi::g0 w] ;#(ttj) + set brc [punk::ansi::g0 n] ;#(fwj) + } + down_up { + #7 + set blc [punk::ansi::g0 t] ;#(ltj) + set brc [punk::ansi::g0 u] ;#(rtj) + + set tlc [punk::ansi::g0 t] ;#(ltj) + set trc [punk::ansi::g0 u] ;#(rtj) + } + left_right { + #8 + #from 2 + set tlc [punk::ansi::g0 w] ;#(ttj) + set blc [punk::ansi::g0 v] ;#(btj) + #from3 + set trc [punk::ansi::g0 w] ;#(ttj) + set brc [punk::ansi::g0 v] ;#(btj) + } + left_up { + #9 + set tlc [punk::ansi::g0 n] ;#(fwj) + set trc [punk::ansi::g0 u] ;#(rtj) + set blc [punk::ansi::g0 v] ;#(btj) + } + right_up { + #10 + set tlc [punk::ansi::g0 t] ;#(ltj) + set trc [punk::ansi::g0 n] ;#(fwj) + set brc [punk::ansi::g0 v] ;#(btj) + } + down_left_right { + #11 + set blc [punk::ansi::g0 n] ;#(fwj) + set brc [punk::ansi::g0 n] ;#(fwj) + set trc [punk::ansi::g0 w] ;#(ttj) + set tlc [punk::ansi::g0 w] ;#(ttj) + } + down_left_up { + #12 + set tlc [punk::ansi::g0 n] ;#(fwj) + set blc [punk::ansi::g0 n] ;#(fwj) + set trc [punk::ansi::g0 u] ;#(rtj) + set brc [punk::ansi::g0 u] ;#(rtj) + + } + down_right_up { + #13 + set tlc [punk::ansi::g0 t] ;#(ltj) + set blc [punk::ansi::g0 t] ;#(ltj) + set trc [punk::ansi::g0 n] ;#(fwj) + set brc [punk::ansi::g0 n] ;#(fwj) + } + left_right_up { + #14 + set tlc [punk::ansi::g0 n] ;#(fwj) + set trc [punk::ansi::g0 n] ;#(fwj) + set blc [punk::ansi::g0 v] ;#(btj) + set brc [punk::ansi::g0 v] ;#(btj) + + } + down_left_right_up { + #15 + set tlc [punk::ansi::g0 n] ;#(fwj) + set blc [punk::ansi::g0 n] ;#(fwj) + set trc [punk::ansi::g0 n] ;#(fwj) + set brc [punk::ansi::g0 n] ;#(fwj) + } + } + + + } + "ascii" { + set hl - + set hlt - + set hlb - + set vl | + set vll | + set vlr | + set tlc + + set trc + + set blc + + set brc + + } + "light" { + #unicode box drawing set + set hl [punk::char::charshort boxd_lhz] ;# light horizontal + set hlt $hl + set hlb $hl + set vl [punk::char::charshort boxd_lv] ;#light vertical + set vll $vl + set vlr $vl + set tlc [punk::char::charshort boxd_ldr] + set trc [punk::char::charshort boxd_ldl] + set blc [punk::char::charshort boxd_lur] + set brc [punk::char::charshort boxd_lul] + #15 combos + #sort order: down left right up + #ltj,rtj,ttj,btj e.g left T junction etc. + #Look at from the perspective of a frame/table outline with a clean border and arms pointing inwards + + #set targetdown,targetleft,targetright,targetup vars + #default empty targets to current box type 'light' + foreach dir {down left right up} { + set target [dict get $join_targets $dir] + switch -- $target { + "" - light { + set target$dir light + } + ascii - altg - arc { + set target$dir light + } + heavy { + set target$dir $target + } + default { + set target$dir other + } + } + } + switch -- $do_joins { + down { + #1 + switch -- $targetdown { + heavy { + set blc [punk::char::charshort boxd_dhrul] ;#\u251f down hieavy and right up light (ltj) + set brc \u2527 ;#boxd_dhlul down heavy and left up light (rtj) + } + light { + set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + } + } + } + left { + #2 + switch -- $targetleft { + heavy { + set tlc \u252d ;# Left Heavy and Right Down Light (ttj) + set blc \u2535 ;# Left Heavy and Right Up Light (btj) + } + light { + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - joinleft + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + } + } + right { + #3 + switch -- $targetright { + heavy { + set trc \u252e ;#Right Heavy and Left Down Light (ttj) + set brc \u2536 ;#Right Heavy and Left up Light (btj) + } + light { + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + } + } + up { + #4 + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + } + down_left { + #5 + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + } + down_right { + #6 + set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + } + down_up { + #7 + set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + } + left_right { + #8 + #from 2 + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - joinleft + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + #from3 + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + left_up { + #9 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + right_up { + #10 + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + down_left_right { + #11 + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + + } + down_left_up { + #12 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + + } + down_right_up { + #13 + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + } + left_right_up { + #14 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + + } + down_left_right_up { + #15 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + } + } + #four way junction (cd::fwj) (punk::ansi::g0 n) (punk::char::charshort lvhz) (+) + } + "heavy" { + #unicode box drawing set + set hl [punk::char::charshort boxd_hhz] ;# light horizontal + set hlt $hl + set hlb $hl + set vl [punk::char::charshort boxd_hv] ;#light vertical + set vll $vl + set vlr $vl + set tlc [punk::char::charshort boxd_hdr] + set trc [punk::char::charshort boxd_hdl] + set blc [punk::char::charshort boxd_hur] + set brc [punk::char::charshort boxd_hul] + #set targetdown,targetleft,targetright,targetup vars + #default empty targets to current box type 'heavy' + foreach dir {down left right up} { + set target [dict get $join_targets $dir] + switch -- $target { + "" - heavy { + set target$dir heavy + } + light - ascii - altg - arc { + set target$dir light + } + default { + set target$dir other + } + } + } + switch -- $do_joins { + down { + #1 + switch -- $targetdown { + light { + set blc [punk::char::charshort boxd_dlruh] ;#\u2521 down light and right up heavy (ltj) + set brc [punk::char::charshort boxd_dlluh] ;#\u2529 down light and left up heavy (rtj) + } + heavy { + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + } + } + } + left { + #2 + switch -- $targetleft { + light { + set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) + set blc [punk::char::charshort boxd_llruh] ;#\u253a Left Light and Right Up Heavy (btj) + } + heavy { + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + } + } + } + right { + #3 + switch -- $targetright { + light { + set trc [punk::char::charshort boxd_rlldh] ;#\u2531 Right Light and Left Down Heavy (ttj) + set brc [punk::char::charshort boxd_rlluh] ;#\u2539 Right Light and Left Up Heavy(btj) + } + heavy { + set trc [punk::char::charshort boxd_hdhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + } + } + } + up { + #4 + switch -- $targetup { + light { + set tlc [punk::char::charshort boxd_ulrdh] ;#\u2522 Up Light and Right Down Heavy (ltj) + set trc [punk::char::charshort boxd_ulldh] ;#\u252a Up Light and Left Down Heavy (rtj) + } + heavy { + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + } + } + } + down_left { + #down_left is the main join type used for 'L' shaped cell border table building where we boxlimit to {vll hlb blc} + #5 + switch -- down-$targetdown-left-$targetleft { + down-light-left-heavy { + set blc [punk::char::charshort boxd_dluhzh] ;#down light and up horizontal heavy (fwj) + set brc [punk::char::charshort boxd_dlluh] ;#\u2529 down light and left up heavy (rtj) + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) (at tlc down stays heavy) + } + down-heavy-left-light { + set blc [punk::char::charshort boxd_llrvh] ;# left light and right Vertical Heavy (fwj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) (at brc left must stay heavy) + set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) + } + down-light-left-light { + set blc [punk::char::charshort boxd_ruhldl] ;#\u2544 right up heavy and left down light (fwj) + set brc [punk::char::charshort boxd_dlluh] ;#\u2529 Down Light and left Up Heavy (rtj) (left must stay heavy) + set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) (we are in heavy - so down must stay heavy at tlc) + } + down-heavy-left-heavy { + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + } + down-other-left-heavy { + set blc \u253b ;#boxd_huhz Heavy Up and Horizontal (btj) + #leave brc default corner + set tlc \u2533 ;#hdhz Heavy Down and Horizontal (ttj) + + } + down-other-left-light { + set blc \u253a ;#llruh Left Light and Right Up Heavy (btj) + #leave brc default corner + set tlc \u2532 ;#llrdh Left Light and Right Down Heavy (ttj) + } + down-heavy-left-other { + set blc \u2523 ;#hvr Heavy Vertical and Right (ltj) + set brc \u252b ;#hvl Heavy Veritcal and Left (rtj) + #leave tlc default corner + } + down-light-left-other { + set blc \u2521 ;#dlruh Down Light and Right Up Heavy (ltj) + set brc \u2529 ;#dlluh Down Light and Left Up Heavy (rtj) + #leave tlc default corner + } + } + } + down_right { + #6 + set blc [punk::char::charshort boxd_hvr] ;# (ltj) (blc right&up stay heavy) + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) (tlc down&left stay heavy) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) (brc left&up heavy) + } + down_up { + #7 + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + } + left_right { + #8 + #from 2 + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + #from3 + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + } + left_up { + #9 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + } + right_up { + #10 + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + } + down_left_right { + #11 + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + + } + down_left_up { + #12 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + + } + down_right_up { + #13 + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + } + left_right_up { + #14 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + + } + down_left_right_up { + #15 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + } + } + } + "double" { + #unicode box drawing set + set hl [punk::char::charshort boxd_dhz] ;# double horizontal \U2550 + set hlt $hl + set hlb $hl + set vl [punk::char::charshort boxd_dv] ;#double vertical \U2551 + set vll $vl + set vlr $vl + set tlc [punk::char::charshort boxd_ddr] ;#double down and right \U2554 + set trc [punk::char::charshort boxd_ddl] ;#double down and left \U2557 + set blc [punk::char::charshort boxd_dur] ;#double up and right \U255A + set brc [punk::char::charshort boxd_dul] ;#double up and left \U255D + + # \u256c (fwj) + + #set targetdown,targetleft,targetright,targetup vars + #default empty targets to current box type 'double' + foreach dir {down left right up} { + set target [dict get $join_targets $dir] + switch -- $target { + "" - double { + set target$dir double + } + default { + set target$dir other + } + } + } + + #unicode provides no joining for double to anything else + #better to leave a gap by using default double corners if join target is not empty or double + switch -- $do_joins { + down { + #1 + switch -- $targetdown { + double { + set blc \u2560 ;# (ltj) + set brc \u2563 ;# (rtj) + } + } + } + left { + #2 + switch -- $targetleft { + double { + set tlc \u2566 ;# (ttj) + set blc \u2569 ;# (btj) + } + } + } + right { + #3 + switch -- $targetright { + double { + set trc \u2566 ;# (ttj) + set brc \u2569 ;# (btj) + } + } + } + up { + #4 + switch -- $targetup { + double { + set tlc \u2560 ;# (ltj) + set trc \u2563 ;# (rtj) + } + } + } + down_left { + #5 + switch -- $targetdown-$targetleft { + double-double { + set blc \u256c ;# (fwj) + set brc \u2563 ;# (rtj) + set tlc \u2566 ;# (ttj) + } + double-other { + set blc \u2560 ;# (ltj) + set brc \u2563 ;# (rtj) + #leave tlc as ordinary double corner + } + other-double { + set blc \u2569 ;# (btj) + #leave brc as ordinary double corner + set tlc \u2566 ;# (ttj) + } + } + } + down_right { + #6 + switch -- $targetdown-$targetright { + double-double { + set blc \u2560 ;# (ltj) + set trc \u2566 ;# (ttj) + set brc \u256c ;# (fwj) + } + double-other { + set blc \u2560 ;# (ltj) + #leave trc default + set brc \u2563 ;# (rtj) + } + other-double { + #leave blc default + set trc \u2566 ;# (ttj) + set brc \u2569 ;#(btj) + } + } + } + down_up { + #7 + switch -- $targetdown-$targetup { + double-double { + set blc \u2560 ;# (ltj) + set brc \u2563 ;# (rtj) + set tlc \u2560 ;# (ltj) + set trc \u2563 ;# (rtj) + } + } + } + left_right { + #8 + + #from 2 + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + #from3 + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + } + left_up { + #9 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + } + right_up { + #10 + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + } + down_left_right { + #11 + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + + } + down_left_up { + #12 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + + } + down_right_up { + #13 + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + } + left_right_up { + #14 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + + } + down_left_right_up { + #15 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + } + } + + } + "arc" { + #unicode box drawing set + + + set hl [punk::char::charshort boxd_lhz] ;# light horizontal + set hlt $hl + set hlb $hl + set vl [punk::char::charshort boxd_lv] ;#light vertical + set vll $vl + set vlr $vl + set tlc [punk::char::charshort boxd_ladr] ;#light arc down and right \U256D + set trc [punk::char::charshort boxd_ladl] ;#light arc down and left \U256E + set blc [punk::char::charshort boxd_laur] ;#light arc up and right \U2570 + set brc [punk::char::charshort boxd_laul] ;#light arc up and left \U256F + + #set targetdown,targetleft,targetright,targetup vars + #default empty targets to current box type 'arc' + foreach dir {down left right up} { + set target [dict get $join_targets $dir] + switch -- $target { + "" - arc { + set target$dir self + } + default { + set target$dir other + } + } + } + + switch -- $do_joins { + down { + #1 + switch -- $targetdown { + self { + set blc \u251c ;# *light (ltj) + #set blc \u29FD ;# misc math right-pointing curved angle bracket (ltj) - positioned too far left + #set blc \u227b ;# math succeeds char. joins on right ok - gaps top and bottom - almost passable + #set blc \u22b1 ;#math succeeds under relation - looks 'ornate', sits too low to join horizontal + + #set brc \u2524 ;# *light(rtj) + #set brc \u29FC ;# misc math left-pointing curved angle bracket (rtj) + } + } + } + left { + #2 + switch -- $targetleft { + self { + set tlc \u252c ;# *light(ttj) - need a low positioned curved y shape - nothing apparent + #set blc \u2144 ;# (btj) - upside down y - positioning too low for arc + set blc \u2534 ;# *light (btj) + } + } + } + right { + #3 + switch -- $targetright { + self { + set trc \u252c ;# *light (ttj) + #set brc \u2144 ;# (btj) + set brc \u2534 ;# *light (btj) + } + } + } + up { + #4 + switch -- $targetup { + self { + set tlc \u251c ;# *light (ltj) + set trc \u2524 ;# *light(rtj) + } + } + } + down_left { + #5 + switch -- $targetdown-$targetleft { + self-self { + #set blc \u27e1 ;# white concave-sided diamond - positioned too far right + #set blc \u27e3 ;# concave sided diamond with rightwards tick - positioned too low, too right - big gaps + set brc \u2524 ;# *light (rtj) + set tlc \u252c ;# *light (ttj) + } + self-other { + #set blc \u2560 ;# (ltj) + #set brc \u2563 ;# (rtj) + #leave tlc as ordinary double corner + } + other-self { + #set blc \u2569 ;# (btj) + #leave brc as ordinary double corner + #set tlc \u2566 ;# (ttj) + } + } + } + } + } + block1 { + set hlt \u2581 ;# lower one eighth block + set hlb \u2594 ;# upper one eighth block + set vll \u258f ;# left one eighth block + set vlr \u2595 ;# right one eighth block + set tlc \u2581 ;# lower one eighth block + set trc \u2581 ;# lower one eighth block + set blc \u2594 ;# upper one eighth block + set brc \u2594 ;# upper one eight block + + } + blockxx { + set hlt \u2594 ;# upper one eighth block + set hlb \u2581 ;# lower one eighth block + set vll \u2595 ;# right one eighth block + set vlr \u258f ;# left one eighth block + + set tlc \u2595 ;# right one eighth block + set trc \u258f ;# left one eighth block + + set blc \u2595 ;# right one eighth block + set brc \u258f ;# left one eighth block + + } + block { + set hlt \u2580 ;#upper half + set hlb \u2584 ;#lower half + set vll \u258c ;#left half + set vlr \u2590 ;#right half + + set tlc \u259b ;#upper left corner half + set trc \u259c + set blc \u2599 + set brc \u259f + } + custom { + dict with custom_frame {} ;#extract keys as vars + if {[dict exists $custom_frame hlt]} { + set hlt [dict get $custom_frame hlt] + } else { + set hlt $hl + } + if {[dict exists $custom_frame hlb]} { + set hlb [dict get $custom_frame hlb] + } else { + set hlb $hl + } + + if {[dict exists $custom_frame vll]} { + set vll [dict get $custom_frame vll] + } else { + set vll $vl + } + if {[dict exists $custom_frame vlr]} { + set vlr [dict get $custom_frame vlr] + } else { + set vlr $vl + } + + + + } + } + + dict for {boxelement sub} $opt_boxmap { + if {$boxelement eq "vl"} { + set vll $sub + set vlr $sub + set hl $sub + } elseif {$boxelement eq "hl"} { + set hlt $sub + set hlb $sub + set hl $sub + } else { + set $boxelement $sub + } + } + + switch -- $frame_type { + custom { + + set vll_width [punk::ansi::printing_length $vll] + set hlb_width [punk::ansi::printing_length $hlb] + set hlt_width [punk::ansi::printing_length $hlt] + + set vlr_width [punk::ansi::printing_length $vlr] + + set tlc_width [punk::ansi::printing_length $tlc] + set trc_width [punk::ansi::printing_length $trc] + set blc_width [punk::ansi::printing_length $blc] + set brc_width [punk::ansi::printing_length $brc] + + + set framewidth [expr {$contentwidth + 2}] ;#reverse default assumption + if {$opt_width eq ""} { + #width wasn't specified - so user is expecting frame to adapt to title/contents + #content shouldn't truncate because of extra wide frame + set contentwidth $content_or_title_width + set tbarwidth [expr {$content_or_title_width + 2 - $tlc_width - $trc_width - 2 + $vll_width + $vlr_width}] ;#+/2's for difference between border element widths and standard element single-width + set bbarwidth [expr {$content_or_title_width + 2 - $blc_width - $brc_width - 2 + $vll_width + $vlr_width}] + } else { + set contentwidth [expr $opt_width - $vll_width - $vlr_width] ;#content may be truncated + set tbarwidth [expr {$opt_width - $tlc_width - $trc_width}] + set bbarwidth [expr {$opt_width - $blc_width - $brc_width}] + } + #set column [string repeat " " $contentwidth] + set underlayline [string repeat " " $contentwidth] + set underlay [::join [lrepeat $linecount $underlayline] \n] + + if {$hlt_width == 1} { + set tbar [string repeat $hlt $tbarwidth] + } else { + #possibly mixed width chars that make up hlt - string range won't get width right + set blank [string repeat " " $tbarwidth] + if {$hlt_width > 0} { + set count [expr {($tbarwidth / $hlt_width) + 1}] + } else { + set count 0 + } + set tbar [string repeat $hlt $count] + #set tbar [string range $tbar 0 $tbarwidth-1] + set tbar [overtype::left -overflow 0 -exposed1 " " -exposed2 " " $blank $tbar];#spaces for exposed halves of 2w chars instead of default replacement character + } + if {$hlb_width == 1} { + set bbar [string repeat $hlb $bbarwidth] + } else { + set blank [string repeat " " $bbarwidth] + if {$hlb_width > 0} { + set count [expr {($bbarwidth / $hlb_width) + 1}] + } else { + set count 0 + } + set bbar [string repeat $hlb $count] + #set bbar [string range $bbar 0 $bbarwidth-1] + set bbar [overtype::left -overflow 0 -exposed1 " " -exposed2 " " $blank $bbar] + } + } + altg { + set tbar [string repeat $hlt $contentwidth] + set tbar [cd::groptim $tbar] + set bbar [string repeat $hlb $contentwidth] + set bbar [cd::groptim $bbar] + } + default { + set tbar [string repeat $hlt $contentwidth] + set bbar [string repeat $hlb $contentwidth] + + } + } + + set leftborder 0 + set rightborder 0 + set topborder 0 + set bottomborder 0 + # hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + #puts "----->$exact_boxlimits" + foreach lim $exact_boxlimits { + switch -- $lim { + hlt { + set topborder 1 + } + hlb { + set bottomborder 1 + } + vll { + set leftborder 1 + } + vlr { + set rightborder 1 + } + tlc { + set topborder 1 + set leftborder 1 + } + trc { + set topborder 1 + set rightborder 1 + } + blc { + set bottomborder 1 + set leftborder 1 + } + brc { + set bottomborder 1 + set rightborder 1 + } + } + } + if {$opt_width ne "" && $opt_width < 2} { + set rightborder 0 + } + #keep lhs/rhs separate? can we do vertical text on sidebars? + set lhs [string repeat $vll\n $linecount] + set lhs [string range $lhs 0 end-1] + set rhs [string repeat $vlr\n $linecount] + set rhs [string range $rhs 0 end-1] + + + if {$opt_ansiborder ne ""} { + set tbar $opt_ansiborder$tbar$rst + set bbar $opt_ansiborder$bbar$rst + set tlc $opt_ansiborder$tlc$rst + set trc $opt_ansiborder$trc$rst + set blc $opt_ansiborder$blc$rst + set brc $opt_ansiborder$brc$rst + set lhs $opt_ansiborder$lhs$rst ;#wrap the whole block and let textblock::join figure it out + set rhs $opt_ansiborder$rhs$rst + } + + #boxlimits used for partial borders in table generation + set all_exact_boxlimits [list vll vlr hlt hlb tlc blc trc blc] + set unspecified_limits [struct::set diff $all_exact_boxlimits $exact_boxlimits] + foreach lim $unspecified_limits { + switch -- $lim { + vll { + set blank_vll [string repeat " " $vll_width] + set lhs [string repeat $blank_vll\n $linecount] + set lhs [string range $lhs 0 end-1] + } + vlr { + set blank_vlr [string repeat " " $vlr_width] + set rhs [string repeat $blank_vlr\n $linecount] + set rhs [string range $rhs 0 end-1] + } + hlt { + set bar_width [punk::ansi::printing_length $tbar] + set tbar [string repeat " " $bar_width] + } + tlc { + set tlc_width [punk::ansi::printing_length $tlc] + set tlc [string repeat " " $tlc_width] + } + trc { + set trc_width [punk::ansi::printing_length $trc] + set trc [string repeat " " $trc_width] + } + hlb { + set bar_width [punk::ansi::printing_length $bbar] + set bbar [string repeat " " $bar_width] + } + blc { + set blc_width [punk::ansi::printing_length $blc] + set blc [string repeat " " $blc_width] + } + brc { + set brc_width [punk::ansi::printing_length $brc] + set brc [string repeat " " $brc_width] + } + } + } + + if {$opt_title ne ""} { + set topbar [overtype::centre -overflow 0 -exposed1 " " -exposed2 " " -ellipsis 1 -bias left $tbar $opt_title] ;#overtype supports gx0 on/off + } else { + set topbar $tbar + } + if {$opt_subtitle ne ""} { + set bottombar [overtype::centre -overflow 0 -exposed1 " " -exposed2 " " -ellipsis 1 -bias left $bbar $opt_subtitle] ;#overtype supports gx0 on/off + } else { + set bottombar $bbar + } + if {$opt_ansibase eq ""} { + set rstbase [a] + } else { + set rstbase [a]$opt_ansibase + } + + if {$opt_title ne ""} { + #title overrides -boxlimits for topborder + set topborder 1 + } + set fs "" + if {$topborder} { + if {$leftborder && $rightborder} { + append fs $tlc$topbar$trc + } else { + if {$leftborder} { + append fs $tlc$topbar + } elseif {$rightborder} { + append fs $topbar$trc + } else { + append fs $topbar + } + } + } + if {$has_contents || $opt_height > 2} { + if {$topborder && $fs ne ""} { + append fs \n + } + #set inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $opt_ansibase$contents$rstbase] + set inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $contents] + if {$leftborder && $rightborder} { + set bodyparts [list $lhs $opt_ansibase$inner$rstbase $rhs] + } else { + if {$leftborder} { + set bodyparts [list $lhs $opt_ansibase$inner$rstbase] + } elseif {$rightborder} { + set bodyparts [list $opt_ansibase$inner$rstbase $rhs] + } else { + set bodyparts [list $opt_ansibase$inner$rstbase] + } + } + set body [textblock::join -- {*}$bodyparts] + append fs $body + } + + if {$opt_height eq "" || $opt_height > 1} { + if {$opt_subtitle ne ""} { + #subtitle overrides boxlimits for bottomborder + set bottomborder 1 + } + if {$bottomborder} { + if {($topborder & $fs ne "" ) || ($has_contents || $opt_height > 2)} { + append fs \n + } + if {$leftborder && $rightborder} { + append fs $blc$bottombar$brc + } else { + if {$leftborder} { + append fs $blc$bottombar + } elseif {$rightborder} { + append fs $bottombar$brc + } else { + append fs $bottombar + } + } + } + } + + 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] + return [ansistring VIEW $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 0.1.1 +}] +return \ No newline at end of file diff --git a/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n b/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n index af00fd1..a8505f5 100644 --- a/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n +++ b/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n @@ -280,6 +280,8 @@ package require \fBpunk::lib \fR .sp \fBlpop\fR \fIlistvar\fR ?index? .sp +\fBlindex_resolve\fR \fIlist\fR \fIindex\fR +.sp \fBK\fR \fIx\fR \fIy\fR .sp \fBis_utf8_multibyteprefix\fR \fIstr\fR @@ -377,6 +379,24 @@ Forwards compatible lpop for versions 8\&.6 or less to support equivalent 8\&.7 .PP Core API functions for punk::lib .TP +\fBlindex_resolve\fR \fIlist\fR \fIindex\fR +.sp +Resolve an index which may be of the forms accepted by Tcl list commands such as end-2 or 2+2 to the actual integer index for the supplied list +.sp +Users may define procs which accept a list index and wish to accept the forms understood by Tcl\&. +.sp +This means the proc may be called with something like $x+2 end-$y etc +.sp +Sometimes the actual integer index is desired\&. +.sp +We want to resolve the index used, without passing arbitrary expressions into the 'expr' function - which could have security risks\&. +.sp +lindex_resolve will parse the index expression and return -1 if the supplied index expression is out of bounds for the supplied list\&. +.sp +Otherwise it will return an integer corresponding to the position in the list\&. +.sp +Like Tcl list commands - it will produce an error if the form of the +.TP \fBK\fR \fIx\fR \fIy\fR .sp The K-combinator function - returns the first argument, x and discards y diff --git a/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md b/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md index 30e0f6a..8fbe9b7 100644 --- a/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md +++ b/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md @@ -48,31 +48,32 @@ package require punk::lib [__lremove__ *list* ?index \.\.\.?](#1) [__lpop__ *listvar* ?index?](#2) -[__K__ *x* *y*](#3) -[__is\_utf8\_multibyteprefix__ *str*](#4) -[__is\_utf8\_single__ *1234bytes*](#5) -[__get\_utf8\_leading__ *rawbytes*](#6) -[__hex2dec__ ?option value\.\.\.? *list\_largeHex*](#7) -[__dex2hex__ ?option value\.\.\.? *list\_decimals*](#8) -[__log2__ *x*](#9) -[__logbase__ *b* *x*](#10) -[__factors__ *x*](#11) -[__oddFactors__ *x*](#12) -[__greatestFactorBelow__ *x*](#13) -[__greatestOddFactorBelow__ *x*](#14) -[__greatestOddFactor__ *x*](#15) -[__gcd__ *n* *m*](#16) +[__lindex\_resolve__ *list* *index*](#3) +[__K__ *x* *y*](#4) +[__is\_utf8\_multibyteprefix__ *str*](#5) +[__is\_utf8\_single__ *1234bytes*](#6) +[__get\_utf8\_leading__ *rawbytes*](#7) +[__hex2dec__ ?option value\.\.\.? *list\_largeHex*](#8) +[__dex2hex__ ?option value\.\.\.? *list\_decimals*](#9) +[__log2__ *x*](#10) +[__logbase__ *b* *x*](#11) +[__factors__ *x*](#12) +[__oddFactors__ *x*](#13) +[__greatestFactorBelow__ *x*](#14) +[__greatestOddFactorBelow__ *x*](#15) +[__greatestOddFactor__ *x*](#16) [__gcd__ *n* *m*](#17) -[__commonDivisors__ *x* *y*](#18) -[__hasglobs__ *str*](#19) -[__trimzero__ *number*](#20) -[__substring\_count__ *str* *substring*](#21) -[__dict\_merge\_ordered__ *defaults* *main*](#22) -[__askuser__ *question*](#23) -[__linesort__ ?sortoption ?val?\.\.\.? *textblock*](#24) -[__list\_as\_lines__ ?\-joinchar char? *linelist*](#25) -[__lines\_as\_list__ ?option value \.\.\.? *text*](#26) -[__opts\_values__ ?option value\.\.\.? *optionspecs* *rawargs*](#27) +[__gcd__ *n* *m*](#18) +[__commonDivisors__ *x* *y*](#19) +[__hasglobs__ *str*](#20) +[__trimzero__ *number*](#21) +[__substring\_count__ *str* *substring*](#22) +[__dict\_merge\_ordered__ *defaults* *main*](#23) +[__askuser__ *question*](#24) +[__linesort__ ?sortoption ?val?\.\.\.? *textblock*](#25) +[__list\_as\_lines__ ?\-joinchar char? *linelist*](#26) +[__lines\_as\_list__ ?option value \.\.\.? *text*](#27) +[__opts\_values__ ?option value\.\.\.? *optionspecs* *rawargs*](#28) # DESCRIPTION @@ -124,7 +125,30 @@ class definitions Core API functions for punk::lib - - __K__ *x* *y* + - __lindex\_resolve__ *list* *index* + + Resolve an index which may be of the forms accepted by Tcl list commands + such as end\-2 or 2\+2 to the actual integer index for the supplied list + + Users may define procs which accept a list index and wish to accept the + forms understood by Tcl\. + + This means the proc may be called with something like $x\+2 end\-$y etc + + Sometimes the actual integer index is desired\. + + We want to resolve the index used, without passing arbitrary expressions + into the 'expr' function \- which could have security risks\. + + lindex\_resolve will parse the index expression and return \-1 if the supplied + index expression is out of bounds for the supplied list\. + + Otherwise it will return an integer corresponding to the position in the + list\. + + Like Tcl list commands \- it will produce an error if the form of the + + - __K__ *x* *y* The K\-combinator function \- returns the first argument, x and discards y @@ -133,7 +157,7 @@ Core API functions for punk::lib It is used in cases where command\-substitution at the calling\-point performs some desired effect\. - - __is\_utf8\_multibyteprefix__ *str* + - __is\_utf8\_multibyteprefix__ *str* Returns a boolean if str is potentially a prefix for a multibyte utf\-8 character @@ -152,12 +176,12 @@ Core API functions for punk::lib e\.g using: set head \[get\_utf8\_leading $testbytes\] ; set tail \[string range $testbytes \[string length $head\] end\] - - __is\_utf8\_single__ *1234bytes* + - __is\_utf8\_single__ *1234bytes* Tests input of 1,2,3 or 4 bytes and responds with a boolean indicating if it is a valid utf\-8 character \(codepoint\) - - __get\_utf8\_leading__ *rawbytes* + - __get\_utf8\_leading__ *rawbytes* return the leading portion of rawbytes that is a valid utf8 sequence\. @@ -182,7 +206,7 @@ Core API functions for punk::lib The utf\-8 BOM \\xEF\\xBB\\xBF is a valid UTF8 3\-byte sequence and so can also be returned as part of the leading utf8 bytes - - __hex2dec__ ?option value\.\.\.? *list\_largeHex* + - __hex2dec__ ?option value\.\.\.? *list\_largeHex* Convert a list of \(possibly large\) unprefixed hex strings to their decimal values @@ -199,7 +223,7 @@ Core API functions for punk::lib Internal whitespace e\.g "F F" is not permitted \- but a completely empty element "" is allowed and will return 0 - - __dex2hex__ ?option value\.\.\.? *list\_decimals* + - __dex2hex__ ?option value\.\.\.? *list\_decimals* Convert a list of decimal integers to a list of hex values @@ -208,7 +232,7 @@ Core API functions for punk::lib \-case upper|lower determines the case of the hex letters in the output - - __log2__ *x* + - __log2__ *x* log base2 of x @@ -218,7 +242,7 @@ Core API functions for punk::lib \(courtesy of RS [https://wiki\.tcl\-lang\.org/page/Additional\+math\+functions](https://wiki\.tcl\-lang\.org/page/Additional\+math\+functions)\) - - __logbase__ *b* *x* + - __logbase__ *b* *x* log base b of x @@ -229,7 +253,7 @@ Core API functions for punk::lib Use expr's log10\(\) function or tcl::mathfunc::log10 for base 10 - - __factors__ *x* + - __factors__ *x* Return a sorted list of the positive factors of x where x > 0 @@ -265,11 +289,11 @@ Core API functions for punk::lib In other mathematical contexts zero may be considered not to divide anything\. - - __oddFactors__ *x* + - __oddFactors__ *x* Return a list of odd integer factors of x, sorted in ascending order - - __greatestFactorBelow__ *x* + - __greatestFactorBelow__ *x* Return the largest factor of x excluding itself @@ -277,17 +301,17 @@ Core API functions for punk::lib See Tcllib math::numtheory for more extensive implementations - - __greatestOddFactorBelow__ *x* + - __greatestOddFactorBelow__ *x* Return the largest odd integer factor of x excluding x itself - - __greatestOddFactor__ *x* + - __greatestOddFactor__ *x* Return the largest odd integer factor of x For an odd value of x \- this will always return x - - __gcd__ *n* *m* + - __gcd__ *n* *m* Return the greatest common divisor of m and n @@ -299,19 +323,19 @@ Core API functions for punk::lib only if c is a common divisor of a and b - - __gcd__ *n* *m* + - __gcd__ *n* *m* Return the lowest common multiple of m and n Straight from Lars Hellström's math::numtheory library in Tcllib - - __commonDivisors__ *x* *y* + - __commonDivisors__ *x* *y* Return a list of all the common factors of x and y \(equivalent to factors of their gcd\) - - __hasglobs__ *str* + - __hasglobs__ *str* Return a boolean indicating whether str contains any of the glob characters: \* ? \[ \] @@ -319,17 +343,17 @@ Core API functions for punk::lib hasglobs uses append to preserve Tcls internal representation for str \- so it should help avoid shimmering in the few cases where this may matter\. - - __trimzero__ *number* + - __trimzero__ *number* Return number with left\-hand\-side zeros trimmed off \- unless all zero If number is all zero \- a single 0 is returned - - __substring\_count__ *str* *substring* + - __substring\_count__ *str* *substring* Search str and return number of occurrences of substring - - __dict\_merge\_ordered__ *defaults* *main* + - __dict\_merge\_ordered__ *defaults* *main* The standard dict merge accepts multiple dicts with values from dicts to the right \(2nd argument\) taking precedence\. @@ -341,7 +365,7 @@ Core API functions for punk::lib This function merges the two dicts whilst maintaining the key order of main followed by defaults\. - - __askuser__ *question* + - __askuser__ *question* A basic utility to read an answer from stdin @@ -370,7 +394,7 @@ Core API functions for punk::lib puts "Cancelled by user" } - - __linesort__ ?sortoption ?val?\.\.\.? *textblock* + - __linesort__ ?sortoption ?val?\.\.\.? *textblock* Sort lines in textblock @@ -379,7 +403,7 @@ Core API functions for punk::lib options are flags as accepted by lsort ie \-ascii \-command \-decreasing \-dictionary \-index \-indices \-integer \-nocase \-real \-stride \-unique - - __list\_as\_lines__ ?\-joinchar char? *linelist* + - __list\_as\_lines__ ?\-joinchar char? *linelist* This simply joines the elements of the list with \-joinchar @@ -391,7 +415,7 @@ Core API functions for punk::lib lines \- but with more options related to trimming the block and/or each line\. - - __lines\_as\_list__ ?option value \.\.\.? *text* + - __lines\_as\_list__ ?option value \.\.\.? *text* Returns a list of possibly trimmed lines depeding on options @@ -401,7 +425,7 @@ Core API functions for punk::lib \- not console lines which may be entirely different due to control characters such as vertical tabs or ANSI movements - - __opts\_values__ ?option value\.\.\.? *optionspecs* *rawargs* + - __opts\_values__ ?option value\.\.\.? *optionspecs* *rawargs* Parse rawargs as a sequence of zero or more option\-value pairs followed by zero or more values diff --git a/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html b/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html index 154e3f5..61ed29b 100644 --- a/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html +++ b/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html @@ -142,31 +142,32 @@ @@ -208,20 +209,29 @@

Namespace punk::lib

Core API functions for punk::lib

-
K x y
+
lindex_resolve list index
+

Resolve an index which may be of the forms accepted by Tcl list commands such as end-2 or 2+2 to the actual integer index for the supplied list

+

Users may define procs which accept a list index and wish to accept the forms understood by Tcl.

+

This means the proc may be called with something like $x+2 end-$y etc

+

Sometimes the actual integer index is desired.

+

We want to resolve the index used, without passing arbitrary expressions into the 'expr' function - which could have security risks.

+

lindex_resolve will parse the index expression and return -1 if the supplied index expression is out of bounds for the supplied list.

+

Otherwise it will return an integer corresponding to the position in the list.

+

Like Tcl list commands - it will produce an error if the form of the

+
K x y

The K-combinator function - returns the first argument, x and discards y

see https://wiki.tcl-lang.org/page/K

It is used in cases where command-substitution at the calling-point performs some desired effect.

-
is_utf8_multibyteprefix str
+
is_utf8_multibyteprefix str

Returns a boolean if str is potentially a prefix for a multibyte utf-8 character

ie - tests if it is possible that appending more data will result in a utf-8 codepoint

Will return false for an already complete utf-8 codepoint

It is assumed the incomplete sequence is at the beginning of the bytes argument

Suitable input for this might be from the unreturned tail portion of get_utf8_leading $testbytes

e.g using: set head [get_utf8_leading $testbytes] ; set tail [string range $testbytes [string length $head] end]

-
is_utf8_single 1234bytes
+
is_utf8_single 1234bytes

Tests input of 1,2,3 or 4 bytes and responds with a boolean indicating if it is a valid utf-8 character (codepoint)

-
get_utf8_leading rawbytes
+
get_utf8_leading rawbytes

return the leading portion of rawbytes that is a valid utf8 sequence.

This will stop at the point at which the bytes can't be interpreted as a complete utf-8 codepoint

e.g It will not return the first byte or 2 of a 3-byte utf-8 character if the last byte is missing, and will return only the valid utf-8 string from before the first byte of the incomplete character.

@@ -229,26 +239,26 @@

Note that while this will return valid utf8 - it has no knowledge of grapheme clusters or diacritics

This means if it is being used to process bytes split at some arbitrary point - the trailing data that isn't returned could be part of a grapheme cluster that belongs with the last character of the leading string already returned

The utf-8 BOM \xEF\xBB\xBF is a valid UTF8 3-byte sequence and so can also be returned as part of the leading utf8 bytes

-
hex2dec ?option value...? list_largeHex
+
hex2dec ?option value...? list_largeHex

Convert a list of (possibly large) unprefixed hex strings to their decimal values

hex2dec accepts and ignores internal underscores in the same manner as Tcl 8.7+ numbers e.g hex2dec FF_FF returns 65535

Leading and trailing underscores are ignored as a matter of implementation convenience - but this shouldn't be relied upon.

Leading or trailing whitespace in each list member is allowed e.g hex2dec " F" returns 15

Internal whitespace e.g "F F" is not permitted - but a completely empty element "" is allowed and will return 0

-
dex2hex ?option value...? list_decimals
+
dex2hex ?option value...? list_decimals

Convert a list of decimal integers to a list of hex values

-width <int> can be used to make each hex value at least int characters wide, with leading zeroes.

-case upper|lower determines the case of the hex letters in the output

-
log2 x
+
log2 x

log base2 of x

This uses a 'live' proc body - the divisor for the change of base is computed once at definition time

(courtesy of RS https://wiki.tcl-lang.org/page/Additional+math+functions)

-
logbase b x
+
logbase b x

log base b of x

This function uses expr's natural log and the change of base division.

This means for example that we can get results like: logbase 10 1000 = 2.9999999999999996

Use expr's log10() function or tcl::mathfunc::log10 for base 10

-
factors x
+
factors x

Return a sorted list of the positive factors of x where x > 0

For x = 0 we return only 0 and 1 as technically any number divides zero and there are an infinite number of factors. (including zero itself in this context)*

This is a simple brute-force implementation that iterates all numbers below the square root of x to check the factors

@@ -261,42 +271,42 @@ but has the disadvantage of being slower for 'small' numbers and using more memo

If the largest factor below x is needed - the greatestOddFactorBelow and GreatestFactorBelow functions are a faster way to get there than computing the whole list, even for small values of x

* Taking x=0; Notion of x being divisible by integer y being: There exists an integer p such that x = py

In other mathematical contexts zero may be considered not to divide anything.

-
oddFactors x
+
oddFactors x

Return a list of odd integer factors of x, sorted in ascending order

-
greatestFactorBelow x
+
greatestFactorBelow x

Return the largest factor of x excluding itself

factor functions can be useful for console layout calculations

See Tcllib math::numtheory for more extensive implementations

-
greatestOddFactorBelow x
+
greatestOddFactorBelow x

Return the largest odd integer factor of x excluding x itself

-
greatestOddFactor x
+
greatestOddFactor x

Return the largest odd integer factor of x

For an odd value of x - this will always return x

-
gcd n m
+
gcd n m

Return the greatest common divisor of m and n

Straight from Lars Hellström's math::numtheory library in Tcllib

Graphical use:

An a by b rectangle can be covered with square tiles of side-length c,

only if c is a common divisor of a and b

-
gcd n m
+
gcd n m

Return the lowest common multiple of m and n

Straight from Lars Hellström's math::numtheory library in Tcllib

-
commonDivisors x y
+
commonDivisors x y

Return a list of all the common factors of x and y

(equivalent to factors of their gcd)

-
hasglobs str
+
hasglobs str

Return a boolean indicating whether str contains any of the glob characters: * ? [ ]

hasglobs uses append to preserve Tcls internal representation for str - so it should help avoid shimmering in the few cases where this may matter.

-
trimzero number
+
trimzero number

Return number with left-hand-side zeros trimmed off - unless all zero

If number is all zero - a single 0 is returned

-
substring_count str substring
+
substring_count str substring

Search str and return number of occurrences of substring

-
dict_merge_ordered defaults main
+
dict_merge_ordered defaults main

The standard dict merge accepts multiple dicts with values from dicts to the right (2nd argument) taking precedence.

When merging with a dict of default values - this means that any default key/vals that weren't in the main dict appear in the output before the main data.

This function merges the two dicts whilst maintaining the key order of main followed by defaults.

-
askuser question
+
askuser question

A basic utility to read an answer from stdin

The prompt is written to the terminal and then it waits for a user to type something

stdin is temporarily configured to blocking and then put back in its original state in case it wasn't already so.

@@ -314,19 +324,19 @@ but has the disadvantage of being slower for 'small' numbers and using more memo }
-
linesort ?sortoption ?val?...? textblock
+
linesort ?sortoption ?val?...? textblock

Sort lines in textblock

Returns another textblock with lines sorted

options are flags as accepted by lsort ie -ascii -command -decreasing -dictionary -index -indices -integer -nocase -real -stride -unique

-
list_as_lines ?-joinchar char? linelist
+
list_as_lines ?-joinchar char? linelist

This simply joines the elements of the list with -joinchar

It is mainly intended for use in pipelines where the primary argument comes at the end - but it can also be used as a general replacement for join $lines <le>

The sister function lines_as_list takes a block of text and splits it into lines - but with more options related to trimming the block and/or each line.

-
lines_as_list ?option value ...? text
+
lines_as_list ?option value ...? text

Returns a list of possibly trimmed lines depeding on options

The concept of lines is raw lines from splitting on newline after crlf is mapped to lf

- not console lines which may be entirely different due to control characters such as vertical tabs or ANSI movements

-
opts_values ?option value...? optionspecs rawargs
+
opts_values ?option value...? optionspecs rawargs

Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values

Returns a dict of the form: opts <options_dict> values <values_dict>

ARGUMENTS:

diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index c3b0867..e674ba2 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -1748,6 +1748,7 @@ namespace eval punk::ansi { dict set codestate_empty bg "" ;#40-47 + 100-107 + #misnomer should have been sgr_merge_args ? :/ #as a common case optimisation - it will not merge a single element list, even if that code contains redundant elements proc sgr_merge_list {args} { if {[llength $args] == 0} { @@ -1755,9 +1756,30 @@ namespace eval punk::ansi { } elseif {[llength $args] == 1} { return [lindex $args 0] } + sgr_merge $args + } + #codes *must* already have been split so that one esc per element in codelist + #e.g codelist [a+ Yellow Red underline] [a+ blue] [a+ red] is ok + #but codelist "[a+ Yellow Red underline][a+ blue]" [a+ red] is not + #(use punk::ansi::ta::split_codes_single) + proc sgr_merge {codelist args} { variable codestate_empty set othercodes [list] + set defaults [dict create\ + -filter_fg 0\ + -filter_bg 0\ + ] + dict for {k v} $args { + switch -- $k { + -filter_fg - -filter_bg {} + default { + error "sgr_merge unknown option '$k'. Known options [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + set codestate $codestate_empty set codestate_initial $codestate_empty ;#keep a copy for resets. set did_reset 0 @@ -1772,7 +1794,7 @@ namespace eval punk::ansi { #We still output any non SGR codes in the list as they came in - preserving their CSI - foreach c $args { + foreach c $codelist { #normalize 8bit to a token of the same length so our string operations on the code are the same and we can maintain a switch statement with literals rather than escapes #.. but preserve original c #set cnorm [string map [list \x9b {8[} ] $c] @@ -1911,7 +1933,7 @@ namespace eval punk::ansi { dict set codestate hide 28 ;#reveal } 29 { - dict set codestate strik 29;#off + dict set codestate strike 29;#off } 30 - 31 - 32 - 33 - 34 - 35 - 36 - 37 { dict set codestate fg $p ;#foreground colour @@ -2067,13 +2089,38 @@ namespace eval punk::ansi { } set codemerge "" - dict for {k v} $codestate { - switch -- $v { - "" { + if {[dict get $opts -filter_fg] || [dict get $opts -filter_bg]} { + dict for {k v} $codestate { + switch -- $v { + "" { + } + default { + switch -- $k { + bg { + if {![dict get $opts -filter_bg]} { + append codemerge "${v}\;" + } + } + fg { + if {![dict get $opts -filter_fg]} { + append codemerge "${v}\;" + } + } + default { + append codemerge "${v}\;" + } + } + } } - default { - append codemerge "${v}\;" + } + } else { + dict for {k v} $codestate { + switch -- $v { + "" {} + default { + append codemerge "${v}\;" + } } } } @@ -3963,7 +4010,7 @@ namespace eval punk::ansi::ansistring { #return empty string for each index that is out of range #review - this is possibly too slow to be very useful as is. # consider converting to oo and maintaining state of ansisplits so we don't repeat relatively expensive operations for same string - #see also punk::list_index_resolve / punk::list_index_get for ways to handle tcl list/string indices without parsing them. + #see also punk::lindex_resolve / punk::lindex_get for ways to handle tcl list/string indices without parsing them. proc INDEXABSOLUTE {string args} { set payload_len -1 ;# -1 as token to indicate we haven't calculated it yet (only want to call it once at most) set testindices [list] diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index a5a0d41..52fc4ab 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -211,7 +211,18 @@ namespace eval punk::lib { #} - proc list_index_resolve {list index} { + proc lindex_resolve {list index} { + #*** !doctools + #[call [fun lindex_resolve] [arg list] [arg index]] + #[para]Resolve an index which may be of the forms accepted by Tcl list commands such as end-2 or 2+2 to the actual integer index for the supplied list + #[para]Users may define procs which accept a list index and wish to accept the forms understood by Tcl. + #[para]This means the proc may be called with something like $x+2 end-$y etc + #[para]Sometimes the actual integer index is desired. + #[para]We want to resolve the index used, without passing arbitrary expressions into the 'expr' function - which could have security risks. + #[para]lindex_resolve will parse the index expression and return -1 if the supplied index expression is out of bounds for the supplied list. + #[para]Otherwise it will return an integer corresponding to the position in the list. + #[para]Like Tcl list commands - it will produce an error if the form of the index is not acceptable + #Note that for an index such as $x+1 - we never see the '$x' as it is substituted in the calling command. We will get something like 10+1 - which we will resolve (hopefully safely) with expr if {![llength $list]} { return -1 @@ -271,7 +282,7 @@ namespace eval punk::lib { } } } - proc list_index_resolve2 {list index} { + proc lindex_resolve2 {list index} { set indices [list] ;#building this may be somewhat expensive in terms of storage and compute for large lists - we could use lseq in Tcl 8.7+ but that's likely unavailable here. for {set i 0} {$i < [llength $list]} {incr i} { lappend indices $i @@ -283,7 +294,7 @@ namespace eval punk::lib { return $idx } } - proc list_index_get {list index} { + proc lindex_get {list index} { set resultlist [lrange $list $index $index] if {![llength $resultlist]} { return -1 diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index b907b7f..d398810 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -29,6 +29,117 @@ package require textutil namespace eval textblock { namespace eval class { + variable opts_table_defaults + set opts_table_defaults [dict create\ + -title ""\ + -frametype "light"\ + -frametype_header ""\ + -ansibase_header ""\ + -ansibase_body ""\ + -ansibase_footer ""\ + -ansiborder_header ""\ + -ansiborder_body ""\ + -ansiborder_footer ""\ + -ansireset "\uFFeF"\ + -framelimits_header "vll vlr hlb hlt tlc trc blc brc"\ + -frametype_body ""\ + -framelimits_body "vll vlr hlb hlt tlc trc blc brc"\ + -framemap_body [list\ + topleft {} topinner {} topright {} topsolo {}\ + middleleft {} middleinner {} middleright {} middlesolo {}\ + bottomleft {} bottominner {} bottomright {} bottomsolo {}\ + onlyleft {} onlyinner {} onlyright {} onlysolo {}\ + ]\ + -framemap_header [list headerleft {} headerinner {} headerright {} headersolo {}]\ + -show_edge 1\ + -show_separators 1\ + -show_header ""\ + -show_footer ""\ + ] + variable table_border_parts + #for 'L' shaped table building pattern + set table_border_parts [dict create\ + topleft [list hlt vll tlc blc]\ + topinner [list hlt tlc]\ + topright [list hlt tlc vlr trc brc]\ + topsolo [list hlt tlc trc blc brc vl]\ + middleleft [list vll blc]\ + midleinner [list]\ + middleright [list vlr brc]\ + middlesolo [list vl blc brc]\ + bottomleft [list vll blc hlb]\ + bottominner [list hlb blc]\ + bottomright [list hlb blc brc vlr]\ + bottomsolo [list hlb blc brc tlc trc vl]\ + onlyleft [list hlt hlb vll tlc blc]\ + onlyinner [list hlt hlb tlc blc]\ + onlyright [list hlt hlb tlc blc brc trc vlr]\ + onlysolo [list hlt hlb vll vlr blc brc trc brc]\ + ] + variable table_sep_parts + set table_sep_parts [dict create\ + topleft [list blc hlb]\ + topinner [list blc hlb]\ + topright [list blc hlb brc]\ + topsolo [list blc hlb brc]\ + middleleft [list blc hlb]\ + middleinner [list blc hlb]\ + middleright [list blc hlb brc]\ + middlesolo [list blc hlb brc]\ + bottomleft [list]\ + bottominner [list]\ + bottomright [list]\ + bottomsolo [list]\ + onlyleft [list]\ + onlyinner [list]\ + onlyright [list]\ + onlysolo [list]\ + ] + variable header_border_parts + set header_border_parts [dict create\ + headerleft [list vll tlc blc hlt]\ + headerinner [list tlc hlt]\ + headerright [list tlc hlt trc vlr brc]\ + headersolo [list tlc vlr blc hlt trc brc]\ + ] + + #e.g $t configure -framemap_body [table_border_map " "] + proc table_border_map {char} { + variable table_border_parts + set map [list] + dict for {celltype parts} $table_border_parts { + set tmap [list] + foreach p $parts { + dict set tmap $p $char + } + dict set map $celltype $tmap + } + return $map + } + proc table_sep_map {char} { + variable table_sep_parts + set map [list] + dict for {celltype parts} $table_sep_parts { + set tmap [list] + foreach p $parts { + dict set tmap $p $char + } + dict set map $celltype $tmap + } + return $map + } + proc header_border_map {char} { + variable header_border_parts + set map [list] + dict for {celltype parts} $header_border_parts { + set tmap [list] + foreach p $parts { + dict set tmap $p $char + } + dict set map $celltype $tmap + } + return $map + } if {[info commands [namespace current]::table] eq ""} { #*** !doctools #[subsection {Namespace textblock::class}] @@ -48,16 +159,15 @@ namespace eval textblock { variable o_columndata variable o_rowdefs variable o_rowstates + variable o_opts_table_defaults + variable o_opts_column_defaults + variable o_opts_row_defaults constructor {args} { #*** !doctools #[call class::table [method constructor] [arg args]] - - set o_opts_table_defaults [dict create\ - -title ""\ - -frametype "unicode_box"\ - -show_header ""\ - ] + upvar ::textblock::class::opts_table_defaults tdefaults + set o_opts_table_defaults $tdefaults if {[llength $args] == 1} { set args [list -title [lindex $args 0]] } @@ -69,27 +179,118 @@ namespace eval textblock { error "[namespace current]::table unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" } } - set o_opts_table [dict merge $o_opts_table_defaults $args] + #set o_opts_table [dict merge $o_opts_table_defaults $args] + set o_opts_table $o_opts_table_defaults + my configure {*}[dict merge $o_opts_table_defaults $args] set o_columndefs [dict create] - set o_columndata [dict create] + set o_columndata [dict create] ;#we store data by column even though it is often added row by row set o_rowdefs [dict create] ;#user requested row data e.g -minheight -maxheight set o_rowstates [dict create] ;#actual row data such as -minheight and -maxheight detected from supplied row data } + method Get_frametypes {} { + set requested_ft [dict get $o_opts_table -frametype] + set requested_ft_header [dict get $o_opts_table -frametype_header] + set requested_ft_body [dict get $o_opts_table -frametype_body] + set ft $requested_ft + set ft_header $requested_ft_header + set ft_body $requested_ft_body + switch -- $requested_ft { + light { + if {$requested_ft_header eq ""} { + set ft_header heavy + } + if {$requested_ft_body eq ""} { + set ft_body light + } + } + default { + if {$requested_ft_header eq ""} { + set ft_header $requested_ft + } + if {$requested_ft_body eq ""} { + set ft_body $requested_ft + } + } + } + return [dict create header $ft_header body $ft_body] + } method configure args { if {![llength $args]} { return $o_opts_table - } else { - if {[llength $args] %2 != 0} { - error "[namespace current]::table configure - unexpected argument count. Require name value pairs" + } + if {[llength $args] == 1 && [lindex $args 0] in [dict keys $o_opts_table_defaults]} { + #query single option + set k [lindex $args 0] + set val [dict get $o_opts_table $k] + set infodict [dict create] + switch -- $k { + -ansibase_header - -ansibase_body - -ansiborder_header - -ansiborder_body - -ansiborder_footer { + dict set infodict debug [ansistring VIEW $val] + } } - dict for {k v} $args { - if {$k ni [dict keys $o_opts_table_defaults]} { - error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + return [dict create option $k value $val ansireset "\x1b\[m" info $infodict] + } + if {[llength $args] %2 != 0} { + error "[namespace current]::table configure - unexpected argument count. Require name value pairs" + } + dict for {k v} $args { + if {$k ni [dict keys $o_opts_table_defaults]} { + error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + } + } + set checked_opts [list] + dict for {k v} $args { + switch -- $k { + -ansireset { + if {$v eq "\uFFEF"} { + lappend checked_opts $k "\x1b\[m" ;# [a] + } else { + error "textblock::table::configure -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" + } } + default { + lappend checked_opts $k $v + } + } + } + set o_opts_table [dict merge $o_opts_table $checked_opts] + } + + #integrate with struct::matrix - allows ::m format 2string $table + method printmatrix {matrix} { + set matrix_rowcount [$matrix rows] + set matrix_colcount [$matrix columns] + set table_colcount [my column_count] + if {$table_colcount == 0} { + for {set c 0} {$c < $matrix_colcount} {incr c} { + my add_column -header "" } - set o_opts_table [dict merge $o_opts_table $args] + } + set table_colcount [my column_count] + if {$table_colcount != $matrix_colcount} { + error "textblock::table::printmatrix column count of table doesn't match column count of matrix" + } + if {[my row_count] > 0} { + my row_clear + } + for {set r 0} {$r < $matrix_rowcount} {incr r} { + my add_row [$matrix get row $r] } + my print + } + method as_matrix {{cmd ""}} { + if {$cmd eq ""} { + set m [struct::matrix] + } else { + set m [struct::matrix $cmd] + } + $m add columns [dict size $o_columndata] + $m add rows [dict size $o_rowdefs] + dict for {k v} $o_columndata { + $m set column $k $v + } + return $m } method add_column {args} { #*** !doctools @@ -97,10 +298,13 @@ namespace eval textblock { set defaults [dict create\ -header ""\ -footer ""\ - -style ""\ + -ansibase ""\ + -ansireset "\uFFEF"\ -minwidth ""\ -maxwidth ""\ ] + #initialise -ansireset with replacement char so we can keep in appropriate dict position for initial configure and then treat as read-only + set o_opts_column_defaults $defaults if {[llength $args] %2 != 0} { error "[namespace current]::table::add_column unexpected argument count. Require name value pairs. Known options: [dict keys $defaults]" } @@ -111,45 +315,128 @@ namespace eval textblock { } set opts [dict merge $defaults $args] set colcount [dict size $o_columndefs] - set h [dict get $opts -header] - #todo - multiline header - if {[string is integer -strict $h]} { - error "table::add_column -header cannot be an integer" - } - set coldef [dict create -header $h -style [dict get $opts -style] -minwidth [dict get $opts -minwidth] -maxwidth [dict get $opts -maxwidth]] - dict set o_columndefs $colcount $coldef + + dict set o_columndata $colcount [list] + dict set o_columndefs $colcount $defaults ;#ensure record exists + if {[catch { + my configure_column $colcount {*}$opts + } errMsg]} { + #configure failed - ensure o_columndata and o_columdefs entries are removed + dict unset o_columndata $colcount + dict unset o_columndefs $colcount + error "add_column failed to configure with supplied options $opts. Err:\n$errMsg" + } return $colcount } + method column_count {} { + return [dict size $o_columndefs] + } + method configure_column {index_expression args} { + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + error "textblock::table::configure_column - no column defined at index '$cidx'.Use add_column to define columns" + } + if {![llength $args]} { + return [dict get $o_columndefs $cidx] + } else { + if {[llength $args] %2 != 0} { + error "textblock::table configure_column unexpected argument count. Require name value pairs. Known options: [dict keys $o_opts_column_defaults]" + } + dict for {k v} $args { + if {$k ni [dict keys $o_opts_column_defaults]} { + error "[namespace current]::table configure_column unknown option '$k'. Known options: [dict keys $o_opts_column_defaults]" + } + } + set checked_opts [list] + dict for {k v} $args { + switch -- $k { + -header { + #todo - multiline header + if {[string is integer -strict $v]} { + #review - this is inconvenient + error "textblock::table::configure_column invalid value '$v' -header cannot be an integer" + } + lappend checked_opts $k $v + } + -ansibase { + set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" + set col_ansibase_items [list] ; + foreach {pt code} $parts { + if {$pt ne ""} { + #we don't expect plaintext in an ansibase + error "Unable to interpret -ansibase value as ansi SGR codes. Plaintext detected. Consider using for example: '\[punk::ansi::a+ green]' (or alias '\[a+ green]') to build ansi. debug view: [punk::ansi::ansistring VIEW $v]" + } + if {$code ne ""} { + lappend col_ansibase_items $code + } + } + set col_ansibase [punk::ansi::codetype::sgr_merge $col_ansibase_items] + lappend checked_opts $k $col_ansibase + } + -ansireset { + if {$v eq "\uFFEF"} { + lappend checked_opts $k "\x1b\[m" ;# [a] + } else { + error "textblock::table::configure_column -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" + } + } + default { + lappend checked_opts $k $v + } + } + } + + set current_opts [dict get $o_columndefs $cidx] + set opts [dict merge $current_opts $checked_opts] + dict set o_columndefs $cidx $opts + } + } method add_row {valuelist args} { #*** !doctools #[call class::table [method add_row] [arg args]] - if {[llength $valuelist] > [dict size $o_columndefs]} { - error "too many row values - only [dict size $o_columndefs] defined" + if {[dict size $o_columndefs] > 0 && ([llength $valuelist] != [dict size $o_columndefs])} { + error "invalid number of values in row - Must match existing column count: [dict size $o_columndefs]" } set defaults [dict create\ -minheight 1\ -maxheight ""\ + -ansibase ""\ + -ansireset "\uFFEF"\ ] + set o_opts_row_defaults $defaults + if {[llength $args] %2 !=0} { error "[namespace current]::table::add_row unexpected argument count. Require name value pairs. Known options: [dict keys $defaults]" } - set opts [dict merge $defaults $args] - set opt_minh [dict get $opts -minheight] - set opt_maxh [dict get $opts -maxheight] - if {![string is integer $opt_minh] || ($opt_maxh ne "" && ![string is integer -strict $opt_maxh])} { - error "[namespace current]::table::add_row error -minheight '$opt_minh' and -maxheight '$opt_maxh' must be integers greater than or equal to 1" + dict for {k v} $args { + switch -- $k { + -minheight - -maxheight - -ansibase - -ansireset {} + default { + error "Invalid option '$k' Known options: [dict keys $defaults] (-ansireset is read-only)" + } + } } - if {$opt_minh < 1 || ($opt_maxh ne "" && $opt_maxh < 1)} { - error "[namespace current]::table::add_row error -minheight '$opt_minh' and -maxheight '$opt_maxh' must both be 1 or greater" + set opts [dict merge $defaults $args] + + set rowcount [dict size $o_rowdefs] + dict set o_rowdefs $rowcount $defaults ;# ensure record exists before configure + + if {[catch { + my configure_row $rowcount {*}$opts + } errMsg]} { + #undo anything we saved before configure_row + dict unset o_rowdefs $rowcount + error "add_row failed to configure with supplied options $opts. Err:\n$errMsg" } - if {$opt_maxh ne "" && $opt_maxh < $opt_minh} { - error "[namespace current]::table::add_row error -maxheight '$opt_maxh' must greater than -minheight '$opt_minh'" + + if {[dict size $o_columndefs] == 0} { + #no columns defined - auto define with defaults for each column in first supplied row + foreach el $valuelist { + my add_column + } } - set rowcount [dict size $o_rowdefs] - dict set o_rowdefs $rowcount -minheight $opt_minh - dict set o_rowdefs $rowcount -maxheight $opt_maxh - dict set o_rowstates $rowcount -minheight $opt_minh + set c 0 set max_height_seen 1 foreach v $valuelist { @@ -160,12 +447,96 @@ namespace eval textblock { } incr c } + set opt_maxh [dict get $o_rowdefs $rowcount -maxheight] if {$opt_maxh ne ""} { dict set o_rowstates $rowcount -maxheight [expr {min($opt_maxh,$max_height_seen)}] } else { dict set o_rowstates $rowcount -maxheight $max_height_seen } } + method configure_row {index_expression args} { + set ridx [lindex [dict keys $o_rowdefs] $index_expression] + if {$ridx eq ""} { + error "textblock::table::configure_row - no row defined at index '$ridx'.Use add_row to define rows" + } + if {![llength $args]} { + return [dict get $o_rowdefs $ridx] + } + if {[llength $args] %2 != 0} { + error "textblock::table configure_row incorrect number of options following index_expression. Require name value pairs. Known options: [dict keys $o_opts_row_defaults]" + } + dict for {k v} $args { + if {$k ni [dict keys $o_opts_row_defaults]} { + error "[namespace current]::table configure_row unknown option '$k'. Known options: [dict keys $o_opts_row_defaults]" + } + } + set checked_opts [list] + dict for {k v} $args { + switch -- $k { + -ansibase { + set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" + set row_ansibase_items [list] ; + foreach {pt code} $parts { + if {$pt ne ""} { + #we don't expect plaintext in an ansibase + error "Unable to interpret -ansibase value as ansi SGR codes. Plaintext detected. Consider using for example: '\[punk::ansi::a+ green]' (or alias '\[a+ green]') to build ansi. debug view: [punk::ansi::ansistring VIEW $v]" + } + if {$code ne ""} { + lappend row_ansibase_items $code + } + } + set row_ansibase [punk::ansi::codetype::sgr_merge $row_ansibase_items] + lappend checked_opts $k $row_ansibase + } + -ansireset { + if {$v eq "\uFFEF"} { + lappend checked_opts $k "\x1b\[m" ;# [a] + } else { + error "textblock::table::configure_row -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" + } + } + default { + lappend checked_opts $k $v + } + } + } + + set current_opts [dict get $o_rowdefs $ridx] + set opts [dict merge $current_opts $checked_opts] + + #check minheight and maxheight together + set opt_minh [dict get $opts -minheight] + set opt_maxh [dict get $opts -maxheight] + if {![string is integer $opt_minh] || ($opt_maxh ne "" && ![string is integer -strict $opt_maxh])} { + error "[namespace current]::table::add_row error -minheight '$opt_minh' and -maxheight '$opt_maxh' must be integers greater than or equal to 1" + } + if {$opt_minh < 1 || ($opt_maxh ne "" && $opt_maxh < 1)} { + error "[namespace current]::table::add_row error -minheight '$opt_minh' and -maxheight '$opt_maxh' must both be 1 or greater" + } + if {$opt_maxh ne "" && $opt_maxh < $opt_minh} { + error "[namespace current]::table::add_row error -maxheight '$opt_maxh' must greater than -minheight '$opt_minh'" + } + dict set o_rowstates $ridx -minheight $opt_minh + + + dict set o_rowdefs $ridx $opts + } + method row_count {} { + return [dict size $o_rowdefs] + } + method row_clear {} { + set o_rowdefs [dict create] + set o_rowstates [dict create] + #The data values are stored by column regardless of whether added row by row + dict for {cidx records} $o_columndata { + dict set o_columndata $cidx [list] + } + } + method clear {} { + my row_clear + set o_columndefs [dict create] + set o_columndata [dict create] + } method Get_columns_by_name {namematch_list} { } @@ -181,7 +552,8 @@ namespace eval textblock { } } } - method get_column_by_index {i args} { + method get_column_by_index {index_expression args} { + #index_expression may be something like end-1 or 2+2 - we can't directly use it as a lookup for dicts. set defaults [dict create\ -positiontype "inner"\ ] @@ -198,11 +570,11 @@ namespace eval textblock { error "[namespace::current]::table::get_column_by_index error invalid value '$opt_posn' for -positiontype. Valid values $valid_positiontypes" } - set columninfo [my get_column_cells_by_index $i] + set columninfo [my get_column_cells_by_index $index_expression] set header [dict get $columninfo header] set cells [dict get $columninfo cells] - set columninfo [my get_column_cells_by_index $i] + set columninfo [my get_column_cells_by_index $index_expression] set topt_show_header [dict get $o_opts_table -show_header] if {$topt_show_header eq ""} { set allheaders "" @@ -218,129 +590,299 @@ namespace eval textblock { } else { set do_show_header $topt_show_header } + set topt_show_footer [dict get $o_opts_table -show_footer] + + + set ftypes [my Get_frametypes] set output "" set boxlimits "" set joins "" set header_boxlimits [list] set header_joins [list] + set ftype_body [dict get $ftypes body] + if {[llength $ftype_body] >= 2} { + set ftype_body "custom" + } switch -- $opt_posn { left { set header_boxlimits {hl tlc blc vll} - set header_joins {down-light} - set boxlimits {hlb blc vll} - set boxlimits_headerless {hl blc vll tlc} + set header_joins [list down-$ftype_body] + set boxlimits_build {hlb blc vll} + set boxlimits {} + foreach l $boxlimits_build { + if {$l in [dict get $o_opts_table -framelimits_body]} { + lappend boxlimits $l + } + } + set boxlimits_headerless {hlb hlt blc vll tlc} set joins {down} } inner { set header_boxlimits {hl tlc blc vll} - set header_joins {left down-light} - set boxlimits {hlb blc vll} - set boxlimits_headerless {hl blc vll tlc} + set header_joins [list left down-$ftype_body] + set boxlimits_build {hlb blc vll} + set boxlimits {} + foreach l $boxlimits_build { + if {$l in [dict get $o_opts_table -framelimits_body]} { + lappend boxlimits $l + } + } + set boxlimits_headerless {hlb hlt blc vll tlc} set joins {down left} } right { set header_boxlimits {hl tlc blc vl trc brc} - set header_joins {left down-light} - set boxlimits {hlb blc vl brc} - set boxlimits_headerless {hl blc vl brc tlc trc} + set header_joins [list left down-$ftype_body] + set boxlimits_build {hlb blc vll vlr brc} + set boxlimits {} + foreach l $boxlimits_build { + if {$l in [dict get $o_opts_table -framelimits_body]} { + lappend boxlimits $l + } + } + set boxlimits_headerless {hlb hlt blc vll vlr brc tlc trc} set joins {down left} } solo { set header_boxlimits {hl tlc blc vl trc brc} - set header_joins {down-light} - set boxlimits {hlb blc vl brc} - set boxlimits_headerless {hl blc vl brc tlc trc} + set header_joins [list down-$ftype_body] + set boxlimits_build {hlb blc vll vlr brc} + set boxlimits {} + foreach l $boxlimits_build { + if {$l in [dict get $o_opts_table -framelimits_body]} { + lappend boxlimits $l + } + } + set boxlimits_headerless {hlb hlt blc vl brc tlc trc} set joins {down} } } + upvar ::textblock::class::opts_table_defaults tdefaults + set defaultmap [dict get $tdefaults -framemap_body] + set default_hmap [dict get $tdefaults -framemap_header] + if {![dict get $o_opts_table -show_edge]} { + set fmap [dict merge $defaultmap [textblock::class::table_border_map ""]] + set hmap [dict merge $default_hmap [textblock::class::header_border_map ""]] + } else { + set fmap [dict merge $defaultmap [dict get $o_opts_table -framemap_body]] + set hmap [dict merge $default_hmap [dict get $o_opts_table -framemap_header]] + } + set sep_elements $::textblock::class::table_sep_parts + + switch -- $opt_posn { + left { + set topmap [dict get $fmap topleft] + set botmap [dict get $fmap bottomleft] + set midmap [dict get $fmap middleleft] + set onlymap [dict get $fmap onlyleft] + set hdrmap [dict get $hmap headerleft] + set topseps [dict get $sep_elements topleft] + set midseps [dict get $sep_elements middleleft] + } + inner { + set topmap [dict get $fmap topinner] + set botmap [dict get $fmap bottominner] + set midmap [dict get $fmap middleinner] + set onlymap [dict get $fmap onlyinner] + set hdrmap [dict get $hmap headerinner] + set topseps [dict get $sep_elements topinner] + set midseps [dict get $sep_elements middleinner] + } + right { + set topmap [dict get $fmap topright] + set botmap [dict get $fmap bottomright] + set midmap [dict get $fmap middleright] + set onlymap [dict get $fmap onlyright] + set hdrmap [dict get $hmap headerright] + set topseps [dict get $sep_elements topright] + set midseps [dict get $sep_elements middleright] + } + solo { + set topmap [dict get $fmap topsolo] + set botmap [dict get $fmap bottomsolo] + set midmap [dict get $fmap middlesolo] + set onlymap [dict get $fmap onlysolo] + set hdrmap [dict get $hmap headersolo] + set topseps [dict get $sep_elements topsolo] + set midseps [dict get $sep_elements middlesolo] + } + } + if {$do_show_header} { - append output [textblock::frame -type unicode_box_heavy -boxlimits $header_boxlimits -joins $header_joins $header]\n + #puts "boxlimitsinfo header $opt_posn: -- boxlimits $header_boxlimits -- boxmap $hdrmap" + set ansibase_header [dict get $o_opts_table -ansibase_header] + set ansiborder_header [dict get $o_opts_table -ansiborder_header] + if {[dict get $o_opts_table -frametype_header] eq "block"} { + set extrabg [punk::ansi::codetype::sgr_merge [list $ansibase_header] -filter_fg 1] + set ansiborder_final $ansibase_header$ansiborder_header$extrabg + } else { + set ansiborder_final $ansibase_header$ansiborder_header + } + set cidx [lindex [dict keys $o_columndefs] $index_expression] + set RST [a] + set colwidth [my column_width $cidx] + set hcell_line_blank [string repeat " " $colwidth] + set hval $ansibase_header$header ;#no reset + set rowh 1 ;#todo + set h_lines [lrepeat $rowh $hcell_line_blank] + set hcell_blank [join $h_lines \n] + + set hval_lines [split $hval \n] + set hval_lines [lrange $hval_lines 0 $rowh-1] + set hval_block [join $hval_lines \n] + set headercell [overtype::left -experimental test_mode $ansibase_header$hcell_blank$RST $hval_block] + + set header_frame [textblock::frame -width [expr {$colwidth+2}] -type [dict get $ftypes header]\ + -ansibase $ansibase_header -ansiborder $ansiborder_final\ + -boxlimits $header_boxlimits -boxmap $hdrmap -joins $header_joins $hval\ + ] + + #puts ">> '[ansistring VIEW $hval]' -> $header_frame" + + append output $header_frame\n } set r 0 set rmax [expr {[llength $cells]-1}] + + + set blims_mid $boxlimits + set blims_top $boxlimits + set blims_top_headerless $boxlimits_headerless + if {![dict get $o_opts_table -show_separators]} { + foreach el $midseps { + set elposn [lsearch $blims_mid $el] + if {$elposn >= 0} { + set blims_mid [lremove $blims_mid $elposn] + } + } + foreach el $topseps { + set elposn [lsearch $blims_top $el] + if {$elposn >= 0} { + set blims_top [lremove $blims_top $elposn] + } + set elposn [lsearch $blims_top_headerless $el] + if {$elposn >= 0} { + set blims_top_headerless [lremove $blims_top_headerless $elposn] + } + } + } + + set colidx [lindex [dict keys $o_columndefs] $index_expression] ;#convert possible end-1,2+2 etc expression to >= 0 integer in dict range + + set opt_col_ansibase [dict get $o_columndefs $colidx -ansibase] ;#ordinary merge of codes already done in configure_column + + set body_ansibase [dict get $o_opts_table -ansibase_body] + set ansibase $body_ansibase$opt_col_ansibase ;#allow col to override body + set body_ansiborder [dict get $o_opts_table -ansiborder_body] + if {[dict get $o_opts_table -frametype] eq "block"} { + #block is the only style where bg colour can fill the frame content area exactly if the L-shaped border elements are styled + #we need to only accept background ansi codes from the columndef ansibase for this + set col_bg [punk::ansi::codetype::sgr_merge [list $opt_col_ansibase] -filter_fg 1] ;#special merge for block borders - don't override fg colours + set border_ansi $body_ansibase$body_ansiborder$col_bg + } else { + set border_ansi $body_ansibase$body_ansiborder + } + set r 0 foreach c $cells { #todo - joinleft,joinright,joindown based on opts in args #append output [textblock::frame -boxlimits {vll blc hlb} $c]\n + if {[dict get $o_opts_table -frametype] eq "block"} { + set row_ansibase [dict get $o_rowdefs $r -ansibase] + set row_bg "" + if {$row_ansibase ne ""} { + set row_bg [punk::ansi::codetype::sgr_merge [list $row_ansibase] -filter_fg 1] + } + set border_ansi_final $border_ansi$row_bg + } else { + set border_ansi_final $border_ansi + } + if {$r == 0} { if {$r == $rmax} { - set joins [lremove $joins [lsearch $joins down]] - } - if {$do_show_header} { - append output [textblock::frame -boxlimits $boxlimits -joins $joins $c]\n + set joins [lremove $joins [lsearch $joins down*]] + set bmap $onlymap + if {$do_show_header} { + set blims $boxlimits + } else { + set blims $boxlimits_headerless + } } else { - append output [textblock::frame -boxlimits $boxlimits_headerless -joins $joins $c]\n + set bmap $topmap + if {$do_show_header} { + set blims $blims_top + } else { + set blims $blims_top_headerless + } } + append output [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n } else { if {$r == $rmax} { - set joins [lremove $joins [lsearch $joins down]] + set joins [lremove $joins [lsearch $joins down*]] + set bmap $botmap + set blims $boxlimits + } else { + set bmap $midmap + set blims $blims_mid ;#will only be reduced from boxlimits if -show_separators was processed above } - append output [textblock::frame -boxlimits $boxlimits -joins $joins $c]\n + append output [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n } incr r } + #return empty (zero content height) row if no rows + if {![llength $cells]} { + set joins [lremove $joins [lsearch $joins down*]] + #we need to know the width of the column to setup the empty cell properly + #(we didn't need it above because get_column_cells_by_index returned values of the correct width) + #even if no header displayed - we should take account of any defined column widths + set colwidth [my column_width $index_expression] + #note that if show_edge is 0 - then for this empty line - we will not see any vertical bars + #This is because the frame with no data is made entirely of corner elements + if {$do_show_header} { + append output [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $boxlimits -boxmap $onlymap -joins $joins]\n + } else { + append output [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $boxlimits_headerless -boxmap $onlymap -joins $joins] \n + } + } return [string trimright $output \n] } - method get_column_cells_by_index {i} { - set cidx [lindex [dict keys $o_columndefs] $i] + method get_column_cells_by_index {index_expression} { + set cidx [lindex [dict keys $o_columndefs] $index_expression] if {$cidx eq ""} { set range "" if {[dict size $o_columndefs] > 0} { - set range "0..[expr {[dict size $o_columndefs] -1}] + set range "0..[expr {[dict size $o_columndefs] -1}]" + } else { + set range empty } - error "table::get_column_by_index no such index $i valid range is $range" + error "table::get_column_cells_by_index no such index $index_expression. Valid range is $range" } + #assert cidx is integer >=0 set cdef [dict get $o_columndefs $cidx] set t [dict get $cdef -header] ;#may be empty string set items [dict get $o_columndata $cidx] - set defminw [dict get $cdef -minwidth] - set defmaxw [dict get $cdef -maxwidth] - set defstyle [dict get $cdef -style] - set stylecodes "" - if {$defstyle ne ""} { - set stylecodes [punk::ansi::a+ {*}$defstyle] - } + set ansibase_body [dict get $o_opts_table -ansibase_body] + set ansibase_col [dict get $cdef -ansibase] + set RST [punk::ansi::a] - if {"$defminw$defmaxw" ne "" && $defminw eq $defmaxw} { - #an exact width is defined for the column - no need to look at data width - set colwidth $defminw - } else { - #todo - predetermine if any items in column contain newlines and are truncated vertically due to o_rowdefs configuration. - #if so - a truncated line shouldn't be included in our width calculation - set widest [tcl::mathfunc::max {*}[lmap v [concat [list $t] $items] {textblock::width $v}]] - if {$defminw eq ""} { - if {$defmaxw eq ""} { - set colwidth $widest - } else { - set colwidth [expr {min(1,$defmaxw,$widest)}] - } - } else { - if {$defmaxw eq ""} { - set colwidth [expr {max($defminw,$widest)}] - } else { - if {$widest < $defminw} { - set colwidth $defminw - } else { - if {$widest > $defmaxw} { - set colwidth $defmaxw - } else { - set colwidth [expr {max($defminw,$widest)}] - } - } - } - } - } + set colwidth [my column_width $cidx] + set ansibase_header [dict get $o_opts_table -ansibase_header] set cell_line_blank [string repeat " " $colwidth] + set header_underlay $ansibase_header$cell_line_blank set output [dict create] if {$t ne ""} { - dict set output header [overtype::left $cell_line_blank $t] + dict set output header [overtype::left -experimental test_mode $header_underlay $ansibase_header$t] } else { - dict set output header $cell_line_blank + dict set output header $header_underlay } - + dict set output cells [list];#ensure we return something for cells key if no items in list set r 0 foreach cval $items { + set opt_row_ansibase [dict get $o_rowdefs $r -ansibase] + set cell_ansibase $ansibase_body$ansibase_col$opt_row_ansibase + + #todo move to row_height method set maxdataheight [dict get $o_rowstates $r -maxheight] set rowdefminh [dict get $o_rowdefs $r -minheight] set rowdefmaxh [dict get $o_rowdefs $r -maxheight] @@ -367,44 +909,141 @@ namespace eval textblock { } } } - if {$stylecodes ne ""} { - set cval $stylecodes$cval - } + set cval $cell_ansibase$cval ;#no reset set cell_lines [lrepeat $rowh $cell_line_blank] set cell_blank [join $cell_lines \n] set cval_lines [split $cval \n] set cval_lines [lrange $cval_lines 0 $rowh-1] set cval_block [join $cval_lines \n] #TODO! fix overtype library - set cell [overtype::left -experimental test_mode $cell_blank $cval_block] + set cell [overtype::left -experimental test_mode $cell_ansibase$cell_blank$RST $cval_block] dict lappend output cells $cell incr r } return $output } + method get_column_values_by_index {index_expression} { + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + return + } + return [dict get $o_columndata $cidx] + } method debug {} { puts stdout "rowdefs: $o_rowdefs" puts stdout "rowstates: $o_rowstates" puts stdout "columndefs: $o_columndefs" + dict for {k coldef} $o_columndefs { + if {[dict exists $o_columndata $k]} { + set header [dict get $coldef -header] + set coldata [dict get $o_columndata $k] + set colinfo "rowcount: [llength $coldata]" + set widest [tcl::mathfunc::max {*}[lmap v [concat [list $header] $coldata] {textblock::width $v}]] + append colinfo " widest: $widest" + } else { + set colinfo "WARNING - no columndata record for column key '$k'" + } + puts stdout "column $k columndata info: $colinfo" + } } - method print {args} { - if {![llength $args]} { - set cols [dict keys $o_columndata] + method column_width {index_expression} { + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + return + } + #assert cidx is now >=0 integer within the range of defined columns + set cdef [dict get $o_columndefs $cidx] + set defminw [dict get $cdef -minwidth] + set defmaxw [dict get $cdef -maxwidth] + if {"$defminw$defmaxw" ne "" && $defminw eq $defmaxw} { + #an exact width is defined for the column - no need to look at data width + set colwidth $defminw } else { - set cols [list] - foreach colspec $args { - set allcols [dict keys $o_columndata] - if {[string first .. $colspec] >=0} { - set parts [punk::ansi::ta::_perlish_split {\.\.} $colspec] - if {[llength $parts] != 3} { - error "[namespace::current]::table error invalid print specification '$colspec'" - } - lassign $parts from _dd to - if {$from eq ""} { - set from 0 - } - if {$to eq ""} { + set widest [my column_datawidth $cidx -header 1 -data 1 -footer 1] + #todo - predetermine if any items in column contain newlines and are truncated vertically due to o_rowdefs configuration. + #if so - a truncated line shouldn't be included in our width calculation + if {$defminw eq ""} { + if {$defmaxw eq ""} { + set colwidth $widest + } else { + set colwidth [expr {min(1,$defmaxw,$widest)}] + } + } else { + if {$defmaxw eq ""} { + set colwidth [expr {max($defminw,$widest)}] + } else { + if {$widest < $defminw} { + set colwidth $defminw + } else { + if {$widest > $defmaxw} { + set colwidth $defmaxw + } else { + set colwidth [expr {max($defminw,$widest)}] + } + } + } + } + } + return $colwidth + } + method column_datawidth {index_expression args} { + set defaults [dict create\ + -header 0\ + -footer 0\ + -data 1\ + ] + dict for {k v} $args { + switch -- $k { + -header - -footer - -data {} + default { + error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + return + } + #assert cidx is >=0 integer in valid range of keys for o_columndefs + set values [list] + if {[dict get $opts -header]} { + lappend values [dict get $o_columndefs $cidx -header] + } + if {[dict get $opts -data]} { + if {[dict exists $o_columndata $cidx]} { + lappend values {*}[dict get $o_columndata $cidx] + } + } + if {[dict get $opts -footer]} { + lappend values [dict get $o_columndefs $cidx -footer] + } + if {[llength $values]} { + set widest [tcl::mathfunc::max {*}[lmap v $values {textblock::width $v}]] + } else { + set widest 0 + } + return $widest + } + method print {args} { + if {![llength $args]} { + set cols [dict keys $o_columndata] + } else { + set cols [list] + foreach colspec $args { + set allcols [dict keys $o_columndata] + if {[string first .. $colspec] >=0} { + set parts [punk::ansi::ta::_perlish_split {\.\.} $colspec] + if {[llength $parts] != 3} { + error "[namespace::current]::table error invalid print specification '$colspec'" + } + lassign $parts from _dd to + if {$from eq ""} { + set from 0 + } + if {$to eq ""} { set to end } set indices [lrange $allcols $from $to] @@ -463,6 +1102,94 @@ namespace eval textblock { namespace eval ::term::ansi::code::macros::cd {namespace export -clear} } + proc list_as_table {datalist table_or_colcount args} { + set defaults [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_separators \uFFEF\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_separators - -frametype {} + default { + error "unrecognised option '$k'. Known options [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + + set count [llength $datalist] + + set is_new_table 0 + if {[string is integer -strict $table_or_colcount]} { + set cols $table_or_colcount + set is_new_table 1 + #defaults for new table only + if {[dict get $opts -frametype] eq "\uFFEF"} { + dict set opts -frametype "light" + } + if {[dict get $opts -show_edge] eq "\uFFEF"} { + dict set opts -show_edge 1 + } + if {[dict get $opts -show_separators] eq "\uFFEF"} { + dict set opts -show_separators 1 + } + set t [textblock::class::table new -show_header 0 -show_edge [dict get $opts -show_edge] -frametype [dict get $opts -frametype] -show_separators [dict get $opts -show_separators]] + for {set c 0} {$c < $cols} {incr c} { + $t add_column -header c$c + } + } else { + if {[namespace tail [info object class $table_or_colcount]] ne "table"} { + error "textblock::list_as_table error - table_or_colcount must be an integer or an existing table object" + } + set t $table_or_colcount + if {[dict get $opts -frametype] ne "\uFFEF"} { + $t configure -frametype [dict get $opts -frametype] + } + if {[dict get $opts -show_edge] ne "\uFFEF"} { + $t configure -show_edge [dict get $opts -show_edge] + } + $t row_clear + set cols [$t column_count] + } + set full_rows [expr {$count / $cols}] + set last_items [expr {$count % $cols}] + + + set rowdata [list] + set row [list] + set i 0 + if {$full_rows > 0} { + for {set r 0} {$r < $full_rows} {incr r} { + set j [expr {$i + ($cols -1)}] + set row [lrange $datalist $i $j] + incr i $cols + lappend rowdata $row + } + } + if {$last_items > 0} { + set idx [expr {$last_items -1}] + lappend rowdata [lrange $datalist end-$idx end] + } + foreach row $rowdata { + set shortfall [expr {$cols - [llength $row]}] + if {$shortfall > 0} { + set row [concat $row [lrepeat $shortfall ""]] + } + $t add_row $row + } + #puts stdout $rowdata + if {[dict get $opts -return] eq "string"} { + set result [$t print] + if {$is_new_table} { + $t destroy + } + return $result + } else { + return $t + } + } #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) #This can have ansi SGR codes - but to repeat blocks containing ansi-movements, the block should first be rendered to a static output with something like overtype::left @@ -807,7 +1534,7 @@ namespace eval textblock { append out $2frames_a \n set 2frames_b [textblock::join [textblock::frame -ansiborder $cyanb -title "plainpunks" $punks] [textblock::frame -ansiborder $greenb -title "fancypunks" $cpunks]] append out [textblock::frame -title "punks" $2frames_b\n$RST$2frames_a] \n - append out [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type unicode_box_heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"] \n + append out [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"] \n #append out [textblock::frame -title gr $gr0] return $out } @@ -826,10 +1553,87 @@ namespace eval textblock { [>punk . rhs]\ [punk::lib::list_as_lines -- [lrepeat 8 " | "]] } + proc table {args} { + upvar ::textblock::class::opts_table_defaults toptdefaults + set defaults [dict create\ + -rows [list]\ + -headers [list]\ + -return string\ + ] + + + set defaults [dict merge $defaults $toptdefaults] ;# -title -frametype -show_header etc + set opts [dict merge $defaults $args] + # -- --- --- --- + set opt_return [dict get $opts -return] + set opt_rows [dict get $opts -rows] + set opt_headers [dict get $opts -headers] + # -- --- --- --- + set topts [dict create] + set toptkeys [dict keys $toptdefaults] + dict for {k v} $opts { + if {$k in $toptkeys} { + dict set topts $k $v + } + } + set t [textblock::class::table new {*}$topts] + + foreach h $opt_headers { + $t add_column -header $h + } + if {[$t column_count] == 0} { + if {[llength $opt_rows]} { + set r0 [lindex $opt_rows 0] + foreach c $r0 { + $t add_column + } + } + } + foreach r $opt_rows { + $t add_row $r + } + + + + if {$opt_return eq "string"} { + set result [$t print] + $t destroy + return $result + } else { + return $t + } + } proc frame {args} { - set contents [lindex $args end] - set arglist [lrange $args 0 end-1] + + set expect_optval 0 + set argposn 0 + set pmax [expr {[llength $args]-1}] + set has_contents 0 ;#differentiate between empty string and no content supplied + set contents "" + set arglist [list] + foreach a $args { + if {!$expect_optval} { + if {$argposn < $pmax} { + if {[string match -* $a]} { + set expect_optval 1 + lappend arglist $a + } else { + error "textblock::frame expects -option pairs" + } + } else { + set has_contents 1 + set contents $a + } + } else { + lappend arglist $a + set expect_optval 0 + } + incr argposn + } + + #set contents [lindex $args end] + #set arglist [lrange $args 0 end-1] if {[llength $arglist] % 2 != 0} { error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " } @@ -837,12 +1641,14 @@ namespace eval textblock { set defaults [dict create\ -etabs 0\ - -type unicode_box\ + -type light\ -boxlimits [list hl vl tlc blc trc brc]\ + -boxmap {}\ -joins [list]\ -title ""\ -subtitle ""\ -width ""\ + -height ""\ -ansiborder ""\ -ansibase ""\ -align "left"\ @@ -851,7 +1657,7 @@ namespace eval textblock { set opts [dict merge $defaults $arglist] foreach {k v} $opts { switch -- $k { - -etabs - -type - -boxlimits - -joins - -title - -subtitle - -width - -ansiborder - -ansibase - -align - -ellipsis {} + -etabs - -type - -boxlimits - -boxmap - -joins - -title - -subtitle - -width - -height - -ansiborder - -ansibase - -align - -ellipsis {} default { error "frame option '$k' not understood. Valid options are [dict keys $defaults]" } @@ -862,7 +1668,8 @@ namespace eval textblock { set opt_type [dict get $opts -type] set opt_boxlimits [dict get $opts -boxlimits] set opt_joins [dict get $opts -joins] - set known_types [list unicode_box unicode_box_heavy unicode_arc unicode_double ascii altg] + set opt_boxmap [dict get $opts -boxmap] + set known_types [list light heavy arc double block block1 ascii altg] set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "] set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] if {$opt_type ni $known_types} { @@ -886,11 +1693,23 @@ namespace eval textblock { error "frame option -type must be one of known types: $known_types or a dictionary with any of keys hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" } set custom_frame [dict merge $default_custom $opt_type] + set frame_type custom + } else { + set frame_type $opt_type } set is_boxlimits_ok 1 + set exact_boxlimits [list] foreach v $opt_boxlimits { switch -- $v { - hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + hl { + lappend exact_boxlimits hlt hlb + } + vl { + lappend exact_boxlimits vll vlr + } + hlt - hlb - vll - vlr - tlc - trc - blc - brc { + lappend exact_boxlimits $v + } default { #k not in custom_keys set is_boxlimits_ok 0 @@ -901,10 +1720,20 @@ namespace eval textblock { if {!$is_boxlimits_ok} { error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" } + set exact_boxlimits [lsort -unique $exact_boxlimits] + set is_joins_ok 1 foreach v $opt_joins { - switch -- $v { - left - left-light - right - right-light - up - up-light - down - down-light {} + lassign [split $v -] direction target + switch -- $direction { + left - right - up - down {} + default { + set is_joins_ok 0 + break + } + } + switch -- $target { + "" - light - heavy - ascii - altg - arc - double - custom - block - block1 {} default { set is_joins_ok 0 break @@ -912,7 +1741,20 @@ namespace eval textblock { } } if {!$is_joins_ok} { - error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down" + error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" + } + set is_boxmap_ok 1 + dict for {boxelement subst} $opt_boxmap { + switch -- $boxelement { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + default { + set is_boxmap_ok 0 + break + } + } + } + if {!$is_boxmap_ok} { + error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" } #sorted order down left right up #1 x choose 4 @@ -921,13 +1763,13 @@ namespace eval textblock { #4 x choose 1 #15 combos set join_directions [list] - #modifiers - light,heavy (double?) - seem to be some required glyphs missing from unicode + #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode #e.g down-light, up-heavy - set join_modifiers [dict create left "" down "" right "" up ""] + set join_targets [dict create left "" down "" right "" up ""] foreach jt $opt_joins { - lassign [split $jt -] direction modifier - if {$modifier ne ""} { - dict set join_modifiers $direction $modifier + lassign [split $jt -] direction target + if {$target ne ""} { + dict set join_targets $direction $target } lappend join_directions $direction } @@ -939,6 +1781,7 @@ namespace eval textblock { set opt_title [dict get $opts -title] set opt_subtitle [dict get $opts -subtitle] set opt_width [dict get $opts -width] + set opt_height [dict get $opts -height] # -- --- --- --- --- --- set opt_align [dict get $opts -align] set opt_align [string tolower $opt_align] @@ -955,19 +1798,25 @@ namespace eval textblock { set opt_ellipsis [dict get $opts -ellipsis] # -- --- --- --- --- --- - if {[string last \t $contents] >= 0} { - if {[info exists punk::console::tabwidth]} { - set tw $::punk::console::tabwidth - } else { - set tw 8 - } - if {$opt_etabs} { - set contents [textutil::tabify::untabify2 $contents $tw] + if {$has_contents} { + if {[string last \t $contents] >= 0} { + if {[info exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + if {$opt_etabs} { + set contents [textutil::tabify::untabify2 $contents $tw] + } } + set contents [string map [list \r\n \n] $contents] + set actual_contentwidth [textblock::width $contents] + set actual_contentheight [textblock::height $contents] + } else { + set actual_contentwidth 0 + set actual_contentheight 0 } - set contents [string map [list \r\n \n] $contents] - set actual_contentwidth [width $contents] if {$opt_title ne ""} { set titlewidth [punk::ansi::printing_length $opt_title] set content_or_title_width [expr {max($actual_contentwidth,$titlewidth)}] @@ -976,14 +1825,24 @@ namespace eval textblock { set content_or_title_width $actual_contentwidth } - if {[$opt_width eq ""]} { + if {$opt_width eq ""} { set contentwidth $content_or_title_width } else { - set contentwidth [expr {$opt_width -2}] ;#default + set contentwidth [expr {max(0,$opt_width - 2)}] ;#default + } + + if {$opt_height eq ""} { + set contentheight $actual_contentheight + } else { + set contentheight [expr {max(0,$opt_height -2)}] ;#default + } + if {$contentheight == 0} { + set has_contents 0 } #todo - render it with vertical overflow so we can process ansi moves? - set linecount [textblock::height $contents] + #set linecount [textblock::height $contents] + set linecount $contentheight set rst [a] #set column [string repeat " " $contentwidth] ;#default - may need to override for custom frame set underlayline [string repeat " " $contentwidth] @@ -992,7 +1851,12 @@ namespace eval textblock { set vll_width 1 ;#default for all except custom (printing width) set vlr_width 1 - switch -- $opt_type { + #unicode box drawing only provides enough characters for seamless joining of unicode boxes light and heavy. + #e.g with characters such as \u2539 Box Drawings Right Light and Left Up Heavy. + #the double glyphs in box drawing can do a limited set of joins to light lines - but not enough for seamless table layouts. + #the arc set can't even join to itself e.g with curved equivalents of T-like shapes + #I guess + switch -- $frame_type { "altg" { #old style ansi escape sequences with alternate graphics page G0 set hl [cd::hl] @@ -1005,9 +1869,108 @@ namespace eval textblock { set trc [cd::trc] set blc [cd::blc] set brc [cd::brc] - set tbar [string repeat $hl $contentwidth] - set tbar [cd::groptim $tbar] - set bbar $tbar + #No join targets available to join altg to other box styles + switch -- $do_joins { + down { + #1 + set blc [punk::ansi::g0 t] ;#(ltj) + set brc [punk::ansi::g0 u] ;#(rtj) + } left { + #2 + set tlc [punk::ansi::g0 w] ;#(ttj) + set blc [punk::ansi::g0 v] ;#(btj) + } + right { + #3 + set trc [punk::ansi::g0 w] ;#(ttj) + set brc [punk::ansi::g0 v] ;#(btj) + } + up { + #4 + set tlc [punk::ansi::g0 t] ;#(ltj) + set trc [punk::ansi::g0 u] ;#(rtj) + } + down_left { + #5 + set blc [punk::ansi::g0 n] ;#(fwj) + set tlc [punk::ansi::g0 w] ;#(ttj) + set brc [punk::ansi::g0 u] ;#(rtj) + } + down_right { + #6 + set blc [punk::ansi::g0 t] ;#(ltj) + set trc [punk::ansi::g0 w] ;#(ttj) + set brc [punk::ansi::g0 n] ;#(fwj) + } + down_up { + #7 + set blc [punk::ansi::g0 t] ;#(ltj) + set brc [punk::ansi::g0 u] ;#(rtj) + + set tlc [punk::ansi::g0 t] ;#(ltj) + set trc [punk::ansi::g0 u] ;#(rtj) + } + left_right { + #8 + #from 2 + set tlc [punk::ansi::g0 w] ;#(ttj) + set blc [punk::ansi::g0 v] ;#(btj) + #from3 + set trc [punk::ansi::g0 w] ;#(ttj) + set brc [punk::ansi::g0 v] ;#(btj) + } + left_up { + #9 + set tlc [punk::ansi::g0 n] ;#(fwj) + set trc [punk::ansi::g0 u] ;#(rtj) + set blc [punk::ansi::g0 v] ;#(btj) + } + right_up { + #10 + set tlc [punk::ansi::g0 t] ;#(ltj) + set trc [punk::ansi::g0 n] ;#(fwj) + set brc [punk::ansi::g0 v] ;#(btj) + } + down_left_right { + #11 + set blc [punk::ansi::g0 n] ;#(fwj) + set brc [punk::ansi::g0 n] ;#(fwj) + set trc [punk::ansi::g0 w] ;#(ttj) + set tlc [punk::ansi::g0 w] ;#(ttj) + } + down_left_up { + #12 + set tlc [punk::ansi::g0 n] ;#(fwj) + set blc [punk::ansi::g0 n] ;#(fwj) + set trc [punk::ansi::g0 u] ;#(rtj) + set brc [punk::ansi::g0 u] ;#(rtj) + + } + down_right_up { + #13 + set tlc [punk::ansi::g0 t] ;#(ltj) + set blc [punk::ansi::g0 t] ;#(ltj) + set trc [punk::ansi::g0 n] ;#(fwj) + set brc [punk::ansi::g0 n] ;#(fwj) + } + left_right_up { + #14 + set tlc [punk::ansi::g0 n] ;#(fwj) + set trc [punk::ansi::g0 n] ;#(fwj) + set blc [punk::ansi::g0 v] ;#(btj) + set brc [punk::ansi::g0 v] ;#(btj) + + } + down_left_right_up { + #15 + set tlc [punk::ansi::g0 n] ;#(fwj) + set blc [punk::ansi::g0 n] ;#(fwj) + set trc [punk::ansi::g0 n] ;#(fwj) + set brc [punk::ansi::g0 n] ;#(fwj) + } + } + + } "ascii" { set hl - @@ -1020,10 +1983,8 @@ namespace eval textblock { set trc + set blc + set brc + - set tbar [string repeat - $contentwidth] - set bbar $tbar } - "unicode_box" { + "light" { #unicode box drawing set set hl [punk::char::charshort boxd_lhz] ;# light horizontal set hlt $hl @@ -1039,39 +2000,76 @@ namespace eval textblock { #sort order: down left right up #ltj,rtj,ttj,btj e.g left T junction etc. #Look at from the perspective of a frame/table outline with a clean border and arms pointing inwards + + #set targetdown,targetleft,targetright,targetup vars + #default empty targets to current box type 'light' + foreach dir {down left right up} { + set target [dict get $join_targets $dir] + switch -- $target { + "" - light { + set target$dir light + } + ascii - altg - arc { + set target$dir light + } + heavy { + set target$dir $target + } + default { + set target$dir other + } + } + } switch -- $do_joins { down { #1 - switch -- [dict get $join_modifiers down] { + switch -- $targetdown { heavy { - set blc [punk::char::charshort boxd_dhrul] ;#down light and right up heavy (ltj) + set blc [punk::char::charshort boxd_dhrul] ;#\u251f down hieavy and right up light (ltj) + set brc \u2527 ;#boxd_dhlul down heavy and left up light (rtj) } - default { + light { set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) } } - set brc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) } left { #2 - set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - joinleft - set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + switch -- $targetleft { + heavy { + set tlc \u252d ;# Left Heavy and Right Down Light (ttj) + set blc \u2535 ;# Left Heavy and Right Up Light (btj) + } + light { + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - joinleft + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + } } right { #3 - set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + switch -- $targetright { + heavy { + set trc \u252e ;#Right Heavy and Left Down Light (ttj) + set brc \u2536 ;#Right Heavy and Left up Light (btj) + } + light { + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + } } up { #4 set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) - set trc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) } down_left { #5 - set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - set brc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) } down_right { #6 @@ -1082,155 +2080,398 @@ namespace eval textblock { down_up { #7 set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) - set brc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + } + left_right { + #8 + #from 2 + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - joinleft + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + #from3 + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + left_up { + #9 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + right_up { + #10 + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + down_left_right { + #11 + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + + } + down_left_up { + #12 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + + } + down_right_up { + #13 + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + } + left_right_up { + #14 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + + } + down_left_right_up { + #15 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + } + } + #four way junction (cd::fwj) (punk::ansi::g0 n) (punk::char::charshort lvhz) (+) + } + "heavy" { + #unicode box drawing set + set hl [punk::char::charshort boxd_hhz] ;# light horizontal + set hlt $hl + set hlb $hl + set vl [punk::char::charshort boxd_hv] ;#light vertical + set vll $vl + set vlr $vl + set tlc [punk::char::charshort boxd_hdr] + set trc [punk::char::charshort boxd_hdl] + set blc [punk::char::charshort boxd_hur] + set brc [punk::char::charshort boxd_hul] + #set targetdown,targetleft,targetright,targetup vars + #default empty targets to current box type 'heavy' + foreach dir {down left right up} { + set target [dict get $join_targets $dir] + switch -- $target { + "" - heavy { + set target$dir heavy + } + light - ascii - altg - arc { + set target$dir light + } + default { + set target$dir other + } + } + } + switch -- $do_joins { + down { + #1 + switch -- $targetdown { + light { + set blc [punk::char::charshort boxd_dlruh] ;#\u2521 down light and right up heavy (ltj) + set brc [punk::char::charshort boxd_dlluh] ;#\u2529 down light and left up heavy (rtj) + } + heavy { + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + } + } + } + left { + #2 + switch -- $targetleft { + light { + set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) + set blc [punk::char::charshort boxd_llruh] ;#\u253a Left Light and Right Up Heavy (btj) + } + heavy { + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + } + } + } + right { + #3 + switch -- $targetright { + light { + set trc [punk::char::charshort boxd_rlldh] ;#\u2531 Right Light and Left Down Heavy (ttj) + set brc [punk::char::charshort boxd_rlluh] ;#\u2539 Right Light and Left Up Heavy(btj) + } + heavy { + set trc [punk::char::charshort boxd_hdhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + } + } + } + up { + #4 + switch -- $targetup { + light { + set tlc [punk::char::charshort boxd_ulrdh] ;#\u2522 Up Light and Right Down Heavy (ltj) + set trc [punk::char::charshort boxd_ulldh] ;#\u252a Up Light and Left Down Heavy (rtj) + } + heavy { + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + } + } + } + down_left { + #down_left is the main join type used for 'L' shaped cell border table building where we boxlimit to {vll hlb blc} + #5 + switch -- down-$targetdown-left-$targetleft { + down-light-left-heavy { + set blc [punk::char::charshort boxd_dluhzh] ;#down light and up horizontal heavy (fwj) + set brc [punk::char::charshort boxd_dlluh] ;#\u2529 down light and left up heavy (rtj) + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) (at tlc down stays heavy) + } + down-heavy-left-light { + set blc [punk::char::charshort boxd_llrvh] ;# left light and right Vertical Heavy (fwj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) (at brc left must stay heavy) + set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) + } + down-light-left-light { + set blc [punk::char::charshort boxd_ruhldl] ;#\u2544 right up heavy and left down light (fwj) + set brc [punk::char::charshort boxd_dlluh] ;#\u2529 Down Light and left Up Heavy (rtj) (left must stay heavy) + set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) (we are in heavy - so down must stay heavy at tlc) + } + down-heavy-left-heavy { + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + } + down-other-left-heavy { + set blc \u253b ;#boxd_huhz Heavy Up and Horizontal (btj) + #leave brc default corner + set tlc \u2533 ;#hdhz Heavy Down and Horizontal (ttj) + + } + down-other-left-light { + set blc \u253a ;#llruh Left Light and Right Up Heavy (btj) + #leave brc default corner + set tlc \u2532 ;#llrdh Left Light and Right Down Heavy (ttj) + } + down-heavy-left-other { + set blc \u2523 ;#hvr Heavy Vertical and Right (ltj) + set brc \u252b ;#hvl Heavy Veritcal and Left (rtj) + #leave tlc default corner + } + down-light-left-other { + set blc \u2521 ;#dlruh Down Light and Right Up Heavy (ltj) + set brc \u2529 ;#dlluh Down Light and Left Up Heavy (rtj) + #leave tlc default corner + } + } + } + down_right { + #6 + set blc [punk::char::charshort boxd_hvr] ;# (ltj) (blc right&up stay heavy) + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) (tlc down&left stay heavy) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) (brc left&up heavy) + } + down_up { + #7 + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) - set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) - set trc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) } left_right { #8 #from 2 - set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - joinleft - set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) #from3 - set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) } left_up { #9 - set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set trc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) - set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) } right_up { #10 - set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) - set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) } down_left_right { #11 - set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) } down_left_up { #12 - set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set trc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) - set brc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) } down_right_up { #13 - set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) - set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) - set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) } left_right_up { #14 - set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) - set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) } down_left_right_up { #15 - set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) - set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) } } - - set tbar [string repeat $hl $contentwidth] - set bbar $tbar - #four way junction (cd::fwj) (punk::ansi::g0 n) (punk::char::charshort lvhz) (+) } - "unicode_box_heavy" { + "double" { #unicode box drawing set - set hl [punk::char::charshort boxd_hhz] ;# light horizontal + set hl [punk::char::charshort boxd_dhz] ;# double horizontal \U2550 set hlt $hl set hlb $hl - set vl [punk::char::charshort boxd_hv] ;#light vertical + set vl [punk::char::charshort boxd_dv] ;#double vertical \U2551 set vll $vl set vlr $vl - set tlc [punk::char::charshort boxd_hdr] - set trc [punk::char::charshort boxd_hdl] - set blc [punk::char::charshort boxd_hur] - set brc [punk::char::charshort boxd_hul] + set tlc [punk::char::charshort boxd_ddr] ;#double down and right \U2554 + set trc [punk::char::charshort boxd_ddl] ;#double down and left \U2557 + set blc [punk::char::charshort boxd_dur] ;#double up and right \U255A + set brc [punk::char::charshort boxd_dul] ;#double up and left \U255D + + # \u256c (fwj) + + #set targetdown,targetleft,targetright,targetup vars + #default empty targets to current box type 'double' + foreach dir {down left right up} { + set target [dict get $join_targets $dir] + switch -- $target { + "" - double { + set target$dir double + } + default { + set target$dir other + } + } + } + + #unicode provides no joining for double to anything else + #better to leave a gap by using default double corners if join target is not empty or double switch -- $do_joins { down { #1 - switch -- [dict get $join_modifiers down] { - light { - set blc [punk::char::charshort boxd_dlruh] ;#down light and right up heavy (ltj) - set brc [punk::char::charshort boxd_dlluh] ;#down light and left up heavy (rtj) - } - default { - set blc [punk::char::charshort boxd_hvr] ;# (ltj) - set brc [punk::char::charshort boxd_hvl] ;# (rtj) + switch -- $targetdown { + double { + set blc \u2560 ;# (ltj) + set brc \u2563 ;# (rtj) } } } left { #2 - set tlc [punk::char::charshort boxd_ldhz] ;# (ttj) - set blc [punk::char::charshort boxd_luhz] ;# (btj) + switch -- $targetleft { + double { + set tlc \u2566 ;# (ttj) + set blc \u2569 ;# (btj) + } + } } right { #3 - set trc [punk::char::charshort boxd_hdhz] ;#T shape (ttj) - set brc [punk::char::charshort boxd_huhz] ;# (btj) + switch -- $targetright { + double { + set trc \u2566 ;# (ttj) + set brc \u2569 ;# (btj) + } + } } up { #4 - set tlc [punk::char::charshort boxd_hvr] ;# (ltj) - set trc [punk::char::charshort boxd_hvl] ;# (rtj) + switch -- $targetup { + double { + set tlc \u2560 ;# (ltj) + set trc \u2563 ;# (rtj) + } + } } down_left { #5 - switch -- d-[dict get $join_modifiers down]_l-[dict get $join_modifiers left] { - d-light_l- { - set blc [punk::char::charshort boxd_dluhzh] ;#down light and up horizontal heavy (fwj) - set brc [punk::char::charshort boxd_dlluh] ;#down light and left up heavy (rtj) - } - d-_l-light { - set blc [punk::char::charshort boxd_llrvh] ;# left light and right Vertical Heavy (fwj) - set brc [punk::char::charshort boxd_vhll] ;#vertical heavy and left light (rtj) + switch -- $targetdown-$targetleft { + double-double { + set blc \u256c ;# (fwj) + set brc \u2563 ;# (rtj) + set tlc \u2566 ;# (ttj) } - d-light_l-light { - set blc [punk::char::charshort boxd_ruhldl] ;#right up heavy and left down light (fwj) - set brc [punk::char::charshort boxd_uhldl] ;#up heavy and left down light (rtj) + double-other { + set blc \u2560 ;# (ltj) + set brc \u2563 ;# (rtj) + #leave tlc as ordinary double corner } - default { - set blc [punk::char::charshort boxd_hvhz] ;# (fwj) - set brc [punk::char::charshort boxd_hvl] ;# (rtj) + other-double { + set blc \u2569 ;# (btj) + #leave brc as ordinary double corner + set tlc \u2566 ;# (ttj) } } - set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) } down_right { #6 - set blc [punk::char::charshort boxd_hvr] ;# (ltj) - set trc [punk::char::charshort boxd_hdhz] ;# (ttj) - set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + switch -- $targetdown-$targetright { + double-double { + set blc \u2560 ;# (ltj) + set trc \u2566 ;# (ttj) + set brc \u256c ;# (fwj) + } + double-other { + set blc \u2560 ;# (ltj) + #leave trc default + set brc \u2563 ;# (rtj) + } + other-double { + #leave blc default + set trc \u2566 ;# (ttj) + set brc \u2569 ;#(btj) + } + } } down_up { #7 - set blc [punk::char::charshort boxd_hvr] ;# (ltj) - set brc [punk::char::charshort boxd_hvl] ;# (rtj) - - set tlc [punk::char::charshort boxd_hvr] ;# (ltj) - set trc [punk::char::charshort boxd_hvl] ;# (rtj) + switch -- $targetdown-$targetup { + double-double { + set blc \u2560 ;# (ltj) + set brc \u2563 ;# (rtj) + set tlc \u2560 ;# (ltj) + set trc \u2563 ;# (rtj) + } + } } left_right { #8 + #from 2 set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) set blc [punk::char::charshort boxd_huhz] ;# (btj) @@ -1290,26 +2531,11 @@ namespace eval textblock { } } - set tbar [string repeat $hl $contentwidth] - set bbar $tbar - } - "unicode_double" { - #unicode box drawing set - set hl [punk::char::charshort boxd_dhz] ;# double horizontal \U2550 - set hlt $hl - set hlb $hl - set vl [punk::char::charshort boxd_dv] ;#double vertical \U2551 - set vll $vl - set vlr $vl - set tlc [punk::char::charshort boxd_ddr] ;#double down and right \U2554 - set trc [punk::char::charshort boxd_ddl] ;#double down and left \U2557 - set blc [punk::char::charshort boxd_dur] ;#double up and right \U255A - set brc [punk::char::charshort boxd_dul] ;#double up and left \U255D - set tbar [string repeat $hl $contentwidth] - set bbar $tbar } - "unicode_arc" { + "arc" { #unicode box drawing set + + set hl [punk::char::charshort boxd_lhz] ;# light horizontal set hlt $hl set hlb $hl @@ -1320,35 +2546,173 @@ namespace eval textblock { set trc [punk::char::charshort boxd_ladl] ;#light arc down and left \U256E set blc [punk::char::charshort boxd_laur] ;#light arc up and right \U2570 set brc [punk::char::charshort boxd_laul] ;#light arc up and left \U256F - set tbar [string repeat $hl $contentwidth] - set bbar $tbar + + #set targetdown,targetleft,targetright,targetup vars + #default empty targets to current box type 'arc' + foreach dir {down left right up} { + set target [dict get $join_targets $dir] + switch -- $target { + "" - arc { + set target$dir self + } + default { + set target$dir other + } + } + } + + switch -- $do_joins { + down { + #1 + switch -- $targetdown { + self { + set blc \u251c ;# *light (ltj) + #set blc \u29FD ;# misc math right-pointing curved angle bracket (ltj) - positioned too far left + #set blc \u227b ;# math succeeds char. joins on right ok - gaps top and bottom - almost passable + #set blc \u22b1 ;#math succeeds under relation - looks 'ornate', sits too low to join horizontal + + #set brc \u2524 ;# *light(rtj) + #set brc \u29FC ;# misc math left-pointing curved angle bracket (rtj) + } + } + } + left { + #2 + switch -- $targetleft { + self { + set tlc \u252c ;# *light(ttj) - need a low positioned curved y shape - nothing apparent + #set blc \u2144 ;# (btj) - upside down y - positioning too low for arc + set blc \u2534 ;# *light (btj) + } + } + } + right { + #3 + switch -- $targetright { + self { + set trc \u252c ;# *light (ttj) + #set brc \u2144 ;# (btj) + set brc \u2534 ;# *light (btj) + } + } + } + up { + #4 + switch -- $targetup { + self { + set tlc \u251c ;# *light (ltj) + set trc \u2524 ;# *light(rtj) + } + } + } + down_left { + #5 + switch -- $targetdown-$targetleft { + self-self { + #set blc \u27e1 ;# white concave-sided diamond - positioned too far right + #set blc \u27e3 ;# concave sided diamond with rightwards tick - positioned too low, too right - big gaps + set brc \u2524 ;# *light (rtj) + set tlc \u252c ;# *light (ttj) + } + self-other { + #set blc \u2560 ;# (ltj) + #set brc \u2563 ;# (rtj) + #leave tlc as ordinary double corner + } + other-self { + #set blc \u2569 ;# (btj) + #leave brc as ordinary double corner + #set tlc \u2566 ;# (ttj) + } + } + } + } } - default { + block1 { + set hlt \u2581 ;# lower one eighth block + set hlb \u2594 ;# upper one eighth block + set vll \u258f ;# left one eighth block + set vlr \u2595 ;# right one eighth block + set tlc \u2581 ;# lower one eighth block + set trc \u2581 ;# lower one eighth block + set blc \u2594 ;# upper one eighth block + set brc \u2594 ;# upper one eight block + + } + blockxx { + set hlt \u2594 ;# upper one eighth block + set hlb \u2581 ;# lower one eighth block + set vll \u2595 ;# right one eighth block + set vlr \u258f ;# left one eighth block + + set tlc \u2595 ;# right one eighth block + set trc \u258f ;# left one eighth block + + set blc \u2595 ;# right one eighth block + set brc \u258f ;# left one eighth block + + } + block { + set hlt \u2580 ;#upper half + set hlb \u2584 ;#lower half + set vll \u258c ;#left half + set vlr \u2590 ;#right half + + set tlc \u259b ;#upper left corner half + set trc \u259c + set blc \u2599 + set brc \u259f + } + custom { dict with custom_frame {} ;#extract keys as vars if {[dict exists $custom_frame hlt]} { set hlt [dict get $custom_frame hlt] } else { set hlt $hl } - set hlt_width [punk::ansi::printing_length $hlt] if {[dict exists $custom_frame hlb]} { set hlb [dict get $custom_frame hlb] } else { set hlb $hl } - set hlb_width [punk::ansi::printing_length $hlb] if {[dict exists $custom_frame vll]} { set vll [dict get $custom_frame vll] } else { set vll $vl } - set vll_width [punk::ansi::printing_length $vll] if {[dict exists $custom_frame vlr]} { set vlr [dict get $custom_frame vlr] } else { set vlr $vl } + + + + } + } + + dict for {boxelement sub} $opt_boxmap { + if {$boxelement eq "vl"} { + set vll $sub + set vlr $sub + set hl $sub + } elseif {$boxelement eq "hl"} { + set hlt $sub + set hlb $sub + set hl $sub + } else { + set $boxelement $sub + } + } + + switch -- $frame_type { + custom { + + set vll_width [punk::ansi::printing_length $vll] + set hlb_width [punk::ansi::printing_length $hlb] + set hlt_width [punk::ansi::printing_length $hlt] + set vlr_width [punk::ansi::printing_length $vlr] set tlc_width [punk::ansi::printing_length $tlc] @@ -1378,7 +2742,11 @@ namespace eval textblock { } else { #possibly mixed width chars that make up hlt - string range won't get width right set blank [string repeat " " $tbarwidth] - set count [expr {($tbarwidth / $hlt_width) + 1}] + if {$hlt_width > 0} { + set count [expr {($tbarwidth / $hlt_width) + 1}] + } else { + set count 0 + } set tbar [string repeat $hlt $count] #set tbar [string range $tbar 0 $tbarwidth-1] set tbar [overtype::left -overflow 0 -exposed1 " " -exposed2 " " $blank $tbar];#spaces for exposed halves of 2w chars instead of default replacement character @@ -1387,34 +2755,43 @@ namespace eval textblock { set bbar [string repeat $hlb $bbarwidth] } else { set blank [string repeat " " $bbarwidth] - set count [expr {($bbarwidth / $hlb_width) + 1}] + if {$hlb_width > 0} { + set count [expr {($bbarwidth / $hlb_width) + 1}] + } else { + set count 0 + } set bbar [string repeat $hlb $count] #set bbar [string range $bbar 0 $bbarwidth-1] set bbar [overtype::left -overflow 0 -exposed1 " " -exposed2 " " $blank $bbar] } } + altg { + set tbar [string repeat $hlt $contentwidth] + set tbar [cd::groptim $tbar] + set bbar [string repeat $hlb $contentwidth] + set bbar [cd::groptim $bbar] + } + default { + set tbar [string repeat $hlt $contentwidth] + set bbar [string repeat $hlb $contentwidth] + + } } + set leftborder 0 set rightborder 0 set topborder 0 set bottomborder 0 # hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} - foreach lim $opt_boxlimits { + #puts "----->$exact_boxlimits" + foreach lim $exact_boxlimits { switch -- $lim { - hl { - set topborder 1 - set bottomborder 1 - } hlt { set topborder 1 } hlb { set bottomborder 1 } - vl { - set leftborder 1 - set rightborder 1 - } vll { set leftborder 1 } @@ -1439,11 +2816,16 @@ namespace eval textblock { } } } + if {$opt_width ne "" && $opt_width < 2} { + set rightborder 0 + } #keep lhs/rhs separate? can we do vertical text on sidebars? set lhs [string repeat $vll\n $linecount] set lhs [string range $lhs 0 end-1] set rhs [string repeat $vlr\n $linecount] set rhs [string range $rhs 0 end-1] + + if {$opt_ansiborder ne ""} { set tbar $opt_ansiborder$tbar$rst set bbar $opt_ansiborder$bbar$rst @@ -1456,43 +2838,47 @@ namespace eval textblock { } #boxlimits used for partial borders in table generation - if {"vll" ni $opt_boxlimits && "vl" ni $opt_boxlimits} { - set blank_vll [string repeat " " $vll_width] - set lhs [string repeat $blank_vll\n $linecount] - set lhs [string range $lhs 0 end-1] - } - if {"vlr" ni $opt_boxlimits && "vl" ni $opt_boxlimits} { - set blank_vlr [string repeat " " $vlr_width] - set rhs [string repeat $blank_vlr\n $linecount] - set rhs [string range $rhs 0 end-1] - } - if {"hl" ni $opt_boxlimits && "hlt" ni $opt_boxlimits} { - set bar_width [punk::ansi::printing_length $tbar] - set tbar [string repeat " " $bar_width] - } - if {"tlc" ni $opt_boxlimits} { - set tlc_width [punk::ansi::printing_length $tlc] - set tlc [string repeat " " $tlc_width] - } - if {"trc" ni $opt_boxlimits} { - set trc_width [punk::ansi::printing_length $trc] - set trc [string repeat " " $trc_width] - } - - if {"hl" ni $opt_boxlimits && "hlb" ni $opt_boxlimits} { - set bar_width [punk::ansi::printing_length $bbar] - set bbar [string repeat " " $bar_width] - } - if {"blc" ni $opt_boxlimits} { - set blc_width [punk::ansi::printing_length $blc] - set blc [string repeat " " $blc_width] - } - if {"brc" ni $opt_boxlimits} { - set brc_width [punk::ansi::printing_length $brc] - set brc [string repeat " " $brc_width] + set all_exact_boxlimits [list vll vlr hlt hlb tlc blc trc blc] + set unspecified_limits [struct::set diff $all_exact_boxlimits $exact_boxlimits] + foreach lim $unspecified_limits { + switch -- $lim { + vll { + set blank_vll [string repeat " " $vll_width] + set lhs [string repeat $blank_vll\n $linecount] + set lhs [string range $lhs 0 end-1] + } + vlr { + set blank_vlr [string repeat " " $vlr_width] + set rhs [string repeat $blank_vlr\n $linecount] + set rhs [string range $rhs 0 end-1] + } + hlt { + set bar_width [punk::ansi::printing_length $tbar] + set tbar [string repeat " " $bar_width] + } + tlc { + set tlc_width [punk::ansi::printing_length $tlc] + set tlc [string repeat " " $tlc_width] + } + trc { + set trc_width [punk::ansi::printing_length $trc] + set trc [string repeat " " $trc_width] + } + hlb { + set bar_width [punk::ansi::printing_length $bbar] + set bbar [string repeat " " $bar_width] + } + blc { + set blc_width [punk::ansi::printing_length $blc] + set blc [string repeat " " $blc_width] + } + brc { + set brc_width [punk::ansi::printing_length $brc] + set brc [string repeat " " $brc_width] + } + } } - if {$opt_title ne ""} { set topbar [overtype::centre -overflow 0 -exposed1 " " -exposed2 " " -ellipsis 1 -bias left $tbar $opt_title] ;#overtype supports gx0 on/off } else { @@ -1513,48 +2899,60 @@ namespace eval textblock { #title overrides -boxlimits for topborder set topborder 1 } + set fs "" if {$topborder} { if {$leftborder && $rightborder} { - append fs $tlc$topbar$trc\n + append fs $tlc$topbar$trc } else { if {$leftborder} { - append fs $tlc$topbar\n + append fs $tlc$topbar } elseif {$rightborder} { - append fs $topbar$trc\n + append fs $topbar$trc } else { - append fs $topbar\n + append fs $topbar } } } - set inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $opt_ansibase$contents$rstbase] - if {$leftborder && $rightborder} { - set bodyparts [list $lhs $opt_ansibase$inner$rstbase $rhs] - } else { - if {$leftborder} { - set bodyparts [list $lhs $opt_ansibase$inner$rstbase] - } elseif {$rightborder} { - set bodyparts [list $opt_ansibase$inner$rstbase $rhs] - } else { - set bodyparts [list $opt_ansibase$inner$rstbase] + if {$has_contents || $opt_height > 2} { + if {$topborder && $fs ne ""} { + append fs \n } - } - set body [textblock::join -- {*}$bodyparts] - #set body [textblock::join -- $lhs $opt_ansibase$inner$rstbase $rhs] - append fs $body - if {$opt_subtitle ne ""} { - #subtitle overrides boxlimits for bottomborder - set bottomborder 1 - } - if {$bottomborder} { - if {$leftborder && $rightborder} { - append fs \n$blc$bottombar$brc + #set inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $opt_ansibase$contents$rstbase] + set inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $contents] + if {$leftborder && $rightborder} { + set bodyparts [list $lhs $opt_ansibase$inner$rstbase $rhs] } else { if {$leftborder} { - append fs \n$blc$bottombar + set bodyparts [list $lhs $opt_ansibase$inner$rstbase] } elseif {$rightborder} { - append fs \n$bottombar$brc + set bodyparts [list $opt_ansibase$inner$rstbase $rhs] + } else { + set bodyparts [list $opt_ansibase$inner$rstbase] + } + } + set body [textblock::join -- {*}$bodyparts] + append fs $body + } + + if {$opt_height eq "" || $opt_height > 1} { + if {$opt_subtitle ne ""} { + #subtitle overrides boxlimits for bottomborder + set bottomborder 1 + } + if {$bottomborder} { + if {($topborder & $fs ne "" ) || ($has_contents || $opt_height > 2)} { + append fs \n + } + if {$leftborder && $rightborder} { + append fs $blc$bottombar$brc } else { - append fs \n$bottombar + if {$leftborder} { + append fs $blc$bottombar + } elseif {$rightborder} { + append fs $bottombar$brc + } else { + append fs $bottombar + } } } }