@ -106,7 +106,7 @@ namespace eval punk::ansi::class {
#overflow is a different concept - perhaps not particularly congruent with the idea of the textblock as a mini terminal emulator.
#overflow effectively auto-expands the block(terminal?) width
#overflow and wrap both being true won't make sense unless we implement a max_overflow concept
set o_rendered [overtype::left -overflow 0 -wrap 1 -width $w -appendlines 1 "" [$o_ansistringobj get]]
set o_rendered [overtype::left -overflow 0 -wrap 1 -width $w -height $h - appendlines 1 "" [$o_ansistringobj get]]
if {$cksum eq "not-done"} {
#if dimensions changed - the checksum won't have been done
set o_rendered_what [$o_ansistringobj checksum]
@ -129,10 +129,41 @@ namespace eval punk::ansi::class {
set o_dimensions $dimensions
set rendered [overtype::left -experimental {test_mode} -overflow 0 -wrap 1 -width $w -appendlines 1 "" [$o_ansistringobj get]]
set rendered [overtype::left -experimental {test_mode} -overflow 0 -wrap 1 -width $w -height $h - appendlines 1 "" [$o_ansistringobj get]]
return $rendered
}
method render_to_input_line {x {minuschar 0}} {
method render_to_input_line {args} {
if {[llength $args] < 1} {
puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x"
}
set x [lindex $args end]
set arglist [lrange $args 0 end-1]
if {[llength $arglist] %2 != 0} {
puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x"
}
set defaults [dict create\
-dimensions 80x24\
-minus 0\
]
dict for {k v} $arglist {
switch -- $k {
-dimensions - -minus { }
default {
puts stderr "render_to_input_line unexpected argument '$k' usage: ?-dimensions WxH? ?-minus charcount? x"
}
}
}
set opts [dict merge $defaults $arglist]
set opt_dimensions [dict get $opts -dimensions]
set opt_minus [dict get $opts -minus]
lassign [split $opt_dimensions x] w h
if {![string is integer -strict $w] || ![string is integer -strict $h] || $w < 1 || $h < 1} {
puts stderr "render_to_input_line WxH width & height must be positive integer values usage: ?-dimensions WxH? ?-minus charcount? x"
}
if {![string is integer -strict $opt_minus]} {
puts stderr "render_to_input_line -minus must be positive integer value representing number of chars to exclude from end. usage: ?-dimensions WxH? ?-minus charcount? x"
}
package require textblock
set lfvis [ansistring VIEW -lf 1 \n]
set maplf [list \n "[a+ green bold reverse]${lfvis}[a]\n"] ;#a mapping to highlight newlines
@ -141,12 +172,12 @@ namespace eval punk::ansi::class {
set rlines [lrange $lines 0 $x]
set chunk [::join $rlines \n]
append chunk \n
if {$minuschar ne "0"} {
set chunk [string range $chunk 0 end-$minuschar ]
if {$opt_ minus ne "0"} {
set chunk [string range $chunk 0 end-$opt_ minus]
}
set rendered [overtype::left -experimental {test_mode} -overflow 0 -wrap 1 -width 80 -appendlines 1 "" $chunk]
set rendered [overtype::left -experimental {test_mode} -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" $chunk]
set marker ""
for {set i 1} {$i <= 80 } {incr i} {
for {set i 1} {$i <= $w } {incr i} {
if {$i % 10 == 0} {
::append marker "|"
} elseif {$i % 5 == 0} {
@ -159,13 +190,19 @@ namespace eval punk::ansi::class {
set xline [lindex $rlines $x]\n
set xlinev [ansistring VIEWSTYLE $xline]
set xlinev [string map $maplf $xlinev]
set xlinedisplay [overtype::left -wrap 1 -width 80 "" $xlinev]
set xlinedisplay [overtype::left -wrap 1 -width $w -height 1 "" $xlinev]
::append rendered \n $xlinedisplay
set chunk [ansistring VIEWSTYLE $chunk]
set chunk [string map $maplf $chunk]
set chunkdisplay [overtype::left -wrap 1 -width 80 "" $chunk]
textblock::join $rendered $chunkdisplay
#keep chunkdisplay narrower - leave at 80 or it will get unwieldy for larger image widths
set chunkdisplay [overtype::left -wrap 1 -width 80 -height 1 "" $chunk]
set renderheight [llength [split $rendered \n]]
set chunkdisplay_lines [split $chunkdisplay \n]
set chunkdisplay_tail [lrange $chunkdisplay_lines end-$renderheight end]
set chunkdisplay_block [join $chunkdisplay_tail \n]
#the input chunk lines are often much longer than the output.. resulting in main content being way up the screen. It's often impractical to view more than the tail of the chunkdisplay.
textblock::join $rendered $chunkdisplay_block
}
method checksum {} {
@ -335,6 +372,43 @@ namespace eval punk::ansi {
]
# --------------------------------------
#comparitive test (performance) string-append vs 2-object (with existing splits) append
proc test_cat1 {ansi1 ansi2} {
#make sure objects have splits
set s1 [ansistring NEW $ansi1]
namespace eval [info object namespace $s1] {my MakeSplit}
set s2 [ansistring NEW $ansi2]
namespace eval [info object namespace $s2] {my MakeSplit}
#operation under test
# --
#standard string append
$s1 append $ansi2
# --
#$s1 append \033\[31mX ;#redX
return $s1
}
proc test_cat2 {ansi1 ansi2} {
#make sure objects have splits
set s1 [ansistring NEW $ansi1]
namespace eval [info object namespace $s1] {my MakeSplit}
set s2 [ansistring NEW $ansi2]
namespace eval [info object namespace $s2] {my MakeSplit}
#operation under test
# --
#ansistring object append
$s1 appendobj $s2
# --
#$s1 append \033\[31mX ;#redX
return $s1
}
# --------------------------------------
#review - We have file possibly encoded directly in another codepage such as 437 - or utf8,utf16 etc, but then still needing post conversion to e.g cp437?
#In testing old ansi graphics files available on the web, some files need encoding {utf-8 cp437} some just cp437
proc readfile {fname {encoding cp437}} {
@ -376,7 +450,7 @@ namespace eval punk::ansi {
}
if {$dimensions eq ""} {
set dimensions 80x26
set dimensions 80x24
}
set ansidata [fcat -encoding $encoding $fname]
@ -2587,6 +2661,9 @@ namespace eval punk::ansi::class {
set codestack [list]
set gx0_state 0 ;#default off
set current_split_index 0 ;#incremented for each pt block, incremented for each code
if {$o_count eq ""} {
set o_count 0
}
foreach {pt code} $o_ansisplits {
lappend o_ptlist $pt
foreach grapheme [punk::char::grapheme_split $pt] {
@ -2594,6 +2671,7 @@ namespace eval punk::ansi::class {
lappend o_sgrstacks $codestack
lappend o_gx0states $gx0_state
lappend o_splitindex $current_split_index
incr o_count
}
#after handling the pt block - incr the current_split_index
incr current_split_index ;#increment for each pt block - whether empty string or not. Indices corresponding to empty PT blocks will therefore not be present in o_splitindex as there were no elements in that ansisplit entry
@ -2605,7 +2683,7 @@ namespace eval punk::ansi::class {
#maintenance warning - dup in append!
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set codestack [list]
set codestack [list "\x1b\[m" ]
lappend o_elements [list sgr $code]
} elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
set codestack [list $code]
@ -2669,7 +2747,7 @@ namespace eval punk::ansi::class {
return 0
}
my MakeSplit
set o_count [my DoCount [join $o_ptlist ""]]
# set o_count [my DoCount [join $o_ptlist ""]]
}
return $o_count
}
@ -2823,15 +2901,16 @@ namespace eval punk::ansi::class {
lappend o_sgrstacks $last_codestack
lappend o_gx0states $last_gx0state
lappend o_splitindex $current_split_index
incr o_count
}
incr o_count [my DoCount $catstr]
# incr o_count [my DoCount $catstr] ;#from before we were doing grapheme split.. review
} else {
if {![llength $o_ansisplits]} {
#if we have an initial string - but no internal split-state because this is our first append and no methods have caused its generation - we can run more efficiently by combining it with the first append
append o_string $catstr ;#append before split and count on whole lot
my MakeSplit
set combined_plaintext [join $o_ptlist ""]
set o_count [my DoCount $combined_plaintext]
my MakeSplit ;#update o_count
# set combined_plaintext [join $o_ptlist ""]
# set o_count [my DoCount $combined_plaintext]
assert {[llength $o_elements] == [llength $o_sgrstacks] && [llength $o_elements] == [llength $o_gx0states] && [llength $o_elements] == [llength $o_splitindex]}
return $o_string
} else {
@ -2841,15 +2920,18 @@ namespace eval punk::ansi::class {
set ptnew ""
set codestack [lindex $o_sgrstacks end]
set gx0_state [lindex $o_gx0states end]
set current_split_index 0
set current_split_index [lindex $o_splitindex end]
#first pt must be merged with last element of o_ptlist
set new_pt_list [list]
foreach {pt code} $newsplits {
lappend o_ptlist $pt
lappend new_pt_ list $pt
append ptnew $pt
foreach grapheme [punk::char::grapheme_split $catstr ] {
foreach grapheme [punk::char::grapheme_split $pt ] {
lappend o_elements [list g $grapheme]
lappend o_sgrstacks $codestack
lappend o_gx0states $gx0_state
lappend o_splitindex $current_split_index
incr o_count
}
incr current_split_index ;#increment 1 of 2 within each loop
if {$code ne ""} {
@ -2858,7 +2940,7 @@ namespace eval punk::ansi::class {
lappend o_splitindex $current_split_index
#maintenance - dup in MakeSplit!
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set codestack [list]
set codestack [list "\x1b\[m" ]
lappend o_elements [list sgr $code]
} elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
set codestack [list $code]
@ -2883,14 +2965,78 @@ namespace eval punk::ansi::class {
incr current_split_index ;#increment 2 of 2
}
}
lset o_ptlist end [string cat [lindex $o_ptlist end] [lindex $new_pt_list 0]]
lappend o_ptlist {*}[lrange $new_pt_list 1 end]
lset o_ansisplits end [string cat [lindex $o_ansisplits end] [lindex $newsplits 0]]
lappend o_ansisplits {*}[lrange $newsplits 1 end]
incr o_count [my DoCount $ptnew]
#if {$o_count eq ""} {
# #we have splits - but didn't count graphemes?
# set o_count [my DoCount [join $o_ptlist ""]] ;#o_ptlist already has ptnew parts
#} else {
# incr o_count [my DoCount $ptnew]
#}
}
}
assert {[llength $o_elements] == [llength $o_sgrstacks] && [llength $o_elements] == [llength $o_gx0states] && [llength $o_elements] == [llength $o_splitindex]}
return $o_string
}
#we are currently assuming that the component strings have complete graphemes ie no split clusters - and therefore we don't attempt to check for and combine at the string catenation points.
#This is 'often'? likely to be true - We don't have grapheme cluster support yet anyway. review.
method appendobj {args} {
if {![llength $o_ansisplits]} {
my MakeSplit
}
foreach a $args {
set ns [info object namespace $a]
upvar ${ns}::o_ansisplits new_ansisplits
upvar ${ns}::o_count new_count
if {![llength $new_ansisplits] || $new_count eq ""} {
namespace eval $ns {my MakeSplit}
}
upvar ${ns}::o_ptlist new_ptlist
upvar ${ns}::o_string new_string
upvar ${ns}::o_elements new_elements
upvar ${ns}::o_sgrstacks new_sgrstacks
upvar ${ns}::o_gx0states new_gx0states
upvar ${ns}::o_splitindex new_splitindex
lset o_ansisplits end [string cat [lindex $o_ansisplits end] [lindex $new_ansisplits 0]]
lappend o_ansisplits {*}[lrange $new_ansisplits 1 end]
lset o_ptlist end [string cat [lindex $o_ptlist end] [lindex $new_ptlist 0]]
lappend o_ptlist {*}[lrange $new_ptlist 1 end]
append o_string $new_string
lappend o_elements {*}$new_elements
#prepend the previous sgr stack to all stacks in the new list.
#This allows us to use only list operations to keep the sgr data valid - but we don't yet make it canonical/flat by examining each for resets etc.
#ie just call sgr_merge_list once now.
set laststack [lindex $o_sgrstacks end]
set mergedtail [punk::ansi::codetype::sgr_merge_list "" {*}$laststack]
foreach n $new_sgrstacks {
lappend o_sgrstacks [list $mergedtail {*}$n]
}
lappend o_gx0states {*}$new_gx0states
#first and last of ansisplits splits merge
set lastidx [lindex $o_splitindex end]
set firstnewidx [lindex $new_splitindex 0]
set diffidx [expr {$lastidx - $firstnewidx}] ;#may be negative
foreach v $new_splitindex {
lappend o_splitindex [expr {$v + $diffidx}]
}
incr o_count $new_count
}
return $o_count
}
#method append_and_render - append and render up to end of appended data at same time
method view {args} {
@ -2941,62 +3087,118 @@ namespace eval punk::ansi::class {
foreach {pt code} $o_ansisplits {
append output [ansistring VIEW {*}$args $pt]
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set displaycode [ansistring VIEW $code]
append output ${whiteb}$displaycode$RST
} elseif {[punk::ansi::codetype::is_gx_open $code]} {
append output ${GX}GX+$RST
} elseif {[punk::ansi::codetype::is_gx_close $code]} {
append output ${GX}GX-$RST
} elseif {[punk::ansi::codetype::is_sgr $code]} {
set displaycode [ansistring VIEW $code]
if {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
#highlight the esc & leftbracket in white as indication there is a leading reset
set cposn [string first ";" $displaycode]
append output ${whiteb}[string range $displaycode 0 $cposn]$RST${greenb}[string range $displaycode $cposn+1 end]$RST
} else {
append output ${greenb}$displaycode$RST
#map DEC cursor_save/restore to CSI version
set code [string map [list \x1b7 \x1b\[s \x1b8 \x1b\[u ] $code]
set c1 [string index $code 0]
set c1c2 [string range $code 0 1]
#set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)}
set leadernorm [string range [string map [list\
\x1b\[ 7CSI\
\x9b 8CSI\
\x1b\] 7OSC\
\x1b\( 7GFX\
\x9d 8OSC\
\x1b 7ESC\
] $c1c2] 0 3] ;#leadernorm is 1st 2 chars mapped to 4char normalised indicator - or is original 2 chars
#we leave the tail of the code unmapped for now
switch -- $leadernorm {
7CSI - 7OSC {
set codenorm [string cat $leadernorm [string range $code 2 end]]
}
} else {
switch -regexp -matchvar matchinfo -- $code\
$re_row_move {
set displaycode [ansistring VIEW $code]
set displaycode [string map [list A "A$arrow_up" B "B$arrow_down"] $displaycode]
append output ${cyanb}$displaycode$RST
}\
$re_col_move {
lassign $matchinfo _match num type
set displaycode [ansistring VIEW $code]
set displaycode [string map [list C "C$arrow_right" D "D$arrow_left" G "G$arrow_lr"] $displaycode]
append output ${cyanb}$displaycode$RST
}\
$re_both_move {
lassign $matchinfo _match row col
set displaycode [ansistring VIEW $code]
if {$col eq ""} {
#row only move
set map [list H "H${arrow_lr}"]
} else {
#row and col move
set map [list H "H${arrow_lr}${arrow_du}"]
7ESC {
set codenorm [string cat $leadernorm [string range $code 1 end]]
}
8CSI - 8OSC {
set codenorm [string cat $leadernorm [string range $code 1 end]]
}
default {
#we haven't made a mapping for this
set codenorm $code
}
}
switch -- $leadernorm {
{7CSI} - {8CSI} {
set param [string range $codenorm 4 end-1]
#puts stdout "--> CSI [string index $leadernorm 0] bit param:$param"
switch -- [string index $codenorm end] {
m {
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set displaycode [ansistring VIEW $code]
append output ${whiteb}$displaycode$RST
} else {
set displaycode [ansistring VIEW $code]
if {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
#highlight the esc & leftbracket in white as indication there is a leading reset
set cposn [string first ";" $displaycode]
append output ${whiteb}[string range $displaycode 0 $cposn]$RST${greenb}[string range $displaycode $cposn+1 end]$RST
} else {
append output ${greenb}$displaycode$RST
}
}
}
A - B {
#row move
set displaycode [ansistring VIEW $code]
set displaycode [string map [list A "A$arrow_up" B "B$arrow_down"] $displaycode]
append output ${cyanb}$displaycode$RST
}
C - D - G {
#set num [string range $codenorm 4 end-1]
set displaycode [ansistring VIEW $code]
set displaycode [string map [list C "C$arrow_right" D "D$arrow_left" G "G$arrow_lr"] $displaycode]
append output ${cyanb}$displaycode$RST
}
H - f {
set params [string range $codenorm 4 end-1]
lassign [split $params {;}] row col
#lassign $matchinfo _match row col
set displaycode [ansistring VIEW $code]
if {$col eq ""} {
#row only move
set map [list H "H${arrow_lr}" f "f${arrow_lr}]
} else {
#row and col move
set map [list H "H${arrow_lr}${arrow_du}" f "${arrow_lr}${arrow_du}"]
}
set displaycode [string map $map $displaycode]
append output ${cyanb}$displaycode$RST
}
s {
append output ${blueb}[ansistring VIEW $code]$RST
}
u {
append output ${blueb_r}[ansistring VIEW $code]$RST
}
default {
append output ${unk}[ansistring VIEW -lf 1 $code]$RST
}
set displaycode [string map $map $displaycode]
append output ${cyanb}$displaycode$RST
}\
$re_cursor_save -\
$re_cursor_save_dec {
append output ${blueb}[ansistring VIEW $code]$RST
}\
$re_cursor_restore -\
$re_cursor_restore_dec {
append output ${blueb_r}[ansistring VIEW $code]$RST
}\
default {
#if the code is a PM (or other encapsulation type code e.g terminated by ST) we want to see linefeeds as visual representation character
append output ${unk}[ansistring VIEW -lf 1 $code]$RST
}
}
7GFX {
switch -- [string index $codenorm 4] {
"0" {
append output ${GX}GX+$RST
}
"B" {
append output ${GX}GX-$RST
}
}
}
7ESC {
append output ${unk}[ansistring VIEW -lf 1 $code]$RST
}
default {
#if the code is a PM (or other encapsulation type code e.g terminated by ST) we want to see linefeeds as visual representation character
append output ${unk}[ansistring VIEW -lf 1 $code]$RST
}
}
}
return $output
}
