Various coloring scripts
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

79 lines
2.4 KiB

#!/usr/bin/tclsh
array set arguments {-rnd 0.3 -text magenta -keyword orange -alt cyan}
array set arguments $::argv
array set rnd "
char $arguments(-rnd)
"
array set theme "
text $arguments(-text)
keyword $arguments(-keyword)
keywordalt $arguments(-alt)
"
array set col {
red %^RED%^ bred %^BOLD%^%^RED%^
blue %^BLUE%^ bblue %^BOLD%^%^BLUE%^
orange %^ORANGE%^ borange %^BOLD%^%^ORANGE%^
green %^GREEN%^ bgreen %^BOLD%^%^GREEN%^
black %^BOLD%^%^BLACK%^ bblack %^BOLD%^%^BLACK%^
white %^WHITE%^ bwhite %^BOLD%^%^WHITE%^
cyan %^CYAN%^ bcyan %^BOLD%^%^CYAN%^
magenta %^MAGENTA%^ bmagenta %^BOLD%^%^MAGENTA%^
reset %^RESET%^
}
#Randomly colors the word
# IN: word
# main color
# secondary color
# percentage of secondary color accurance
# OUT: color coded string
proc wordColor {word color rcolor tolerance} {
global rnd col
set len [string length $word]
set charList [regexp -inline -all -- {.} $word]
set newWord ""
foreach {char} $charList {
if {[expr {rand()}] < $tolerance} {
set newWord [string cat $newWord "$col(reset)$col($color)$char$col(reset)$col($rcolor)"]
} else {
set newWord [string cat $newWord $char]
}
}
return $newWord
}
proc lineColor {line} {
global rnd theme col
if {$line == ""} {
return ""
}
set wordList [regexp -inline -all -- {\S+} $line]
foreach {word} $wordList {
if {[string index $word 0] == "@"} {
set color $theme(keyword)
set altColor $theme(keywordalt)
if {[string index $word 1] == "("} {
set tmp [regexp -inline -all -- {\@\((\w+),(\w+)\)} $word]
set color [lindex $tmp 1]
set altColor [lindex $tmp 2]
set word [string range $word [expr [string first ")" $word] + 1] [string length $word]]
} else {
set word [string range $word 1 [string length $word]]
}
set word [wordColor $word $altColor $color $rnd(char)]
lappend newText "$col(reset)$col($color)$word$col(reset)$col($theme(text))"
} else {
lappend newText $word
}
}
return "$col($theme(text))[join $newText " "]$col(reset)"
}
while {[gets stdin text] >= 0} {
puts [lineColor $text]
}