Compatibility bar

Active 0 Reply 158 Views 2022-12-17 14:17:51 TCL Snippets
A fun snippet that adds a command to show the compatibility between two users from channel. Enable it with command !chanset #channel +compat.

###############################################################################
#
#Compatibility bar TCL
#
#.chanset #channel +compat
#
# !compat [nick1]
#                                             BLaCkShaDoW Production
###############################################################################
##
#Flags to use
set compat(flags_to_use) "-|-"

##
#How many percent foreach same letter from nick ?
set compat(same_letter_percent) "2"

##
#How many percent foreach different letter to remove ?
set compat(different_letter_percent) "1"

################################################################################

setudef flag compat
bind pub $compat(flags_to_use) !compat proc:compat

proc proc:compat {nick host hand chan arg} {
    global compat
  if {![channel get $chan compat]} {
    return
}
  set nick1 [lindex [split $arg] 0]
  set nick2 [lindex [split $arg] 1]
if {[llength [split $arg]] == 1} {
    set nick2 $nick1
    set nick1 $nick
  } elseif {[llength [split $arg]] < 1} {
    putserv "NOTICE $nick :Use !compat \[nick1\] "
    return
  }
  if {![onchan $nick2 $chan]} {
    putserv "NOTICE $nick :$nick2 is not on $chan ..."
    return
}
  set llength_n1 [string length $nick1]
  set llength_n2 [string length $nick2]
  set sum [expr $llength_n1 + $llength_n2]
  set compat_nick1 [compat:percentage $sum $llength_n1]
  set compat_nick2 [compat:percentage $sum $llength_n2]

  if {$compat_nick1 > $compat_nick2} {
    set dif [expr $compat_nick1 - $compat_nick2]
  } else {
    set dif [expr $compat_nick2 - $compat_nick1]
  }
  set dif [expr {double(round(1000*$dif))/1000.0}]
  set compatibility [expr 100 - $dif]

  set same_letter_value [compat:same_letter $nick1 $nick2]
  if {$same_letter_value != 0} {
    set compatibility [expr $compatibility + [expr $same_letter_value * $compat(same_letter_percent)]]
  }
  set remove [expr [expr $sum - $same_letter_value] / 2]
  set compatibility [expr $compatibility - [expr $remove * $compat(different_letter_percent)]]

  if {$compatibility > 100} {set compatibility 100.0}
  if {$compatibility < 0} {
    set compatibility 0
    set red 10
    set green 0
    } else {
  set compatibility [expr {double(round(100*$compatibility))/100.0}]
  if {[expr {round($compatibility / 10)}] > 100} {set red 100} else {set red [expr {round($compatibility / 10)}]}
  set green [expr {10 - $red}]
}
  set a [string repeat { } [expr $red * 2]]
  set a "\00305,04$a\0034"
  set b [string repeat { } [expr $green * 2]]
  set b "\00305,01$b\0031"
  set comp "$a$b"
  putserv "PRIVMSG $chan :Compatibility ($compatibility %) :$comp"
}

###
proc compat:percentage {total number} {
    if {$number == 0} { return 0}
  if {$number > $total} {
  set percentage [expr $total / [expr $number * 100.0]]
} else {
  set percentage [expr [expr $number * 100.0] / $total]
}
  return $percentage
}

###
proc compat:same_letter {nick1 nick2} {
  set split_nick1 [split $nick1 ""]
  set split_nick2 [split $nick2 ""]
  set counter 0
foreach n1 $split_nick1 {
foreach n2 $split_nick2 {
if {[string equal -nocase $n1 $n2]} {
  incr counter
      }
    }
  }
  return $counter
}

putlog "Compatibility bar by BLaCkShaDoW Loaded"
loading...