1# -*- tcl -*- 2# ### ### ### ######### ######### ######### 3## Terminal packages - ANSI - Control codes 4 5## References 6# [0] Google: ansi terminal control 7# [1] http://vt100.net/docs/vt100-ug/chapter3.html 8# [2] http://www.termsys.demon.co.uk/vtansi.htm 9# [3] http://rrbrandt.dyndns.org:60000/docs/tut/redes/ansi.php 10# [4] http://www.dee.ufcg.edu.br/~rrbrandt/tools/ansi.html 11# [5] http://www.ecma-international.org/publications/standards/Ecma-048.htm 12 13# ### ### ### ######### ######### ######### 14## Requirements 15 16package require term::ansi::code 17package require term::ansi::code::attr 18 19namespace eval ::term::ansi::code::ctrl {} 20 21# ### ### ### ######### ######### ######### 22## API. Symbolic names. 23 24proc ::term::ansi::code::ctrl::names {} { 25 variable ctrl 26 return $ctrl 27} 28 29proc ::term::ansi::code::ctrl::import {{ns ctrl} args} { 30 if {![llength $args]} {set args *} 31 set args ::term::ansi::code::ctrl::[join $args " ::term::ansi::code::ctrl::"] 32 uplevel 1 [list namespace eval ${ns} [linsert $args 0 namespace import]] 33 return 34} 35 36# ### ### ### ######### ######### ######### 37 38## TODO = symbolic key codes for skd. 39 40# ### ### ### ######### ######### ######### 41## Internal - Setup 42 43proc ::term::ansi::code::ctrl::DEF {name esc value} { 44 variable ctrl 45 define $name $esc $value 46 lappend ctrl $name 47 namespace export $name 48 return 49} 50 51proc ::term::ansi::code::ctrl::DEFC {name arguments script} { 52 variable ctrl 53 proc $name $arguments $script 54 lappend ctrl $name 55 namespace export $name 56 return 57} 58 59proc ::term::ansi::code::ctrl::INIT {} { 60 # ### ### ### ######### ######### ######### 61 ## 62 63 # Erasing 64 65 DEF eeol escb K ; # Erase (to) End Of Line 66 DEF esol escb 1K ; # Erase (to) Start Of Line 67 DEF el escb 2K ; # Erase (current) Line 68 DEF ed escb J ; # Erase Down (to bottom) 69 DEF eu escb 1J ; # Erase Up (to top) 70 DEF es escb 2J ; # Erase Screen 71 72 # Scrolling 73 74 DEF sd esc D ; # Scroll Down 75 DEF su esc M ; # Scroll Up 76 77 # Cursor Handling 78 79 DEF ch escb H ; # Cursor Home 80 DEF sc escb s ; # Save Cursor 81 DEF rc escb u ; # Restore Cursor (Unsave) 82 DEF sca esc 7 ; # Save Cursor + Attributes 83 DEF rca esc 8 ; # Restore Cursor + Attributes 84 85 # Tabbing 86 87 DEF st esc H ; # Set Tab (@ current position) 88 DEF ct escb g ; # Clear Tab (@ current position) 89 DEF cat escb 3g ; # Clear All Tabs 90 91 # Device Introspection 92 93 DEF qdc escb c ; # Query Device Code 94 DEF qds escb 5n ; # Query Device Status 95 DEF qcp escb 6n ; # Query Cursor Position 96 DEF rd esc c ; # Reset Device 97 98 # Linewrap on/off 99 100 DEF elw escb 7h ; # Enable Line Wrap 101 DEF dlw escb 7l ; # Disable Line Wrap 102 103 # Graphics Mode (aka use alternate font on/off) 104 105 DEF eg esc F ; # Enter Graphics Mode 106 DEF lg esc G ; # Exit Graphics Mode 107 108 ## 109 # ### ### ### ######### ######### ######### 110 111 # ### ### ### ######### ######### ######### 112 ## Complex, parameterized codes 113 114 # Select Character Set 115 # Choose which char set is used for default and 116 # alternate font. This does not change whether 117 # default or alternate font are used 118 119 DEFC scs0 {tag} {esc ($tag} ; # Set default character set 120 DEFC scs1 {tag} {esc )$tag} ; # Set alternate character set 121 122 # tags in A : United Kingdom Set 123 # B : ASCII Set 124 # 0 : Special Graphics 125 # 1 : Alternate Character ROM Standard Character Set 126 # 2 : Alternate Character ROM Special Graphics 127 128 # Set Display Attributes 129 130 DEFC sda {args} {escb [join $args ";"]m} 131 132 # Force Cursor Position (aka Go To) 133 134 DEFC fcp {r c} {escb ${r}\;${c}f} 135 136 # Cursor Up, Down, Forward, Backward 137 138 DEFC cu {{n 1}} {escb [expr {$n == 1 ? "A" : "${n}A"}]} 139 DEFC cd {{n 1}} {escb [expr {$n == 1 ? "B" : "${n}B"}]} 140 DEFC cf {{n 1}} {escb [expr {$n == 1 ? "C" : "${n}C"}]} 141 DEFC cb {{n 1}} {escb [expr {$n == 1 ? "D" : "${n}D"}]} 142 143 # Scroll Screen (entire display, or between rows start end, inclusive). 144 145 DEFC ss {args} { 146 if {[llength $args] == 0} {return [escb r]} 147 if {[llength $args] == 2} {foreach {s e} $args break ; return [escb ${s};${e}r]} 148 return -code error "wrong\#args" 149 } 150 151 # Set Key Definition 152 153 DEFC skd {code str} {escb "${code};\"${str}\"p"} 154 155 # Terminal title 156 157 DEFC title {str} {esc "\]0;${str}\007"} 158 159 # Switch to and from character/box graphics. 160 161 DEFC gron {} {return \016} 162 DEFC groff {} {return \017} 163 164 # Character graphics, box symbols 165 # - 4 corners, 4 t-junctions, 166 # one 4-way junction, 2 lines 167 168 DEFC tlc {} {return [gron]l[groff]} ; # Top Left Corner 169 DEFC trc {} {return [gron]k[groff]} ; # Top Right Corner 170 DEFC brc {} {return [gron]j[groff]} ; # Bottom Right Corner 171 DEFC blc {} {return [gron]m[groff]} ; # Bottom Left Corner 172 173 DEFC ltj {} {return [gron]t[groff]} ; # Left T Junction 174 DEFC ttj {} {return [gron]w[groff]} ; # Top T Junction 175 DEFC rtj {} {return [gron]u[groff]} ; # Right T Junction 176 DEFC btj {} {return [gron]v[groff]} ; # Bottom T Junction 177 178 DEFC fwj {} {return [gron]n[groff]} ; # Four-Way Junction 179 180 DEFC hl {} {return [gron]q[groff]} ; # Horizontal Line 181 DEFC vl {} {return [gron]x[groff]} ; # Vertical Line 182 183 # Optimize character graphics. The generator commands above create 184 # way to many superfluous commands shifting into and out of the 185 # graphics mode. The command below removes all shifts which are 186 # not needed. To this end it also knows which characters will look 187 # the same in both modes, to handle strings created outside this 188 # package. 189 190 DEFC groptim {string} { 191 variable grforw 192 variable grback 193 while {![string equal $string [set new [string map \ 194 "\017\016 {} \016\017 {}" [string map \ 195 $grback [string map \ 196 $grforw $string]]]]]} { 197 set string $new 198 } 199 return $string 200 } 201 202 ## 203 # ### ### ### ######### ######### ######### 204 205 # ### ### ### ######### ######### ######### 206 ## Higher level operations 207 208 # Clear screen <=> CursorHome + EraseDown 209 # Init (Fonts): Default ASCII, Alternate Graphics 210 # Show a block of text at a specific location. 211 212 DEFC clear {} {return [ch][ed]} 213 DEFC init {} {return [scs0 B][scs1 0]} 214 215 DEFC showat {r c text} { 216 if {![string length $text]} {return {}} 217 return [fcp $r $c][sca][join \ 218 [split $text \n] \ 219 [rca][cd][sca]][rca][cd] 220 } 221 222 ## 223 # ### ### ### ######### ######### ######### 224 225 # ### ### ### ######### ######### ######### 226 ## Attribute control (single attributes) 227 228 foreach a [::term::ansi::code::attr::names] { 229 DEF sda_$a escb "[::term::ansi::code::attr::$a]m" 230 } 231 232 ## 233 # ### ### ### ######### ######### ######### 234 return 235} 236 237# ### ### ### ######### ######### ######### 238## Data structures. 239 240namespace eval ::term::ansi::code::ctrl { 241 namespace import ::term::ansi::code::define 242 namespace import ::term::ansi::code::esc 243 namespace import ::term::ansi::code::escb 244 245 variable grforw 246 variable grback 247 variable _ 248 foreach _ { 249 ! \" # $ % & ' ( ) * + , - . / 250 0 1 2 3 4 5 6 7 8 9 : ; < = > 251 ? @ A B C D E F G H I J K L M 252 N O P Q R S T U V W X Y Z [ \\ 253 ] ^ 254 } { 255 lappend grforw \016$_ $_\016 256 lappend grback $_\017 \017$_ 257 } 258 unset _ 259} 260 261::term::ansi::code::ctrl::INIT 262 263# ### ### ### ######### ######### ######### 264## Ready 265 266package provide term::ansi::code::ctrl 0.1.1 267 268## 269# ### ### ### ######### ######### ######### 270