# CETK epic miscelaneous fun script 0.9

unload cetk.entertainment
package cetk.entertainment

load cetk.functions

alias.pipel1 factor.e factor
alias.t factor.s {
	@ :num = [$0]
	if (num==(1&num)) {
		@ num = []
	} elsif (num%2) {
		for foo from ${1<#?(1|[$1]):3} to ${(num**2)**0.25} step 2 {
			unless (num % foo) {
				@ num = [$foo $${t}(${num/foo} $foo)]
				break
			}
		}
	} else {
		@ num = [2 $${t}(${num/2} 2)]
	}
	if (functioncall()) {
		return $num
	} else {
		echo $0$chr(9)$num
	}
}
alias.t factor.f {
	@ :num = [$0]
	@ :root = (num**2)**0.25
	@ :factors = []
	for foo in ($primes.walk($root)) {
		if (root<foo) {
			if (1<num**2) {
				push factors $num
			}
			break
		}
		until (num%foo) {
			push factors $foo
			@ num /= foo
			@ root = (num**2)**0.25
		}
	}
	if (1>#factors) {
		push factors $num
	}
	if (functioncall()) {
		return $factors
	} else {
		echo $0$chr(9)$factors
	}
}
alias.t factor.gcf (args) {
	@ :factors = factor.e($shift(args))
	fe ($args) arg {
		@ :factors = common($factors / $factor.e($arg))
	}
	if (functioncall()) {
		return $uniq($factors)
	} else {
		echo $0$chr(9)$uniq($factors)
	}
}
alias.t primes.exec (top,bot default 0,...) {
	fe ($exec(primes $bot $top)) in out err {break}
	@ close($in)
	@ close($err)
	@ :ret = readfdlineall($out)
	@ close($out)
	if (functioncall()) {
		return $ret
	} else {
		echo $ret
	}
}
alias.t primes.sieve {
	@ :nn = :non = :ret = []
	@ :top = [$0]
	@ :root = top**0.5
	for foo from 3 to $root step 2 {
		if (0 > findw($foo $nn)) {
			@ nn#= remws($nn / $jot(${2*foo} $root $foo))##[ ]
			@ non#= remws($non / $jot(${2*foo} $top $foo))##[ ]
		}
	}
	@ :ret = remws($non / 2 $jot(3 $top 2))
	if (functioncall()) {
		return $ret
	} else {
		echo $ret
	}
}
alias.t primes.walk {
	@ :bottom = my.primes?pop(my.primes):2
	@ :top = [$0]?[$0]:bottom+1000
	push my.primes $bottom
	@ :foo=:food = (1|++bottom)
	while (foo<=top || top<0) {
		@ foo = food
		@ :baz = foo**0.5
		fe ($my.primes) bar {
			if (bar>baz) {break}
			unless (foo%bar) {
				@ foo = 0
				break
			}
		}
		if (foo) {
			push my.primes $foo
			if (top<0) {
				@ ++top
			}
		}
		@ food += 2
	}
	if (functioncall()) {
		return $my.primes
	} else {
		echo $my.primes
	}
}

alias collatz (arg,mul default 3,div default 2,add default 1,args) {
	until (0<=finditem(divs $arg)) {
		setuniqitem divs $arg
		@ arg = arg%div ? arg*mul+1 : arg/div
	}
}

# Aliases stuff which shouldn't be in a client.
alias.t games.numpadtest (mx default 1000, ...) {
	#stack push bind key_plus
	#bind -symbolic key_plus erase_line
	@ :pass = :fail = 0
	@ :num = chr($jot($ascii(09)))
	@ :ut = utime()
	while (1) {
		@ :rn = rand($mx)
		@ :rd = [$"$rn "]
		if (rd == []) {
			break
		} elsif (strip($num $rd)) {
			@ :null++
		} elsif (rn == rd) {
			@ :pass++
		} else {
			@ :fail++
			beep
		}
	}
	@ :ut = tdiffu($ut)
	@ :fp = setset(floating_point_math on)
	echo $pass+$fail / $ut = ${pass/ut} + ${fail/ut}
	^set floating_point_math $fp
	#stack pop bind key_plus
}
alias.t games.acrogrep (word,files default /usr/share/dict/words) {
	@ :wd = :lt = word
	fec wd wd {@ wd = [\[$word\]]}
	fec lt lt {@ lt = [ | grep -i $lt]}
	exec grep -i '^$wd\$' $files $lt
}
alias.t games.wordle (word,charn,chars,files default /usr/share/dict/*english*) {
	fec chars chars {@ chars = [ | grep -i $chars]}
	exec  egrep -hi '^$word\$' $files | egrep -iv '[$charn]' $chars | egrep -i '^[a-z]+\$' | sort -f | uniq -i | shuf | head -99
}
alias.t plot.text (args) {
	@ :code = getcap(term cup 1 0)
	until (code == sar(r/%i//code)) {@ ++:add}
	xecho -r $sar(/%p2%d/${shift(args)+add}/$sar(/%p1%d/${shift(args)+add}/$code))$args
}
alias.t screen.fill (args) {
	@ :xx = getcap(term lines 1 1)
	@ :yy = getcap(term cols 1 1)
	@ :code = getcap(term cup 1 0)
	until (code == sar(r/%i//code)) {@ ++:add}
	fec ($args) arg {
		@ :xxx = rand($xx) + add
		@ :yyy = rand($yy) + add
		xecho -r $sar(/%p1%d/$xxx/$sar(/%p2%d/$yyy/$code))$arg
	}
}
alias.t screen.snake {
	@ :xx = getcap(term lines 1 1)
	@ :yy = getcap(term cols 1 1)
	@ :xxx = rand($xx)
	@ :yyy = rand($yy)
	@ :code = getcap(term cup 1 0)
	until (code == sar(r/%i//code)) {@ ++:add}
	fec ($*) arg {
		switch ($rand(4)) {
			(0) {@ :xxx++}
			(1) {@ :xxx--}
			(2) {@ :yyy++}
			(3) {@ :yyy--}
		}
		@ xxx = xxx < 0 ? xx : xxx > xx ? 0 : xxx
		@ yyy = yyy < 0 ? yy : yyy > yy ? 0 : yyy
		xecho -r $sar(/%p1%d/${xxx+add}/$sar(/%p2%d/${yyy+add}/$code))$arg
	}
}
alias.t screen.termcap {
	fe ($*) cap {
		echo $cap = "$getcap(term $cap 0 1)" = "$getcap(term $cap 1 1)" = "$getcap(term $cap 2 1)"
	}
}
alias.t pong (chan default *,list,args) {
	@ :list = shuffles($uniq($split(, $list)))
	fe list list {@ list = onchannel($list $chan) ? list : []}
	@ :chus = chanmode($chan) =~ [*m*] ? uniq($chops($chan) $chhops($chan) $chvoices($chan)) : chanusers($chan)
	@ :list = 1<#list ? unsplit(, $list) : word.randsel($remw($servernick() $chus))
	@ :diff = isnumber(b10 $args) ? shift(args) : 0
	ctcp $chan PONG $list $utimen() $diff $args
}
addctcp pong "plays a game of channel pingpong.  '/ctcp #channel pingpong $servernick()' starts a game.  The game is to roll your own code to work with this." {
	@ :sn = servernick()
	if (2<cloak) {
	} elsif ([$1] == sn) {
		qcmd 99 notice $0 This message needs to be sent to a common channel.  Try /ctcp # PONG $servernick()
	} elsif (rmatch($3 $sn $sn,*)) {
		@ :args = [$4-]
		@ :time = isnumber(b10 $args) ? shift(args) : utimen()
		@ :diff = isnumber(b10 $args) ? shift(args) : 0
		@ :diff = tdiffu($split(. $time))
		qcmd 99 pong $1 $unsplit(, $0 $after(, $3)) $diff $args
	}
}
on #-ctcp_reply 1 "% % VERSION *" setuniqitem $2-
alias.t verr (to, mask default *) {
	@ :sn = servernum()
	unless (numitems(version)) {array.nuread VERSION}
	unless (numitems(version)) {setuniqitem version mIRC v7.41}
	ctcp.reply $to VERSION ${#serv[$sn][ver] ? serv[$sn][ver] : (serv[$sn][ver] = getmaskitem(version $mask))}
}

# Audio stuff.
#
alias.t cbeep (time,args) {
	if ([off] == beep) {return}
	if (isnumber(b10 $time)) {timer -u -ref beep $time cbeep $args}
	beep
}
alias.t tbeep (args) {
	$getopts(:args :opt_ hk:m:n:s:t: $args)
	if (opt_h) {
		echo -k num    Raise the key by this amount.
		echo -t on,off Add a new timing specifying on and off in milliseconds.
		echo -s speed  Multiply all timings by this factor.
		echo -m dest   /msg the command to dest.
		echo -n dest   /notice the command to dest.
		echo This requires this utility: http://www.johnath.com/beep/
		return
	}
	@ :ofp = setset(floating_point_math on)
	@ :C = 261.6
	@ :F = (523.2 / 261.6) ** (1 / 12)
	@ :opt_k * = 12
	@ :opt_s = opt_s ? opt_s : 1
	fe args arg {
		fe ($split(, $arg)) tone time {break}
		@ :oldtime = :time = numwords($time) ? time : oldtime
		@ :time = isnumber(b10 $time) ? word($time $opt_t) : time
		fe ($split(: $time)) on off {@ on*=opt_s, off*=opt_s;break}
		@ :tone = C * F ** (tone + opt_k)
		@ :arg = [-f $tone -l $on -D $off -n]
	}
	^set $ofp
	pop args
	pop args
	pop args
	@ :dst = unsplit(, $opt_m $opt_n)
	@ :cmd = [exec]
	@ :cmd = opt_n ? [notice $dst] : cmd
	@ :cmd = opt_m ? [msg $dst] : cmd
	$cmd beep $args
}
alias tune.lamb /TBEEP -t 111:44 -t 333:44 6,0 4 2 4 6 6 6,1 4,0 4 4,1 6,0 9 9,1 6,0 4 2 4 6 6 6 6 4 4 6 4 2,1 $*
alias tune.lion /TBEEP -t 111:44 -t 333:44 0,0 2 4 5 7 4 7,1 8,0 5 8,1 7,0 4 7,1 0,0 2 4 5 7 4 7,1 8,0 5 8,1 7 $*

# Calculate the "IP distance" to other users.
#
# This is fairly robust in that you should be able to give it any combination
# of nicks, userhosts, IP's which should Just Work.
#
alias ipdist (args) {
	@ :oxd = xdebug(dword)
	xdebug dword
	$getopts(:args :opt_ c:m: $args)
	@ :unk = userhost(,)
	@ :me = opt_m ? opt_m : N
	@ :me = unk == userhost($me) ? me : userhost($me)
	@ :me = me =~ [*@*] ? after(-1 @ $me) : me
	@ :me = nametoip($me) ? nametoip($me) : me
	@ :me = iptolong($me)
	@ :uhts = userhost($args)
	@ :uhts = [$copattern($unk uhts args) $filter($unk $uhts)]
	fe uhts uhts {@ uhts = uhts =~ [*@*] ? after(-1 @ $uhts) : uhts}
	@ :uips = uhts
	fe uips uips {@ uips = nametoip($uips) ? nametoip($uips) : uips}
	fe uips uips {@ uips = iptolong($uips)}
	@ :xors = uips
	fe xors xors {@ xors = me^xors}
	@ :logs = xors
	fe logs logs {@ logs = trunc(1 $log10($logs))}
	@ :bits = xors
	fe bits bits {@ :foo = bits, bits = 0;while (foo) {@ bits+=foo&1, foo>>=1}}
	if (functioncall()) {
		@ function_return = joinstr(" " args logs bits)
	} else {
		fe ($joinstr(" " args uhts logs bits)) foo {echo $foo}
	}
	xdebug $oxd
}

# Geolocation.
#
alias geoloc (nick,userhost,chan,net,args) {
	$getopts(:args :opt_ haclpuf: $args)
	if (opt_h) {
		echo -p        Reply privately.
		echo -a        Return info from all networks.
		echo -c        Return info from only this channel.
		echo -u        Key from user@host rather than nick.
		echo -f file   File to store user geolocation data.
		echo -l        Lock config switches (-f) switch off.
	}
	if (opt_f && !opt_l) {
		@ cetk.geoloc.file = opt_f
		return
	}
	setuniqitem geoloc ${opt_a?1:0} ${opt_c?1:0} ${opt_p?1:0} ${opt_u?1:0} $nick $userhost $chan $net $args
echo => ${args}
	^exec -direct -window -name geoloc$servernum() -line {
echo $*
		#@ :args = getandmitem(geoloc % % % % % % % % $beforew(# $2-)*)
		@ :args = getandmitem(geoloc % % % % % % % % $2-)
echo <= $args
		@ :opt_a = shift(args)
		@ :opt_c = shift(args)
		@ :opt_p = shift(args)
		@ :opt_u = shift(args)
		writeto $cetk.geoloc.file $0-1 $args
		@ :nick = shift(args)
		@ :chan = shift(args)
		@ :chan = shift(args)
		@ :net = shift(args)
		@ :pid = urlencode(geoloc $args)
		@ :opt_c = opt_c ? [\$F[4] =~ /^$chan\$/i] : 1
		@ :opt_a = opt_a ? 1 : [\$F[5] =~ /^$net\$/i]
		@ :grep = [| perl -lane 'print if $opt_a && $opt_c']
		@ :uopt = opt_u ? [-i -f3] : [-i -f2]
		@ :dest = opt_p || N == chan ? nick : chan
		@ :awk = [perl -lane 'END {print "$nick, you are @f."}\; if ($nick) {push @f,((int $F[2]*1000)/1000)." km from $F[3]"} else {$nick = $F[3]}']
		^exec -window -m $dest tac $cetk.geoloc.file $grep| uniqo $uopt | latlong2distdeg | sort -nk3 | $awk
	} loc2latlong
	exec -in %geoloc$servernum() $args
}
geoloc . . . . -f ~/.epic/geoloc.dat

# Search the scrollback for urls and open them.  First arg, if numeric, opens the n'th url found.
#
alias.t viewlasturl (args) {
	@ :which = isnumber(b10 $args) ? shift(args) : 1
	@ :pattern = args ? args : [%://% www.% ftp.%]
	@ :oxd = xdebug(dword extractw)
	xdebug dword extractw
	fe ($jot(1 $winscrollbacksize())) foo {
		if ((:urls = pattern("\\[$pattern\\]" $line($foo))) && ++:found == which) {viewurl $urls}
	}
	xdebug $oxd
}
alias.t viewurl fe ($*) foo {exec -direct -name viewurl$rand(${2**31}) x-www-browser $foo}
on #^exec_exit 0 "viewurl% *"