This is the new home of the egghelp.org community forum.
All data has been migrated (including user logins/passwords) to a new phpBB version.


For more information, see this announcement post. Click the X in the top right-corner of this box to dismiss this message.

kamus.tcl

Help for those learning Tcl or writing their own scripts.
Post Reply
User avatar
abah
Halfop
Posts: 62
Joined: Sun Dec 01, 2013 3:04 am
Location: Indonesia

kamus.tcl

Post by abah »

script kamus.tcl

Code: Select all

bind pub - !a msg_bahasa

proc msg_bahasa {nick uhost hand chan text} {
  global botnick
  set time_setting "%Y/%m/%d"
  set tanggalharini [clock format [clock seconds] -format $time_setting]
  set text [string tolower $text]
  if {$text == "" } {putserv "NOTICE $nick :Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda";return}
  set bahasa [lindex $text 0]
  set artikan [lindex $text 1]

  if {$bahasa == "" || $artikan == "" } {putserv "NOTICE $nick :Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda";return}

set bahasa [string tolower $bahasa]
switch $bahasa {
        padang { set bhs2 k }
        aceh { set bhs2 o }
        bali { set bhs2 g }
        banjar { set bhs2 h }
        bugis { set bhs2 r }
        jawa { set bhs2 i }
        lampung { set bhs2 s }
        makassar { set bhs2 j }
        palembang { set bhs2 l }
        pontianak { set bhs2 n }
        sunda { set bhs2 m}
        default { set bhs2 k }
}

if {$bhs2 == ""} { return }

###putserv "PRIVMSG $chan : $bahasa -- $artikan -- $bhs2"

  if {[string match "*" $text]} {
  set connect [::http::geturl http://www.kamusdaerah.com/?bhs=a&bhs2=$bhs2&q=$artikan]
  set files [::http::data $connect]
  ::http::cleanup $files

    set l [regexp -all -inline -- {<div class='arti'>Artinya: </div>(.*?)<div class='bahasa'>(.*?)</div>} $files]

if {[llength $l] != 0} {
     set m 0
     foreach {black a b} $l {
         incr m
         set a [string trim $a " \n"]
         set b [string trim $b " \n"]

         regsub -all {<.+?>} $a {} a
         regsub -all {<.+?>} $b {} b


        striphtml $a
        striphtml $b
        set kumpulin "$m. $a "
        append muncrat $kumpulin
        }
       putserv "PRIVMSG $chan : Translate $artikan dalam bahasa [string toupper $bahasa]: $muncrat"

} else { putserv "NOTICE $nick :\[\002[string toupper $bahasa]\002\] Kami tidak menemukan bahasa lainnya" }


        }
}


proc striphtml { text } {

     # filter out scripts, stylesheets, tags, and most escaped characters
     set text [regsub -all -nocase {<script[^>]*?>.*?</script>} $text " "]
     set text [regsub -all -nocase {<style[^>]*?>.*?</style>} $text " "]
     set text [regsub -all -nocase {<[\/\!]*?[^<>]*?>} $text " "]
     set text [regsub -all -nocase {([\r\n])[\s]+} $text "\\1"]
     set text [regsub -all -nocase {%&(quot|#34);} $text "\""]
     set text [regsub -all -nocase {&(amp|#38);} $text "&"]
     set text [regsub -all -nocase {&(lt|#60);} $text "<"]
     set text [regsub -all -nocase {&(gt|#62);} $text ">"]
     set text [regsub -all -nocase {&(nbsp|#160);} $text " "]
     set text [regsub -all -nocase {&(iexcl|#161);} $text "\xa1"]
     set text [regsub -all -nocase {&(cent|#162);} $text "\xa2"]
     set text [regsub -all -nocase {&(pound|#163);} $text "\xa3"]
     set text [regsub -all -nocase {&(copy|#169);} $text "\xa9"]

     # and last, catch arbitrary sequences
     set text [string map {[ \\[ ] \\] $ \\$ \\ \\\\} $text]
     set text [regsub -all -nocase {&#(\d+);} $text {[format c \1]}]
     set text [subst $text]

     return $text

}

putlog "\00303[string range [info script] 0 end]\00303 \002loaded...\002"
and i run but i get error messege
Tcl error [msg_bahasa]: invalid command name "::http::geturl"
can help me fix that script tq
User avatar
caesar
Mint Rubber
Posts: 3776
Joined: Sun Oct 14, 2001 8:00 pm
Location: Mint Factory

Post by caesar »

At the top add:

Code: Select all

package require http
Once the game is over, the king and the pawn go back in the same box.
User avatar
abah
Halfop
Posts: 62
Joined: Sun Dec 01, 2013 3:04 am
Location: Indonesia

Post by abah »

can you teach how tcl can use the command +chanset
w
willyw
Revered One
Posts: 1196
Joined: Thu Jan 15, 2009 12:55 am

Post by willyw »

abah wrote:can you teach how tcl can use the command +chanset

Not sure what you mean. Is this it?

http://forum.egghelp.org/viewtopic.php?p=98054#98054
For a fun (and popular) Trivia game, visit us at: irc.librairc.net #science-fiction . Over 300K Q & A to play in BogusTrivia !
User avatar
abah
Halfop
Posts: 62
Joined: Sun Dec 01, 2013 3:04 am
Location: Indonesia

Post by abah »

setudef flag bahasa

proc msg_bahasa {nick uhost hand chan text} {
if {![channel get $chan bahasa]} { return 0 }
correct ?
w
willyw
Revered One
Posts: 1196
Joined: Thu Jan 15, 2009 12:55 am

Post by willyw »

abah wrote:
setudef flag bahasa

proc msg_bahasa {nick uhost hand chan text} {
if {![channel get $chan bahasa]} { return 0 }
correct ?
If you are wanting to have:
.chanset #channel +bahasa
as an On switch for that proc, for #channel - yes.


Try it.
Test it with both:
.chanset #channel +bahasa
and
.chanset #channel -bahasa

You can see it's current value any time, with:
.chaninfo #channel

I hope this helps.
For a fun (and popular) Trivia game, visit us at: irc.librairc.net #science-fiction . Over 300K Q & A to play in BogusTrivia !
User avatar
abah
Halfop
Posts: 62
Joined: Sun Dec 01, 2013 3:04 am
Location: Indonesia

Post by abah »

Code: Select all

bind pub - !a msg_bahasa

package require http << added

proc msg_bahasa {nick uhost hand chan text} {
if {[channel get $chan bahasa]} { return 0 } < please comment my edit right or wrong ?
  global botnick
  set time_setting "%Y/%m/%d"
  set tanggalharini [clock format [clock seconds] -format $time_setting]
  set text [string tolower $text]
  if {$text == "" } {putserv "NOTICE $nick :Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda";return}
  set bahasa [lindex $text 0]
  set artikan [lindex $text 1]

  if {$bahasa == "" || $artikan == "" } {putserv "NOTICE $nick :Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda";return}

set bahasa [string tolower $bahasa]
switch $bahasa {
        padang { set bhs2 k }
        aceh { set bhs2 o }
        bali { set bhs2 g }
        banjar { set bhs2 h }
        bugis { set bhs2 r }
        jawa { set bhs2 i }
        lampung { set bhs2 s }
        makassar { set bhs2 j }
        palembang { set bhs2 l }
        pontianak { set bhs2 n }
        sunda { set bhs2 m}
        default { set bhs2 k }
}

if {$bhs2 == ""} { return }

###putserv "PRIVMSG $chan : $bahasa -- $artikan -- $bhs2"

  if {[string match "*" $text]} {
  set connect [::http::geturl http://www.kamusdaerah.com/?bhs=a&bhs2=$bhs2&q=$artikan]
  set files [::http::data $connect]
  ::http::cleanup $files

    set l [regexp -all -inline -- {<div class='arti'>Artinya: </div>(.*?)<div class='bahasa'>(.*?)</div>} $files]

if {[llength $l] != 0} {
     set m 0
     foreach {black a b} $l {
         incr m
         set a [string trim $a " \n"]
         set b [string trim $b " \n"]

         regsub -all {<.+?>} $a {} a
         regsub -all {<.+?>} $b {} b


        striphtml $a
        striphtml $b
        set kumpulin "$m. $a "
        append muncrat $kumpulin
        }
       putserv "PRIVMSG $chan : Translate $artikan dalam bahasa [string toupper $bahasa]: $muncrat"

} else { putserv "NOTICE $nick :\[\002[string toupper $bahasa]\002\] Kami tidak menemukan bahasa lainnya" }


        }
}


proc striphtml { text } {

     # filter out scripts, stylesheets, tags, and most escaped characters
     set text [regsub -all -nocase {<script[^>]*?>.*?</script>} $text " "]
     set text [regsub -all -nocase {<style[^>]*?>.*?</style>} $text " "]
     set text [regsub -all -nocase {<[\/\!]*?[^<>]*?>} $text " "]
     set text [regsub -all -nocase {([\r\n])[\s]+} $text "\\1"]
     set text [regsub -all -nocase {%&(quot|#34);} $text "\""]
     set text [regsub -all -nocase {&(amp|#38);} $text "&"]
     set text [regsub -all -nocase {&(lt|#60);} $text "<"]
     set text [regsub -all -nocase {&(gt|#62);} $text ">"]
     set text [regsub -all -nocase {&(nbsp|#160);} $text " "]
     set text [regsub -all -nocase {&(iexcl|#161);} $text "\xa1"]
     set text [regsub -all -nocase {&(cent|#162);} $text "\xa2"]
     set text [regsub -all -nocase {&(pound|#163);} $text "\xa3"]
     set text [regsub -all -nocase {&(copy|#169);} $text "\xa9"]

     # and last, catch arbitrary sequences
     set text [string map {[ \\[ ] \\] $ \\$ \\ \\\\} $text]
     set text [regsub -all -nocase {&#(\d+);} $text {[format c \1]}]
     set text [subst $text]

     return $text

}

putlog "\00303[string range [info script] 0 end]\00303 \002loaded...\002"
I added but still error
User avatar
caesar
Mint Rubber
Posts: 3776
Joined: Sun Oct 14, 2001 8:00 pm
Location: Mint Factory

Post by caesar »

Same error? A new one? Be more specific.

I took the liberty to fix your code a bit. Haven't tested anything so let me know if it works or you get any errors.

Code: Select all

namespace eval bahasa {

	package require http
	setudef flag bahasa
	bind pub - !a [namespace current]::public

	proc public {nick uhost hand chan text} {
		if {![channel get $chan bahasa]} return
		set lang {Padang Aceh Bali Banjar Bugis Jawa Lampung Makassar Palembang Pontianak Sunda}
		if {[scan $text {%s%s} bahasa artikan] != 2} {
			putserv "NOTICE $nick :Command: !a bahasa kata - Bahasanya: [join $lang ", "]"
			return
		}
		
		if {[lsearch -nocase $lang $bahasa]} {
			set bhs2 "k"
		} else {
			set bhs2 [string map [list "padang" "k" "aceh" "o" "bali" "g" "banjar" "h" "jawa" "i" "lampung" "s" "makassar" "j" "palembang" "l" "pontianak" "n" "sunda" "m"] $bahasa]
		}
		
		set http [::http::geturl "http://www.kamusdaerah.com/?bhs=a&bhs2=$bhs2&q=$artikan"]
		set data [::http::data $http]
		::http::cleanup $http

		set l [regexp -all -inline -- {<div class='arti'>Artinya: </div>(.*?)<div class='bahasa'>(.*?)</div>} $data]

		set bahasa [string toupper $bahasa]
		if {[llength $l]} {
			set m 0
			foreach {black a b} $l {
				incr m
				set a [string trim $a " \n"]
				set b [string trim $b " \n"]
				regsub -all {<.+?>} $a {} a
				regsub -all {<.+?>} $b {} b
				striphtml $a
				striphtml $b
				set kumpulin "$m. $a "
				append muncrat $kumpulin
			}
			putserv "PRIVMSG $chan :Translate $artikan dalam bahasa $bahasa: $muncrat"
		} else {
			putserv "NOTICE $nick :\[\002$bahasa\002\] Kami tidak menemukan bahasa lainnya"
		}
	}

	proc striphtml { text } {
		# filter out scripts, stylesheets, tags, and most escaped characters
		set text [regsub -all -nocase {<script[^>]*?>.*?</script>} $text " "]
		set text [regsub -all -nocase {<style[^>]*?>.*?</style>} $text " "]
		set text [regsub -all -nocase {<[\/\!]*?[^<>]*?>} $text " "]
		set text [regsub -all -nocase {([\r\n])[\s]+} $text "\\1"]
		set text [regsub -all -nocase {%&(quot|#34);} $text "\""]
		set text [regsub -all -nocase {&(amp|#38);} $text "&"]
		set text [regsub -all -nocase {&(lt|#60);} $text "<"]
		set text [regsub -all -nocase {&(gt|#62);} $text ">"]
		set text [regsub -all -nocase {&(nbsp|#160);} $text " "]
		set text [regsub -all -nocase {&(iexcl|#161);} $text "\xa1"]
		set text [regsub -all -nocase {&(cent|#162);} $text "\xa2"]
		set text [regsub -all -nocase {&(pound|#163);} $text "\xa3"]
		set text [regsub -all -nocase {&(copy|#169);} $text "\xa9"]

		# and last, catch arbitrary sequences
		set text [string map {[ \\[ ] \\] $ \\$ \\ \\\\} $text]
		set text [regsub -all -nocase {&#(\d+);} $text {[format c \1]}]
		set text [subst $text]

		return $text
	}

	putlog "\00303[string range [info script] 0 end]\00303 \002loaded...\002"
}
Oh, and you didn't get any errors since this:

Code: Select all

if {[channel get $chan bahasa]} { return 0 }
returns 1 if the channel had +bahasa set.

Edit: Fixed the code.
Last edited by caesar on Wed Mar 25, 2020 1:56 am, edited 1 time in total.
Once the game is over, the king and the pawn go back in the same box.
User avatar
abah
Halfop
Posts: 62
Joined: Sun Dec 01, 2013 3:04 am
Location: Indonesia

Post by abah »

[25:12:37:33:am] -> *agnes* set #makmur +bahasa
[25:12:37:20:am] -agnes- Set +bahasa for #makmur
[25:12:37:41:am] <abi> !a
[25:12:37:50:am] <abi> !a aku
not respon from bot
User avatar
caesar
Mint Rubber
Posts: 3776
Joined: Sun Oct 14, 2001 8:00 pm
Location: Mint Factory

Post by caesar »

That's most likely cos I forgot to add:

Code: Select all

setudef flag bahasa
under the:

Code: Select all

package require http
Edited the above code to add the line and it's working:
[07:53:05] (@cez): !a
[07:53:07] -Bot- Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda
[07:53:23] (@cez): !a aku
[07:53:25] -Bot- Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda
[07:53:43] (@cez): !a bali bahasanya
[07:53:44] -Bot- [BALI] Kami tidak menemukan bahasa lainnya
Once the game is over, the king and the pawn go back in the same box.
User avatar
abah
Halfop
Posts: 62
Joined: Sun Dec 01, 2013 3:04 am
Location: Indonesia

Post by abah »

But not running os openbsd or freebsd
User avatar
caesar
Mint Rubber
Posts: 3776
Joined: Sun Oct 14, 2001 8:00 pm
Location: Mint Factory

Post by caesar »

Use the code I posted.
Once the game is over, the king and the pawn go back in the same box.
User avatar
abah
Halfop
Posts: 62
Joined: Sun Dec 01, 2013 3:04 am
Location: Indonesia

Post by abah »

where code u posted please show me
User avatar
abah
Halfop
Posts: 62
Joined: Sun Dec 01, 2013 3:04 am
Location: Indonesia

Post by abah »

if the script is correct, it will definitely work and will show as shown
Image
Post Reply