jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
189 Commits
1 Branch
1 Tag
197 MiB
 
 
 
 
 
 
Tree: 7c6ca9b532
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '7c6ca9b532'
${ noResults }
punkshell/src/modules/textblock-999999.0a1.0.tm

3076 lines
140 KiB
Raw Blame History

# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application textblock 999999.0a1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
#package require punk
package require punk::args
package require punk::char
package require punk::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 <data>]] width height
}
#must be able to handle block as string with or without newlines
#if no newlines - attempt to treat as a list
#must handle whitespace-only string,list elements, and/or lines.
#reviewing 2024 - this seems like too much magic!
proc width1 {block} {
if {$block eq ""} {
return 0
}
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 -- <input/0,indent/1|
pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- <input/0,colsize/1|
proc ::textblock::pad {block args} {
set defaults [dict set\
-padchar " "\
-which "right"\
-width ""\
-overflow 0\
]
set usage "pad ?-padchar <character>? ?-which right|left|centre? -width <int>"
foreach {k v} $args {
if {$k ni [dict keys $defaults]} {
error "textblock::pad unrecognised option '$k'. Usage: $usage"
}
}
set opts [dict merge $defaults $args]
# -- --- --- --- --- --- --- --- --- ---
set padchar [dict get $opts -padchar]
# -- --- --- --- --- --- --- --- --- ---
set known_whiches [list l left r right c center centre]
set which [string tolower [dict get $opts -which]]
if {$which in [list centre center]} {set which "c"}
if {$which in [list left]} {set which "l"}
if {$which in [list right]} {set which "r"}
if {$which ni $known_whiches} {
error "textblock::pad unrecognised value for -which option. Known values $known_whiches"
}
# -- --- --- --- --- --- --- --- --- ---
set width [dict get $opts -width]
# -- --- --- --- --- --- --- --- --- ---
if {$width = ""} {
}
}
pipealias ::textblock::join_width .= {list $lhs [string repeat " " $w1] $rhs [string repeat " " $w2]} {|
/2,col1/1,col2/3
>} punk::lib::lines_as_list -- {|
data2
>} .=lhs> punk::lib::lines_as_list -- {|
>} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
>} punk::lib::list_as_lines -- <lhs/0,w1/1,rhs/2,w2/3|
pipealias ::textblock::joinpair .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
/2,col1/1,col2/3
>} .=> punk::lib::lines_as_list -- {|
data2
>} .=lhs> punk::lib::lines_as_list -- {|
>} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
>} punk::lib::list_as_lines -- <lhs/0,rhs/1|
proc ::textblock::join1 {args} {
lassign [punk::args::opts_values {
-ansiresets -default 1 -type integer
blocks -type string -multiple 1
} $args] _o opts _v values
set blocks [dict get $values blocks]
set idx 0
set fordata [list]
foreach b $blocks {
set c($idx) [string repeat " " [width $b]]
lappend fordata "v($idx)" [punk::lib::lines_as_list {*}$opts -- $b]
incr idx
}
set outlines [list]
foreach {*}$fordata {
set row ""
foreach colidx [lsort -integer -increasing [array names c]] {
append row [overtype::left $c($colidx) $v($colidx)]
}
lappend outlines $row
}
return [punk::lib::list_as_lines -- $outlines]
}
#for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed
proc ::textblock::join {args} {
#lassign [punk::lib::opts_values {
# blocks -type string -multiple 1
#} $args] _o opts _v values
#set blocks [dict get $values blocks]
if {[lindex $args 0] eq "--"} {
set blocks [lrange $args 1 end]
} else {
set blocks $args
}
if {![llength $blocks]} {
return
}
set idx 0
set fordata [list]
set colindices [list]
foreach b $blocks {
set c($idx) [string repeat " " [width $b]]
set w($idx) [width $b] ;#we need the width of a rendered block for per-row renderline calls
#fairly commonly a block may be a vertical list of chars e.g something like 1\n2\n3 or -\n-\n-\n-
#for determining a shortcut to avoid unnecessary ta::detect - (e.g width <=1) we can't use result of textblock::width as it strips ansi.
#testing of any decent size block line by line - even with max_string_length_line is slower than ta::detect anyway.
if {[punk::ansi::ta::detect $b]} {
lappend fordata "v($idx)" [punk::lib::lines_as_list -ansiresets 1 -- $b]
} else {
#each block is being rendered into its own empty column - we don't need resets if it has no ansi, even if blocks to left and right do have ansi
lappend fordata "v($idx)" [split $b \n]
}
lappend colindices $idx
incr idx
}
set outlines [list]
#set colindices [lsort -integer -increasing [array names c]]
foreach {*}$fordata {
set row ""
foreach colidx $colindices {
#we know we have a single line, no ansi in underlay and no overflow required - so we can use renderline directly
append row [overtype::renderline -width $w($colidx) -insert_mode 0 -info 0 $c($colidx) $v($colidx)]
}
lappend outlines $row
}
return [::join $outlines \n]
}
proc ::textblock::trim {block} {
set trimlines []
}
pipealias ::textblock::join_right .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
/2,col1/1,col2/3
>} .=> punk::lib::lines_as_list -- {|
data2
>} .=lhs> punk::lib::lines_as_list -- {|
>} .= {lmap v $data w $data2 {val "[overtype::right $col1 $v][overtype::right $col2 $w]"}} {|
>} punk::lib::list_as_lines <lhs/0,rhs/1|
proc example {} {
set pleft [>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 <value> 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|<dict hl (c) vl (c) tlc (c) trc (c) blc (c) brc (c)>? ?-title <ansitext>? ?-subtitle <ansitext>? ?-width <columns>? ?-ansiborder <ansi_sgr>? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? <contents>"
}
#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::<cmd>
# -- --- --- --- --- ---
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 999999.0a1.0
}]
return