# -*- 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 punk::console 999999.0a1.0
# Meta platform     tcl
# Meta license      <unspecified>
# @@ Meta End



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Requirements
##e.g package require frobz
package require punk::ansi


if {"windows" eq $::tcl_platform(platform)} {
    package require zzzload
    zzzload::pkg_require twapi
}

#see https://learn.microsoft.com/en-us/windows/console/classic-vs-vt  
#https://learn.microsoft.com/en-us/windows/console/creating-a-pseudoconsole-session

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::console {
    variable has_twapi 0

    #punk::console namespace - contains *directly* acting functions - some based on ansi escapes from the 'ansi' sub namespace, some on local system calls or executable calls wrapped in the 'local' sub namespace
    #directly acting means they write to stdout to cause the console to peform the action,  or they perform the action immediately via other means.
    #punk::console::ansi contains a subset of punk::ansi, but with emission to stdout as opposed to simply returning the ansi sequence.
    #punk::console::local functions are used by punk::console commands when there is no ansi equivalent
    #ansi escape sequences are possibly preferable esp if terminal is remote to process running punk::console 
    # punk::local commands may be more performant in some circumstances where console is directly attached, but it shouldn't be assumed. e.g ansi::titleset outperforms local::titleset on windows with twapi.

    namespace eval ansi {
        #ansi escape sequence based terminal/console control functions
        namespace export *
    }
    namespace eval local {
        #non-ansi terminal/console control functions
        #e.g external utils system API's.
        namespace export *
    }
    
    if {"windows" eq $::tcl_platform(platform)} {
        proc enableAnsi {} {
            #loopavoidancetoken (don't remove) 
            internal::define_windows_procs
            internal::abort_if_loop
            tailcall enableAnsi
        }
        proc enableRaw {{channel stdin}} {
            #loopavoidancetoken (don't remove) 
            internal::define_windows_procs
            internal::abort_if_loop
            tailcall enableRaw $channel
        }
        proc disableRaw {{channel stdin}} {
            #loopavoidancetoken (don't remove) 
            internal::define_windows_procs
            internal::abort_if_loop
            tailcall disableRaw $channel
        }
    } else {
        proc enableAnsi {} {
            #todo?
        }
        proc enableRaw {{channel stdin}} {
            set sttycmd [auto_execok stty]
            exec {*}$sttycmd raw -echo <@$channel
        }
        proc disableRaw {{channel stdin}} {
            set sttycmd [auto_execok stty]
            exec {*}$sttycmd raw echo <@$channel
        }
    }

    proc enable_mouse {} {
        puts -nonewline stdout \x1b\[?1000h
        puts -nonewline stdout \x1b\[?1003h
        puts -nonewline stdout \x1b\[?1015h
        puts -nonewline stdout \x1b\[?1006h
        flush stdout
    }
    proc disable_mouse {} {
        puts -nonewline stdout \x1b\[?1000l
        puts -nonewline stdout \x1b\[?1003l
        puts -nonewline stdout \x1b\[?1015l
        puts -nonewline stdout \x1b\[?1006l
        flush stdout
    }
    proc enable_bracketed_paste {} {
        puts -nonewline stdout \x1b\[?2004h
    }
    proc disable_bracketed_paste {} {
        puts -nonewline stdout \x1b\[?2004l
    }
    proc start_application_mode {} {
        #need loop to read events?
        puts -nonewline stdout \x1b\[?1049h  ;#alt screen
        enable_mouse
        #puts -nonewline stdout \x1b\[?25l  ;#hide cursor
        puts -nonewline stdout \x1b\[?1003h\n
        enable_bracketed_paste
        
    }

    namespace eval internal {
        proc abort_if_loop {{failmsg ""}} {
            #puts "il1 [info level 1]"
            #puts "thisproc: [lindex [info level 0] 0]"
            set would_loop [uplevel 1 {expr {[string match *loopavoidancetoken* [info body [namespace tail [lindex [info level 0] 0]]]]}}]
            #puts "would_loop: $would_loop"
            if {$would_loop} {
                set procname [uplevel 1 {namespace tail [lindex [info level 0] 0]}]
                if {$failmsg eq ""} {
                    set errmsg "[namespace current] Failed to redefine procedure $procname"
                } else {
                    set errmsg $failmsg
                }
                error $errmsg
            }
        }
        proc define_windows_procs {} {
            set loadstate [zzzload::pkg_require twapi]
            if {$loadstate ni [list loading failed]} {
                package require twapi ;#should be fast once twapi dll loaded in zzzload thread
                set ::punk::console::has_twapi 1

                #todo - move some of these to the punk::console::local sub-namespace - as they use APIs rather than in-band ANSI to do their work.
                #enableAnsi seems like it should be directly under punk::console .. but then it seems inconsistent if other local console-mode setting functions aren't.
                #Find a compromise to organise things somewhat sensibly..

                proc [namespace parent]::enableAnsi {} {
                    #output handle modes
                    #Enable virtual terminal processing (sometimes off in older windows terminals)
                    #ENABLE_PROCESSED_OUTPUT = 0x0001
                    #ENABLE_WRAP_AT_EOL_OUTPUT = 0x0002
                    #ENABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004
                    #DISABLE_NEWLINE_AUTO_RETURN = 0x0008
                    set h_out [twapi::get_console_handle stdout] 
                    set oldmode_out [twapi::GetConsoleMode $h_out]
                    set newmode_out [expr {$oldmode_out | 5}] ;#5?

                    twapi::SetConsoleMode $h_out $newmode_out

                    #input handle modes
                    #ENABLE_PROCESSED_INPUT 0x0001
                    #ENABLE_LINE_INPUT 0x0002
                    #ENABLE_ECHO_INPUT 0x0004
                    #ENABLE_WINDOW_INPUT 0x0008  (default off when a terminal created)
                    #ENABLE_MOUSE_INPUT 0x0010
                    #ENABLE_INSERT_MODE 0X0020
                    #ENABLE_QUICK_EDIT_MODE 0x0040
                    #ENABLE_VIRTUAL_TERMINAL_INPUT 0x0200 (default off when a terminal created) (512)
                    set h_in [twapi::get_console_handle stdin]
                    set oldmode_in [twapi::GetConsoleMode $h_in]
                    set newmode_in [expr {$oldmode_in | 8}]

                    twapi::SetConsoleMode $h_in $newmode_in

                    return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
                }
                proc [namespace parent]::disableAnsi {} {
                    set h_out [twapi::get_console_handle stdout] 
                    set oldmode_out [twapi::GetConsoleMode $h_out]
                    set newmode_out [expr {$oldmode_out & ~5}]
                    twapi::SetConsoleMode $h_out $newmode_out


                    set h_in [twapi::get_console_handle stdin]
                    set oldmode_in [twapi::GetConsoleMode $h_in]
                    set newmode_in [expr {$oldmode_in & ~8}]
                    twapi::SetConsoleMode $h_in $newmode_in


                    return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
                }

                proc [namespace parent]::enableProcessedInput {} {
                    set h_in [twapi::get_console_handle stdin]
                    set oldmode_in [twapi::GetConsoleMode $h_in]
                    set newmode_in [expr {$oldmode_in | 1}]
                    twapi::SetConsoleMode $h_in $newmode_in
                    return [list stdin [list from $oldmode_in to $newmode_in]]
                }
                proc [namespace parent]::disableProcessedInput {} {
                    set h_in [twapi::get_console_handle stdin]
                    set oldmode_in [twapi::GetConsoleMode $h_in]
                    set newmode_in [expr {$oldmode_in & ~1}]
                    twapi::SetConsoleMode $h_in $newmode_in
                    return [list stdin [list from $oldmode_in to $newmode_in]]
                }


                proc [namespace parent]::enableRaw {{channel stdin}} {
                    #review - change to modify_console_input_mode
                    set console_handle [twapi::GetStdHandle -10]
                    set oldmode [twapi::GetConsoleMode $console_handle]
                    set newmode [expr {$oldmode & ~6}] ;# Turn off the echo and line-editing bits
                    twapi::SetConsoleMode $console_handle $newmode
                    return [list stdin [list from $oldmode to $newmode]]
                }
                proc [namespace parent]::disableRaw {{channel stdin}} {
                    set console_handle [twapi::GetStdHandle -10]
                    set oldmode [twapi::GetConsoleMode $console_handle]
                    set newmode [expr {$oldmode | 6}] ;# Turn on the echo and line-editing bits
                    twapi::SetConsoleMode $console_handle $newmode
                    return [list stdin [list from $oldmode to $newmode]]
                }

            } else {
                if {$loadstate eq "failed"} {
                    puts stderr "punk::console falling back to stty because twapi load failed"
                    proc [namespace parent]::enableAnsi {} {
                        puts stderr "punk::console::enableAnsi todo"
                    }
                    proc [namespace parent]::enableRaw {{channel stdin}} {
                        set sttycmd [auto_execok stty]
                        exec {*}$sttycmd raw -echo <@$channel
                    }
                    proc [namespace parent]::disableRaw {{channel stdin}} {
                        set sttycmd [auto_execok stty]
                        exec {*}$sttycmd raw echo <@$channel
                    }
                }
            }
        }

        proc ansi_response_handler {chan accumulatorvar waitvar} {
            set status [catch {read $chan 1} bytes]
            if { $status != 0 } {
                # Error on the channel
                fileevent stdin readable {}
                puts "error reading $chan: $bytes"
                set $waitvar [list error_read status $status bytes $bytes]
            } elseif {$bytes ne ""} {
                # Successfully read the channel
                #puts "got: [string length $bytes]"
                upvar $accumulatorvar chunk
                append chunk $bytes
                if {$bytes eq "R"} {
                    fileevent stdin readable {}
                    set $waitvar ok
                }
            } elseif { [eof $chan] } {
                fileevent stdin readable {}
                # End of file on the channel
                #review
                puts "ansi_response_handler end of file"
                set $waitvar eof
            } elseif { [fblocked $chan] } {
                # Read blocked.  Just return
            } else {
                fileevent stdin readable {}
                # Something else
                puts "ansi_response_handler can't happen"
                set $waitvar error_unknown 
            }
        }
    } ;#end namespace eval internal

    variable colour_disabled 0
    # https://no-color.org
    if {[info exists ::env(NO_COLOR)]} {
        if {$::env(NO_COLOR) ne ""} {
            set colour_disabled 1
        }
    }

    namespace eval ansi {
        proc a+ {args} {
            puts -nonewline [::punk::ansi::a+ {*}$args]
        }
    }
    proc ansi+ {args} {
        variable colour_disabled
        if {$colour_disabled == 1} {
            return
        }
        #stdout
        tailcall ansi::a+ {*}$args
    }
    proc get_ansi+ {args} {
        variable colour_disabled
        if {$colour_disabled == 1} {
            return
        }
        tailcall punk::ansi::a+ {*}$args
    }

    namespace eval ansi {
        proc a {args} {
            puts -nonewline [::punk::ansi::a {*}$args]
        }
    }
    proc ansi {args} {
        variable colour_disabled
        if {$colour_disabled == 1} {
            return
        }
        #stdout
        tailcall ansi::a {*}$args
    }
    proc get_ansi {args} {
        variable colour_disabled
        if {$colour_disabled == 1} {
            return
        }
        tailcall punk::ansi::a {*}$args
    }

    namespace eval ansi {
        proc a? {args} {
            puts -nonewline stdout [::punk::ansi::a? {*}$args]
        }
    }
    proc ansi? {args} {
        #stdout
        tailcall ansi::a? {*}$args
    }
    proc get_ansi? {args} {
        tailcall ::punk::ansi::a? {*}$args
    }

    proc colour {{onoff {}}} {
        variable colour_disabled
        if {[string length $onoff]} {
            set onoff [string tolower $onoff]
            if {$onoff in [list 1 on true yes]} {
                interp alias "" a+ "" punk::console::ansi+
                set colour_disabled 0
            } elseif {$onoff in [list 0 off false no]} {
                interp alias "" a+ "" control::no-op
                set colour_disabled 1
            } else {
                error "punk::console::colour expected 0|1|on|off|true|false|yes|no"
            }
        }
        catch {repl::reset_prompt}
        return [expr {!$colour_disabled}]
    }

    namespace eval ansi {
        proc reset {} {
            puts -nonewline stdout [punk::ansi::reset]
        }
    }
    namespace import ansi::reset

    namespace eval ansi {
        proc clear {} {
            puts -nonewline stdout [punk::ansi::clear]
        }
        proc clear_above {} {
            puts -nonewline stdout [punk::ansi::clear_above]
        }
        proc clear_below {} {
            puts -nonewline stdout [punk::ansi::clear_below]
        }
        proc clear_all {} {
            puts -nonewline stdout [punk::ansi::clear_all]
        }
    }
    namespace import ansi::clear
    namespace import ansi::clear_above
    namespace import ansi::clear_below
    namespace import ansi::clear_all

    namespace eval local {
        proc set_codepage_output {cpname} {
            #todo
            if {"windows" eq $::tcl_platform(platform)} {
                twapi::set_console_output_codepage $cpname
            } else {
                error "set_codepage_output unimplemented on $::tcl_platform(platform)"
            }
        }
        proc set_codepage_input {cpname} {
            #todo
            if {"windows" eq $::tcl_platform(platform)} {
                twapi::set_console_input_codepage $cpname
            } else {
                error "set_codepage_input unimplemented on $::tcl_platform(platform)"
            }
        }
    }
    namespace import local::set_codepage_output
    namespace import local::set_codepage_input


    proc get_cursor_pos {} {
        set ::punk::console::chunk ""
        
        set accumulator ::punk::console::chunk
        set waitvar     ::punk::console::chunkdone
        set existing_handler [fileevent stdin readable]
        set $waitvar ""
        #todo - test and save rawstate so we don't disableRaw if terminal was already raw
        enableRaw
        fconfigure stdin -blocking 0
        fileevent stdin readable [list ::punk::console::internal::ansi_response_handler stdin $accumulator $waitvar]
        puts -nonewline stdout \033\[6n ;flush stdout
        after 0 {update idletasks}
        #e.g  \033\[46;1R
        #todo - reset
        set info ""
        if {[set $waitvar] eq ""} {
            vwait   $waitvar
        }
        disableRaw
        if {[string length $existing_handler]} {
            fileevent stdin readable $existing_handler
        }

        set info [set $accumulator]
        #set punk::console::chunk ""
        set data [string range $info 2 end-1]
        return $data
    }
    proc get_cursor_pos_list {} {
        return [split [get_cursor_pos] ";"]
    }

    #terminals lie. This should be a reasonable (albeit relatively slow) test of actual width - but some terminals seem to miscalculate.
    #todo - a visual interactive test/questionnaire to ask user if things are lining up or if the terminal is telling fibs about cursor position.
    #todo - determine if these anomalies are independent of font
    #punk::ansi should be able to glean widths from unicode data files - but this may be incomplete - todo - compare with what terminal actually does. 
    proc test_char_width {char_or_string {emit 0}} {
        if {!$emit} {
            puts -nonewline stdout \033\[2K\033\[1G ;#2K erase line 1G cursor at col1
        }
        lassign [split [punk::console::get_cursor_pos] ";"] _row1 col1
        puts -nonewline stdout $char_or_string
        lassign [split [punk::console::get_cursor_pos] ";"] _row2 col2
        if {!$emit} {
            puts -nonewline stdout \033\[2K\033\[1G
        }
        flush stdout;#if we don't flush - a subsequent stderr write could move the cursor to a newline and interfere with our 2K1G erasure and cursor repositioning.
        return [expr {$col2 - $col1}]
    }

    namespace eval ansi {
        proc cursor_on {} {
            puts -nonewline stdout [punk::ansi::cursor_on]
        }
        proc cursor_off {} {
            puts -nonewline stdout [punk::ansi::cursor_off]
        }
    }
    namespace import ansi::cursor_on
    namespace import ansi::cursor_off

    namespace eval local {
        proc titleset {windowtitle} {
            if {"windows" eq $::tcl_platform(platform)} {
                if {![catch {twapi::set_console_title $windowtitle} result]} {
                    return $windowtitle
                } else {
                    error "punk::console::titleset failed to set title - try punk::console::ansi::titleset"
                }
            } else {
                error "punk::console::titleset has no local mechanism to set the window title on this platform. try punk::console::ansi::titleset"
            }
        }
        proc titleget {} {
            if {"windows" eq $::tcl_platform(platform)} {
                if {![catch {twapi::get_console_title} result]} {
                    return $result
                } else {
                    error "punk::console::titleset failed to set title - ensure twapi is available"
                }
            } else {
                #titleget - https://invisible-island.net/xterm/xterm.faq.html#how2_title
                # won't work on all platforms/terminals - but may be worth implementing
                error "punk::console::titleget has no local mechanism to get the window title on this platform."
            }
        }
    }

    namespace eval ansi {
        proc titleset {windowtitle} {
            puts -nonewline stdout [punk::ansi::titleset $windowtitle]
        } 
    }
    namespace import ansi::titleset
    #no known pure-ansi solution 
    proc titleget {} {
        return [local::titleget]
    }

    proc infocmp_test {} {
        set cmd1 [auto_execok infocmp]
        if {[string length $cmd1]} {
            puts stderr "infocmp seems to be available"
            return [exec {*}$cmd1]
        } else {
            puts stderr "infcmp doesn't seem to be present"
            set tcmd [auto_execok tput]
            if {[string length $tcmd]} {
                puts stderr "tput seems to be available. Try something like: tput -S - (freebsd)"
            }
        }
    }

    proc test_cursor_pos {} {
        enableRaw
        puts -nonewline stdout \033\[6n ;flush stdout
        fconfigure stdin -blocking 0
        set info [read stdin 20] ;#
        after 1
        if {[string first "R" $info] <=0} {
            append info [read stdin 20]
        }
        disableRaw
        set data [string range [string trim $info] 2 end-1]
        return [split $data ";"]
    }

    namespace eval ansi {
        proc move {row col} {
            puts -nonewline stdout [punk::ansi::move $row $col]
        }
        proc move_forward {row col} {
            puts -nonewline stdout [punk::ansi::move_forward $row $col]
        }
        proc move_back {row col} {
            puts -nonewline stdout [punk::ansi::move_back $row $col]
        }
        proc move_up {row col} {
            puts -nonewline stdout [punk::ansi::move_up $row $col]
        }
        proc move_down {row col} {
            puts -nonewline stdout [punk::ansi::move_down $row $col]
        }
        proc move_emit {row col data args} {
            puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args]
        }
        proc move_emit_return {row col data args} {
            lassign [punk::console::get_cursor_pos_list] orig_row orig_col
            set out ""
            append out [punk::ansi::move_emit $row $col $data {*}$args]
            if {!$is_in_raw} {
                incr orig_row -1
            }
            move  $orig_row $orig_col
        }
    }
    namespace import ansi::move
    namespace import ansi::move_emit
    namespace import ansi::move_forward
    namespace import ansi::move_back
    namespace import ansi::move_up
    namespace import ansi::move_down

    proc move_emit_return {row col data args} {
        #todo detect if in raw mode or not?
        set is_in_raw 0
        lassign [punk::console::get_cursor_pos_list] orig_row orig_col

        move_emit $row $col $data
        foreach {row col data} $args {
            move_emit $row $col $data
        }

        if {!$is_in_raw} {
            incr orig_row -1
        }
        move  $orig_row $orig_col
        return ""
    }
    proc move_call_return {row col script} {
        lassign [punk::console::get_cursor_pos_list] orig_row orig_col
        move $row $col
        uplevel 1 $script
        move  $orig_row $orig_col
    }

        #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations
        # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries
        proc pick {row col} {
            lassign [punk::console::get_cursor_pos_list] orig_row orig_col
            set test ""
            #set test [a green Yellow]
            move_emit $row $col $test\0337
            puts -nonewline \0338\033\[${orig_row}\;${orig_col}H
        }
        proc pick_emit {row col data} {
            set test ""
            #set test [a green Purple]
            lassign [punk::console::get_cursor_pos_list] orig_row orig_col
            move_emit $row $col $test\0337
            puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data
        }

    # -- --- --- --- --- ---
    namespace eval ansi {
        proc test_decaln {} {
            puts -nonewline stdout [punk::ansi::test_decaln]
        }
    }
    namespace import ansi::test_decaln

    namespace eval clock {

        #map chars of chars "0" to "?""  ie 0x30 to x3f
        variable fontmap1 {
            7C CE DE F6 E6 C6 7C 00
            30 70 30 30 30 30 FC 00
            78 CC 0C 38 60 CC FC 00
            78 CC 0C 38 0C CC 78 00
            1C 3C 6C CC FE 0C 1E 00
            FC C0 F8 0C 0C CC 78 00
            38 60 C0 F8 CC CC 78 00
            FC CC 0C 18 30 30 30 00
            78 CC CC 78 CC CC 78 00
            78 CC CC 7C 0C 18 70 00
            00 18 18 00 00 18 18 00
            00 18 18 00 00 18 18 30
            18 30 60 C0 60 30 18 00
            00 00 7E 00 7E 00 00 00
            60 30 18 0C 18 30 60 00
            3C 66 0C 18 18 00 18 00 
        }
        #libungif extras
        append fontmap1 {
            7c 82 9a aa aa 9e 7c 00
            38 6c c6 c6 fe c6 c6 00
            fc c6 c6 fc c6 c6 fc 00
        }

        #https://github.com/Distrotech/libungif/blob/master/lib/gif_font.c
        variable fontmap {
        }
        #ascii row 0x00 to 0x1F control chars
        #(cp437 glyphs)
        append fontmap {
            00 00 00 00 00 00 00 00
            3c 42 a5 81 bd 42 3c 00
            3c 7e db ff c3 7e 3c 00
            00 ee fe fe 7c 38 10 00
            10 38 7c fe 7c 38 10 00
            00 3c 18 ff ff 08 18 00
            10 38 7c fe fe 10 38 00
            00 00 18 3c 18 00 00 00
            ff ff e7 c3 e7 ff ff ff
            00 3c 42 81 81 42 3c 00
            ff c3 bd 7e 7e bd c3 ff
            1f 07 0d 7c c6 c6 7c 00
            00 7e c3 c3 7e 18 7e 18
            04 06 07 04 04 fc f8 00
            0c 0a 0d 0b f9 f9 1f 1f
            00 92 7c 44 c6 7c 92 00
            00 00 60 78 7e 78 60 00
            00 00 06 1e 7e 1e 06 00
            18 7e 18 18 18 18 7e 18
            66 66 66 66 66 00 66 00
            ff b6 76 36 36 36 36 00
            7e c1 dc 22 22 1f 83 7e
            00 00 00 7e 7e 00 00 00
            18 7e 18 18 7e 18 00 ff
            18 7e 18 18 18 18 18 00
            18 18 18 18 18 7e 18 00
            00 04 06 ff 06 04 00 00
            00 20 60 ff 60 20 00 00
            00 00 00 c0 c0 c0 ff 00
            00 24 66 ff 66 24 00 00
            00 00 10 38 7c fe 00 00
            00 00 00 fe 7c 38 10 00
        }
        #chars SP to "/"  row 0x20 to 0x2f
        append fontmap {
            00 00 00 00 00 00 00 00
            30 30 30 30 30 00 30 00
            66 66 00 00 00 00 00 00
            6c 6c fe 6c fe 6c 6c 00
            10 7c d2 7c 86 7c 10 00
            f0 96 fc 18 3e 72 de 00
            30 48 30 78 ce cc 78 00
            0c 0c 18 00 00 00 00 00
            10 60 c0 c0 c0 60 10 00
            10 0c 06 06 06 0c 10 00
            00 54 38 fe 38 54 00 00
            00 18 18 7e 18 18 00 00
            00 00 00 00 00 00 18 70
            00 00 00 7e 00 00 00 00
            00 00 00 00 00 00 18 00
            02 06 0c 18 30 60 c0 00
        }
        #chars "0" to "?""  row 0x30 to 0x3f
        append fontmap {
            7c c6 c6 c6 c6 c6 7c 00
            18 38 78 18 18 18 3c 00
            7c c6 06 0c 30 60 fe 00
            7c c6 06 3c 06 c6 7c 00
            0e 1e 36 66 fe 06 06 00
            fe c0 c0 fc 06 06 fc 00
            7c c6 c0 fc c6 c6 7c 00
            fe 06 0c 18 30 60 60 00
            7c c6 c6 7c c6 c6 7c 00
            7c c6 c6 7e 06 c6 7c 00
            00 30 00 00 00 30 00 00
            00 30 00 00 00 30 20 00
            00 1c 30 60 30 1c 00 00
            00 00 7e 00 7e 00 00 00
            00 70 18 0c 18 70 00 00
            7c c6 0c 18 30 00 30 00
        }
        #chars "@" to "O" row 0x40 to 0x4f
        append fontmap {
            7c 82 9a aa aa 9e 7c 00
            38 6c c6 c6 fe c6 c6 00
            fc c6 c6 fc c6 c6 fc 00
            7c c6 c6 c0 c0 c6 7c 00
            f8 cc c6 c6 c6 cc f8 00
            fe c0 c0 fc c0 c0 fe 00
            fe c0 c0 fc c0 c0 c0 00
            7c c6 c0 ce c6 c6 7e 00
            c6 c6 c6 fe c6 c6 c6 00
            78 30 30 30 30 30 78 00
            1e 06 06 06 c6 c6 7c 00
            c6 cc d8 f0 d8 cc c6 00
            c0 c0 c0 c0 c0 c0 fe 00
            c6 ee fe d6 c6 c6 c6 00
            c6 e6 f6 de ce c6 c6 00
            7c c6 c6 c6 c6 c6 7c 00
        }
        #chars "P" to "_" row 0x50 to 0x5f
        append fontmap {
            fc c6 c6 fc c0 c0 c0 00
            7c c6 c6 c6 c6 c6 7c 06
            fc c6 c6 fc c6 c6 c6 00
            78 cc 60 30 18 cc 78 00
            fc 30 30 30 30 30 30 00
            c6 c6 c6 c6 c6 c6 7c 00
            c6 c6 c6 c6 c6 6c 38 00
            c6 c6 c6 d6 fe ee c6 00
            c6 c6 6c 38 6c c6 c6 00
            c3 c3 66 3c 18 18 18 00
            fe 0c 18 30 60 c0 fe 00
            3c 30 30 30 30 30 3c 00
            c0 60 30 18 0c 06 03 00
            3c 0c 0c 0c 0c 0c 3c 00
            00 38 6c c6 00 00 00 00
            00 00 00 00 00 00 00 ff
        }
        #chars "`" to "o" row 0x60 to 0x6f
        append fontmap {
            30 30 18 00 00 00 00 00
            00 00 7c 06 7e c6 7e 00
            c0 c0 fc c6 c6 e6 dc 00
            00 00 7c c6 c0 c0 7e 00
            06 06 7e c6 c6 ce 76 00
            00 00 7c c6 fe c0 7e 00
            1e 30 7c 30 30 30 30 00
            00 00 7e c6 ce 76 06 7c
            c0 c0 fc c6 c6 c6 c6 00
            18 00 38 18 18 18 3c 00
            18 00 38 18 18 18 18 f0
            c0 c0 cc d8 f0 d8 cc 00
            38 18 18 18 18 18 3c 00
            00 00 cc fe d6 c6 c6 00
            00 00 fc c6 c6 c6 c6 00
            00 00 7c c6 c6 c6 7c 00
        }
        #chars "p" to DEL row 0x70 to 0x7f
        append fontmap {
            00 00 fc c6 c6 e6 dc c0
            00 00 7e c6 c6 ce 76 06
            00 00 6e 70 60 60 60 00
            00 00 7c c0 7c 06 fc 00
            30 30 7c 30 30 30 1c 00
            00 00 c6 c6 c6 c6 7e 00
            00 00 c6 c6 c6 6c 38 00
            00 00 c6 c6 d6 fe 6c 00
            00 00 c6 6c 38 6c c6 00
            00 00 c6 c6 ce 76 06 7c
            00 00 fc 18 30 60 fc 00
            0e 18 18 70 18 18 0e 00
            18 18 18 00 18 18 18 00
            e0 30 30 1c 30 30 e0 00
            00 00 70 9a 0e 00 00 00
            00 00 18 3c 66 ff 00 00
        }

        proc bigstr {str row col} {
            variable fontmap
            #curses attr off reverse
            #a noreverse
            set reverse 0
            set output "" 
            set charno 0
            foreach char [split $str {}] {
                binary scan $char c f
                set index [expr {$f * 8}]
                for {set line 0} {$line < 8} {incr line} {
                    set bitline 0x[lindex $fontmap [expr {$index + $line}]]
                    binary scan [binary format c $bitline] B8 charline
                    set cix 0
                    foreach c [split $charline {}] {
                        if {$c} {
                            append output [punk::ansi::move_emit [expr {$row + $line}] [expr {$col + $charno * 8 + $cix}] "[a reverse] [a noreverse]"]
                            #curses attr on reverse
                            #curses move [expr $row + $line] [expr $col + $charno * 8 + $cix]
                            #curses puts " "
                        }
                        incr cix
                    }
                }
                incr charno
            }
            return $output
        }
        proc display1 {} {
            #punk::console::clear
            punk::console::move_call_return 20 20 {punk::console::clear_above}
            flush stdout
            punk::console::move_call_return 0 0 {puts stdout [bigstr [clock format [clock seconds] -format %H:%M:%S] 10 5]}
            after 2000 {punk::console::clock::display}
        }
        proc display {} {
            lassign [punk::console::get_cursor_pos_list] orig_row orig_col
            punk::console::move 20 20 
            punk::console::clear_above
            punk::console::move 0 0 
            puts -nonewline [bigstr [clock format [clock seconds] -format %H:%M:%S] 10 5]

            punk::console::move $orig_row $orig_col
            #after 2000 {punk::console::clock::display}
        }

        proc displaystr {str} {
            lassign [punk::console::get_cursor_pos_list] orig_row orig_col
            punk::console::move 20 20 
            punk::console::clear_above
            punk::console::move 0 0 
            puts -nonewline [bigstr $str 10 5]

            punk::console::move $orig_row $orig_col
        }


    }

    proc test {} {
        set high_unicode_length [string length \U00010000]
        set can_high_unicode 0
        set can_regex_high_unicode 0
        set can_terminal_report_dingbat_width 0
        set can_terminal_report_diacritic_width 0
        if {$high_unicode_length != 1} {
            puts stderr "punk::console WARNING: no modern unicode support in this Tcl version. High unicode values not properly supported. (string length \\U00010000 : $high_unicode_length should be 1)"
        } else {
            set can_high_unicode 1
            set can_regex_high_unicode [string match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525]
            if {!$can_regex_high_unicode} {
                puts stderr "punk::console warning: TCL version cannot perform braced regex of high unicode"
            }
        }
        set dingbat_heavy_plus_width [punk::console::test_char_width \U2795] ;#review - may be font dependent. We chose a wide dingbat as a glyph that is hopefully commonly renderable - and should display 2 wide.
        #This will give a false report that terminal can't report width if the glyph (or replacement glyph) is actually being rendered 1 wide.
        #we can't distinguish without user interaction?
        if {$dingbat_heavy_plus_width == 2} {
            set can_terminal_report_dingbat_width 1
        } else {
            puts stderr "punk::console warning: terminal either not displaying wide unicode as wide, or unable to report width properly." 
        }
        set diacritic_width [punk::console::test_char_width a\u0300]
        if {$diacritic_width == 1} {
            set can_terminal_report_diacritic_width 1
        } else {
            puts stderr "punk::console warning: terminal unable to report diacritic width properly." 
        }

        if {$can_high_unicode && $can_regex_high_unicode && $can_terminal_report_dingbat_width && $can_terminal_report_diacritic_width} {
            set result [list result ok]
        } else {
            set result [list result error]
        }
        return $result
    }
    #run the test and allow warnings to be emitted to stderr on package load. User should know the terminal and/or Tcl version are not optimal for unicode character work
    #set testresult [test1]
}














# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Ready   
package provide punk::console [namespace eval punk::console {
    variable version
    set version 999999.0a1.0 
}]
return