jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

punk pipeline rework - list return, pdict fixes, ansistrip performance

master
Julian Noble 3 months ago
parent
ad3ca5b9a9
commit
c65942ef2e
6 changed files with 214 additions and 57 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 2
      src/modules/patternpunk-1.1.tm
  2. 61
      src/modules/punk-0.1.tm
  3. 39
      src/modules/punk/ansi-999999.0a1.0.tm
  4. 84
      src/modules/punk/lib-999999.0a1.0.tm
  5. 4
      src/modules/punk/mix/commandset/debug-999999.0a1.0.tm
  6. 81
      src/modules/textblock-999999.0a1.0.tm

2
src/modules/patternpunk-1.1.tm
Unescape View File

@ -264,7 +264,7 @@ v_ /|\/ /
} \n] } \n]
>punk .. Method gcross {{size 1} args} { >punk .. Method gcross {{size 1} args} {
package require textblock package require textblock
textblock::gcross $size {*}$args textblock::gcross {*}$args $size
} }
>punk .. Method dumpProperties {{object ::>punk}} { >punk .. Method dumpProperties {{object ::>punk}} {

61
src/modules/punk-0.1.tm
Unescape View File

@ -1395,6 +1395,36 @@ namespace eval punk {
append script \n {set assigned [string length $leveldata]} append script \n {set assigned [string length $leveldata]}
set level_script_complete 1 set level_script_complete 1
} }
%str {
set active_key_type "string"
if $get_not {
error "!%# not string-get is not supported"
}
lappend INDEX_OPERATIONS string-get
append script \n {# set active_key_type "" index_operation: string-get}
append script \n {set assigned $leveldata}
set level_script_complete 1
}
%ansiview {
set active_key_type "string"
if $get_not {
error "!%# not string-ansiview is not supported"
}
lappend INDEX_OPERATIONS string-ansiview
append script \n {# set active_key_type "" index_operation: string-ansiview}
append script \n {set assigned [ansistring VIEW $leveldata]}
set level_script_complete 1
}
%ansiviewstyle {
set active_key_type "string"
if $get_not {
error "!%# not string-ansiviewstyle is not supported"
}
lappend INDEX_OPERATIONS string-ansiviewstyle
append script \n {# set active_key_type "" index_operation: string-ansiviewstyle}
append script \n {set assigned [ansistring VIEWSTYLE $leveldata]}
set level_script_complete 1
}
@ { @ {
#as this is a stateful list next index operation - we use not (!@) to mean there is no element at the next index (instead of returning the complement ie all elements except next) #as this is a stateful list next index operation - we use not (!@) to mean there is no element at the next index (instead of returning the complement ie all elements except next)
#This is in contrast to other not operations on indices e.g /!2 which returns all elements except that at index 2 #This is in contrast to other not operations on indices e.g /!2 which returns all elements except that at index 2
@ -1849,7 +1879,7 @@ namespace eval punk {
# set active_key_type "dict" index_operation: globvalue-get-keys-not # set active_key_type "dict" index_operation: globvalue-get-keys-not
set assigned [list] set assigned [list]
tcl::dict::for {k v} $leveldata { tcl::dict::for {k v} $leveldata {
if {![string match <keyglob> $v]} { if {![string match "<keyglob>" $v]} {
lappend assigned $k lappend assigned $k
} }
} }
@ -1860,7 +1890,7 @@ namespace eval punk {
# set active_key_type "dict" index_operation: globvalue-get-keys # set active_key_type "dict" index_operation: globvalue-get-keys
set assigned [list] set assigned [list]
tcl::dict::for {k v} $leveldata { tcl::dict::for {k v} $leveldata {
if {[string match <keyglob> $v]} { if {[string match "<keyglob>" $v]} {
lappend assigned $k lappend assigned $k
} }
} }
@ -2745,7 +2775,9 @@ namespace eval punk {
#'ismatch' must always be first element of dict - as we dispatch on ismatch 0 or ismatch 1 #'ismatch' must always be first element of dict - as we dispatch on ismatch 0 or ismatch 1
if {![string length $multivar]} { if {![string length $multivar]} {
#treat the absence of a pattern as a match to anything #treat the absence of a pattern as a match to anything
#JMN2 - changed to list based destructuring
return [dict create ismatch 1 result $data setvars {} script {}] return [dict create ismatch 1 result $data setvars {} script {}]
#return [dict create ismatch 1 result [list $data] setvars {} script {}]
} }
set returndict [dict create ismatch 0 result "" setvars {}] set returndict [dict create ismatch 0 result "" setvars {}]
set script "" set script ""
@ -2848,7 +2880,14 @@ namespace eval punk {
if {[string length $v]} { if {[string length $v]} {
dict set returndict_setvars $v $assigned dict set returndict_setvars $v $assigned
} }
lappend assigned_values $assigned
#JMN2
#special case expansion for empty varspec (e.g ,<something> or <something>,,<something>)
#if {$vspec eq ""} {
# lappend assigned_values {*}$assigned
#} else {
lappend assigned_values $assigned
#}
incr i incr i
} }
@ -3374,7 +3413,13 @@ namespace eval punk {
incr i incr i
} }
set returnval [lindex $assigned_values 0] #JMN2
#set returnval [lindex $assigned_values 0]
if {[llength $assigned_values] == 1} {
set returnval [join $assigned_values]
} else {
set returnval $assigned_values
}
#puts stdout "----> > rep returnval: [rep $returnval]" #puts stdout "----> > rep returnval: [rep $returnval]"
@ -3492,6 +3537,8 @@ namespace eval punk {
if {![llength $var_names]} { if {![llength $var_names]} {
#var_name entries can be blank - but it will still be a list #var_name entries can be blank - but it will still be a list
#JMN2
#dict set returndict result [list $data]
dict set returndict result $data dict set returndict result $data
} else { } else {
assert {$i == [llength $var_names]} assertion_fail _multi_bind_result condition {$i == [llength $var_names]} assert {$i == [llength $var_names]} assertion_fail _multi_bind_result condition {$i == [llength $var_names]}
@ -4764,7 +4811,9 @@ namespace eval punk {
} }
#set forward_result $segment_result #set forward_result $segment_result
#JMN2
set previous_result $segment_result set previous_result $segment_result
#set previous_result [join $segment_result]
} else { } else {
debug.punk.pipe {[a+ cyan bold]End of pipe segments ($i)[a]} 4 debug.punk.pipe {[a+ cyan bold]End of pipe segments ($i)[a]} 4
#output pipe spec at tail of pipeline #output pipe spec at tail of pipeline
@ -4783,12 +4832,16 @@ namespace eval punk {
#the segment_result is based on the leftmost var on the lhs of the .= #the segment_result is based on the leftmost var on the lhs of the .=
#whereas forward_result is always the entire output of the segment #whereas forward_result is always the entire output of the segment
#JMN2
#lappend segment_result_list [join $segment_result]
lappend segment_result_list $segment_result lappend segment_result_list $segment_result
incr i incr i
incr j incr j
} ;# end while } ;# end while
return [lindex $segment_result_list end] return [lindex $segment_result_list end]
#JMN2
#return $segment_result_list
#return $forward_result #return $forward_result
} }

39
src/modules/punk/ansi-999999.0a1.0.tm
Unescape View File

@ -2261,7 +2261,15 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set sgr_cache [tcl::dict::create] set sgr_cache [tcl::dict::create]
#sgr_cache clear called by punk::console::ansi when set to off #sgr_cache clear called by punk::console::ansi when set to off
proc sgr_cache {{action ""}} { proc sgr_cache {args} {
set argd [punk::args::get_dict {
-action -default "" -choices "clear"
-pretty -default 1 -help "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output"
*values -min 0 -max 0
} $args]
set action [dict get $argd opts -action]
set pretty [dict get $argd opts -pretty]
variable sgr_cache variable sgr_cache
if {$action ni {"" clear}} { if {$action ni {"" clear}} {
error "sgr_cache action '$action' not understood. Valid actions: clear" error "sgr_cache action '$action' not understood. Valid actions: clear"
@ -2270,6 +2278,10 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set sgr_cache [tcl::dict::create] set sgr_cache [tcl::dict::create]
return "sgr_cache cleared" return "sgr_cache cleared"
} }
if {$pretty} {
return [pdict -channel none sgr_cache */%str,%ansiview]
}
if {[catch { if {[catch {
set termwidth [tcl::dict::get [punk::console::get_size] columns] set termwidth [tcl::dict::get [punk::console::get_size] columns]
} errM]} { } errM]} {
@ -5439,7 +5451,28 @@ tcl::namespace::eval punk::ansi::class {
} }
} }
tcl::namespace::eval punk::ansi { tcl::namespace::eval punk::ansi {
proc stripansi {text} [string map [list <re> $::punk::ansi::ta::re_ansi_split] { proc stripansi {text} {
#ever so slightly slower on short strings - much faster than split_at_codes version for large/complex ansi blocks
if {[punk::ansi::ta::detect_g0 $text]} {
set text [convert_g0 $text];#Convert ansi borders to unicode line drawing instead of ascii letters
}
set parts [punk::ansi::ta::split_codes $text]
set out ""
foreach {pt code} $parts {
append out $pt
}
return $out
}
proc stripansiraw {text} {
#slightly slower on short strings - much faster than split_at_codes version for large/complex ansi blocks
set parts [punk::ansi::ta::split_codes $text]
set out ""
foreach {pt code} $parts {
append out $pt
}
return $out
}
proc stripansi3 {text} [string map [list <re> $::punk::ansi::ta::re_ansi_split] {
#*** !doctools #*** !doctools
#[call [fun stripansi] [arg text] ] #[call [fun stripansi] [arg text] ]
#[para]Return a string with ansi codes stripped out #[para]Return a string with ansi codes stripped out
@ -5459,7 +5492,7 @@ tcl::namespace::eval punk::ansi {
punk::ansi::ta::Do_split_at_codes_join $text {<re>} punk::ansi::ta::Do_split_at_codes_join $text {<re>}
}] }]
proc stripansiraw {text} [string map [list <re> $::punk::ansi::ta::re_ansi_split] { proc stripansiraw3 {text} [string map [list <re> $::punk::ansi::ta::re_ansi_split] {
#*** !doctools #*** !doctools
#[call [fun stripansi] [arg text] ] #[call [fun stripansi] [arg text] ]
#[para]Return a string with ansi codes stripped out #[para]Return a string with ansi codes stripped out

84
src/modules/punk/lib-999999.0a1.0.tm
Unescape View File

@ -696,12 +696,17 @@ namespace eval punk::lib {
} }
## { ## {
dict set pattern_this_structure $pattern_nest dict dict set pattern_this_structure $pattern_nest dict
lappend keyset ## lappend keyset [list ## query]
} }
@* { @* {
dict set pattern_this_structure $pattern_nest list dict set pattern_this_structure $pattern_nest list
lappend keyset {*}[punk::lib::range 0 [llength $dval]-1] lappend keyset {*}[punk::lib::range 0 [llength $dval]-1]
} }
@@ {
#get first k v from dict
dict set pattern_this_structure $pattern_nest dict
lappend keyset [list @@ query]
}
@*k@* - @*K@* { @*k@* - @*K@* {
#returns keys only #returns keys only
lappend keyset [list $p query] lappend keyset [list $p query]
@ -832,7 +837,7 @@ namespace eval punk::lib {
} elseif {$this_type eq "dict"} { } elseif {$this_type eq "dict"} {
#default equivalent to @\*@* #default equivalent to @\*@*
dict set pattern_this_structure $pattern_nest dict dict set pattern_this_structure $pattern_nest dict
puts "dict: appending keys from index '$p' keys: [dict keys $dval $p]" #puts "dict: appending keys from index '$p' keys: [dict keys $dval $p]"
lappend keyset {*}[dict keys $dval $p] lappend keyset {*}[dict keys $dval $p]
} else { } else {
puts stderr "list: unrecognised pattern $p" puts stderr "list: unrecognised pattern $p"
@ -857,6 +862,9 @@ namespace eval punk::lib {
# { # {
set substructure list set substructure list
} }
## {
set substructure dict
}
%# { %# {
set substructure string set substructure string
} }
@ -887,18 +895,21 @@ namespace eval punk::lib {
dict set pattern_next_substructure $pattern_nest $substructure dict set pattern_next_substructure $pattern_nest $substructure
# -- --- --- --- # -- --- --- ---
set int_keyset 1 if {$opt_keysorttype ne "none"} {
foreach k $keyset { set int_keyset 1
if {![string is integer -strict $k]} { foreach k $keyset {
set int_keyset 0 if {![string is integer -strict $k]} {
break set int_keyset 0
break
}
}
if {$int_keyset} {
set keyset [lsort -integer $keyset]
} else {
set keyset [lsort -$opt_keysorttype $keyset]
} }
} }
if {$int_keyset} {
set keyset [lsort -integer $keyset]
} else {
set keyset [lsort -dictionary $keyset]
}
foreach k $keyset { foreach k $keyset {
lappend pattern_key_index $pattern_nest lappend pattern_key_index $pattern_nest
} }
@ -935,11 +946,13 @@ namespace eval punk::lib {
set kidx 0 set kidx 0
foreach keydisplay $display_keys key $filtered_keys { foreach keydisplay $display_keys key $filtered_keys {
set hidekey 0
set pattern_nest [lindex $pattern_key_index $kidx] set pattern_nest [lindex $pattern_key_index $kidx]
set pattern_nest_list [split $pattern_nest /] set pattern_nest_list [split $pattern_nest /]
#puts stderr "---> kidx:$kidx key:$key - pattern_nest:$pattern_nest" #puts stderr "---> kidx:$kidx key:$key - pattern_nest:$pattern_nest"
set this_type [dict get $pattern_this_structure $pattern_nest] set this_type [dict get $pattern_this_structure $pattern_nest]
set is_match 1 ;#whether to display the normal separator or bad-match separator
switch -- $this_type { switch -- $this_type {
dict { dict {
#todo? - slower lsearch if -dupes 1 flag set so we can display duplicate 'keys' if var not a proper dict but rather a dict-shaped list that we want to display as a dict #todo? - slower lsearch if -dupes 1 flag set so we can display duplicate 'keys' if var not a proper dict but rather a dict-shaped list that we want to display as a dict
@ -958,7 +971,7 @@ namespace eval punk::lib {
set nextsub [dict get $pattern_next_substructure $pattern_nest] set nextsub [dict get $pattern_next_substructure $pattern_nest]
if {[llength $pattern_nest_list]} { if {[llength $pattern_nest_list]} {
set nest [lrange $pattern_nest_list 1 end] set nest [lrange $pattern_nest_list 1 end]
lappend nextpatterns [join $nest /] lappend nextpatterns {*}[join $nest /]
} }
set nextopts [dict get $argd opts] set nextopts [dict get $argd opts]
@ -973,7 +986,12 @@ namespace eval punk::lib {
#puts stderr "showdict {*}$nextopts $thisval [lindex $args end]" #puts stderr "showdict {*}$nextopts $thisval [lindex $args end]"
if {[llength $nextpatterns]} { if {[llength $nextpatterns]} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns] if {[catch {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
} errMsg]} {
#puts stderr ">>> nextpatterns:'$nextpatterns' nextopts:'$nextopts'"
set is_match 0
}
} }
} }
list { list {
@ -993,7 +1011,7 @@ namespace eval punk::lib {
set nextsub [dict get $pattern_next_substructure $pattern_nest] set nextsub [dict get $pattern_next_substructure $pattern_nest]
if {[llength $pattern_nest_list]} { if {[llength $pattern_nest_list]} {
set nest [lrange $pattern_nest_list 1 end] set nest [lrange $pattern_nest_list 1 end]
lappend nextpatterns [join $nest /] lappend nextpatterns {*}[join $nest /]
} }
set nextopts [dict get $argd opts] set nextopts [dict get $argd opts]
@ -1004,12 +1022,32 @@ namespace eval punk::lib {
# set nextpatterns * # set nextpatterns *
#} #}
if {[llength $nextpatterns]} { if {[llength $nextpatterns]} {
if {[catch {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns] set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
} errMsg]} {
set is_match 0
}
} }
} }
string { string {
set hidekey 0
if {$key eq "%string"} { if {$key eq "%string"} {
set hidekey 1
set thisval $dval set thisval $dval
} elseif {$key eq "%ansiview"} {
set thisval [ansistring VIEW -lf 1 $dval]
} elseif {$key eq "%ansiviewstyle"} {
set thisval [ansistring VIEWSTYLE -lf 1 $dval]
} elseif {[string match *lpad-* $key]} {
set hidekey 1
lassign [split $key -] _ extra
set width [expr {[textblock::width $dval] + $extra}]
set thisval [textblock::pad $dval -which left -width $width]
} elseif {[string match *rpad-* $key]} {
set hidekey 1
lassign [split $key -] _ extra
set width [expr {[textblock::width $dval] + $extra}]
set thisval [textblock::pad $dval -which right -width $width]
} else { } else {
if {[lindex $key 1] eq "query"} { if {[lindex $key 1] eq "query"} {
set qry [lindex $key 0] set qry [lindex $key 0]
@ -1028,7 +1066,7 @@ namespace eval punk::lib {
set nextsub [dict get $pattern_next_substructure $pattern_nest] set nextsub [dict get $pattern_next_substructure $pattern_nest]
if {[llength $pattern_nest_list]} { if {[llength $pattern_nest_list]} {
set nest [lrange $pattern_nest_list 1 end] set nest [lrange $pattern_nest_list 1 end]
lappend nextpatterns [join $nest /] lappend nextpatterns {*}[join $nest /]
} }
#set nextopts [dict get $argd opts] #set nextopts [dict get $argd opts]
dict set nextopts -roottype $nextsub dict set nextopts -roottype $nextsub
@ -1040,7 +1078,7 @@ namespace eval punk::lib {
} }
} }
if {$this_type eq "string" && $key eq "%string"} { if {$this_type eq "string" && $hidekey} {
lassign [textblock::size $thisval] _vw vwidth _vh vheight lassign [textblock::size $thisval] _vw vwidth _vh vheight
#set blanks_above [string repeat \n [expr {$kheight -1}]] #set blanks_above [string repeat \n [expr {$kheight -1}]]
set vblock $opt_ansibase_values$thisval$RST set vblock $opt_ansibase_values$thisval$RST
@ -1054,9 +1092,17 @@ namespace eval punk::lib {
set totalheight [expr {$kheight + $vheight -1}] set totalheight [expr {$kheight + $vheight -1}]
set blanks_above [string repeat \n [expr {$kheight -1}]] set blanks_above [string repeat \n [expr {$kheight -1}]]
set blanks_below [string repeat \n [expr {$vheight -1}]] set blanks_below [string repeat \n [expr {$vheight -1}]]
set sepwidth [textblock::width $opt_sep]
if {$is_match} {
set use_sep $opt_sep
} else {
set use_sep " [a+ Web-red undercurly underline undert-white]mismatch[a] "
}
set sepwidth [textblock::width $use_sep]
set kblock [textblock::pad $ansibase_key$keydisplay$RST$blanks_below -width $maxl] set kblock [textblock::pad $ansibase_key$keydisplay$RST$blanks_below -width $maxl]
set sblock [textblock::pad $blanks_above$opt_sep$blanks_below -width $sepwidth] set sblock [textblock::pad $blanks_above$use_sep$blanks_below -width $sepwidth]
set vblock $blanks_above$opt_ansibase_values$thisval$RST set vblock $blanks_above$opt_ansibase_values$thisval$RST
#only vblock is ragged - we can do a basic join because we don't care about rhs whitespace #only vblock is ragged - we can do a basic join because we don't care about rhs whitespace
append result [textblock::join_basic -- $kblock $sblock $vblock] \n append result [textblock::join_basic -- $kblock $sblock $vblock] \n

4
src/modules/punk/mix/commandset/debug-999999.0a1.0.tm
Unescape View File

@ -31,7 +31,7 @@ namespace eval punk::mix::commandset::debug {
set out "" set out ""
puts stdout "find_repos output:" puts stdout "find_repos output:"
set pathinfo [punk::repo::find_repos [pwd]] set pathinfo [punk::repo::find_repos [pwd]]
pdict $pathinfo pdict pathinfo
set projectdir [dict get $pathinfo closest] set projectdir [dict get $pathinfo closest]
set modulefolders [lib::find_source_module_paths $projectdir] set modulefolders [lib::find_source_module_paths $projectdir]
@ -39,7 +39,7 @@ namespace eval punk::mix::commandset::debug {
set template_base_dict [punk::mix::base::lib::get_template_basefolders] set template_base_dict [punk::mix::base::lib::get_template_basefolders]
puts stdout "get_template_basefolders output:" puts stdout "get_template_basefolders output:"
pdict $template_base_dict pdict template_base_dict */*
return return
} }

81
src/modules/textblock-999999.0a1.0.tm
Unescape View File

@ -29,6 +29,7 @@ package require textutil
tcl::namespace::eval textblock { tcl::namespace::eval textblock {
#review - what about ansi off in punk::console? #review - what about ansi off in punk::console?
tcl::namespace::import ::punk::ansi::a ::punk::ansi::a+ tcl::namespace::import ::punk::ansi::a ::punk::ansi::a+
tcl::namespace::export block frame frame_cache framedef frametypes gcross height width widthtopline join join_basic list_as_table pad testblock
tcl::namespace::eval class { tcl::namespace::eval class {
variable opts_table_defaults variable opts_table_defaults
@ -3733,7 +3734,6 @@ tcl::namespace::eval textblock {
#Note: A textblock does not necessarily have lines the same length - either in number of characters or print-width #Note: A textblock does not necessarily have lines the same length - either in number of characters or print-width
# #
tcl::namespace::eval textblock { tcl::namespace::eval textblock {
tcl::namespace::export block width
tcl::namespace::eval cd { tcl::namespace::eval cd {
#todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future
tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *}
@ -3799,6 +3799,7 @@ tcl::namespace::eval textblock {
-choices {table tableobject}\ -choices {table tableobject}\
-help "default choice 'table' returns the displayable table output" -help "default choice 'table' returns the displayable table output"
-compact -default 1 -type boolean -help "compact true defaults: -show_vseps 0 -show_header 0 -show_edge 0" -compact -default 1 -type boolean -help "compact true defaults: -show_vseps 0 -show_header 0 -show_edge 0"
-frame -default 1 -type boolean
-show_vseps -default "" -type boolean -show_vseps -default "" -type boolean
-show_header -default "" -type boolean -show_header -default "" -type boolean
-show_edge -default "" -type boolean -show_edge -default "" -type boolean
@ -3950,7 +3951,11 @@ tcl::namespace::eval textblock {
-frametype block -frametype block
if {$opt_return eq "table"} { if {$opt_return eq "table"} {
set output [textblock::frame -ansiborder [a+ {*}$fc Web-black web-cornflowerblue] -type heavy -title "[a+ {*}$fc Web-black] Periodic Table " [$t print]] if {[dict get $opts -frame]} {
set output [textblock::frame -ansiborder [a+ {*}$fc Web-black web-cornflowerblue] -type heavy -title "[a+ {*}$fc Web-black] Periodic Table " [$t print]]
} else {
set output [$t print]
}
$t destroy $t destroy
return $output return $output
} }
@ -6288,33 +6293,44 @@ tcl::namespace::eval textblock {
variable frame_cache variable frame_cache
set frame_cache [tcl::dict::create] set frame_cache [tcl::dict::create]
proc frame_cache {{action ""}} { proc frame_cache {args} {
set argd [punk::args::get_dict {
-action -default "" -choices {clear} -help "Clear the textblock::frame_cache dictionary"
-pretty -default 1 -help "Use 'pdict textblock::frame_cache */*' for prettier output"
*values -min 0 -max 0
} $args]
set action [dict get $argd opts -action]
if {$action ni [list clear ""]} { if {$action ni [list clear ""]} {
error "frame_cache action '$action' not understood. Valid actions: clear" error "frame_cache action '$action' not understood. Valid actions: clear"
} }
variable frame_cache variable frame_cache
set out "" if {[dict get $argd opts -pretty]} {
if {[catch { set out [pdict -chan none frame_cache */*]
set termwidth [tcl::dict::get [punk::console::get_size] columns] } else {
}]} { set out ""
set termwidth 80 if {[catch {
} set termwidth [tcl::dict::get [punk::console::get_size] columns]
}]} {
set termwidth 80
}
tcl::dict::for {k v} $frame_cache { tcl::dict::for {k v} $frame_cache {
lassign $v _f frame _used used lassign $v _f frame _used used
set fwidth [textblock::widthtopline $frame] set fwidth [textblock::widthtopline $frame]
#review - are cached frames uniform width lines? #review - are cached frames uniform width lines?
#set fwidth [textblock::width $frame] #set fwidth [textblock::width $frame]
set frameinfo "$k used:$used " set frameinfo "$k used:$used "
set allinone_width [expr {[tcl::string::length $frameinfo] + $fwidth}] set allinone_width [expr {[tcl::string::length $frameinfo] + $fwidth}]
if {$allinone_width >= $termwidth} { if {$allinone_width >= $termwidth} {
#split across 2 lines #split across 2 lines
append out "$frameinfo\n" append out "$frameinfo\n"
append out $frame \n append out $frame \n
} else { } else {
append out [textblock::join -- $frameinfo $frame]\n append out [textblock::join -- $frameinfo $frame]\n
}
append out \n ;# frames used to build tables often have joins - keep a line in between for clarity
} }
append out \n ;# frames used to build tables often have joins - keep a line in between for clarity
} }
if {$action eq "clear"} { if {$action eq "clear"} {
set frame_cache [tcl::dict::create] set frame_cache [tcl::dict::create]
@ -7038,15 +7054,24 @@ tcl::namespace::eval textblock {
return $fs return $fs
} }
} }
proc gcross {{size 1} args} { proc gcross {args} {
set argd [punk::args::get_dict {
-max_cross_size -default 0 -type integer -help "Largest size cross to use to make up the block
Only cross sizes that divide the size of the overall block will be used.
e.g if the 'size' chosen is 19 (a prime number) - only 1 or the full size of 19 can be used as the crosses to make up the block.
Whereas for a block size of 24, -max_cross_size of 1,2,3,4,6,8,12 or 24 will work. (all divisors)
If a number chosen for -max_cross_size isn't a divisor, the largest divisor below the chosen value will be used.
"
*values -min 1
size -default 1 -type integer
} $args]
set size [dict get $argd values size]
set opts [dict get $argd opts]
if {$size == 0} { if {$size == 0} {
return "" return ""
} }
set defaults [list\
-max_cross_size 0
]
set opts [tcl::dict::merge $defaults $args]
set opt_max_cross_size [tcl::dict::get $opts -max_cross_size] set opt_max_cross_size [tcl::dict::get $opts -max_cross_size]
#set fit_size [punk::lib::greatestOddFactor $size] #set fit_size [punk::lib::greatestOddFactor $size]

Write Preview
Loading…
Cancel
Save