#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?
proc readfile {fname} {
proc readfile {fname {encoding cp437}} {
#todo
#todo
#1- look for BOM - read according to format given by BOM
#1- look for BOM - read according to format given by BOM
#2- assume utf-8
#2- assume utf-8
#3- if errors - assume cp437?
#3- if errors - assume cp437?
set data [fcat $fname]
set ansidata [fcat -encoding $encoding $fname]
if {[file extension $fname] eq ".ans"} {
set obj [punk::ansi::class::class_ansi new $ansidata]
set ansidata [encoding convertfrom cp437 $data]
return $obj
}
proc ansicat {fname args} {
set encnames [encoding names]
set encoding ""
set dimensions ""
foreach a $args {
if {$a in $encnames} {
set encoding $a
} else {
} else {
set ansidata $data
if {[regexp {[0-9]+(?:x|X)[0-9]+} $a]} {
set dimensions $a
}
}
}
}
if {$encoding eq ""} {
set encoding cp437
}
if {$dimensions eq ""} {
set dimensions 80x26
}
set ansidata [fcat -encoding $encoding $fname]
set obj [punk::ansi::class::class_ansi new $ansidata]
set obj [punk::ansi::class::class_ansi new $ansidata]
return $obj
$obj render $dimensions
}
#utf-8/ascii encoded cp437
proc ansicat2 {fname {encoding utf-8}} {
set data [fcat -encoding $encoding $fname]
set ansidata [encoding convertfrom cp437 $data]
set obj [punk::ansi::class::class_ansi new $ansidata]
$obj render
}
}
proc is_utf8_char {char} {
proc is_utf8_char {char} {
regexp {(?x) # Expanded regexp syntax, so I can put in comments :-)
regexp {(?x) # Expanded regexp syntax, so I can put in comments :-)
@ -931,8 +964,47 @@ namespace eval punk::ansi {
#[para] DECRC
#[para] DECRC
return \x1b8
return \x1b8
}
}
# -- --- --- --- ---
# -- --- --- --- ---
#DECAWM - automatic line wrapping
proc enable_line_wrap {} {
#*** !doctools
#[call [fun enable_line_wrap]]
#[para] enable automatic line wrapping when characters entered beyond rightmost column
#[para] This will also allow forward movements to move to subsequent lines
#[para] This is DECAWM - and is the same sequence output by 'tput smam'
return \x1b\[?7h
}
proc disable_line_wrap {} {
#*** !doctools
#[call [fun disable_line_wrap]]
#[para] disable automatic line wrapping
#[para] reset DECAWM - same sequence output by 'tput rmam'
error "overtype::left unknown option '$k'. Known options: $known_opts"
error "overtype::left unknown option '$k'. Known options: $known_opts"
@ -243,8 +244,12 @@ proc overtype::left {args} {
set opts [dict merge $defaults $argsflags]
set opts [dict merge $defaults $argsflags]
# -- --- --- --- --- ---
# -- --- --- --- --- ---
set opt_overflow [dict get $opts -overflow]
set opt_overflow [dict get $opts -overflow]
#####
# review -wrap should map onto DECAWM terminal mode - the wrap 2 idea may not fit in with this?.
set opt_wrap [dict get $opts -wrap] ;#wrap 1 is hard wrap cutting word at exact column, or 1 column early for 2w-glyph, wrap 2 is for language-based word-wrap algorithm (todo)
set opt_wrap [dict get $opts -wrap] ;#wrap 1 is hard wrap cutting word at exact column, or 1 column early for 2w-glyph, wrap 2 is for language-based word-wrap algorithm (todo)
#####
#for repl - standard output line indicator is a dash - todo, add a different indicator for a continued line.
#for repl - standard output line indicator is a dash - todo, add a different indicator for a continued line.
set opt_width [dict get $opts -width]
set opt_appendlines [dict get $opts -appendlines]
set opt_appendlines [dict get $opts -appendlines]
set opt_transparent [dict get $opts -transparent]
set opt_transparent [dict get $opts -transparent]
set opt_ellipsistext [dict get $opts -ellipsistext]
set opt_ellipsistext [dict get $opts -ellipsistext]
@ -253,25 +258,31 @@ proc overtype::left {args} {
set opt_exposed2 [dict get $opts -exposed2] ;#widechar_exposed_right - todo
set opt_exposed2 [dict get $opts -exposed2] ;#widechar_exposed_right - todo
# -- --- --- --- --- ---
# -- --- --- --- --- ---
#modes
set insert_mode 0 ;#can be toggled by insert key or ansi IRM sequence ESC [ 4 h|l
set autowrap_mode $opt_wrap
set reverse_mode 0
set norm [list \r\n \n]
set norm [list \r\n \n]
set underblock [string map $norm $underblock]
set underblock [string map $norm $underblock]
set overblock [string map $norm $overblock]
set overblock [string map $norm $overblock]
#set underlines [split $underblock \n]
#set underlines [split $underblock \n]
set underlines [lines_as_list -ansiresets 1 $underblock]
#set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]]
#underblock is a 'rendered' block - so width height make sense
set underlines [lines_as_list -ansiresets 1 $underblock]
set overlines [split $overblock \n]
set overlines [split $overblock \n]
#set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]]
#overblock height/width isn't useful in the presence of an ansi input overlay with movements. The number of lines may bear little relationship to the output height
set overtext [string cat [lindex $replay_codes_overlay $overidx] $overtext]
set overtext [string cat [lindex $replay_codes_overlay $overidx] $overtext]
@ -320,14 +310,18 @@ proc overtype::left {args} {
lappend underlay_resets [list $row [dict get $replay_codes_underlay $row]]
lappend underlay_resets [list $row [dict get $replay_codes_underlay $row]]
}
}
#review insert_mode. As an 'overtype' function whose main function is not interactive keystrokes - insert is secondary -
#review insert_mode. As an 'overtype' function whose main function is not interactive keystrokes - insert is secondary -
#but even if we didn't want it as an option to the function call - to process ansi fully it may need to be supported (how widely supported are ansi insert-mode toggles?)
#but even if we didn't want it as an option to the function call - to process ansi adequately we need to support IRM (insertion-replacement mode) ESC [ 4 h|l
#puts stderr "overtype::left cursor_restore without save data available"
#puts stderr "overtype::left cursor_restore without save data available"
}
}
#If we were inserting prior to hitting the cursor_restore - there could be overflow_right data - generally the overtype functions aren't for inserting - but ansi could enable it
#If we were inserting prior to hitting the cursor_restore - there could be overflow_right data - generally the overtype functions aren't for inserting - but ansi can enable it
#if we were already in overflow when cursor_restore was hit - it shouldn't have been processed as an action - just stored.
#if we were already in overflow when cursor_restore was hit - it shouldn't have been processed as an action - just stored.
if {!$overflow_handled && $overflow_right ne ""} {
if {!$overflow_handled && $overflow_right ne ""} {
#wrap before restore? - possible effect on saved cursor position
#wrap before restore? - possible effect on saved cursor position
@ -441,26 +437,41 @@ proc overtype::left {args} {
}
}
up {
up {
#renderline already knows not to go above l
#renderline already knows not to go above l
set row $render_row
#Note that an ansi up sequence after last column going up to a previous line and also beyond the last column, will result in the next grapheme going onto the following line.
set col $render_col
#this seems correct - as the column remains beyond the right margin so subsequent chars wrap (?) review
#puts stderr "up $post_render_row"
#puts stderr "$rinfo"
set row $post_render_row
set rowdata [lindex $outputlines [expr {$row -1}]]
set len [punk::ansi::printing_length $rowdata]
if {$len+1 < $post_render_col} {
set col [expr {$len+1}]
} else {
set col $post_render_col
}
}
}
down {
down {
#renderline doesn't know how far down we can go..
#renderline doesn't know how far down we can go..
if {$render_row > [llength $outputlines]} {
if {$post_render_row > [llength $outputlines]} {
#if {$opt_appendlines} {
# set diff [expr {$post_render_row - [llength $outputlines]}]
# if {$diff > 0} {
# lappend outputlines {*}[lrepeat $diff ""]
# }
#}
set row [llength $outputlines]
set row [llength $outputlines]
} else {
} else {
set row $render_row
set row $post_render_row
}
}
set col $post_render_col
set col $render_col
}
}
move {
move {
if {$render_row > [llength $outputlines]} {
if {$post_render_row > [llength $outputlines]} {
set row [llength $outputlines]
set row [llength $outputlines]
} else {
} else {
set row $render_row
set row $post_render_row
}
}
set col $render_col
set col $post_render_col
#overflow + unapplied?
#overflow + unapplied?
}
}
newline_above - newline_below {
newline_above - newline_below {
@ -468,13 +479,62 @@ proc overtype::left {args} {
}
}
wrap {
wrap {
#hard wraps in this context.
#hard wraps in this context.
#note that cursor_forward may move deep into the next line - or even span multiple lines !TODO
if {$overflow_right_column eq ""} {
#so why are we getting a wrap instruction?
puts stderr "overtype::left wrap instruction when no overflow_right_column\n$rinfo"
incr row
incr row
set col 1
set col 1
} else {
if {$post_render_col >= $overflow_right_column} {
#review - check printing_length of each following underlay line and move appropriately?
error "overtype::renderline -cursor_row must be empty for unspecified/unknown or a non-zero positive integer. received: '$opt_row_context'"
error "overtype::renderline -cursor_row must be empty for unspecified/unknown or a non-zero positive integer. received: '$opt_row_context'"
}
}
}
}
# -- --- --- --- --- --- --- --- --- --- --- ---
#The _mode flags correspond to terminal modes that can be set/reset via escape sequences (e.g DECAWM wraparound mode)
set opt_insert_mode [dict get $opts -insert_mode];#should usually be 1 for each new line in editor mode but must be initialised to 1 externally (review)
set opt_insert_mode [dict get $opts -insert_mode];#should usually be 1 for each new line in editor mode but must be initialised to 1 externally (review)
#default is for overtype
#default is for overtype
# -- --- --- --- --- --- --- --- --- --- --- ---
# -- --- --- --- --- --- --- --- --- --- --- ---
set opt_autowrap_mode [dict get $opts -autowrap_mode] ;#DECAWM - char or movement can go beyond leftmost/rightmost col to prev/next line
set opt_reverse_mode [dict get $opts -reverse_mode] ;#DECSNM
# set cursor_row 0 ;#we aren't allowed to make assumptions about our context. zero represents cursor_row_change - not an absolute row (for which zero is invalid anyway)
#} else {
# set cursor_row "=$opt_row_context" ;#we are at this row number in the greater context - allow moves that explicitly refer to this row without returning prematurely
set idx [expr {$opt_colcursor -1}] ;#don't use opt_colstart here - we have padded and won't start emitting until idx reaches opt_colstart-1
set idx [expr {$opt_colcursor -1}] ;#don't use opt_colstart here - we have padded and won't start emitting until idx reaches opt_colstart-1
#cursor_column is usually one above idx - but we have opt_colstart which is like a margin - todo: remove cursor_column from the following loop and calculate it's offset when breaking or at end.
#(for now we are incrementing/decrementing both in sync - which is a bit silly)
#How we simulate this to render within a block of text is an open question.
#track all SGR stacks and constantly flip based on the current SGR reverse state?
#It is the job of the calling loop to do this - so at this stage we'll just set the states
#DECAWM autowrap
if {$type eq "h"} {
#set (enable)
set reverse_mode 1
} else {
#reset (disable)
set reverse_mode 0
}
}
7 {
#DECAWM autowrap
if {$type eq "h"} {
#set (enable)
set autowrap_mode 1
if {$opt_width ne "\uFFEF"} {
set overflow_idx $opt_width
} else {
#review - this is also the cursor position when adding a char at end of line?
set overflow_idx [expr {[llength $undercols]}] ;#index at which we would be *in* overflow a row move may still override it
}
}
#review - can idx ever be beyond overflow_idx limit when we change e.g with a width setting and cursor movements? presume not - but sanity check for now.
