#!/bin/sh # the next line restarts using wish \ exec wish "$0" ${1+"$@"} # Potato 2 (Potatoes?) # April 25 2003 # Bug fixes provided by (until there's a help-file to mention # them in, and so I don't forget anyone): Larry Virden, FW proc setVars {} { # Set global variables. Run at startup only global p conn tcl_platform tcl_wordchars tcl_nonwordchars global tcl_patchLevel tk_patchLevel auto_path set p(wmstate) "Configure" set p(name) "Potato MU* Client" set p(nick) "Potato" set p(version) "0.2.20" set date "July 12 2004" set p(date) "[clock scan "00:00 $date" -gmt 0]" set p(contact) "talvohornblower@hotmail.com" set p(saving) "0" set p(platform) $tcl_platform(platform) if { $p(platform) == "windows" } { switch -glob -- $tcl_platform(osVersion) { 1.3* {set p(os) "Windows 3.1"} 4.0 {set p(os) "Windows 95"} 4.10 {set p(os) "Windows 98"} 4.90 {set p(os) "Windows ME"} 5.0* {set p(os) "Windows 2000"} 5.1* {set p(os) "Windows XP"} } } else { set p(os) "$tcl_platform(os) $tcl_platform(osVersion)" } set p(tclPatch) $tcl_patchLevel ; set p(tkPatch) $tk_patchLevel # Record the platform's default font for labels. catch {label .tempLabel set p(label) [list [font actual [.tempLabel cget -font] \ -displayof . -family]] destroy .tempLabel } # Change tcl_wordchars and tcl_nonwordchars. First, # we need to have Tcl set them itself. # Tip from http://mini.net/tcl/1503 catch {tcl_endOfWord} set tcl_wordchars {[a-zA-Z0-9' ]} set tcl_nonwordchars {[^a-zA-Z0-9']} # Folder is the current working dir. set p(folder) [file dirname [info script]] # Windows needs the short name for some things. catch {set p(folder) [file attributes $p(folder) -shortname]} # preffile is the place to read from and save to. preffile2 is the # backup we make when saving. library is library files (duh), img # is images/icons/cursors, worlds and gags world/gag info. :p # logdir is the default logging directory. logdirE is used by # the logging commands and should default to logdir. # locale is where msgcat messages are stored. set p(preffile) [file join $p(folder) potato.ini] set p(preffile2) [file join $p(folder) backup.ini] set p(library) [file join $p(folder) lib] set p(img) [file join $p(folder) img] set p(logdir) [file join $p(folder) Logs] set p(logdirE) $p(logdir) set p(worlds) [file join $p(folder) Worlds] set p(gags) [file join $p(worlds) Gags] set p(timers) [file join $p(worlds) Timers] set p(locale) [file join $p(folder) msgs] set chklist "library img logdir worlds gags timers locale" foreach x $chklist { if { ![file exists $p($x)] \ || ![file isdirectory $p($x)]} { file mkdir $p($x) } } # Some cursors. 'setCursor_init' sets this up. set p(cursor-handB) hand2 set p(cursor-harrowB) sb_h_double_arrow set p(cursor-varrowB) sb_v_double_arrow set p(cursor-handW) [file join $p(img) hand.cur] set p(cursor-harrowW) [file join $p(img) horizontal.cur] set p(cursor-varrowW) [file join $p(img) vertical.cur] # Nice little color icons for Windows. Crappy black and white ones # for everyone else :) 'setIcon_init' does the Windows check for it. set p(iconB) "[imageFor iconbitmap]" ;# mono bitmap icon set p(iconW) "[file join $p(img) Potato.ico]" ;# Windows icon set conn(limbo) "" set conn(waiting) "" set conn(on) "" set conn(full) "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20" set conn(off) $conn(full) # conn(full) must never contain '0', it's reserved for the # 'not connected anywhere' "world". It can be extented to over 20 # if you want (keeping to numbers only), but: # 1) it may cause memory problems, or other similar issues # 2) the client being able to handle 20+ connections at once depends # on my coding skill. Don't count on it :P # 3) Does ANYONE ever log into 20 worlds at once?? Let alone more :p # p(textEdit) is set later, via 'toggleBindings'; 'main' must be run first # p() isn't the best place for these, but oh well :p set p(wState,1) "normal" set p(wState,0) "disabled" lappend ::auto_path $p(library) };# setVars proc showWebPage {page} { global tcl_platform if { $tcl_platform(platform) == "windows" } { if { [string match "4.*0" $tcl_platform(osVersion)] } { catch {eval exec [auto_execok start] [list $page] &} } else { catch {eval exec [auto_execok start] [list [regsub -all {&} $page {^&}]] &} } } elseif { $tcl_platform(platform) == "Darwin" } { catch {exec open $page} } elseif { $tcl_platform(platform) == "unix" } { foreach browser {htmlview mozilla konqueror netscape} { set binary [lindex [auto_execok $browser] 0] if {[string length $binary]} { catch {exec $binary $page &} break } };# foreach } return; };# showWebPage proc about {} { global p set w .about if { [winfo exists $w] } { wm deiconify $w raise $w focus $w return; } image create photo ::img::tcltk -data { R0lGODdheAC1APcAAP/////cAP7x8v7r8v7NAv3a5f29Bvzj5PvW1/vI1/uv CPrIyfq4y/qhCvmnvfmTDvi6vPiYsPiGEPesrvbr+PaeofaJo/Z6EvXZ7PV7 lfVvFfSRk/Rth/RiF/OEhvNge/NYGfK20fJ2efGnxPFoa/FVbfFOG/CXtvBJ YPBEH+9aXu5MUO4/Uu47Ie3Z8u0/Q+01Q+0zI+xsjuwsNuwqJusxNeq21+pg geojKOdJZuV5o+PG6+NsleK13uJfh+IjL9+VxN9Ibd4+X9x5qdw0UttrnNoj Ntm15dlfjtik19eUytN3sNIqS9FeldEiPM+i3s6U0c5He8t3tsszX8giQ8ZR jsVGgMST18F2vb8hS7mD0bd2w7cybbYpX7VbqbUhUq51yq4xdKxnvKwpZqog WKlPoqdFlaMxeqFnw6AgX59atpxEm5o6jpgwgJRavJQgZpBEoowwh4oneogf bYZOtYNDqX8vjnofc3ZDsHEvlG0eemU3qVwegFAuokkehzElmywejQAdlAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAACwAAAAAeAC1AAAI/wABCBxIsKDBgwgTGkSwoCGE DRA3iFBBUQWOixdfbDigsKPHjyBDEjzQsGGFiB4qqniBsaXLlzBxkIAgsqZN hCUXPIxIQmXMn0CD/tTI8aZRgRE3pKxYQ6jTp1Cfzjx6M6rVq1iB1vBQlGpB kiUnQMxKtmxWFRMOCsi5E+JSiizNyp0rt4aKFXTz6t3LN2jTvoADl7UouLBh pxQPK17csifjx4c3EIZMua/kypj3VpicuXPZBSQAz/iQYcbPEgkAOGDhOeuC DX1LDAAQ4acFggNgtL6KAPbeEgJzx/xgsPbuqAB8550xG0CGmCwMMmBwHLly uhwG6oZZYOCA0tWj1v9IvpeBQOMvMwxMsD08VBUAKuwdyPolc4EJTLuPCn+B XhT4xRSBQAXotx9UJADgX14AAsABTDAMhMKBVm2goF7EAdBeS+o5R2GFF+al XgEw3Vfgh1FVECJd6qHXUnYAfCBXCRnUuCFkCwCAgF7ZyfhSdySWlUFzA1mA WY4A/AfAhC41+GBWLHR3kIuMISCQkjANOICBVmWYkI+PDaRXdPbNRiVUAxZ0 BBhgaIEBAANQJqZecbqUIZNWpSkQBWD0EcifgfhRRIyPjXelXmc6AECQeRL0 xB+ARhqIFw48Bp9AcdFlpEsCbRqVnhTQIemoT/zA2KUAcCbXcy0BB0AJXQ7/ tIOfo0q6xxqMJSiQqmbB2tJtdULlKgCP1lrrGIxZuKtgqVUKFQvNXWFsrXM8 pmyqgc0g0JNOzZAaANJOKykfpjKm4rKAuVqfU2mGKy6ggBiB40AiBKZesEK5 6u67f2ZBGZLkAWYedd3OtgOk/P75hlkzrBuVlUgFNhurQilKAa0J8zGXeQ7g 6RRB1+ml7ZJONShqwn86IRQMHJgHAAMOX3QfbVCBDFiDXP7U3RMo/5mGUyzA KJCzdkrolKERxwanU8RRgHDGUd02548CUQwUqgBMAJh6BAfVHRo9B6IyVA0u DZPUVv+E9YJ8qefpT8S5EPbPUZXdtUuuggmUrgKx/73XbdzqDIAbPftxVXSd xgTglk5du2J5JAMFoNw9U3FV2R63BODbQDnut17m3fjSgISjXG1MM+SMUYP4 usQB406d27fASQKlrdMoA1Lu6hkwMBvnGHVI9EsM+OoUwAAIIHACQRG377tk rB4BkQQKKJDeLcEAPFDI187XdEEpugfKhuNARRltHuFCQaLj8K3qF8UsFMRT 7xXB9i0NQHnGfNTaBxgUEEjmcDCy4ZnFIFtLm0ui87ywSaoH13uJq4wnFwT2 JQPYcx0ATubAUQGiQwoEVl6QVj+9lGCAvwLA0zoYqTug7SWpwR9WsCYQvPAF BvJrCQN2wMJafcFlFMRBhP80lBcaYgsyA9BCD0dlhG9lLjt3kwvfBsKrwwxu iZEynHZcoqggmsVx6AoTHrAIqDkgznsyW9RewHhExgCIjIDKAoyiSJwMmkV2 VIQMCigAxz/9QFEO4iKj8tI9AHhAj0foo8aa4zBt2dEshQzZYVCQSDi+oUGD xAEHMkkX+g1EkoZBgRLhSAWpBc59jzygQUBZGBiAoY84kBKXYMC8vhyElYV5 JRn1gDgqWQCFdbklZXQ5rdKJiwxSu5EC6WJEAECAMmIQ1x/A9i4ndOdM8JtL Mz+nGDOIyw1jFBcgXNU+wExxINw8zBmMBYhANHBUdxjQMgPDxsctJg3G+gIg ePj/ri4sKpuAqWc6DfMFY/2ADZUUFw9e9Rg8opMyVKiVxsQwymn5oQBnMkwh D2UYhzmhVm8wwhOIaSw4nOgxG0WjYDJZqyxQwQXhnBYUcmgYTxJEMR7CSDsl 9QMuACCmtbLDKReTEJwS6iJ6kJThqgAAcflhd5ApqhW3Ja83SOoOOFhCU6dl ucqQsCBGFcgR6uAHSf3sCAkdFd0q08wwCsYgxQIUFX5AgbRGSmOZaWsb3yqQ 8dXqB0wAV63i5RKAmjMhVeTLQNiJgyAAgKRxxEEJLFCjBMyTnoidql0BpQcc +OCxg9VDGpRgtGRl1jAC4RlIcTCEDb6rtSo9jEMJktj5/4C2Vj8bwU/fNago Hialew2MQCArVxzYYLfiMo8MAwPc2upFIMaUlOUEgrFa+SGCKD1tYVID1Ejh 4AcCeRceBDgvhDg3L+bpLqBwQITwiksNHGVMcw9jnjVIFAcNehcY1Fjeg/yl MAPy5qg669j9GSsJL6PMbEtoLwBYoVadlQEANiup4y4XswhRjHqisFr1UDhS qbmsYOoZX8EAKAO4xYEOJiwuPmDXWlINpXNSrNUP/0kP5IUMiWMr3Awk1aw4 MI+NA5GGHD/mnDfFaQR+HCnLCfmYRj4VThYzHXxKFwchuK2xqGAeYBamrQPt SwQYQIZRWe4IWv7rgLwsGDAvRv89Eb0ymonrXeJ48TBuVgyAPirnNEuqsyeu zJQVEyEUmBkHc54WVgGUysIMWjEDKEFZm4xoP0fqZ8RhM18N8kwq+7jPdO4X DgaEGYTg8oIOmAOouRpLAzLG1G5MgJWLm2hjSTZy/xLmq7Ow6sEG2dXy1fVi EsBhStcaniiAXWU2euq+WOAGvR7VFxJA08Uw+zEosICkoodm1Urqg+vSNHMP Uq/HJIDJRK40hdPQHtJUpp7n7YsD0P2zJ7CYiReBgTzffZB48+UDAvYZDva7 2TugIAPfyqmO+w2ZGWwhUtXCwr2bPBqXKRzGBvE3X5oQqc7WWKkYyUIbdnBU yHiA4ZD/EULHszrxP82BDExGs7gB00yN8yWLODCDe6clc7YeJFOF4YDHdvon HFhh58ZCM2aauRjiWEA/6MZBFJBeqyO0TsoWPMzIBmCBKNTBr4GgQpFVKC4M +HYxKzgIYwApkH1RgQoCUS+griti1Gb9MBk6QnfJQIUAyv1Pa2Boqe9+mAIY GFBp+AGaOTgqKQDAsHYHK2OIo16sHvvbDKjl4Amyo8cUgJ8rd3yo5RDIzAig IGEODICo6d3WvjMQSCBiZrqX+sDcBux+nDqF/ZCAs2eXILUPTAJcsEIq5AAA oI9UGHB9JNRXxlsHAxQZnED1P53A979/6PMTEP1ALCyAKwxE/xwAUG3GpAX4 mZlBCKLf2fRKCghD5bfNMvMDKRwMEKN2LaDykFH5f9IzP2AHV7AHRqAeJDUF 1QFGzaYYP9A/VAAc7tJZCVgQC8iAd5AG0ZFQXXUcIkCB1SEvApEGaRA94UFD FWhuj3cgJlgZGtCCF/ASijJzLxEDLfgAgUFDNrcXKdABAdAA6VF6VkEDKRAA AXCDBZGDOtiDLxFoWUGEgfECR4gZQ+iDLhEhwPYUTihctIUVKXABIGAWUwgT A6B5M9iCP5GFgBGFV6EBAaABYKiExMNjFxGGMYGGtrSFa9iGb0iFLqEeNEWH MGGHikUQNhQVDWAAAWAADfCFMygBCv/QAA3ghjABiJpTci0BAgoQAATQAC/4 Ell4AZC4iHnRFXIoFA2ghzBhAgRggzhAAwQgAZMIh4UFAPhDiS6RhS1gAB2w F8iTFacoiS7higEQAxfBg0X4EraIEQVAhi2RjBjhhClgAIyoF72IFb8IEyCg iRiRAq8Yi3zoEgMCP854EUSYjS3QF9V4Fdf4Emz4jT8xjnbmjWeoiQEAi3yR jlaxji7Rjk4xjtGxPeOIA0RoAuXIF3jki6joEjxIAC5hAsToEgE5hvJYh0XI hgFwjnpxLQeAkMDYEsL4kK1oABMJE4qiOgGZhRKgiSA5F9cSfDHBhhJgAgrw Etn4ADTQigr/MI3byIMKkAIYqUFeNIQGkAISsJJCSIQpEAMtQAAB0JM3yZLa dxW5GAAP8JPN+ACb2AAmABOhCImduEAXhxEPkIi72BIt0JUgAAJdaZVl0ZIo 8h3uwTcumRkRUHeUgSpziRnuVoJReSAzYJeQgSrygSLllFf/hyL7gTQniJhR lTSMGR6H+ZjVEZmSuRuUWZmegSShgZm7gSRIyJnjFlyguWxuNZqkKZqmiXGf mZoZWZqsaVql+JqGoSyyKX+1eZclBhh2oQIikBS+qRQqURGF6B6XQhcrQBER 0RA25RUEsRY54RC/CZzBeRfalJsx8QIU0ZsbAAENcXrM+Z3f6ZzPFtkWSZES J+c9FQERFaCc4Nme7tmeAQEAOw== };# image create tcltk toplevel $w wm withdraw $w wm title $w "[mc aboutX $p(name)]" wm resizable $w 0 0 frame $w.cont pack $w.cont pack [frame $w.cont.l -relief ridge -borderwidth 2] -side left \ -padx 3 -ipadx 3 -pady 5 -ipady 5 \ -expand 1 -fill both pack [frame $w.cont.m] -side left -padx 3 -ipadx 3 \ -expand 1 -fill both pack [frame $w.cont.r -relief ridge -borderwidth 2] -side right \ -padx 3 -ipadx 3 -pady 5 -ipady 5 \ -expand 1 -fill both label $w.cont.l.logo -image [imageFor potatologo] pack $w.cont.l.logo -padx 2 -ipadx 2 -pady 2 -ipady 2 -side left set time [clock format $p(date) -format {%B %e %Y} -gmt 0] set time [list [lindex $time 0] [num2ord [lindex $time 1]] [lindex $time 2]] set text "$p(name)\n[mc word,ver] $p(version)\n" set text "$text[mc word,updated $time]" label $w.cont.m.top -text $text -wraplength 175 -justify left -anchor nw \ -font [font actual "$p(label) -11 bold" -displayof $w] pack $w.cont.m.top -expand 1 -fill x -pady 3 set text [mc about,credits $p(nick) $p(contact)] label $w.cont.m.text -text $text -wraplength 175 -justify left -anchor nw \ -font [font actual "$p(label) -10" -displayof $w] pack $w.cont.m.text -expand 1 -fill both label $w.cont.r.logo -image [imageFor tcltk] pack $w.cont.r.logo -side top -expand 1 -fill y # set tcl [mc packVer Tcl $p(tclPatch)] # set tk [mc packVer Tk $p(tkPatch)] # label $w.cont.r.text -font [font actual {Times -18} -displayof $w] \ -text "$tcl\n$tk" # pack $w.cont.r.text bind $w <> "image delete ::img::tcltk ; destroy $w" bind $w [list event generate $w <>] bind $w [list event generate $w <>] bind $w [list event generate $w <>] update center $w wm deiconify $w raise $w focus $w bell -displayof $w update };# about proc num2ord {num} { regexp {^[^0-9]*([0-9]+)$} $num -> tnum if { $tnum == "11" || $tnum == "12" || $tnum == "13" } { return ${num}th; } switch [string range $num end end] { 1 {append num st} 2 {append num nd} 3 {append num rd} 4 - 5 - 6 - 7 - 8 - 9 - 0 {append num th} } return $num; };# num2ord proc aboutPacks {} { global p set w .aboutPacks if { [winfo exists $w] } { wm deiconify $w raise $w focus $w return; } set pf(unix) { R0lGODlhEAAQAIIAAPwCBAQCBPz+/ISChPz+BMTCBISCBAAAACH5BAEAAAAA LAAAAAAQABAAAANHCLrRsTC6F6UId1TYiNtMQRQNqARDOlAgJrzlhr7vqlUu fbHMoMO8k+8XY4yGtc9pREIORKRTYVoYDgxUVmBqmGCLJzDYnwAAIf5oQ3Jl YXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3Ig MTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5k ZXZlbGNvci5jb20AOw== } set pf(windows) { R0lGODlhIAAgALMAANnZ2QAAAIAAAACAAP8AAAD/AAAAgICAAAAA////AP// /////////////////////yH5BAEAAAAALAAAAAAgACAAAAT/EMhJq704680p DHJSCOSktcIgJ6UABAjkpDSEEIQQIcAhQwgBBABAAACCAAAIIIQQBCFQhDBK GSGEAECAIQAQAgghgBACJJKIEEYppYQQIAAhBBBCACEEAIMkhBAhRymlyAAB EIIMIYAQAggwBEIIESGMUkqBQRIIpAwzzBACIYRAEcIopZQQAgEAAgIAIAAA AkIIkEgiQhillBJCgAAQQiQhgBACAgyBEEJECKOUUmCQABBCACAEEAIJCCEQ AYOccpQJACEAEEgIIIQAGOSklUIgJZlkwiClMUaec+YEAIIAAAgAgABCCNAg hEwIJ6V0QoABgBACACGAEAIEIQSE3BAyIZyUYEohBABCCCCEAEEIAYQQEELI BBhOSimFEAAIAUAQQgAhBBBCQAgiZEI4KaUUQkAQSBlmmCEEhBCCJoSTUkoh BAQABAgAgAAACIQQIJLIhHBSSimEAAFACEmEAEIIBBgCQgiZEE5KKcEgAUAI AYAQQAgiEEJAyBgTwjnwpBRCAAAhABCCCCCEAAxy0kohkBJNNGGQk1YKAAgA gACBDAAGKSGQU8IgJQATAAkmmBDISWUIQYYQQIAhgBACBHLSakOQIQQQYAgQ yEmrpWGGe++913Vd13UBUAQAOw== } set pf(macintosh) { R0lGODlhEAAQAKIAANnZ2QD/AP//AP8AAAAA/////////////yH5BAEAAAAA LAAAAAAQABAAAANPCLobzEyhCARd3sAIBF3GUEXQXQxdDgRVFF0WQABA0WVB UMXR5UFQxdHlQVDF0eVBUMXRZUVQxdFlBQQAHF0eBF0k3UXQVSIkICIEXW7H BAA7 } image create photo ::img::PF -data $pf($p(platform)) toplevel $w wm withdraw $w wm title $w "$p(nick) - [mc packs,title]" wm resizable $w 0 0 frame $w.top pack $w.top set text [mc packs,info $p(nick)] label $w.top.l -text $text -wraplength 350 \ -font [font actual "Helvetica -17"] pack $w.top.l -pady 4 set pack(Tcl,ver) $p(tclPatch) ; set pack(Tcl,col) blue set pack(Tk,ver) $p(tkPatch) ; set pack(Tk,col) blue set pack(IWidgets,ver) [package present Iwidgets] ; set pack(IWidgets,col) blue set NN [mc notNeeded] set NA [mc notAvailable] if { $p(hasWinico) == "-1" } { set pack(Winico,ver) $NN set pack(Winico,col) black } elseif { $p(hasWinico) == "1" } { set pack(Winico,ver) [package present Winico] set pack(Winico,col) blue } else { set pack(Winico,ver) $NA set pack(Winico,col) red } if { $p(hasWinflash) == "-1" } { set pack(Winflash,ver) $NN set pack(Winflash,col) black } elseif { $p(hasWinflash) == "1" } { set pack(Winflash,ver) [package present Winflash] set pack(Winflash,col) blue } else { set pack(Winflash,ver) $NA set pack(winflash,col) red } if { $p(hasImg) } { set pack(Img,ver) [package present Img] set pack(Img,col) blue } else { set pack(Img,ver) $NA set pack(Img,col) red } if { $p(hasSnack) } { set pack(Snack,ver) [package present snack] set pack(Snack,col) blue } else { set pack(Snack,ver) $NA set pack(Snack,col) red } if { $p(hasCtext) } { set pack(Ctext,ver) [package present ctext] set pack(Ctext,col) blue } else { set pack(Ctext,ver) $NA set pack(Ctext,col) red } set style {underline} pack [frame $w.0] -expand 1 -fill x label $w.0.l -text [mc word,package] -width 25 -anchor nw -justify left \ -font [font actual "$p(label) -12 $style" -displayof $w] pack $w.0.l -side left -padx 9 label $w.0.r -text [mc word,ver] -width 15 -anchor nw -justify left \ -font [font actual "$p(label) -12 $style" -displayof $w] pack $w.0.r -side left set i 1 foreach x {Tcl Tk IWidgets Snack Img Winico Ctext} { pack [frame $w.$i] -expand 1 -fill x label $w.$i.l -text "$x" -width 25 -anchor nw -justify left \ -font [font actual "$p(label) -12" -displayof $w] \ -foreground $pack($x,col) pack $w.$i.l -side left -padx 9 label $w.$i.r -text "$pack($x,ver)" -width 15 -anchor nw -justify left \ -font [font actual "$p(label) -12" -displayof $w] \ -foreground $pack($x,col) pack $w.$i.r -side left incr i; } frame $w.os pack $w.os -expand 1 -fill both -pady 3 label $w.os.fill -width 8 label $w.os.t -text [mc packs,os $p(os)] label $w.os.i -image [imageFor PF 1] pack $w.os.fill $w.os.i $w.os.t -expand 0 \ -fill x -padx 2 -side left frame $w.btm pack $w.btm -side bottom -pady 5 -ipady 3 button $w.btm.close -text [mc word,close] \ -underline 0 -width 10 -default active \ -command [list event generate $w <>] pack $w.btm.close bind $w [list event generate $w <> \; break] bind $w [list event generate $w <>] bind $w [list event generate $w <>] bind $w <> "image delete ::img::PF ; destroy $w" update center $w update wm deiconify $w raise $w focus $w bell -displayof $w };# aboutPacks namespace eval Penn {} proc Penn::setdiff {arg1 arg2} { set list "" foreach x $arg1 { if { [lsearch -exact $arg2 $x] == "-1" } { lappend list $x } } return [lsort -unique $list]; };# Penn::setdiff proc Penn::setunion {arg1 arg2} { foreach x $arg1 { lappend arg2 $x } return [lsort -unique $arg2]; };# Penn::setunion proc Penn::setinter {arg1 arg2} { set list "" foreach x $arg1 { if { [lsearch -exact $arg2 $x] != "-1" } { lappend list $x } } return [lsort -unique $list] };# Penn::setinter proc Penn::inc {num} { return [expr $num + 1]; };# Penn::inc proc Penn::dec {num} { return [expr $num - 1]; };# Penn::dec proc Penn::before {string1 string2} { if { [set point [string first $string2 $string1]] == "-1" } { return $string1; } else { return [string range $string1 0 [::Penn::dec $point]]; } };# Penn::before proc Penn::after {string1 string2} { if { [set point [string first $string2 $string1]] == "-1" } { return; } set point [expr $point + [string length $string2]] return [string range $string1 $point end]; };# Penn::after proc Penn::lnum {num {num2 DEF}} { # Limitations: only does 0 - 409 if { $num == $num2 } {return $num;} if {$num > $num2 && $num2 != "DEF"} { set rev -decreasing ; set num3 $num ; set num $num2 ; set num2 $num3 } else { set rev -increasing } if { $num2 == "DEF" } { set num2 [::Penn::dec $num] set num 0 } if { $num < 0 } { set num 0} if { $num > 409 } {return "409";} if { $num2 < 2 } {return 0;} if { $num2 > 409 } {set num2 409} set nums "0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22" set nums "$nums 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40" set list 0 foreach x {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 } { foreach y {0 1 2 3 4 5 6 7 8 9} { set this [string trimleft $x$y 0] if { $this != "" } { lappend list $this } } } return [lsort $rev -integer [lrange $list $num $num2]]; };# Penn::lnum proc Penn::enumerate {list {sep ,} {join and}} { if {[llength $list] == "0"} {return;} if {[llength $list] == "1"} {return $list;} if {[llength $list] == "2"} {return [linsert $list 1 $join];} set new "[lrange $list 0 0]$sep " foreach x [lrange $list 1 end-1] { append new "$x$sep " } append new "$join [lrange $list end end]" return $new; };# Penn::enumerate proc Penn::min {l} { return [lindex [lsort -real $l] 0]; };# Penn::min proc Penn::max {l} { return [lindex [lsort -real $l] end]; };# Penn::max # ::Penn::functions removed. Use info procs ::Penn::* proc moveUpDown {tW dir} { # Based on http://mini.net/tcl/3082 # Make the insertion cursor visible so bbox doesn't return empty list $tW see insert # Find the coordinates of the cursor and set the new height # manually. Note: errors rounding off, since # coordinates don't match character positions exactly. scan [$tW index insert] {%d.%d} lines char scan [$tW bbox insert] {%d %d %d %d} x y textWidth textHeight scan [$tW bbox @[winfo width $tW],[winfo height $tW]] {%*d %d %*d %*d} maxy # When updating position, make sure y is within text boundaries switch -- $dir { "up" { if { $y <= $textHeight } { $tW yview scroll -1 units } else { set y [::Penn::max [list [expr $y-$textHeight] 0]] } } "down" { if { $y >= $maxy } { $tW yview scroll 1 units } else { set y [::Penn::min [list [expr $y+$textHeight] $maxy]] } } };# switch scan [$tW bbox [$tW index @$x,$y]] {%d %d %d %*d} newx newy width # Test on which side of the character # we should position the cursor if { $x>[expr $newx+$width/2] } { set x [expr $newx+$width+1] } return [$tW index @$x,$y]; };# moveUpDown proc textHomeEnd {w d {char ""}} { if { $char == "" } { set char [$w index insert] } set insert $char if { $d == "home" } { set op "-" ; set nop "+" ; set index "1.0" } else { set op "+" ; set nop "-" ; set index [$w index end-1char] set index [$w index [::Penn::before [$w index $insert] .].end] } $w see $insert set coord [lindex [$w bbox $insert] 1] while {1} { $w see $char if { [$w compare $char == $index] } {return $index;} if { [lindex [$w bbox $insert] 1] != $coord } { $w yview scroll ${nop}1 units return [$w index "$char $nop 1 char"]; } if { [lindex [$w bbox $char] 1] != $coord } { return [$w index "$char $nop 1 char"]; } set insert $char set char [$w index "$char $op 1 char"] } };# textHomeEnd proc htmlColor {q} { set col(r) [lindex $q 0] set col(g) [lindex $q 1] set col(b) [lindex $q 2] set col(list) [list 0 1 2 3 4 5 6 7 8 9 a b c d e f] foreach x {r g b} { set col(s$x) [htmlColor2 $col($x) 16 16] set col(o$x) [expr 16*$col(s$x)] set col(e$x) [htmlColor2 [expr $col($x)-$col(o$x)] 1 1] set col(f$x) "[lindex $col(list) $col(s$x)][lindex $col(list) $col(e$x)]" } return "#$col(fr)$col(fg)$col(fb)"; };# htmlColor proc htmlColor2 {y s i} { set n 0 while { $y >= $s } { incr s $i incr n 1 } if { $n == "16" } { return "15"; } return $n; };# htmlColor2 proc fonts_init {} { global fonts # called at startup. Initializes font list. set fonts(list) [lsort [font families]] set fonts(sizes) "8 9 10 11 12 13 14 16 18 20 22 24 26 28 30 36" set fonts(fixed) "" foreach x $fonts(list) { if { [font metrics [list $x] -displayof . -fixed] } { lappend fonts(fixed) $x } } };# fonts_init proc fonts_keyPress {c w lb key} { global fonts set on [$lb curselection] set on2 [$lb get $on] set onPlus [expr $on + 1] set onPlus2 [$lb get $onPlus] if { $on == "" } { set on "0" } elseif { "$key" < [string tolower [string range $on2 0 0]] } { set on "0" } elseif { [$lb index end] == $on } { set on 0 } elseif { "$key" < [string tolower [string range $onPlus2 0 0]] } { set on 0 } else { incr on } if { $fonts($c,fixOnly) } { set which fixed } else { set which list } set regexp "^\[$key[string toupper $key]\]" set next [lsearch -regexp -start $on $fonts($which) $regexp] if { $next == "-1" } { return; } $lb selection clear 0 end $lb selection set $next $lb activate $next $lb see $next fonts_update $w.samp.l $c "" $w.top.family.lb $w.top.size.lb };# fonts_keyPress # Open a box for world $c proc fonts_popup {c {f "Courier 10"}} { global fonts # Popup a window for selecting fonts. $f is # the starting font. set w .font$c if { [winfo exists $w] } { wm deiconify $w raise $w focus $w bell return; } set updateCmd "fonts_update $w.samp.l $c \"\" $w.top.family.lb $w.top.size.lb" toplevel $w wm withdraw $w wm resizable $w 0 0 wm title $w "Select Font" pack [frame $w.top] -expand 1 -fill both labelframe $w.top.family -labelanchor nw -text "Family" pack $w.top.family -side left -anchor nw -pady 3 -padx 3 \ -expand 0 -fill none listbox $w.top.family.lb -height 8 -exportselection 0 \ -yscrollcommand [list $w.top.family.sb set] set lb1 $w.top.family.lb bind $lb1 "$updateCmd" foreach x {a b c d e f g h i j k l m n o p q r s t u v w x y z} { bind $w [list fonts_keyPress $c $w $lb1 $x] bind $w "" \ [list fonts_keyPress $c $w $lb1 $x] } bindtags $lb1 "Listbox $lb1 [winfo toplevel $lb1] all" scrollbar $w.top.family.sb -command [list $w.top.family.lb yview] \ -orient vertical pack $w.top.family.lb -expand 0 -fill both -side left pack $w.top.family.sb -side right -fill y labelframe $w.top.style -labelanchor nw -text "Style" pack $w.top.style -side left -anchor nw -pady 3 -padx 3 \ -ipady 2 -ipadx 2 -expand 0 -fill none foreach x {bold italic underline overstrike} { pack [frame $w.top.style.$x] -side top -anchor nw \ -pady 2 -padx 2 checkbutton $w.top.style.$x.chk \ -variable fonts($c,[string range $x 0 0]) \ -selectcolor grey90 -activebackground grey85 \ -indicatoron 0 -image [imageFor $x] \ -command $updateCmd \ -onvalue "$x" pack $w.top.style.$x.chk -side left -padx 2 label $w.top.style.$x.l -text "[string totitle $x 0 0]" \ -underline 0 pack $w.top.style.$x.l -side left } $w.top.style.overstrike.l configure -underline 8 bind $w [list $w.top.style.bold.chk invoke] bind $w [list $w.top.style.italic.chk invoke] bind $w [list $w.top.style.underline.chk invoke] bind $w [list $w.top.style.overstrike.chk invoke] labelframe $w.top.size -labelanchor nw -text "Size" pack $w.top.size -side left -anchor nw -pady 3 -padx 3 \ -expand 0 -fill none listbox $w.top.size.lb -height 8 -width 6 -exportselection 0 \ -listvariable fonts(sizes) \ -yscrollcommand [list $w.top.size.sb set] set lb2 $w.top.size.lb bind $lb2 $updateCmd bindtags $lb2 "Listbox $lb2 [winfo toplevel $lb2] all" scrollbar $w.top.size.sb -command [list $w.top.size.lb yview] \ -orient vertical pack $w.top.size.lb -expand 0 -fill both -side left pack $w.top.size.sb -expand 0 -fill y -side right pack [labelframe $w.samp -labelanchor nw -text "Sample" \ -height 50p] \ -expand 1 -fill both pack propagate $w.samp 0 label $w.samp.l -text "Sample Text" pack $w.samp.l -expand 1 -fill both -anchor center if { ![info exists font($c,fixOnly)] } { set font($c,fixOnly) 0 } set fixOnlyCmd {set Ffixed [font metrics $fonts($c,act) -displayof . -fixed] set Fwhich [lindex "list fixed" $fonts($c,fixOnly)] if { !$Ffixed && $Fwhich == "fixed" } { set fonts($c,act) [font actual "Courier 10"] } set Ffam [font actual $fonts($c,act) -family] set Fat [lsearch $fonts($Fwhich) $Ffam] $lb1 configure -listvariable fonts($Fwhich) $lb1 selection clear 0 end $lb1 selection set $Fat $lb1 activate $Fat $lb1 see $Fat } set fixOnlyCmd [string map "\$c $c \$lb1 $lb1" $fixOnlyCmd] set fixOnlyCmd "$fixOnlyCmd ; fonts_update $w.samp.l $c \"\" $lb1 $lb2" pack [frame $w.fixOnly] -side top -pady 5 checkbutton $w.fixOnly.chk -variable fonts($c,fixOnly) \ -command $fixOnlyCmd \ -text "Show Fixed-Width fonts only?" pack $w.fixOnly.chk -side left -padx 4 pack [frame $w.button] -side bottom -pady 5 button $w.button.ok -default active -text "OK" -underline 0 -width 8 \ -command [list destroy $w] button $w.button.cancel -text "Cancel" -underline 0 \ -command [list set fonts($c,act) \"\" \; destroy $w] -width 8 pack $w.button.ok $w.button.cancel -padx 3 -side left bind [list $w.button.cancel invoke] bind [list $w.button.cancel invoke] bind [list $w.button.ok invoke] bind [list $w.button.ok invoke] fonts_update $w.samp.l $c $f $w.top.family.lb $w.top.size.lb eval "$fixOnlyCmd" update center $w wm deiconify $w update raise $w focus $w tkwait window $w return $fonts($c,act) };# fonts_popup proc fonts_checkFixed {f w} { if { $f == "" } {return;} if { [font metrics $f -displayof $w -fixed] } { return $f; } set msg [mc conf,font,nonfix] if { [tk_messageBox -title "Font" -icon question -parent $w \ -type yesno -message $msg] == "yes" } { return $f; } return; };# fonts_checkFixed proc fonts_update {w c {start ""} fam size} { global fonts # Update the selection in window $w. $c is connection # If $start != "", we're running this right after # the 'Choose Font' box came up to set the first. # $fam and $size are the listboxes for each :) if { $start != "" } { set font [font actual $start -displayof $w] set listIt 0 $fam selection clear 0 end set at [lsearch $fonts(list) [font actual $start -family]] set fonts($c,f) [font actual $start -family] $fam selection set $at $fam activate $at $fam see $at set close [closest [font actual $start -size] $fonts(sizes)] set fonts($c,s) $close set close [lsearch -integer $fonts(sizes) $close] $size selection clear 0 end $size selection set $close $size activate $close $size see $close foreach x {underline overstrike} { if { [font actual $start -$x] == "1" } { set fonts($c,[string range $x 0 0]) $x } else { set fonts($c,[string range $x 0 0]) "" } } if { [font actual $start -weight] == "normal" } { set fonts($c,b) "" } else { set fonts($c,b) "bold" } if { [font actual $start -slant] == "roman" } { set fonts($c,i) "" } else { set fonts($c,i) "italic" } } else { foreach x {b i u o} { set $x $fonts($c,$x) } set f [$fam get active] set s [$size get active] set listIt 1 set opts [list [::Penn::setdiff "$b $i $u $o" {{}}]] set opts [list [::Penn::setdiff "$b $i $u $o" 0]] if { [::Penn::setdiff $opts {{}}] == "" } { set font [font actual "[list $f] $s" -displayof $w] } else { set font [font actual "[list $f $s] $opts" -displayof $w] } } $w configure -font [fonts_Aname $font] -text [fonts_name $font 0] set fonts($c,act) $font };# fonts_update proc fonts_Aname {font} { if { [lindex $font 0] == "-family" } { set actual $font } else { set actual [font actual $font] } set var "[list [lindex $actual 1]] [lindex $actual 3]" set var2 "" set list "5 bold bold 7 italic italic" set list "$list 9 1 underline 11 1 overstrike" foreach {x i s} $list { if { [lindex $actual $x] == $i } { lappend var2 $s } };# foreach x if { $var2 != "" } { lappend var $var2 } return $var; };# fonts_Aname proc fonts_name {font {show "1"}} { # This 'if' fixes an apparant bug with "font actual" # in Tk 8.4 if { [lindex $font 0] == "-family" } { set base $font } else { set base [font actual $font] } set var "[lindex $base 1] [lindex $base 3]" set list "weight bold Bold slant italic Italic" set list "$list underline 1 Underline overstrike 1 Overstrike" if { $show } { foreach {x i s} $list { if { [font actual "$font" -$x] == $i } { set var "$var $s" } };# foreach x } return $var; };# fonts_name # This 'closest' proc taken from http://mini.net/tcl/43 proc closest {value list} { set minElement [lindex $list 0] set minDist [expr {abs($value-$minElement)}] foreach i [lrange $list 1 end] { if {abs($value-$i) < $minDist} { set minDist [expr {abs($value-$i)}] set minElement $i } } set minElement };# closest proc config {x} { global world p # $x = World we're configuring. -1 for global settings. set w .config$x if {[winfo exists $w]} { set state [wm state $w] if {$state == "iconic" || $state == "withdrawn"} { wm state $w "normal" } raise $w focus $w return; } toplevel $w if { $x == "-1" } { set title [mc conf,titleG $p(nick)] } else { set title [mc conf,titleW $world($x,info,name)] } wm title $w $title wm minsize $w 500 350 wm maxsize $w 500 350 wm resizable $w 0 0 wm geometry $w 500x350 wm withdraw $w frame $w.tab pack $w.tab -side top -fill x ::iwidgets::tabset $w.tab.ts -tabpos n -command [list config_show $w] \ -backdrop [$w.tab cget -background] \ -background [$w.tab cget -background] \ -tabborders 1 -equaltabs 0 \ -font {Helvetica 9} pack $w.tab.ts -side left frame $w.main pack $w.main frame $w.btm pack $w.btm -side bottom button $w.btm.ok -text [mc word,ok] -width 9 -underline 0 -default active \ -command "if \{ \[config_canSave \"$x\" \"$w\"\] \} \{ config_save \"$x\" destroy $w\}" button $w.btm.cancel -text [mc word,cancel] -width 9 -underline 0 \ -command "if \{ \[config_canSave \"$x\" \"$w\"\] \} \{ destroy $w\}" pack $w.btm.ok $w.btm.cancel -padx 5 -side left -pady 3 bind $w [list $w.btm.cancel invoke] bind $w [list $w.btm.cancel invoke] bind $w [list $w.btm.ok invoke] if { $x == "-1" } { # Global settings config_add $w [mc conf,tab,color] color $x config_add $w [mc conf,tab,gcolor] Gcolor $x config_add $w [mc conf,tab,salias] salias $x } else { # A normal World config config_add $w [mc conf,tab,site] siteinfo $x config_add $w [mc conf,tab,color] color $x config_add $w [mc conf,tab,gag] gags $x config_add $w [mc conf,tab,text] fonts $x config_add $w [mc conf,tab,auto] auto $x config_add $w [mc conf,tab,f] fkey $x } $w.tab.ts select 0 update idletasks center $w wm deiconify $w raise $w focus $w update };# config proc config_canSave {x w} { if { $x == "-1" } { set list "color Gcolor" } else { set list "color siteinfo gags fonts auto fkey" } foreach p $list { if { [info procs config_cmd_${p}_cansave] != "" && \ [config_cmd_${p}_cansave $x $w] != "1" } { return 0; } };# foreach p return 1; };# config_canSave proc config_save {x} { global conn if { $x == "-1" } { config_cmd_color_save $x config_cmd_Gcolor_save $x } else { config_cmd_auto_save $x config_cmd_siteinfo_save $x config_cmd_gags_save $x config_cmd_fonts_save $x config_cmd_fkey_save $x config_cmd_color_save $x saveWorldPrefs $x } if { ![info exists conn(up)] || $conn(up) == "0" } { # So that host/port/desc, etc, are right colorSetup $conn(0,top) QUICK QUICK setupConnZero 1 } else { showFrame $conn(up) } };# config_save proc config_add {w l c x} { $w.tab.ts add -label $l set num [$w.tab.ts index end] frame $w.main$num config_cmd_$c $w $num $x };# config_add proc config_show {x t} { global conn if { [info exists conn($x,tabUp)]} { pack forget $x.main$conn($x,tabUp) } pack $x.main$t -in $x -expand 1 -fill both -before $x.btm set conn($x,tabUp) $t };# config_show proc config_cmd_fkey {w t c} { global tempconf # $w = window. $t = tab (on tabset). $c = world num. set winv $w.main$t.fkey frame $winv foreach x {2 3 4 5 6 7 8 9 10} { set tempconf($c,fkey,$x) [worldInfo $c fkey,$x] frame $winv.$x pack $winv.$x -side top -pady 4 -ipadx 2 label $winv.$x.l -width 6 -text "F${x}:" -justify left -anchor w entry $winv.$x.e -width 75 -textvariable tempconf($c,fkey,$x) bind $winv.$x.e {%W insert end \b ; break} pack $winv.$x.l -side left pack $winv.$x.e -side left -expand 1 -fill x } pack $winv -side left -anchor nw -padx 7 -pady 5 -expand 0 -fill both };# config_cmd_fkey proc config_cmd_fkey_save {x} { global tempconf world foreach y {2 3 4 5 6 7 8 9 10} { set world($x,fkey,$y) $tempconf($x,fkey,$y) } };# config_cmd_fkey_save proc config_cmd_auto {w t c} { global tempconf world # $w = window. $t = tab (on tabset). $c = world num. set tempconf($c,auto,before) [worldInfo $c auto,before] set tempconf($c,auto,after) [worldInfo $c auto,after] set tempconf($c,auto,csound) [worldInfo $c auto,csound] set tempconf($c,auto,dsound) [worldInfo $c auto,dsound] set tempconf($c,auto,asound) [worldInfo $c auto,asound] set winv $w.main$t.auto frame $winv frame $winv.l frame $winv.sep -width 1 -background black catch {$winv.sep configure -background systemButtonShadow} frame $winv.r pack $winv.l -side left -expand 0 -fill both -padx 4 -pady 4 pack $winv.sep -expand 0 -fill y -pady 2 -ipady 2 \ -side left -padx 3 pack $winv.r -side left -expand 1 -fill both -padx 4 -pady 4 foreach {x} {c d a} { frame $winv.l.$x pack $winv.l.$x -side top -expand 1 -fill both labelframe $winv.l.$x.f -labelanchor nw -text [mc conf,auto,pon$x] pack $winv.l.$x.f -side left -anchor nw -fill x entry $winv.l.$x.f.e -width 25 \ -textvariable tempconf($c,auto,${x}sound) \ -validate all \ -validatecommand "checkFile %P $winv.l.$x.f.e" button $winv.l.$x.f.br -image ::img::open \ -command [list sub_auto_browse $x $winv $c] button $winv.l.$x.f.te -text [mc word,play] \ -command "playSound \$tempconf($c,auto,${x}sound)" pack $winv.l.$x.f.e $winv.l.$x.f.br $winv.l.$x.f.te -side left -padx 1 };# foreach x labelframe $winv.r.before -labelanchor nw -text [mc conf,auto,sbl] text $winv.r.before.t -width 20 -font {Courier 10} -height 4 \ -yscrollcommand "$winv.r.before.sb set" scrollbar $winv.r.before.sb -orient vertical -command [list $winv.r.before.t yview] $winv.r.before.t insert end [string map {\b \n} $tempconf($c,auto,before)] pack $winv.r.before.t -side left -anchor nw -fill both pack $winv.r.before.sb -side left -fill y -anchor nw -expand 1 pack $winv.r.before -side top -anchor w -padx 2 -expand 1 labelframe $winv.r.after -labelanchor nw -text [mc conf,auto,sal] text $winv.r.after.t -width 20 -font {Courier 10} -height 4 \ -yscrollcommand "$winv.r.after.sb set" scrollbar $winv.r.after.sb -orient vertical -command [list $winv.r.after.t yview] $winv.r.after.t insert end [string map {\b \n} $tempconf($c,auto,after)] pack $winv.r.after.t -side left -anchor nw -fill both pack $winv.r.after.sb -side left -fill y -anchor nw -expand 1 pack $winv.r.after -side top -anchor nw -padx 2 -expand 1 pack $winv -side left -anchor nw -padx 7 -pady 5 -expand 1 -fill both };# config_cmd_auto proc config_cmd_auto_save {x} { global tempconf world foreach y {before after} { set str [.config$x.main4.auto.r.$y.t get 1.0 end-1c] set world($x,auto,$y) \ [string map {\n \b} $str] } foreach y {a c d} { set world($x,auto,${y}sound) $tempconf($x,auto,${y}sound) } };# config_cmd_auto_save proc sub_auto_browse {x w c} { global tempconf p set types { {{All Sound Files} {.wav} } {{All Sound Files} {.mp3} } {{All Sound Files} {.au} } {{All Sound Files} {.snd} } {{All Sound Files} {.aiff} } {{Wave Files} {.wav} } {{MP3s} {.mp3} } {{AU Sound Files} {.au} } {{SND Sound Files} {.snd} } {{AIFF Sound Files} {.aiff} } {{All Files} * } } set f [tk_getOpenFile -initialdir $p(folder) -parent $w \ -filetypes $types] if { $f == "" } { return; } set tempconf($c,auto,${x}sound) [file nativename [file normalize $f]] };# sub_auto_browse proc config_cmd_salias {w t c} { global tempconf # $w = window. $t = tab (on tabset). $c = world num. set winv $w.main$t.salias frame $winv labelframe $winv.add -text " Add New Alias " -labelanchor nw pack $winv.add -side top -padx 5 -pady 8 -fill both frame $winv.add.alias pack $winv.add.alias label $winv.add.alias.l -text "Alias:" -width 10 entry $winv.add.alias.e -textvariable tempconf($c,salias,alias) -width 25 pack $winv.add.alias.l $winv.add.alias.e -side left -padx 3 -pady 5 frame $winv.add.cmd pack $winv.add.cmd label $winv.add.cmd.l -text "Command:" -width 10 entry $winv.add.cmd.e -textvariable tempconf($c,salias,cmd) -width 25 pack $winv.add.cmd.l $winv.add.cmd.e -side left -padx 3 -pady 5 button $winv.add.btn -command "sub_salias_add $c $winv.current" \ -text [mc word,add] -width 8 pack $winv.add.btn labelframe $winv.current -text " Current Aliases " -labelanchor nw pack $winv.current -padx 5 -pady 8 -fill both -expand 1 sub_salias_refresh $winv.current pack $winv -side left -anchor nw -padx 7 -pady 5 -expand 1 -fill both };# config_cmd_salias proc sub_salias_add {c w} { global tempconf slashalias set al $tempconf($c,salias,alias) set cmd $tempconf($c,salias,cmd) if { ![regexp {^[a-zA-Z0-9]+$} $al] || [string trim $cmd] == "" } { tk_messageBox -icon error -title $::p(name) \ -message [mc conf,salias,bad] -parent $w sub_salias_refresh $w return; } set slashalias($al) $cmd set tempconf($c,salias,alias) "" set tempconf($c,salias,cmd) "" sub_salias_refresh $w };# sub_salias_add proc sub_salias_refresh {w} { global slashalias catch {destroy $w.fill} frame $w.fill pack $w.fill -fill both set i 0 ; set y -1 foreach x [array names slashalias] { if { [expr {$i%3}] == "0" } { frame $w.fill.[incr y] pack $w.fill.$y -side top -fill x -anchor nw -padx 8 -pady 4 set i 0 } button $w.fill.$y.$i -image ::img::blank10 \ -command "unset slashalias($x) ; sub_salias_refresh $w" label $w.fill.$y.${i}l -text $x balloon $w.fill.$y.${i}l "$slashalias($x)" pack $w.fill.$y.$i -side left -anchor nw pack $w.fill.$y.${i}l -side left -anchor nw -fill x incr i } };# sub_salias_refresh proc config_cmd_fonts {w t c} { global tempconf world # $w = window. $t = tab (on tabset). $c = world num. set tempconf($c,fontAct) [font actual font$c.0] set tempconf($c,fontN) [fonts_name font$c.0] set tempconf($c,pane,indent) [worldInfo $c pane,indent] set tempconf($c,pane,linewrap) [worldInfo $c pane,linewrap] set tempconf($c,top,echo) [worldInfo $c top,echo] set tempconf($c,top,empty) [worldInfo $c top,empty] set tempconf($c,text,say) [worldInfo $c text,say] set tempconf($c,text,pose) [worldInfo $c text,pose] set tempconf($c,text,emit) [worldInfo $c text,emit] set winv $w.main$t.fonts frame $winv labelframe $winv.font -text "[mc word,font]: " \ -labelanchor nw -height 60p pack $winv.font -fill both -expand 0 -side top -pady 2 frame $winv.font.f -height 60p label $winv.font.f.f -anchor w -justify left \ -textvariable tempconf($c,fontN) \ -font $tempconf($c,fontAct) pack $winv.font.f -expand 1 -fill both -side left pack propagate $winv.font.f 0 pack $winv.font.f.f -side left -fill both -expand 0 -padx 3 set str {[fonts_checkFixed} set str "$str \[fonts_popup $c \[font actual \$tempconf($c,fontAct)\]\] $winv\]" button $winv.font.set -image [imageFor font] \ -command "set f $str if \{ \$f != \"\" \} \{ set tempconf($c,fontAct) \$f set tempconf($c,fontN) \[fonts_name \$tempconf($c,fontAct)] $winv.font.f.f configure -font \$f \}" balloon $winv.font.set [mc conf,font,change] button $winv.font.default -text [mc word,default] \ -command "set tempconf($c,fontAct) \[font actual \$top(font)\] set tempconf($c,fontN) \[fonts_name \$tempconf($c,fontAct)] $winv.font.f.f configure -font \$tempconf($c,fontAct)" balloon $winv.font.default [mc conf,font,def] pack $winv.font.default $winv.font.set -side right -padx 5 frame $winv.nums pack $winv.nums -side top -expand 0 -fill both -pady 9 frame $winv.nums.wrap pack $winv.nums.wrap -side left -padx 5 label $winv.nums.wrap.l -text [mc conf,font,wrapat] set val {expr [lsearch -exact {{} 1 2 3 4 5 6 7 8 9 0} %S] != "-1"} entry $winv.nums.wrap.e -width 5 -textvariable tempconf($c,pane,linewrap) \ -invalidcommand {bell -displayof %W} \ -validate key -validatecommand $val pack $winv.nums.wrap.l $winv.nums.wrap.e -side left -padx 2 frame $winv.nums.ind pack $winv.nums.ind -side left -padx 5 label $winv.nums.ind.l -text [mc conf,font,indent] entry $winv.nums.ind.e -width 5 -textvariable tempconf($c,pane,indent) \ -invalidcommand {bell -displayof %W} \ -validate key -validatecommand $val pack $winv.nums.ind.l $winv.nums.ind.e -side left -padx 2 frame $winv.chk pack $winv.chk -side top -expand 0 -fill both -pady 9 frame $winv.chk.echo pack $winv.chk.echo -side left -padx 5 checkbutton $winv.chk.echo.c -text [mc conf,font,echo] \ -variable tempconf($c,top,echo) pack $winv.chk.echo.c -side left frame $winv.chk.empty pack $winv.chk.empty -side left -padx 5 checkbutton $winv.chk.empty.c -text [mc conf,font,empty] \ -variable tempconf($c,top,empty) pack $winv.chk.empty.c -side left frame $winv.text labelframe $winv.text.say -labelanchor nw -text [mc conf,font,say] entry $winv.text.say.e -width 15 -textvariable tempconf($c,text,say) pack $winv.text.say.e -side left -anchor nw -fill x pack $winv.text.say -side left -padx 8 labelframe $winv.text.pose -labelanchor nw -text [mc conf,font,pose] entry $winv.text.pose.e -width 15 -textvariable tempconf($c,text,pose) pack $winv.text.pose.e -side left -anchor nw -fill x pack $winv.text.pose -side left -padx 8 labelframe $winv.text.emit -labelanchor nw -text [mc conf,font,emit] entry $winv.text.emit.e -width 15 -textvariable tempconf($c,text,emit) pack $winv.text.emit.e -side left -anchor nw -fill x pack $winv.text.emit -side left -padx 8 pack $winv.text -side top -expand 0 -fill both -pady 5 pack $winv -side left -anchor nw -padx 7 -pady 5 -expand 1 -fill both };# config_cmd_fonts proc config_cmd_fonts_cansave {c w} { if { [winfo exists .font$c] } { raise $w raise .font$c set msg [mc conf,font,close] if { $c == "-1" } { set title glconf } else { set title woconf } tk_messageBox -icon warning -title [mc conf,title,$title] \ -message $msg -parent .font$c return 0; } return 1; };# config_cmd_fonts_cansave proc config_cmd_fonts_save {x} { global tempconf world catch {font create font${x}.0} eval "font configure font${x}.0 $tempconf($x,fontAct)" set world($x,top,font) $tempconf($x,fontAct) if { [string trimleft $tempconf($x,pane,indent) 0] == "" } { set world($x,pane,indent) 0 } else { set world($x,pane,indent) $tempconf($x,pane,indent) } if { [string trimleft $tempconf($x,pane,linewrap) 0] == "" } { set world($x,pane,linewrap) 0 } else { set world($x,pane,linewrap) $tempconf($x,pane,linewrap) } set world($x,top,echo) $tempconf($x,top,echo) set world($x,top,empty) $tempconf($x,top,empty) foreach y {say pose emit} { set world($x,text,$y) $tempconf($x,text,$y) } };# config_cmd_fonts_save proc config_cmd_gags_cansave {c w} { global tempconf if { [info exists tempconf($c,gagEdit)] && \ $tempconf($c,gagEdit) != "-1" } { set msg [mc conf,gag,unsaved] tk_messageBox -icon warning -title [mc conf,title,woconf] \ -message $msg -parent $w return 0; } return 1; };# config_gags_cmd_cansave proc config_cmd_gags {w t c} { global world tempconf gags # $w = window. $t = tab (on tabset). $c = world num. if { ![info exists gags($c)] } {set gags($c) ""} set tempconf($c,gags) $gags($c) set tempconf($c,gagsN) "" if { $tempconf($c,gags) != "" } { foreach x $tempconf($c,gags) { lappend tempconf($c,gagsN) [lindex $x 0] } } set tempconf($c,gagUp) -1 set winv $w.main$t.gags frame $winv frame $winv.list pack $winv.list -side left -padx 6 -pady 8 frame $winv.list.box pack $winv.list.box -expand 0 -fill both -side top -pady 5 listbox $winv.list.box.lb -listvariable tempconf($c,gagsN) \ -yscrollcommand "$winv.list.box.sb set" \ -height 9 -exportselection 0 pack $winv.list.box.lb -side left -fill y scrollbar $winv.list.box.sb -orient vertical \ -command [list $winv.list.box.lb yview] pack $winv.list.box.sb -side right -fill y -expand 1 frame $winv.list.btn pack $winv.list.btn -side bottom frame $winv.list.btnTop pack $winv.list.btnTop -side top -pady 3 button $winv.list.btnTop.up -image [imageFor uparrow 1] \ -command [list sub_gags_move -1 {} 0 $winv $c] balloon $winv.list.btnTop.up [mc conf,gag,up] button $winv.list.btnTop.down -image [imageFor downarrow 1] \ -command [list sub_gags_move +1 +1 end $winv $c] balloon $winv.list.btnTop.down [mc conf,gag,down] pack $winv.list.btnTop.up $winv.list.btnTop.down -side left -padx 3 frame $winv.list.btnBtm pack $winv.list.btnBtm -side bottom -pady 4 button $winv.list.btnBtm.add -image [imageFor gagnew 1] \ -command [list sub_gags_add $winv $c] balloon $winv.list.btnBtm.add [mc conf,gag,add] button $winv.list.btnBtm.edit -image [imageFor gagedit 1] \ -command [list sub_gags_edit $winv $c] balloon $winv.list.btnBtm.edit [mc conf,gag,edit] button $winv.list.btnBtm.trash -image [imageFor trash 1] \ -command [list sub_gags_trash $winv $c] balloon $winv.list.btnBtm.trash [mc conf,gag,del] pack $winv.list.btnBtm.add $winv.list.btnBtm.edit \ $winv.list.btnBtm.trash -side left -padx 2 frame $winv.sep -width 1 -background black catch {$winv.sep configure -background systemButtonShadow} pack $winv.sep -expand 0 -fill y -pady 2 -ipady 2 -side left -padx 10 frame $winv.edit pack $winv.edit -expand 0 -fill both -pady 3 -side left pack [frame $winv.edit.text] -expand 0 -fill x -pady 2 label $winv.edit.text.l -text [mc conf,gag,match] -width 7 -justify left -anchor nw if { ![info exists tempconf($c,gagText)] } {set tempconf($c,gagText) ""} entry $winv.edit.text.e -textvariable tempconf($c,gagText) pack $winv.edit.text.l -side left pack $winv.edit.text.e -side left -expand 1 -fill x pack [frame $winv.edit.type] -expand 0 -fill x -pady 2 checkbutton $winv.edit.type.chk -text [mc conf,gag,case] \ -underline 0 -variable tempconf($c,gagType) pack $winv.edit.type.chk -side left -fill x -padx 4 checkbutton $winv.edit.type.act -text [mc conf,gag,active] \ -underline 0 -variable tempconf($c,gagAct) \ -onvalue 0 -offvalue 1 pack $winv.edit.type.act -side left -fill x -padx 4 pack [frame $winv.edit.chk] -expand 0 -fill x -pady 2 if { ![info exists tempconf($c,gagHide)] } {set tempconf($c,gagHide) "0"} checkbutton $winv.edit.chk.hide -text [mc conf,gag,disp] -underline 0 \ -variable tempconf($c,gagHide) if { ![info exists tempconf($c,gagLog)] } {set tempconf($c,gagLog) "0"} checkbutton $winv.edit.chk.log -text [mc conf,gag,omit] -underline 10 \ -variable tempconf($c,gagLog) pack $winv.edit.chk.hide $winv.edit.chk.log -padx 4 -side left -fill x pack [frame $winv.edit.fg] -expand 0 -fill x -pady 2 set tempconf($c,gagFGShow) "None" ; set tempconf($c,gagFG) "" label $winv.edit.fg.l -text "Hilite Foreground:" -width 20 \ -justify left -anchor nw menubutton $winv.edit.fg.col -relief sunken \ -textvariable tempconf($c,gagFGShow) \ -direction below -menu $winv.edit.fg.col.menu \ -width 20 pack $winv.edit.fg.l $winv.edit.fg.col -side left -anchor nw -padx 2 menu $winv.edit.fg.col.menu -tearoff 0 $winv.edit.fg.col.menu add command -label "None" \ -command "set tempconf($c,gagFG) \"\" set tempconf($c,gagFGShow) \ \"\[sub_gags_col \$tempconf($c,gagFG) FG\]\"" $winv.edit.fg.col.menu add command -label "Normal FG" \ -command "set tempconf($c,gagFG) \"FG_NORMAL\" set tempconf($c,gagFGShow) \ \"\[sub_gags_col \$tempconf($c,gagFG) FG\]\"" foreach x {Red Blue Yellow Green Cyan Magenta Black White} { $winv.edit.fg.col.menu add command -label $x \ -command "set tempconf($c,gagFG) \ [string toupper FG_ANSI_$x] set tempconf($c,gagFGShow) \ \"\[sub_gags_col \$tempconf($c,gagFG) FG\]\"" $winv.edit.fg.col.menu add command -label "$x Hilite" \ -command "set tempconf($c,gagFG) \ [string toupper FG_ANSI_$x-H] set tempconf($c,gagFGShow) \ \"\[sub_gags_col \$tempconf($c,gagFG) FG\]\"" };# foreach x pack [frame $winv.edit.bg] -expand 0 -fill x -pady 2 set tempconf($c,gagBGShow) "None" ; set tempconf($c,gagBG) "" label $winv.edit.bg.l -text "Hilite Background:" -width 20 \ -justify left -anchor nw menubutton $winv.edit.bg.col -relief sunken \ -textvariable tempconf($c,gagBGShow) \ -direction below -menu $winv.edit.bg.col.menu \ -width 20 pack $winv.edit.bg.l $winv.edit.bg.col -side left -anchor nw -padx 2 menu $winv.edit.bg.col.menu -tearoff 0 $winv.edit.bg.col.menu add command -label "None" \ -command "set tempconf($c,gagBG) \"\" set tempconf($c,gagBGShow) \ \"\[sub_gags_col \$tempconf($c,gagBG) BG\]\"" $winv.edit.bg.col.menu add command -label "Normal BG" \ -command "set tempconf($c,gagBG) \"BG_NORMAL\" set tempconf($c,gagBGShow) \ \"\[sub_gags_col \$tempconf($c,gagBG) BG\]\"" foreach x {Red Blue Yellow Green Cyan Magenta Black White} { $winv.edit.bg.col.menu add command -label $x \ -command "set tempconf($c,gagBG) \ [string toupper BG_ANSI_$x] set tempconf($c,gagBGShow) \ \"\[sub_gags_col \$tempconf($c,gagBG) BG\]\"" $winv.edit.bg.col.menu add command -label "$x Hilite" \ -command "set tempconf($c,gagBG) \ [string toupper BG_ANSI_$x-H] set tempconf($c,gagBGShow) \ \"\[sub_gags_col \$tempconf($c,gagBG) BG\]\"" };# foreach x pack [frame $winv.edit.sound] -expand 0 -fill x -pady 2 label $winv.edit.sound.l -text [mc conf,gag,play] -anchor nw -justify left entry $winv.edit.sound.e -textvariable tempconf($c,gagHear) \ -validate all \ -validatecommand "checkFile %P $winv.edit.sound.e" set ft { {{All Sound Files} {.wav} } {{All Sound Files} {.mp3} } {{All Sound Files} {.au} } {{All Sound Files} {.snd} } {{All Sound Files} {.aiff} } {{Wave Files} {.wav} } {{MP3s} {.mp3} } {{AU Sound Files} {.au} } {{SND Sound Files} {.snd} } {{AIFF Sound Files} {.aiff} } {{All Files} * } } set cmd "set f \[tk_getOpenFile -filetypes \{$ft\} \ -initialdir \[openFileD \$tempconf($c,gagHear)] \ -initialfile \[openFileF \$tempconf($c,gagHear)] \ -parent $winv -title \[mc conf,gag,selsound\]\] if \{ \$f != \"\" \} \{ set tempconf($c,gagHear) \[file nativename \[file normalize \$f\]\] checkFile \$tempconf($c,gagHear) $winv.edit.sound.e\}" button $winv.edit.sound.b -image [imageFor sound 1] -command $cmd balloon $winv.edit.sound.b "[mc word,browse]..." pack $winv.edit.sound.l -side left -padx 2 -anchor nw pack $winv.edit.sound.e -side left -expand 1 -fill x -anchor nw -padx 2 pack $winv.edit.sound.b -side right -anchor nw -padx 2 labelframe $winv.edit.send -labelanchor nw -text [mc conf,gag,send2mu] text $winv.edit.send.t -width 20 -height 3 pack $winv.edit.send.t -fill both pack $winv.edit.send -fill x -pady 2 #YES# 0: Gag from display? gagHide #YES# 1: Omit from (partial) log? gagLog #YES# 2: FG Color gagFG #YES# 3: BG Color gagBG #YES# 4: Sound file to play (if available) gagHear #NO # 5: String to send to MUSH. gagSend #YES# 6: Match type (see 'gagcheck' for info) gagType pack [frame $winv.edit.btns] -side bottom -pady 2 -fill x button $winv.edit.btns.save -image [imageFor tick 1] \ -command [list sub_gags_save $winv $c] balloon $winv.edit.btns.save [mc conf,gag,save] button $winv.edit.btns.cancel -image [imageFor cross 1] \ -command [list sub_gags_up $winv $c] balloon $winv.edit.btns.cancel [mc conf,gag,scrap] pack $winv.edit.btns.save $winv.edit.btns.cancel -side left \ -padx 3 sub_gags_up $winv $c pack $winv -side left -anchor nw -padx 7 -pady 5 };# config_cmd_gags proc sub_gags_up {w c {g ""}} { global tempconf # box.sb set list00 "box.lb btnTop.up btnTop.down btnBtm.add" set list00 "$list00 btnBtm.edit btnBtm.trash" set list10 "text.l text.e chk.hide chk.log fg.l fg.col bg.l" set list10 "$list10 bg.col type.chk type.act sound.l sound.e sound.b" set list10 "$list10 btns.save btns.cancel send.t" set list01 "btnTop.up uparrow btnTop.down downarrow btnBtm.add gagnew" set list01 "$list01 btnBtm.edit gagedit btnBtm.trash trash" set list11 "sound.b sound btns.save tick btns.cancel cross" $w.edit.send.t delete 1.0 end if { $g == "" } { set state0 normal ; set img0 1 set state1 disabled ; set img1 0 foreach x {Text FG BG Hear Send} { set tempconf($c,gag$x) "" } set tempconf($c,gagFGShow) "None" set tempconf($c,gagBGShow) "None" set tempconf($c,gagType) "0" set tempconf($c,gagAct) "1" set tempconf($c,gagHide) "0" set tempconf($c,gagLog) "0" set tempconf($c,gagEdit) "-1" set col [$w.edit.text.l cget -disabledforeground] set bcol [$w.edit.text.e cget -disabledbackground] } else { set state0 disabled ; set img0 0 set state1 normal ; set img1 1 set col [$w.edit.text.l cget -foreground] set bcol [$w.edit.text.e cget -background] $w.edit.send.t configure -state normal $w.edit.send.t insert end $tempconf($c,gagSend) } foreach x $list00 { $w.list.$x configure -state $state0 } foreach {x y} $list01 { $w.list.$x configure -image [imageFor $y $img0] } foreach x $list10 { $w.edit.$x configure -state $state1 } foreach {x y} $list11 { $w.edit.$x configure -image [imageFor $y $img1] } $w.edit.send configure -foreground $col $w.edit.send.t configure -background $bcol };# sub_gags_up proc sub_gags_trash {w c} { global tempconf # $w = window ($w.list.box.lb == the listbox) # $c = connection ($tempconf($c,...)) if { [info exists tempconf($c,gagEdit)] && \ $tempconf($c,gagEdit) != "-1" } { set msg [mc conf,gag,do1st] tk_messageBox -title [mc conf,gag,conf] -icon error \ -message $msg -parent [winfo toplevel $w] return; } set lb $w.list.box.lb set x [$lb curselection] if { $x == "" } { bell -displayof $w return; } set tempconf($c,gags) [lreplace $tempconf($c,gags) $x $x] set tempconf($c,gagsN) [lreplace $tempconf($c,gagsN) $x $x] };# sub_gags_trash proc sub_gags_save {w c} { global tempconf if { ![info exists tempconf($c,gagEdit)] || \ $tempconf($c,gagEdit) == "-1" } { bell -displayof $w return; } set list "text.e chk.hide chk.log fg.col bg.col type.chk sound.e" set p0 $tempconf($c,gagText) set p1 $tempconf($c,gagHide) set p2 $tempconf($c,gagLog) set p3 $tempconf($c,gagFG) set p4 $tempconf($c,gagBG) set p5 $tempconf($c,gagHear) set p6 [string map {\n \b} [$w.edit.send.t get 1.0 end-1char]] set p7 $tempconf($c,gagType) set p8 $tempconf($c,gagAct) set new [list $p0 $p1 $p2 $p3 $p4 $p5 $p6 $p7 $p8] if { $tempconf($c,gagEdit) == "N" } { lappend tempconf($c,gags) $new lappend tempconf($c,gagsN) [lindex $new 0] } else { set n $tempconf($c,gagEdit) set tempconf($c,gags) [lreplace $tempconf($c,gags) \ $n $n $new] set tempconf($c,gagsN) [lreplace $tempconf($c,gagsN) \ $n $n [lindex $new 0]] } set tempconf($c,gagEdit) "-1" sub_gags_up $w $c };# sub_gags_save proc sub_gags_add {w c} { global tempconf # $w = window ($w.list.box.lb == the listbox) # $c = connection ($tempconf($c,...)) if { [info exists tempconf($c,gagEdit)] && \ $tempconf($c,gagEdit) != "-1" } { set msg [mc conf,gag,do1st] tk_messageBox -title [mc conf,gag,conf] -icon error \ -message $msg -parent [winfo toplevel $w] return; } sub_gags_up $w $c N set tempconf($c,gagEdit) "N" set tempconf($c,gagText) "" set tempconf($c,gagHide) "0" set tempconf($c,gagLog) "0" set tempconf($c,gagFG) "" set tempconf($c,gagFGShow) "[sub_gags_col {} FG]" set tempconf($c,gagBG) "" set tempconf($c,gagBGShow) "[sub_gags_col {} BG]" set tempconf($c,gagHear) "" set tempconf($c,gagSend) "" set tempconf($c,gagType) "0" set tempconf($c,gagAct) "1" };# sub_gags_add proc sub_gags_edit {w c} { global tempconf # $w = window ($w.list.box.lb == the listbox) # $c = connection ($tempconf($c,...)) if { [info exists tempconf($c,gagEdit)] && \ $tempconf($c,gagEdit) != "-1" } { set msg [mc conf,gag,do1st] tk_messageBox -title [mc conf,gag,conf] -icon error \ -message $msg -parent [winfo toplevel $w] return; } set lb $w.list.box.lb set x [$lb curselection] if { $x == "" } { bell -displayof $w return; } set tempconf($c,gagEdit) $x set base [lindex $tempconf($c,gags) $x] set tempconf($c,gagText) [lindex $base 0] set tempconf($c,gagHide) [lindex $base 1] set tempconf($c,gagLog) [lindex $base 2] set tempconf($c,gagFG) [lindex $base 3] set tempconf($c,gagFGShow) [sub_gags_col $tempconf($c,gagFG) FG] set tempconf($c,gagBG) [lindex $base 4] set tempconf($c,gagBGShow) [sub_gags_col $tempconf($c,gagBG) BG] set tempconf($c,gagHear) [lindex $base 5] set tempconf($c,gagSend) [string map {\b \n} [lindex $base 6]] set tempconf($c,gagType) [lindex $base 7] set tempconf($c,gagAct) [lindex $base 8] sub_gags_up $w $c $x };# sub_gags_edit proc sub_gags_col {c s} { if { $c == "" } { return "None" } if { $c == "${s}_NORMAL" } { return "Normal $s" } if { $c == "${s}_HILITE" } { return "$s Hilite" } set chk [string totitle [string tolower [string range $c 8 end]] 0 0] if { [string first - $chk] == "-1" } { return $chk; } else { return "[string range $chk 0 end-2] Hilite" } };# sub_gags_col proc sub_gags_move {a d s w c} { global tempconf # $a = amount (+1 or -1) # $d = diff for current selection when checking against $s # $s = stop if current = this (0 or end) # $w = window ($w.list.box.lb == the listbox) # $c = connection ($tempconf($c,...)) if { [info exists tempconf($c,gagEdit)] && \ $tempconf($c,gagEdit) != "-1" } { set msg [mc conf,gag,do1st] tk_messageBox -title [mc conf,gag,conf] -icon error \ -message $msg -parent [winfo toplevel $w] return; } set lb $w.list.box.lb set x [$lb curselection] set new [expr $x$a] if { $x == "" || [expr $x$d] == [$lb index $s] } { bell -displayof $w return; } if { $a == "-1" } { set one $new ; set two $x set oneX $x ; set twoX $new } else { set one $x ; set two $new set oneX $new ; set twoX $x } set tempconf($c,gags) [lreplace $tempconf($c,gags) $one $two \ [lindex $tempconf($c,gags) $oneX] \ [lindex $tempconf($c,gags) $twoX]] set tempconf($c,gagsN) [lreplace $tempconf($c,gagsN) $one $two \ [lindex $tempconf($c,gagsN) $oneX] \ [lindex $tempconf($c,gagsN) $twoX]] $lb selection clear 0 end $lb selection set $new $lb activate $new };# sub_gags_move proc config_cmd_gags_save {x} { global tempconf gags set gags($x) $tempconf($x,gags) };# config_cmd_gags_save proc config_cmd_siteinfo {w t c} { global world tempconf # $w = window. $t = tab (on tabset). $c = world num. set winv $w.main$t.siteinfo frame $winv foreach x {host port char pw desc mush} { if { [info exists world($c,info,$x)] } { set tempconf($c,info,$x) $world($c,info,$x) } else { set tempconf($c,info,$x) "" } } frame $winv.fill -height 15p pack $winv.fill -side top -fill x frame $winv.hp pack $winv.hp -anchor nw -pady 3 frame $winv.hp.host pack $winv.hp.host -anchor nw label $winv.hp.host.l -text [mc conf,site,host] -width 17 \ -justify left -anchor nw entry $winv.hp.host.e -textvariable tempconf($c,info,host) \ -width 45 pack $winv.hp.host.l $winv.hp.host.e -side left -anchor nw frame $winv.hp.port pack $winv.hp.port -anchor nw -pady 3 label $winv.hp.port.l -text [mc conf,site,port] -width 17 \ -justify left -anchor nw entry $winv.hp.port.e -textvariable tempconf($c,info,port) \ -width 8 -validate key \ -validatecommand {string is integer %S} pack $winv.hp.port.l $winv.hp.port.e -side left -anchor nw frame $winv.cp pack $winv.cp -anchor nw -pady 11 frame $winv.cp.char pack $winv.cp.char -anchor nw label $winv.cp.char.l -text [mc conf,site,char] -width 17 \ -justify left -anchor nw entry $winv.cp.char.e -textvariable tempconf($c,info,char) \ -width 30 pack $winv.cp.char.l $winv.cp.char.e -side left -anchor nw frame $winv.cp.pw pack $winv.cp.pw -anchor nw -pady 3 label $winv.cp.pw.l -text [mc conf,site,pw] -width 17 \ -justify left -anchor nw entry $winv.cp.pw.e -textvariable tempconf($c,info,pw) \ -width 30 -show * pack $winv.cp.pw.l $winv.cp.pw.e -side left -anchor nw frame $winv.desc pack $winv.desc -anchor nw -pady 10 -expand 1 -fill x pack [frame $winv.desc.lf] -anchor nw label $winv.desc.lf.l -text [mc conf,site,desc] pack [frame $winv.desc.ef] -anchor nw -expand 1 -fill x entry $winv.desc.ef.e -textvariable tempconf($c,info,desc) pack $winv.desc.lf.l -side left -anchor nw pack $winv.desc.ef.e -side bottom -expand 1 -fill x -anchor nw labelframe $winv.type -labelanchor nw -text [mc conf,site,type] pack $winv.type -anchor nw -pady 6 -expand 1 -fill none radiobutton $winv.type.mush -text "MUSH" -value 1 \ -variable tempconf($c,info,mush) radiobutton $winv.type.mud -text "MUD" -value 0 \ -variable tempconf($c,info,mush) pack $winv.type.mush $winv.type.mud -side left pack $winv -side left -anchor nw -padx 7 -pady 5 };# config_cmd_siteinfo proc config_cmd_siteinfo_save {c} { global world tempconf conn foreach x [array names tempconf $c,info,*] { set world($x) $tempconf($x) set [lindex [split $x \,] 2] $tempconf($x) } # Debating whether to update already-connected # versions of this world. . . Perhaps not? # But then, I guess I should for consistency. # (It only counts for HOST and PORT; the rest are a # part of $world, not $conn, and so on reconnect will be # updated anyway) set shouldI 1 if { $shouldI } { foreach n $conn(on) { if { $conn($n,num) == $c } { set conn($n,info,host) $host set conn($n,info,port) $port };# if $n == $c };# foreach n $conn(on) };# if $shouldI };# config_cmd_siteinfo_save proc config_cmd_color_save {c} { global world tempconf conn if { $c == "-1" } { # We're doing Global settings; new defaults, # and Quick-Connects only are changed global ansi top foreach x [array names tempconf $c,ansi,*] { set ansi([::Penn::after $x ansi,]) $tempconf($x) } set top(bg) $tempconf($c,top,background) set ansi(normal) $tempconf($c,top,foreground) set ansi(normal-h) $tempconf($c,top,hilite) set c "QUICK" } else { # Just a regular world foreach x [array names tempconf $c,ansi,*] { set world($x) $tempconf($x) } set world($c,top,bg) $tempconf($c,top,background) set world($c,ansi,normal) $tempconf($c,top,foreground) set world($c,ansi,normal-h) $tempconf($c,top,hilite) } foreach n $conn(on) { if { "$conn($n,num)" == "$c" } { colorSetup $conn($n,top) $c $n } } };# config_cmd_color_save proc config_cmd_color {a b c} { global ansi top tempconf world conn set winv $a.main$b.color frame $winv set colors [list white cyan magenta blue yellow green red black] if { $c == "-1" } { foreach x [array names ansi] { set tempconf($c,ansi,$x) $ansi($x) } set tempconf($c,top,background) $top(bg) set tempconf($c,top,foreground) $ansi(normal) set tempconf($c,top,hilite) $ansi(normal-h) } else { foreach x [array names world $c,ansi,*] { set tempconf($x) $world($x) } set tempconf($c,top,background) $world($c,top,bg) set tempconf($c,top,foreground) $world($c,ansi,normal) set tempconf($c,top,hilite) $world($c,ansi,normal-h) } # This holds two frames, left and right, at the top frame $winv.split pack $winv.split -expand 1 -fill both -pady 14 frame $winv.split.l frame $winv.split.r pack $winv.split.l -in $winv.split -side left \ -anchor nw -expand 1 \ -fill both -padx 5 pack $winv.split.r -in $winv.split -side right \ -anchor ne -expand 1 \ -fill both -padx 5 foreach x {1 2 3 4} { frame $winv.split.l.$x pack $winv.split.l.$x -fill none -pady 3 } set i 0 foreach x { white cyan magenta blue yellow green red black } { incr i; set num [expr ($i + 1) / 2] frame $winv.split.l.$num.$x -relief groove \ -borderwidth 4 pack $winv.split.l.$num.$x -in $winv.split.l.$num \ -side left -padx 2 -ipadx 2 label $winv.split.l.$num.$x.l -width 8 -pady 5 \ -text [string totitle $x] set cmd [list sub_color_pick $x $winv.split.l.$num.$x.n tempconf($c,ansi,] button $winv.split.l.$num.$x.n \ -background $tempconf($c,ansi,$x) \ -height 1 -width 2 \ -activebackground $tempconf($c,ansi,$x) \ -command $cmd balloon $winv.split.l.$num.$x.n "ANSI [string totitle $x]" set tempconf($c,button,$x) $winv.split.l.$num.$x.n set cmd [list sub_color_pick $x-h $winv.split.l.$num.$x.h tempconf($c,ansi,] button $winv.split.l.$num.$x.h \ -background $tempconf($c,ansi,${x}-h) \ -height 1 -width 2 \ -activebackground $tempconf($c,ansi,${x}-h) \ -command $cmd balloon $winv.split.l.$num.$x.h "ANSI [string totitle $x] Hilite" set tempconf($c,button,$x-h) $winv.split.l.$num.$x.h pack $winv.split.l.$num.$x.l $winv.split.l.$num.$x.h \ -in $winv.split.l.$num.$x \ -side left -anchor nw \ -pady 3 pack $winv.split.l.$num.$x.n -in $winv.split.l.$num \ -side left -anchor nw -padx 6 \ -before $winv.split.l.$num.$x.h -pady 3 } frame $winv.split.r.top -relief groove pack $winv.split.r.top -in $winv.split.r -anchor nw -padx 10 \ -pady 2 -ipadx 2 -ipady 2 \ -expand 1 -fill both frame $winv.split.r.top.l frame $winv.split.r.top.r pack $winv.split.r.top.l -in $winv.split.r.top -side left \ -anchor nw -padx 1 -expand 1 -fill both pack $winv.split.r.top.r -in $winv.split.r.top -side right \ -anchor ne -padx 2 -expand 1 -fill both set cmd [list sub_color_pick foreground $winv.split.r.top.r.out tempconf($c,top,] button $winv.split.r.top.l.fg -text "Change Foreground" -width 17 \ -command $cmd set cmd [list sub_color_pick background $winv.split.r.top.r.out tempconf($c,top,] if { $c == "-1" } { set cmd "$cmd 1" } button $winv.split.r.top.l.bg -text "Change Background" -width 17 \ -command $cmd button $winv.split.r.top.r.out -takefocus 0 -height 4 -width 20 \ -background $tempconf($c,top,background) \ -foreground $tempconf($c,top,foreground) \ -text "Example Output" -relief sunken set tempconf($c,button,ground) $winv.split.r.top.r.out bindtags $winv.split.r.top.r.out "$winv.split.r.top.r.out . all" pack $winv.split.r.top.l.fg -in $winv.split.r.top.l -pady 4 pack $winv.split.r.top.l.bg -in $winv.split.r.top.l -pady 4 pack $winv.split.r.top.r.out -in $winv.split.r.top.r -pady 3 frame $winv.split.r.hilite pack $winv.split.r.hilite -in $winv.split.r -anchor nw \ -padx 10 -pady 2 -ipadx 2 -ipady 2 \ -expand 1 -fill both frame $winv.split.r.hilite.l frame $winv.split.r.hilite.r pack $winv.split.r.hilite.l -in $winv.split.r.hilite -side left \ -anchor nw -padx 1 -pady 5 \ -expand 1 -fill both pack $winv.split.r.hilite.r -in $winv.split.r.hilite -side right \ -anchor ne -padx 2 -expand 1 -fill both set cmd [list sub_color_pick hilite $winv.split.r.hilite.r.out tempconf($c,top,] button $winv.split.r.hilite.l.set -text "Change Hilite Color" \ -width 17 \ -command $cmd button $winv.split.r.hilite.r.out \ -background $tempconf($c,top,background) \ -foreground $tempconf($c,top,hilite) \ -text "Hilite Example" -relief sunken \ -height 2 -takefocus 0 -width 18 set tempconf($c,button,hilite) $winv.split.r.hilite.r.out bindtags $winv.split.r.hilite.r.out "$winv.split.r.hilite.r.out . all" pack $winv.split.r.hilite.l.set -in $winv.split.r.hilite.l -pady 0 pack $winv.split.r.hilite.r.out -in $winv.split.r.hilite.r frame $winv.split.r.2 -relief groove pack $winv.split.r.2 -in $winv.split.r -anchor nw -padx 10 \ -pady 2 -ipadx 2 -ipady 2 \ -expand 1 -fill both checkbutton $winv.split.r.2.ansi -text "Allow ANSI Colors?" \ -variable tempconf($c,ansi,use-ansi) checkbutton $winv.split.r.2.flash -text "Allow ANSI Flash?" \ -variable tempconf($c,ansi,use-flash) pack $winv.split.r.2.ansi $winv.split.r.2.flash \ -in $winv.split.r.2 \ -side top -anchor nw -pady 2 # This is a single frame at the bottom frame $winv.whole pack $winv.whole -expand 1 -fill both frame $winv.whole.def pack $winv.whole.def -side bottom -expand 1 -fill x -pady 5 frame $winv.whole.def.l frame $winv.whole.def.r pack $winv.whole.def.l $winv.whole.def.r -side left -expand 1 -fill x set cmd " foreach x \{white cyan magenta blue yellow green red black\} \{ set tempconf($c,ansi,\$x) \$ansi(\$x) set tempconf($c,ansi,\$x-h) \$ansi(\$x-h) \$tempconf($c,button,\$x) configure -background \$tempconf($c,ansi,\$x) -activebackground \$tempconf($c,ansi,\$x) \$tempconf($c,button,\$x-h) configure -background \$tempconf($c,ansi,\$x-h) -activebackground \$tempconf($c,ansi,\$x-h) \} " if { $c == "-1" } { set cmd [string map {\$ansi( \$globals(ansi,} $cmd] } button $winv.whole.def.l.ansi -text "Use Default ANSI Colors" \ -command $cmd set cmd "set tempconf($c,top,background) \$top(bg) set tempconf($c,top,foreground) \$ansi(normal) set tempconf($c,top,hilite) \$ansi(normal-h) $tempconf($c,button,ground) configure \ -background \$top(bg) \ -foreground \$ansi(normal) $tempconf($c,button,hilite) configure \ -background \$top(bg) \ -foreground \$ansi(normal-h) " if { $c == "-1" } { set cmd [string map {\$top( \$globals(top, \$ansi( \$globals(ansi,} $cmd] set cmd "$cmd ; \$tempconf($c,gcolorbgtab) configure -bg \$top(bg)" set text "Use Preset BG/FG Colors" } else { set text "Use Default BG/FG Colors" } button $winv.whole.def.r.other -text $text -command $cmd pack $winv.whole.def.l.ansi -padx 15 pack $winv.whole.def.r.other -padx 15 pack $winv -expand 0 -fill x -in [winfo parent $winv] -side top };# config_cmd_color proc config_cmd_Gcolor_save {c} { global tempconf bottom1 bottom2 side conn ansi # Save the bg/fg colors for bottom1, bottom2 and side. # And update these, plus Echo and System colors, everywhere. # (ansi(system) and ansi(echo) get saved by the Colors tab, but # we'll do it again to be safe) foreach x {bottom1 bottom2 side} { set $x\(bg) $tempconf($c,gcolor,bg) set $x\(fg) $tempconf($c,gcolor,fg) } set fg $bottom1(fg) ; set bg $bottom1(bg) set ansi(system) $tempconf($c,ansi,system) set ansi(echo) $tempconf($c,ansi,echo) foreach x $conn(on) { $conn($x,bottom1) configure -bg $bg -fg $fg $conn($x,bottom2) configure -bg $bg -fg $fg colorSetup $conn($x,top) $conn($x,num) $x } $::pane(side) configure -bg $bg -fg $fg };# config_cmd_Gcolor_save proc config_cmd_Gcolor {a b c} { global ansi tempconf top bottom1 globals # Configure Side pane and Bottom1/Bottom2 FG and BG, as well as # the System and Echo colors. For Global settings (world -1) only. set winv $a.main$b.color frame $winv foreach x {fg bg font} { set tempconf($c,gcolor,$x) $bottom1($x) } frame $winv.text pack $winv.text -side left -anchor nw -padx 6 -pady 6 set t [text $winv.text.top -bg $tempconf($c,top,background) -cursor arrow \ -height 5 -width 25 -font $top(font)] set tempconf($c,gcolorbgtab) $t $t tag configure system -lmargin1 5p -lmargin2 5p \ -foreground $tempconf($c,ansi,system) $t tag configure echo -lmargin1 5p -lmargin2 5p \ -foreground $tempconf($c,ansi,echo) $t insert end "\n" $t insert end "Example System Color" system $t insert end "\n" $t insert end "\n" $t insert end "Example Echo Color" echo bindtags $t [::Penn::setdiff [bindtags $t] Text] pack $t -side top -anchor nw set t [text $winv.text.bot -bg $tempconf($c,gcolor,bg) \ -fg $tempconf($c,gcolor,fg) \ -height 3 -width 25 -cursor arrow \ -font $tempconf($c,gcolor,font)] $t tag configure push -lmargin1 5p -lmargin2 5p $t insert end "\nExample Input Color\n" push bindtags $t [::Penn::setdiff [bindtags $t] Text] pack $t -side top -anchor nw frame $winv.but pack $winv.but -side left -anchor nw -padx 6 -pady 6 set cmd [list sub_Gcolor_pick $winv.text.top system tempconf($c,ansi,system)] button $winv.but.sys -text "Change System Color" -command $cmd -width 35 pack $winv.but.sys -side top -anchor nw -padx 2 -pady 2 set cmd [list sub_Gcolor_pick $winv.text.top echo tempconf($c,ansi,echo)] button $winv.but.echo -text "Change Echo Color" -command $cmd -width 35 pack $winv.but.echo -side top -anchor nw -padx 2 -pady 2 set cmd [list sub_Gcolor_pick $winv.text.bot fg tempconf($c,gcolor,fg)] button $winv.but.fg -text "Change Send-Window Foreground" -command $cmd -width 35 pack $winv.but.fg -side top -anchor nw -padx 2 -pady 2 set cmd [list sub_Gcolor_pick $winv.text.bot bg tempconf($c,gcolor,bg)] button $winv.but.bg -text "Change Send-Window Background" -command $cmd -width 35 pack $winv.but.bg -side top -anchor nw -padx 2 -pady 2 set cmd [list sub_Gcolor_pick $winv.text.top system tempconf($c,ansi,system) $globals(ansi,system)] set cmd "$cmd; sub_Gcolor_pick $winv.text.top echo tempconf($c,ansi,echo) $globals(ansi,echo)" set cmd "$cmd; sub_Gcolor_pick $winv.text.bot fg tempconf($c,gcolor,fg) $globals(bottom1,fg)" set cmd "$cmd; sub_Gcolor_pick $winv.text.bot bg tempconf($c,gcolor,bg) $globals(bottom1,bg)" button $winv.but.def -text "Set All Colors To Default" -command $cmd -width 35 pack $winv.but.def -side top -anchor nw -padx 2 -pady 2 pack $winv -expand 0 -fill x -in [winfo parent $winv] -side top };# config_cmd_Gcolor proc sub_Gcolor_pick {win c var {new ""}} { global tempconf switch -glob $c { system {set name "System"} echo {set name "Echo"} bg {set name "Send-Window Background"} fg {set name "Send-Window Foreground"} default {set name [string totitle $c]} };# switch if { $new == "" } { set new [tk_chooseColor -initialcolor [set $var] \ -parent [winfo toplevel $win] \ -title "Choose $name Color..."] } if { $new == "" } {return;} set $var $new if { $c == "system" || $c == "echo" } { $win tag configure $c -foreground $new } else { $win configure -$c $new } };# sub_Gcolor_pick proc sub_color_pick {c w v {global "0"}} { global tempconf # $c is a color (red, green-h, etc), and $w is the button # $v is the var to use - 'set $v$c) ' should work. # $global, if 1, indicates a global setting (used for BG) switch -glob $c { foreground {set name "Foreground"} background {set name "Background"} hilite {set name "ANSI Hilite"} *-h {set name "ANSI [string totitle [::Penn::before $c -] 0 0] Hilite"} default {set name "ANSI [string totitle $c 0 0]"} };# switch set new [tk_chooseColor -initialcolor "[subst $[set v][set c])]" \ -parent [winfo toplevel $w] \ -title "Choose $name Color..."] if {$new == ""} return; set $v$c) $new if {$c == "foreground" } { $w configure -$c $new } elseif { $c == "background"} { $w configure -$c $new ; set up $w set up [winfo parent $up] ; set up [winfo parent $up] set up [winfo parent $up] $up.hilite.r.out configure -background $new if { $global == "1" } { $tempconf(-1,gcolorbgtab) configure -$c $new } } elseif { $c == "hilite" } { $w configure -foreground $new } else { $w configure -background $new -activebackground $new } };# sub_color_pick proc badpackage {pack ver} { global p set abortMsg "$p(nick) requires a minimum of TK Version 8.4 and" set abortMsg "$abortMsg IWidgets 4.0 to run.\nThey can be downloaded" set abortMsg "$abortMsg from: http://www.tcl.tk\nMsgcat is also required." badpackageExit $abortMsg $pack exit; };# badpackage proc badpackageExit {eI pack} { set pack [string tolower pack] switch $pack { tcl - tk - iwidgets - msgcat {return -code error -errorinfo $eI;} default {return -code return;} } # return -code "error" -errorinfo "$eI"; };# badpackageExit proc require {} { # To be run at startup. Do some PACKAGE REQUIREs. global p package unknown badpackage package require Tk 8.4 package require msgcat # Clear off the bindings for the Tk Panedwindow. This avoids # an error with 'identify' from the Iwidgets paned window, and is # safe as we never use the TK Panedwindow in the client. foreach x [bind Panedwindow] { bind Panedwindow $x {} };# foreach x bind Panedwindow package require Iwidgets 4.0 if { [catch {package require Img 1.3}] == 0 } { set p(hasImg) "1" } else { set p(hasImg) "0" } if { [catch {package require snack}] == 0 } { set p(hasSnack) "1" } else { set p(hasSnack) "0" } if { [catch {package require ctext}] == 0 } { set p(hasCtext) "1" } else { set p(hasCtext) "0" } if { "$p(platform)" == "windows" } { if { [file exists [set xyz [file join $p(library) winico.tcl]]] } { package forget Winico source $xyz set p(hasWinico) "1" } elseif { [catch {package require Winico 0.3}] == 0 } { set p(hasWinico) "1" } else { set p(hasWinico) "0" } } else { set p(hasWinico) "-1" };# winico if { $p(platform) == "windows" } { if { [file exists [set xyz [file join $p(library) flash.tcl]]] } { source $xyz set p(hasWinflash) "1" } else { set p(hasWinflash) "0" } } else { set p(hasWinflash) "-1" };# winflash };# require # textWrap and textIdent, stolen (with some minor changes) # from Tcllib's ::textutils package. 99% of the credits # goes to their authors. textWrap splits the string $text # into lines which are, at most, $at characters long. # textIndent will indent each line of $text with $num # blank space characters, skipping $skip lines. proc textWrap {text at} { if { [string length $text] == "0" } { return ""; } set ltext [list] foreach Line [split $text \n] { set Ltext [split $Line " "] set i 0 foreach tmpWord $Ltext { if { [string length $tmpWord] > $at } { set Ltext [lreplace $Ltext $i $i] incr i -1 set j 0 while { $j < [string length $tmpWord] } { if { [expr {[string length $tmpWord] - $j}] > $at } { set end [expr {$j + $at - 1}] } else { set end [string length $tmpWord] } set Ltext [linsert $Ltext [expr {$i+1}] \ [string range $tmpWord $j $end]] incr i incr j [expr {$end - $j + 1}] } } incr i };# foreach tmpWord Ltext # if { $blank } { # append ltext \n # } # if { [info exists ltext] } { # set ltext "$ltext\n$Ltext" # } else { # set ltext $Ltext # } lappend ltext $Ltext };# foreach Line split set ltext [join $ltext \n] # puts "----*** WHEE ***-----\nITS $ltext\n----*** WHEE ***-----" set line [lindex $ltext 0] set pos [string length $line] set text "" set On 1 foreach word [lrange $ltext 1 end] { set size [string length $word] if { ($pos + $size + 1) < $at } { puts "Carry on: $word" append line " $word" incr pos incr pos $size } else { puts "NewLine: $word" # if { [string length $text] } {append text "\n" ; puts "Appending. Now it's: $text"} set lineinfo($On) $line incr On set line $word # append text "$line" set line $word set pos $size } };# foreach foreach x [lsort [array names lineinfo]] { lappend data $lineinfo($x) } set text "[join $data \n]\n$line" # if { [string length $text] } {append text "\n"} # append text $line return $text; };# textWrap proc textIndent {text num {skip 1}} { # set text [string trim $text] set res [list] set prefix [string repeat " " $num] foreach line [split $text \n] { if {[string compare "" $line] == 0} { lappend res {} } elseif {$skip <= 0} { lappend res $prefix$line } else { lappend res $line } if {$skip > 0} {incr skip -1} } return [join $res \n] };# textIndent proc loadImages {} { global p # Load the images. The only ones set here are used in several # places. Images limited to a certain proc (for instance, # ::img::tcltk, in 'about') are in that proc, and are # created/destroyed at every call, to save the memory. namespace eval img {} image create photo ::img::blank10 -height 10 -width 10 image create photo ::img::open -data { R0lGODlhEAAQAIMAAPwCBASCBMyaBPzynPz6nJxmBPzunPz2nPz+nPzSBPzq nPzmnPzinPzenAAAAAAAACH5BAEAAAAALAAAAAAQABAAAARTEMhJq724hp1n 8MDXeaJgYtsnDANhvkJRCcZxEEiOJDIlKLWDbtebCBaGGmwZEzCQKxxCSgQ4 Gb/BbciTCBpOoFbX9X6fChYhUZYU3vB4cXTxRwAAIf5oQ3JlYXRlZCBieSBC TVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4 LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5j b20AOw== } image create photo ::img::q -data { R0lGODlhEAAQAJEAANnZ2f8AAP///////yH5BAEAAAAALAAAAAAQABAAAAI6 hI+py90Uh+AjUHyCfxFhQQnhW0RYUEL4FhEWlBC+RYQFJYR/FJ/gI1D8IPgI EREEHzEyMzOllNIhBQA7 } image create photo ::img::settingsY -data { R0lGODlhEAAQAIYAAPwCBCwqXERGhFxajGxqlExKhFxanGxqrHx6tJyazFxe hDw6XDQybDw+fGxmpHRyrISCtIyKvJSOxLSy1LSu3CQiTCwqZFRSlKSizMzK 5MTC5KyqzJyWxKyq1Ly25IyOxLSy3Kyu1Nza7Hx6pExKjLy63Hx+tDQ2XOTi 9BwePFRWnMzG5BQOJDQuTMzO5MS+7FRWlGxupJSSvLy23AwOJNzW7LS21IyO vERChExKfJSSxKymzNTS5MzK7FxalHRytDQyXIyKtKSi1NTS7Ozq9Pz6/IyG vGxujMTC3PTy/JyaxNza9CwuZLS23Dw6dAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAA LAAAAAAQABAAAAfOgACCgwECggMEg4qCAQUGBgcICQqLAAsMDQ4PEBESExQV ihYNFxgZGhscHB0dDooBFx4eHw4XESAhGiIjghUkFCUmDQEAJxMeGSgdKQEq DysQJCyCLR4uIi8UFzAxMjMXNIMQGTU2Nw84OQ86OySDEjwoPRI+DYI/HBgX AEBBNSIoUEBgIE4IBQwjXgxBQaRIESPhABwRcgxJDxEieCQh4kGJPUEKPICo UWMJhQ8fKCRwQGwQEx9NkmiQcMFJAwYtK3Gg8OBjpUUXfC7yEwgAIf5oQ3Jl YXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3Ig MTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5k ZXZlbGNvci5jb20AOw== } image create photo ::img::worldY -data { R0lGODlhEAAQAIYAAPwCBFxONCROfCRKfKx6LNy+bNTOpGSS1DRupAwyXBRS nPTSjPTqvOzqzMzSvHSSlKy6ZDxutAxCpBQ2XBxepLTKvPzqzPzy5OTShLS2 dLSqRFR2jBRerBQ+jOTixOzetNS2XHx6XDR2tCRexBwyTDyKzOTavPzq1OzK dCx23BRKtCQ6VCQmHFSa7IyirOzSnGSGpIR+bFSO1DyK7DR+5CRixBw2VDQu HFye7IS27NzGXISuhEyS5DR25BRWxBQ+lBQyXCQqPCxSfGyu7GyerKy2ZFR+ rERqfCRmxBROtBQ+fBwuTBwmNDSW9JyabLyqRIx+TExSXBQ6bAQCBBQ6ZBxa pDR+zBxq3LyaLJySRHxqPGxeNBxGbCRmrHRyRERONDRKNDQ2JCQuLAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAA LAAAAAAQABAAAAeygACCg4SFhgABAQIDh4MBBAUGBwgDCYcKCwwNDg8QERIT hRQVFhcNGBkaGxwdoYMDHhcXHxggISIjEiSvJSYXJwsoISkpIyorLIIDLS4W LzAxMjM0NSo2N8o4OS46OzwzPSk+P0BBgkI8Q0NERUZHCEhJSktMgwk4Qy1N Tk9QUVJLphCiUsWKlStYsmjZQiJgIS4KuijQ4iXAFxYCDVFJwGUFmDBhMjYS w0KMyEYoBfkJBAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9u IDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2 ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo ::img::connectY -data { R0lGODlhEAAQAIMAAPwCBAQCBPz+/KSipDQyNMTCxMTGxISChFxaXMzGzAAA AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAARaEMhJZxCjgsAt DtUlCOA1gJQ4kl/IDatAoF7xxkS6GgEBr6jAobCyBX42SQBxMOx6A8MhiGAS R8YDgrYsNEeJ0zaEGZY7uoH2oB6nOUwtbdLaVOeTUwo/8UcAACH+aENyZWF0 ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5 OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2 ZWxjb3IuY29tADs= } image create photo ::img::disconnectY -data { R0lGODlhEAAQAIMAAPwCBPz+BMTCBAQCBERCBPz+/MTCxMTGxISChFxaXMzG zKSipAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAARPEMhJq704axBE HoPUEdhQGMNYFuwxkKInDYjBniEnwMCQIIebSzXx/WwsFK+YMABZikWuYlrU CtZpEYv4WRPaHhb064YB41kCfJFSQBh/BAAh/mhDcmVhdGVkIGJ5IEJNUFRv R0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFs bCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo ::img::reconnectY -data { R0lGODlhEAAQAIMAAPwCBPz+BMTCBISCBAQCBPz+/MTCxMTGxISChFxaXMzG zKSipAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAARaEMhJZbihUiz6 0FPnfaA0iBpBVGdHEYWxToEoSHBRHHM9AgSEQRcj+AYkYAJxIPKQFUJiOdTJ QFIDU6dYzKKFhTCM+E5g4mXaDAyrlogEG+DGTecA7wsP8EcAACH+aENyZWF0 ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5 OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2 ZWxjb3IuY29tADs= } image create photo ::img::closeY -data { R0lGODlhEAAQAIQAAASC/IQCBOwuBMwiBMQeBMweBNQiBNQmBNwmBLwaBLQS BFQCBMQaBLQWBKwSBLwWBJwKBKQOBJQKBJwOBFwCBJQGBIwGBAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAV2ICCOZEkG gQmgpyCk50DAQWEcCLzKiZIuCQahUEAFZIyGYyFaOBSPRHBQSCiZowXkmeBd Tc6GMPFYqgKKodUR0Z0SBKsi0jbV4mW6w+E+EpJsEhIQE3U7cUoUCwsVFRCE P3hmTRYWFRJYC18kCwEWWE2gnFh+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lG IFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCBy aWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo ::img::next-worldY -data { R0lGODlhEAAQAIQAAPwCBEya/AQ2rLza/GSm/GSi9IS+/Hy2/HSy/Gym/FSS 9HSq/Gyu/FSO9ESG7Hyy/FyW9Dx67KzO/Iy2/EyG9Iyy9AAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVHICCOZGme 6BikZiCwZDC8KFHYxVDQZm4ciERBwSMRBoYFoxBoOIqi3GNRgDgjUABBwp0o KNiTYDxuhGGBSvbkgo3W7jjKHwIAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQ cm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmln aHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo ::img::down-worldsY -data { R0lGODlhEAAQAIQAAPwCBHyq9Fyi/FyGzHSq9KTK/ESC7AQ2rFSS9FSO9Dx6 5EyK9Dx25FSCzFSa/DRy5DyC7DR25Cxm1ESG7Dx67DR67DRqzCRazAQCxAAA AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVEICCOZGme aIoGQisMKlHMxqEGBZIodionC0av1CAQHIWF4XFoDkWD2QICiRRqJ8lkS6kw UxZDxfs8XciqEaacbrvf/hAAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8g dmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRz IHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo ::img::up-worldsY -data { R0lGODlhEAAQAIQAAPwCBGyq/Aw6tIy+/Hyy/HSq/IS+/GSi9FSS7KTO/LTW /HSu/Jy+/Eya/JzC9GSe9EyC7FSS9FSK9ER65EyG7ESC7DRy5GyS5AAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVFICCOZGme aKoGgjoGA9GqhWEQbBrcRHEgs1IgoVgEfgxGUNRoNhwPBERAXY6eEcnEWmow KBULl/R0OC7jUbXqarvfI38IACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJv IHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0 cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= } image create photo ::img::prev-worldY -data { R0lGODlhEAAQAIQAAPwCBFSa/JTC/Hy2/KTO/Iy6/Aw+rHyy/Iy+/HSu/ISu /Iyy9IS6/IS+/Gyq9GSe9FSS9EyG7HSq/FyW9EyK9ESC7Aw+tFSS7ER65Dx2 5Hym7AAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVIICCOZGme KBmkpbCy4kC8bGEHeGCcBzIkBcVCsSsxEI2D4wGJLIokw+EgeUwolefJUr1U MBkItGSYEA3oMVmjTqFhUbh87g8BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYg UHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJp Z2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= } image create photo ::img::logY -data { R0lGODlhEAAQAIYAAPwCBHyq/CRm3PzSlPT6/Ozy/NTm/Mze/LTO/LTS/Pya DOz2/Nzm/NTi/LzS/Iy2/MSCTPyODPySBPz6/Nzq/LzW/ER63MSCVPySDPyO BPyCBOTu/NTe9MyKXPR+BKxOBMTa/NyifBwOBPT2/Ozi3Pzy3PyaZPyKDCQS BNza7Py+nOR2RNxqJKxSDPTezPzevNSGZIxaLGRKNCwaFCxatNzO1PzWtIxW NDQyJFRWXKTC7JSGdKx2VFQ+LGRmbLTC3KTG/KTC/CRizLS2vBwaFGRiZLS+ 1KS+7JSq3ISaxHSKtBxKlIyKhKSqtHyStHyOtMTW/KzK/KzG/AAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAA LAAAAAAQABAAAAe8gAAAAYSFhAKCggOCAQQFBQYHCAkBiAADCowECwUMDQ6U DxADERKME5wUBhUJFhcDGBkamo8bBhwOHaQZHh+ntRQgIQMZEr0ijCPAJCUm J70oiQEjGxsMKSUqKywt0dIFGxQNLi8wMTIzNImD4Aw1NjA3ODk6lowFFAc7 PD0+P0BBhKwL0GkIkSJGjiBJomTJwA0NmDRJ4sTJEyUNHx4AAQIKqChAgNgb RIEDR48IokgJMlKAy5cwXQryEwgAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQ cm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmln aHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo ::img::uploadY -data { R0lGODlhEAAQAIYAAPwCBMTGxMTCxLy6vLSytLSutKyqrPTy9PTu9Ozu7OTi 5Nza3NTW1NzW3MzKzIR+hGxmbFxaXFROVExKTERCRHRudGRiZKS6tPT2/Jym pHSOjGSSjFSKjGxqbJyenGxubHyanEx2bDx2bJTGvLTe3ITKzKSepJSytMzi 1Ozy9MTi5ITGxJSWlFRSVIyurMze3HzGxJSOlFRWVEyKfEyGfESOjCyCjIyK jKSipHSChDRqZDxuVBxGRDxORFRqXNTq3Nzu3IS+hCwyLMza1JzKpMTixITC fFyeZHx6fNTS1ISChKzStKzWpHS2bDRGNCwqLIyijGSCbFxyZExOTJTClFyS XDw2PAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAA LAAAAAAQABAAAAe0gACCAQIDAwQFBokFgo0BBwgJCgoLCwwNDg+NAAIIEBER EhITFBEGFZsFCRYXGBkaGxwdHh+pChEgISIjJCUdJhCbJgoSJycoKSorFSzB jQ8NLS4vGBgkMBUxzo0NMi4zGzQ1NhU324IDODk6KDs8PBUVPZuNPj9AQTtC 9I5DRChFjBzxcQMJvyQNlCxh0sTJExky+AkoYAJKFCkyIEyhwC/GBwhEqFTp QcHKE34oU6qk5ycQACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNp b24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNl cnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= } image create photo ::img::i18n -data { R0lGODlhEAAQAKIAANnZ2QAAAAAA//////8AAP//AAAAgP///yH5BAEAAAAA LAAAAAAQABAAAANsGLocCKohgzJIqoGgGiM4gqMaCKqBpLuBoBo4uhsIqkGE hKHLABiqSLoaCLpRhoalGgi6UYaGpRoIuoGkqxEYAAAYukyBoBoiKDNDhBQI qiGCMjNESIGgGiIoM0OEFAiqIYIyM0RIgaCKocuRADs= } image create photo ::img::copy -data { R0lGODlhEAAQAIUAAIx+bIx6bIR6bIRyZHxyZHxuXHRqXPwCBOTe3Nze3HRm XIR2ZPz+/GxiVPz29GRaTGReVFxWTHxuZPzy5Ly2rFxSRPTq3OzexLyulFRK RKyqrPTizLyihExKRMTCxGxeVOzWvERCPFxSTOzSrLyabLSytGRaVOTKpEQ+ NLy+vMS+tMS2nLymhDw2NExGPMSulMSqjDw6NDQ2LAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAcALAAAAAAQABAAAAal QEBAMCAUDIekUhlAJBJOhWK5XCQYWEbD8aAmB9csBBKJeCVhhmOSoFQeR6Uh vLZcMBlNQppUINQTFhsXHB0eDB9cBw0JdYMgHCGHHw8PIh8JgRcXICMkkmsJ JRUmCYKcIyckKCmBG3gRKhQrGBy2qyWnLB0iFRkdHSEhKC0tJYMjkV4uGikl JajKVBGmj6mrXrErKy8wLCQkMV4VFcDCKCEtMn5BACH+aENyZWF0ZWQgYnkg Qk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5 OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3Iu Y29tADs= } image create photo ::img::paste -data { R0lGODlhEAAQAIYAAPwCBCQiFHRqNIx+LFxSBFw6BKSaRPz+/NTOjKyiZPzO dIR2FPzy5Ly2dNyqPExGLDw6NNyiPNSeNIRyZHxuXHRqXHRmVGxeVHxuZNze 3OTe3GReVMyWLPz29FxSRMSKLISChMzKzLSCJHRmXLy2rFRKRGxiVFxaXHxy bLyulExGPLR6HPTq3PTizPTexLymfKRuFKxyHGRaTMTGxFxWVOzWvOzSrMSe dJReDHx6dJyGdMS+tMS2rMSqjMSidMSabDw2NEQ+NDQyLAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAA LAAAAAAQABAAAAfRgACCggECAwSDiQAFjAUGBwgJBI0FggUKmAsMCA0GCwQO mJWXDg6fBA8PEA+lDqMKEbESExQUFRUWFxGvEr0SGBkaGhkZFxuvHMkcFRkH zgcbHR6LCh/WH8wgISAHHt4elx8i1iPNzh0MGSQllyLuIiYZICfbISgpKpcr +ysXzegsWrh4kU8BjBUwYsjIcALEDBA0UBC8BKMiDA8ZGLBw4aKGjRsQCnzA QRIHxhw0SOiogALkIkoedvBIkaLHCx8/gCgC4KFECRUqIAQBAkGIn0AAIf5o Q3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxD b3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3 dy5kZXZlbGNvci5jb20AOw== } image create photo ::img::cut -data { R0lGODlhEAAQAIEAAPwCBAQCBPz+/ISChCH5BAEAAAAALAAAAAAQABAAAAIw hI9pwaHrGFRBNDdPlYB3bWHQ1YXPtYln+iCpmqCDp6El7Ylsp6ssR1uYSKuW 0V8AACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqp IERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0 dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= } image create photo ::img::undo -data { R0lGODlhEAAQAIMAAPwCBARCZKze7KTW5IzC1IS+1JTO3HSyzGSmxFSStFya vEyKrESCpDR2nBxejAAAACH5BAEAAAAALAAAAAAQABAAAARPEMhJq714hh0y 2EIobFr3CQNRrAZhBiN8zDTdwYWB7AgX7DdBQqEYmiQBImixSCSOmieMQWVA kdZAosHlXkkfHxjZuF4CDrOF4wmr2xNvBAAh/mhDcmVhdGVkIGJ5IEJNUFRv R0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFs bCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo ::img::redo -data { R0lGODlhEAAQAIMAAPwCBARCZKze7KTW5IS+1JTK3HSyzGSmxJzO3FSWtFye vFyavEyOtESCpDR2nBxejCH5BAEAAAAALAAAAAAQABAAAARPEMhJq70YhB2y DkI4bFcwDERKFET3aYIhz/M2asbBBUffI7pAQuGSCBWKxGKxYRQnAYZUumk8 jY1stkOiBBzgMNfx3HGgj2vm7PF2221/BAAh/mhDcmVhdGVkIGJ5IEJNUFRv R0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFs bCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo ::img::helpY -data { R0lGODlhIAAgAKIAANnZ2YCAAMDAwP//////AAAAAICAgP///yH5BAEAAAAA LAAAAAAgACAAAAP/CLq8GLqLoMvtGCEjgyMjEhgIutyKESMjODIjg6KBoMsd OLo8KKqBoMsbOEi6TIMjIhIIugyBg6TLLCgiEQi6G4Oky00oGoWguzFIutyK ElEIuhqDpMu9GFoIuhqDpBtRWEi6GoFRCLoag6QaEVhQSLoUgVEIuhqDpBpR CGBIuhSBUQi6GoOkGgUIYEi6FIGFoLsxSKoFgACGpEtRCLocWLoAgBCDpBuF oMvtGIOkG4Wgy+0Yg6QbhaDL7RiDpBtRCLrcjoGkSxFYCLrcjTFIuhGBhaDL 3RiDpBsRWAi63I0xSLoRgYWgy90Yg6QbUQi63I4xSLpRCLrcDiiwdBdBPJfb F4WqaCHocjsgQ1KNCCwEXW5HQ9KlCCwEXW5HQ9KlCCwEXW5HQ9KlKARdbldk SKpRCLrczqh0EXR5EwA7 } image create photo ::img::mailY -data { R0lGODlhEAAQANUAANnZ2WxaVOTe1Oze3OTWxOTWvNzStNzKpEQ6LOTezPz+ /Pzy7Pz69Pz25Pzy1PzqzPzuxEQyLLyinLSmnPz67Pzy3Pz23Pz21PzuzLSa fKyObDwuJMzCtLSelPz65My6nLymjNTCxLyqnPzq1LyihKyOfOzavOzetEQ6 NPTq3NzOtJR2bOTOpPTivNTGvLymlKSShKyahEw6NOTe3PTm1FRCPLSadFxG POzm3PTmzPzmvP///////////////////yH5BAEAAAAALAAAAAAQABAAAAay QIBwSCwaj0RgQDgkFoWCgUAgEBAIhYKhcDggAgnFYsFYLBaNheMBOUQCkklD wWBQKBXLBZPRbAILTkewoFA8wIbjowEdIoGFIiQSLRiNEakEMp1QgdSCoZJI Qp/SitVKtRCBFMU1WaResAMh9oG0ZIGZQbRoLIAO2qjSyhxOtcDntfBULI1G xeF42D63gAT3eIxGkJwu12qdNLeADCFDIBAyBAIhQ8hkESBAOCQWjUdiEAA7 } image create photo ::img::about -data { R0lGODlhEAAQAJEAANnZ2QAAgP///////yH5BAEAAAAALAAAAAAQABAAAAJI hI+pFJ/gH8U3gg8REUJKIgg2xUcDgEwkQCJCREiMD3AnQvEB7kQoPsCdCMUH uBOh+ABwJiTGJtgRJD+C4APFN4J/FJ/gY2oBADs= } image create photo ::img::uparrow -data { R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIYhI+py+0P WwhxzmetzFpxnnxfRJbmufgFACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJv IHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0 cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= } image create photo ::img::downarrow -data { R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIYhI+py+0P UZi0zmTtypflV0VdRJbm6fgFACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJv IHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0 cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= } image create photo ::img::trash -data { R0lGODlhEAAQAIIAAPwCBAQCBKSipFxaXPz+/MTCxISChDQyNCH5BAEAAAAA LAAAAAAQABAAAANQCKrRsZA5EYZ7K5BdugkdlQVCsRHdoGLMRwqw8UWvIKvG wTICQdmGgY7W+92GEJKPdNwBlMYgMlNkSp3QgOxKXAKFWE0UHHlObI3yyFH2 JwAAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkg RGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0 cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo ::img::gagnewY -data { R0lGODlhEAAQALMAANnZ2YCAgAAAAP///4AAgP8AAMDAwAAA/wCAgP////// /////////////////////yH5BAEAAAAALAAAAAAQABAAAAR/EMhJq51BhHCr gGOIECCQcwYxyBgiBDohMUopZAwo5ARBjFJIGSJAMcYQIoxBSikDCiDGGMKI IMYgcIgAxBBDCCFCgGIMEYCAQ05hzkEiCCAGFFIMYc45Z4gg4JBTGHTOkUIM AYUQQ4SBxhAhCDjkFEGKEACAQk4JRAgQyElrjQA7 } image create photo ::img::gageditY -data { R0lGODlhEAAQAKIAANnZ2YCAgAAAAAD//wCAgP///////////yH5BAEAAAAA LAAAAAAQABAAAANgCLoQgaIIuhuBEjOCoKshGDMzgqCrMjgTIoKgCzI4IYGg yzIogaDLKigIusyCgqDLLEgCAIKgu0JIEiCCoLtCSCFCgqCrIUi6gqCrIRhE RIKgyyFIJAi6vIKCoMssCLoJADs= } image create photo ::img::soundY -data { R0lGODlhEAAQAKIAANnZ2YCAAICAgAAAAP///8DAwP//AP///yH5BAEAAAAA LAAAAAAQABAAAANQCLrc/jA6FCIAgKMKAAhBI4AAOKoAgFEyJAgwCoMAUTZY JDi6G4I0UgIIAwCDMCM2WCQ4uguDYUMCOAOggAMwETiAo7sACDODoMvtD6Oc ECUAOw== } image create photo ::img::tickY -data { R0lGODlhEAAQAIIAAPwCBMT+xATCBASCBARCBAQCBEQCBAAAACH5BAEAAAAA LAAAAAAQABAAAAM2CLrc/itAF8RkdVyVye4FpzUgJwijORCGUhDDOZbLG6Nd 2xjwibIQ2y80sRGIl4IBuWk6Af4EACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYg UHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJp Z2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= } image create photo ::img::crossY -data { R0lGODlhEAAQAIIAAASC/PwCBMQCBEQCBIQCBAAAAAAAAAAAACH5BAEAAAAA LAAAAAAQABAAAAMuCLrc/hCGFyYLQjQsquLDQ2ScEEJjZkYfyQKlJa2j7AQn MM7NfucLze1FLD78CQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJz aW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVz ZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo ::img::findY -data { R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAJT hI+JEUFwIswMKAoAhATBh4i4oITwKTacEeyQiACKEgEAQPHhDsBICUSEUGww MTgSY4PJnVBsuAu4C4IoIgh2SEQARYkg2CERARSbYFNsgo+pmwUAOw== } image create photo ::img::font -data { R0lGODlhEAAQAJEAANnZ2QAAAAAA//8AACH5BAEAAAAALAAAAAAQABAAAAJF hI95oXoUwkcMCCSZ8APCRAiWGcUGEAAgAQABABRARIRgx4XJkQgfQU4ySTbB R0GboY3w0cYm08gIH3MykwYMwUebmaECADs= } image create photo ::img::bulb -data { R0lGODlhEAAQAIMAAPwCBAQCBPz+BPzerPz+xPyqXPz+/ISChFxaXKSipDQy NAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAARMEEgZap14BjG6 CJkmEMVQCF+4mQPBpthWtuYJxkJJGK6dbQRCgMBB3XCDzQamMhpDGlvuCFUy oQDLBUsJHBDUKuKQCKsUCIVZtc34IwAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lG IFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCBy aWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo ::img::textedY -data { R0lGODlhEAAQAKIAANnZ2YCAgP/G1v8AAAAAgAAA/////////yH5BAEAAAAA LAAAAAAQABAAAANbCLrc/jA+FBoygyNEBAgQEYIyIyJYChCBojOqWAoRghEz KKpVhRASMjiBolpVGBIzgxEoqlWFETOiKLpUhTERESi6QYQ1ESiqEYAARAQI FhGBoKuEoMvtD+NCCQA7 } image create bitmap ::img::iconbitmap -data { #define iconb_width 16 #define iconb_height 16 static char iconb_bits = { 0x00, 0x18, 0x00, 0x3c, 0x00, 0x18, 0x00, 0x1e, 0x00, 0x03, 0x00, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f, 0xf8, 0x1f, 0xf8, 0x1f, 0xf8, 0x1f, 0xf8, 0x1f, 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03 } } image create bitmap ::img::bold -data { #define bold_width 16 #define bold_height 16 static char bold_bits = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0x70, 0x0e, 0x70, 0x0e, 0x70, 0x0e, 0xf0, 0x07, 0x70, 0x0e, 0x70, 0x0e, 0x70, 0x0e, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 } } image create bitmap ::img::italic -data { #define italic_width 16 #define italic_height 16 static char italic_bits = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x1f, 0x00, 0x03, 0x00, 0x03, 0x80, 0x01, 0x80, 0x01, 0xc0, 0x00, 0xc0, 0x00, 0x60, 0x00, 0xfc, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 } } image create bitmap ::img::underline -data { #define underline_width 16 #define underline_height 16 static char underline_bits = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x78, 0x0f, 0x30, 0x06, 0x30, 0x06, 0x30, 0x06, 0x30, 0x06, 0x30, 0x06, 0x30, 0x06, 0x30, 0x06, 0xe0, 0x03, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00 } } image create bitmap ::img::overstrike -data { #define overstrike_width 16 #define overstrike_height 16 static char overstrike_bits = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc8, 0xe3, 0x88, 0x94, 0x9c, 0x14, 0x94, 0x13, 0xff, 0xff, 0xa2, 0x14, 0xf7, 0xe3, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 } } # The following are used on labels/buttons/etc and are used in # a disabled state, so have a greyscale equivilent to show up as "off". # A few others (uparrow, trash, etc) have on/off versions, but being black # and white anyway there's no point creating a greyscale equiv :) set listOff "settings world connect disconnect reconnect close" set listOff "$listOff down-worlds help mail next-world prev-world" set listOff "$listOff gagnew gagedit sound tick cross texted" set listOff "$listOff log upload" foreach x $listOff { image create [image type ::img::${x}Y] ::img::${x}N \ -data [::img::${x}Y data -format gif -grayscale] } };# loadImages proc getColor {n {d black}} { # Given a color name ($n), work out the correct value # in #xxxxxx terms. If it ($n) is invalid use $d, which # defaults to "black". Useful for parsing colors which # could be given by a user textually. We don't check $d # is a real color; please make sure it is first. :) # Adapted (stolen?) from 'tcolor', the Tk demo. if { [catch {set list [winfo rgb . $n] }] } { set list [winfo rgb . $d] } set red [lindex $list 0] set green [lindex $list 1] set blue [lindex $list 2] return [format "#%04x%04x%04x" $red $green $blue]; };# getColor proc getRGB {n {d black}} { # Given a color name ($n), return the Red, Green and Blue # counts as (R,G,B) . For the HTML logger (BGs). if { [catch {set list "[winfo rgb . $n]"} ] } { set list "[winfo rgb . $d]" } set red "[lindex [split [expr ([lindex $list 0]/65535.0)*256] .] 0]" set green "[lindex [split [expr ([lindex $list 1]/65535.0)*256] .] 0]" set blue "[lindex [split [expr ([lindex $list 2]/65535.0)*256] .] 0]" return [list $red $green $blue]; };# getRGB proc revColor {i {b black}} { # Given a color $i, reverse/invert it. Adapted from 'tcolor', # the Tk demo. $i must be a # color pattern, not a name! # If $i is invalid or something goes wrong, we'll return # $b (black as default) instead. switch [string length $i] { 4 {set format "#%1x%1x%1x"; set shift 12} 7 {set format "#%2x%2x%2x"; set shift 8} 10 {set format "#%3x%3x%3x"; set shift 4} 13 {set format "#%4x%4x%4x"; set shift 0} default {return $b;} } scan $i $format red green blue set red [expr {65535 - ($red << $shift)}] set blue [expr {65535 - ($blue << $shift)}] set green [expr {65535 - ($green << $shift)}] return [format "#%04x%04x%04x" $red $green $blue]; };# revColor proc splash {} { global tcl_platform wm resizable . 0 0 wm withdraw . wm title . "Launching Client..." wm geometry . 335x265 # This works in Windows. Use catch rather than # checking platform b/c it might work elsewhere, too? catch {wm attributes . -topmost 1} update frame .f -relief raised -borderwidth 3 -background #c55fc55fc55f pack .f -expand 1 -fill both image create photo ::img::potatologo -data { R0lGODlhkwDIAPcAANnZ2UoIAIQQAP8xGGsQANY5GP9aGLUhCP+cAP/WOaUY AP/GKf//AP+9IRAAAISMhISEhO9SENYxKYRzhAAAABAYGAgQEBAQEIR7cwgI CEpKSlpaUiEYGKWlpSkYIVpjY3Nza729vTExKTEpIWOMe1pzc1JaSmNjY0Jz Y0qEa2uchHutlISthEI5QmOEY1JjWjljWmNza7W1tYyUlClaUoyclKWcnHOM nIy1nIyMhNbWzr21td7e1u/v76W1vZytrTk5Mc7OzpScnN7e562tta29vcbG vVpzvaWtrXN7WtbOvSFKOWNzSnNzQjE5SlpKMVJCMYxaKaVzObWMSqWEUr2U Y5yUhDE5Y0IxIVoxEFIxIWtCGGtKKXtKIaVzSrWMa4RzWoRjSmMxIWtSSmtj WqVaGMaMUpSMlMaUQoRKKYQxGL2lhM6MUpRzUsa9ta2lnL2tpa2tpc6cUtaU Y7WUhM61raVaKc6cY4xCStbGnNbGtWs5SpRaa71je3s5Sue9nKVaa85ae8Y5 WtZKe+dKe+dzhM5SY4x7lNa1c3shSq1KWu9jlO9ShO9zlIRaa5R7hKVjWuda jN5znOdSa/eMnKVre5QxWns5WqVrhM6llO+llN6Me4Q5a4w5Wta1rWtje2M5 c2NCe7VSY95CY/dzpYwhUoxae++MraUhUkohUrU5WqUhQq05UpQpOaU5QmsY OXNja9aUlIQYOVIYIZQ5Mdata5QhEP+lrYxre2sYKVoYIcZCOXsYSr29tWtr a3tzc85zQpQhMbU5OZQQGKVCKbVCSu+ltVoYOb1SQu9zY3tajNa1lOdSUt6E UmshWtY5OcZjMcY5MedSQsaEQu9zUu+Ua96MY+9jUr0pKa0hKcYpKYwxMf97 a5wxEK0YGK1SKaUpEMY5GMYhGL0YGK05GCkYCFIpEPcAANYYCOcYCL0ICO8A AMYYEN4ICDEYUiEhYzEhY1JCjGtSlDEphEJKpVpjtSEpezk5hFopa1JarVJS lGtztTFClGs5a2t7xhAYWiH5BAEAAAAALAAAAACTAMgAAAj/AAEIHEiwoMGD CBMqXMiwocOHECNKnEixosWLGDMKDCBAo0aNGjU6FDBAo0aNGjU6FDBgAAGN GjVq1MhQQAEDBgZo1KhRo0aGAwYYMCBAo0aNGjUuPDDAAAIDAjRq1KhRo0IB AwwgSGBgQACNGjVq1JhQwQADCxggMDBAo0aNGjUmHGAAQQIGCAwM0KhRo0aN CRUYSMCgAQIDAzRq1KhRY0IHAxIwQGBggACNGjVq1JjwAQQICRAMEKBRo0aN GhMChCBQYAQJAAEIHEiwoMGDCBMqXMiwocOHEAtCgDAhYsSIESNGjBixIAUK FSBAgGCBAoWIESNGjBgxYkQKFC5c/7gAAQKGChcuZKBAIWLEiBEjRozIsIKG CxU0bOBwoUKFCxcuXMiQgULEiBEjRowYUeEFDB02ePgAokIFDhcqALwgUGAG CgABCBxIsKDBgwgTKlzIsKHDhwg5QAgBQQSHERU4VLjA4UKFCxcuXKAAEaJA EiUEmhBoAiJEiBAhFqRgQcQJDRU8VKhQgUOFChwuVLhw4cIFChQgHiyBogSK FChSpCiRokQKEiRUqFhBgsUDiBAhQoQokMKFChU4tPigYUQFDhU4XKhwgcOF CxcyUIBIsEQKgCgECiyRogSKFClIkCBBQoUKFSRWqCDh4gWMFwABCBxIsKDB gwgTKly4MP/DhQscPMSQMaNFBQ4VKnAAeEHgwAsUKAAEIHAgwYICaaBIgaIE ChQlUKRAATCFQIEkVKQgoUKFChIqaqggQYJEjRoAAQgcSLCgwYMIEypciJDC hQoVKnD4YAOCiAocKnC4UIEDwAsCBWagABCAwIEEB8JAgQIFChglYABEIVBg ihIoUqQgkYIECRIqVJBQoYKEihUqaqggoULFA4AABA4kWNDgQYQJFS40mOHC BQ4XKoxoIaIChwocKlS4cKHChQsXLmSgwBAGDBQwYMAogQIFDBQoUpRIgSIF ihQpUqggQUIFCRUqbpBQoUKFihUqVJBQcYMhQ4YMGS7McOFCBQ7/FSpUqMCh AocKHC5wAHhB4MAMFAACEDiQIIASKGDAgAEDBQoYAFEIFJiCBIoUKUiQUEFC RQoVKlSQUKGCBIsbKlYAVCFwYAyAAAQOJFjQ4EGECRUuHJjhwoUKFy5wqMCh AocKFypcuHChwoULFzJkoJAQBQoaMGDAgIECRQoYKFCgQJEihQoUKVKQSEFC hQoXAFUIFLiChIoVAwXeIEFiRQmAAAQOJFjQ4EGECRUuFJjhwgUOFzhUuMCh wgUOFzhcqADwgsCBGSgABCBwoEAYNFCgAAhDoEAUKGigQJECRYoUJFCkSJGC BAkVKlyoUKFCBQkWKVSoYKFixQoVKlSo/0iB4wFAAAIHEixo8CDChAoXAshw 4cKFChcqcKhwgUOFCxUuXOBw4cKFDBcyOED4AgUMGDRgwEABI0UKgCgECkxB ggSKFCRIkFChgkUKFSxUsFChQgUJFStUsFCxYoUKFSpU4HgBEIDAgQQLGjyI MKHChRkuXLhwgcOFCxUuVLjAAeAFgQMFZshAASAAgQMBwICBAgUMGChgoECR AgWKFClSpCChIkUKEiRIqFChokYKFSxUqFixYoWLFStWsFCxggULFStUqMAB EIDAgQQLGjyIMKHChRQAXhAosMIFDgMvVBgoMMOFCjl0xAAIQKDAFzBgwIBB AwYMFDBQkICBwv8FihQuUqhwkQKgCoECWbBQwWIFCxYsVuBIsYLFihUscLBY sULFChUrcAAEIHAgwYIGDyJMqHBhhgoALwgceKECQYIXMojYwaMHQAACB8KA gQIGDBgwUKCAQSJFihQuXKRQsaKEihUqVLBgsQKHihUrVqzAgcOHCoA4BA5c IXDFihUrfpgACEDgQIIFDR5EmFChQgotAF4QOFAgB4IDM1w4oaNHDwAAAAAA CEPgwIEoUKAggSJFihQpSqQgkSIFCRIkSKQgoSIFQBUCBa7AoWIFQBwCBcoY iGPFCoEAAQgcSLCgwYMIEypUSAHDCAsALwgcSHBghgtAZIQI0gMAAAD/L1DQ AAhD4EAYKFCgKAEQhUCBKVCkQJEiRQoSKVKQSJEiRQoSAFMIHJhCRQoVK1bg wIHDBw4cLHAABCBwIMGCBg8iTKhwoQ8QHABeEDiQ4IUMGS4AERIiSI8XAF64 gAEDBgoYKFCgQJECRQoUKVAATCFQIAmBKkiQUKFChQoSKVSkWIGDxQoVK1Ss ULFChYoVKlasAIhDoMAfAAEIHEiwoMGDCBMqVCjDB4QRFgBeEDjwQoYLGS60 mBEiSIgbJEiUKAEDBgoYAFEIHIgiBQqAKQQOJKEihYoUKlSQUKFCxYoVK1aw WIEDBw6AKwQOxLECx0AWLFbgwAEQgMCBBAsa/zyIMKFChSGGDCHSokKGCxky ZLiQ4cKFDT+CDPlBokQKFDBg0IABAyAKgQNToEiRIgWJFClSkEhBIgWJFCRU qEihQoUKFSxWAMQhUCCLFQBZCBSIYwWLFSxWqFjBYsUDgAAEDiRY0OBBhAkV HtTgo4iREEGCzDgBRISHESJavLARwkiIIyhg0KBBAwYMGDBQwIABEIVAgQBT CBxYYmAKEilIpCChIgUJFSpUsFgBEIfAgSwArhAoUIWKFSxWqBjIQgVAAAIH Eixo8CDChAoPEvERIkSQIEGGBNlBBEkHIkaMhBhyAwUNGDRowKBBgwYMGDBQ wIABEIXAgQQHAkwhcP8gQRIpVKhQARCHwIErVqxQkSKFCxcuUrBYwYLFChYP kgAEIHAgwYIGDyJMqLDgDyI+QgQpEmLIECVDegwZwmOIDx83UACkIXDgkoEw aMCgAWOgQBQwaMAwgQKGCRMvmJhgYgIFkxQuUjBJkSKFChYrcOBYwUKFCxcA mwgUyCQJCxYqWDxw8QAgAIEDCRY0eBBhQoUEaxDx4cOHjyBDQgwZMiRECIA+ BAokAYMGDRpLnCyhsWTJkiU0lixZQmPJkiVPTDx58uQJlCdPnkABYuLJEyhP oEB5wsQEEyZMXLhwocKFiyZRmkiRMmUKlSlVqFhhwYKFCxcPAAIQOJBgQYP/ BxEmVDhQyI8fPnyECFKkx5AQAH0IHOjjRwkYV2g4WbLEyZIlS4AswQJkyRMo WJ48wYIFC5QsQLJggaJFSxYtWbRkwZIFShYsW7I8efKkSZMmUqhIkTJlyhQq U6ZUoUKFChUrVlwkYQEQgMCBBAsaPIgwoUKBL374+EHER4ggRUIE8eEjhA8f Pnz8+FECBo0lS4AsGSFiBBYsWp5oyaJFS5YsWZ5k2bIlCxctW7Js0bJlS5Yt W7ZkeQJwi0CBXaJEkSJFyhQpU6ZImTKlypQqU6pM8UKFCoYmLlwABCBwIMGC Bg8iTKgQAIgfP34Q8eGjSJAhAH0IHOjjh5AbJWgs/wGyBIgIKCaePOHCBWAW gQK3ZNkiUMsWLVuybHmyJYuWJ1u0PMmyZcsWLl2aAJQicOAUKVOkTJkypQqV KlOqUJnyhQoVKmCSPAAIQOBAggUNHkSYUCGABz9+CCHiw0cIH0UA+hAo8McP IT9sQDABREQLEUugPGEShkuWLFm2iMmSZUsWgFsECswycAsXgVy2dOHCJUoU KVKiAJQiUOAUKQCnCBxYRWCVKlWoTPky5QsVMElYAAQgcCDBggYPIkyoEIQQ Ij9+ECniI0iQED98EPnhw4YQG0JmYDjBJMmIEU9OhBmzRUwWMVuybMmyZUuW LVu2bOnSpUsXgFEEDhQoJf+KlChSpEiRMmWKFClTqEyZMoXKlCpVqkypMqVK lSlUqHyhgsEKQAACBxIsaPAgwoQKQfz48YOIDyI+fBTp4YPIDyI/fPwQYkOI EAxkgIwYAyZMlC1btojZIgbgFoEDu3QBGEXgQIJlBEqJIiUKQCkCBU6RMoUK wCkCB06pQqVKlSpVplSZYoaKmS9UMAAEIHAgwYIGDyJMqNDFDyJChCD5USQE kSAhfBARQkSIjR9CzmgY+CQMFy5ctmwRA3CLQIFdunDpEiVKF4BRBA6MIiWK lChSokiJIkWKFClTplCZMmUKlSlT0FSZUqVKlSkAqwgcOMUMFS9UqJgACEDg QIL/BQ0eRJgQYQ0fRH4g+UHkBxEiIYIECVGECBEbP87YyDEQyoY0abhsUbNl ixouW9QA7CJQYJQuAKMIHCiwjMAyAqWUAShF4EApU6RQAThF4MApa6ZUmVKl ypQqZr54YVPFDJU2YwACEDiQYEGDBxEmLPhACJEfRIj8EPLjBxEiQYIU0RFC R4gQPoTYGCgCTJQxUbh06bKli5gtALsIHAgwikCBXQZGkSJQShQpAgFKEThw yhQqU6RMmTJlSpUqU6pMqUKlypQqVaZMqTLFCxUqX74ABCBwIMGCBg8iTEhQ w48fP34Q+UGECBEhIWyEKOImyI4gQXS4CUFwRJg0abp0/+mypcuWLVu6dOnS JU2ULgCjCBxIMIqUKFKiAJQicOAUKVSkTJkyhcqUKVOoTJlCpcqUKlPWTKlS pcqUKV+8mPnSJgxAAAIHEixo8CDChANN/PARwocPIj+KEPnx5ocRGUWKuAkR IsQOIgTBpIkSBWAXgQMJpokSpQvAKAIHShEoJYqUKFKiSIkiJYoUKVOkSJky ZQqVKVOoTKkypcoUgFUECpwysMqUKVOmUKHy5QsYgAAEDiRY0OBBhAkH+vgR IsSQISHgECEiI44MIyF2uDHiI4SbFgPDhIkSJUqULlEAdhEoMEqXKF0ARhE4 sEmZJlLKNJEiRUoTKVGkSJEiZf+KFIBTBA4kWGVKlSlUqkwBWEWgwCkCv0z5 4sXMFCprAAIQOJBgQYMHESYcWIPIDx8hhgzhEcKIESNuZBgJ4SZEiBktBiYJ EyVMmihdoqRJk4ZLlC5RonQBGEXgQClRpEiJIiWKlCgApQgcKGWKlClTmkyZ QmUKlSlTqkypMqXKlCpVqkypMqVKFTNVpkyZ8oXKlC9fNgAEIHAgwYIGDyJM KBDDDyJEgvDgwUPHkCE8eAQJ4kYHESEEw4QJE8VLlDBRooQZEyUNwCgCBwqU 0kRKFClNpEhpIkWKlCZSpEhpMkUKlSlTpqCZMmVKlSlVpkypMqXKFIBVBA6s IodglSn/U6jM8VKFThiAAAQOJFjQ4EGECQU++EGkSAgdQYYA5CFQ4BAeQ+rY 2AAAAJA0YOxEiRImSpQwW6KkCRMlTJgoUaI0iSJFSpQmUqJEiQJQisCBBKc0 mUKFChUqU6hUmTJlypQqVaZUmVJlSpUqU6pUuVNFTpUqVcx8oVKFShU6AAEI HEiwoMGDCBMKfPHjBxEiIXQE4TGEBw8lPILwcGPFisAxbaKAiRImShQ8UcJE iRIlTJowUZpIkRKlSZQmVNbkyVOlSZQoUdBIkSJlyhQqaKhQqcIijxseedZU kUKlipwqU6ZUqVJFThU5VarcqVLFTJUpU6ZMofLli0KFChUe/8xxRggRIj7c hNDBg8cQHjx49IDzxorAMHaitIkSJUyUMFGihGkSJUqYKFLsRGlCxcoaN3qU hAjCg0eePFOaSJlCpcmUKVSqrDGiR4kRHjx48FCSZ8qUKlWqTJFTpYqcKnKq VLlT5U4VM1/MfDFD5csahQWh7OHTx49ChQaFnDkjhAgRIm6ChNARJAiPIUHe 0HkAAIwdMFHCSIkSJkoUgGHCREkTpUmYKGG6NFmjJEiIECFC6DASIgQPHjz+ NIkyZUoUKjhChOARIkiQIUNCDOHRo0eeKWjkVKliRk6VKlXuVLlT5U4VM1Wq TKlS5UsVDAABCBxIEACgPoEEDSJUyP9QIUBQChYsWFDggxo2zhw6Y4MIETc6 9ATREUQPHBs5KowJYyeKlDBRwkSJEiZKlCZRwkQJEyUMBiJuQgQxEiIIDx0h hvAIwoMHDx6IojT54sZIiCBFhhgByEOgwB4CeyipQmVKlSpTAFYROPCOGYFT zFSZMuULlTUAAQgcKDCRoj6DAhFaxIjRokaNChXqA8gPQYIECQJwNObMmTNC bJw5c+YMESJE3NQJQsTKIzIXmoSxAyZKFC9RIEUJEyZKlChhokRpYsVNCBlB QgQJMqRIkCFDgihRwoMHDx5W6IQIEcSIEh5DhgwJMqRHDx48evDowWPKlCpy qpipIqfKnSr/VapUMVNlypQvZr6YqWKFoMA9gxgtYhQp0KBIgyJJihRp0aJJ lCoRJEhQ4B5LlzAJOXPmjBAhRITQOXOGzhkbj8gMhBLGThgpbaK0ARhFoMAw UcKEiQLGCpEQIUIECTGkxhUnTpwI6TFkSI8hQ3jwkGFESRAjQ4Y80HBFgwYf PYb06DGkRw8eiKZUkVOlipw1cqrIqSKnipkqU6qY+VLFTCaAAAQKTGQoEiFC gxhFihRp0aJIkSJFWrRokaZNAwcOHHiJk6VOZ86cEWKDiA0inuoYgXPmDCA/ GwY+CSOlTZQ2UcKEiRImTJgoYZpE6UInBBEiIXwECbFBxJUNGjYA//k0ZEgP Hj148DASIkQQHkE0eNgA6kUoIIcA9hAocAiPHlXWVJFTpUoVOVWqVJFTpYqZ KVXMfJnyhcoXAAD4iCJEaNCoQZEiDQo0KJAkSaQkLYpEalGjQn4AAhA4kGCn UpYsmapx5pANIUQkESFC5NShR3RQofIjMEmbKHbaSIkSJUyUMFGihIkSJUqU NnCIEIHjw0iQUFdaaEjVQoOGKxN69BjSgwcPGUFCBAnSQsMLDS1MaPh05RPA HgIFDunBQ4qcKmaqmKkip4qcKlWqVDEzpYoZM1XmrAnDR5QgRoIGDRqkSpUo VZZEqRLVR9KpU6cokSJVKAxAAAIHAthzif+TJU6czpw5c0bIISJEiNQhcugM HUyoVlnCwyeMnTB2ooQJE8ZOmChhokQJEyVMGCshfsDx4SbEISctrjjRoGGD hg8aQvTg0YMHDyMhdAx5AESDEyhXTGjY8ElEiB49evDowaMHoilV5FSRc+fO mjtV5MipYqaKmSpTqkyhg0gQoUijBKlShYqVIkGGAhUyNEiQoECSTpGS1IhU Iy4EBV7iZImTJVNnDh0ScoiIDSJEiGDCdAYTJ1SlVrXCEyUKmChhokSREiVM lChhwkQJEyVMCB9wiBApEkRECyctQISwAQPUixYkevDo0YNHiBBBhrS40qKF DR5vNJDREGpCjx7/PXrw6MGjBxo5Ve5UuXPnTpU7d6rIMVMFoJkqZsxUMaOp 0KhRgjqhciWoUKRFkRhFWjRpUiRChAKdOrWIFClKYwAAAACAjyVLpSxxenTm zKEzRCQJISLp0JlHZ/i88rNqVStXYaLYCSMlSpQwUcJECRMlTJQwUdqEIELE Rgg4RYA4cdKCR48eMTRo0NCix5AeQ4YYCREiBJYWTjSE6NGDjIYPsDT06DGk R48hPIbkkbPmjpw1cqrIuXPnTpUqVaqYMVPFzJc7sVy1kqVqVKBFkgIxYsRo UaNTkgoxIrRI0qlTpBqd2gQAAAAAiSxxsmTJ1JlDZ84cOkSEyJlDEx49/8K0 Z9YsMa1c0ZISJUyUKGHCRAkTJgqeKFHCRIlC5QdAIgIHemjhZEOIIUM+afiw IVUPHj148CgSIkgQES1a0AgRIsQnDRs+aejRo0ePIT168Mgjp1YVOVUQIaq1 ptadNXKqyKlipkoVM1UQ0bIlyFChQosIEYq0aBEpSadOnbpViNAiUqdOSTpF CQAAAHtKleKEitOZM4cOnZFk442kQ7gePaLDp5SfXLp0qQljB0waKWGiRAkT JUqYKGCihIlCy4oNIjaICCGyw0OLFk4+3SjxYsMGDRiGDBkyJIibEEF4ANGw oUWJG59eaDih4VOPHkN6DOExpMefWrUQ3UF0p/9WlVpVENWSc+fOnTtm7syp smnTLkKDIjEKNGhQJEmSSEk6dYrUqVOLIi0idepUI0pfAAC4ZMmSpVKmbBw6 dAjgmUOYDk3A9QjXo0qoVq1axSuXmihhooQJEwVPlChh8EQJEyVKlDBRrPz4 8aYDkTdGnABpcaKFkxYvQI1xEmIIjx49goQI0WsILCAaNGjQ4OsTmU+pzvTo MWRIDx5DevyRg6jWHUS11iC6U6tWrSqI7lS5U+XOFzN3NBkaRSjQKEGsWLly pUiUqEGRIkk6dSrSIlKnGpG6tQkAgE6WSpXidOjQoUOYDh0ydQjXI1y4HnWy 1KrTKlStukgJE8VOmCj/UcKEiRImSpQwUaKESWPlzY84RH68CSHEwwYyGmBp OEGmxYYePIbwGKJERogQOup4gLIB1AZYv2CR0dCjx5AePYb04DHkTxU5VapU uXOnCsA7AgVWMWOmihkzVaZU0QRMECo8wVoJEyZKkCFBwlgpCrSo0SlSjCSd OkXq1CYAABJZslTK1KFDmA4dMoXpkClcuHBV4gNl1is/nVq5ihIlSpgwUcKE iRIlTJQwUaKEiRImDRUiRN68IULkhxsQIjRsgKWBzAYQAHkIHOjGDRE9O3QI AQLExJgTsMhoqNNjSA8ePYbwGNIjj5wqd+7cqXLnzp07tarcuVPlTpUqcqqw /6ky58swYquKDQo0qdCiRo0aGSoGKFKkU8YYkSJljBQpSgAclbJUihOmQ4cO HTJ1yNQEXLhwVXrEJ1euY7N0iYkSJkqYKGGiRAljJ0qUMFLCRMETJUoYMHB+ EPkh5M2bEEHeAPEABAoWK0MGBhFYxw0cN0Tc8KgzZgSWJ0Ae8egxZCCPHjyG 9KiC6M4dRFXu3LlTqwqiKojuVLlTRc6dKnfMzFmDbJQhQoQCLVq0qBEpSpQM uYok6ZQxRotIGWtEyhiAS4k4leJ05tAhTBMmmJpgChcuXJUqdUJlqdUrXWrS 2IkSJkoYgFHCRAkTJkqYMFGiRAETJUoYGzaEvLFB5P8NETghgryxYkVJECVB eAThEYRHnTpI4MAJ4UYHjzpw4CjpEWQIjyE8ePDgMaSHEjR3EFW5c+cOoiqI 7tSqUgvgHYEDq9ypcgfRplGjBhGKxGjRokWNSJFKJqzPIlKnFkVadOoUqVsA /FjiVcrUGVOHJijDhQsXLky4+FQC1MkVKleoaNGKIiVMlDBRwtiJEiVKmChh ooQJEyVMmCgY3tgQ8ubNGyJuiNTxFESJEj1ugvAIokMHDzqZ6rhxU8cIESVK 9ARRokQJQB4CBSoJMqTHHTlVEN1BVOVOFUR3ANYSKLDKnTtV7ty5c6fKpmXM RhEiFClSpEWLFi1qlKzYIEn/jYwtikTqFKlGkgAkKpUokalDuEwdwoXLFC5T mHDhAtQJlSVUqFbRihImSpg0YdKECRMlTJgoYaKEiRIlTJQoUcJYsWHjjZA3 RODAgQPHjQ43etwEUaLDE48/YSrBgQOnzg49QdzoCRJECY8gOngE4cGDR488 cqogqiKnCiI5iBDVqlJrTa0qiKrcmXPnzp0qc+4sazZqFCFCjCIxirSIUSFD igJJOnWKkSRSpxotKgRgTCJnpTqdOXTo0KNDjw49OvToESY/qDqVKtWKVhg7 YcJECRMlip0wUaJECYMnShQ8YaKEiZImDJ04b4S8efMGTgg3QZTo2eGmjg4l AHkY/6siJQoVT3XgeKpTx80OI0F06FCiYwiPIEp65GEjB1EVRIhqVUFUBRHA WgIFIqp1506VO3fu3KlVBdGmUYIYEYq0KFKhQpMMsRIViJSxRowknSK1aNEk ABtKlUp06RDARwIHPjr06MwjTHwsoerkqpWdKGGiRIkSJUyYKGHCROETJUyU MFHCRAkTJUwUMHTovLHx5s2bN3DquAlSp44nPTz+3KFShYqXNnTqeKrjqY4n PXr06NDDQwcPHj3+yKmCqAqiKrUQIap1B1EVRGtqIUK0ptadO3dq1aqCqMqm P89GCSI0yFCgQoIUFRNFilSjU4sYBTK2aNGiPgAAvCpVyv+ZqTOHDh16dOjR IUxnHmHCZAkVqlW08EQJEyZKmChRooQBGEXgwChhwgwMEyVMmDBW6Lx5QwcO HDh19OipU0cPj01UzNy5M2fOnS90MnnyVKeOJx1BgugwpocHj2VTEN2pVasK olpValVBhAgRolqIECGqVatWFURVECG6cwfRH2isBKkqVkxYK2GiCkVqREoS KUKB+pyKtKgQAAAA9pTilejSowm4DmE6dOgQpjOPHmHy06qULFp2wggMEyVM mChhouCJEiZKmChhBIYJIzBMlDBhIFmh8+bNGzhwPHnSoyfTpmZmgCFDBg1Y s0KbNsXS46mOJz06jOngoeePnDv/te7UklMLUa1aiBDVqoJoDaJaiO4gQoSo CqJadxDVQrQJ0bIqtla1YsVKkKFIixaRarQoUqRIoiSditSoGAAAAAAATFQq 0Z5Hnx4dOnTo0SFMjx49euRHV65caaKEidLJTpg0UcJEiRIlSpgoYaJECRNG ShMpbaJ4kSJFCiQqX+jQyZQpVqxNoqBF27Vr1zNpz6JFi7ZLWrNkmzZp8mTs zx9EVabVulOrCiJEd2pVQVQLICKBAmsNHHinCqIqAxGtQfRnlyBDoyZNIkSI 0KRIiyIxChRIFKlFkRa5AgAAAIBXpRK9enTo0SFcjw5hOnTm0aNHnXKJyZIm CpgoUcJE/4kSJkqUMGnCRInSJEoYgFIEDqTSRgoVL168UPli5gsyZIZ27ZK2 a9ezXc+ePZP27Jm0Z9KeSWOGjFo1RNXuIKoip9YdRLXuAKwlUGCVO4iqIKqC aFmtNbUQrRGICBGiO4gQIVoG7BkjRqNGjRpFaBQhRpEMiXIViVGkSIUAAhAo cE+iRIkcTTg04dChQ4ceHcL06AwgV8HS2MEjJU2YKGGihAmDJ0qYKGGiRIkS RgoVKVSoSJHSRooXKlSoAEOGrNiuXc+QSRO2a9euZ7ueSZMm7Zk0adKeSZMm TdouYHOsyblzp4qcKohqyakip1YVRFXuILpT606tWrUQIbpTa/9NLUSIEK2Z g2gZomeDIi1aFCnSokaNChkqVixSJEKEGOEZKHDMq0SyOJ2ZcOjRoUeHHp15 9OhRJVetaEUJEyZKlDBRwkSJEiVKmDBhooTxIqWNFCpSqEgJI8ULFS+QFCET JuzZs13Pdu3aFe1ZtGfSnj179kyatGfSnkmTJo3ZNWnSpFmrVuVOFURVEMm5 UwVRFURVEFVBVOVOLUQAa9VChEhgLUSINiGqhejPH2GrBIkyVKhQoUCikAkT FGkUIUaGUAEEIHCgwD25/Dx6cGjCoUdnMD06dAbTIzy0wkQJEyVMmChhwkQJ EyVMmChRooSJ0kaKFCpUqEiJ0kZKGzv/rrAJ27XrmbBnu3Y92/Us2jNBz55J k/bsmbRnzJhJeybtmTRp0phJu2Ztjpw7dxDdqSUHUa0qiO7UqnXnTq1atWoh WlML0ZpaABEJHLiMTTZh0YQJE+YKmTBBhhgRYkQoEEAAAgcSBLAnF6ZDEw49 OvTozCNMZx49aoMnSpQwadKEiRImSpgoYaJEiRImSpQwUqRQkSKlTZQwdsK4 yiZM2DNhz1g9E7brWbFnu57tevZM2jNpz5gxeybtmTRmzK5dYybt2jVp0ajd QVSr1p1aVWpVQVSrCqJaVe4ArCVwoMA7iBBVQYRoDqJliLQ9EzRqlKFJkyYR IkRo0KJAAAEI/xxIcOAxR48eHDrz6NChM4/OYHr0KEwUO2GigIkSJUyUKGGi RPETJUyUMHbaSGkjJUqUKGGkuBImTJiwZ7ue7dq169muZ9J2PXv2TNozacyk MZPGjNk1acmuXbvG7BozZsykPbtm7Q6iO3fkIKpVBVGtWncQ3blzpxZARAIH Dqw1cBkiYM9GjZo0ahKhQZEiEWJUDCAAgQMJFtTyaMKhR2fOHHr06MyjR1/C RAkTJk2YKHjCRAmDJ0qUMGGiRAkjJUwUKU2iRAkTxtU2bcJ2PRP2rNiuZ7ue 7ZL2TNqzXaOkPZP2bJK0a8yuXbsGMJlAgcyYMZMmTdozYJsQIbpzp/8Kolq1 qiCqgqjKnVp3ECHahGgOojW15iBChGjOsj+bBDEiFGhQJEKEGBEqVAwgAIED CRYUCOvMoUdnDp05c4jOo0eVooSJEiVKlDBRwkSJEgVMlDB2okgJEyWKlChR wkSxQ4vYqmjPhD0TJuzZs127BCF7tkvaM2nIpD2bxAzZNWbArl2bRG0SN4DJ BA68xuwas2Zz7typVatWrSqIaiGqdQdRlVq1ECFChGgOIkSIaiFCVGsZoj9R DDEaxYhRoUB9dAEEIHAgwYIFz5w5dObQmUdnzjyy0iZMlDBhooSJEiZMlDBR 0kQJEyVMlCheooQJEyVKmCjZhGUTJuxZsWj/0aLt2vXs2a5nu54xe/ZMGjJm 0qRJY3ZtErVr15Jdu3YtWbJk3JJdk8bsWrNad6rIqYKolpwqiBDVqiWnVi1E iDIhQjQHEaI5iBAhWvYHERgAeBSJwmPQoEGDDw6dsXLmzJlHZx494hMmSpQo YcJEiRImSpgwUcLYARMlTJQwUaJAihIlDLFsrrRli/ZMWLRdu6Lt2rVLmrRn 0JhJMyRNGrNrzIAxuyaNGTNpzKQZunaNW7Jk164xuyat2Zw7dxAhqlULUS1E tRDdQXQHICKBAwkKnLNMYBuAAAQOJFjQ4EEAOc6cOXPozJkzVh5VahMmSpgw YaJECRMlTJQoYcIA/4wiUGAYSAOjtBKWrRU2YcKw7Yq269muXc92PTPETBoz adKYXbt2jZm0a9cMSZPGTBqza8yuJUvGLdm1a9KuMZtT6w7AWgIFVkFUCxGi gYg0IUK0CREiRIjmIFqG6A+iPzyC8FCiJAgPHlYAAhA4kGDBgg8enDlj5dEZ K2esgAljJ0yUKGGiRAmDJ0qYKFGihJESBk+UMFGigEkThparbNlWZROGTdiz XdGeFdv1bJc0ZsiYMQPGDNi1a82uAUt2TZq0Z9KkXbt2LVmyZNSkSbsm7dqm O7VqIUJUC1EtRIgQIap1p1YtRIiWIUI0ByAigQKXIfqzjMeQIEF48AjCg/9H DzcAAQgcSLAgwRxnzpx5cCbHozOQwkSJMiZKlDB4wkSJEiZKmChhwkSJIiVK mChRooShlS1bsGzCsEXDtuuZsGfPnu2StuvaNWnMDEljdu2aIWrXrkmTJu2Z NGbSpEm7du0aNWrXrkmTVq3WHURVENWqhagWIkSIEN2pVQsRIkTLECFaVgsg IoEC/2jiwYOHDh5BeAwZ0qNHD4AABA4kWHBgDoBnBArMccZKmChhokQJgydK mChRokRJEyVMmChRooSJEiZKmDBRugXLli2bMGzCoj0DuEugwGe7pCFjdk2a NGDMrl27BuwaQGkCBw5kdu0atWTXCFarVQsgIoH/AwkiqlVL4LKCAzUh0vRn 2Z8hPILw0DFEyZAePXooAQhA4ECCBQUKOSPkzBkhVs5gChMlTJgoUcJECRMl SZQoYcJEiRIFT5goUaKEiRIlCi2A2QQKjIYNm7Bdz55Fe7Zr165n0qQBY8aM GbBr15hdAyhN4ECC165Ru0bwWa1atWohQoQIUS1EiBAhqlWrFkBEAgcSLPhn WQ8dPHTw4DGkx5AePHoABCBwIMGCAnPksHHmjI0zVhyFsTMmTZgoYaKEiRIl CpcoUSBFCRMlSpgoXqJEiRKFlrds2bJlE6YtmrZo0XYJirZL2q5du3Y9k4ZM GjNm0KRRu3ZNmrRr165d/6N27Ro1atcAShMoENEcObVq1aqFqBZARAIF1qpV a+CygZoEbkK0DNEfOj2C8NDRgwcPgD0ECgQIQOBAggUFbphxRsgZIWeshAkT JUqUMGGiRIkSJUyUKGGiRPESJUqUNlGihImSJgyxbMGyBcOGDZuwaMKeRYsW 7dmuZ7uePdv17Jk0adKkMbsG7Bo1YNekUbtGDeA1gQKlSZN2jRqiWnIQ1UJU qxaiWogQIUI0p1YtRIiWIdIEEJHAgQL//EGkhIcOHkGG8BjSg0ePHgABCBxI sOBAG0LO2Dgj5FGYKGHShAkTJUqYMGGihIkSJUyYKGHCRIkSJkyUMFGifAuW Lf9btmyrtGHDFi3aM4DRBAqUtkuawGfSpO16Bo3ZNWnXmF27do3atWsApQkU eE1gLUS15CCqhagWIkS1ECHKhAhRrVoAEQkc+GfgwGXL/njqwYMHjyFDhvTo wWMIQAACBxIsOPDMmTNCzrzBECVMlChRooSJEgZgFIECw0SREkZgmDBRpETB M5AYOIDZBArEJkwbwGgCBz4TqE2ChGfPnkl7Jk3aM2nSpD2TJu0aQGkCBwp8 Rq1WLURyatWqVQtRLYCIBAq8U6uWQE1/BiLSNHDgnzw9lPDgMWRIjx48hvQA CEDgQIIFBz4QYqPGGRuQooQJwyVMFDxRwkSJ0iRKlDD/AKMIHCglSpiBYQTS sgUuG7hsq7BFw4YNYDSBAyVEkyBB4LNn0p5Ji/bsmbRnzwBKEzhQ2rNnBaTN QYQIkZw5tRDVQlRrTS1EmRAhmgMQkUCBfwYOFPgH0Z8/PHjw4DGkB48ePYb0 AAhA4ECCBQkKmXHmjJAwdsJESRMmSpg0YaKEiRIlTBQpUcJECYMnDMAoAgc2 kdIKHMBsAgViwyZMW7hoEqJJiCZOW7RoEqJJkPbs2bMCBSQUeFbg2bNnz6A9 k/ZMWoE5iBAhqlWtVq1atRDVqgUQkcCBtWoNHDhwoMA/y/4MCcKDx5AeQ3r0 6AEQgMCBBAsSnHFGiA0rYcJE/xmTJkyUKGHShIkSJU2UKFHCRAkTJUqUKGGi NIkSJYqdMFHU2MqWLVs2bNiwRYsWLZo2bNqwadMWTUK0Z9IKSJP2rICEaAUK SCgg7Zm0ZwUK1EKEqBoiRHLu1EJ0BxEiRIjmLEOEqFYtRNX+IPqDCBGiP4gQ VUOE6A+iP8t4BBnCY0gPHj2G9DBo0CAAITVs1HgUJUyYKFHCRBkTJUqUJlHS RAkTpU2UKE3shIkiJU2UKFG8RLETJoqabrbGZcuGDRs2bNGwYRuHLZw2cdqi RYtW4NmzZwUkSJCgTZsECQUKSCgADBEiRNUQIUI0p9YdRIgQ1QKISODAWrUG /kH0Z//gwIGZ/izjEYQHjyE9evQY0gMgAIEDCRYkCGLGjDNgwkRJMyZNmDBp ooQJEyVMlChh7EQJEyVKlDBRmkSJEiZKlDZRothJk0aNLW/gsmHDFg1btmzY sInThk1buGgFdhWAJu1ZAW3aJEiQIEFbgW/NatWqVgsRIkSI5iCqBRCRQIFz BlZDVK3WwIEDBWoa+CeTDh46hgzpMaRHjx4AAQgcSLAgQTI1bJwJEyVMlChh ooyJEgZgFIECw0QJEyVMlDBhwgyUEsaOlyheBkaxQ4uWLW/esGEj5y0bNmzj sGHTpi2ahGjSJEh4VqCAOHHhxJH7BgwRIjlzaiFChAhRrTn/tahUWbNsGSJE iJYhQoSoVq1aiP4g+oMIESJEmhAhQqRpDaJlPHjwGMIDYA+BAgECEDiQYEGC L4ScETImTJoxacZEiRImTZQwUfBwiRLFS5QoUcJwwaKlSZQoUaK0iSIlipco UaJIiUKLmK1u2bJ5A4ctGzZs2bBhi6ZNgrZnEqQ90yaOXDho1mrVmnPnTq1a ABEJFFhLjpQwYR6tGTiwVq1aAwcOHDhw2TIeSobw6NFjSI8ePQACEDiQYMGC Vs5YCRMlSpg0YaJwidIkSpgoTaKEiRIlTBQpYzhgaWMnTJQwUbxIaSNFihQp U6S0kSIlSpRuasCBA+cNnLdx4sSJ/8MWTls4beHIfSM3bU6tO3eqIJpT5Q6i KogQIUJUqxaiNVbAkLGCyBpARAIF1hqI6M/AgQOrIfozhAePIQB7CBwIEIDA gQQLGjxzJkqUMFzCpIkSJk0UWgCjCBToJUqYKFxGVBgxJgwVKlKiAJQicCCV KVOmTPkyZYoUO1LK2CFGjBgxO9++ffsGDdo0NnPuNDNjRk6VO3eq3EF0p1at WogQ1ZqDaM2aJmPChPmSCREiRNUQIaoGEJHAgQQRVRu4bEiQITx6DOkxpEcP gAAEDiRY0KCQHGmicInCJcqYLmGiROESJUqYKFGihAkzgoOHCuWwjGkjRUoY gFIEDpQyhf/KlClTqJiZMsXMlDtV7lSZ86UKolq1ECFCdKfWFDNV5txBdAdR FTmI5NRCVAvRH0R3wjwBAycJmTZU/iBChAhRLUSIECH6AxCRQIHVBs5B5KkH jyFDevTg0aNHD4AABA4kWNCgjUdhonCJMiZKlDRcmkSJEiZKlCZRwkiBwuHC BhsYWlzA8iQMlTZSpLSRQmXKlClUpkyZUmXKlClTqJipMmXKlCpVqtzZdOdO rVpmzMipcqfWnTu1qshBVAvRsmVVxpR7xKPHEB5N6FSphQgRomq1agFEJHAg omoDqwmcA2cIDx48hvQY0qNHD4AABA4kWNAgiBxRojRJkyYKlyj/UaKkaRKF C8AoAgViGQHEBpE3IayMueDhSRgqVKS0kSJFCpUpU75MMTPFC8ApAgdOqVKl yp0qAO8IFIimipwqcqoIlFMFUZVla76MeUJGyRAePHj0WAYFESJEiGrVqlUL ICKBA2shqlULUa1ad+7U4RGEB48hPHrw6NEDIACBAwkWNEgGQxguYdKMiRKG S5QoYQBGESgQj8AmDk68sWHFihJYQExUKAclDBUqUaRMkTLFi5kpU6ZMMTOl ypQpVKpMqcJGzp07VRDVQjSFzR05d+7cqYIIEaI1VLBAedMjzBAeSnjwUMID C5VltWohqlUNUS2AiAQKlFNLTq1ate7c/7mTiQePITwA9hA4ECAAgQMJFjQI oBKXKGmepInCJQ2XKFHSREkTJUqTKFG4OHhkw8qbNzkuWIHzBgwQDiO4tKFC ZQqVKV4AThE4kCDBKnLuyKkip5ZAOVWqIEJUZU2TMVB8wenRo8ebJj2U8ODB oweVJohq1apVTQ6iWgARCRTYDJGcWrXk1JJzJxMPHjyGDBkypMeQHgABCBxI sKBBAGCicImShkuYLlG4RIkSJkoaLlGiRJEChYMVK0KswKnw6I2VN2/06CFz wQGWJ22ofKky5csUL1OmAZwicCBBOXKq3KlVpUoVRFWoJHkyAouVITx48OAR pIe5EEF4KOHBw/9KFERzatWSU6sWIkSIqiGqJUdOLTm15NSSc2cNDyVDeAzp waMHjx4AAQgcSLCgQQBjukTpwiUKly5RonCJwiVKlChhokQJo+WCFStv4EBp 4cYGwDcCBcJx80YEEA4csDwZE6ZNGypUvlD58mXKly9VqqxZU2VNlS9hmjzB gkUEFhBuAPIQOHAgHBA9lAxsMgbRnFq1asmpVQsRIkS1asmRI0dOLTly7tzJ NHDIkB49egzpARCAwIEECxoEECZKkzRcujTpwiVKlDBR0kThEiVKlChYKpyx IuTRCDhwhLyx8mbNmzdv3lQ4o0cIGCgjOJS7wGEEFihQnnB5MubJGC7/T55A GYGFw4gNGOAEgUJmiBIdSnjo4cGDR48hTTzx0MPjj5YmiO7UkiNHTq1aiKrJ QVRLjhw5chDJkSPnTiYeQYbw6NFjSI8ePQ4ePAhgTJQuY6J0icIlCpcuUbik 4RIlSpQoYbA4yPEIjghYcN7YAPhG4EA3UIC4gePGTRAlenZYeQRmDBQoQEaI 4AAEyAYQGN7AUaJESZAgQYLUuSCDBw8lOnjw4MGjB481Y3jw6EGFTJg1cmrV kiNHTi05iGoBlCNwYK2BVfTwGMJjSA8ePXr06AEQgMCBBAsaFNglCpc0XNJw 6RKlS5QoUboAjCJQoJYLTN5MuGDlzZs3Vta8/1nzZk2NCznqwIEDB44bPTrg 6AkSJEgQDBzgKAHIQ+BAgUr0KFGiRIkOJht66AmiR0cQgT2U8BgRhIcVKEzC IJIjp5YcObXk1JKDSA4iOWjkoJEjB42cKjp4DOExpEePHkN69AAIQOBAggUN CuySZkwXLlG4dInCJUqXKFwARhEo8AkHDyHIeHjz5o2QN0LevHkDxwQUIzbg /ICjp44SN3DgeIIDRw8GDnDquFGiQ48bJTp4KHGjZ4cSPUF4jAjCQwkPJTx4 8OihhIe5HGRGgAET5k4tObXkyKklR04tObXkoJEjRw6iWrVqreGhhMeQIT14 9BjSowdAAAIHEixoUP9glChcuHTh0oVLlDRRukTpAjCKQIFcLnggA0QEHBtv rLyx8ubNGysVhLh5AwcOHDg79CiB4wYOHE+eMDggYkSPGyV6dARRwsNIHSVu guhR0oPMGB5KdPDgoUdHjyB1sABpYaUHlzZ35MiRgwaNHERyagGUI3BgLYFo 7iwbEmRIDx5DegzpwaMHQAACBxIsaFAglyhconCJkoYLly5dunTh0iUKlyhR olzQcIFDCyFW3ryx8uaNFTgbRsB58waODThw9PRyAweOGzhu3GC48KaOER11 guhRooSHHjc69CgJsUOJpwt6gihREoQHDx48MEDREISHEixU7sipVatWLTn/ iBAhQiQHEUA5AgfKoaODB48hPXoM6cGjBw8lAAEIHEiwoEGBXaJw4dKFSxQu XaJEiRKlSxQuUaJwieKBzAYHLd68eWNFiI01b9yMGEPkzZs3RODAeaNHCUA4 AgW6yXHhjZ5edYwYceMmCA8lnty4caNDSRAeQKzwCMKDBw8ePYJogQKrBw89 WRDVklOrVi00cmrJkSNHDho5aOTIqYVGzhoePHj0GNKDR48ePHpYAQhA4ECC BQ0KTMMlDZcuUbik4RKFS5coXABGETjwyRgiQC68qQNHCJw3cN7AqWDDSB0j dYzoUaKklw44bvT0UqLEioM3OpQEAchDoMAeeoIM/xzI482YHgMHQoHy5lMP HlTSIJIjR04tOWjkyKklR04tOXLQyJEjR84aHQN79OgxZEgPgUwAAhA4kGBB gwKjcEnDhQuXLmm4dOnSJQqXLlGicIkSJQwQOGc8mHgTwoqVN2/ggBDhBs4b OER6uemlx40SOG7cuIFT580FG0GUKNGjRI8SHjzc6HGjRE8QPUr08BihhAcP Hn/oAGkRxAqIHjyeVLkjp5YcOXLQyJEjpxZAOQIFopGDSE4mHjx49OgxpEcP HkN68AAIQOBAggUNDuSShguXLlG4ROESpQuXLlG4dIkSJQqXLlB+vRFxAYiV N2/evHEzggwcOG8AwhEo0P+NHjdv4LhxA8fImws59LjRs0OJEiVBeOiBo0SJ GyVKdCjpgWWDpzdhPFx4M4SHFTI9wGypBVCOwIFoBg6UgwaNwFpV/gzhMWRI Dx5Degzp0QMgAIEDCRY0SJBLFC5duHDpwqVLly5RukThEiUKlyZRonAZIaSF hjEXgGggA4LMBQxw4Lx58wYOHDhueil5AxCOQIFvLuTQ4caIGz1udCjh4caN Gz29jChRooTHkxYjOLQ4M6SHHh4YYCnBQqUKQDkCBaIRWEtgLTloBgpcNoTH EB49hvTo0YNHjzcAAQgcSLCgQYJjuHTpwqVLlzRcunSJwiVKly5RukTpEiWM OSj/Isi4sbEBSoULFTyMgfPjDRw4Mt7UgeNGx5s3cNzAgQOHAqwgbpS4CaJH SRAebtzk6aVHSRA9bnhoMYGhzhAePHjkUQKGzAYuVQDKESiwFho0AwfKQSOw lhw9PYYM6dGDRw8ePYb0IAMQgMCBBAsaLLilSxcuXbh04dKFS5cuXLp06dIl SpcuUbh4uNACjpU3Qt68yeGhggY4b968eQMHDhw3euDAkQEHzps3FaAEceMm iBsdeoLwUAJHjxs3bpTAUcJjhJshPHQoCdJDj5JHUJ5UkSPHjBw5cuSgAShH 4EA5aNAMRDRkCI8hPYb04DGkR48eAAEIHEiwoEGDY7pw/+nSJU0aLl26ROkS ZUuXKF2iROkSJcwWDiPeWDlj5YwVOBw8XDBBBCAcgQLz9FIy8A0cJRgujLCi xI0eJTuUBOFRB04vPW6U6OnFwwqHIEGU8FDCg0cdHmOgtLkDUI7AgQLRCKxF cCAiPUOGDOnBo0cPHj169AAIQOBAggUNHgTQpQsXLl24dOHSpUuXKFy2ROkS hUuULlGkaLlAhkglIWvOwBmhAcgFDzncuHkDJ4QbJW+EvIGjxIoIICIu5Oih J4gSPXp4GIFTx4geNzp6WOHQgocSJTyUBOHBY025NlXkoJFjRk4VOXLQoJEj R46cWnLkyJFT60+PIT149OgxZP9IjyE93iBEiLAgly5cunTpwqVLly5cunTZ EoVLlC5RokTpEkWLBwxWbFix8aYFGSVkRlwYgQEHHCNGlMhw4+ZNkhEjRgAR 4WGDDTdBePDg4caNmxBG4DyAwgFKCx46lARRoqPHI3NcqsyRI8eMHDNy5MhB I0eOnFoA5QgciGhIDx49ePQY0oNHjyE9AAIQOJBgQYMHBXLh0oULly5cumzp 0qVLly1donTpEoVLlChSomjhMOaNFStvNrSAA6cOhhEUHFy4UGHEiBEXKFyo 4GGEiBYjLlyowGEEEBEXOFSowIECBSBvNJDhoYSHEiU9rDiIgkiOHDN30MhB I0eOHDT/AOUIHEjwTw8dPIb06NGDRw8ePXoABCBwIMGCBg8K5NKly5YuXLZ0 6dKlSxQuXbpE6RKFS5cuUbpEkfKEA5k3VoRgGAHnzRs4b4TkiDHGhAkTJshg sAJHzwsNQdzAsYJhjAYyG6CYIDMGhJA6OniYgzUkiBIlPOhgCVNFjhw5ctAA lCNwIBqBteTUEogoTx4eQ4YM4dFjSI8ePXjwAAhA4ECCBQ0eHBiGS5cuXLpw 2QKwi8CBBLtEicIlSpQoUbiUeyTEypsRb968sQLnTR04OnjwUOKmDhwib9xs IKMHjhslQXgM6dFDjxIlPJQoUVLHzYUzPHQo6QGnXBg5cqqg/5Ejhw0aOWbk yJGDBqAcgQJrodHTo0ePHkN6DBnSo8eQHjzeAAQgcCDBggYPEuTSZQuXLl24 AOwiUOCWgVG4dAEYReDAKFs4nHlDZwSIN2/WvHkTBw4cOErevIEDBw4cPS1O hDBSp44eJUqC8IADp04dN3rcKIHj4I0SHTysYPFSZQoaNHLYyEEjxwwaOVXQ AJQjUGAtNIh68OABsIfAgTwE8gAIQOBAggUNHjTIpcuWLVy6cNnSJU2XLlu2 ROHSpUuULVG6AIwiUOATD2DgaIAC8I3AgW/cuFEC5w0cOG/guBERQ4kbPXDc KNGjhEcdOHp66THiRo+VC3V48ABTzv/LHTZo0LAxIweNHDQA5QgUiGZgLYE8 eATh0aPHEIA9BAoc0gMgAIEDCRY0eNAglzRbuHDhsoXLFi5dumwB2EXgwC5R onSJEiUKlyhcKoz5VQGOlTdW4LyB88aNEjdv4MCB80aJB1hu4NTZoaSOEh08 4MDJ40aPGz1GMFzQoYSMuTZV0EyZMkUOGjlm0JhBY0aOHDRo5MipJUcOoh5K 9AzhMYTHEIA9BA4ECEDgQIIFDR48yGXLFi5buGzpsqULly5bAHYROHBLlyhc okThEiUKFw4eOGCAQ+fNmjdv4MAJAefNmzdw3ripAEIJHD1w8hhxoyQIHDh1 8vTSY0SJiRH/dYCYa1NFDpppaKbIQTNFDhozcuTIkYMGjRw5cmrJQcSDhw4e PIYMAdhD4EAeAAEIHEiwoMGDB9Ns2dJlS5ctW7ps6dJlyxaAXQQKjCIwSpQo XLpECRNFiwMsOeC8efOGRZ03RuCsefMGzho3HkDUgbMjjxs3bpTweLMGjhE3 efLweAJkBJcvVczIQTMFzRQ0ctCYQYPGjBw5ctAAlCNQ4JQ1PIIM4TFkCA8e Q3rw6NGjB0AAAgcSLGjwIEIuW7hw2bJly5YuXbZs2QKwi8CBUaJsicIlisAo UcJw4cBhjJA3cN7AgQOnjpU1b968qVMBgxE4buC4yeNGh543cNzA/9GjRI+V EWLC3KkiZ4oZNFLQoDEzRQ6aKXLkTJEjBw0aOXdqIVqjhMeQIUN49OgxpMeQ HkN69MAAEIDAgQQLGjx4kEuaLVy2iNmypcuWLlu2bOnSpUsXLl24ROESpUuX KFGiRLET5omDclis1KnjJs8bK3DerHlj5AIIPXDc5HHjpo4RHm/gwOHhBgyH cmG8yJmCZgoaOWimoZkiB80UOVPQyJEjBw0bOXKqZFLCg0eQHjx4DOnRo0cP Hj2G8OjRAyFChAgJitmyhUuXLVnEpOnSZcuWLl22cOkSpUuUKFG2dIkSJYqd KHaiROEyotwIMm/cuHmz5s2bNW4ugHDzBv8OHDhu9PDg8eYNhicjsIyhYmbK FDRm5KBBM2XaFDRT5KCZgkYOGjlyzKBhc2eNkiB6dPQYomTIEB5DevQY0mMI jx49ECJEiJDgky1cxGzZsqVLly1b1GwBqAYcOXLdunXrVqZbmS5dAEYRONBO FDtRoJRzUA4IBjhu8vyoU46JEhlGlCjhoUQIlArlymkJU2XalClTpqAxg2YK mmlT0ExBMwWNGTRm0Mgxg0aOGTpKgijhEYRHkCFDePAY0qPHkCE9ePToARCA wIEECxo8iPDJFi5iuGzJsmWLmi1dtowDeE7gQILn0AGMInDgwDBt2oThoqUc hxFAoGzgMMIEFFr/XICM4FBOC5cobaawmTJlipRpU6ZNMYNmyjRo0KagMYNm ChozctDImTbtix4lSoIE4TGExxAeQ3j04NGjBw8eQ4b0AAhA4ECCBQ0eRAjg CRcxW8R02bJlS5ctW9ABPCdwIEGB6QBGETgwipQodqJIoeIlShotWMyVw2Ju lrpzup5waVNlihQpUqZMmyJlyrQpU6agQWNmWrpz06awQWPGzBQ5csygmUbF kxI3bnToGDJkCA8eQ4b0GDKERw8ePIb0AAhA4ECCBQ0eRCiQixguYrZsEbOF y5Yt686dO7cu3bp0AM8JHCiuC8AoAgcKtCPFjhSBUqRIiSKF3Llz56RQ/6ky hco0O1KkSJkyZco0KVOmTZmC5tm5c+emoJliZgoaM2aqoJkmJVMQJTpCBOHB g8eQIUN68OjRY0gPHkOC8OgBEIDAgQQLGjyIUOATLmK4iOkiZouYLWrOnTt3 rsuWLl26qEF37ty5dFGidAEYReDAKFKkSIliR6AUKXbOnTuXbpoUKdMAShEo EM00L1OmSZmCZsq0aefOnUuHZooZM1PQTJFjBo2USm6UuAnCIwgPHjyG9ODR o0ePHjx69BjCgwdAAAIHEixo8CDCgmnEcBGzZQsXLuDOnTuHbguXLVu4dFFz 7ty5dVGidIkSJUoZcuTIRZEiJUoUKWmkRCF37v/cuXR2pEybgkZKGTvhoEGD NkXKFClTpk2Bdu7cuXTTpk2ZMsWMGTPAoIX7oiOEmyBGgvDQoWNIDx5Degzp 0YNHDx5JEiZMmPCgGDFbtojZImbcuXPn2HHZ0kVMly7bzp07l65LlChRwq0D eE6gwHZlonSREqXAwIHn0kmRgiZcuoEC00mZNmVKgYEDz0lAg2YKtAIDBxZy E0RHEB1DgvAI0oNHjx49evDo0QMgAIEDCRY0eBAhwidbxGzJkmULunPnztna ImaLGC5i2J07dw5dlyhq0gE8J3CgwHRlokSJko7gwAJSpKQjSPCcFDRT0hEc WMDMlAIECZ6TpiOIjjr/QXQM0TFkyJAePXrw6NEDIACBAwkWNHgQYUIxW8Rs EfPk3Llz59RwESOmixhx586dO6cmTZp0586dO4cuHMBzAgVGiRIl3UCB6dJB k1JgYLoCBdINLDBlyrl0A8+lSwdsSoGB59Ixezbw3CI9OkLoCKKDxxAePIb0 6NGjBw8TAAEIHEiwoMGDCBOK2SJmi5pz586d8zZuHDt0686dO3euXRou4s6d O3cuSpQ0UdKdO3eOXBQ7UeycO3cunRQpUqSkS3cunRQpU6CdO3euwLQpaKad O3cuHZop06adO3funDQZbupsOnfuXLoQIULo0GFsCA8eQ3gMGdJjCI8NCRMm /0yYEACULWJsATwncCDBgevSiElDkFyaNFGikBuILkoUO2UGorNjR4oUKVPs 2JEiRYqUgQXMTJmGbGCBaVOmFRgowQ2REHDqSBhYR0eIIUGCBNExhMeQHjx6 DOkBEIDAgQQLGjyIMOFAMWLGATwncCBBgei6iOmSbWC6NFGiREkTZZ3AdFGi RAm3TmC4KFKiSJEipUyZbwUKFBj4bIqXaQUGPvtChUq6gYWIvCFSh460gbGC 7AihQ0cQHkqG8OjRo0cPHgABCBxIsKDBgwgTFkR37ty5durYsVM3bliwYy32 7Hky7ty5c+KiROESJQ2xc+fOoesSJUq6c+fOkbNTJv+KlHDpAJ4TOHCglClT qBQYKOqQskMEzxDJRCeKGgkDY4UIEsRIkCBDhgwZ0qNHjx5vAAIQOJBgQYMH ESYseO7cuXNqoKRK5c6du3cA4QkUOO7cuXO00kRJkyYKuXPnzqFLEyVKunPn zkWJIiVKOoDnBApMV2DgOS+VKp0ZeC5UPHmhBraLF2pDmihR1g2sE0KHmyA6 dAThwWNIjx49lAAEIHAgwYIGDyJMWBDgOYECAQBw5+7du3nwAM4TKDDbuXPn OoW6hCdKGnTnzp0j1yVNlHXnzp2LUiZKuHPnzqUrY8eOlHPnzqXDZUqZvHPn zq2LF49eqHPnzj2rJw+UhjT/xM6dO5euRxA3QYb06KGDh5IhQ3r02AAQgMCB BAsaPIgwYUGA5wQKBPDunb0r9t7Nszfvnr17qwbKuhcq1Bg86wamSZOG3MB0 UaJEQTcwSpQoUsINxIYvXj1OA7XFo0dP3sBz9I7kCzUG3cBCPXQE0TGkRw8e Q4YM6dGDB0AAAgcSLGjwIMKEBs+dO3cumzt79uzZg2fv3rx59+7d43Tu3Ll1 8e7dA9Xu3Llz4qJ06SLu3Llz4qJEiZLu3LlzZaLYkZLu3Llzsu7V07fq3Llz qO7Fo5eP3blz5yzlO7LP0rlz584FCRJCx5AhQ3oEGcKDx5AeehQqVKhQIYBz 586d/3s1z948e/bs3bM37949fvzitTt37ly7VavanTt37lyUKF26sDt37lw6 cuCioDt37ly6cOIAnhMo0Jk+efdWDWyXqFS8fJwGntPG6dnAc4V6uAliZAiP Hj1CDNExpEcPOAABCBxIsKDBgwgTFgR4TqBAePzs2bN37948e/Pu8bvHj16o dQMHCmzHaUyaNF3EDRSYLk23gQMHCuxH7949VAMFaqOXL5+2gQMHMhuiJISO IEOG9OhhYwgPHkN6sAAIQOBAggUNHkSYsCDAcwIF2rM3z949e/zs8bvHj989 evTyhdI2cOCqUPpCmdrDpUu6gefEdYlCbuC5dYlkDbR0b//evXvtBp5DRS9e vXqWBg5sVyjEkBBBggwZ0qPHhhxDggzp0QMMQAACBxIsaPAgwoQFz51LBW+e PXv2+NnjZ4/fPHr8+M3jRy9fvnyhOKFCxSkfPXr59MkL46dLF3DjxIFT02VL FzXnzr1y5w4evFTy4N27F48fP1CoUFmKR49evnz16nFSZYmTPH8hgugoEiTE kCFBegC40SMIjyE9TChUqFChQoH27tmzB5CfwIEE6fGjRy8fvXz08uWrly+f vnz66u2Tp0GMmi5btmzZIkaMmGMAALx79+4KvHv35t3jR48fPX708tHLRy9f vnz56tWrd6RePX8hhhAJoUPHkCH/PZQAsMGDB48hPQACEDiQYEGDBxEmRGjP nj1+/PjdA8hPoEB6/Ojxo0cPYD6BAuvlo5evXr19++T5UwZFjBg1AMUIFKgF AAAA7+C9g2fv3j1+9OLFo0dPH7189PLRy0evXr56R+odoecvn78iRIKEGDJk SA8yAHwMGTKkRw+AAAQOJFjQ4EGECQ/+s3fPHr97/Pjd40fvHj1+AOkJFFgv X74j9fLRy1cP4D6BAuvJAwBAjBYxWbSI0QIAAAB37t69g2fv3j19/OjRo6eP HsB8AgfWq1evHsAjAgfu+0HER5AhQ3r0AADAR5AhPYbwAAhA4ECCBQ0eRJjw IDx79uzx/7t3z949fvro5dOXLx+9fPkAHhE4sN6Revv87asnr148AAAAiNFi TgxAAAIHvnv37t28efzu0bvHjx+9fPX21au3r169egCPCBx4xJ+/fYd8hAgy ZAgPAABqDAkxpEcdgAAEDiRY0OBBhAkPzrNnz949e/fs2btHr169evXy1ct3 JB/AIwIH7qt3pN6+ffXk3QMIQKBALWIGDnz37t07e/Du3bN37x4/ffX21dtX b9+RI/UA+hM4cKA8e/FChFDSAwAAAC+CGOHRAwNAAAIHEixo8CDChAbf2bP3 7p09e/beXbl3L18+ffn05cuXD+ARgQL3+dt3pF6+evny6YsHEP+AwIEEB757 9+/dO3v27N2zd28eP3358uXLpy9fvXpH/Pnz5++IP3/+/OW7B+BTjIImQEBI UrBgwYIFCwI8J3AgQAACBwI8J3DgOQAAAKR69epVqnfv3tl7Z+8eqE6dOoHi p49ePm0SOB2pVy9fvXz56uXLp+8eQAACBwI8J3DgK3fv3v179+6dPXy8eCUK xY+fvk6dOnGipy9fPYBHBAqs52+fv3oAAQgcSLCgwYMICwI8J3DgOYAABAoE eE7gQIEAAADwNnDYu3fv/r2zZy/bwFX8+PHTt+4cp3r58uXLdyRfvnz69MUD AAAAAIIEz7V79e4dPHv27KkTuA7UvXv/oAaO40cvHz2A+QQOzFevXj6AAAQO JFjQ4MBz5w4eBADwnMCB5wACECgQ4DmBA88BAAAAQLuBzv69s2fvnz177QY6 47cqFL125zjVM8XJ35Ej+fLl06dPHwAAAAgSJMjrnT179+6tGxiPHz9LA1HR o6cvX758+Y7kO1KvXr18AAEIHEiwoEEA586dO3fwIACA5wQOPAcAAAAABAkC AACA4Dl4AO0JHMjv3Llz5+LJO3dOWLtznCSce3akXj16+fTR03cPAACA5wQO JDhwHbx37+zBG9iOHj1+qAZyygfwiMCBBPMdyQcQgMCBBAsWBHhOoECAAAQO JFgQAMBzAgee/wMAAAAAggQBAABAsN07e/bs2bvHD9/AdfQSESS47ki9fPTy 6dN3DwAAggMBAABA8Nwwe+/s8Rq4ih8/gPQECsxXD+ARgQMF5qtXL58+gAAE DiRYsCDAcwIFAgQgcCDBggAAnhM4UCAAAAAIEgQAAABBb+/evbNn74q9UgO1 0aNHL9SqgaYO+TtSL1++fPz4XQFAcCBAAAIFAjwnUOC7d++CDSx1jx+/ePHi 6aNX78iRI/78yePESV6+fPn0AQAAYKBAAAAGngMIQOBAgOcEDjwHEIDAgQQH AjwncOBAAAAIEjwHAAAAgrLe/Xv37p29K6sGluJHjx4ngoL8HTlyJP8fvXv2 3gEAQFAgQAACBwI4d+6ct3f/3qk7d+6cM373+p07dw4bvXz1juwTBPCcQIHa QvHTBwAAgIEDBw4EAADAwIEDAQIQOJDgQIDnBA4cCAAAQYIAAAAAQDDVv3fv 3r27Yq/dQE73+IESqI2TQFX19tXLdwWABgAAABA8BxCAwIEEB74DeE6gQHjz 5q0aWIpevnzK2g0cKBAfAAAABg4cOFAgAAADBw4ECEDgQIIDAZ4TOHAgAIIE zwEAAICgQAD//r379+4KQXjz5jkTqK+etnOr9OnTBxCAwIEAzwkcCBCAwIEE CZ47d+5cu3f27Kk7d+6cs3v89KU7d+5cO1T/7c6dW3duIMBzAgcSJAigYEGA AAQOJDjw3Llz5wCcO3fuHACA5wQOHAgAAACC5wACEDgQAMBzAgUCAADgnTtn 8fSF8gMQgMCBBAGeEygQIACBAwkWBHhOoEAAAN4NFAgAgLiBq+Ldu7Ju4DkA AAYOPAcAwECBAAAAGCgQIACBAwkWBHDu3LlzAACeEziQIEEAAAAUBAhA4EAA AM8JFAgQgMCBBAsWBHhOoECAAAQOJFgQ4DmBAgEAGCgQAICBAwEAADBQIAAA AwcCAABgoEAAAAAMFAgQgMCBBAsCPCdQIICBAwcOFAgAAICBAgECEDgQAMBz AgUCBCBwIMGCBQGe/xMoECAAgQMJFgR4TqBAAAAGCgQAYKBAgAAECjx37tw5 gQDPCRQIAAAAAAMFAgAAYKBAgAAEDiRYEOA5gQIBDBwoEMBAgQAAABgoECAA gQMBADwnUCBAAAIHEixYEOA5gQIBAhA4kCBBgOcEDgQAYKBAAAAGDhw4UCCA gQMBAAAAYKBAAAAADBQIEIDAgQQLAjwnUCCAgQMFAhh4DgAAAAMHAgQgcCDA cwIHAgQgcCDBggUBnhMoECAAgQMBADwnUCAAAAMFAgAAYKBAAAAGDhw4UCCA gQIBAAAAYKBAAAAADBQIEIDAgQQLAjh37tw5gQDPCRx4DgAAggAAACB4Dv8g AIEDAQA8J1AgQAACBxIsaBDgOYECAQIQOBAAwHMCBQIAMFAgAAAABgoEAGDg wIEDBQIYKBAAAAAABgoEAADAQIEAAQgcSLAgwHMCBQIAMHDgOQADBQIAAGDg QIAABAoEeE7gQIAABA4kWNAgwHMCBwIEIFAgwHMCBwIAMFAgAAADBQIAAGCg QAAAAAAQCAAAAAADBQIAAADAQIEAAAAYKBAgAIEDCRYEeE6gQAAABg48B2Cg QAAAAAAYOPAcgIEDzwEEIHAgwYIGBQI8J3DgOQAEBwIAAIDgOQAACJ4DAAAA QYEAABA8BwAAwXMAAAAAQPAcAAAACJ4DCEDgQIL/BQGeEygQAICBAwEAGCgQ AAAAAAYOHDhwIEAAAgcSLGhQIMBzAgcSLAgAQEEAAAAUBAAAQMGCAwEUBAhA oMBz586dGwgA4DmBA88BBCBwIMGBAM8JFAgAwMCBAAAMPAcQgMCBAM8JHEhw IEAAAgcSLGiQIMBzAgcSHAgAAICCAAAAKAgAAAAABQueAwCgIAAAAAAUBAAA AICCAgECEDiQ4MBz586dGwjwnECBAAAAGHgOIACBAwEAPCdwIMFzAAEIHEiw oEGDAM8JHEgQIACBAgGeEygQAAAAAwUCBCBQIMBzAgcOBAAAAMFzAAAAAEDw HAAAAAAQHAgQgMCBBAeelTt37txAgOcECgQAAMDAcwABCBwoEOA5gQMFAgQg cCDBggYPDgR4TuBAgAAEDgQA8JxAgQAAABh4DiAAgQMFAjwnUCBAAAIFAjwn UCAAAAAADBQIEIBAgQDPCRwIEIDAgQQLGjyIMKHChQwbOnwIMaLEiRQrWryI MaPGjRw7evwIMqTIkSRLmjyJMqXKlSxbunwJ82BAADs= };# image create potatologo pack [frame .f.f -background grey20 -cursor watch] -expand 1 -fill both \ -ipady 5p -anchor center -side top set font [font actual {Helvetica 13 italic} -displayof .] label .f.f.i -relief raised -image [imageFor potatologo] \ -background grey20 -borderwidth 0 -cursor watch pack .f.f.i -side top -anchor center -expand 1 -fill both label .f.f.t -font $font -borderwidth 0 -text "Preparing to launch. . ." \ -foreground white -background grey20 -cursor watch pack .f.f.t -side bottom -expand 1 -fill both -pady 2 wm overrideredirect . 1 update idletasks center . wm deiconify . update idletasks update after 750 .f.f.t configure -text "Setting global variables. . ." update setVars .f.f.t configure -text "Loading preferences. . ." update loadPrefs .f.f.t configure -text "Initializing TCL Packages. . ." require msgcat_init .f.f.t configure -text "Setting Locale-Specific options. . ." update setLocale loadDic .f.f.t configure -text "Loading image information. . ." update loadImages .f.f.t configure -text "Setting Platform-Dependant options. . ." update setIcon_init setCursor_init toplevel_init $tcl_platform(platform) flashBar_init $tcl_platform(platform) .f.f.t configure -text "Loading font information. . ." update fonts_init .f.f.t configure -text "Customizing text bindings. . ." update bindText .f.f.t configure -text "Executing source script. . ." update sourceFile .f.f.t configure -text "Loading World information. . ." update setupWorldList .f.f.t configure -text "Creating window. . ." update after 550 pack forget .f destroy .f return; };# splash proc loadPrefs {} { # This loads the preference files at start-up. # Load initial prefs setPrefs 0 # Write the pref-file, if it's not there/valid if { [checkPrefFile] == "0" } { savePrefs } # Read the pref-file, if it's there/valid if { [checkPrefFile] != "0" } { setPrefs 1 } };# loadPrefs proc msgcat_init {} { namespace import ::msgcat::mc proc ::msgcat::mcunknown {l str {arg ""} {arg2 ""} {arg3 ""}} { global ::language if { [info exists ::language($str)] } { return [format $::language($str) "$arg" "$arg2" "$arg3"]; } else { return $str; } };# ::msgcat::mcunknown };# msgcat_init proc setLocale {} { global p locale misc language i18n set app $p(nick) set str "Below is a list of the available languages" set str "$str for $app on this computer. More can be" set str "$str downloaded from the same place you got" set str "$str $app. Note that changes will not take" set str "$str effect until you next open the program." set i18n(en_us,1) $str set i18n(en_us,2) "Currently Using:" set i18n(en_us,3) "Next Use:" supplyLocale en_us "English (United States)" array set language { word,start "Start" word,default "Default" word,end "End" word,ver "Version" word,updated "Updated %s" word,package "Package" word,ok "OK" word,apply "Apply" word,cancel "Cancel" word,close "Close" word,restore "Restore" word,file "File" word,files "Files" word,browse "Browse" word,about "About" word,translate "Translate" word,find "Find" word,direction "Direction" word,forwards "Forwards" word,backwards "Backwards" word,options "Options" word,toggle "Toggle" word,quick "Quick" word,connected "Connected" word,connect "Connect" word,to "To" word,subject "Subject" word,send "Send" word,exit "Exit" word,worlds "Worlds" word,host "Host" word,port "Port" word,char "Character" word,pw "Password" word,edit "Edit" word,error "Error" word,cut "Cut" word,copy "Copy" word,paste "Paste" word,delete "Delete" word,source "Source" word,clear "Clear" word,logging "Logging" word,logfile "Logfile" word,browse "Browse" word,play "Play" word,font "Font" word,none "None" word,add "Add" error "An error has occurred." find,title "Find. . ." find,case "Case Sensitive?" find,next "Find Next" find,none "No Match" find,match "Match at Line %1\$s Char %2\$s" time,title "Enter Time Format" time,info "Enter the time format and press OK. Use '%X' for native time. See the TCL help for 'clock format' for more information." files,files "Files" files,all "All Files" files,text "Text Files" files,html "HTML Files" files,baddir "Invalid directory \"%s\"!" aboutX "About %s" packVer "%1\$s Ver %2\$s" notNeeded "Not Needed" notAvailable "Not Available" log,stop "Stop logging from %s?" log,stopped "Logging stopped." log,title "Log from %1\$s - %2\$s" log,opts "Select Logging Option:" log,opt1 "Dual Log (buffer and upcoming)" log,opt2 "Upcoming (partial) logging" log,opt3 "Log Buffer" log,opt4 "HTML Buffer Log" log,select "Select Log File..." log,unable "Unable to log to \"%s\"" log,to "Logging to \"%s\"" log,buffered "Buffer Logged to \"%s\"" log,html "HTML Log of buffer created at \"%s\"" log,header "Logfile from %1\$s at %2\$s" upl,title "Upload to: %s" upl,title2 "Uploading to: %s" upl,cancel "Cancel file upload to %s?" upl,aborted "Upload of \"%1\$s\" to %2\$s aborted" upl,delay "Time Delay:" upl,badfile "Unable to open \"%s\"" upl,going "Uploading \"%s\"..." upl,complete "Uploading of \"%s\" complete." console,title "TK Console" console,hide "Hide Console" console,clear "Clear Console" menu,Chc "Hide Console" menu,file "File" menu,Fct "Connect To" menu,Fqc "Quick Connect" menu,Fcw "Configure Worlds" menu,Fes "Edit Settings" menu,Fdc "Disconnect" menu,Frc "Reconnect" menu,Fcl "Close" menu,Fex "Exit" menu,edit "Edit" menu,Eur "Undo/Redo" menu,Esp "Say Prefix" menu,Epp "Pose Prefix" menu,Eep "Emit Prefix" menu,Ecp "Custom Prefix..." menu,Ehw "Input History Window" menu,Efd "Find..." menu,Uut "Undo Top Editing Box" menu,Uub "Undo Bottom Editing Box" menu,Urt "Redo Top Editing Box" menu,Urb "Redo Bottom Editing Box" menu,view "View" menu,Vsb "Statusbar" menu,Vvs "Vertical Scrollbar" menu,Vhs "Horizontal Scrollbar" menu,Vis "Input Scrollbars" menu,Vhy "History Window" menu,Vwt "Show Connected Worlds Toolbar?" menu,Vtc "Toggle Console" menu,logging "Logging" menu,Llo "Log Output" menu,Lup "Upload File" menu,tools "Tools" menu,Tcm "Compose Mail" menu,Tte "Basic Text Editor" menu,Tle "Log Editor" menu,options "Options" menu,Ogs "Change Global Settings" menu,Osm "Start Maximized?" menu,Ost "Minimize to System Tray?" menu,Oft "Flash Taskbar on Activity?" menu,Ona "New Activity Separator?" menu,Osw "Show 'World () Active'?" menu,Oce "Confirm Exit?" menu,Onm "Numberpad as Map?" menu,Otb "Allow Top-Box Editing?" menu,help "Help" menu,Hab "About..." menu,Hpi "Package Info" balloon,conn "Click to connect to another MU*" balloon,quick "Quick-Connect" balloon,close "Disconnect from MU* and close window" balloon,recon "Reconnect to this MU*" balloon,disco "Disconnect from MU*" balloon,back "See Previous World" balloon,next "See Next World" balloon,popup "Go to World (...)" balloon,mail "Compose Game Mail" balloon,txted "Basic Text Editor" balloon,world "Configure Worlds" balloon,edit "Edit Settings" balloon,i18n "Set Language (i18n)" balloon,find "Search Output Box" balloon,about "About %s" balloon,log "Log Output" balloon,upload "Upload File to MU*" status,2 "Double-click to copy..." status,3 "Time connected to MU*" status,4 "Double-click to edit..." status,noton "Not Connected" status,confor "Connected For: %1\$sh %2\$sm" texted,title "Text Editor for %s" texted,top "Send to Top Input Box" texted,bottom "Send to Bottom Input Box" texted,clear "Clear Text" texted,aot "Always on top?" texted,conR "Convert Carriage Returns to %r" texted,conB "Convert Spaces to %b" texted,direct "Send straight to MUSH" texted,hl "Syntax Highlighting" texted,penn "PennMUSH Softcode" texted,spell "Enable Spell-Checker?" texted,esc "Escape MUSHcode..." texted,escall "Escape All" texted,escsel "Escape Selection" disco,check "Confirm disconnect from %s?" disco,disco "Disconnected from host." recon,auto "Auto-Reconnect in %s seconds. . ." recon,try "Attemping to reconnect. . ." world,active "World %s Active!" world,newact "New Activity" mail,title "Send Mail To %s" mail,style "Command Style:" mail,returns "Convert Carriage Returns?" mail,cleart "Mail: Clear Message" mail,clearb "Are you sure you want to erase your message?" close,check "Disconnect from %s and close the window?" exit,active "There are still active connections!" exit,confirm "Are you sure you want to quit?" frame,error "Error: All Windows appear to have been unpacked" rclick,copy "Copy Selected Text" rclick,edit "Edit Settings" rclick,hist "History Window" conn,limit "Unable to connect: Connection Limit Reached" conn,errtitle "%s: Connection Error" conn,invalid "Host and/or Port Invalid." conn,invalid2 "Go to World Configuration?" conn,ingto "Connecting to %s. . ." prefix,title "Custom Prefix" prefix,enter "Enter Prefix" prefix,space "Space?" prefix,w1 "Top Window" prefix,w2 "Bottom Window" loged,setin "Select Log File..." loged,setout "Select Output File..." loged,name "Log Edit" loged,unable "Unable to open file \"%s\"" loged,unable2 "Unable to write to \"%s\"!" loged,inout "You must select a different file for output." loged,good "Log successfully edited to \"%s\"" loged,bad "Error editing log to \"%s\"!" about,credits "%1\$s, written by Mike Griffiths (%2\$s) with code/ideas/help from Keith Vetter (Brinli@ElendorMUSH). Bug Fixes and Suggestions from Evelyn K. Vides (Bratto@ElendorMUSH) and Karen Reynolds :)\nSome icons are from the ICONS package (http://mini.net/tcl/5185).\n\nSpell-Checking code by Richard Suchenwirth (http://mini.net/tcl/882)\nWinflash code by Youness El Alaoui (KaKaRoTo - kakaroto@users.sourceforge.net)\n\n%1\$s is a MU* Client written in TCL.\n" about,out "Written by Mike Griffiths (Talvo@ElendorMUSH)" zero,none1 "There are no worlds defined. To add a world, select 'Configure Worlds' in the File menu, or click " zero,none2 "here" zero,none3 ", or use the " zero,none4 "Quick Connect" zero,none5 " feature to connect a world quickly." zero,defined "Defined Worlds (click to connect):" zero,alt1 "Alternativly, you can use the " zero,alt2 "Quick Connect" zero,alt3 " feature to connect to a MU* quickly." conf,w,title "Configure Worlds" conf,w,add "Add World" conf,w,delete "Delete World" conf,w,suredel "Are you sure you want to delete %s?" conf,titleW "Configuration Settings for %s" conf,titleG "Global Configuration Settings for %s" conf,tab,gcolor "View" conf,tab,color "Colors" conf,tab,salias "Slash-Aliases" conf,tab,site "Site Info" conf,tab,gag "Gags/Hilites/Triggers" conf,tab,text "Text/Display" conf,tab,auto "Auto-Send" conf,tab,f "F-Keys" conf,auto,ponc "Play On Connect: " conf,auto,pond "Play On Disconnect: " conf,auto,pona "Play On Activity: " conf,auto,sbl "Send Before Login " conf,auto,sal "Send After Login " conf,font,change "Change Font. . ." conf,font,def "Use Global Default" conf,font,wrapat "Wrap At:" conf,font,indent "Indent:" conf,font,echo "Echo Sent Commands?" conf,font,empty "Ignore Empty Lines?" conf,font,say "Say Prefix: " conf,font,pose "Pose Prefix: " conf,font,emit "Emit Prefix: " conf,font,close "You must close the Font Selection window first." conf,font,nonfix "You have selected a non-fixed width font (not recommended).\nDo you wish to keep your selection?" conf,title,woconf "World Config" conf,title,glconf "Global Config" conf,gag,unsaved "You have unsaved changes on the Gags page." conf,gag,up "Move Up" conf,gag,down "Move Down" conf,gag,add "Add New" conf,gag,edit "Edit Selected" conf,gag,del "Delete Selected" conf,gag,match "Match:" conf,gag,case "Case-Sensitive Match?" conf,gag,active "Only when Inactive?" conf,gag,disp "Gag from display?" conf,gag,omit "Omit from logs?" conf,gag,play "Play Sound:" conf,gag,selsound "Select Sound File" conf,gag,send2mu "Send To MU: " conf,gag,save "Save Changes" conf,gag,scrap "Discard Changes" conf,gag,do1st "You must save or discard your current gag changes before you can do this." conf,gag,conf "Gag Configure" conf,site,host "Host Address:" conf,site,port "Port Number:" conf,site,char "Character Name:" conf,site,pw "Password:" conf,site,desc "Site Description:" conf,site,type "MU* Type" conf,salias,bad "The Alias must contain only letters and numbers, and neither alias nor command can be empty." anw,title "Add New World" anw,entername "Enter a name for this world:" anw,exists "That world already exists." slash,which "Which slash command do you want? Use //command to send slash-commands to the game" slash,unknown "Unknown command %s: use //command to send slash-commands to the game" slash,connact "Connection is still active. Use \"/connect \" to connect to a new world." slash,connbad "No such world \"%s\". Use \"/quick ?<1/0>?\" to connect quickly to a new world" slash,togglebad "There is no connection \"%s\". Use \"/toggle\" to toggle to the next connection, or \"/toggle \" to toggle to connection " slash,list "Defined Slash Commands" slash,alias "Slash Command Aliases" slash,hist "Use '/history' to display a list of commands, or '/history \[end-\]number to use command \[end-\]number" slash,histout "Out of range. Must be between 0 and %s" slash,logprev "Include Previous Output Buffer?" hist,info "Click the command and press 1, 2 or 3, to place it into the top or bottom entry boxes, or send it directly to the MU*, respectively. Escape will close this window. Double-clicking an entry, or pressing =, has the same effect as '1'. Right-clicking (or pressing 4) copies to the clipboard." hist,title "%1\$s. %2\$s Input History" quick,title "Quick Connect" quick,info "\nEnter the information about the MU* you want to connect to. 'MU* Name' is the name of the MU*, and is optional. Host and Port are the MU*'s address, and Login and Password, both optional, are your character's details.\n" quick,name "MU* Name" packs,title "Package Info" packs,info "%s makes use of the following packages, where available. Shown below are the version numbers of all packages in use." packs,os "Running on %s" };# array set ::msgcat::mcmset en_us [array get language] set load 0 if { [glob -nocomplain -directory $p(locale) *.msg] != "" } { foreach x [glob -directory $p(locale) *.msg] { source $x } };# if glob set files [lsort -dictionary [array names locale]] set locale(list1) $files foreach x $files { lappend locale(list2) $locale($x) } set curr [::msgcat::mclocale] foreach x "$misc(locale) $curr en_us" { ::msgcat::mclocale $x foreach y [::msgcat::mcpreferences] { lappend list $y } };# foreach x foreach x $list { if { [info exists locale($x)] } { set p(lang) $x break; } };# foreach x if { $misc(locale) == "" } { set misc(locale) $p(lang) } set load 1 ::msgcat::mclocale $p(lang) ::msgcat::mcload $p(locale) return; # When choosing a language here, we: # 1) take the locale from the pref file, and use that if possible # 2) try the less specific form of the locale, if there is one # 3) try to use the default system locale, if available # 4) try to use the less specific forms of the system locale # 5) default to US English };# setLocale proc supplyLocale {l {e ""}} { global locale # This is called to add a new Locale from the msgcat files. if { $e == "" } { set e $l } set locale($l) $e };# supplyLocale proc i18n {} { global p locale misc i18n # This is where you can set the language. set w .i18n if { [winfo exists $w] } { wm deiconify $w raise $w focus $w return; } toplevel $w wm withdraw $w wm title $w "Language Settings (i18n)" wm minsize $w 300 300 wm maxsize $w 325 325 foreach x {1 2 3} { set text$x $i18n(en_us,$x) } frame $w.l label $w.l.l -wraplength 200p -text $text1 pack $w.l -side top -padx 4 -ipadx 4 -pady 3 pack $w.l.l -side left -anchor nw labelframe $w.curr -labelanchor nw -text $text2 label $w.curr.l -text "$locale($p(lang))" -anchor w pack $w.curr -side top -fill x -pady 3 -padx 2 -ipadx 2 -anchor w pack $w.curr.l -side left -fill both -anchor nw labelframe $w.next -labelanchor nw -text $text3 listbox $w.next.lb -selectmode single -listvariable locale(list2) \ -exportselection 0 -height 11 -width 99 \ -yscrollcommand "$w.next.sb set" scrollbar $w.next.sb -command [list $w.next.lb yview] pack $w.next -pady 3 -padx 2 -ipadx 2 -anchor w -fill x -expand 1 pack propagate $w.next 0 pack $w.next.sb -side right -fill y pack $w.next.lb -fill both -side left -fill x $w.next configure -height [winfo reqheight $w.next.lb] set up [lsearch $locale(list1) $misc(locale)] $w.next.lb selection clear 0 end $w.next.lb selection set $up $w.next.lb activate $up set bind {set misc(locale) [lindex $locale(list1) [%W curselection]]} bind $w.next.lb <> $bind set bind {i18nInfo [lindex $locale(list1) [%W index @%x,%y]] [winfo toplevel %W]} bind $w.next.lb $bind frame $w.btm pack $w.btm -side left -fill x -pady 4 -expand 1 button $w.btm.close -text [mc word,close] -width 9 -default active \ -command [list destroy $w] pack $w.btm.close bind $w [list $w.btm.close invoke] i18nInfo $p(lang) $w update center $w wm deiconify $w raise $w focus $w update };# i18n proc i18nInfo {l w} { global i18n if { ![winfo exists $w] } { return; } foreach {x y} {l.l 1 curr 2 next 3} { if { [info exists i18n($l,$y)] } { $w.$x configure -text $i18n($l,$y) } };# foreach };# i18nInfo proc loadDic {} { global p dict # load the dictionary for the Spell Checker array set dict {} set file [file join $p(locale) $p(lang).dic] if { [file exists $file] && [file readable $file] } { set fid [open $file r] while {![eof $fid]} { gets $fid line if { [llength $line] == "1" } { set dict($line) "" } else { set dict([lindex $line 0]) [lindex $line 1] } } close $fid set p(hasDic) "1" } else { set p(hasDic) "0" } };# loadDic # string:wordindexes text:spell string:words words:count # all by Richard Suchenwirth, and taken from http://mini.net/tcl/882 proc words:count { s } { foreach i [string tolower [string:words $s]] { if { [string length $i]>1 } { if { [info exists a($i)] } { incr a($i) } else { set a($i) 1 } } };# foreach set t {} foreach {i n} [array get a] {lappend t [list $i $n]} return [lsort -integer -decreasing -index 1 $t]; };# words:count proc string:words { s } { set res {} foreach line [split $s \n] { for {set i 0} {$i<[string length $line]} {incr i} { if { $i eq [string wordstart $line $i] } { set w [string range $line $i [expr {[string wordend $line $i]-1}]] if { $w ne " " } {lappend res $w} incr i [expr {[string length $w]-1}];# always loop incr } };# for };# foreach return $res; };# string:words proc spell:ok { word } { global dict misc if { [regexp {^[^0-9a-zA-Z]+$} $word] } { return 1; } if { [regexp {^.$} $word] } { return 1; } if { $misc(dictnum) && [regexp {[0-9]} $word] } { return 1; } if { [regexp {^[0-9\.-]+$} $word] } { return 1; } set wordL [string tolower $word] if { ![info exists dict($wordL)] } { return 0; } if { $dict($wordL) != "" && [string totitle $wordL 0 $dict($wordL)] != $word } { return 0; } return 1; };# spell:ok proc text:spell {w {tag {dict}}} { set lineno 1 $w tag remove $tag 1.0 end foreach line [split [$w get 1.0 end-1c] \n] { foreach {from to} [string:wordindexes $line] { set word [string range $line $from [expr $to-1]] if { ![spell:ok $word] } { $w tag add $tag $lineno.$from $lineno.$to update idletasks } } incr lineno } };# text:spell proc string:wordindexes { s } { set i 0 set res {} foreach c [split $s ""] { if { $c ne " " && $i eq [tcl_wordBreakBefore $s $i] } { lappend res $i [tcl_wordBreakAfter $s $i] } incr i } return $res; };# string:wordindexes proc toggleWorldToolbar {} { global pane if { $pane(worldtb) } { pack $pane(worldtoolbar) -expand 0 -fill x \ -padx 4 -pady 6 -after $pane(bar) } else { pack forget $pane(worldtoolbar) } };# toggleWorldToolbar proc addWorldToolbar {} { global conn pane set tb $pane(worldtoolbar) foreach x $conn(on) { set list($x) $tb.$x if { [winfo exists $list($x)] } { pack forget $list($x) continue } button $list($x) -text "$x. [connInfo $x info,name]" \ -command [list showFrame $x] -anchor w \ -relief flat -overrelief raised colorWorldToolbar $x } foreach x [lsort -integer [array names list]] { pack $list($x) -padx 4 -anchor w -side left } };# addWorldToolbar proc colorWorldToolbar {c} { global pane conn if { $c == "0" } { return; } set w $pane(worldtoolbar).$c set def [lindex [$w configure -background] end-1] array set colors " up-old #beb8ffffce97 up #ce97d53fee97 active #ffffbbe77ve7 dead #ffff99999999 inactive $def " if { ![winfo exists $w] } { return; } if { $conn(up) == $c } { set color up } elseif { [dead $c] } { set color dead } elseif { $conn($c,idle) != "0" } { set color active } else { set color inactive } $w configure -background $colors($color) \ -activebackground $colors($color) };# colorWorldToolbar proc sourceFile {} { # NEW! 8/19/2003 -- if it exists, source in the file # ./source.tcl. That means the user, if a TCL coder, can place # the file there to (for example) change widget bindings, set up # default [options] and so on, before anything is created. set file [file join . source.tcl] if { [file exists $file] && [file readable $file] } { source $file } };# sourceFile proc checkPrefFile {} { global p # Check the pref-file is ok. If not, find the backup if {![file exists $p(preffile)] || ![file readable $p(preffile)] \ || ![file isfile $p(preffile)] } { # Pref-file is corrupt. Try and use a backup... catch {file delete -force $p(preffile)} if {[file exists $p(preffile2)] && [file isfile $p(preffile2)] \ && [file readable $p(preffile2)] } { # Good backup found. Using it. catch {file copy -force $p(preffile2) $p(preffile)} catch {file attributes $p(preffile) -hidden 0} return 2; } else { # No backup available. Break. return 0; };# if preffile2 };# if preffile # If we get here, it already existed and was ok. Return 1 return 1; };# checkPrefFile proc savePrefs {} { # save the prefs into a file. global p top bottom1 bottom2 side if { $p(saving) != "0" } { # we're already saving. An error must've occured; # we shouldn't be saving twice in a row, so the last # save must've gone wrong. Abort. error "an unknown error has occured while saving" return; } set p(saving) 1 # Backup the current prefs file catch {file delete -force $p(preffile2)} catch {file copy -force "$p(preffile)" "$p(preffile2)"} catch {file attributes $p(preffile2) -hidden 1} foreach x $p(options2) { global $x } if { [winfo exists .p] } { # Refresh the Pane sizes before we save. . . # pane(X) where X is topp, bottom1p, bottom2p or sidep set pane(topp) [lindex [.p fraction] 0] set pane(bottom1p) [lindex [.p fraction] 1] set pane(bottom2p) [lindex [.p fraction] 2] } if { [wm state .] == "zoomed" } { set pane(state) zoomed } else { set pane(state) normal set pane(geom) [wm geometry .] } # Clear the current preffile catch {file delete -force $p(preffile)} # Create it a-new set fid [open $p(preffile) w+] # This isn't ::msgcat'ed. set comment "# This is the preference file for $p(name).\n" set comment "$comment# Editing this file is not recommended; edit the\n" set comment "$comment# preferences from inside $p(nick), which will update\n" set comment "$comment# this file automatically.\n" set comment "$comment# Created at time ID [clock seconds] by version $p(version)\n" puts $fid $comment # Explaination of $p(options) and $p(options2): # For each of the members of $p(options), we log into the Prefs file, # where they exist, top(), bottom1(), bottom2() # and side() # For each of $p(options2), if one exists, we log only the members of # $(logtheseonly), otherwise we use # everything in the array. And it's $(), too. foreach x "$p(options)" { puts $fid "\[[string totitle $x]\]" foreach i {top bottom1 bottom2 side} { if {[info exists $i\($x)]} { puts $fid "${i}=[set $i\($x)]" };# if info exists }; # foreach i puts -nonewline $fid "\n" };# foreach x $p(options) foreach x "$p(options2)" { puts $fid "\[[string totitle $x]\]" if { [info exists $x\(logtheseonly)] } { set log [lsort -dictionary -unique [set $x\(logtheseonly)]] } else { set log [lsort -dictionary [array names $x]] };# if info exists logtheseonly foreach i "$log" { puts $fid "${i}=[set $x\($i)]" };# foreach i puts -nonewline $fid \n };# foreach x $p(options2) # Finish off by closing the prefs file close $fid set p(saving) "0" # And then check it worked, to be nice. if { ![file exists $p(preffile)] || ![file readable $p(preffile)] } { set errormsg "error while saving prefs: preffile" set errormsg "$errormsg \"$p(preffile)\" has written incorrectly" error $error };# if error check };# savePrefs proc setPrefs {{file 1}} { # $file is whether to read from the .ini file as well # as set defaults. global p top bottom1 bottom2 side globals # explained in savePrefs set p(options) "font bg fg" set p(options2) "ansi text pane mail misc fkey logedit slashalias" foreach x $p(options) { global $x } foreach x $p(options2) { global $x } # What the ansi codes mean. Non-color set ansi(5) flash set ansi(1) hilite set ansi(0) normal set ansi(7) inverse set ansi(4) underline # Ansi FG color codes set ansi(30) black set ansi(31) red set ansi(32) green set ansi(33) yellow set ansi(34) blue set ansi(35) magenta set ansi(36) cyan set ansi(37) white # Ansi BG color codes set ansi(40) black set ansi(41) red set ansi(42) green set ansi(43) yellow set ansi(44) blue set ansi(45) magenta set ansi(46) cyan set ansi(47) white # Mail formats set globals(mail,1,name) "+Mail" set globals(mail,1,style) "+mail %0=%1 ;; -%2 ;; --" set globals(mail,2,name) "MUSH @mail" set globals(mail,2,style) "@mail %0=%1/%2" set globals(mail,3,name) "MUX @mail" set globals(mail,3,style) "@mail %0=%1 ;; -%2 ;; --" set globals(mail,4,name) "MUSE +mail" set globals(mail,4,style) "+mail %0=%2" set globals(pane,linewrap) 78 set globals(pane,indent) 2 set globals(pane,worldtb) 1 set globals(pane,minw) 450 set globals(pane,minh) 450 set globals(pane,topp) 73 set globals(pane,geom) "$globals(pane,minw)x$globals(pane,minh)+5+5" set globals(pane,bottom1p) 13 set globals(pane,bottom2p) 14 set globals(pane,sidep) 8 set globals(pane,yscroll) 1 set globals(pane,xscroll) 0 set globals(pane,showStatus) 1 set globals(pane,state) normal set globals(pane,iscroll) 1 set globals(text,emit) @emit set globals(text,say) say set globals(text,pose) pose set globals(text,ooc) +os set globals(top,font) "Courier 10" set globals(bottom1,font) "Courier 10" set globals(bottom2,font) "Courier 10" set globals(top,bg) #639500000000 set globals(bottom1,bg) black set globals(bottom2,bg) black set globals(side,bg) black set globals(bottom1,fg) white set globals(bottom2,fg) white set globals(side,fg) white set globals(top,echo) 0 set globals(top,empty) 0 set globals(ansi,black) black set globals(ansi,red) #b53f00000000 set globals(ansi,green) #0043828f0000 set globals(ansi,yellow) #deb7c9c80000 set globals(ansi,blue) navy set globals(ansi,magenta) #9e6600009eb8 set globals(ansi,cyan) #00007810f168 set globals(ansi,white) #f168f168f168 set globals(ansi,normal) cyan set globals(ansi,black-h) #96c896c896c8 set globals(ansi,red-h) red set globals(ansi,green-h) green set globals(ansi,yellow-h) yellow set globals(ansi,blue-h) blue set globals(ansi,magenta-h) magenta set globals(ansi,cyan-h) #47efa560ffff set globals(ansi,white-h) white set globals(ansi,normal-h) white set globals(ansi,system) yellow set globals(ansi,echo) #0000ffff8800 set globals(ansi,use-ansi) 1 set globals(ansi,use-flash) 0 set globals(misc,newact) 1 set globals(misc,topedit) 0 set globals(misc,maximize) 1 set globals(misc,chkexit) 1 set globals(misc,actworld) 1 set globals(misc,dirPad) 0 set globals(misc,minTray) 0 set globals(misc,clockFormat) %X set globals(misc,flashTaskBar) 1 set globals(misc,autorecon) 45 set globals(misc,locale) "" set globals(misc,logover) "a" set globals(misc,hl) "0" set globals(misc,dictnum) "0" foreach x {2 3 4 5 6 7 8 9 10} { set globals(fkey,$x) "" } foreach x [array names globals] { set a [::Penn::before $x ,] set b [::Penn::after $x ,] lappend $a\(logtheseonly) $b set $a\($b\) $globals($x) } unset mail(logtheseonly) # Load user prefs if we should set pf $p(preffile) if {$file && [file exists $pf] && [file readable $pf]} { set fid [open $pf] fconfigure $fid -buffering line -blocking 0 -translation auto global var while {![eof $fid]} { gets $fid x if {$x == "" || [string match -nocase #* $x]} { continue; } if {[string match -nocase {\[*\]} $x]} { set var(a) [string tolower [string range $x 1 end-1]] if {[lsearch $p(options) $var(a)] == "-1" } { set var(1) 0 } else { set var(1) 1 } continue; } set var(z) [string first = $x] set var(x) [string range $x 0 [expr $var(z)-1]] set var(y) [string range $x [expr $var(z)+1] end] if { $var(1) == "0" } { if { $var(x) != "logtheseonly" } { set $var(a)($var(x)) $var(y) } } else { if { $var(a) != "logtheseonly" } { set $var(x)($var(a)) $var(y) } } };#while close $fid };#if $file catch {font create fontQ.0} catch {font create fontQ.C} eval "font configure fontQ.0 [font actual $top(font)]" eval "font configure fontQ.C [font actual $top(font)]" };# setPrefs proc doLogOff {c {force 0}} { global conn if { $conn($c,partial) == "0" } { return; } if { $force } { set ans "yes" } else { set ans [tk_messageBox -title [mc word,logging] -icon question \ -message [mc log,stop [connInfo $c info,name]] \ -type yesno] } if { $ans == "no" } { return; } set conn($c,partial) 0 close $conn($c,partialID) putOut $c [mc log,stopped] statusBar $c };# doLogOff proc doLogMenu {c} { set w .log$c if { [winfo exists $w] } { wm deiconify $w raise $w focus $w return; } toplevel $w wm withdraw $w wm title $w [mc log,title $c [connInfo $c info,name]] catch {wm attributes $w -toolwindow 1 -topmost 1} wm resizable $w 0 0 labelframe $w.l -text [mc log,opts] -labelanchor nw pack $w.l -side top -pady 2 -padx 2 -ipadx 2 -ipady 2 radiobutton $w.l.1 -text [mc log,opt1] \ -variable rBtn -value 1 radiobutton $w.l.2 -text [mc log,opt2] \ -variable rBtn -value 2 radiobutton $w.l.3 -text [mc log,opt3] \ -variable rBtn -value 3 radiobutton $w.l.4 -text [mc log,opt4] \ -variable rBtn -value 4 $w.l.1 select foreach x {1 2 3 4} { pack $w.l.$x -side top -anchor w -pady 1 -padx 1 } frame $w.b pack $w.b -side top -pady 3 button $w.b.ok -width 9 -text [mc word,ok] -underline 0 \ -command "after 10 \"destroy $w\" ; doLogOn \$rBtn $c" button $w.b.cancel -width 9 -text [mc word,cancel] -underline 0 \ -command [list destroy $w] pack $w.b.ok $w.b.cancel -side left -padx 5 bind $w [list $w.b.cancel invoke] bind $w [list $w.b.cancel invoke] bind $w [list $w.b.ok invoke] update center $w wm deiconify $w focus $w };# doLogMenu proc doLogOn {type c} { global conn p # Types: # 1: Log buffer and do partial log # 2: No buffer, just partial logging from here on # 3: Buffer log only # 4: HTML log if { $conn($c,partial) == "1" && ($type == "1" || $type == "2") } { doLogOff $c return; } if { $type == "4" } { set types { {{HTML} {.htm} } {{HTML} {.html} } {{Text} {.txt} } {{Text} {.log} } {{All} * } } set def .htm } else { set types { {{Text} {.txt} } {{Text} {.log} } {{All} * } } set def .txt } set types [string map " HTML \"[mc files,html]\" Text \"[mc files,text]\" All \"[mc files,all]\" " $types] set muname [connInfo $c info,name] set file [tk_getSaveFile -initialdir $p(logdirE) -defaultextension $def \ -filetypes $types -parent . \ -title [mc log,select] \ -initialfile "$muname [mc word,logfile]$def"] if { $file == "" } { return; } set p(logdirE) [file dirname $file] set nat [file nativename [file normalize $file]] if { [file exists $file] && (![file readable $file] || ![file writable $file]) } { tk_messageBox -title [mc word,logging] -icon error \ -message [mc log,unable $nat] return; } doLogSub$type $c $file $nat statusBar $c };# doLogOn proc doLogSub1 {c file nat} { global conn misc # Log Buffer and do Partial Log # Args: $c = connection number, $id = [open] id, # $file = Tcl file name, $nat = OS/platform file name if { [catch {open $file $misc(logover)} id] } { putOut $c "[mc log,unable $nat] - $id" return; } puts $id [mc log,header [connInfo $c info,name] [clock format [clock seconds]]] puts $id [$conn($c,top) get 1.0 end] flush $id set conn($c,partial) 1 set conn($c,partialID) $id putOut $c [mc log,to $nat] };# doLogSub1 proc doLogSub2 {c file nat} { global conn misc # Partial Log Only if { [catch {open $file $misc(logover)} id] } { putOut $c "[mc log,unable $nat] - $id" return; } puts $id [mc log,header [connInfo $c info,name] [clock format [clock seconds]]] putOut $c [mc log,to $nat] set conn($c,partial) 1 set conn($c,partialID) $id };# doLogSub2 proc doLogSub3 {c file nat} { global conn misc # Log Buffer Only if { [catch {open $file $misc(logover)} id] } { putOut $c "[mc log,unable $nat] - $id" return; } puts $id [mc log,header [connInfo $c info,name] [clock format [clock seconds]]] puts $id [$conn($c,top) get 1.0 end] flush $id close $id putOut $c [mc log,buffered $nat] };# doLogSub3 proc doLogSub4 {c file nat} { global conn # Log Buffer as HTML if { [catch {open $file w} id] } { putOut $c "[mc log,unable $nat] - $id" return; } set w $conn($c,top) set world [connInfo $c info,name] set host [connInfo $c info,host] set port [connInfo $c info,port] set bg [htmlColor [getRGB [getColor [$w cget -background]]]] set fg [htmlColor [getRGB [getColor [$w tag cget FG_NORMAL -foreground]]]] set header "\n\n\n$world Logfile" set header "$header\n\n\n" set header "$header\n" puts -nonewline $id $header set str "

HTML Log-File from " set str "$str" set str "$str$world ($host:$port)" if { [connInfo $c pane,wrap] != "0" } { set extra " width =\"[connInfo $c pane,wrap]\"" } else { set extra "" } set str "$str at [clock format [clock seconds]]

\n

" puts $id $str $w dump -text -tag -command [list doLogSub4-2 $id $w $c] 1.0 end puts $id "\n

\n\n\n" close $id putOut $c [mc log,html $nat] };# doLogSub4 proc doLogSub4-2 {f w c k v i} { # f = file id (from [open ]) # w = $conn(,top) # c = # k = 'dump' key # v = 'dump' value # i = 'dump' index if { $k == "text" } { set v [logWrap $v $c] puts -nonewline $f [string map { & & < < > > \" " \' ' \n \t } $v] } elseif { $k == "tagon" } { switch -glob $v { sysfont - FG_* {puts -nonewline $f ""} BG_* {puts -nonewline $f ""} TAG_FLASH {puts -nonewline $f ""} TAG_UNDERLINE {puts -nonewline $f ""} } } elseif { $k == "tagoff" } { switch -glob $v { FG_NORMAL {} BG_NORMAL {} sysfont - FG_* {puts -nonewline $f ""} BG_* {puts -nonewline $f ""} TAG_FLASH {puts -nonewline $f ""} TAG_UNDERLINE {puts -nonewline $f ""} } } };# doLogSub4-2 proc logWrap {str c} { global p set wrapat [connInfo $c pane,linewrap] set indent [connInfo $c pane,indent] if { $wrapat == "0" } { return $str; } return [wrap $str $wrapat $indent]; # return [textIndent [textWrap $str $wrapat] $indent 1]; };# logWrap proc wrap {text at indent} { set i 0 foreach line [split $text \n] { set ind [string repeat " " $indent] if { $i == "0" } { set out [lindex $line 0] } else { set out "$out\n[lindex $line 0]" } incr i set line [lrange $line 1 end] set len [string length $out] while { $line != "" } { set word [lindex $line 0] set wordlen [string length $word] if { ($len + $wordlen + 1) <= $at } { set out "$out $word" incr len $wordlen } else { set out "$out\n$ind$word" set len $wordlen } set line [lrange $line 1 end] };# while };# foreach return $out; };# wrap proc upload_file {w {y ""}} { global conn p set name [connInfo $w info,name] if {$conn($w,upload,on) == "1" && $conn($w,upload,delay) > 0} { set title "$p(nick): [mc upl,title "($w. $name)"]" set msg [mc upl,cancel $name] set ans [tk_messageBox -title $title -message $msg \ -type yesno -icon question] if {$ans == "no"} return; after cancel $conn($w,upload,afterid) set conn($w,upload,fid) "" set conn($w,upload,afterid) "" set conn($w,upload,on) "0" putOut $w [mc upl,aborted $conn($w,upload,nafile) $name] close $conn($w,upload,fid) destroy $y return; } set x .upload$w if {[winfo exists $x]} { wm deiconify $x raise $x focus $x return; } toplevel $x wm withdraw $x wm resizable $x 0 0 wm title $x [mc upl,title "($w. $name)"] frame $x.top pack $x.top -pady 5 -padx 5 label $x.top.l -text [mc upl,delay] spinbox $x.top.s -from 0 -to 60 -increment 1 -width 4 \ -textvariable conn($w,upload,delay) if {![info exists conn($w,upload,delay)]} {set conn($w,upload,delay) "0"} pack $x.top.l $x.top.s -in $x.top -side left -padx 3 set types " \{\{[mc files,text]\} \{.txt\} \} \{\{[mc files,text]\} \{.log\} \} \{\{[mc files,all]\} \{*\} \} " frame $x.file label $x.file.l -text "[mc word,file]: " entry $x.file.e -textvariable conn($w,upload,file) -width 40 button $x.file.b -text "[mc word,browse]..." -underline 0 \ -command "set newF \[tk_getOpenFile -initialdir \$p(logdir) \ -filetypes \"$types\" -parent $x] if \{\$newF != \"\"\} \{ set conn($w,upload,file) \[file nativename \$newF\] \} focus $x ";# -command bind $x [list $x.file.b invoke] pack $x.file -pady 5 -padx 5 pack $x.file.l $x.file.e $x.file.b -in $x.file -padx 3 -side left frame $x.bottom button $x.bottom.o -text [mc word,start] -underline 0 -default active \ -command [list upload_check $w $x] -width 8 button $x.bottom.c -text [mc word,cancel] -underline 0 \ -command [list destroy $x] -width 8 pack $x.bottom -pady 4 pack $x.bottom.o $x.bottom.c -in $x.bottom -padx 4 -side left bind $x [list $x.bottom.c invoke] bind $x [list $x.bottom.o invoke] bind $x [list $x.bottom.o invoke] bind $x [list $x.bottom.c invoke] update center $x wm deiconify $x focus $x.file.e; };# upload_file proc upload_check {w x} { global p conn set name [connInfo $w info,name] set conn($w,upload,nafile) [file nativename $conn($w,upload,file)] set f $conn($w,upload,file) set d $conn($w,upload,delay) if { ![file exists $f] || ![file readable $f] } { set msg [mc upl,badfile $conn($w,upload,nafile)] tk_messageBox -title $p(nick) -message $msg return; } set conn($w,upload,size) [file size $f] set conn($w,upload,perc) "0" set conn($w,upload,fid) [open $f r] catch {destroy $x} toplevel $x wm protocol $x WM_DELETE_WINDOW {return;} wm title $x "$p(nick): [mc upl,title2 "($w. $name)"]" frame $x.top pack $x.top -padx 4 -pady 4 label $x.top.l -text [mc upl,going $conn($w,upload,nafile)] pack $x.top.l frame $x.mid ::iwidgets::feedback $x.mid.fb -steps 100 pack $x.mid -expand 1 -fill x pack $x.mid.fb -in $x.mid -side left -expand 1 -fill x frame $x.bot button $x.bot.cancel -text [mc word,cancel] -width 9 -underline 0 \ -command [list upload_file $w $x] pack $x.bot pack $x.bot.cancel putOut $w [mc upl,going $conn($w,upload,nafile)] center $x upload_go "$w" "$x" };# upload_check proc upload_go {w x} { global conn set id $conn($w,upload,fid) if {[eof $id]} { # Most of this needs repeating at the "cancel" spot. set conn($w,upload,on) "0" close $id set conn($w,upload,fid) "" set conn($w,upload,afterid) "" bell -displayof $x destroy $x putOut $w [mc upl,complete $conn($w,upload,nafile)] return; } set conn($w,upload,on) "1" set size $conn($w,upload,size) gets $id text set at [tell $id] set at2 [::Penn::before [expr (${at}.0 / $size) * 100] .] send_to $w $text $x.mid.fb step [expr $at2 - $conn($w,upload,perc)] set conn($w,upload,perc) $at2 set conn($w,upload,afterid) [after $conn($w,upload,delay)000 "upload_go $w $x"] };# upload_go proc main {} { global p top bottom1 bottom2 ansi conn pane side size misc menu wm withdraw . catch {wm attributes . -topmost 0} wm overrideredirect . 0 wm resizable . 1 1 wm title . "$p(name) [mc word,ver] $p(version)" wm iconname . "$p(name) [mc word,ver] $p(version)" tk appname [string tolower $p(nick)$p(version)] set p(console) "0" catch {console title "$p(name) - [mc console,title]"} # Change some Console stuff. . . catch {console eval {.menubar.file entryconfigure "Source" \ -label [consoleinterp eval "mc word,source"]}} catch {console eval {.menubar.file entryconfigure "Clear Console" \ -label [consoleinterp eval "mc console,clear"]}} catch {console eval {wm protocol . WM_DELETE_WINDOW ".menubar.file invoke [.menubar.file index "Hide Console"]"}} catch {console eval {.menubar.file entryconfigure "Hide Console" \ -command {consoleinterp eval {.menu.v invoke $menu(view,tc)}} \ -label [consoleinterp eval "mc menu,Chc"]}} catch {console eval {.menubar.file delete "Exit"}} catch {console eval {.menubar delete "Help"}} catch {console eval {destroy .menubar.help}} catch {console eval {.menubar.edit entryconfigure "Cut" \ -label [consoleinterp eval "mc word,cut"]}} catch {console eval {.menubar.edit entryconfigure "Copy" \ -label [consoleinterp eval "mc word,copy"]}} catch {console eval {.menubar.edit entryconfigure "Paste" \ -label [consoleinterp eval "mc word,paste"]}} catch {console eval {.menubar.edit entryconfigure "Delete" \ -label [consoleinterp eval "mc word,delete"]}} console eval "proc center \{[info args center]\} \{ [info body center] \}" # And fix the annoying fact that 'cut' actually does 'copy' :P console eval {bind Console <> { if {![catch {set data [%W get sel.first sel.last]}]} { clipboard clear -displayof %W clipboard append -displayof %W $data %W delete sel.first sel.last } }} set m .menu menu $m -tearoff 0 . configure -menu $m menu $m.f -tearoff 0 set menu(file) 0 $m add cascade -label [mc menu,file] -menu $m.f -underline 0 menu $m.f.c -tearoff 0 # if 'connect to' is ever moved from being the top of the File menu, # 'updateWorldList' will need editing so it deactivates the correct # menu entry when there are no worlds defined. $m.f add cascade -label [mc menu,Fct] -underline 0 -menu $m.f.c $m.f add command -label [mc menu,Fqc] -underline 0 -command "quickConnect" $m.f add separator $m.f add command -label [mc menu,Fcw] -underline 10 \ -command addEditWorlds $m.f add command -label [mc menu,Fes] -underline 0 \ -command {config $conn($conn(up),num)} $m.f add separator $m.f add command -label [mc menu,Fdc] -underline 0 \ -command {.tb.1.disconnect invoke} $m.f add command -label [mc menu,Frc] -underline 0 \ -command {.tb.1.reconnect invoke} $m.f add command -label [mc menu,Fcl] -underline 1 \ -command {.tb.1.close invoke} $m.f add separator $m.f add command -label [mc menu,Fex] -command chk_exit \ -underline 1 -accelerator "Alt+F4" array set menu { file,ct 0 file,qc 1 file,cw 3 file,es 4 file,dc 6 file,rc 7 file,cl 8 file,ex 10 } menu $m.e -tearoff 0 set menu(edit) 1 $m add cascade -label [mc menu,edit] -menu $m.e -underline 0 menu $m.e.u -tearoff 0 $m.e add cascade -label [mc menu,Eur] -menu $m.e.u -underline 0 $m.e add separator $m.e add command -label [mc menu,Esp] \ -command {prefix $conn(up) 1 [connInfo $conn(up) text,say]} \ -underline 0 $m.e add command -label [mc menu,Epp] \ -command {prefix $conn(up) 1 [connInfo $conn(up) text,pose]} \ -underline 0 $m.e add command -label [mc menu,Eep] \ -command {prefix $conn(up) 1 [connInfo $conn(up) text,emit]} \ -underline 0 $m.e add command -label [mc menu,Ecp] \ -command {prefix:custom $conn(up)} -underline 0 $m.e add separator $m.e add command -label [mc menu,Ehw] \ -command {historyWindow $conn(up)} -underline 0 $m.e add separator $m.e add command -label [mc menu,Efd] -underline 0 -accelerator "Ctrl+F" \ -command {findIn $conn(up)} $m.e.u add command -label [mc menu,Uut] \ -command {event generate $conn($conn(up),bottom1) <>} $m.e.u add command -label [mc menu,Uub] \ -command {event generate $conn($conn(up),bottom2) <>} $m.e.u add separator $m.e.u add command -label [mc menu,Urt] \ -command {event generate $conn($conn(up),bottom1) <>} $m.e.u add command -label [mc menu,Urb] \ -command {event generate $conn($conn(up),bottom2) <>} array set menu { edit,ur 0 edit,sp 2 edit,pp 3 edit,ep 4 edit,cp 5 edit,hw 7 edit,fd 9 undo,ut 0 undo,ub 1 undo,rt 3 undo,rb 4 } menu $m.v -tearoff 0 set menu(view) 2 $m add cascade -label [mc menu,view] -menu $m.v -underline 0 $m.v add checkbutton -label [mc menu,Vsb] -variable pane(showStatus) \ -command {statusBar $conn(up)} -underline 0 $m.v add checkbutton -label [mc menu,Vvs] \ -variable pane(yscroll) -command {showFrame $conn(up)} \ -underline 0 $m.v add checkbutton -label [mc menu,Vhs] \ -variable pane(xscroll) -command {showFrame $conn(up)} \ -underline 0 $m.v add checkbutton -label [mc menu,Vis] \ -variable pane(iscroll) -command {iscroll $conn(up)} \ -underline 0 $m.v add separator $m.v add command -label [mc menu,Vhy] -command {historyWindow $conn(up)} \ -accelerator "Cntrl+H" -underline 0 $m.v add separator $m.v add checkbutton -label [mc menu,Vwt] -command {toggleWorldToolbar} \ -variable pane(worldtb) -underline 0 $m.v add separator $m.v add checkbutton -label [mc menu,Vtc] -variable p(console) \ -underline 0 \ -command {if { $p(console) == "1" } { console show console eval {center .} } else { console hide } };# toggle console checkbutton -command array set menu { view,sb 0 view,vs 1 view,hs 2 view,is 3 view,hy 5 view,wt 7 view,tc 9 } if { $p(platform) == "unix" } { $m.v entryconfigure $menu(view,tc) -state disabled } menu $m.l -tearoff 0 set menu(logging) 3 $m add cascade -label [mc menu,logging] -menu $m.l -underline 0 $m.l add command -label [mc menu,Llo] -command {doLogMenu $conn(up)} $m.l add separator $m.l add command -label [mc menu,Lup] -command {upload_file $conn(up)} array set menu { logging,lo 1 logging,up 2 } menu $m.t -tearoff 0 set menu(tools) 4 $m add cascade -label [mc menu,tools] -menu $m.t -underline 0 $m.t add command -label [mc menu,Tcm] -underline 8 \ -command ".tb.3.mail invoke" $m.t add command -label [mc menu,Tte] -underline 11 \ -command {textEditor $conn(up)} $m.t add separator $m.t add command -label [mc menu,Tle] -underline 0 \ -command {logEditor} -state disabled ;#here *** array set menu { tools,cm 0 tools,te 1 tools,le 3 } menu $m.c -tearoff 0 set menu(options) 5 $m add cascade -label [mc menu,options] -menu $m.c -underline 0 $m.c add command -label [mc menu,Ogs] -command {config -1} -underline 0;# 'c' $m.c add separator set inc 1 if { $p(hasWinico) == "1" } { $m.c add checkbutton -label [mc menu,Ost] \ -variable misc(minTray) -underline 13 ;# 'y' $m.c add separator set inc 3 } $m.c add checkbutton -label [mc menu,Oft] -underline 0 \ -variable misc(flashTaskBar) ;# 'f' $m.c add checkbutton -label [mc menu,Ona] -underline 0 \ -variable misc(newact) ;# 'n' $m.c add checkbutton -label [mc menu,Osw] -underline 0 \ -variable misc(actworld) ;# 's' $m.c add checkbutton -label [mc menu,Oce] -underline 8 \ -variable misc(chkexit) ;# 'e' $m.c add checkbutton -label [mc menu,Onm] -underline 6 \ -variable misc(dirPad) ;# 'p' $m.c add checkbutton -label [mc menu,Otb] -command {toggleBindings} \ -underline 0 -variable misc(topedit) ;# 'a' if { $inc } { set menu(options,st) 2 } array set menu " options,ft [expr 1+$inc] options,na [expr 2+$inc] options,se [expr 3+$inc] options,ce [expr 4+$inc] options,nm [expr 5+$inc] options,tb [expr 6+$inc] " menu $m.help -tearoff 0 set menu(help) 6 $m add cascade -label [mc menu,help] -menu $m.help -underline 0 $m.help add command -label [mc menu,Hab] -underline 0 \ -command "about" -compound left \ -hidemargin 1 -image [imageFor about] $m.help add separator $m.help add command -label [mc menu,Hpi] -underline 0 \ -command "aboutPacks" -compound left \ -hidemargin 1 -image [imageFor bulb] # A toolbar, with graphical pictures on. Whee. :P frame .tb pack .tb -in . -expand 0 -fill x -pady 3 set pane(bar) .tb set xx $pane(bar).0 frame $xx -relief flat -borderwidth 1 pack $xx -in $pane(bar) -padx 6 -side left button $xx.connect -image [imageFor connect] \ -relief flat -overrelief raised set atx "\[winfo rootx $xx.connect\]" set aty "\[expr \[winfo rooty $xx.connect\]+\[winfo height $xx.connect\]\]" $xx.connect configure -command "tk_popup $xx.connect.menu $atx $aty" pack $xx.connect -side left menu $xx.connect.menu -tearoff 0 balloon $xx.connect [mc balloon,conn] button $xx.quick -image [imageFor q] -command {quickConnect} \ -relief flat -overrelief raised pack $xx.quick -side left balloon $xx.quick [mc balloon,quick] set xx $pane(bar).1 frame $xx -relief flat -borderwidth 1 pack $xx -in $pane(bar) -padx 6 -side left button $xx.disconnect -image [imageFor disconnect] \ -command {disconnect $conn(up) 1} \ -relief flat -overrelief raised pack $xx.disconnect -side left;# -padx 2 button $xx.close -image [imageFor close] \ -command {closeWorld $conn(up)} \ -relief flat -overrelief raised pack $xx.close -side left;# -padx 2 set msg "Attemping to reconnect. . ." set ho {[connInfo $conn(up) info,host]} set po {[connInfo $conn(up) info,port]} set ch {[connInfo $conn(up) info,char]} set pw {[connInfo $conn(up) info,pw]} set up {$conn(up)} button $xx.reconnect -image [imageFor reconnect] \ -relief flat -overrelief raised \ -command "connect2mushSub \"$up\" \"$msg\" \"$ho\" \"$po\" \"$ch\" \"$pw\" 0" pack $xx.reconnect -side left balloon $xx.close [mc balloon,close] balloon $xx.disconnect [mc balloon,disco] balloon $xx.reconnect [mc balloon,recon] set xx $pane(bar).2 frame $xx -relief flat -borderwidth 1 pack $xx -padx 6 -side left button $xx.back -image [imageFor prev-world 0] -state disabled \ -command {toggleFrame XXXXX 0} \ -relief flat -overrelief raised pack $xx.back -side left balloon $xx.back [mc balloon,back] button $xx.popup -image [imageFor down-worlds 1] \ -relief flat -overrelief raised pack $xx.popup -side left balloon $xx.popup [mc balloon,popup] menu $xx.popup.m -tearoff 0 set atx "\[winfo rootx $xx.popup\]" set aty "\[expr \[winfo rooty $xx.popup\]+\[winfo height $xx.popup\]\]" $xx.popup configure -command "tk_popup $xx.popup.m $atx $aty" button $xx.next -image [imageFor next-world 0] -state disabled \ -command {toggleFrame} \ -relief flat -overrelief raised pack $xx.next -side left balloon $xx.next [mc balloon,next] set xx $pane(bar).3 frame $xx -relief flat -borderwidth 1 pack $xx -padx 6 -side left button $xx.mail -image [imageFor mail] \ -relief flat -overrelief raised \ -command {mail_start $conn(up)} pack $xx.mail -side left button $xx.texted -image [imageFor texted] \ -relief flat -overrelief raised \ -command {textEditor $conn(up)} pack $xx.texted -side left balloon $xx.mail [mc balloon,mail] balloon $xx.texted [mc balloon,txted] set xx $pane(bar).3b frame $xx -relief flat -borderwidth 1 pack $xx -padx 6 -side left button $xx.log -image [imageFor log] \ -relief flat -overrelief raised \ -command {doLogMenu $conn(up)} pack $xx.log -side left button $xx.up -image [imageFor upload] \ -relief flat -overrelief raised \ -command {upload_file $conn(up)} pack $xx.up -side left balloon $xx.log [mc balloon,log] balloon $xx.up [mc balloon,upload] set xx $pane(bar).4 frame $xx -relief flat -borderwidth 1 button $xx.worlds -image [imageFor world] \ -relief flat -overrelief raised \ -command {addEditWorlds} button $xx.settings -image [imageFor settings] \ -command {config $conn($conn(up),num)} \ -relief flat -overrelief raised button $xx.i18n -image [imageFor i18n] -command {i18n} \ -relief flat -overrelief raised pack $xx -padx 6 -side left pack $xx.worlds -side left pack $xx.settings -side left pack $xx.i18n -side left balloon $xx.worlds [mc balloon,world] balloon $xx.settings [mc balloon,edit] balloon $xx.i18n [mc balloon,i18n] set xx $pane(bar).5 frame $xx -relief flat -borderwidth 1 button $xx.find -image [imageFor find 1] \ -relief flat -overrelief raised \ -command {findIn $conn(up)} pack $xx -padx 6 -side left pack $xx.find -side left balloon $xx.find [mc balloon,find] set xx $pane(bar).6 frame $xx -relief flat -borderwidth 1 button $xx.about -image [imageFor about 1] -command about \ -relief flat -overrelief raised pack $xx -padx 6 -side left pack $xx.about -side left balloon $xx.about [mc balloon,about $p(nick)] foreach x {0 1 2 3 3b 4 5} { frame $pane(bar).f$x -background #999999999999 \ -relief sunken pack $pane(bar).f$x -side left -fill y -after $pane(bar).$x } # foreach x {0 1 2 3 4 5 6} { # bindtags $pane(bar).$x "ToolBarBind [bindtags $pane(bar).$x]" # } # set col [$pane(bar) cget -background] # bind ToolBarBind "%W configure -background $col -relief flat" # bind ToolBarBind "%W configure -background white -relief ridge" # toolbar ends. set pane(worldtoolbar) .tbW frame $pane(worldtoolbar) toggleWorldToolbar iwidgets::panedwindow .p -orient horizontal \ -showhandle 0 -sashcursor $p(cursor-varrow) pack .p -expand 1 -fill both .p add "top" -margin 0 set pane(top) [.p childsite "top"] set pane(top) [frame $pane(top).2] pack $pane(top) -expand 1 -fill both frame $pane(top).text bind $pane(top).text "scrollTextWin %X %Y %D" pack $pane(top).text -expand 1 -fill both -side left pack propagate $pane(top).text 0 .p add "bottom1" -margin 0 set pane(bottom1) [.p childsite "bottom1"] .p add "bottom2" -margin 0 set pane(bottom2) [.p childsite "bottom2"] .p fraction $pane(topp) $pane(bottom1p) $pane(bottom2p) frame .p.sideLine -background grey80 -width 2p -borderwidth 1 -relief groove frame .p.side -width 60p -background $side(bg) set pane(side) .p.side.lb listbox $pane(side) -listvar conn(waiting) -selectmode single \ -bg $side(bg) -fg $side(fg) -borderwidth 0 bind WaitingBox {waitingSel %W} bindtags .p.side.lb ".p.side.lb Listbox WaitingBox . all" pack .p.side.lb -expand 1 -fill both bind PanedWinLB {after 10 {raise .p.side ; raise .p.sideLine ; set amt [expr 1.0 - [lindex [place configure .p.pane0 -relheight] end]] place configure .p.sideLine -relheight $amt -height -1p place configure .p.side -relheight $amt -height -1p place configure .p.pane1 -width -60p place configure .p.pane2 -width -60p }} bind PanedWinLB <> {after 10 {raise .p.side ; raise .p.sideLine ; set amt [expr 1.0 - [lindex [place configure .p.pane0 -relheight] end]] place configure .p.sideLine -relheight $amt -height -1p place configure .p.side -relheight $amt -height -1p place configure .p.pane1 -width -60p place configure .p.pane2 -width -60p }} bind PanedWinLB {event generate %W <>} bind PanedWinLB [bind PanedWinLB ] bind PanedWinLB {event generate %W <>} set amt [expr (100.0 - $pane(topp))/100] place .p.sideLine -anchor se -relx 1.0 -rely 1.0 -x -60p \ -relheight $amt -width 2p place .p.side -anchor se -relx 1.0 -rely 1.0 -x 0p \ -relheight $amt -width 60p #### place configure .p.pane1 -width -60p bindtags .p.sash1 [linsert [bindtags .p.sash1] 1 PanedWinLB] bindtags .p.sash2 [linsert [bindtags .p.sash2] 1 PanedWinLB] set pane(bottombar) [frame .absbtm] pack $pane(bottombar) -side bottom -fill x -expand 0 -pady 1 set pane(absbottom) [frame $pane(bottombar).frame] pack $pane(absbottom) -side bottom -fill x -expand 0 -pady 1 frame $pane(absbottom).fill -relief flat -height 1p pack $pane(absbottom).fill -side top -fill x set pane(statusbar) [frame $pane(absbottom).statusBar -borderwidth 1 -relief ridge] pack $pane(statusbar) -expand 1 -fill both -ipadx 1 -side left frame $pane(statusbar).1 -relief sunken -borderwidth 2 frame $pane(statusbar).2 -relief sunken -borderwidth 2 frame $pane(statusbar).3 -relief sunken -borderwidth 2 frame $pane(statusbar).4 -relief sunken -borderwidth 2 place $pane(statusbar).1 -relwidth .25 -relx 0 \ -relheight 1 -height -1p place $pane(statusbar).2 -relwidth .32 -relx .25 \ -relheight 1 -height -1p place $pane(statusbar).3 -relwidth .25 -relx .57 \ -relheight 1 -height -1p place $pane(statusbar).4 -relwidth .18 -relx .82 \ -relheight 1 -height -1p label $pane(statusbar).1.l -text $p(name) -anchor w -padx 3 label $pane(statusbar).2.l -text "" label $pane(statusbar).3.l -text "Not Connected" -anchor e -padx 3 label $pane(statusbar).4.l -text "Setting Clock..." -anchor e -padx 3 pack $pane(statusbar).1.l -fill both pack $pane(statusbar).2.l -fill both pack $pane(statusbar).3.l -fill both pack $pane(statusbar).4.l -fill both balloon $pane(statusbar).1.l "$p(name) [mc word,ver] $p(version)" balloon $pane(statusbar).2.l [mc status,2] balloon $pane(statusbar).3.l [mc status,3] balloon $pane(statusbar).4.l [mc status,4] update set high [winfo reqheight $pane(statusbar).1] $pane(statusbar) configure \ -height [winfo reqheight $pane(statusbar).1] $pane(absbottom) configure \ -height [winfo reqheight $pane(statusbar).1] bind $pane(statusbar).1.l {showConnectionInfo $conn(up)} bind $pane(statusbar).2.l \ {clipboard clear -displayof %W clipboard append -displayof %W [%W cget -text] bell -displayof %W} bind $pane(statusbar).4.l {timeFormat} set pane(resizeHandle) [frame $pane(absbottom).handle -relief flat] set pane(resize) [resizeHandle $pane(resizeHandle)] set conn(0,num) "QUICK" ;# force default color values set conn(0,sessiontime) "0" ;# so the display doesn't break createFrame 0 showFrame 0 wm minsize . $pane(minw) $pane(minh) wm protocol . WM_DELETE_WINDOW {chk_exit} toggleBindings 0 bind $pane(top) {tk_popup $conn($conn(up),top).click %X %Y} bind $pane(top).text [bind $pane(top) ] # to stop Cntrl-Shft-Btn3 producing the event. . . bind $pane(top) {continue;} bind . {set conn($conn(up),idle) "0"} bind all chk_exit bind . {chkUnmap} bind all {toggleFrame ; break} bind all {toggleFrame XXXXX -1 ; break} bind Text [bind Text ] bind Text [bind Text ] bind Text {continue} bind Text {continue} bind . {findIn $conn(up)} bindtags . "mainWin [bindtags .]" bind . {historyLastCommand $conn(up) 1} bind . {historyLastCommand $conn(up) 2} bind . {historyWindow $conn(up)} bind Text {} bind Text {} bind . {if {[wm state .] == $p(wmstate)} continue; if {[wm state .] == "normal"} { center . pack $pane(resizeHandle) -side right -anchor se } elseif {[wm state .] == "zoomed" } { pack forget $pane(resizeHandle) } set p(wmstate) [wm state .] fixHack } wm state . $pane(state) flashing runClock runClock2 toolbarPopupSet wm deiconify . if { $pane(state) == "normal" } { wm geometry . $pane(geom) } after 50 {raise .p.sideLine raise .p.side update event generate .p.sash1 <>} };# main # 'fixHack' makes up for my crap iwidgets::panedwindow hack, and # brings the listbox on the right up to the top proc fixHack {} { after 10 {raise .p.side ; raise .p.sideLine} event generate .p.sash2 };# fixHack # this allows scrolling the top-box when the mouse # is over the containing frame, not the text-box itself proc scrollTextWin {x y d} { eval [string map "%X $x %Y $y %D $d %W $conn($conn(up),top)" [bind Text ]] };# scrollTextWin proc showConnectionInfo {c} { # show info for connection $c if { $c == "0" || [dead $c] } {return;} set id [connInfo $c id] if { [catch {fconfigure $id -peername} host] } { # Connection's not there. return; } set home [fconfigure $id -sockname] if { [lindex $host 0] == [lindex $host 1] } { set hname [lindex $host 0] } else { set hname "[lindex $host 0] ([lindex $host 1])" } set msg "Connected to [connInfo $c info,name]" set msg "$msg\nHost Addr: $hname" set msg "$msg\nHost Port: [lindex $host 2]" set msg "$msg\n\nConnected from [lindex $home 0] port [lindex $home 2]" tk_messageBox -title "Connection Info" -icon info -message $msg };# showConnectionInfo proc logEditor {} { global p logedit # The logedit() array should contain the # match info, as regexps. IE: # set logedit(0) {^Announcement: .* has set the poll to:.*$} # set logedit(1) {^SHIRE ZMO: .*$} # This still needs setting up somewhere, to be configurable! *** set types { {{Text Files} {.txt} } {{Text Files} {.log} } {{All Files} * } } set file [tk_getOpenFile -title [mc loged,setin] \ -filetypes $types -initialdir $dir] if {$file == "" } return; if {![file exists $file] || ![file readable $file]} { set fi [file nativename [file normalize $file]] tk_messageBox -title [mc loged,name] -icon error \ -message [mc loged,unable $fi] return; } set p(logdirE) [file dirname $file] set out [tk_getSaveFile -title [mc loged,setout] \ -filetypes $types -initialdir $dir \ -defaultextension txt] if { $out == "" } return; if { [file exists $out] && ![file writable $out] } { set ou [file nativename [file normalize $out]] tk_messageBox -title [mc loged,name] -icon error \ -message [mc loged,unable2 $ou] return; } if { $file == $out } { tk_messageBox -title [mc loged,name] -icon error \ -message [mc loged,inout] return; } set rid [open $file r] set oid [open $out w] while {![eof $rid]} { gets $rid str set good 1 if { $str != "\n" } { foreach x [lsort -integer [array names logedit]] { if { [regexp -line $logedit($x) $str] == "1" } {set good 0} } } if {$good} { puts $oid $str } } close $rid ; close $oid set ouF [file nativename [file normalize $out]] if { [file exists $out] && [file readable $out] } { tk_messageBox -title [mc loged,name] -icon info \ -message [mc loged,good $ouF] } else { tk_messageBox -title [mc loged,name] -icon error \ -message [mc loged,bad $ouF] } };# logEditor proc findIn {c} { global conn set w .find$c $conn($c,top) configure -exportselection 0 if { [winfo exists $w] } { wm deiconify $w raise $w focus $w return; } toplevel $w wm withdraw $w wm title $w [mc find,title] wm resizable $w 0 0 wm transient $w . set padx 3 pack [frame $w.l] -side left -expand 1 -fill both -pady 5 -padx 0 pack [frame $w.r] -side right -expand 0 -fill both -pady 5 -padx 3 pack [frame $w.l.top] -side top -padx $padx -fill both label $w.l.top.l -text "[mc word,find]:" -width 6 -anchor w -justify left entry $w.l.top.e -textvariable search -width 30 -exportselection 0 bindtags $w.l.top.e "Entry $w.l.top.e [winfo toplevel $w.l.top.e] all" bind $w.l.top.e {set w [winfo toplevel %W] if { $search == "" } { $w.r.find configure -state disabled } else { $w.r.find configure -state normal } } pack $w.l.top.l -padx 3 -side left pack $w.l.top.e -padx 3 -side left -expand 1 -fill x pack [frame $w.l.mid] -side top -padx $padx -fill x set case 0 pack [frame $w.l.mid.left] -fill both -side left checkbutton $w.l.mid.left.case -text [mc find,case] \ -variable case pack $w.l.mid.left.case -side top -fill none -pady 5 -anchor nw label $w.l.mid.left.match -state disabled -anchor w -justify left pack $w.l.mid.left.match -side top -fill both -anchor w labelframe $w.l.mid.dir -labelanchor nw -text [mc word,direction] radiobutton $w.l.mid.dir.for -text [mc word,forwards] \ -command [list $w.l.mid.dir.back deselect] \ -variable findDir -value "forwards" radiobutton $w.l.mid.dir.back -text [mc word,backwards] \ -command [list $w.l.mid.dir.for deselect] \ -variable findDir -value "backwards" pack $w.l.mid.dir.for $w.l.mid.dir.back \ -side top -anchor nw pack $w.l.mid.dir -side right -ipadx 4 $w.l.mid.dir.for select set cmd "$w.l.mid.left.match configure \ -text \[findSub $c $w \$search \$case \$findDir\]" button $w.r.find -text [mc find,next] -underline 0 \ -default active -width 11 -state disabled \ -command "$cmd" button $w.r.cancel -text [mc word,cancel] -underline 0 -width 11\ -command [list event generate $w ] pack $w.r.find $w.r.cancel -side top -pady 5 -padx 3 bind $w "$conn($c,top) configure -exportselection 1 $w.l.top.e delete 0 end destroy $w" bind $w [list event generate $w ] bind $w [list $w.r.find invoke] bind $w [list $w.r.find invoke] wm protocol $w WM_DELETE_WINDOW [list event generate $w ] update center $w wm deiconify $w raise $w focus $w focus $w.l.top.e };# findIn proc findSub {c w str case dir } { global conn # $c = connection, $w = toplevel window of find box # $str = string, $case = case sensitive?, $dir = direction $w.l.top.e selection range 0 end if { $case } { set case exact } else { set case nocase } set txt $conn($c,top) set at [$txt search -count length -$case -$dir $str insert] if { $at == "" } { bell -displayof $w set retVal [mc find,none] } else { $txt tag remove sel 1.0 end set at2 [$txt index "$at+$length chars"] $txt tag add sel $at $at2 $txt see $at set mark $at2 if { $dir != "forwards" } {set mark $at} $txt mark set insert $mark set at3 [split $at .] set retVal [mc find,match [lindex $at3 0] [lindex $at3 1]] } raise $w focus $txt return $retVal; };# findSub proc timeFormat {} { global misc tempconf # Allow the user to edit the format of the clock on the statusbar set w .timeFormat if { [winfo exists $w] } { wm deiconify $w raise $w focus $w return; } toplevel $w wm withdraw $w set tempconf(clockFormat) $misc(clockFormat) set tempconf(oldclockFormat) $misc(clockFormat) wm title $w [mc time,title] frame $w.top pack $w.top -side top label $w.top.l -text [mc time,info] -wraplength 8c pack $w.top.l pack [frame $w.mid] -side top -pady 2 entry $w.mid.e -width 30 -textvariable tempconf(clockFormat) pack $w.mid.e pack [frame $w.bot] -side top -pady 2 button $w.bot.ok -text [mc word,ok] -underline 0 -width 8 -default active \ -command "$w.bot.apply invoke ; destroy $w" button $w.bot.apply -text [mc word,apply] -underline 0 -width 8 \ -command {set misc(clockFormat) $tempconf(clockFormat) after cancel [runClock]} button $w.bot.cancel -text [mc word,cancel] -underline 0 -width 8 \ -command "set misc(clockFormat) \$tempconf(oldclockFormat); destroy $w" pack $w.bot.ok $w.bot.apply $w.bot.cancel -side left -padx 5 bind $w "$w.bot.ok invoke" bind $w "$w.bot.ok invoke" bind $w "$w.bot.apply invoke" bind $w "$w.bot.cancel invoke" bind $w "$w.bot.cancel invoke" wm resizable $w 0 0 update center $w wm deiconify $w update };# timeFormat proc iscroll {c} { global pane conn if { $pane(iscroll) } { pack $conn($c,scrollb1) -fill y -side left -anchor e -padx 2 pack $conn($c,scrollb2) -fill y -side left -anchor e -padx 2 } else { pack forget $conn($c,scrollb1) $conn($c,scrollb2) } };# iscroll proc statusBar {c} { # Set the status bar up for connection $c global pane p conn if { $pane(showStatus) == "0" } { pack forget $pane(bottombar) return; } else { pack $pane(bottombar) -expand 0 -fill x \ -pady 1 -side bottom } set nc [mc status,noton] if { $c == "0" } { $pane(statusbar).3.l configure -text $nc $pane(statusbar).1.l configure -text $p(name) $pane(statusbar).2.l configure -text "*** $nc ***" } else { set mins [expr $conn($c,sessiontime)/60] if { [dead $c] } { set text $nc } else { set text [mc status,confor [expr $mins/60] [expr $mins%60]] $pane(statusbar).3.l configure -text $text } set t1 "$c. [connInfo $c info,name]" if { $conn($c,partial) } { set t1 "$t1 - << [mc word,logging] >>" } $pane(statusbar).1.l configure -text $t1 set ho [connInfo $c info,host] ; set po [connInfo $c info,port] $pane(statusbar).2.l configure -text "$ho:$po" } };# statusBar proc runClock {} { global pane misc $pane(statusbar).4.l configure \ -text [clock format [clock seconds] -format $misc(clockFormat)] return [after 1000 {runClock}]; };# runClock proc runClock2 {} { global conn pane foreach i [::Penn::setdiff $conn(on) $conn(limbo)] { incr conn($i,sessiontime) 2 };# foreach i statusBar $conn(up) return [after 2000 {runClock2}]; };# runClock2 proc textEditor {c} { global conn p alwaysontop set w .txtEd$c if {[winfo exists $w]} { wm deiconify $w raise $w focus $w $w.t configure -font [connInfo $c top,font] return; } toplevel $w wm withdraw $w wm title $w [mc texted,title "\[$c. [connInfo $c info,name]\]"] wm minsize $w 200 150 if { $p(hasCtext) } { # setup the 'ctext' highlighting for PennMUSH... setupCtextHilite $w.t [connInfo $c misc,hl] $c } else { setupCtextHilite $w.t 0 $c } menu $w.menu -tearoff 0 $w configure -menu $w.menu set m [menu $w.menu.sub -tearoff 0] $w.menu add cascade -label "[mc word,options]..." -menu $m menu $m.hl -tearoff 0 ; menu $m.esc -tearoff 0 set cmdE "\[$w.t get 1.0 end-1char\] ; $w.t delete 1.0 end" $m add command -label [mc texted,top] -accelerator "Alt+1" \ -command "$conn($c,bottom1) insert end $cmdE" $m add command -label [mc texted,bottom] -accelerator "Alt+2" \ -command "$conn($c,bottom2) insert end $cmdE" set cmd "send_mushage2 \[$w.t get 1.0 end-1char\] $c 0 \n ; $w.t delete 1.0 end ; $m invoke end" $m add command -label [mc texted,direct] -accelerator "Alt+3" \ -command $cmd $m add separator $m add cascade -label [mc texted,hl] -menu $m.hl -state $p(wState,$p(hasCtext)) set conn($c,texted,spell) 0 $m add checkbutton -label [mc texted,spell] -state $p(wState,$p(hasDic)) \ -variable conn($c,texted,spell) -command "toggleSpelling $c $w.t" $m add cascade -label [mc texted,esc] -menu $m.esc $m add separator $m add command -label [mc texted,conR] -command "textConvert $w.t \\n %r" $m add command -label [mc texted,conB] -command "textConvert $w.t { } %b" $m add separator $m add command -label [mc texted,clear] -command "$w.t delete 1.0 end" $m add separator if { $p(platform) == "windows" } { $m add checkbutton -label [mc texted,aot] \ -command "wm attributes $w -topmost \$alwaysontop($w)" \ -variable alwaysontop($w) set alwaysontop($w) $m add separator } $m add command -label [mc word,close] -accelerator "Esc" -command "wm withdraw $w" $m.hl add checkbutton -label [mc word,none] -variable conn($c,misc,hl) -command "setupCtextHilite $w.t \$conn($c,misc,hl) $c" -onvalue 0 $m.hl add checkbutton -label [mc texted,penn] -variable conn($c,misc,hl) -command "setupCtextHilite $w.t \$conn($c,misc,hl) $c " -onvalue 1 $m.esc add command -label [mc texted,escsel] -command "textEdEsc $w.t 1" $m.esc add command -label [mc texted,escall] -command "textEdEsc $w.t 0" wm protocol $w WM_DELETE_WINDOW "$m invoke end" bind $w "$m invoke end" bind $w "invoke 0" bind $w "$m invoke 1" update center $w wm deiconify $w raise $w focus $w update };# textEditor proc toggleSpelling {c w} { if { [connInfo $c texted,spell] == "1" } { bind $w "text:spell $w" text:spell $w } else { bind $w {} $w tag remove dict 1.0 end } };# toggleSpelling proc textEdEsc {w {sel 0}} { # if $sel == "1", escape selection only. Otherwise, do the whole widget if { $sel } { if { [catch {$w index sel.first} start] } { bell -displayof $w return; } set str [$w get sel.first sel.last] $w delete sel.first sel.last $w insert $start [regsub -all {(\[|\]|{|}|%|;|\\|\(|\)|,)} $str {\\\1}] sel } else { set str [$w get 1.0 end-1c] $w delete 1.0 end $w insert end [regsub -all {(\[|\]|{|}|%|;|\\|\(|\)|,)} $str {\\\1}] } };# textEdEsc proc setupCtextHilite {w style c} { global p if { $style == "0" && [winfo exists $w] && [winfo class $w] == "Text" } { return; } setupCtextHilite$style $w $c $w tag configure dict -foreground red -overstrike 1 toggleSpelling $c $w };# setupCtextHilite proc setupCtextHilite0 {w c} { if { [winfo exists $w] && [winfo class $w] == "Text" } { return; } if { [winfo exists $w] } { set str [$w get 1.0 end-1c] destroy $w } else { set str "" } text $w -undo 1 -font [connInfo $c top,font] $w insert end $str if { [set bef [lindex [pack slaves [winfo parent $w]] 0]] != "" } { pack $w -expand 1 -fill both -before $bef } else { pack $w -expand 1 -fill both } };# setupCtextHilite0 proc setupCtextHilite1 {w c} { if { [winfo exists $w] } { if { [winfo class $w] == "Ctext" } { ctext::clearHighlightClasses $w } else { set str [$w get 1.0 end-1c] destroy $w ctext $w -undo 1 -font [connInfo $c top,font] if { [set bef [lindex [pack slaves [winfo parent $w]] 0]] != "" } { pack $w -expand 1 -fill both -before $bef } else { pack $w -expand 1 -fill both } $w insert end $str } } else { ctext $w -undo 1 -font [connInfo $c top,font] if { [set bef [lindex [pack slaves [winfo parent $w]] 0]] != "" } { pack $w -expand 1 -fill both -before $bef } else { pack $w -expand 1 -fill both } } toggleSpelling $c $w # for window $w, setup PennMUSH Syntax Highlighting using ctext ctext::addHighlightClassWithOnlyCharStart $w attr1 purple "&" ctext::addHighlightClass $w attrCmds purple [list @aclone @adescribe @adrop @afailure @ahear @alfail @apayment @atport @ause @azleave @aconnect @aefail @adestroy @afollow @aidescribe @alias @amhear @aufail @away @aahear @adeath @idescformat @infilter @lalias @adisconnect @enter @agive @aleave @amove @asuccess @aunfollow @azenter @charges @death @conformat @descformat @comment @cost @describe @efail @filter @forwardlist @give @idescribe @inprefix @ealias @enter @exitformat @haven @idle @doing @drop @failure @leave @nameformat @odescribe @ofollow @odrop @enter @ogive @lfail @listen @move @nameaccent @odeath @oefail @ofailure @oidescribe @oleave @opayment @osuccess @ounfollow @oxleave @ozenter @runout @olfail @otport @ouse @oxmove @ozleave @payment @receive @omove @oreceive @oufail @oxenter @oxtport @prefix @sex @ufail @unfollow @zleave @success @ulock @unlock @uunlock @vrml_url @startup @zenter] ctext::addHighlightClassForSpecialChars $w brackets #00008888ffff {[]} ctext::addHighlightClassForSpecialChars $w braces #00004444ffff {{}} ctext::addHighlightClassForSpecialChars $w parens blue {()} ctext::addHighlightClassForRegexp $w pSub "#2222dddd2222" {%([0-9a-cA-ClLnNOPopr-tR-T#~@\!\?%]|[v-xV-X][a-zA-Z]|[qQ][a-zA-Z0-9])} ctext::addHighlightClassForRegexp $w functions purple {(?i)(@@|ABS|ACCENT|ACCNAME|ACOS|ADD|AFTER|ALLOF|ALPHAMAX|ALPHAMIN|AND|ANDFLAGS|ANDLFLAGS|ANSI|APOSS|ART|ASIN|ATAN|ATAN2|ATRLOCK|ATTRCNT|BAND|BASECONV|BEEP|BEFORE|BNAND|BNOT|BOR|BOUND|BRACKETS|BXOR|CAND|CAPSTR|CASE|CASEALL|CAT|CEIL|CENTER|CHEALTH|CHECKPASS|CHILDREN|CHR|CLONE|CMDS|COMBAT|COMP|CON|CONFIG|CONN|CONTROLS|CONVSECS|CONVTIME|CONVUTCSECS|COR|COS|CREATE|CTIME|CTU|CULTURE|DEC|DECRYPT|DEFAULT|DELETE|DESCFUN|DIE|DIG|DIGEST|DIST2D|DIST3D|DIV|DOING|DYNHELP|E|EBALANCE|ECON|EDEFAULT|EDIT|EGIVE|ELEMENT|ELEMENTS|ELIST|ELOCK|EMIT|ENCRYPT|ENDTAG|ENTRANCES|EQ|ESCAPE|ETAKE|ETIMEFMT|EVAL|EVEN|EXIT|EXP|EXTRACT|FDIV|FILTER|FILTERBOOL|FINDABLE|FIRST|FIRSTOF|FLAGS|FLIP|FLOOR|FLOORDIV|FMOD|FOLD|FOLLOWERS|FOLLOWING|FOOTER|FORCE|FOREACH|FRACTION|FULLNAME|FUNCTIONS|GET|GET_EVAL|GRAB|GRABALL|GREP|GREPI|GT|GTE|HASATTR|HASATTRP|HASATTRPVAL|HASATTRVAL|HASFLAG|HASPOWER|HASTYPE|HEADER|HEIGHT|HIDDEN|HOME|HOST|HOSTNAME|HTML|IDLE|IDLESECS|IF|IFELSE|ILEV|INAME|INC|INDEX|INLIST|INSERT|INUM|IPADDR|ISDAYLIGHT|ISDBREF|ISINT|ISNUM|ISWORD|ITEMIZE|ITEMS|ITER|ITEXT|LANG|LAST|LATTR|LCON|LCSTR|LDELETE|LEFT|LEMIT|LEXITS|LFIELD|LFLAGS|LINE|LINK|LIST|LIT|LJUST|LMATH|LN|LNUM|LOC|LOCALIZE|LOCATE|LOCATION|LOCK|LOG|LOGWRITE|LPARENT|LPLAYERS|LPORTS|LPOS|LSEARCH|LSEARCHR|LSTATS|LT|LTE|LVCON|LVEXITS|LVPLAYERS|LWHO|MAP|MATCH|MATCHALL|MAX|MEAN|MEDIAN|MEMBER|MERGE|MID|MIN|MIX|MOD|MODULO|MODULUS|MONEY|MTIME|MUDNAME|MUL|MUNGE|MWHO|NAME|NAND|NATTR|NCSTR|NEARBY|NEQ|NEXT|NOR|NOT|NSPEMIT|NULL|NUM|NUMO|OBJ|OBJEVAL|OBJMEM|OEMIT|OPEN|OR|ORD|ORFLAGS|ORLFLAGS|OWNER|PARENT|PARSE|PCREATE|PEMIT|PI|PICKRAND|PLAYERMEM|PLAYERS|PMATCH|PNT|POLL|PORTS|POS|POSS|POWER|POWERS|PUEBLO|QUOTA|R|RAND|RANDWORD|REGEDIT|REGEDITALL|REGEDITALLI|REGEDITI|REGMATCH|REGMATCHI|REGRAB|REGRABALL|REGRABALLI|REGRABI|REGREP|REGREPI|REMAINDER|REMIT|REMOVE|REPEAT|REPLACE|REPLACEALL|REST|RESTARTS|RESTARTTIME|RESWITCH|RESWITCHALL|RESWITCHALLI|RESWITCHI|REVERSE|REVWORDS|RFIELD|RIGHT|RJUST|RLOC|RNUM|ROOM|ROOT|ROUND|S|SCAN|SCRAMBLE|SEARCH|SECS|SECURE|SET|SETDIFF|SETINTER|SETQ|SETR|SETUNION|SHA0|SHL|SHR|SHUFFLE|SIGN|SIN|SORT|SORTBY|SOUNDEX|SOUNDLIKE|SOUNDSLIKE|SPACE|SPELLNUM|SPLICE|SQ|SQRT|SQUISH|SSL|STARTTIME|STATS|STATUS|STDDEV|STEP|STRCAT|STRINSERT|STRIPACCENTS|STRIPANSI|STRLEN|STRMATCH|STRREPLACE|SUB|SUBJ|SWITCH|SWITCHALL|T|TABLE|TAG|TAGQ|TAGWRAP|TAN|TEL|TERMINFO|TEXTFILE|THE|TIME|TIMEFMT|TIMESTRING|TR|TRIGGER|TRIM|TRIMPENN|TRIMTINY|TRUNC|TYPE|U|UCSTR|UDEFAULT|UFUN|ULDEFAULT|ULOCAL|UTCTIME|V|VADD|VAL|VALID|VDIM|VDOT|VERSION|VISIBLE|VMAG|VMAX|VMIN|VMUL|VSUB|VUNIT|WFUN|WHERE|WIDTH|WIPE|WORDPOS|WORDS|WRAP|XGET|XOR|ZEMIT|ZFUN|ZONE)\(} ctext::addHighlightClassForRegexp $w cmdsSwitch red {(?i)(@allquota|@attribute|@boot|@allhalt|@cemit|@chownall|@chzoneall|@chown|@chzone|@config|@cpattr|@channel|@chat|@chzone|@clock|@command|@create|@decompile|@dig|@dolist|@dump|@enable|@eunlock|@halt|@hook|@disable|@flag|@force|@function|@emit|@entrances|@grep|@hide|@map|@link|@logwipe|@mail|@mvattr|@nspemit|@oemit|@lemit|@list|@listmotd|@lset|@malias|@motd|@lock|@log|@notify|@pemit|@poor|@ps|@rejectmotd|@shutdown|@remit|@rwall|@sitelock|@quota|@recycle|@restart|@scan|@stats|@switch|@tport|@version|@wizwall|@uptime|@wall|@zemit|@sweep|@teleport|@wait|@warnings|@wcheck|@wizmotd|EXAMINE|LOOK|PAGE|POSE|SAY|SEMIPOSE|THINK|WHISPER|WITH|EX|EXA)(/\S*)?} ctext::addHighlightClassForRegexp $w cmdsNoswitch orange {(?i)(@atrchown|@atrlock|@break|@@|@destroy|@dbck|@firstexit|@follow|@drain|@kick|@elock|@edit|@find|@gedit|@name|@newpassword|@nuke|@password|@readcache|@search|@select|@open|@power|@purge|@set|@parent|@pcreate|@poll|@unrecycle|@use|@whereis|@squota|@trigger|@unlink|@wipe|@undestroy|@verb|AHELP|ANEWS|BRIEF|DESERT|DISMISS|DROP|ENTER|FOLLOW|GET|GIVE|GOTO|HELP|INVENTORY|KILL|LEAVE|GOTO|NEWS|SCORE|SLAY|TAKE|TEACH|UNFOLLOW|USE|WHISPER)} foreach x {attr1 attrCmds brackets braces parens pSub functions cmdsSwitch cmdsNoswitch} { $w tag configure $x -overstrike 0 $w tag raise $x dict } $w tag raise parens functions };# setupCtextHilite1 proc textConvert {w f t} { # In text widget $w, convert the string $f to $t set var 1.0 set cnt 0 set len [string length $t] while { [set var [$w search -count cnt -nocase $f $var end-1c]] != "" } { $w delete $var "$var+$cnt char" $w insert $var $t set var [$w index "$var + $len chars"] } bell -displayof $w return; };# textConvert proc disconnect {w {check 0}} { global conn p if { $check == "1" } { set msg [mc disco,check [connInfo $w info,name]] set ans [tk_messageBox -title $p(name) -message $msg \ -type yesno -icon question] if { $ans == "no" } { return; } } fileevent $conn($w,id) writable {} timerReset $w close $conn($w,id) putOut $w [mc disco,disco] playSound [connInfo $w auto,dsound] set conn($w,id) {} setState $w set conn(limbo) [lsort -dictionary -unique "$conn(limbo) $w"] colorWorldToolbar $w };# disconnect proc boot_reconnect {w} { global conn misc if { [info exists conn($w,reconID)] || $misc(autorecon) == "0" } { return; } set conn($w,reconID) [after [expr $misc(autorecon) * 1000] "reconnect $w"] putOut $w [mc recon,auto $misc(autorecon)] };# boot_reconnect proc closeWorld {w {check 1}} { global p conn pane if { ![info exists conn($w,id)] } { set conn($w,id) "" } if { [info exists conn($w,reconID)] } { after cancel $conn($w,reconID) unset conn($w,reconID) } if { $check == "1" && ![dead $w] && ![stillConnecting $w] } { set msg [mc close,check [connInfo $w info,name]] set ans [tk_messageBox -title $p(name) -type yesno \ -message $msg -icon question] if { $ans == "no" } { return; } } catch {disconnect $w} doLogOff $w 1 toggleFrame $w if { [set loc [lsearch $conn(limbo) $w]] != "-1" } { set $conn(limbo) [lreplace $conn(limbo) $loc $loc] } destroy $conn($w,top) $conn($w,bottom1) $conn($w,bottom2) \ $conn($w,topbar) $conn($w,sidebarframe) \ $conn($w,scrollb1) $conn($w,scrollb2) set loc [lsearch $conn(on) $w] set conn(on) [lreplace $conn(on) $loc $loc] set conn(off) [lsort -dictionary -unique "$conn(off) $w"] catch {destroy $conn($w,top).click} catch {destroy .txtEd$w} catch {destroy .log$w} catch {destroy .custom-prefix-$w} catch {destroy $pane(worldtoolbar).$w} # Remove this world from right-click 'toggle' menus # We add 5 for 'Copy Text', 'Toggle', 'Edit Settings', # 'History window', and a separator. set mloc [expr $loc + 5] foreach x $conn(on) { $conn($x,top).click delete $mloc } array unset conn $w,* toolbarPopupSet };# closeWorld proc waitingSel {w} { # Someone double-clicked listbox $w which shows screens with new text # The listbox element is deleted in showFrame, as showFrame will # always bring the new window the front, but won't always be run # via the listbox / waitingSel set x [$w curselection] if {$x != ""} { set y [$w get $x] set num [string range [lindex $y 0] 0 end-1] showFrame $num } };# waitingSel proc showFrame {n} { global conn p world pane size menu set bgCol [$conn($n,top) cget -background] $pane(top) configure -background $bgCol $pane(top).text configure -background $bgCol set u 0 if {[info exists conn(up)]} { set u $conn(up) if {$n == $u} { if { $pane(yscroll) == "1" } { pack $conn($n,topbar) -in $pane(top) -side right \ -anchor e -expand 0 -fill y pack $conn($n,sidebarfill) -side right -expand 0 } else { pack forget $conn($n,topbar) pack forget $conn($n,sidebarfill) };# yscroll == 1 if { $pane(xscroll) == "1" } { pack $conn($n,sidebarframe) -in $pane(top) \ -side bottom -anchor s \ -expand 0 -fill x -before $pane(top).text } else { pack forget $conn($n,sidebarframe) };# xscroll == 1 set old [expr [connInfo $n pane,linewrap] > 0] setMargins $n set new [expr [connInfo $n pane,linewrap] > 0] statusBar $n if { $old != $new } { pack configure $conn($n,top) -fill [lindex {both y} $new] $conn($n,topbar) set $conn($n,sidebar) set };# old != new return; };# n == u set conn($u,idle) "0" if {[lsearch "0 $conn(on)" $n] == "-1"} { return; } pack forget $conn($u,top) $conn($u,bottom1) \ $conn($u,bottom2) $conn($u,topbar) \ $conn($u,sidebarframe) $conn($u,scrollb1) $conn($u,scrollb2) catch {destroy .find$u} catch {destory .history$u} catch {wm withdraw .custom-prefix-$u} };# info exists conn(up) catch {event generate .pick } catch {wm state .custom-prefix-$n normal} setMargins $n if { [connInfo $n pane,linewrap] == "0" } { pack $conn($n,top) -expand 1 -fill both -in $pane(top).text \ -side left -anchor w } else { pack $conn($n,top) -expand 1 -fill y -in $pane(top).text \ -side left -anchor w } if { $pane(yscroll) == "1" } { pack $conn($n,topbar) -in $pane(top) -side right \ -anchor e -expand 0 -fill y pack $conn($n,sidebarfill) -side right -expand 0 } else { pack forget $conn($n,topbar) pack forget $conn($n,sidebarfill) } if { $pane(xscroll) == "1" } { pack $conn($n,sidebarframe) -in $pane(top) \ -side bottom -anchor s \ -expand 0 -fill x -before $pane(top).text } else { pack forget $conn($n,sidebarframe) } pack $conn($n,bottom1) -expand 1 -fill both -in $pane(bottom1) -side left pack $conn($n,bottom2) -expand 1 -fill both -in $pane(bottom2) -side left iscroll $n focus $conn($n,bottom$conn($n,focuswin)) if { $n == "0" } { wm title . "$p(name) [mc word,ver] $p(version)" .menu entryconfigure $menu(logging) -state disabled } else { wm title . "$p(nick) - \[$n. [connInfo $n info,name]\]" .menu entryconfigure $menu(logging) -state normal } if { $n != "0" } { set wait [lsearch -exact $conn(waiting) "$n. [connInfo $n info,name]"] if { $wait != "-1" } { set conn(waiting) [lreplace $conn(waiting) $wait $wait] } } setState $n statusBar $n set conn(up) $n set conn($n,idle) "0" colorWorldToolbar $u colorWorldToolbar $n fixHack };# showFrame proc setState { w } { global conn p menu if { $w == "0" } { .tb.1.disconnect configure -state disabled -image [imageFor disconnect 0] .tb.1.close configure -state disabled -image [imageFor close 0] .tb.1.reconnect configure -state disabled -image [imageFor reconnect 0] .tb.3.mail configure -state disabled -image [imageFor mail 0] .tb.3.texted configure -state disabled -image [imageFor texted 0] .tb.3b.log configure -state disabled -image [imageFor log 0] .tb.3b.up configure -state disabled -image [imageFor upload 0] .tb.4.settings configure -state disabled -image [imageFor settings 0] .menu.t entryconfigure $menu(tools,cm) -state disabled .menu.t entryconfigure $menu(tools,te) -state disabled .menu.f entryconfigure $menu(file,es) -state disabled .menu.f entryconfigure $menu(file,dc) -state disabled .menu.f entryconfigure $menu(file,rc) -state disabled .menu.f entryconfigure $menu(file,cl) -state disabled return; } if { ![dead $w] } { .tb.1.disconnect configure -state normal -image [imageFor disconnect 1] .menu.f entryconfigure $menu(file,dc) -state normal .tb.1.reconnect configure -state disabled -image [imageFor reconnect 0] .menu.f entryconfigure $menu(file,rc) -state disabled .tb.3b.up configure -state normal -image [imageFor upload 1] } else { .tb.1.disconnect configure -state disabled -image [imageFor disconnect 0] .menu.f entryconfigure $menu(file,dc) -state disabled .tb.1.reconnect configure -state normal -image [imageFor reconnect 1] .menu.f entryconfigure $menu(file,rc) -state normal .tb.3b.up configure -state disabled -image [imageFor upload 0] } .tb.3b.log configure -state normal -image [imageFor log 1] .tb.3.mail configure -state normal -image [imageFor mail 1] .tb.3.texted configure -state normal -image [imageFor texted 1] .tb.1.close configure -state normal -image [imageFor close 1] .menu.f entryconfigure $menu(file,cl) -state normal .menu.t entryconfigure $menu(tools,cm) -state normal .menu.t entryconfigure $menu(tools,te) -state normal if { $conn($w,num) == "QUICK" } { .menu.f entryconfigure $menu(file,es) -state disabled .tb.4.settings configure -state disabled -image [imageFor settings 0] } else { .menu.f entryconfigure $menu(file,es) -state normal .tb.4.settings configure -state normal -image [imageFor settings 1] } };# setState proc toggleFrame {{not XXXXX} {dir 1}} { global conn catch {event generate .pick } if {![info exists conn(up)]} { tk_messageBox -title $p(name) -icon error \ -message [mc frame,error] return; } if { $conn(on) == "" } { showFrame 0; return; } set temp [lsearch $conn(on) $conn(up)] if { $dir == "1" } { set temp [lindex "$conn(on) $conn(on)" [expr $temp+1]] } else { if { $temp == "0" } { set temp [lindex $conn(on) end] } else { set temp [lindex $conn(on) [expr $temp-1]] } } if { [lsearch $conn(full) $temp] == "-1" || "$temp" == "$not" } { showFrame 0 } else { showFrame $temp } };# toggleFrame proc flashing {{arg 0}} { global conn # Using $list if $arg == 0 but $conn(on) if # $arg == 1 means we turn flash off everywhere, # but only turn it on for connected worlds. Thus, # flashing stops when you're disconnected. Whee. :) set list [::Penn::setdiff $conn(on) $conn(limbo)] if { $arg == "1" } { foreach x $conn(on) { $conn($x,top) tag configure TAG_FLASH \ -foreground {} -background {} };# foreach x conn(on) } else { foreach x $list { set col [$conn($x,top) cget -background] set fl [connInfo $x ansi,use-flash] set an [connInfo $x ansi,use-ansi] if {$fl == "1" && $an == "1"} { $conn($x,top) tag configure TAG_FLASH \ -foreground $col -background $col } };# foreach x $list } after 1000 "flashing [lindex {1 0} $arg]" };# flashing proc toolbarPopupSet {} { global conn pane set b1 $pane(bar).2.popup set b2 $pane(bar).2.back set b3 $pane(bar).2.next set m $b1.m $m delete 0 end if { [info exists conn(on)] && [llength $conn(on)] > 1 } { foreach x [lsort -integer $conn(on)] { $m add command -label "$x. [connInfo $x info,name]" \ -command [list showFrame $x] } $b1 configure -state normal -image [imageFor down-worlds 1] $b2 configure -state normal -image [imageFor prev-world 1] $b3 configure -state normal -image [imageFor next-world 1] } else { $b1 configure -state disabled -image [imageFor down-worlds 0] $b2 configure -state disabled -image [imageFor prev-world 0] $b3 configure -state disabled -image [imageFor next-world 0] } };# toolbarPopupSet proc timerReset {c} { global conn world if { [info exists conn($c,timerids)] && $conn($c,timerids) != "" } { foreach x $conn($c,timerids) { after cancel $x } } set conn($c,timerids) "" };# timerReset proc timerStart {c} { global conn timers set now [clock scan {now}] set conn($c,timerids) "" set num $conn($c,num) if { [info exists timers($num)] && $timers($num) != "" } { foreach x $timers($num) { timerStartSub [lindex $x 0] [lindex $x 1] $c } } };# timerStart proc timerStartSub {time cmd c} { global conn set now [clock seconds] if { [catch {clock scan $time} time1] } { return; } if { [set time2 [expr {$time1 - $now}]] < 1 } { return; } lappend conn($c,timerids) \ [after [expr {$time2 * 1000}] [list timerRun $time $cmd $c]] };# timerStartSub proc timerRun {time cmd c} { global conn send_mushage2 $cmd $c "1" "" set conn($c,timerids) \ [::Penn::setinter $conn($c,timerids) [after info]] timerStartSub $time $cmd $c };# timerRun proc createFrame {n} { global conn top bottom1 bottom2 global ansi pane p size set wld $conn($n,num) set conn($n,topbar) $pane(top).${n}bar set conn($n,sidebarframe) $pane(top).${n}sidebar set conn($n,sidebar) $conn($n,sidebarframe).bar set conn($n,sidebarfill) $conn($n,sidebarframe).fill if { $wld == "QUICK" } { set fonts "Q" } else { set fonts $wld } set t [text $pane(top).text.$n -wrap word \ -font font$fonts.0 -relief flat \ -yscrollcommand "$conn($n,topbar) set" \ -xscrollcommand "$conn($n,sidebar) set"] scrollbar $conn($n,topbar) -command [list $t yview] frame $conn($n,sidebarframe) scrollbar $conn($n,sidebar) -command [list $t xview] -orient horizontal pack $conn($n,sidebar) -expand 1 -fill x -side left frame $conn($n,sidebarfill) \ -width [winfo reqwidth $conn($n,topbar)] $t tag configure TAG_FLASH ;# just marks it to flash $t tag configure center -justify center colorSetup $t $conn($n,num) $n set conn($n,top) $t setMargins $n if { $n == "0" || $p(textEdit) == "0" } { set list "TextAlias TextOut" } else { set list "TextAlias" } bindtags $t "$t $list Text . all" set state1 "normal" ; set state2 "normal" if { $n == "0" } { set state1 "disabled" set state2 "disabled" } elseif { $wld == "QUICK" } { set state2 "disabled" } set m [menu $t.click -tearoff 0 -postcommand [list chk_copy $t $t.click 1]] $m add command -label [mc word,toggle] -command toggleFrame $m add command -label [mc rclick,copy] -command [list tk_textCopy $t] $m add command -label [mc rclick,edit] -command [list config $wld] \ -state $state2 $m add command -label [mc rclick,hist] -command [list historyWindow $n] \ -state $state1 $m add separator foreach x $conn(on) { $m add command -label "$x. [connInfo $x info,name]" \ -command [list showFrame $x] } toolbarPopupSet bind $t {tk_popup %W.click %X %Y} set b1 [text $pane(bottom1).$n -wrap word -bg $bottom1(bg) -width 1 \ -fg $bottom1(fg) -font $bottom1(font) \ -yscrollcommand "$pane(bottom1).${n}bar set"] $b1 configure -insertbackground [revColor [getColor $bottom1(bg)]] set conn($n,bottom1) $b1 set conn($n,scrollb1) $pane(bottom1).${n}bar scrollbar $conn($n,scrollb1) -orient vertical -command [list $b1 yview] set b2 [text $pane(bottom2).$n -wrap word -bg $bottom2(bg) -width 1 \ -fg $bottom2(fg) -font $bottom2(font) \ -yscrollcommand "$pane(bottom2).${n}bar set"] $b2 configure -insertbackground [revColor [getColor $bottom2(bg)]] set conn($n,bottom2) $b2 set conn($n,scrollb2) $pane(bottom2).${n}bar scrollbar $conn($n,scrollb2) -orient vertical -command [list $b2 yview] bindtags $b1 "$b1 TextIn Text . all" bindtags $b2 "$b2 TextIn Text . all" bind $b1 "set conn($n,focuswin) 1" bind $b2 "set conn($n,focuswin) 2" set conn($n,focuswin) 1 $b1 configure -undo 1 $b2 configure -undo 1 # So we know we're not doing a Partial Log on this connection set conn($n,partial) "0" # These are used by 'get_mushage' for working out ansi colors, # when no apparant color is given by the MUSH get_mushageSetAnsiNormal $n toolbarPopupSet addWorldToolbar };# createFrame proc get_mushageSetAnsiNormal {w} { global conn set conn($w,getmush,hilite) "" set conn($w,getmush,underline) "" set conn($w,getmush,flash) "" set conn($w,getmush,fg) "normalfg" set conn($w,getmush,bg) "normalbg" set conn($w,getmush,tagother) "" set conn($w,getmush,tagfg) "FG_NORMAL" set conn($w,getmush,tagbg) "BG_NORMAL" set conn($w,getmush,list) "FG_NORMAL BG_NORMAL" };# get_mushageSetAnsiNormal proc setMargins {c} { global conn world # Setup the margins for connection $c set t $conn($c,top) set indent [connInfo $c pane,indent] if { $indent == "0" } { set lm2 "0" } else { set font [connInfo $c top,font] set charSize [font measure $font -displayof . "0"] # These numbers are correct on Win 98. On other platforms, I'm # not sure... set lm2 "[expr ($indent*.75) * $charSize]p" } $t tag configure margins -lmargin1 0m -lmargin2 $lm2 -rmargin 0m set wrap [connInfo $c pane,linewrap] set wl [expr $wrap > 0] $t configure -width [lindex "99999 $wrap" $wl] \ -wrap [lindex {none word} $wl] };# setMargins proc colorSetup {w c x} { global ansi conn top world # for text widget $w, set up the ANSI_ tags. # run when an open world's color setup changes, as well as # when a world is connected to. Center/Margins/Flash, etc, # aren't done here to save "updating" static tags. # Must also be called for top-box BG color changes # Underline is here, as use-ansi changes call this. # We also do 'show/hide empty lines' here # # Also raise the selection tag to the top. # $c is the world, so that we get the right colors # $x is the connection id: $conn($x,top) -> $w set list "black red green yellow blue magenta cyan white normal" if { $c == "QUICK" || $c == "" } { # We're not connecting to a defined world (either quick connect # or "world 0", the title screen world; use the defaults. set Use $ansi(use-ansi) foreach col $list { set local($col) $ansi($col) set local(${col}-h) $ansi(${col}-h) } set local(fg) $ansi(normal) set local(hilite) $ansi(normal-h) set local(bg) $top(bg) } else { # We're on a proper world. Use its settings. set Use [connInfo $x ansi,use-ansi] foreach col $list { set local($col) $world($c,ansi,$col) set local(${col}-h) $world($c,ansi,${col}-h) } set local(fg) $world($c,ansi,normal) set local(hilite) $world($c,ansi,normal-h) set local(bg) $world($c,top,bg) } $w configure -background $local(bg) -foreground $local(fg) if { [info exists conn(up)] && $conn(up) == $x } { # Force background color correction (on outer frame). showFrame $x } if { $Use == "0" } { foreach col $list { $w tag configure [string toupper "fg_ansi_$col"] \ -foreground $local(fg) \ -background $local(bg) $w tag configure [string toupper "fg_ansi_${col}-h"] \ -foreground $local(fg) \ -background $local(bg) $w tag configure [string toupper "bg_ansi_$col"] \ -foreground $local(fg) \ -background $local(bg) $w tag configure [string toupper "bg_ansi_${col}-h"] \ -foreground $local(fg) \ -background $local(bg) } $w tag configure FG_NORMAL -foreground $local(fg) \ -background $local(bg) $w tag configure FG_HILITE -foreground $local(fg) \ -background $local(bg) $w tag configure BG_FG_NORMAL -foreground $local(fg) \ -background $local(bg) $w tag configure BG_FG_HILITE -foreground $local(fg) \ -background $local(bg) $w tag configure BG_NORMAL -foreground $local(fg) \ -background $local(bg) $w tag configure FG_BG -foreground $local(fg) \ -background $local(bg) $w tag configure TAG_UNDERLINE -underline 0 } else { foreach col $list { $w tag configure [string toupper "fg_ansi_$col"] \ -foreground $local($col) \ -background {} $w tag configure [string toupper "fg_ansi_${col}-H"] \ -foreground $local(${col}-h) \ -background {} $w tag configure [string toupper "bg_ansi_$col"] \ -background $local($col) \ -foreground {} $w tag configure [string toupper "bg_ansi_${col}-H"] \ -background $local(${col}-h) \ -foreground {} };# foreach col $list $w tag configure FG_NORMAL -foreground $local(fg) \ -background {} $w tag configure FG_HILITE -foreground $local(hilite) \ -background {} $w tag configure BG_FG_NORMAL -background $local(fg) \ -foreground {} $w tag configure BG_FG_HILITE -background $local(hilite) \ -foreground {} $w tag configure BG_NORMAL -background $local(bg) \ -foreground {} $w tag configure FG_BG -foreground $local(bg) \ -background {} $w tag configure TAG_UNDERLINE -underline 1 };# if $Use == "0" set ibcol [revColor [getColor $local(bg)]] $w tag configure sel -background $ibcol \ -foreground $local(bg) $w tag configure showSel -background $ibcol \ -foreground $local(bg) $w tag configure sysfont -foreground $ansi(system) $w tag configure echo -foreground $ansi(echo) set insertBG [getRGB $ibcol] foreach y {0 1 2} { set temp$y [lindex $insertBG $y] set temp$y [::Penn::min "256 [expr [set temp$y] + 60]"] } set insertBG [getColor [htmlColor "$temp0 $temp1 $temp2"]] $w configure -insertbackground $insertBG $w tag configure newline -elide [connInfo $x top,empty] $w tag raise sysfont $w tag raise TAG_FLASH $w tag raise sel };# colorSetup proc chk_copy {w m e} { # Check that some text is selected in text widget $w. # If not, deactivate menu $m's entry number $e if {[$w tag ranges sel] == ""} { set state disabled } else { set state normal } $m entryconfigure $e -state $state };# chk_copy proc connNames {c w {i "*"}} { global conn world # Kinda like [array names $w $i] but for connection $c. if { [array names conn $w,$i] != "" } { return [array names conn $w,$i]; } elseif { [array names world $conn($c,num),$w,$i] != "" } { return [array names world $conn($c,num),$w,$i]; } elseif { [array names $w $i] != "" } { return [array names $w $i]; } return; };# connNames proc connInfo {c i {d ""}} { global conn world # Return world info for a connection. # First, try $conn($c,$i), then $world($conn($c,num),$i), # then: if $i is *,* we try $() # Otherwise, return $d (default is an empty string) if { [info exists conn($c,$i)]} { return $conn($c,$i); } elseif { $c != "QUICK" && [info exists world($conn($c,num),$i)]} { return $world($conn($c,num),$i); } else { set before [::Penn::before $i ,] set after [::Penn::after $i ,] global $before if { [info exists $before\($after\)]} { return [set $before\($after\)]; } return $d; } };# connInfo proc worldInfo {w i {d ""}} { global world # Return info about a world # First, try $world($w,$i) # Then, if $i is *,* try $() # Otherwise, return $d (defaults to nothing) if { [info exists world($w,$i)] } { return $world($w,$i); } else { set before [::Penn::before $i ,] set after [::Penn::after $i ,] global $before if { [info exists $before\($after\)] } { return [set $before\($after\)]; } } return $d; };# worldInfo proc connect2mush {n {name ""} {host ""} {port ""} {char ""} {pw ""}} { global world conn p quick # This actually just sets up ready for a connection. # connect2mushSub does the real work; we call it # at the end. It's seperate so that we can reconnect # via that. if { [llength $conn(off)] == "0" } { tk_messageBox -title [mc conn,errtitle $p(nick)] -icon warning \ -message [mc conn,limit] return; } set x [lrange $conn(off) 0 0] if { $n != "" } { # connecting to a defined world via a menu-click set m $world($n,info,name) set conn($x,num) $n set host $world($n,info,host) ; set conn($x,info,host) $host set port $world($n,info,port) ; set conn($x,info,port) $port set char $world($n,info,char) set pw $world($n,info,pw) } else { # connecting to a new world via 'Quick connect' set m $name set conn($x,info,name) "$name ([mc word,quick])" set conn($x,num) "QUICK" set conn($x,info,host) $host set conn($x,info,port) $port set conn($x,info,char) $char set conn($x,info,pw) $pw set conn($x,info,mush) $quick(type) } if { $host == "" || $port == "" } { set str [mc conn,invalid] if {$conn($x,num) == "QUICK"} { tk_messageBox -icon error -type ok -message $str \ -title [mc conn,errtitle $p(nick)] } else { set str "$str\n[mc conn,invalid2]" set ans [tk_messageBox -icon error -type yesno -message $str \ -title [mc conn,errtitle $p(nick)]] if { $ans == "yes" } {config $n} } return; } set conn(off) [lrange $conn(off) 1 end] lappend conn(on) $x set conn($x,idle) "0" set conn($x,upload,on) "0" set conn($x,sessiontime) "0" createFrame $x showFrame $x foreach z $conn(on) { if { $z != $x } { $conn($z,top).click add command -label "$x. $m" \ -command [list showFrame $x] } };# foreach z $conn(on) set msg [mc conn,ingto "$host:$port"] # Actually attempt the connection connect2mushSub "$x" "$msg" "$host" "$port" "$char" "$pw" "1" };# connect2mush proc connect2mushSub {x msg host port char pw {full 0}} { global conn if { [info exists conn($x,reconID)] } { after cancel $conn($x,reconID) unset conn($x,reconID) } if { $full == "1" } { # Put a newline, if it's a full connect putOut $x $msg 1 } else { putOut $x $msg 0 } update idletasks update if { [catch {socket -async $host $port} conn($x,id)] } { playSound [connInfo $x auto,dsound] putOut $x "$conn($x,id)" set conn($x,id) "" boot_reconnect $x return; } fileevent $conn($x,id) writable \ [list connect2mushVerify $conn($x,id) $x $msg $host $port $char $pw $full] };# connect2mushSub # some of the code for this -async verification (ok, most of it) # is taken from/based on http://mini.net/tcl/1114 proc connect2mushVerify {id x msg host port char pw full} { global conn if { [catch {fconfigure $id -error} err] || $err != "" } { catch {disconnect $x} playSound [connInfo $x auto,dsound] putOut $x "$err" boot_reconnect $x return; } fileevent $id writable {} fconfigure $id -translation binary -blocking 0 set peer [fconfigure $id -peername] if { [lindex $peer 0] == [lindex $peer 1] } { set str [lindex $peer 0] } else { set str "[lindex $peer 0] ([lindex $peer 1])" } putOut $x "[mc word,connected] - ${str}." playSound [connInfo $x auto,csound] if { [connInfo $x info,mush] == "1" } { fconfigure $id -buffering line } else { fconfigure $id -buffering none } fileevent $id readable "get_mushage $x" send_to $x [connInfo $x auto,before] \b 0 if { $char != "" && $pw != "" } { send_to $x "connect $char $pw" } send_to $x [connInfo $x auto,after] \b 0 timerStart $x # conn(limbo) is 'open' connections (we have a window for it # via createFrame) but currently disconnected. This will effect # whether you get prompted on exit. if { [set ll [lsearch -exact $conn(limbo) $x]] != "-1" } { set conn(limbo) [lreplace $conn(limbo) $ll $ll] } setState $x };# connect2mushVerify proc checkFile {f w} { # If file $f exists, set $w's -foreground to black # Otherwise, set it to red. Always return 1. if { [file exists $f] && [file isfile $f] } { $w configure -foreground black } else { $w configure -foreground red } return 1; };# checkFile proc openFileD {f {d ""}} { global p if { $d == "" } { set d $p(folder) } if { $f == "" || ![file exists $f] } { return $d; } if { [file isdirectory $f] } { return [file nativename [file normalize $f]]; } elseif { [file isfile $f] } { return [file nativename [file normalize [file dirname $f]]]; } };# openFileD proc openFileF {f} { if { $f == "" || ![file exists $f] || ![file isfile $f] } { return ""; } return [file tail $f]; };# openFileF proc reconnect {w {x ""} {msg ""}} { global conn # Reconnect to a MUSH if the connection's dead. # If it isn't dead, and both $x and $msg are given, # putOut $x $msg if { ![dead $w] } { # Connection isn't down. Abort. if {$x != "" && $msg != ""} { putOut $x $msg } return; } # Reconnect. (All $w's from here down were $conn(up)) set msg [mc recon,try] set ho [connInfo $w info,host] set po [connInfo $w info,port] set ch [connInfo $w info,char] set pw [connInfo $w info,pw] connect2mushSub "$w" "$msg" "$ho" "$po" "$ch" "$pw" 0 colorWorldToolbar $w };# reconnect proc stillConnecting {w} { global conn if { [fileevent $conn($w,id) writable] != "" } { return 1; } return 0; };# stillConnecting proc dead {w} { global conn # If $conn($w,*) is connected, return 0. # Otherwise, return 1. (ie: is the connection dead?) if { [catch {eof $conn($w,id)} eof] } { return 1; } if { [info exists conn($w,id)] && $conn($w,id) != "" && !$eof } { return 0; } else { return 1; } };# dead proc chkUnmap {} { global misc p if { $p(hasWinico) == "1" && $misc(minTray) == "1" \ && [wm state .] == "iconic"} { wm withdraw . } };# chkUnmap proc mail_config {c} { global mail set w .mail$c.f4.command.m if { ![winfo exists $w] } { menu $w -tearoff 0 \ -postcommand "mail_config $c" } $w delete 0 end foreach x [lsort -dictionary [array names mail *,name]] { set num [Penn::before $x ,] $w add command -label "$mail($x): $mail($num,style)" \ -command [list mail_set $c $num] } };# mail_config proc mail_set {c n} { global mail conn # Set the mail type for conn $c to number $n .mail$c.f4.command configure -text $mail($n,name) set conn($c,mail) $n };# mail_set proc mail_start {c} { global conn mail # Start sending mail for # connection $c set w .mail$c if { [winfo exists $w] } { wm deiconify $w raise $w focus $w return } toplevel $w wm withdraw $w wm resizable $w 0 0 wm protocol $w WM_DELETE_WINDOW "wm withdraw $w" wm title $w [mc mail,title "($c. [connInfo $c info,name])"] set f0 $w.f0 frame $f0 pack $f0 -pady 5 set f1 $w.f1 frame $f1 label $f1.l_to -text "[mc word,to]:" -width 8 entry $f1.e_to -width 20 set f2 $w.f2 frame $f2 label $f2.l_subject -text "[mc word,subject]:" -width 8 entry $f2.e_subject -width 20 pack $f1 -side top pack $f2 -side top pack $f1.l_to -side left pack $f1.e_to -side left pack $f2.l_subject -in $f2 -side left -anchor e -expand 1 -fill x -pady 5 pack $f2.e_subject -in $f2 -side left -anchor e set f3 $w.f3 frame $f3 frame $f3.1 text $f3.1.e_message -height 15 -width 55 -wrap word \ -yscrollcommand [list $f3.1.ysb set] \ -xscrollcommand [list $f3.2.xsb set] \ -font [$conn($c,top) cget -font] scrollbar $f3.1.ysb -command [list $f3.1.e_message yview] frame $f3.2 scrollbar $f3.2.xsb -command [list $f3.1.e_message xview] -orient horizontal pack $f3 -padx 5 -pady 3 pack $f3.1 pack $f3.1.e_message -in $f3.1 -side left -expand 1 -fill both pack $f3.1.ysb -side right -expand 1 -fill y pack $f3.2 -in $f3 -side left -expand 1 -fill x pack $f3.2.xsb -in $f3.2 -side left -expand 1 -fill x frame $f3.2.fill -width [winfo reqwidth $f3.1.ysb] pack $f3.2.fill -in $f3.2 -side right if { ![info exists conn($c,mail)] } { set conn($c,mail) 1 } set f4 $w.f4 frame $f4 label $f4.l_command -text [mc mail,style] menubutton $f4.command -text "" \ -direction below -menu $f4.command.m -relief raised \ -width 19 -relief sunken -borderwidth 1 \ -background "light green" \ -activebackground "#90a3ffff90a3" mail_set $c $conn($c,mail) # Alternate button colors (blue rather than green) # -activebackground #8787aaaaffff -background "sky blue" mail_config $c pack $f4 pack $f4.l_command -in $f4 -side left pack $f4.command -in $f4 -side left -pady 4 if { ![info exists conn($c,mailCR2)] } { set conn($c,mailCR2) {%r} set conn($c,mailCR) "1" } set f6 $w.f6 frame $f6 label $f6.l_line -text [mc mail,returns] checkbutton $f6.chk -variable conn($c,mailCR) \ -command "$f6.e_line configure \ -state \$p(wState,\$conn($c,mailCR)) $f6.l2 configure \ -state \$p(wState,\$conn($c,mailCR))" label $f6.l2 -text "[mc word,to]:" entry $f6.e_line -width 6 -textvariable conn($c,mailCR2) pack $f6 pack $f6.l_line -in $f6 -side left pack $f6.chk -in $f6 -side left pack $f6.l2 -in $f6 -side left pack $f6.e_line -in $f6 -side left -pady 3 set f5 $w.f5 frame $f5 button $f5.send -text [mc word,send] -underline 0 -default active \ -width 8 -command [list mail_send $c] bind $w [list $f5.send invoke] set cmd "set ans \[tk_messageBox -type yesno \ -title \"\[mc mail,cleart\]\" -parent $w \ -message \"\[mc mail,clearb\]\"\]" set cmd2 "if \{ \$ans == \"yes\" \} \{ mail_clear $c \}" set cmd "$cmd ; $cmd2" button $f5.clear -text [mc word,clear] -underline 0 \ -width 8 -command $cmd bind $w [list $f5.clear invoke] button $f5.close -text "[mc word,close] " -width 11 \ -command [list wm withdraw $w] pack $f5 -anchor s pack $f5.clear -in $f5 -side left -padx 2 -pady 2 pack $f5.send -in $f5 -side left -padx 2 -pady 2 pack $f5.close -in $f5 -side left -padx 2 -pady 2 bind $w [list $f5.close invoke] update center $w update wm deiconify $w raise $w focus $w update };# mail_start proc mail_clear {c {m 1} {t 0} {s 0}} { global conn mail # For connection $c, clear the mail window message. # $m = clear body? $t = to, $s = subject set win .mail$c if { $m == "1" } { $win.f3.1.e_message delete 1.0 end } if { $t == "1" } { $win.f1.e_to delete 0 end } if { $s == "1" } { $win.f2.e_subject delete 0 end } };# mail_clear proc mail_send {c} { global conn mail set win .mail$c if { ![info exists conn($c,mail)] } { set conn($c,mail) 1 } set style $mail($conn($c,mail),style) set style [string map {;; \b} $style] set msg [$win.f3.1.e_message get 1.0 end-1c] set to [$win.f1.e_to get] set subj [$win.f2.e_subject get] if { $conn($c,mailCR) } { set msg [string map "\\n $conn($c,mailCR2)" $msg] } # %0 = ADDR, %1 = SUBJ, %2 = TEXT set cmd [string map [list %0 $to %1 $subj %2 $msg] $style] send_mushage2 $cmd $c 0 \b mail_clear $c 1 1 1 wm withdraw $win };# mail_send proc toplevel_init {pf} { # $pf = $tcl_platform(platform) # If necessary, set us up to set the icon for # all windows after we create them. Not needed # on MS Win, as wm iconbitmap has -default. # This means, on non-Win, [toplevel] takes only # a window arg; so, use: # toplevel $win # $win configure -arg val -arg2 val2 # to give options if { $pf == "windows" } {return;} rename toplevel toplevelOrig proc toplevel {w} { global p eval "toplevelOrig [list $w]" wm iconbitmap $w $p(icon) if { [info exists p(iconwindow)] } { wm iconwindow $w $p(iconwindow) } return $w; } };# toplevel_init proc flashBar_init {pf} { global p if { $pf == "windows" && $p(hasWinflash) } { proc flashBar {} { winflash . -count 3 -appfocus 1 } } else { proc flashBar {} { wm deiconify . } } };# flashBar_init proc setCursor_init {} { global p # Set up the Cursor info. Platform-specific, and run # at startup only :) set hand 0 ; set harrow 0 ; set varrow 0 if { $p(platform) == "windows" } { foreach x {hand harrow varrow} { set f $p(cursor-${x}W) if { [file exists $f] } { set $x 1 } };# foreach x };# if platform == windows foreach x {hand harrow varrow} { if { [set $x] } { set p(cursor-$x) "@$p(cursor-${x}W)" } else { set p(cursor-$x) $p(cursor-${x}B) } } };# setCursor_init proc setIcon_init {} { global p # Set up some icon stuff. Platform-specific, and run at # startup only :) image create photo ::img::potatoicon -data { R0lGODlhIAAgAKIAANnZ2f8AAP//AICAgAAAAMDAwP///////yH5BAEAAAAA LAAAAAAgACAAAAPvCLrcDigQdLn9FQpB0OX2V0gEQZfbH6AQCQRdbm80EyKB oMvtjQYgAkGX2xnNIOhy+wM0g6DL7a/QDIIut79CMwi63P4KzSDocvsj0iUE XW5XRFqlqgh0uRuJqlRVEQS63ItEVaqqFEGgyw1IVIWky4ugy0xIVUi63Ai6 vIRVSLrchKDLSkiFpMu9CLoMhFRIutyLoMuApMvtCLoMSLrcjqDLgKTL7Qi6 DEi63I6gy4Cky+0IuqxIutyERoSgy4uky21oRAi6zEi6vIZGhKDLDUi6bIZG hKDLvUi6aoakCLrcjaTLhKDL7YpIlxB0WRMAOw== };# image create photo ::img::potatoicon if { $p(platform) != "windows" } { set win 0 set flag "" } else { set flag "-default" set fail "0" if { [file exists $p(iconW)] } { set win 1 } elseif { $p(hasImg) } { [imageFor potatoicon] write $p(iconW) -format icon set win 1 } else { set win 0 set fail "1" } if { $p(hasWinico) == "1" && !$fail } { set winico [winico_seticon . $p(iconW)] winico taskbar add $winico \ -callback {winicoCallback %m %x %y} -text "$p(name)" set m [menu .winicoPopup -tearoff 0] $m add command -label "[mc word,restore]" \ -command {winicoCallback WM_LBUTTONUP} set fontB [fonts_Aname [$m cget -font]] set font0 [lindex $fontB 0] set font1 [lindex $fontB 1] set font2 [linsert [lindex $fontB 2] end bold] set font [list $font0 $font1 $font2] $m entryconfigure 0 -font $font $m add command -label "[mc word,exit]" -command {chk_exit} } } if { $win } { set icon iconW image delete ::img::potatoicon } else { set icon iconB } set p(icon) $p($icon) if { !$win } { set w .toplevelIconWindow toplevel $w wm withdraw $w label $w.l -image [imageFor potatoicon] pack $w.l -side left -anchor w catch {wm iconwindow . $w} } };# setIcon_init proc winicoCallback {t {x 0} {y 0}} { if { $t == "WM_LBUTTONUP" } { wm deiconify . raise . focus . } elseif { $t == "WM_RBUTTONUP" } { .winicoPopup post $x $y .winicoPopup activate 0 } };# winicoCallback proc imageFor {x {on "1"}} { if { $on } {set on Y} else {set on N} if { [catch {image type ::img::$x$on}] } { return ::img::$x; } else { return ::img::$x$on; } };# imageFor proc lbAdd {w} { # Something just happened on $w. # If it doesn't have the focus, make sure # it's shown to be active -- ie, give it an entry # in the listbox in the bottom-right. global conn pane p misc set retval "0" # If we flash icons, etc, this is somewhere it would # get initiated if { [focus -displayof .] == "" } { set retval "1" if { $misc(flashTaskBar) == "1" } { flashBar } playSound [connInfo $w auto,asound] } if { $conn(up) == $w } { # We're already there. :) return $retval; } if { $misc(actworld) == "1" && $conn($w,idle) == "0" } { putOut $conn(up) "-- [mc world,active "($w. [connInfo $w info,name])"] --" 0 1 } if { [lsearch $conn(on) $w] == "-1" } { return $retval; } if { [lsearch $conn(waiting) $w] == "-1" } { lappend conn(waiting) "$w. [connInfo $w info,name]" set conn(waiting) [lsort -dictionary -index 0 -unique $conn(waiting)] return "1" } };# lbAdd namespace eval soundlist {} proc playSound {f} { global p # Play the sound file $f if we can. if { $p(hasSnack) != "1" } { # No Snack. We can't do sounds. return; } if { $f == "" || ![file exists $f] || ![file readable $f] } { return; } set secs [clock clicks] catch {snack::sound ::soundlist::${secs}sound -file $f} catch {::soundlist::${secs}sound play -block 0 \ -command [list ::soundlist::${secs}sound destroy]} };# playSound proc gagcheck {n s c} { global world gags conn # for world number $n, check if we should # gag or alter the string $s # $c is the connection, for checking if it's active (a la #8) # (the string to check itself goes here) # 1: Gag from display? # 2: Omit from (partial) log? # 3: FG Color # 4: BG Color # 5: Sound file to play (if available) # 6: String to send to MUSH. # 7: Match type -- 1 (case sensitive) or (case insensitive) # 8: Run type -- 1 (all the time) or 0 (only if world isn't active) # 9: Put it into the pop-up window for the connection? set go [list {} {} {} {} {} {} {} {} {} {} {} {} {} {}] if { ![info exists gags($n)] || $gags($n) == "" } { return $go; } if { [focus -displayof .] == "" || $conn(up) != $c } { set active 0 } else { set active 1 } foreach x $gags($n) { set arg8 [lindex $x 8] if { [lindex $x 7] == "1" } { set nocase "-line" } else { set nocase "-nocase" };# if if {[catch {regexp -line $nocase -- [lindex $x 0] $s -> \ f(0) f(1) f(2) f(3) f(4) f(5) \ f(6) f(7) f(8) f(9)} matched]} { continue; } if { $matched == "1" && ($active || $arg8) } { set arg6 [string map [list %0 $f(0) %1 $f(1) %2 $f(2) \ %3 $f(3) %4 $f(4) %5 $f(5) \ %6 $f(6) %7 $f(7) %8 $f(8) \ %9 $f(9)] [lindex $x 6]] set go [lreplace [lrange $x 1 end] 5 5 $arg6] };# if };# foreach return $go; };# gagcheck proc newAct {w} { global misc conn if { $misc(newact) == "0" || $conn($w,idle) != "0" } { return 0; } if { $conn(up) != "$w" || [focus -displayof .] == "" } { return 1; } return 0; };# newAct proc get_mushage {w} { global conn pane p misc if { $conn($w,id) == "" } { return; } if { [eof $conn($w,id)] } { disconnect $w return; } if { [connInfo $w info,mush] == "1" } { set disco [catch {gets $conn($w,id) text}] } else { set disco [catch {read $conn($w,id)} text] } if { $disco } { disconnect $w boot_reconnect $w return; } set log $conn($w,partial) if { $log } { set logf $conn($w,partialID) } if { $text == "" } {return;} set conn($w,sbp) [see_end $w] if { [info exists conn($w,newlineAt)] } { set newlineAt $conn($w,newlineAt) unset conn($w,newlineAt) } regsub -all {\r} $text "" text regsub -all {.*?m} $text "" noansi set gagcols [gagcheck $conn($w,num) $noansi $w] for {set i 0} {$i < 20} {incr i} { set gagarg($i) [lindex $gagcols $i] } set newAct [newAct $w] set line "------------" if { $log && $newAct && $gagarg(1) != "1" } { puts $logf " $line New Activity $line" } set newActShow "$line [mc world,newact] $line" set newActTags "sysfont center" if { $gagarg(4) != "" } { playSound $gagarg(4) } if { $gagarg(5) != "" } { send_mushage2 $gagarg(5) $w } if { $log && $gagarg(1) != "1" } { puts $logf $noansi flush $logf } if { $gagarg(0) == "1" } return; lbAdd $w set conn($w,idle) 1 colorWorldToolbar $w set gagfg $gagarg(2) set gagbg $gagarg(3) if { ![string match "**" $text] } { if { $newAct && !($text == "" && [connInfo $w top,empty]) } { $conn($w,top) insert end "\n" $conn($w,top) insert end $newActShow $newActTags } if { $gagfg == "" } { set gagfg $conn($w,getmush,tagfg) } if { $gagbg == "" } { set gagbg $conn($w,getmush,tagbg) } set taglist "margins $conn($w,getmush,underline) $conn($w,getmush,flash) $gagfg $gagbg" if { $text == "" } { set index [$conn($w,top) index end-2chars] $conn($w,top) insert end "\n" "$taglist" $conn($w,top) tag add newline $index end lappend conn($w,newlineAt) [$conn($w,top) index end] } else { $conn($w,top) insert end "\n" $conn($w,top) insert end "${noansi}" $taglist } } else { set insertVal "" set string "" set newLineChar "\n" array set tag [string map "$w,getmush, {}" [array get conn $w,getmush,*]] for {set i 0} "\$i < \"[string length $text]\"" {incr i} { set char [string index $text $i] if { $char == "" } { if { $string != "" } { set ansilist $tag(list) if { $gagfg != "" } { set ansilist [lreplace $ansilist 0 0 $gagfg] } if { $gagbg != "" } { set ansilist [lreplace $ansilist 1 1 $gagbg] } lappend insertVal "$string" "$ansilist margins" set string "" } set string "" incr i 2 set code "" while {1} { set char [string index $text $i] if { $char == "m" } { set char [string index $text $i] break; } set code "$code$char" incr i };# while 1 foreach cd [split $code \;] { array set tag [get_mushageSub $cd "[array get tag]"] } } else { set string "$string$char" };# if char == };# for set ansilist $tag(list) if { $gagfg != "" } { set ansilist [lreplace $ansilist 0 0 $gagfg] } if { $gagbg != "" } { set ansilist [lreplace $ansilist 1 1 $gagbg] } if { $string != "" } { lappend insertVal "$string" "$ansilist margins" } foreach x [array names tag] { set conn($w,getmush,$x) $tag($x) } if { $newAct } { $conn($w,top) insert end "\n" $conn($w,top) insert end $newActShow $newActTags } $conn($w,top) insert end $newLineChar margins set newLineChar "" if { $insertVal != "" } { eval "$conn($w,top) insert end $insertVal" } update idletasks };# if string match if { $conn($w,sbp) == "1" } { $conn($w,top) yview moveto 1 update idletasks } if { [info exists newlineAt] } { foreach elem $newlineAt { $conn($w,top) tag add newline "$elem-1char" $elem } } };# get_mushage proc get_mushageSub {code tagI {gagfg ""} {gagbg ""}} { global ansi array set tag $tagI switch -glob $code { 0 { set tag(fg) normalfg set tag(bg) normalbg set tag(underline) "" set tag(flash) "" set tag(hilite) "" } 1 { if { $tag(hilite) != "-h" } { set tag(hilite) "-h" set tag(bg) "$tag(bg)-h" set tag(fg) "$tag(fg)-h" } } 3? { set tag(fg) "$ansi($code)$tag(hilite)"} 4? { set tag(bg) "$ansi($code)$tag(hilite)"} 4 { set tag(underline) TAG_UNDERLINE} 5 { set tag(flash) TAG_FLASH} 7 { set temp $tag(fg) set tag(fg) $tag(bg) set tag(bg) $temp } } switch -glob $tag(fg) { normalfg {set tag(tagfg) FG_NORMAL} normalfg-h {set tag(tagfg) FG_HILITE} normalbg* {set tag(tagfg) FG_BG} default {set tag(tagfg) [string toupper FG_ANSI_$tag(fg)]} } switch -glob $tag(bg) { normalbg* {set tag(tagbg) BG_NORMAL} normalfg {set tag(tagbg) BG_FG_NORMAL} normalfg-h {set tag(tagbg) BG_FG_HILITE} default {set tag(tagbg) [string toupper BG_ANSI_$tag(bg)]} } set tag(list) [string trim "$tag(tagfg) $tag(tagbg) $tag(underline) $tag(flash)"] return [array get tag]; };# get_mushageSub proc center {win} { # Center window $win on the screen set w [winfo width $win] set h [winfo height $win] set sh [winfo screenheight $win] set sw [winfo screenwidth $win] set reqX [expr {($sw-$w)/2}] set reqY [expr {($sh-$h)/2}] wm geometry $win +$reqX+$reqY update idletasks after 10 return; };# center proc chk_exit {{full 0}} { global p conn misc set worlds [::Penn::setdiff $conn(on) $conn(limbo)] set msg "" if { $worlds != "" } { set msg "[mc exit,active]\ " set full 0 } set msg "${msg}[mc exit,confirm]" if { $full == "1" || $misc(chkexit) == "0" \ || [tk_messageBox -title $p(name) \ -type yesno -icon question \ -message $msg] == "yes"} { savePrefs saveWorldPrefs if { $p(hasWinico) == "1" } { # Close down the Winico icons. First, set a diff. # icon for '.', then delete all icons wm iconbitmap . -default {} winico_delall } exit } };# chk_exit proc setupConnZero {{show 1}} { global p conn pane world # Set up $conn(0,top) depending on if there are defined worlds. # Clear "world 0"'s top screen and insert a message. We don't # use putOut here. $conn(0,top) delete 1.0 end set credit "$p(name) [mc word,ver] $p(version)\n[mc about,out]" $conn(0,top) insert end $credit sysfont set col [revColor [$conn(0,top) cget -background]] $conn(0,top) tag configure quickConnect -foreground $col \ -underline 1 set curBind [list $conn(0,top) configure -cursor] $conn(0,top) tag bind quickConnect "$curBind $p(cursor-hand)" $conn(0,top) tag bind quickConnect "$curBind {}" $conn(0,top) tag bind quickConnect {quickConnect} if { ![info exists world(good)] || $world(good) == "" } { set msg "\n\n[mc zero,none1]" $conn(0,top) insert end $msg sysfont $conn(0,top) tag configure addNewWorld -foreground $col \ -underline 1 $conn(0,top) tag bind addNewWorld "$curBind $p(cursor-hand)" $conn(0,top) tag bind addNewWorld "$curBind {}" $conn(0,top) tag bind addNewWorld {addNewWorld1} $conn(0,top) insert end "[mc zero,none2]" addNewWorld $conn(0,top) insert end [mc zero,none3] sysfont $conn(0,top) insert end [mc zero,none4] quickConnect $conn(0,top) insert end [mc zero,none5] sysfont $pane(bar).0.connect configure -state disabled -image [imageFor connect 0] .menu.f entryconfigure 0 -state disabled } else { $pane(bar).0.connect configure -state normal -image [imageFor connect 1] .menu.f entryconfigure 0 -state normal set wlist [lsort -command worldNumsByName $world(good)] $conn(0,top) insert end "\n\n[mc zero,defined]" .menu.f.c delete 0 end .tb.0.connect.menu delete 0 end foreach i $wlist { set x $world($i,info,name) .menu.f.c add command -label $x -command [list connect2mush $i] .tb.0.connect.menu add command -label $x -command [list connect2mush $i] $conn(0,top) tag configure worldLink$i -foreground $col -underline 1 $conn(0,top) tag bind worldLink$i "$curBind $p(cursor-hand)" $conn(0,top) tag bind worldLink$i "$curBind {}" $conn(0,top) tag bind worldLink$i [list connect2mush $i] $conn(0,top) insert end "\n\n" $conn(0,top) insert end "$x" worldLink$i if { [info exists world($i,info,desc)] && $world($i,info,desc) != "" } { $conn(0,top) insert end " - $world($i,info,desc)" } };# foreach y [array names world *,info,name] $conn(0,top) insert end "\n\n[mc zero,alt1]" sysfont $conn(0,top) insert end [mc zero,alt2] quickConnect $conn(0,top) insert end [mc zero,alt3] sysfont };# if info exists world(0,info,name) $conn(0,top) tag raise sel if { $show } { showFrame 0 } };# setupConnZero proc setupWorldList {} { global p conn world gags timers # Runs at startup (and only at startup!). Sets up initial # pre-defined world list. 'main' is always run first set files [glob -nocomplain -join $p(worlds) world*.ini] set world(list) "" set world(good) "" if { $files == "" } { return; } set head {} foreach x $files { if {![catch {open $x} id]} { set i [file rootname [file tail $x]] set i [string range $i 5 end] while {![eof $id]} { gets $id var set fstChr [string range $var 0 1] if { $var == "" || $fstChr == "#" || \ $fstChr == "" || $fstChr == "=" } { continue; } if {[string match -nocase {\[*\]} $var]} { set head [string tolower [string range $var 1 end-1]] continue; } set varn [string first = $var] set tempX [string range $var [expr $varn+1] end] set tempY [string range $var 0 [expr $varn-1]] if { $tempY == "" || $tempY == ""} {continue;} set world($i,$head,$tempY) $tempX };# while !eof close $id # set a decoded password set world($i,info,pw) [codePW $world($i,info,pw) decode] # create fonts for this world eval "font create font$i.0 [font actual $world($i,top,font)]" lappend world(list) $world($i,info,name) lappend world(good) $i ;# this is non-deleted worlds set gagf [file join $p(gags) gags$i.ini] if {[file exists $gagf] && [file readable $gagf]} { set gags($i) "" set id [open $gagf] while {![eof $id]} { if {![string equal -length 1 [set new [gets $id]] #]\ && [string length $new] != "0" } { lappend gags($i) $new } };# while !eof $id close $id };# if file exists $gagf set timef [file join $p(timers) timer$i.ini] if {[file exists $timef] && [file readable $timef] } { set timers($i) "" set id [open $timef] while {![eof $id]} { if {![string equal -length 1 [set new [gets $id]] #]\ && [string length $new] != "0"} { lappend timers($i) $new } };# while !eof $id close $id };# if file exists $timef };# if catch open $x id };# foreach x $files };# setupWorldList proc saveWorldPrefs {{w ""}} { global p world gags timers # If $w is given, just update that worlds pref-file. # Otherwise, do the whole shebang (delete all old, set all # new files down...) Either way, update Gags file, too. # And Timers file, now that we have those :) if {$w == ""} { if { ![info exists world(good)] } {return;} foreach x [glob -nocomplain [file join $p(worlds) world*.ini]] { catch {file delete -force $x} } foreach x [glob -nocomplain [file join $p(gags) gags*.ini]] { catch {file delete -force $x} } foreach x [glob -nocomplain [file join $p(timers) timer*.ini]] { catch {file delete -force $x} } set w $world(good) } foreach i $w { # We want to store the encoded password... set tempPW $world($i,info,pw) set world($i,info,pw) [codePW $tempPW encode] set id [open [file join $p(worlds) world$i.ini] w+] puts $id "# This is a $p(nick) World Definition File." puts $id "# It is recommended you do not edit this file directly\;" puts $id "# Edit the preferences from inside $p(nick) to make changes." puts $id "# Created at time ID [clock seconds] by version $p(version)" set head {} foreach x [lsort -dictionary [array names world $i,*]] { set split [split $x ,] set sub [lindex $split 1] ; set item [lindex $split 2] if { $sub == "" } {continue;} if {$sub != $head} { puts $id "\n\[[string totitle $sub]\]" set head $sub } puts $id "$item=$world($x)" };# foreach x close $id set id [open [file join $p(gags) gags$i.ini] w+] puts $id "# This is a $p(name) World Gag File." puts $id "# It is recommended you do not edit this file directly\;" puts $id "# Edit the preferences from inside $p(nick) to make changes." puts $id "# Created at time ID [clock seconds] by version $p(version)" if { [info exists gags($i)] && $gags($i) != "" } { foreach x $gags($i) { puts $id $x };# foreach x $gags($i) };# if $gags($i) != "" puts $id "# End Of Gags" close $id set id [open [file join $p(timers) timer$i.ini] w+] puts $id "# This is a $p(name) World Timer File." puts $id "# It is recommended you do not edit this file directly\;" puts $id "# Edit the preferences from inside $p(nick) to make changes." puts $id "# Created at time ID [clock seconds] by version $p(version)" if { [info exists timers($i)] && $timers($i) != "" } { foreach x $timers($i) { puts $id $x } };# if $timers($i) != "" puts $id "# End of Timers" close $id # Now, lets get the decoded password saved again in the var set world($i,info,pw) $tempPW };# foreach i $list };# saveWorldPrefs proc codePW {pw dir} { # $pw is a string, and $dir is encode or decode. # Return the password with appropriate encoding. # This is very basic, and just maps letters and numbers, # with a basic randomness (well... it always uses the same pattern # to swap, but it was random the first time I made it:P) # Just to provide some basic encryption. Does nothing to punctuation. if { $dir == "encode" } { set go "b 3 c s d X e N f b g 8 h G i W j w k h l M m k" set go "$go n g o F p z q p r o s d t c u U v D w f" set go "$go x a y E z A A Y B O C n D x E L F v G 0" set go "$go H q I V J S K j L 4 M 5 N I O T P R Q Z" set go "$go R C S H T 7 U u V l W y X P Y 2 Z Q 0 i" set go "$go 1 t 2 m 3 B 4 1 5 6 6 r 7 9 8 J 9 e a K" set go "$go b 3 c s d X e N f b g 8 h G i W j w k h" set go "$go l M m k n g o F p z q p r o s d t c u U" set go "$go v D w f x a y E z A A Y B O C n D x E L" set go "$go F v G 0 H q I V J S K j L 4 M 5 N I O T" set go "$go P R Q Z R C S H T 7 U u V l W y X P Y 2" set go "$go Z Q 0 i 1 t 2 m 3 B 4 1 5 6 6 r 7 9 8 J" } else { set go "3 b s c X d N e b f 8 g G h W i w j h k M l k m" set go "$go g n F o z p p q o r d s c t U u D v f w" set go "$go a x E y A z Y A O B n C x D L E v F 0 G" set go "$go q H V I S J j K 4 L 5 M I N T O R P Z Q" set go "$go C R H S 7 T u U l V y W P X 2 Y Q Z i 0" set go "$go t 1 m 2 B 3 1 4 6 5 r 6 9 7 J 8 e 9 K a" set go "$go 3 b s c X d N e b f 8 g G h W i w j h k" set go "$go M l k m g n F o z p p q o r d s c t U u" set go "$go D v f w a x E y A z Y A O B n C x D L E" set go "$go v F 0 G q H V I S J j K 4 L 5 M I N T O" set go "$go R P Z Q C R H S 7 T u U l V y W P X 2 Y" set go "$go Q Z i 0 t 1 m 2 B 3 1 4 6 5 r 6 9 7 J 8" } return [string map $go $pw]; };# codePW proc resizeHandle {w} { # Setup a 'Resize Handle' in the bottom right corner # of the screen. This is taken from the TCL Wiki @ # http://mini.net/tcl/4553 # with minor changes (var names, etc), but it's still the same code. # You can't actually resize the widget with the handle, because # (although the code allowed it) it looks very different from # the standard OS resizing. But having the glyph looks good :) if { $w == "." } { set x .handle } else { set x $w.handle } # Don't display a resize cursor, because clicking it won't let you resize canvas $x -bg SystemButtonFace -width 14 -height 14 foreach i {3 7 11} { # -width 2 means 2point on win98 and 2pixel on w2k $x create line [expr $i+2] 16 16 [expr $i+2] \ -width 1 -fill SystemButtonShadow $x create line [expr $i+1] 16 16 [expr $i+1] \ -width 1 -fill SystemButtonShadow $x create line $i 16 16 $i \ -width 1 -fill SystemButtonHighlight } pack $x -side right -anchor se return $x; };# resizeHandle proc addEditWorlds {} { global aew # A re-write for 'Configure Worlds' in the # file menu, AKA 'Add/Edit Worlds' set w .aew if { [winfo exists $w] } { wm deiconify $w raise $w focus $w return; } toplevel $w wm withdraw $w wm title $w [mc conf,w,title] wm resizable $w 0 0 pack [frame $w.t] -side top -pady 5 -padx 5 -ipadx 5 \ -expand 1 -fill both pack [frame $w.b] -side bottom -ipady 5 -padx 5 -ipadx 5 pack [frame $w.t.l] -side left pack [frame $w.t.r] -side right label $w.t.l.label -text "[mc word,worlds]:" -justify left -anchor w frame $w.t.l.lb set lb $w.t.l.lb.box listbox $lb -height 8 -width 30 \ -selectmode single \ -yscrollcommand "$w.t.l.lb.bar set" scrollbar $w.t.l.lb.bar -command [list $lb yview] \ -orient vertical pack $w.t.l.label -side top pack $w.t.l.lb -side bottom pack $w.t.l.lb.box -side left -expand 1 -fill both pack $w.t.l.lb.bar -side right -expand 1 -fill y label $w.t.r.host -text "[mc word,host]: " -width 30 -justify left -anchor w label $w.t.r.port -text "[mc word,port]: " -width 30 -justify left -anchor w label $w.t.r.char -text "[mc word,char]: " -width 30 -justify left -anchor w pack $w.t.r.host -side top -pady 6 -anchor w pack $w.t.r.port -side top -pady 6 -anchor w pack $w.t.r.char -side top -pady 6 -anchor w set aew(wl) [addEditWorldsLB $lb] bindtags $lb "Listbox $lb [winfo toplevel $lb] all" button $w.b.add -text " [mc conf,w,add] " -underline 1 -default active \ -command "addNewWorld1 ; destroy $w" button $w.b.edit -text " [mc word,edit] " -underline 1 \ -command [list addEditWorldsHandle $w Edit $lb] button $w.b.del -text " [mc conf,w,delete] " -underline 1 \ -command [list addEditWorldsHandle $w Delete $lb 0] button $w.b.con -text " [mc word,connect] " -underline 1 \ -command [list addEditWorldsHandle $w Connect $lb] button $w.b.clo -text " [mc word,close] " -underline 2 \ -command [list destroy $w] pack $w.b.add $w.b.edit $w.b.del $w.b.con $w.b.clo -padx 5 -side left bind $w [list $w.b.add invoke] bind $w [list $w.b.add invoke] bind $w [list $w.b.edit invoke] bind $w [list $w.b.del invoke] bind $w [list $w.b.con invoke] bind $w [list $w.b.clo invoke] bind $w [list $w.b.clo invoke] set cmd [list addEditWorldsFrame $lb $w.t.r.host $w.t.r.port $w.t.r.char] bind $lb $cmd update center $w wm deiconify $w raise $w focus $w update };# addEditWorlds proc addEditWorldsHandle {w a b {dest 1}} { global world aew conn # $w = window, $a = action, $b = listBox, $dest = destroy $w? set sel [$b curselection] if { $sel == "" } { bell -displayof $b return; } set wld [lindex $aew(wl) $sel] if { $dest } { destroy $w set parent "." } else { set parent $w } if { $a == "Edit" } { config $wld } elseif { $a == "Delete" } { set msg [mc conf,w,suredel $world($wld,info,name)] set ans [tk_messageBox \ -title [mc conf,w,title] -type yesno \ -message $msg -icon question -parent $parent] if { $ans == "no" } return; set world(good) [::Penn::setdiff $world(good) $wld] setupConnZero 0 addEditWorldsLB $b } elseif { $a == "Connect" } { connect2mush $wld } else { tk_messageBox -title "[mc word,error]" -icon error -type ok \ -message [mc error] } };# addEditWorldsHandle proc addEditWorldsFrame {box h p c} { global world aew set sel [$box curselection] set ho "[mc word,host]: " set po "[mc word,port]: " set ch "[mc word,char]: " if { $sel != "" } { set w [lindex $aew(wl) $sel] set ho "$ho$world($w,info,host)" set po "$po$world($w,info,port)" set ch "$ch$world($w,info,char)" } $h configure -text $ho $p configure -text $po $c configure -text $ch };# addEditWorldsFrame proc addEditWorldsLB {w} { global world set list [lsort -command worldNumsByName $world(good)] $w delete 0 end foreach x $list { $w insert end $world($x,info,name) } return $list; };# addEditWorldsLB proc worldNumsByName {a b} { global world set x [string compare $world($a,info,name) $world($b,info,name)] return $x; };# worldNumsByName proc addNewWorld1 {} { global p set w .anw1 if { [winfo exists $w] } { wm deiconify $w raise $w focus $w return; } toplevel $w wm title $w "$p(nick): [mc anw,title]" wm withdraw $w wm resizable $w 0 0 frame $w.top label $w.top.l -text [mc anw,entername] pack $w.top -pady 4 pack $w.top.l frame $w.mid entry $w.mid.e -textvariable name -width 35 pack $w.mid -pady 4 -padx 8 pack $w.mid.e frame $w.btm button $w.btm.ok -text [mc word,ok] -width 11 -default active \ -underline 0 -command "addNewWorld2 \$name $w" button $w.btm.cancel -text [mc word,cancel] -width 11 -underline 0 \ -command "set name {}; destroy $w" pack $w.btm -padx 8 -pady 4 pack $w.btm.ok $w.btm.cancel -padx 5 -side left bind $w [list $w.btm.ok invoke] bind $w [list $w.btm.ok invoke] bind $w [list $w.btm.cancel invoke] bind $w [list $w.btm.cancel invoke] update center $w wm deiconify $w raise $w focus $w update focus $w.mid.e };# addNewWorld1 proc addNewWorld2 {n w} { global p world conn misc # $n is the new world name, $w the window for selection set upper [string toupper $n] set upperL [string toupper $world(good)] if {[lsearch -exact $upperL $upper] != "-1"} { wm withdraw $w tk_messageBox -icon error -title "$p(nick): [mc anw,title]" \ -message [mc anw,exists] wm deiconify $w return; } catch {destroy $w} global top ansi text pane set i [regsub -all {[^0-9 ]} [array names world *,info,name] {}] set i [lindex [lsort -integer [linsert $i 0 0]] end] incr i set world($i,info,name) $n lappend world(good) $i # Default options start getting set here. foreach x {font bg fg echo} { if { [info exists top($x)] } { set world($i,top,$x) $top($x) } };# foreach x foreach x [array names ansi *-h] { set world($i,ansi,$x) $ansi($x) set bef [::Penn::before $x -h] set world($i,ansi,$bef) $ansi($bef) } set world($i,ansi,use-ansi) $ansi(use-ansi) set world($i,ansi,use-flash) $ansi(use-flash) set world($i,misc,hl) $misc(hl) foreach x {emit pose say ooc} { set world($i,text,$x) $text($x) } foreach x {bottom1p bottom2p indent linewrap sidep topp} { set world($i,pane,$x) $pane($x) } # Make sure these defaults are set foreach x {host port char pw desc} { set world($i,info,$x) "" } set world($i,info,mush) "1" catch {font create font$i.0} eval "font configure font$i.0 [font actual $world($i,top,font)]" saveWorldPrefs $i setupConnZero 0 config $i };# addNewWorld2 proc EntryInsertChar {w a} { # A replacement binding for Entry widgets # The if{} catches , etc if { $a != ""} { catch {$w delete sel.first sel.last} $w insert insert $a } tk::EntrySeeInsert $w };# EntryInsertChar proc mouseWheel {w x y d} { set in [winfo containing -displayof $w $x $y] if { $in == "" || [winfo class $in] != "Text" } { $w yview scroll [expr {- ($d / 120) * 4}] units } else { $in yview scroll [expr {- ($d / 120) * 4}] units } };# mouseWheel proc bindText {} { global p # should only be run once. foreach x {b f p n a d k o x t} { bind Text {} } bind Entry {tk::CancelRepeat EntryInsertChar %W %A } bind Text {mouseWheel %W %X %Y %D} bind TextOut {break;} bind TextOut {break;} bind TextOut {break;} bind TextOut {break;} bind TextOut {break;} bind TextOut {break;} bind TextOut {break;} bind TextOut {break;} bind TextOut {break;} bind TextOut {break;} bind TextOut {break;} bind TextOut <> {break;} bind TextOut <> {break;} bind TextOut <> {checkTextCut %W ; break} set bg {if { ([string match ".p.pane0.childsite.*" %W] && \ [string match 0 $p(textEdit)]) || [string match \ .p.pane0.childsite*.0 %W] } { continue } else } set bg "$bg \{ [bind Text ] \}" bind Text $bg bind TextOut <> {markSel %W} bind TextOut {break;} # bind TextOut {break;} bind TextOut {break;} bind TextAlias <> {%W yview scroll -1 pages; break} bind TextAlias <> {%W yview scroll 1 pages; break} bind TextAlias <> {%W yview scroll -1 units; break} bind TextAlias <> {%W yview scroll 1 units ; break} bind TextAlias <> {%W see 1.0} bind TextAlias <> {%W see end} # And now for Input windows. . . bind TextIn { if { [%W compare insert == 1.0] } { event generate $conn($conn(up),top) <> ; break } };# up bind TextIn { if { [%W compare insert == end-1char] } { event generate $conn($conn(up),top) <> ;# break } };# down array set dir { 0 down 1 southwest 2 south 3 southeast 4 west 5 up 6 east 7 northwest 8 north 9 northeast } set str {if { $misc(dirPad) && %k != %N } { send_mushage2 DIR $conn(up) ; break }} set str2 {if { $misc(dirPad) } { send_mushage2 DIR $conn(up) ; break}} foreach x {0 1 2 3 4 5 6 7 8 9} { bind TextIn [string map "DIR $dir($x)" $str] bind TextIn [string map "DIR $dir($x)" $str2] } # PageUp/PageDown in an entry do it for the top-box. # Control-PageUp/Down do it in the box you're in. set norm(next) [bind Text ] set norm(prior) [bind Text ] bind Text {set tempconf(%W,next) [%W index insert];} bind Text "+$norm(next)" set var "if \{ \$tempconf(%W,next) == \[%W index insert\] \} \{ \ tk::TextSetCursor %W end-1char\ \}" bind Text "+$var ; break" bind Text {set tempconf(%W,prior) [%W index insert];} bind Text "+$norm(prior)" set var "if \{ \$tempconf(%W,prior) == \[%W index insert\] \} \{ \ tk::TextSetCursor %W 1.0\ \}" bind Text "+$var ; break" set shift(next) [bind Text ] set shift(prior) [bind Text ] bind Text {set tempconf(%W,snext) [%W index insert];} bind Text "+$shift(next)" set var "if \{ \$tempconf(%W,snext) == \[%W index insert\] \} \{ \ tk::TextKeySelect %W end-1char\ \}" bind Text "+$var ; break" bind Text {set tempconf(%W,sprior) [%W index insert];} bind Text "+$shift(prior)" set var "if \{ \$tempconf(%W,sprior) == \[%W index insert\] \} \{ \ tk::TextKeySelect %W 1.0\ \}" bind Text "+$var ; break" bind TextIn "[bind Text ] ; break" bind TextIn "[bind Text ] ; break" bind TextIn {event generate $conn($conn(up),top) <>} bind TextIn {event generate $conn($conn(up),top) <>} bind TextIn {event generate $conn($conn(up),top) <>;break} bind TextIn {event generate $conn($conn(up),top) <>;break} bind TextIn {if { [%W index end-1c] == [%W index insert] } { event generate $conn($conn(up),top) <> }} bind TextIn {continue;} bind TextIn {continue;} foreach x {2 3 4 5 6 7 8 9 10} { bind TextIn "FKey $x \$conn(up)" } bind TextIn {send_mushage %W ; break} # Binding to [bind Text ] gets around changes in version bind TextIn "[bind Text ] ; break" bind Text "[lrange [bind Text ] 0 1] \[moveUpDown %W up\]" bind Text "[lrange [bind Text ] 0 1] \[moveUpDown %W down\]" bind Text \ "[lrange [bind Text ] 0 1] \[moveUpDown %W up\]" bind Text \ "[lrange [bind Text ] 0 1] \[moveUpDown %W down\]" bind Text \ "[lrange [bind Text ] 0 1] \[textHomeEnd %W home\]" bind Text \ "[lrange [bind Text ] 0 1] \[textHomeEnd %W end\]" bind Text \ "[lrange [bind Text ] 0 1] \[textHomeEnd %W home\]" bind Text \ "[lrange [bind Text ] 0 1] \[textHomeEnd %W end\]" set string [string map "CMD [lindex [bind Text ] 0]" \ {if { [%W tag range sel] == "" } { CMD %W insertDIR1c } else { CMD %W "[lindex [%W tag range sel] IND] DIR 1 char" }}] bind Text [string map "DIR - IND 0" $string] bind Text [string map "DIR + IND 1" $string] set goL {set val [%W index insert] while {$val != "1.0" && [%W get $val-1c $val] == " "} { set val [%W index $val-1c] } if {$val != "1.0" } {set val [CMD1 %W $val tcl_wordBreakBefore]} CMD2 %W $val };# set goL set goR {set val [CMD1 %W insert tcl_wordBreakAfter] set end [%W index end] while {[%W index $val] != $end && [%W get $val $val+1c] == " "} { set val [%W index $val+1c] } CMD2 %W $val };# set goR set goL [string map "CMD1 tk::TextPrevPos" $goL] bind Text [string map "CMD2 tk::TextSetCursor" $goL] bind Text [string map "CMD2 tk::TextKeySelect" $goL] set goR [string map "CMD1 tk::TextNextPos" $goR] bind Text [string map "CMD2 tk::TextSetCursor" $goR] bind Text [string map "CMD2 tk::TextKeySelect" $goR] bind Text {%W tag add sel 1.0 end-1c %W mark set insert end-1c %W see insert} };# bindText proc markSel {w} { # this allows the output window to still show it's selection, # even if the focus is elsewhere. catch {$w tag remove showSel 1.0 end} catch {$w tag add showSel sel.first sel.last} };# markSel proc checkTextCut {w} { global conn p if { $conn(up) == "0" || $p(textEdit) == "0" } { event generate $w <> } else { [string map "%W $w" [bind Text <>]] } };# checkTextCut proc textBindKey {w a} { global p if { [string length $a] == "1"} { eval "$p(textBindKey) \"\\$w\" \"\\$a\"" } };# textBindKey proc FKey {key w} { send_mushage2 [connInfo $w fkey,$key] $w };# FKey proc send_mushage {w} { global conn # .p.pane.childsite. set x [string range $w 7 end] set y [string first . $x] set z [expr 1 + [string range $x 0 [expr $y-1]]] set v [string range [file extension $w] 1 end] # $z is either 1 (window bottom1) or 2 (window bottom2) # $v is the overall window thingy # (ie: $conn($v,bottom$z) is where they hit return) # $v should equal $conn(up), but this way it's definatly right. # Connection checks done in send_to so /commands work. # This runs send_mushage2 with the text where return is pressend, # and clears the box. The point? # send_mushage2 can evaluate a "script" and do /cmds and MUSH cmds # Added to buffer in send_mushage2, too # This is used in send_mushage2, too set char \b set t [string trimleft [$w get 1.0 end-1chars]] if {[string trim $t] == ""} { return; } $w delete 1.0 end regsub -all \n $t $char t send_mushage2 $t $v 0 $char };# send_mushage proc send_mushage2 {text world {nobuf 0} {char \b}} { # Part 2 of 3 of pressing return in an input box # Can also be used separatly from that for triggers, # etc. Does MUSH commands and /commands. # $char is a 'newline' separator for storage, etc # $nobuf, if 1, stops us adding to a worlds buffer. # meant for triggers, etc. if { !$nobuf } { global buffer$world set n [array size buffer$world] set buffer${world}($n) $text } regsub -all "${char}+" $text $char text set list [split $text $char] foreach line $list { if { [string match "/*" $line] } { if { [string match "//*" $line] } { send_to $world [string range $line 1 end] } else { do_slash_command $line $world } } else { send_to $world $line } };# foreach line $list };# send_mushage2 proc send_to {w s {c ""} {echo 1}} { global conn misc # Send $s to connection $conn($w,id) if it's valid/connected. # If $c is given, split $s at all occurances of $c, and send each # split line seperatly to the connection (normally \n or \b). # If $echo is given as 0, we don't echo. Otherwise, if it's not given # (or given as 1) and the Echo option is on, we echo. # (we don't echo if the connection is dead.) if { [dead $w] || $w == "0"} { return; } set id $conn($w,id) if {$c != ""} { if { [connInfo $w top,echo] == "1" && $echo } { foreach line [split $s $c] { puts $id $line echo $w $line };# foreach line } else { foreach line [split $s $c] { puts $id $line };# foreach line };# if echo } else { puts $id $s if { [connInfo $w top,echo] && $echo } { echo $w $s } } };# send_to proc do_slash_command {c w} { global slashalias # Handles slash commands!! # $c is the command (inc. the / and args) # $w is the connection # Remove the / set base [string range $c 1 end] set start [string wordstart $base 0]; set end [string wordend $base 0] set cmd [string trim [string range $base $start $end]] set args [string trim [string range $base $end end]] if {$cmd == "" } { set msg [mc slash,which] if { $w != "" && $w != "0" } { putOut $w $msg } return; } set list [info procs slash_cmd_$cmd*] set exact [info procs slash_cmd_$cmd] set yes 1 if { $exact == "" } { set exact [lindex $list 0] set yes 0 } if { $exact == ""} { if { [info exists [string tolower slashalias($cmd)]] } { set cmd $slashalias([string tolower $cmd]) set args [split $args] set cmd [string map [list %0^ [lrange $args 0 end] %0 [lindex $args 0] \ %1^ [lrange $args 1 end] %1 [lindex $args 1] \ %2^ [lrange $args 2 end] %2 [lindex $args 2] \ %3^ [lrange $args 3 end] %3 [lindex $args 3] \ %4^ [lrange $args 4 end] %4 [lindex $args 4] \ %5^ [lrange $args 5 end] %5 [lindex $args 5] \ %6^ [lrange $args 6 end] %6 [lindex $args 6] \ %7^ [lrange $args 7 end] %7 [lindex $args 7] \ %8^ [lrange $args 8 end] %8 [lindex $args 8] \ %9^ [lrange $args 9 end] %9 [lindex $args 9]] $cmd] send_mushage2 $cmd $w 1 ` return; } set msg [mc slash,unknown /${cmd}] if { $w != "" && $w != "0" } { putOut $w $msg } return; } # $exact is the command. $w is the connection. # $args are the /command's args. $yes is whether # the command was typed in full (1) or not (0) $exact "$w" "$args" "$yes" };# do_slash_command proc slash_cmd_exit {w a f} { # If we're connected anywhere, the user will be prompted. # If the command wasn't typed in full, they will also be # prompted. Otherwise, it'll just close down. chk_exit $f };# slash_cmd_exit proc slash_cmd_reconnect {w a f} { if { $w == "0" || $w == "" } return; set msg [mc slash,connact] reconnect $w $w $msg };# slash_cmd_reconnect proc slash_cmd_connect {w a f} { global conn world p if { $a == "" } { if { $w == "0" || $w == ""} return; set msg [mc slash,connact] reconnect $w $w $msg return; } set up [string toupper $a] set listO "" foreach x $world(good) { lappend listO [string toupper $world($x,info,name)] lappend listP $x } set list [lsort -dictionary $listO] set exact [lsearch -exact -sorted -dictionary $list $up] set partial [lsearch -sorted -glob $list ${up}*] if {$exact == "-1" } { set exact $partial } if {$exact == "-1" } { set msg [mc slash,connbad $a] if { $w == "0" || $w == "" } { tk_messageBox -title $p(nick) -icon info -messge $msg } else { putOut $w $msg } return; } set mush [lsearch -exact $listO [lindex $list $exact]] connect2mush [lindex $listP $mush] return; };# slash_cmd_connect proc slash_cmd_toggle {w a f} { global conn if { $w == "" || $w == "0" } return; if { $a == "" } { toggleFrame return; } if {[lsearch $conn(on) $a] == "-1"} { set msg [mc slash,togglebad $a] putOut $w $msg return; } showFrame $a; };# slash_cmd_toggle proc slash_cmd_slash {w a f} { global slashalias # List all /commands foreach x [info procs slash_cmd_*] { lappend var [string range $x 10 end] } set var [lsort $var] putOut $w "[mc slash,list]: [::Penn::enumerate $var]" if { [array name slashalias] != "" } { putOut $w "[mc slash,alias]: [::Penn::enumerate [array names slashalias]]" } else { putOut $w "[mc slash,alias]: <<[mc word,none]>>" } };# slash_cmd_slash proc slash_cmd_log {w a f} { global p conn # Format: /log [file] # Partial Log to the file given. If no file is given, we ask for one. # Buffer- and HTML-logs can be obtained via /logbuffer or /loghtml # We also ask here whether to include the rest of the buffer at the start; # /logon and /logall can be used to bypass this question if { $w == "" || $w == "0" } { return; } if { $conn($w,partial) } { doLogOff $w return; } if { [llength $a] == "0" } { set types { {{Text} {.txt} } {{Text} {.log} } {{All} * } } set types [string map " HTML \"[mc files,html]\" Text \"[mc files,text]\" All \"[mc files,all]\" " $types] set muname [connInfo $w info,name] set a [tk_getSaveFile -initialdir $p(logdirE) \ -defaultextension .txt \ -filetypes $types -parent . \ -title [mc log,select] \ -initialfile "$muname [mc word,logfile].txt"] } if { $a == "" } { return; } set prev [tk_messageBox -title [mc word,logging] -icon question \ -type yesno -message [mc slash,logprev]] if { $prev == "yes" } { doLogSub1 $w $a [file nativename [file normalize $a]] } else { doLogSub2 $w $a [file nativename [file normalize $a]] } };# slash_cmd_log proc slash_cmd_logon {w a f} { global p # Use /logon [file] to log the upcoming info (ie: partial log) # without the buffer to . We ask for one if no file is given. # This is for Auto-Sends as, if a file is given, no prompting whatsoever # is necessary if { $w == "" || $w == "0" } { return; } if { $conn($w,partial) } { doLogOff $w return; } if { [llength $a] == "0" } { set types { {{Text} {.txt} } {{Text} {.log} } {{All} * } } set types [string map " HTML \"[mc files,html]\" Text \"[mc files,text]\" All \"[mc files,all]\" " $types] set muname [connInfo $w info,name] set a [tk_getSaveFile -initialdir $p(logdirE) \ -defaultextension .txt \ -filetypes $types -parent . \ -title [mc log,select] \ -initialfile "$muname [mc word,logfile].txt"] } if { $a == "" } { return; } doLogSub2 $w $a [file nativename [file normalize $a]] };# slash_cmd_logon proc slash_cmd_logall {w a f} { global p # Use /logall [file] to log the buffer and the upcoming info # (ie: partial log) to . We ask for one if no file is given. # This is for Auto-Sends as, if a file is given, no prompting whatsoever # is necessary if { $w == "" || $w == "0" } { return; } if { $conn($w,partial) } { doLogOff $w return; } if { [llength $a] == "0" } { set types { {{Text} {.txt} } {{Text} {.log} } {{All} * } } set types [string map " HTML \"[mc files,html]\" Text \"[mc files,text]\" All \"[mc files,all]\" " $types] set muname [connInfo $w info,name] set a [tk_getSaveFile -initialdir $p(logdirE) \ -defaultextension .txt \ -filetypes $types -parent . \ -title [mc log,select] \ -initialfile "$muname [mc word,logfile].txt"] } if { $a == "" } { return; } doLogSub1 $w $a [file nativename [file normalize $a]] };# slash_cmd_logall proc slash_cmd_logbuffer {w a f} { global p # Log the buffer only. Format is /logbuffer [file]; # if no file is given we ask for one if { $w == "" || $w == "0" } { return; } if { [llength $a] == "0" } { set types { {{Text} {.txt} } {{Text} {.log} } {{All} * } } set types [string map " HTML \"[mc files,html]\" Text \"[mc files,text]\" All \"[mc files,all]\" " $types] set muname [connInfo $w info,name] set a [tk_getSaveFile -initialdir $p(logdirE) \ -defaultextension .txt \ -filetypes $types -parent . \ -title [mc log,select] \ -initialfile "$muname [mc word,logfile].txt"] if { $a == "" } { return; } } doLogSub3 $w $a [file nativename [file normalize $a]] };# slash_cmd_logbuffer proc slash_cmd_loghtml {w a f} { global p # Log the buffer as HTML. Format is /lohhtml [file]; # if no file is given we ask for one if { $w == "" || $w == "0" } { return; } if { [llength $a] == "0" } { set types { {{HTML} {.htm} } {{HTML} {.html} } {{Text} {.txt} } {{Text} {.log} } {{All} * } } set types [string map " HTML \"[mc files,html]\" Text \"[mc files,text]\" All \"[mc files,all]\" " $types] set muname [connInfo $c info,name] set a [tk_getSaveFile -initialdir $p(logdirE) \ -defaultextension .txt \ -filetypes $types -parent . \ -title [mc log,select] \ -initialfile "$muname [mc word,logfile].htm"] } if { $a == "" } { return; } doLogSub4 $w $a [file nativename [file normalize $file]] };# slash_cmd_loghtml proc slash_cmd_disconnect {w a f} { if { $w == "" || $w == "0" } return; disconnect $w [lindex {1 0} $f]; };# slash_cmd_disconnect proc slash_cmd_quick {w a f} { quickConnect [lindex $a 0] [lindex $a 1] [lindex $a 2]; };# slash_cmd_quick proc slash_cmd_close {w a f} { if { $w == "" || $w == "0" } return; closeWorld $w [lindex {1 0} $f]; };# slash_cmd_close proc slash_cmd_history {w a f} { global buffer$w if { $w == "" || $w == "0" } return; if {![regexp {^(end-)?[0-9]+$} $a] && $a != ""} { set msg [mc slash,hist] putOut $w $msg return; } if {$a != "" } { set max [llength [array names buffer$w]] if { ![string is integer -strict $a] } { set off [string range $a 4 end] incr off set num [expr $max - $off] } else { set num $a } if { $num < 0 || $num > $max } { set msg [mc slash,histout $max] putOut $w $msg return; } set cmd [set buffer${w}($num)] if {$cmd != ""} { send_mushage2 $cmd $w } return; } historyWindow $w };# slash_cmd_history proc see_end {w} { global conn # For $conn($w,top), is the text at the end? # ie: if we insert more text, should we 'see end'? set x [lindex [$conn($w,topbar) get] 1] if { $x == "1.0" } { return 1; } else { return 0; } };# see_end proc historyLastCommand {c win} { global buffer$c conn # This is similar to 'historyWindow', but just puts the last typed command # into the output window. $win is either 1 or 2, referring to which bottom # box to use. if { [array names buffer$c] == "" } { return; } set cmd [lindex [lsort -integer [array names buffer$c]] end] $conn($c,bottom$win) insert end [set buffer$c\($cmd)] };# historyLastCommand proc historyWindow {c} { global buffer$c conn set x .history$c if { [winfo exists $x] } { wm deiconify $x raise $x focus $x return; } toplevel $x wm withdraw $x wm resizable $x 0 0 wm title $x [mc hist,title $c [connInfo $c info,name]] frame $x.exp set text [mc hist,info] label $x.exp.l -text $text -wraplength 400 pack $x.exp pack $x.exp.l frame $x.list frame $x.list.1 frame $x.list.2 listbox $x.list.1.lb -selectmode browse -height 15 -width 65 \ -yscroll "$x.list.1.sb set" \ -xscroll "$x.list.2.sb set" scrollbar $x.list.1.sb -command [list $x.list.1.lb yview] scrollbar $x.list.2.sb -command [list $x.list.1.lb xview] -orient horizontal frame $x.list.2.fill -width [winfo reqwidth $x.list.1.sb] pack $x.list -padx 5 -pady 5 pack $x.list.1 pack $x.list.1.lb -side left pack $x.list.1.sb -side right -expand 1 -fill y pack $x.list.2 -in $x.list -side left -expand 1 -fill x pack $x.list.2.sb -side left -fill x -expand 1 -anchor s pack $x.list.2.fill -in $x.list.2 -side right set lb $x.list.1.lb set xx $conn($c,bottom1) ; set yy $conn($c,bottom2) foreach b [lsort -integer [array names buffer$c]] { $lb insert end [set buffer$c\($b)] } $lb selection clear 0 end $lb selection set end $lb selection anchor end $lb activate end $lb see end bind $x "$xx delete 1.0 end set sel \[$lb get \[$lb curselection\]\] set sel \[string map \{\\b \\n\} \$sel\] $xx insert end \$sel destroy $x" bind $x "event generate $x " bind $x "event generate $x " bind $x "$yy delete 1.0 end set sel \[$lb get \[$lb curselection\]\] set sel \[string map \{\\b \\n\} \$sel\] $yy insert end \$sel destroy $x" bind $x "set sel \[$lb get \[$lb curselection\]\] send_to $c \$sel \b destroy $x" bind $x "set sel \[$lb get \[$lb curselection\]\] set sel \[string map \{\\b \\n\} \$sel\] clipboard clear -displayof $x clipboard append -displayof $x \$sel bell -displayof $x" bind $lb {%W selection clear 0 end set at [%W index @%x,%y] %W selection set $at %W selection anchor $at %W activate $at clipboard clear -displayof %W set sel [%W get $at] set sel [string map {\b \n} $sel] clipboard append -displayof %W $sel bell -displayof %W} bind $x "destroy $x" bind $x "destroy $x" bind $x "destroy $x" frame $x.bottom button $x.bottom.btn -text [mc word,close] -command [list destroy $x] \ -underline 0 -width 8 -default active pack $x.bottom -side bottom -pady 5 pack $x.bottom.btn -side right -padx 10 -anchor se update center $x wm deiconify $x raise $x focus $x focus $lb update };# historyWindow proc echo {w msg} { global conn if { [see_end $w] == "1" } { set end 1 } else { set end 0 } # Echo the command $msg to text box $conn($w,top) set tags "echo margins" $conn($w,top) insert end "\n$msg" $tags if { $end } { $conn($w,top) see end } };# echo proc putOut {w msg {n 0} {center 0} } { global conn # Print $msg in $conn($w,top) in sysfont. # This is much better than using # '$conn($w,top) insert end $msg sysfont' # because it does other things; for example, lbAdd # 7/Jul/2003 -- also uses "margins" tag # 8/Aug/2003 -- '$center', if 1, adds "center" tag # 8/Aug/2003 -- only 'see end' if we should (if it was at the end) set x {} if { $n == "0" } { set x "\n" } set tags "sysfont margins" if { $center } {lappend tags center} $conn($w,top) insert end "$x$msg" $tags if { [see_end $w] == "1" } { $conn($w,top) see end } lbAdd $w };# putOut proc quickConnect {{h ""} {p ""} {tp ""}} { global quick # Pop up a box so that they can connect to a MU* just once, # rather than adding it properly set w ".quick" if { [winfo exists $w] } { wm deiconify $w raise $w focus $w return; } array unset quick toplevel $w wm withdraw $w wm resizable $w 0 0 wm title $w [mc quick,title] frame $w.msg label $w.msg.label -text [mc quick,info] -wraplength 270 pack $w.msg.label frame $w.buttons pack $w.buttons -side bottom -fill x -pady 2m button $w.buttons.connect -text [mc word,connect] -underline 0 -width 9 \ -default active \ -command [list quickConnectValidate $w.1.entry] button $w.buttons.cancel -text [mc word,cancel] -command [list destroy $w] -width 9 pack $w.buttons.connect $w.buttons.cancel -side left -expand 1 set reg(name,1) [mc quick,name] ; set reg(var,1) "quick(name)" set reg(name,2) [mc word,host] ; set reg(var,2) "quick(host)" set reg(name,3) [mc word,port] ; set reg(var,3) "quick(port)" set reg(name,4) [mc word,char] ; set reg(var,4) "quick(char)" set reg(name,5) [mc word,pw] ; set reg(var,5) "quick(pw)" if { $h != "" } { set $reg(var,2) $h } if { $p != "" } { set $reg(var,3) $p } if { [string is boolean -strict $tp] } { set quick(type) [string is true -strict $tp] } else { set quick(type) 1 } foreach i {1 2 3 4 5} { frame $w.$i -bd 2 entry $w.$i.entry -relief sunken -width 35 -textvariable $reg(var,$i) label $w.$i.label -text $reg(name,$i): pack $w.$i.entry -side right pack $w.$i.label -side left } $w.5.entry configure -show * pack $w.msg $w.1 $w.2 $w.3 $w.4 $w.5 -side top -fill x labelframe $w.type -text "Site Type" -labelanchor nw radiobutton $w.type.mush -text "MUSH" -variable quick(type) -value 1 radiobutton $w.type.mud -text "MUD" -variable quick(type) -value 0 pack $w.type.mush $w.type.mud -side left -padx 2 pack $w.type -side top -pady 3 -padx 2 bind $w "$w.buttons.connect invoke" bind $w "event generate $w " bind $w "$w.buttons.cancel invoke" focus $w.1.entry update center $w wm state $w normal raise $w focus $w update if { $h != "" && $p != "" } { $w.buttons.connect invoke } };# quickConnect proc quickConnectValidate {w} { global quick p # A part of 'quickConnect' set host [string trim $quick(host)] set port [string trim $quick(port)] if { $host == "" || $port == "" } { tk_messageBox -title $p(name) -icon error \ -message [mc conn,invalid] focus $w; return; } if { [string trim $quick(name)] == "" } { set name "$host:$port" } else { set name "$quick(name)" } connect2mush "" $name $host $port $quick(char) $quick(pw) # take the quick connect form off the screen destroy [winfo toplevel $w] };# quickConnectValidate proc toggleBindings {{to -1}} { global p conn if {$to != "-1"} { set p(textEdit) [lindex {1 0} $to] } set p(textEdit) [lindex {1 0} $p(textEdit)] if {$conn(on) == ""} { return; } if { $p(textEdit) == "0" } { foreach x $conn(on) { bindtags $conn($x,top) "$conn($x,top) TextAlias TextOut Text . all" } } else { foreach x $conn(on) { bindtags $conn($x,top) "$conn($x,top) TextAlias Text . all" } } if { [info exists $conn(0,top)] } { bindtags $conn(0,top) "$conn(0,top) TextAlias TextOut Text . all" } };# toggleBindings proc prefix:custom {x} { set w .custom-prefix-$x if {[winfo exists $w]} { wm deiconify $w raise $w focus $w return; } toplevel $w wm withdraw $w wm resizable $w 0 0 wm transient $w . bind $w "destroy $w" frame $w.f frame $w.btn pack $w.f $w.btn -side left -expand 1 -fill y -padx 3 wm title $w [mc prefix,title] button $w.btn.f -text [mc word,ok] -width 8 -default active -underline 0 \ -command "prefix \"$x\" \"\$win\" \"\$prefix\$space\" ; destroy $w" button $w.btn.c -text [mc word,cancel] -width 8 -command [list destroy $w] pack $w.btn.f $w.btn.c -side top -expand 0 -fill x -pady 3 frame $w.f.text frame $w.f.b pack $w.f.text $w.f.b -side top -fill x -expand 1 -anchor w -pady 3 label $w.f.text.l -text "[mc prefix,enter]: " entry $w.f.text.e -textvariable prefix -width 30 pack $w.f.text.l $w.f.text.e -side left -fill y -expand 1 $w.f.text.e selection range 0 end frame $w.f.b.l frame $w.f.b.dir pack $w.f.b.l $w.f.b.dir -side left -anchor s checkbutton $w.f.b.l.space -text [mc prefix,space] \ -onvalue " " -offvalue "" -variable space $w.f.b.l.space select checkbutton $w.f.b.l.1 -text [mc prefix,w1] -onvalue "1" -offvalue "2" -variable win checkbutton $w.f.b.l.2 -text [mc prefix,w2] -onvalue "2" -offvalue "1" -variable win $w.f.b.l.1 select pack $w.f.b.l.2 $w.f.b.l.1 $w.f.b.l.space -side bottom -expand 1 -anchor sw bind $w [list $w.btn.c invoke] bind $w [list $w.btn.f invoke] bind $w [list $w.btn.f invoke] wm overrideredirect $w 0 update center $w wm deiconify $w raise $w focus $w update };# prefix:custom proc prefix {x s m} { global conn # Format: $conn($x,bottom$s) # $m is text to insert at the start of every line of text # in $conn($x,bottom$s) # prefix $conn(up) 1 [connInfo $conn(up) text,say] set w $conn($x,bottom$s) set at 1 while { "$at.0" != [$w index end] } { $w insert $at.0 "$m" incr at } return; };# prefix # The two 'balloon help' procs below were based on those in # the snackAmp / tomAmp player, which is a Snack demo w/ActiveTcl. proc balloon {w help} { bind $w "after 450 [list balloonShow %W [list $help]]" bind $w [list destroy %W.balloon] };# balloon proc balloonShow {w text} { global p if { [eval winfo containing [winfo pointerxy .]] != $w } { return; } set top $w.balloon catch {destroy $top} toplevel $top wm title $top "$p(name)" $top configure -bd 1 -bg black wm overrideredirect $top 1 pack [message $top.txt -aspect 10000 -bg lightyellow \ -font {"" 8} -text $text -padx 1 -pady 0] bind $top {destroy %W} set wmx [winfo pointerx $w] set wmy [expr [winfo rooty $w]+[winfo height $w]] if {[expr $wmy+([winfo reqheight $top.txt]*2)]>[winfo screenheight $top]} { incr wmy -[expr [winfo reqheight $top.txt]*2] } if {[expr $wmx+([winfo reqwidth $top.txt]+5)]>[winfo screenwidth $top]} { incr wmx -[expr [winfo reqwidth $top.txt]*2] set wmx [expr [winfo screenwidth $top]-[winfo reqwidth $top.txt]-7] } wm geometry $top \ [winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy raise $top };# balloonShow splash main setupConnZero