# Written by Serge Yudin xmpp:bigote@jabber.ru 2009-04-10 v 0.2
# The idea and original JavaScript are from http://fliptitle.com/
# Modified by Sergei Golovan
# $Id: flip.tcl 1741 2009-03-20 15:41:19Z sergei $

### A bit of code to get hex value of a character specified as command's argument:
### wish flip.tcl <char>
if {[info exists argv]} {
	puts [format %04X [scan [lindex $argv 0] %c]]
	exit
}

namespace eval flip {
    # Some letters are added compared to the original table version.
    # For example, capital letters, cyrillic letters.

    variable flipTable {
	a \u0250
	b q
	c \u0254
	d p
	e \u01DD
	f \u025F
	g \u0183
	h \u0265
	i \u0131
	j \u027E
	k \u029E
	l l
	m \u026F
	n u
	r \u0279
	t \u0287
	v \u028C
	w \u028D
	y \u028E
	\. \u02D9
	\[ \]
	\( \)
	\{ \}
	\? \u00BF
	\! \u00A1
	\' \,
	\< \>
	\_ \u203E
	\; \u061B
	\u203F \u2040
	\u2045 \u2046
	\u2234 \u2235
	\r \n
	A \u2200
	C \u0186
	D \u15E1
	V \u039B
	P \u0500
	M W
	\u0430 \u0250
	\u0431 g
	\u0433 \u0279
	\u0435 \u01DD
	\u0438 n
	\u043A \u029E
	\u043B v
	\u043C w
	\u043F \u0446
	\u0440 d
	\u0441 \u0254
	\u0443 \u028E
	\u0447 \u04BB
	\u0448 m
	\u044C q
	\u044D \u0454
	\u044F \u0281
	f \u025F
	h \u0265
	i \u0131
	j \u027E
	t \u0287
	\u0411 g
	\u0427 \u04BA
	\u0420 \u0500
	\u0421 \u0186
    }
# R \u1D1A mapping is deleted as it gives problems with jabber.ru server
# that prohibits using nicks with both Latin and Arabic characters.
	if {![info exists env(TKABBER_SITE_PLUGINS)]} {
		variable filename [file join $::configdir plugins flip flip_list]
	} else {
		variable filename [file join $env(TKABBER_SITE_PLUGINS) flip flip_list]
	}
}

proc flip::flipping {xlib nick group} {
    variable flipTable

    set seconds [clock seconds]

    # Probability of flipping is 50% at April, 1st
	set is_fools_day [expr {[clock format $seconds -format %m/%d] == "04/01"}]
    if {$is_fools_day && [expr rand()] < 0.5} {
	[namespace current]::store_old_nick $xlib $nick $group
	set newnick ""
	set map [string map $flipTable $nick]
	for {set i 0} {$i < [string length $map]} {incr i} {
	    append newnick [string index $map end-$i]
	}
		return $newnick
    } elseif {$is_fools_day} {
		return $nick
    } else {
		set nick [[namespace current]::restore_old_nick $xlib $nick $group]
		return $nick
	}
}

proc flip::slurp {} {
	variable filename
	if {[file exists $filename]} {
		set f_l [open $filename r]
		fconfigure $f_l -encoding utf-8
		set f_d [read $f_l]
		close $f_l
		return $f_d
	}
}

proc flip::puke {f_d} {
	variable filename
	if {[llength $f_d] > 0} {
		set f_l [open $filename w]
		fconfigure $f_l -encoding utf-8
		puts $f_l $f_d
		close $f_l
	} elseif {[file exists $filename]} {
		file delete $filename
	}
}

proc flip::store_old_nick {xlib nick group} {
	set real_jid [::xmpp::jid::stripResource [connection_jid $xlib]]
	set flip_data [[namespace current]::slurp]
	set fd [split $flip_data "\n"]
	set found 0
	foreach line $fd {
		set els [split $line " "]
		if {[lindex $els 0] == $real_jid
		&&  [lindex $els 1] == $group} {
			set found 1
			break
		}
	}
	if {!$found} {
		append flip_data [join [list $real_jid $group $nick\n] " "]
		[namespace current]::puke $flip_data
	}
}

proc flip::restore_old_nick {xlib nick group} {
	set flip_data [[namespace current]::slurp]
	set new_fd ""
	if {[llength $flip_data] == 0} {
		return $nick
	}
	set real_jid [::xmpp::jid::stripResource [connection_jid $xlib]]
	set fd [split $flip_data "\n"]
	foreach line $fd {
		if {$line != ""} {
			set els [split $line " "]
			if {[lindex $els 0] == $real_jid && [lindex $els 1] == $group} {
				set nick [join [lrange $els 2 end]]
			} else {
				append new_fd [join [list $line\n] " "]
			}
		}
	}
	[namespace current]::puke $new_fd
	return $nick
}

rename ::muc::join_group ::muc::join_group:saved

proc ::muc::join_group {xlib group nick {password ""}} {
    ::muc::join_group:saved $xlib $group \
	[::plugins::flip::flipping $xlib $nick $group] $password
}
