DoctorD90 icon

TextSplitter.tcl 2.6.0

DoctorD90 | PRO | 04/19/13 12:18:19 AM UTC | 0 ⭐ | 3561 👁️ | Never ⏰ | []
TCL |

6.17 KB

|

None

|

0 👍

/

0 👎

### TextSplitter.tcl 2.6.0 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]
  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]
  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]
  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]
  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"

Comments

  •  icon
    01/01/70 12:00:00 AM UTC
    Plain Text |

    0 B

    |

    👍

    /

    👎

    
        
  •  icon
    01/01/70 12:00:00 AM UTC
    Plain Text |

    0 B

    |

    👍

    /

    👎