@ -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 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 effectively auto-expands the block(terminal?) width
#overflow and wrap both being true won't make sense unless we implement a max_overflow concept #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 {$cksum eq "not-done"} {
#if dimensions changed - the checksum won't have been done #if dimensions changed - the checksum won't have been done
set o_rendered_what [$o_ansistringobj checksum] set o_rendered_what [$o_ansistringobj checksum]
@ -129,10 +129,41 @@ namespace eval punk::ansi::class {
set o_dimensions $dimensions 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 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 package require textblock
set lfvis [ansistring VIEW -lf 1 \n] set lfvis [ansistring VIEW -lf 1 \n]
set maplf [list \n "[a+ green bold reverse]${lfvis}[a]\n"] ;#a mapping to highlight newlines 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 rlines [lrange $lines 0 $x]
set chunk [::join $rlines \n] set chunk [::join $rlines \n]
append chunk \n append chunk \n
if {$minuschar ne "0"} { if {$opt_ minus ne "0"} {
set chunk [string range $chunk 0 end-$minuschar ] 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 "" set marker ""
for {set i 1} {$i <= 80 } {incr i} { for {set i 1} {$i <= $w } {incr i} {
if {$i % 10 == 0} { if {$i % 10 == 0} {
::append marker "|" ::append marker "|"
} elseif {$i % 5 == 0} { } elseif {$i % 5 == 0} {
@ -159,13 +190,19 @@ namespace eval punk::ansi::class {
set xline [lindex $rlines $x]\n set xline [lindex $rlines $x]\n
set xlinev [ansistring VIEWSTYLE $xline] set xlinev [ansistring VIEWSTYLE $xline]
set xlinev [string map $maplf $xlinev] 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 ::append rendered \n $xlinedisplay
set chunk [ansistring VIEWSTYLE $chunk] set chunk [ansistring VIEWSTYLE $chunk]
set chunk [string map $maplf $chunk] set chunk [string map $maplf $chunk]
set chunkdisplay [overtype::left -wrap 1 -width 80 "" $chunk] #keep chunkdisplay narrower - leave at 80 or it will get unwieldy for larger image widths
textblock::join $rendered $chunkdisplay 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 {} { 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? #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 #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}} { proc readfile {fname {encoding cp437}} {
@ -376,7 +450,7 @@ namespace eval punk::ansi {
} }
if {$dimensions eq ""} { if {$dimensions eq ""} {
set dimensions 80x26 set dimensions 80x24
} }
set ansidata [fcat -encoding $encoding $fname] set ansidata [fcat -encoding $encoding $fname]
@ -2587,6 +2661,9 @@ namespace eval punk::ansi::class {
set codestack [list] set codestack [list]
set gx0_state 0 ;#default off set gx0_state 0 ;#default off
set current_split_index 0 ;#incremented for each pt block, incremented for each code 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 { foreach {pt code} $o_ansisplits {
lappend o_ptlist $pt lappend o_ptlist $pt
foreach grapheme [punk::char::grapheme_split $pt] { foreach grapheme [punk::char::grapheme_split $pt] {
@ -2594,6 +2671,7 @@ namespace eval punk::ansi::class {
lappend o_sgrstacks $codestack lappend o_sgrstacks $codestack
lappend o_gx0states $gx0_state lappend o_gx0states $gx0_state
lappend o_splitindex $current_split_index lappend o_splitindex $current_split_index
incr o_count
} }
#after handling the pt block - incr the current_split_index #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 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! #maintenance warning - dup in append!
if {[punk::ansi::codetype::is_sgr_reset $code]} { if {[punk::ansi::codetype::is_sgr_reset $code]} {
set codestack [list] set codestack [list "\x1b\[m" ]
lappend o_elements [list sgr $code] lappend o_elements [list sgr $code]
} elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
set codestack [list $code] set codestack [list $code]
@ -2669,7 +2747,7 @@ namespace eval punk::ansi::class {
return 0 return 0
} }
my MakeSplit my MakeSplit
set o_count [my DoCount [join $o_ptlist ""]] # set o_count [my DoCount [join $o_ptlist ""]]
} }
return $o_count return $o_count
} }
@ -2823,15 +2901,16 @@ namespace eval punk::ansi::class {
lappend o_sgrstacks $last_codestack lappend o_sgrstacks $last_codestack
lappend o_gx0states $last_gx0state lappend o_gx0states $last_gx0state
lappend o_splitindex $current_split_index 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 { } else {
if {![llength $o_ansisplits]} { 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 #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 append o_string $catstr ;#append before split and count on whole lot
my MakeSplit my MakeSplit ;#update o_count
set combined_plaintext [join $o_ptlist ""] # set combined_plaintext [join $o_ptlist ""]
set o_count [my DoCount $combined_plaintext] # 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]} assert {[llength $o_elements] == [llength $o_sgrstacks] && [llength $o_elements] == [llength $o_gx0states] && [llength $o_elements] == [llength $o_splitindex]}
return $o_string return $o_string
} else { } else {
@ -2841,15 +2920,18 @@ namespace eval punk::ansi::class {
set ptnew "" set ptnew ""
set codestack [lindex $o_sgrstacks end] set codestack [lindex $o_sgrstacks end]
set gx0_state [lindex $o_gx0states 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 { foreach {pt code} $newsplits {
lappend o_ptlist $pt lappend new_pt_ list $pt
append ptnew $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_elements [list g $grapheme]
lappend o_sgrstacks $codestack lappend o_sgrstacks $codestack
lappend o_gx0states $gx0_state lappend o_gx0states $gx0_state
lappend o_splitindex $current_split_index lappend o_splitindex $current_split_index
incr o_count
} }
incr current_split_index ;#increment 1 of 2 within each loop incr current_split_index ;#increment 1 of 2 within each loop
if {$code ne ""} { if {$code ne ""} {
@ -2858,7 +2940,7 @@ namespace eval punk::ansi::class {
lappend o_splitindex $current_split_index lappend o_splitindex $current_split_index
#maintenance - dup in MakeSplit! #maintenance - dup in MakeSplit!
if {[punk::ansi::codetype::is_sgr_reset $code]} { if {[punk::ansi::codetype::is_sgr_reset $code]} {
set codestack [list] set codestack [list "\x1b\[m" ]
lappend o_elements [list sgr $code] lappend o_elements [list sgr $code]
} elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
set codestack [list $code] set codestack [list $code]
@ -2883,14 +2965,78 @@ namespace eval punk::ansi::class {
incr current_split_index ;#increment 2 of 2 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]] lset o_ansisplits end [string cat [lindex $o_ansisplits end] [lindex $newsplits 0]]
lappend o_ansisplits {*}[lrange $newsplits 1 end] 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]} assert {[llength $o_elements] == [llength $o_sgrstacks] && [llength $o_elements] == [llength $o_gx0states] && [llength $o_elements] == [llength $o_splitindex]}
return $o_string 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 append_and_render - append and render up to end of appended data at same time
method view {args} { method view {args} {
@ -2941,62 +3087,118 @@ namespace eval punk::ansi::class {
foreach {pt code} $o_ansisplits { foreach {pt code} $o_ansisplits {
append output [ansistring VIEW {*}$args $pt] append output [ansistring VIEW {*}$args $pt]
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set displaycode [ansistring VIEW $code] #map DEC cursor_save/restore to CSI version
append output ${whiteb}$displaycode$RST set code [string map [list \x1b7 \x1b\[s \x1b8 \x1b\[u ] $code]
} elseif {[punk::ansi::codetype::is_gx_open $code]} {
append output ${GX}GX+$RST
} elseif {[punk::ansi::codetype::is_gx_close $code]} { set c1 [string index $code 0]
append output ${GX}GX-$RST set c1c2 [string range $code 0 1]
} elseif {[punk::ansi::codetype::is_sgr $code]} { #set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)}
set displaycode [ansistring VIEW $code] set leadernorm [string range [string map [list\
if {[punk::ansi::codetype::has_sgr_leadingreset $code]} { \x1b\[ 7CSI\
#highlight the esc & leftbracket in white as indication there is a leading reset \x9b 8CSI\
set cposn [string first ";" $displaycode] \x1b\] 7OSC\
append output ${whiteb}[string range $displaycode 0 $cposn]$RST${greenb}[string range $displaycode $cposn+1 end]$RST \x1b\( 7GFX\
} else { \x9d 8OSC\
append output ${greenb}$displaycode$RST \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 { 7ESC {
switch -regexp -matchvar matchinfo -- $code\ set codenorm [string cat $leadernorm [string range $code 1 end]]
$re_row_move { }
set displaycode [ansistring VIEW $code] 8CSI - 8OSC {
set displaycode [string map [list A "A$arrow_up" B "B$arrow_down"] $displaycode] set codenorm [string cat $leadernorm [string range $code 1 end]]
append output ${cyanb}$displaycode$RST }
}\ default {
$re_col_move { #we haven't made a mapping for this
lassign $matchinfo _match num type set codenorm $code
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
}\ switch -- $leadernorm {
$re_both_move { {7CSI} - {8CSI} {
lassign $matchinfo _match row col set param [string range $codenorm 4 end-1]
set displaycode [ansistring VIEW $code] #puts stdout "--> CSI [string index $leadernorm 0] bit param:$param"
if {$col eq ""} { switch -- [string index $codenorm end] {
#row only move m {
set map [list H "H${arrow_lr}"] if {[punk::ansi::codetype::is_sgr_reset $code]} {
} else { set displaycode [ansistring VIEW $code]
#row and col move append output ${whiteb}$displaycode$RST
set map [list H "H${arrow_lr}${arrow_du}"] } 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
}
}
} }
set displaycode [string map $map $displaycode] A - B {
append output ${cyanb}$displaycode$RST #row move
}\ set displaycode [ansistring VIEW $code]
$re_cursor_save -\ set displaycode [string map [list A "A$arrow_up" B "B$arrow_down"] $displaycode]
$re_cursor_save_dec { append output ${cyanb}$displaycode$RST
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
}
}
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
}
}
}
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 return $output
} }
