#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/frivol.tcl,v $
# $Date: 1996/12/18 10:17:53 $
# $Revision: 1.18.1.4 $
#
package provide zircon 1.18
#
proc strrev {t} {
    set r {}
    set l [string length $t]
    for {set i 0} {$i < $l} {incr i} {
	set r [string index $t $i]$r
    }
    return $r
}
#

proc rot13 {t} {
    scan A %c Aval
    scan M %c Mval
    scan Z %c Zval
    scan a %c aVal
    scan m %c mVal
    scan z %c zVal
    set r {}
    set l [string length $t]
    for {set i 0} {$i < $l} {incr i} {
	set c [string index $t $i]
	scan $c %c v
	if {($v >= $Aval && $v <= $Mval ) \
	  || ($v >= $aVal && $v <= $mVal)} {
	    incr v 13
	    set c [format %c $v]
	} elseif {($v > $Mval && $v <= $Zval ) \
	  || ($v > $mVal && $v <= $zVal)} {
	    incr v -13
	    set c [format %c $v]
	}
	append r $c
    }
    return $r
}
#
array set zMorse {
    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 --..
    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 --..
    0 -----
    1 .----
    2 ..---
    3 ...--
    4 ....-
    5 .....
    6 -....
    7 --...
    8 ---..
    9 ----.
    ? ..--..
    . .-.-.-
    , --..--
}
#
proc toMorse {str} {
    global zMorse

    set res {}
    foreach ch [split $str {}] {
	if [info exists zMorse($ch)] {
	    append res $zMorse($ch)
	} {
	    append res $ch
	}
    }
    return $res
}
