TextSplitter.tcl 2.6.1

### TextSplitter.tcl 2.6.1 fpx1Gx1Z

#REQUIREMENTS
# PBinScr.tcl fMrtKqyq
# PatchChk.tcl Y5aZfqpT

#LICENSE
# Copyright © 2013 Alberto Dietze "DoctorD90"
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# Full GPLv3 Text: http://www.gnu.org/licenses/gpl.txt

#PATERNITY
#Coder: DoctorD90
#Network: irc.OnlineGamesNet.net
#Chan: #eHito
#Mail: [email protected]
#
#Thanks to guys on #egghelp on irc.freenode.net
#Special thanks to Speechles

#PURPOSE
#This script splits messages sended to irc server
#in lines if it is over max chars network length

#USAGE
#Add this script to your eggdrop's list to load it.

#SETTINGS
#Set your own Max Char Network Length
set textsplitter(netmaxchar) 512


### DON'T EDIT ANYTHING BELOW ###

if {![info exists textsplitter(rename)]} {
  set textsplitter(rename) 1
  rename putserv _putserv
  rename puthelp _puthelp
  rename putquick _putquick
  rename putnow _putnow
}

proc putserv {text {flags ""}} {
  set cmd "[lindex [split $text :] 0]:"
  set lcmd [string length $cmd]
  set what [string range $text $lcmd end]
  #set typ [lindex [split $cmd] 0]
  #set who [lindex [split $cmd] 1]
  foreach {typ who} [split $cmd] { break }
  if {[info exists ::BotPatchedChk] && $::BotPatchedChk} {
    set lines [bpatched_text $typ $who $what]
  } else {
    set lines [bunpatched_text $typ $who $what]
  }
  foreach line $lines {
    if {[string length $flags]} {
      _putserv "$typ $who :$line" $flags
    } else {
      _putserv "$typ $who :$line"
    }
  }
}

proc puthelp {text {flags ""}} {
  set cmd "[lindex [split $text :] 0]:"
  set lcmd [string length $cmd]
  set what [string range $text $lcmd end]
  #set typ [lindex [split $cmd] 0]
  #set who [lindex [split $cmd] 1]
  foreach {typ who} [split $cmd] { break }
  if {[info exists ::BotPatchedChk] && $::BotPatchedChk} {
    set lines [bpatched_text $typ $who $what]
  } else {
    set lines [bunpatched_text $typ $who $what]
  }
  foreach line $lines {
    if {[string length $flags]} {
      _puthelp "$typ $who :$line" $flags
    } else {
      _puthelp "$typ $who :$line"
    }
  }
}

proc putquick {text {flags ""}} {
  set cmd "[lindex [split $text :] 0]:"
  set lcmd [string length $cmd]
  set what [string range $text $lcmd end]
  #set typ [lindex [split $cmd] 0]
  #set who [lindex [split $cmd] 1]
  foreach {typ who} [split $cmd] { break }
  if {[info exists ::BotPatchedChk] && $::BotPatchedChk} {
    set lines [bpatched_text $typ $who $what]
  } else {
    set lines [bunpatched_text $typ $who $what]
  }
  foreach line $lines {
    if {[string length $flags]} {
      _putquick "$typ $who :$line" $flags
    } else {
      _putquick "$typ $who :$line"
    }
  }
}

proc putnow {text {flags ""}} {
  set cmd "[lindex [split $text :] 0]:"
  set lcmd [string length $cmd]
  set what [string range $text $lcmd end]
  #set typ [lindex [split $cmd] 0]
  #set who [lindex [split $cmd] 1]
  foreach {typ who} [split $cmd] { break }
  if {[info exists ::BotPatchedChk] && $::BotPatchedChk} {
    set lines [bpatched_text $typ $who $what]
  } else {
    set lines [bunpatched_text $typ $who $what]
  }
  foreach line $lines {
    if {[string length $flags]} {
      _putnow "$typ $who :$line" $flags
    } else {
      _putnow "$typ $who :$line"
    }
  }
}

proc bpatched_text {typ who what} {
  if {![string match "\001ACTION *\001" $what]} {
    set what [string range $what 12 end-5]
    set ac 1
  } else {
    set ac 16
  }
  set max [expr {$::textsplitter(netmaxchar) - [string bytelength $type] - [string bytelength $who] - 5 - $ac + 1}]
  if {[string bytelength $what] <= $max} {
    lappend msg $what
  } else {
    while {[string bytelength $what] != "0"} {
      set a 0
      set b 0
      while {[string bytelength [string range $what 0 $a]] < $max && $a <= [string length $what]} {
        if {![string length [string trim [string index $what $a]]]} {
          set b $a
        }
        incr a
      }
      if {[string length [string trim [string index $what $a]]] && [string length [string trim [string index $what [expr {$a + 1}]]]] && [llength [split $what]] > "1"} {
        set a $b
      }
      if {[string length [string trim [string range $what 0 $a]]]} {
        if {$ac} {
          lappend msg [string trim [string range $what 0 $a]]
        } else {
          lappend msg \001ACTION [string trim [string range $what 0 $a]]\001
        }
      }
      set what [string range $what [expr {$a + 1}] end]
    }
  }
  return $msg
}

proc bunpatched_text {typ who what} {
  if {![string match "\001ACTION *\001" $what]} {
    set what [string range $what 12 end-5]
    set ac 1
  } else {
    set ac 16
  }
  set max [expr {$::textsplitter(netmaxchar) - [string length $typ] - [string length $who] - 5 - $ac + 1}]
  if {[string length $what] <= $max} {
    lappend msg $what
  } else {
    while {[string length $what] != "0"} {
      set a 0
      set b 0
      while {[string length [string range $what 0 $a]] < $max && $a <= [string length $what]} {
        if {![string length [string trim [string index $what $a]]]} {
          set b $a
        }
        incr a
      }
      if {[string length [string trim [string index $what $a]]] && [string length [string trim [string index $what [expr {$a + 1}]]]] && [llength [split $what]] > "1"} {
        set a $b
      }
      if {[string length [string trim [string range $what 0 $a]]]} {
        if {$ac} {
          lappend msg [string trim [string range $what 0 $a]]
        } else {
          lappend msg \001ACTION [string trim [string range $what 0 $a]]\001
        }
      }
      set what [string range $what [expr {$a + 1}] end]
    }
  }
  return $msg
}

###
putlog "TextSplitter.tcl LOADED"