# Family -100 4 in 1 by andravalid #
#
# Default Settings
set KAOSChannel "#azkalix"
set KAOSPointsName "points"
set KAOSPointsPerAnswer 10
set KAOSQuestionTime 60
set KAOSMarker "*"
set KAOSAskedFile "kaos.asked"
set KAOSQuestionFile "scripts/kaos.db"
set KAOSCFGFile "scripts/kaos.cfg"
set KAOSScoreFile "scripts/rank.data"
# Channel Triggers
bind pub m !ulang KAOS_Repeat
bind pub m !help KAOSCmds
bind pub m !asked KAOS_ShowAsked
bind pub - !start KAOS_Start
bind pub - !off KAOS_Stop
# DCC Commands
bind dcc - kaosrehash dcc_kaosrehash
bind dcc - kaosanswer dcc_kaosanswer
bind dcc - kaosreset dcc_kaosresetasked
bind dcc - kaosasked dcc_kaosshowasked
bind dcc - kaosforce dcc_kaosforce
# Cron Bind For Monthly Score Reset
#bind time - "00 00 01 * *" KAOS_NewMonth
# Global Variables
set KAOSRunning 0
set KAOSAllAnswered 0
set KAOSRoundOver 0
set KAOSQNumber 0
set KAOSQuestion ""
set KAOSQuestions(0) ""
set KAOSAsked ""
set KAOSQCount 0
set KAOSAnswerCount 0
set KAOSDisplayNum 0
set KAOSNumAnswered 0
set KAOSForced 0
set KAOSForcedQuestion ""
set KAOSAutoStart 0
set KAOStimeanswer 1
# Scores And Ads
set KAOSAdNumber 0
set KAOSAd(0) "$botnick"
set KAOSAd(1) "$botnick"
set KAOSAd(2) "$botnick"
# Timers
set KAOSAdTimer ""
set KAOSQuestionTimer ""
# Version
set KDebug 0
set KAOSVersion "0.91.0"
#
# Start KAOS
#
proc KAOS_Start {nick uhost hand chan args} {
global KAOSChannel KAOSRunning KAOSQCount KAOSQNumber KAOSQuestionFile KAOSAdNumber KAOSVersion KDebug
if {($chan != $KAOSChannel)||($KAOSRunning != 0)} {return}
set KAOSQCount 0
set KAOSAdNumber 0
KAOS_ReadCFG
if {![file exist $KAOSQuestionFile]} {
putcmdlog "\[KAOS\] Question File: $KAOSQuestionFile Unreadable Or Does Not Exist"
return 0
}
set KAOSQCount [KAOS_ReadQuestionFile]
if {$KAOSQCount < 2} {
putcmdlog "\[KAOS\] Not Enough Questions in Question File $KAOSQuestionFile"
return 0
}
set KAOSAskedFileLen [KAOS_ReadAskedFile]
if {$KAOSAskedFileLen >= $KAOSQCount} {
# kaosmsg "[kaos] [kcr] All Questions Asked: Resetting \003"
KAOS_ResetAsked
return 0
}
set KAOSRunning 1
# kaosmsg "Family-100 AZKALIXGAMES"
bind pubm - "*" KAOSCheckGuess
KAOSAskQuestion
return 1
}
#
# Stop KAOS
#
proc KAOS_Stop {nick uhost hand chan args} {
global KAOSChannel KAOSRunning KAOSQuestionTimer KAOSAdTimer
if {($chan != $KAOSChannel)||($KAOSRunning != 1)} {return}
set KAOSRunning 0
catch {killutimer $KAOSQuestionTimer}
catch {killutimer $KAOSAdTimer}
catch {unbind pubm - "*" KAOSCheckGuess}
kaosmsg "stopped by $nick"
return 1
}
#
# Pick Question
#
proc KAOSPickQuestion {} {
global KAOSAsked KAOSQCount KDebug
set KAOSUnasked [expr ($KAOSQCount - [llength $KAOSAsked])]
if {$KAOSUnasked < 1} {
# kaosmsg "[kaos] [kcr] All Questions Asked: Resetting \003"
KAOS_ResetAsked
}
set pickdone 0
while {$pickdone == 0} {
set kidx 0
set foundinasked 0
set pick [rand $KAOSQCount]
while {[lindex $KAOSAsked $kidx] != ""} {
if {[lindex $KAOSAsked $kidx] == $pick} {
set foundinasked 1
# kaoslog "KAOS" "Found Pick:$pick in Asked"
break
}
incr kidx
}
if {$foundinasked == 0} {incr pickdone}
}
# kaoslog "KAOS" "Picked Question:$pick"
KAOS_AddAsked $pick
return $pick
}
#
# Parse Question
#
proc KAOSParseQuestion {QNum} {
global KAOSMarker KAOSQuestions KAOSQuestion KAOSAnswers KAOSAnswerCount KAOSForcedQuestion KDebug
set KAnswersLeft ""
if {$QNum < 0} {
set KAOSFileQuestion $KAOSForcedQuestion
} {
set KAOSFileQuestion $KAOSQuestions($QNum)
}
if {$KDebug > 1} {kaoslog "kaos" "Picked:$QNum Question:$KAOSFileQuestion"}
if [info exists KAOSAnswers] {unset KAOSAnswers}
# Position of first "*"
set KAOSMarkerIDX [string first $KAOSMarker $KAOSFileQuestion]
if {$KAOSMarkerIDX < 1} {
kaoslog "KAOS" "Malformed Question #$QNum"
}
set KAOSQuestionEndIDX [expr $KAOSMarkerIDX - 1]
set KAOSQuestion [string range $KAOSFileQuestion 0 $KAOSQuestionEndIDX]
# Move to first character in answers
incr KAOSMarkerIDX
set KAnswersLeft [string range $KAOSFileQuestion $KAOSMarkerIDX end]
set KDoneParsing 0
set KAOSAnswerCount 0
# Parse all answers
while {$KDoneParsing != 1 } {
set KAnswerEnd [string first $KAOSMarker $KAnswersLeft]
if {$KAnswerEnd < 1} {
set KDoneParsing 1
set KAnswerEnd [string length $KAnswersLeft]
}
set KAnswer [string range $KAnswersLeft 0 [expr $KAnswerEnd -1]]
set KAOSAnswers($KAOSAnswerCount) "# $KAnswer"
set KAOSMarkerIDX [expr $KAnswerEnd +1]
set KAnswersLeft [string range $KAnswersLeft $KAOSMarkerIDX end]
incr KAOSAnswerCount
}
}
#
# Ask Question
#
proc KAOSAskQuestion {} {
global KAOSRunning KAOSQNumber KAOSAllAnswered KAOSRoundOver KAOSQuestion
global KAOSPointsPerAnswer KAOSPointsName KAOSNumAnswered KAOSAnswerCount
global KAOSQuestionTimer KAOSQuestionTime KAOSDisplayNum KAOSForced KAOSLastGuesser
global tipno tiplist TipsToUse InfoItem KAOStimestart KAOStimeanswer
if {$KAOSRunning != 1} {return}
# Get The Current Scores
# Pick Next Question
if {$KAOSForced == 1} {
KAOSParseQuestion -1
set KAOSQNumber 0
set KAOSForced 0
set KAOSForcedQuestion ""
} {
set KAOSQNumber [KAOSPickQuestion]
KAOSParseQuestion $KAOSQNumber
}
set KAOSAllAnswered 0
set KAOSLastGuesser ""
set KAOSDisplayNum 0
set KAOSNumAnswered 0
set KAOSRoundOver 0
# Choose Points Value For This Round
set KAOSPointsPerAnswer [rand 3]
if {$KAOSPointsPerAnswer < 1} {set KAOSPointsPerAnswer 3}
set KAOSPointsPerAnswer [expr $KAOSPointsPerAnswer *10]
set KAOSPointTotal [expr $KAOSPointsPerAnswer *$KAOSAnswerCount]
set tipzs "[get_InfoItems]"
if {$KAOStimeanswer==1} {
set KAOStimestart [clock clicks -milliseconds]
}
if {$KAOSAnswerCount == 1} {
kaosmsg "0,12 2 0,2 12 2,1 7,1 AZKALIX GOSIB AND FAKTA 2,1 12,2 0 2,12 0 "
kaosmsg "0,12 2 0,2 12 2,1 7,1 Gosip or fakta 9:9,1 $KAOSQuestion 2,1 12,2 0 2,12 0 "
kaosmsg "0,12 2 0,2 12 2,1 7,1 Nilai 9:8,1 $KAOSPointsPerAnswer $KAOSPointsName 2,1 12,2 0 2,12 0 "
kaosmsg "\00313$tipzs"
} elseif {$KAOSAnswerCount >= 2} {
kaosmsg "0,12 2 0,2 12 2,1 13,1 AZKALIX FAMILY 100 2,1 12,2 0 2,12 0 "
kaosmsg "0,12 2 0,2 12 2,1 13,1 Pertanyaan 9:9,1 $KAOSQuestion 2,1 12,2 0 2,12 0 "
kaosmsg "0,12 2 0,2 12 2,1 13,1 Survey 9:8,1 $KAOSAnswerCount Jawaban Score $KAOSPointsPerAnswer $KAOSPointsName - ToTal $KAOSPointTotal $KAOSPointsName 2,1 12,2 0 2,12 0 "
kaosmsg "$tipzs"
}
set KRemain [expr int([expr $KAOSQuestionTime /2])]
set KAOSQuestionTimer [utimer $KRemain "KAOSDisplayRemainingTime $KRemain"]
}
#
# Get Player Guess
#
proc KAOSCheckGuess {nick uhost hand chan args} {
global KAOSChannel KAOSRunning KAOSAnswerCount KAOSAnswers KAOSRoundOver KAOStimeanswer
global KAOSPointsName KAOSPointsPerAnswer KAOSNumAnswered KAOSAllAnswered KAOSLastGuesser KDebug
global lastwinner lastwinnercount botnick userlist quizconf rankfile KAOStimestart KAOStimetoanswer
variable bestscore 0 lastbestscore 0 lastbest ""
variable userarray
variable authorsolved 0 waitforrank 0 gameend 0
if {($chan != $KAOSChannel)||($KAOSRunning != 1)||($KAOSRoundOver == 1)} {return}
mx_getcreate_userentry $nick $nick
array set userarray $userlist($nick)
# set hostmask $userarray(mask)
set lastbest [lindex [lsort -command mx_sortrank [array names userlist]] 0]
if {$lastbest == ""} {
set lastbestscore 0
} else {
array set aa $userlist($lastbest)
set lastbestscore $aa(score)
}
regsub -all \[{',.!}] $args "" args
if {[string length args] == 0} {return}
set KAOSGuessOld $args
set KAOSGuess [string tolower $KAOSGuessOld]
if {$KDebug > 1} {kaoslog "KAOS" "Guess: $nick $KAOSGuess"}
foreach z [array names KAOSAnswers] {
set KAOSTry [lrange $KAOSAnswers($z) 1 end]
set KAOSTryOld $KAOSTry
regsub -all \[{',.!}] $KAOSTry "" KAOSTry
set KAOSTry [string tolower $KAOSTry]
if {$KDebug > 1} {kaoslog "KAOS" "Try: $KAOSTry"}
if {$KAOSTry == $KAOSGuess} {
if {[lindex $KAOSAnswers($z) 0] == "#"} {
set KAOSAnswers($z) "$nick $KAOSGuessOld"
set KAOStimetoanswer ""
if {$KAOStimeanswer==1} {
set KAOStimetoanswer [expr [expr [clock clicks -milliseconds]-$KAOStimestart]/1000]
}
incr userarray(score) $KAOSPointsPerAnswer
if {$userarray(score) == 1} {
set userarray(started) [unixtime]
}
set userlist($nick) [array get userarray]
kaosmsg "0,12 2 0,2 12 2,1 15,1 Jawaban Betul :11 $KAOSTryOld 15by ->9 [knikclr $nick] 15- Score 8 $KAOSPointsPerAnswer 15- waktu 7 $KAOStimetoanswer 15seconds - 15Total Score : 8 $userarray(score) 15points - 15Rank : 8 [mx_get_rank_pos $nick] 2,1 12,2 0 2,12 0 "
pushmode $KAOSChannel +v $nick
tmcquiz_rank_save {} {} {}
incr KAOSNumAnswered
if {$KAOSNumAnswered == $KAOSAnswerCount} {
set KAOSAllAnswered 1
set KAOSRoundOver 1
if {$KAOSAnswerCount == 1} {
set KAOSLastGuesser ""
# set greeting "[get_grated]"
kaosmsg "0,12 2 0,2 12 2,1 15,1 Seep deh jawaban anda benar 2,1 12,2 0 2,12 0 "
KAOS_TriviaResults
} elseif {$KAOSAnswerCount >= 2} {
set KAOSLastGuesser $nick
kaosmsg "0,12 2 0,2 12 2,1 15,1 Seep deh jawaban anda benar 2,1 12,2 0 2,12 0 "
KAOS_ShowResults
}
KAOS_Recycle
}
return
}
}
}
}
#
# Display Remaining Time And Answer Stats
#
proc KAOSDisplayRemainingTime {remaining} {
global KAOSRunning KAOSAllAnswered KAOSNumAnswered KAOSAnswerCount KAOSQuestionTimer KAOSQuestionTime KAOSDisplayNum
global KAOSQuestion
if {($KAOSRunning != 1)||($KAOSAllAnswered == 1)} {return}
if {$KAOSAnswerCount == 1} {
kaosmsg "0,12 2 0,2 12 2,1 15,1 $remaining detik lagi !!2,1 12,2 0 2,12 0 "
} elseif {$KAOSAnswerCount >= 2} {
kaosmsg "0,12 2 0,2 12 2,1 15,1 $remaining detik lagi !! 9Jawaban sisa [expr $KAOSAnswerCount - $KAOSNumAnswered] 2,1 12,2 0 2,12 0 "
}
incr KAOSDisplayNum
set KRemain [expr int([expr $KAOSQuestionTime /4])]
if {$KAOSDisplayNum < 2} {
set KAOSQuestionTimer [utimer $KRemain "KAOSDisplayRemainingTime $KRemain"]
} {
set KAOSQuestionTimer [utimer $KRemain KAOSTimesUp]
}
}
#
# Show Results Of Round
#
proc KAOSTimesUp {} {
global KAOSAnswers KAOSAllAnswered KAOSRoundOver KAOSNumAnswered KAOSAnswerCount KAOSQuestionTimer KAOSAdTimer
global botnick quizconf
global rankfile uptime botnick
if {$KAOSAllAnswered == 1} { return 1}
set KAOSRoundOver 1
set kaosmissed "[kcg] Time's Up! \003 "
append KMissed "0,12 2 0,2 12 2,1 15,1 Waktunya telah habis... Survey membuktikan. 2,1 12,2 0 2,12 0 "
set KAnswersRemaining [expr ($KAOSAnswerCount - $KAOSNumAnswered)]
set kcount 0
foreach z [array names KAOSAnswers] {
if {[lindex $KAOSAnswers($z) 0] == "#"} {
append KMissed "0,12 2 0,2 12 2,1 15,1 [lrange $KAOSAnswers($z) 1 end] 2,1 12,2 0 2,12 0 "
incr kcount
if {$kcount < $KAnswersRemaining} {append KMissed " "}
}
}
kaosmsg "$KMissed"
KAOS_ShowResults
if {$KAOSNumAnswered > 0} {
# kaosmsg "[kcs] Total Number Answered Correctly: $KAOSNumAnswered from a possible $KAOSAnswerCount! \003"
} {
kaosmsg "0,12 2 0,2 12 2,1 15,1 Kita masuk ke soal Scramble.. Harap Siap !!2,1 12,2 0 2,12 0 "
}
# tmcquiz_rank_save {} {} {}
# set KAOSAdTimer [utimer 10 KAOS_ShowAd]
# set KAOSQuestionTimer [utimer 5 KAOSAskQuestion]
tmcquiz_ask $botnick {} {} $quizconf(quizchannel) {}
}
#
# All Answers Gotten, Next Question
#
proc KAOS_Recycle {} {
global botnick quizconf
global rankfile uptime botnick
global KAOSAnswers KAOSNumAnswered KAOSQuestionTimer KAOSAdTimer
catch {killutimer $KAOSQuestionTimer}
if [info exists KAOSAnswers] {unset KAOSAnswers}
# set KAOSAdTimer [utimer 10 KAOS_ShowAd]
set KAOSQuestion ""
set KAOSNumAnswered 0
tmcquiz_ask $botnick {} {} $quizconf(quizchannel) {}
#set KAOSQuestionTimer [utimer 5 KAOSAskQuestion]
}
#
# Total Answers and Points
#
proc KAOS_ShowResults {} {
global KAOSAnswers KAOSPointsPerAnswer KAOSPointsName KAOSAllAnswered KAOSLastGuesser
global botnick quizconf rankfile userlist lastwinner lastwinnercount
if {$KAOSAllAnswered == 1} {
set KAOSBonus [expr $KAOSPointsPerAnswer *5]
set nick $KAOSLastGuesser
mx_getcreate_userentry $nick $nick
array set userarray $userlist($nick)
# set hostmask $userarray(mask)
set lastbest [lindex [lsort -command mx_sortrank [array names userlist]] 0]
if {$lastbest == ""} {
set lastbestscore 0
} else {
array set aa $userlist($lastbest)
set lastbestscore $aa(score)
}
incr userarray(score) $KAOSBonus
if {$userarray(score) == 1} {
set userarray(started) [unixtime]
}
set userlist($nick) [array get userarray]
# set greeting "[get_grated]"
kaosmsg "0,12 2 0,2 12 2,1 15,1 [knikclr $KAOSLastGuesser] 15dapat BONUS4 +$KAOSBonus 15pts Total Score : 4 $userarray(score) 8 (Rank: [mx_get_rank_pos $nick]) 2,1 12,2 0 2,12 0 "
tmcquiz_rank_save {} {} {}
}
}
proc KAOS_TriviaResults {} {
global KAOSAnswers KAOSPointsPerAnswer KAOSPointsName KAOSAllAnswered KAOSLastGuesser
}
#
# Add Question Number To Asked File
#
proc KAOS_AddAsked {KQnum} {
global KAOSAsked KAOSAskedFile
set f [open $KAOSAskedFile a]
puts $f $KQnum
close $f
lappend KAOSAsked $KQnum
}
#
# Parse Asked Questions
#
proc KAOS_ReadAskedFile {} {
global KAOSAsked KAOSAskedFile
set KAsked 0
set KAOSAsked ""
if {![file exists $KAOSAskedFile]} {
set f [open $KAOSAskedFile w]
} {
set f [open $KAOSAskedFile r]
while {[gets $f KQnum] != -1} {
lappend KAOSAsked "$KQnum"
incr KAsked
}
}
close $f
return $KAsked
}
#
# Reset Asked File
#
proc KAOS_ResetAsked {} {
global KAOSAskedFile KAOSAsked
set f [open $KAOSAskedFile w]
puts $f "0"
close $f
set KAOSAsked ""
}
#
# Read Question File
#
proc KAOS_ReadQuestionFile {} {
global KAOSQuestionFile KAOSQuestions
set KQuestions 0
set f [open $KAOSQuestionFile r]
while {[gets $f q] != -1} {
set KAOSQuestions($KQuestions) $q
incr KQuestions
}
close $f
return $KQuestions
}
#
# Show Asked
#
proc KAOS_ShowAsked {nick uhost hand chan args} {
global KAOSQCount KAOSAsked KAOSQuestions
set KAOSStatsAsked [llength $KAOSAsked]
set KAOSStatsUnasked [expr ($KAOSQCount - $KAOSStatsAsked)]
kaosmsg "[kaos] [kcm] Total: [kcc] $KAOSQCount [kcm] Asked: [kcc] $KAOSStatsAsked [kcm] Remaining: [kcc] $KAOSStatsUnasked \003"
}
#
# Repeat Question
#
proc KAOS_Repeat {nick uhost hand chan args} {
global KAOSChannel KAOSQuestion KAOSRunning KAOSQNumber KAOSAllAnswered
global KAOSPointsName
if {($chan != $KAOSChannel)||($KAOSRunning != 1)} {return}
if {$KAOSAllAnswered == 1} {return }
kaosmsg "0,12 2 0,2 12 2,1 15,1 Pertanyaan :9 $KAOSQuestion ? 2,1 12,2 0 2,12 0 "
}
#
# Read Config File
#
proc KAOS_ReadCFG {} {
global KAOSCFGFile KAOSChannel KAOSAutoStart KAOSAskedFile KAOSQuestionFile KAOSPointsName KAOSAd
if {[file exist $KAOSCFGFile]} {
set f [open $KAOSCFGFile r]
while {[gets $f s] != -1} {
set kkey [string tolower [lindex [split $s "="] 0]]
set kval [lindex [split $s "="] 1]
switch $kkey {
points { set KAOSPointsName $kval }
channel { set KAOSChannel $kval }
autostart { set KAOSAutoStart $kval }
askedfile { set KAOSAskedFile $kval }
kaosfile { set KAOSQuestionFile $kval }
ad1 { set KAOSAd(0) $kval }
ad2 { set KAOSAd(1) $kval }
ad3 { set KAOSAd(2) $kval }
}
}
close $f
if {($KAOSAutoStart < 0)||($KAOSAutoStart > 1)} {set KAOSAutoStart 1}
return
}
kaoslog "KAOS" "Config file $KAOSCFGFile not found... using defaults"
}
#
# Write Config File
#
proc KAOS_WriteCFG {} {
global KAOSCFGFile KAOSChannel KAOSAutoStart KAOSAskedFile KAOSQuestionFile KAOSPointsName KAOSAd
set f [open $KAOSCFGFile w]
puts $f "# This file is automatically overwritten"
puts $f "Points=$KAOSPointsName"
puts $f "Channel=$KAOSChannel"
puts $f "AutoStart=$KAOSAutoStart"
puts $f "AskedFile=$KAOSAskedFile"
puts $f "KAOSFile=$KAOSQuestionFile"
puts $f "Ad1=$KAOSAd(0)"
puts $f "Ad2=$KAOSAd(1)"
puts $f "Ad3=$KAOSAd(2)"
close $f
}
#
# Command Help
#
proc KAOSCmds {nick uhost hand chan args} {
global KAOSChannel
if {$chan != $KAOSChannel} {return}
kaosntc $nick "KAOS Commands: !asked"
}
#
# Color Routines
#
proc kcb {} {
return "\0038,2"
}
proc kcg {} {
return "\0030,3"
}
proc kcr {} {
return "\0030,4"
}
proc kcm {} {
return "\0030,6"
}
proc kcc {} {
return "\0030,10"
}
proc kcs {} {
return "\0030,12"
}
proc kaos {} {
return "\00308K\00307A\00313O\00306S\003"
}
# Channel Message
proc kaosmsg {what} {
global KAOSChannel
putquick "PRIVMSG $KAOSChannel :$what"
}
# Notice Message
proc kaosntc {who what} {
putquick "NOTICE $who :$what"
}
# Command Log
proc kaoslog {who what} {
putcmdlog "\[$who\] $what"
}
# Name Of Last Month
#proc KAOSLastMonthName {month} {
# switch $month {
# 1 {return "Dec"}
# 2 {return "Jan"}
# 3 {return "Feb"}
# 4 {return "Mar"}
# 5 {return "Apr"}
# 6 {return "May"}
# 7 {return "Jun"}
# 8 {return "Jul"}
# 9 {return "Aug"}
# 10 {return "Sep"}
# 11 {return "Oct"}
# 12 {return "Nov"}
# default {return "???"}
# }
#}
# Assign Nickname Color
proc knikclr {nick} {
set nicklen [strlen $nick]
set nicktot 0
set c 0
while {$c < $nicklen} {
binary scan [string range $nick $c $c] c nv
incr nicktot [expr $nv -32]
incr c
}
set nickclr [expr $nicktot %13]
switch $nickclr {
0 {set nickclr 10}
1 {set nickclr 11}
2 {set nickclr 12}
5 {set nickclr 13}
}
set nik [format "%02d" $nickclr]
return "\003$nik$nick"
}
#
# Show Ad
#
proc KAOS_ShowAd {} {
global KAOSAdNumber KAOSAd botnick KAOSChannel
switch $KAOSAdNumber {
0 { kaosmsg "[kcs] $KAOSAd(0) \003" }
1 { KAOSTop10 $botnick none none $KAOSChannel none }
2 { kaosmsg "[kcs] $KAOSAd(1) \003" }
3 { KAOSLastMonthTop3 $botnick none none $KAOSChannel none }
4 { kaosmsg "[kcs] $KAOSAd(2) \003" }
}
incr KAOSAdNumber
if {$KAOSAdNumber > 4} {set KAOSAdNumber 0}
}
#
# Rehash KAOS Config
#
proc dcc_kaosrehash {hand idx arg} {
global KAOSQCount
putcmdlog "#$hand# Rehashing KAOS config"
KAOS_ReadCFG
set KAOSQCount [KAOS_ReadQuestionFile]
if {$KAOSQCount < 2} {
kaoslog "KAOS" "Not Enough Questions in Question File $KAOSQuestionFile"
return 0
}
set KAOSAskedFileLen [KAOS_ReadAskedFile]
if {$KAOSAskedFileLen >= $KAOSQCount} {
kaoslog "KAOS" "Asked file out of sync with question database: resetting"
KAOS_ResetAsked
return 0
}
kaoslog "KAOS" "Questions:$KAOSQCount Asked:$KAOSAskedFileLen Remaining:[expr ($KAOSQCount - $KAOSAskedFileLen)]"
}
#
# Show Current Answers
#
proc dcc_kaosanswer {hand idx arg} {
global KAOSAnswers
set ans ""
foreach z [array names KAOSAnswers] {
if {[lindex $KAOSAnswers($z) 0] == "#"} {
append ans "[lrange $KAOSAnswers($z) 1 end] | "
}
}
kaoslog "KAOS" $ans
}
#
# Reset Asked File
#
proc dcc_kaosresetasked {hand idx arg} {
KAOS_ResetAsked
kaoslog "KAOS" "#$hand# Reset Asked File"
}
#
# Show Asked
#
proc dcc_kaosshowasked {hand idx arg} {
global KAOSQCount KAOSAsked KAOSQuestions
set KAOSStatsAsked [llength $KAOSAsked]
set KAOSStatsUnasked [expr ($KAOSQCount - $KAOSStatsAsked)]
kaoslog "KAOS" "Total:$KAOSQCount Asked:$KAOSStatsAsked Remaining:$KAOSStatsUnasked"
}
#
# Force A Question
#
proc dcc_kaosforce {hand idx arg} {
global KAOSRunning KAOSMarker KAOSForced KAOSForcedQuestion
if {$KAOSRunning != 1} {return}
regsub -all \[`,.!{}] $arg "" arg
if {$arg == ""} {return}
set KAOSMarkerIDX [string first $KAOSMarker $arg]
if {$KAOSMarkerIDX < 2} {
kaoslog "KAOS" "Malformed question: Format: Question*Answer1*Answer2..."
return
}
set KAOSForcedQuestion $arg
set KAOSForced 1
kaoslog "KAOS" "Forcing A Question Next Round"
}
KAOS_ReadCFG
## Tips To Use
set TipsToUses {
"0,12 2 0,2 12 2,1 15,1 Ketik 0!rank lihat rangking 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 Ketik 8 !score - score kamu 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 Ketik 8 !score - 11for your score 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 Ketik 8 !score - 11for your score 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 Type 4!score 15untuk melihat score user lain 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 Be MasTer Game in Here :P 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 Rules: 0No clones,cheating,and no invite 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 Jangan mengulang jawaban anda 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 Kumpul kita maen games 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 Ayoooooo dong mainnin jarinya :P 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 Selalu Memakai nick tetap biar scoremu ga berubah !! 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 ayooo kitaaaa maen 2,1 12,2 0 2,12 0 "
"0,12 2 0,2 12 2,1 15,1 score anda akan otomatis ke save 2,1 12,2 0 2,12 0 "
"7,1Dari Ibnu Abbas r.a Penduduk Khaibar puasa pada hari Asyura dan menjadikannya sebagai Hari Raya, di mana wanita mereka memakai perhiasan dan pakaian yang indah pada hari itu. Lalu Rasulullah s.a.w. bersabda Puasalah kamu (pada hari itu).(Sahih Muslim)"
"7,1Dari Aisyah r.a, Rasulullah s.a.w bersabda Barangsiapa yang tidak sampai mengqada puasa hendaklah keluarganya mengantikan puasa tersebut. (Sahih Bukhari & Muslim)"
"7,1Tegakkan syariat dalam dirimu barulah syariat dapat tegak di negerimu"
"7,1Dari Abu Mas'ud r.a, Rasulullah s.a.w bersabda Apabila seorang laki-laki memberikan nafkah kepada keluarganya dengan ikhlas, maka (pahala) nafkah itu sama dengan (pahala) sadaqah. (Sahih Bukhari)"
"7,1Dari Abu Hurairah r.a, Rasulullah s.a.w bersabda Allah berfirman Setiap amal anak Adam adalah untuk anak Adam itu sendiri melainkan puasa. Sesungguhnya puasa itu bagiKu dan Aku membalasi puasanya itu. (Sahih Bukhari)"
"7,1Tidurnya orang yang puasa tetap dalam ibadat dan diamnya dianggap tasbih dan amalnya dilipatgandakan dan doanya mustajab dan dosanya diampunkan. (HR Al Baihaqi)"
"7,1Nikah adalah sebagian dari sunnahku, barangsiapa tidak suka terhadap sunnahku maka tidak termasuk golonganku (HR Bukhari)"
"7,1Tidak akan datang hari kiamat sehingga orang-orang Islam memerangi dan membunuh orang-orang Yahudi (HR Muslim)"
"7,1Dari Abu Hurairah r.a, Rasulullah s.a.w bersabda Apabila Ramadhan telah datang maka dibukakan pintu rahmat, dikunci Neraka Jahanam dan dibelenggu semua syaitan.(Sahih Muslim)"
"7,1Keajaiban yang sangat mengherankan terhadap orang yang lari dari apa yang sangat dibutuhkan, dan tidak dapat lepas daripadanya. Dan berusaha mencari apa yang tidak akan kekal padanya. Sesungguhnya bukan mata kepala yang buta, tetapi yang buta ialah mata hati yang ada di dalam dada.(Kitab Al Hikam , Syehh Ahmad Attaillah)"
"7,1Dan barangsiapa yang tidak diberi cahaya oleh Allah, maka orang itupun tidak akan memperoleh cahaya apapun. (QS. An-Nur 40)"
"7,1Hai manusia, sesungguhnya janji Allah adalah benar, maka sekali-kali janganlah kehidupan dunia memperdayakan kamu dan sekali-kali janganlah syaitan yang pandai menipu, memperdayakan kamu tentang Allah” (QS. Faathir 35 : 5)"
"7,1Demi waktu, sesungguhnya manusia itu benar-benar berada dalam kerugian, kecuali orang-orang yang beriman dan mengerjakan amal saleh dan saling nasehat-menasehati dalam menatapi kebenaran dan nasehat-menasehati dalam menetapi kesabaran [Q.S. AI Ashr: (103): 1-3]"
"7,1Kamu sekali-kali tidak sampai kepada kebaktian (yang sempurna), sebelum kamu menafkahkan sebahagian harta yang kamu cintai. Dan apa saja yang kamu nafkahkan, maka sesungguhnya Allah mengetahuinya. (QS. Ali Imran 3:92)"
"7,1sesungguhnya telah datang kepadamu seorang rosul dari kamu sendiri, berat terasa olehnya penderitaanmu, sangat mengiginkan (keimanan dan keselamatan) bagimu, amat belas kasihan lagi penyayang terhadap orang-orang mukmin (surat At Taubah : 128 )"
"7,1Wahai anak Adam aku adalah hari yang baru, dan aku datang untuk menyaksikan amalan kamu. Oleh sebab itu manfaatkanlah aku sebaik-baiknya. Karena aku tidak kembali lagi sehingga hari pengadilan. (H.R. Turmudzi)"
"7,1Sesungguhnya telah ada pada diri Rasulullah itu suri tauladan yang baik bagimu (yaitu) bagi orang-orang yang mengharap rahmat Allah ... (QS. Al Ahzab [33] : 21)"
"7,1Sesungguhnya Allah tidak merubah keadaan suatu kaum sehingga mereka merubah keadaan yang ada pada diri mereka sendiri. (QS. Ar Ra'd 13:11)"
"7,1Padahal mereka tidak disuruh, kecuali supaya menyembah Allah dengan memurnikan ketaatan kepada-Nya dalam (menjalankan) agama dengan lurus dan supaya mereka mendirikan shalat serta menunaikan zakat, dan yang demikian itulah agama yang lurus (QS. Al Bayyinah [98] : 5)"
"7,1wahai orang-orang yang beriman diwajibkan kepada kalian untuk berpuasa sebagaimana telah diwajibkan kepada orang-orang sebelum kalian agar kalian bertaqwa (surat Al Baqarah : 183)"
"7,1Barangsiapa yang bersyukur maka sesungguhnya dia bersyukur untuk (kebaikan) dirinya sendiri dan barangsiapa yang ingkar, maka sesungguhnya Tuhanku Maha Kaya lagi Maha Mulia. (QS. An Naml 27:40)"
"7,1Sesuatu yang bernyawa tidak akan mati melainkan dengan izin Allah, sebagai ketetapan yang telah ditentukan waktunya. Barangsiapa menghendaki pahala dunia, niscaya Kami berikan kepadanya pahala dunia itu, dan barangsiapa menghendaki pahala akhirat, Kami berikan (pula) kepadanya pahala akhirat. Dan kami akan memberi balasan kepada orang-orang yang bersyukur. (QS. Ali Imran 3:145)"
"7,1Katakanlah: Jika kamu (benar-benar) mencintai Allah, ikutilah aku, niscaya Allah mengasihi dan mengampuni dosa-dosamu. Allah Maha Pengampun lagi Maha Penyayang. (QS. Ali Imran 3:31)"
"7,1Dan tolong-menolonglah kamu dalam mengerjakan kebajikan dan takwa dan janganlah kamu tolong-menolong dalam berbuat dosa dan pelanggaran. Dan bertakwalah kamu kepada Allah, sesungguhnya Allah amat berat siksanya. (QS. Al-Maidah: 2)"
"7,1Semua amal anak Adam dapat dicampuri kepentingan hawa nafsu, kecuali shaum. Maka sesungguhnya shaum itu semata-mata untuk-Ku dan Aku sendiri yang akan membalasnya (Hr. Bukhari Muslim)"
"7,1Sesungguhnya Allah SWT suka kepada hamba yang berkarya dan terampil. Barang siapa bersusah payah mencari nafkah untuk keluarganya, maka dia serupa dengan seorang mujahid fisabilillah. (HR.Imam Ahmad)"
"7,1Sesungguhnya Jibril alaihis salam selalu menemui Nabi shallallahu alaihi wa salllam untuk membacakan Al Quran baginya.(HR. Al Bukhari dan Muslim dari Ibnu Abbas Radhiyallahu anhu)"
"7,1Sesungguhnya setan itu bermaksud hendak menimbulkan permusuhan dan kebencian di antara kamu lantaran (meminum) khamar dan berjudi itu, dan menghalangi kamu dari mengingat Allah dan sembahyang; maka berhentilah kamu (dari mengerjakan pekerjaan itu)"
"7,1sesungguhnya Allah tidak mengampuni dosa mempersekutukan (sesuatu) dengan Dia, dan Dia mengampuni dosa selain dari syirik itu bagi siapa yang di kehendaki-Nya. (an Nisa': 116)"
"7,1Dan siapakah yang lebih zhalim dari pada orang yang telah diperingatkan dengan ayat-ayat tuhan-Nya, kemudian ia berpaling daripadanya? Sesungguhnya kami akan memberikan pembalasan kepada orang-orang yang berdosa.(As Sajdah: 32)"
"7,1Mereka mempunyai tikar tidur dari api nereka dan di atas mereka ada selimut (api nereka). Demikianlah Kami memberi balasan kepada orang-orang yang zalim "
"7,1Kemudian tatkala dia melihat matahari terbit dia berkata: Inilah Tuhanku, ini yang lebih besar, maka tatkala matahari itu telah terbenam, dia berkata: Hai kaumku, sesungguhnya aku berlepas diri dari apa yang kamu persekutukan "
"7,1Dan sebagian dari tanda-tanda kekuasaan-Nya ialah malam, siang, matahari dan bulan. Janganlah bersujud kepada matahari dan janganlah (pula) kepada bulan, tetapi bersujudlah kepada Allah Yang menciptakannya, jika kamu hanya kepada-Nya saja menyembah "
"7,1Dia menciptakan langit dan bumi dengan (tujuan) yang benar; Dia menutupkan malam atas siang dan menutupkan siang atas malam dan menundukkan matahari dan bulan, masing-masing berjalan menurut waktu yang ditentukan.Ingatlah Dialah Yang Maha Perkasa lagi Maha Pengampun "
"7,1Maka sabarlah kamu atas apa yang mereka katakan, dan bertasbihlah dengan memuji Tuhanmu,sebelumterbit matahari dan terbenamnya dan bertasbih pulalah pada waktu-waktu di malam hari dan pada waktu-waktu di siang hari, supaya akmu merasa senang "
"7,1Apakah kamu tidak memperhatikan (penciptaan) Tuhanmu, bagaimana Dia memanjangkan (dan memendekkan) bayang-bayang; dan kalau Dia menghendaki niscaya Dia menjadikan tetap bayang-bayang itu, kemudian Kami jadikan matahari sebagai petunjuk atas bayang-bayang itu "
"7,1Dia memasukkan malam ke dalam siang dan memasukkan siang ke dalam malam dan menundukkan matahari dan bulan, masing-masing berjalan menurut waktu yang ditentukan.Yang (berbuat) demikian itulah Allah Tuhan-mu, kepunyaan-Nyalah kerajaan.Dan orang-orang yang kamu seru (sembah) selain Allah tiada mempunyai apa-apa walaupun setipis kulit ari "
"7,1Berkata Musa: Waktu untuk pertemuan (kami dengan) kamu itu ialah di hari raya dan hendaklah dikumpulkan manusia pada waktu matahari sepenggalahan naik "
"7,1Dan jagalah dirimu dari ('azab) hari (kiamat, yang pada hari itu) seseorang tidak dapat membela orang lain, walau seikitpun; dan (begitu pula) tidak diterima syafa'at dan tebusan daripadanya, dan tidaklah mereka akan ditolong "
"7,1Dan orang-orang Yahudi berkata: Orang-orang Nasrani itu tidak punya suatu pegangan, dan orang-orang Nasrani berkata: Orang-orang Yahudi tidak mempunyai sesuatu pegangan, padahal mereka (sama-sama) membaca Al-Kitab. Demikian pula orang-orang yang tidak mengetahui, mengucapkan seperti ucapan mereka itu. Maka Allah akan mengadili diantara mereka pada hari kiamat, tentang apa-apa yang mereka erselisih padanya "
"7,1Dan bagi tiap-tiap ummat ada kiblatnya (sendiri) yang ia menghadap kepadanya. Maka berlomba-lombalah kamu (dalam membuat) kebaikan. Di mana saja kamu berada pasti Allah akan mengumpulkan kamu sekalian (pada hari kiamat). Seungguhnya Allah Maha Kuasa atas segala sesuatu "
"7,1Dan di antara manusia ada orang-orang yang menyembah tandingan-tandingan selain Allah; mereka mencintainya sebagaimana mereka mencintai Allah. Adapan orang-orang yang beriman amat sangat cintanya kepada Allah. Dan jika seandainya orang-orang yang berbuat zalim itu mengetahui ketika mereka melihat siksa (pada Hari Kiamat), bahwa kekuatan itu kepunyaan Allah semuanya, dan bahwa Allah amat berat siksa-Nya (niscaya mereka menyesal) "
"7,1Sesungguhnya orang-orang yang menyembunyikan apa-apa yang telah diturunkan Allah, yaitu Al-Kitab dan menjualnya dengan harga yang sedikit (murah), mereka itu sebenarnya tidak memakan (tidak menelan) ke dalam perutnya melainkan api, dan Allah tidak akan berbicara kepada mereka pada Hari Kiamat dan tidak mensucikan mereka dan bagi mereka siksa yang amat pedih "
"7,1Tiada yang mereka nanti-nantikan (pada hari Kiamat) melainkan datangnya (siksa) Allah dalam naungan awan dan malaikat, dan diputuskanlah perkaranya. Dan hanya kepada Allah dikembalikan segala urusan "
"7,1Kehidupan dunia dijadikan indah dalam pandangan orang-orang kafir, dan mereka memandang hina orang-orang yang beriman. Padahal orang-orang yang bertaqwa itu lebih mulia dari pada mereka di hari Kiamat. Dan Allah memberi rezki kepada orang-orang yang dikehendaki-Nya tanpa batas "
}
## Proc to Randomly Select an Info Item!
proc get_InfoItems { } {
global TipsToUses
set outputiz9 [lindex $TipsToUses [rand [llength $TipsToUses]]]
return $outputiz9
}
putlog "Loaded KAOS $KAOSVersion by andravalid"
###########################################################################
##
## ATTENTION:
##
## Defaults for bot configuration. Don't edit here, edit the file
## quiz.rc instead!
##
###########################################################################
# system stuff
variable quizbasedir scripts
variable gamedata scripts/
variable datadir $quizbasedir/
variable configfile $quizbasedir/quiz.rc
variable rankfile $datadir/rank.data
variable userqfile $datadir/questions.user.en
#
# Configuration map
#
variable quizconf
set quizconf(quizchannel) "#azkalix"
set quizconf(quizloglevel) 1
# several global numbers
set quizconf(maxranklines) 5
set quizconf(tipcycle) 0
set quizconf(useractivetime) 240
set quizconf(userqbufferlength) 5
#set quizconf(winscore) 30
# timer delays in seconds
set quizconf(askdelay) 5
set quizconf(tipdelay) 30
# safety features and other configs
set quizconf(lastwinner_restriction) no
set quizconf(lastwinner_max_games) 2
set quizconf(colorize) yes
set quizconf(pausemoderated) no
set quizconf(userquestions) yes
set quizconf(msgwhisper) no
set quizconf(stripumlauts) no
##
###########################################################################
##
## stuff for the game state
##
# values = stopped, paused, asked, waittoask, halted
variable quizstate "halted"
variable statepaused ""
variable statemoderated ""
variable usergame 0
variable timeasked [unixtime]
variable revoltmax 0
# values = newgame, stop, halt, exit
variable aftergame "newgame"
#
# variables for the ranks and user handling
#
variable timerankreset [unixtime]
variable userlist
variable revoltlist ""
variable lastsolver ""
variable lastsolvercount 0
variable lastwinner ""
variable lastwinnercount 0
#
# stuff for the question
#
variable tiplist ""
variable theq
variable qnumber 0
variable qnum_thisgame 0
variable userqnumber 0
variable tipno 0
variable qlist ""
variable qlistorder ""
variable userqlist ""
#
# doesn't fit elsewhere
#
variable whisperprefix "NOTICE"
##################################################
## bindings
# userquest and other user (public) commands
bind pubm - * tmcquiz_pubm
bind pub - !starcfk tmcquiz_ask
bind pub - !savecfk tmcquiz_saves
bind pub - !stopcfk tmcquiz_stops
bind pub m !exit tmcquiz_exit
bind msg m !addquest tmcquiz_userquest
bind msg m !usercancel tmcquiz_usercancel
bind msg m !usersolve tmcquiz_usersolve
bind pub m !qhelp tmcquiz_pub_help
bind pub - !score tmcquiz_pub_score
bind pub - !rank tmcquiz_pub_rank
# Some events the bot reacts on
#bind nick - * tmcquiz_on_nickchanged
#bind join - * tmcquiz_on_joined
# bind mode - "*m" tmcquiz_on_moderated
bind evnt - prerehash mx_event
bind evnt - rehash mx_event
## DEBUG
bind dcc n !colors tmcquiz_colors
###########################################################################
#
# Helptext
#
###########################################################################
set quizshorthelp [list \
"© by AZKALIX@DALnet crew" \
"Most important commands are: !start, !rank, !score and !stop" \
"To learn more, specify a topic: !qhelp ." \
"Topics are: %s"]
###########################################################################
#
# bot running commands
#
###########################################################################
## stop
## stop everything and kill all timers
proc tmcquiz_stop {handle idx arg} {
global quizstate
global quizconf
variable t
variable prefix
## called directly?
if {[info level] != 1} {
set prefix
} else {
set prefix
}
set quizstate "stopped"
## kill timers
foreach t [utimers] {
if {[lindex $t 1] == "mx_timer_ask" || [lindex $t 1] == "mx_timer_tip"} {
killutimer [lindex $t 2]
}
}
mx_log "--- Game stopped."
mxirc_say $quizconf(quizchannel) "Games ScrambLe stopped."
return 1
}
## halt
## halt everything and kill all timers
proc tmcquiz_halt {handle idx arg} {
global quizstate banner bannerspace
global quizconf
variable t
variable prefix
## called directly?
if {[info level] != 1} {
set prefix [bannerspace]
} else {
set prefix
}
set quizstate "halted"
## kill timers
foreach t [utimers] {
if {[lindex $t 1] == "mx_timer_ask" || [lindex $t 1] == "mx_timer_tip"} {
killutimer [lindex $t 2]
}
}
mx_log "--- Game halted."
mxirc_say $quizconf(quizchannel) "0,12 2 0,2 12 2,1 9,1 Games Scramble halted. Type 9!start 4for new questions. 2,1 12,2 0 2,12 0 "
return 1
}
## reload questions
proc tmcquiz_reload {handle idx arg} {
global qlist quizconf
global datadir gamedata
variable alist ""
variable banks
variable suffix
set arg [string trim $arg]
if {$arg == ""} {
# get question files
set alist [glob -nocomplain "$datadir/questions.*"]
# get suffixes
foreach file $alist {
regexp "^.*\\.(\[^\\.\]+)$" $file foo suffix
set banks($suffix) 1
}
# report them
mxirc_dcc $idx "There are the following question banks available (current: $quizconf(questionset)): [lsort [array names banks]]"
} else {
if {[mx_read_questions $arg] != 0} {
mxirc_dcc $idx "There was an error reading files for $arg."
mxirc_dcc $idx "There are [llength $qlist] questions available."
} else {
mxirc_dcc $idx "Reloaded database, [llength $qlist] questions."
set quizconf(questionset) $arg
}
}
return 1
}
## exit -- finish da thing and logoff
proc tmcquiz_exit {nick host handle channel idx} {
global rankfile uptime botnick
global quizconf
mx_log "--- EXIT requested."
mxirc_say $quizconf(quizchannel) "0,1I am leaving now."
tmcquiz_rank_save $handle $idx {}
tmcquiz_saveuserquests $handle $idx "all"
tmcquiz_config_save $handle $idx {}
mxirc_dcc $idx "$botnick now exits."
mx_log "--- $botnick exited"
mx_log "**********************************************************************"
utimer 5 die
}
###########################################################################
#
# commands for the questions
#
###########################################################################
## something was said. Solution?
proc tmcquiz_pubm {nick host handle channel text} {
global quizstate
global timeasked theq aftergame
global usergame revoltlist
global lastsolver lastsolvercount
global lastwinner lastwinnercount
global botnick
global userlist
global quizconf
variable bestscore 0 lastbestscore 0 lastbest ""
variable userarray
variable authorsolved 0 waitforrank 0 gameend 0
# ## only accept chatter on quizchannel
if {![mx_str_ieq $channel $quizconf(quizchannel)]} {
return
}
## record that the $nick spoke and create entries for unknown people
mx_getcreate_userentry $nick $nick
array set userarray $userlist($nick)
# set hostmask $userarray(mask)
## not in asking state?
if {$quizstate != "asked"} {
return
}
# nick has revolted
# if {[lsearch -exact $revoltlist $hostmask] != -1} {
# return
# }
# nick is author of userquest
if {([info exists theq(Author)] && [mx_str_ieq $nick $theq(Author)])
|| ([info exists theq(Hostmask)] && [mx_str_ieq [maskhost $nick] $theq(Hostmask)])} {
set authorsolved 1
}
## tweak german umlauts in input
set text [mx_tweak_umlauts $text]
if {[regexp -nocase -- $theq(Regexp) $text]} {
## reset quiz state related stuff (and save userquestions)
mx_answered
set duration [mx_duration $timeasked]
# if it wasn't the author
if {!$authorsolved} {
## save last top score for the test if reset is near (later below)
set lastbest [lindex [lsort -command mx_sortrank [array names userlist]] 0]
if {$lastbest == ""} {
set lastbestscore 0
} else {
array set aa $userlist($lastbest)
set lastbestscore $aa(score)
}
## record nick for bonus points
if {[mx_str_ieq [maskhost $nick] $lastsolver]} {
incr lastsolvercount
} else {
set lastsolver [maskhost $nick]
set lastsolvercount 1
}
# ## ignore games_max in a row winner
# if {[mx_str_ieq [maskhost $nick] $lastwinner]
# && $lastwinnercount >= $quizconf(lastwinner_max_games)
# && $quizconf(lastwinner_restriction) == "yes"} {
# return
# }
# ##with or without bonus
set bonuse "[get_bonuses]"
if {$lastsolvercount == 1} {
set addscored "$theq(Score)"
} elseif {$lastsolvercount >= 2} {
set addscored "[expr $bonuse + $theq(Score)]"
}
## save score (set started time to time of first point)
incr userarray(score) $addscored
if {$userarray(score) == 1} {
set userarray(started) [unixtime]
}
set userlist($nick) [array get userarray]
## tell channel, that the question is solved
mx_log "--- solved after $duration by $nick with \"$text\", now has $userarray(score) points"
regsub -all "\#(\[^\#\]*\)\#" $theq(Answer) "\\1" answer
mxirc_say $channel "0,12 2 0,2 12 2,1 15,1 Jawaban Betul :11,1 $answer 15,1by ->3,1 $nick 15,1waktu7,1 $duration 0,1- 15,1Score8,1 +$theq(Score) 15,1 Points - Total Score:8,1 $userarray(score) 15,1points - Rank:8,1 [mx_get_rank_pos $nick] 2,1 12,2 0 2,12 0 "
## honor good games!
if {$lastsolvercount == 1} {
tmcquiz_rank_set $botnick 0 "$nick +0"
mxirc_say $channel ""
# pushmode $channel +v $nick
} elseif {$lastsolvercount >= 2} {
set greeting "[get_grated]"
tmcquiz_rank_set $botnick 0 "$nick +0"
mxirc_say $channel ""
# pushmode $channel +v $nick
}
## rankreset, if above winscore
# notify if this comes near
set best [lindex [lsort -command mx_sortrank [array names userlist]] 0]
if {$best == ""} {
set bestscore 0
} else {
array set aa $userlist($best)
set bestscore $aa(score)
}
set waitforrank 0
if {[mx_str_ieq $best $nick] && $bestscore > $lastbestscore} {
array set aa $userlist($best)
# mxirc_say $channel "$nick reaches $quizconf(winscore) points and wins$price"
set now [unixtime]
if {[mx_str_ieq [maskhost $nick] $lastwinner]} {
incr lastwinnercount
if {$lastwinnercount >= $quizconf(lastwinner_max_games)
&& $quizconf(lastwinner_restriction) == "yes"} {
# mxirc_notc $nick "Since you won $quizconf(lastwinner_max_games) games in a row, you will be ignored for the next game. This is a safety feature to stop answer bots."
}
} else {
set lastwinner [maskhost $nick]
set lastwinnercount 1
}
# show rank at 1/3, 2/3 of and 5 before winscore
set spitrank 1
foreach third [list [expr $quizconf(winscore) / 3] [expr 2 * $quizconf(winscore) / 3] [expr $quizconf(winscore) - 5]] {
if {$lastbestscore < $third && $bestscore >= $third && $spitrank} {
tmcquiz_rank $botnick 0 {}
set spitrank 0
# set waitforrank 15
}
}
}
} else {
## tell channel, that the question is solved by author
mx_log "--- solved after $duration by $nick with \"$text\" by author"
regsub -all "\#(\[^\#\]*\)\#" $theq(Answer) "\\1" answer
mxirc_say $channel "6$nick solved his own question after 12 $duration 6 and has no points, keeping 12 $userarray(score) 6 points on rank 12 mx_get_rank_pos $nick6 The Answer was: 12 $answer "
# remove area of tip generation tags
regsub -all "\#(\[^\#\]*\)\#" $theq(Answer) "\\1" answer
# mxirc_say $channel "The answer was: $answer"
}
## check if game has ended and react
if {!$gameend || $aftergame == "newgame"} {
# set up ask timer
utimer [expr $waitforrank + $quizconf(askdelay)] mx_timer_ask
} else {
mx_aftergameaction
}
}
}
## ask a question, start game
proc tmcquiz_ask {nick host handle channel arg} {
global qlist quizstate botnick
global tipno tiplist
global userqnumber usergame userqlist
global timeasked qnumber qlistorder theq
global qnum_thisgame
global userlist timerankreset
global quizconf
variable anum 0
variable txt
## only accept chatter on quizchannel
if {![mx_str_ieq $channel $quizconf(quizchannel)]} {
return
}
# switch -exact $quizstate {
# "paused" {
# mxirc_notc $nick "Game is paused."
# return 1
# }
# "stopped" {
# mxirc_notc $nick "Game is stopped."
# return 1
# }
# }
## record that $nick spoke (prevents desert detection from stopping,
## when an user joins and starts the game with !ask)
# if {![mx_str_ieq $nick $botnick]} {
# mx_getcreate_userentry $nick $nick
# }
## any questions available?
if {[llength $qlist] == 0 && [mx_userquests_available] == 0} {
mxirc_say $channel "Sorry, my database is empty."
} elseif {$quizstate == "asked"} {
## game runs, tell user the question via msg
set txt "Current"
if {[info exists theq(Level)]} {
set txt "$txt level $theq(Level)"
}
if {$usergame == 1} {
set txt "$txt user"
}
set txt "$txt question no. $qnum_thisgame is \""
if {[info exists theq(Category)]} {
set txt "${txt}\($theq(Category)\) "
}
set txt "$txt$theq(Question)\" open for [mx_duration $timeasked]"
if {$theq(Score) > 1} {
set txt "$txt, worth $theq(Score) points."
} else {
set txt "$txt."
}
mxirc_notc $nick $txt
} elseif {$quizstate == "waittoask" && ![mx_str_ieq $nick $botnick]} {
## no, user has to be patient
mxirc_notc $nick "Please stand by, the next question comes in less than $quizconf(askdelay) seconds."
} else {
##
## ok, now lets see, which question to ask (normal or user)
##
## clear old question
foreach k [array names theq] {
unset theq($k)
}
if {[mx_userquests_available]} {
## select a user question
array set theq [lindex $userqlist $userqnumber]
set usergame 1
incr userqnumber
mx_log "--- asking a user question: $theq(Question)"
} else {
variable ok 0
while {!$ok} {
## select a normal question
if {$qnumber >= [llength $qlistorder]} {
set qnumber 0
set qlistorder [mx_mixedlist [llength $qlist]]
}
array set theq [lindex $qlist [lindex $qlistorder $qnumber]]
set usergame 0
# skip question if author is about to win
if {[info exists theq(Author)] && [info exists userlist($theq(Author))]} {
array set auser $userlist($theq(Author))
if {$auser(score) >= [expr $quizconf(winscore) - 5]} {
mx_log "--- skipping question number $qnumber ([lindex $qlistorder $qnumber]), author is about to win"
## clear old question
foreach k [array names theq] {
unset theq($k)
}
} else {
mx_log "--- asking question number $qnumber ([lindex $qlistorder $qnumber]): $theq(Question)"
set ok 1
}
} else {
mx_log "--- asking question number $qnumber ([lindex $qlistorder $qnumber]): $theq(Question)"
set ok 1
}
incr qnumber
}
}
incr qnum_thisgame
if {$qnum_thisgame == 1} {
set timerankreset [unixtime]
mx_log "---- it's the no. $qnum_thisgame in this game, rank timer started."
} else {
mx_log "---- it's the no. $qnum_thisgame in this game."
}
##
## ok, set some minimal required fields like score, regexp and the tiplist.
##
## set regexp to match
if {![info exists theq(Regexp)]} {
## mask all regexp special chars except "."
set aexp [mx_tweak_umlauts $theq(Answer)]
regsub -all "(\\+|\\?|\\*|\\^|\\$|\\(|\\)|\\\[|\\\]|\\||\\\\)" $aexp "\\\\\\1" aexp
# get #...# area tags for tipgeneration as regexp
regsub -all ".*\#(\[^\#\]*\)\#.*" $aexp "\\1" aexp
set theq(Regexp) $aexp
} else {
set theq(Regexp) [mx_tweak_umlauts $theq(Regexp)]
}
# protect embedded numbers
if {[regexp "\[0-9\]+" $theq(Regexp)]} {
set newexp ""
set oldexp $theq(Regexp)
set theq(Oldexp) $oldexp
while {[regexp -indices "(\[0-9\]+)" $oldexp pair]} {
set subexp [string range $oldexp [lindex $pair 0] [lindex $pair 1]]
set newexp "${newexp}[string range $oldexp -1 [expr [lindex $pair 0] - 1]]"
if {[regexp -- $theq(Regexp) $subexp]} {
set newexp "${newexp}(^|\[^0-9\])${subexp}(\$|\[^0-9\])"
} else {
set newexp "${newexp}${subexp}"
}
set oldexp "[string range $oldexp [expr [lindex $pair 1] + 1] [string length $oldexp]]"
}
set newexp "${newexp}${oldexp}"
set theq(Regexp) $newexp
mx_log "---- replaced regexp '$theq(Oldexp)' with '$newexp' to protect numbers."
}
## set score
if {![info exists theq(Score)]} {
set theq(Score) 50
}
## set category
## set anum [lsearch -exact $alist "Category"]
## if {![info exists theq(Category)} {
## set theq(Category) "unknown"
##}
## initialize tiplist
set anum 0
set tiplist ""
while {[info exists theq(Tip$anum)]} {
lappend tiplist $theq(Tip$anum)
incr anum
}
# No tips found? construct standard list
if {$anum == 0} {
set add "·"
# extract area of tip generation tags
if {![regsub -all ".*\#(\[^\#\]*\)\#.*" $theq(Answer) "\\1" answer]} {
set answer $theq(Answer)
}
## use tipcycle from questions or
## generate less tips if all words shorter than $tipcycle
if {[info exists theq(Tipcycle)]} {
set limit $theq(Tipcycle)
} else {
set limit $quizconf(tipcycle)
## check if at least one word long enough
set tmplist [lsort -command mx_cmp_length -decreasing [split $answer " "]]
# not a big word
if {[string length [lindex $tmplist 0]] < $quizconf(tipcycle)} {
set limit [string length [lindex $tmplist 0]]
}
}
for {set anum 0} {$anum < $limit} {incr anum} {
set tiptext ""
set letterno 0
for {set i 0} {$i < [string length $answer]} {incr i} {
if {([expr [expr $letterno - $anum] % $quizconf(tipcycle)] == 0) ||
([regexp "\[- \.,`'\"\]" [string range $answer $i $i] foo])} {
set tiptext "$tiptext[string range $answer $i $i]"
if {[regexp "\[- \.,`'\"\]" [string range $answer $i $i] foo]} {
set letterno -1
}
} else {
set tiptext "$tiptext$add"
}
incr letterno
}
lappend tiplist $tiptext
}
}
##
## Now construct the text to print
##
# set ans "word : $answer"
set txt "0,12 2 0,2 12 2,1 9,1 AZKALIXSCRAMBLE 2,1 12,2 0 2,12 0 "
mxirc_say $channel $txt
set txt ""
set txt "0,12 2 0,2 12 2,1 15,1 Hint 9:9,1 $txt$theq(Question) 2,1 12,2 0 2,12 0 "
set ans "0,12 2 0,2 12 2,1 15,1 Word 9:8,1 [randomanswer $answer] 2,1 12,2 0 2,12 0 "
set tipz "0,12 2 0,2 12 2,1 15,1 [get_InfoItem] 2,1 12,2 0 2,12 0 "
mxirc_say $channel $txt
mxirc_say $channel $ans
mxirc_say $channel $tipz
set quizstate "asked"
set tipno 0
set timeasked [unixtime]
## set up tip timer
utimer $quizconf(tipdelay) mx_timer_tip
}
}
## A user dislikes the question
proc tmcquiz_user_revolt {nick host handle channel text} {
global revoltlist revoltmax tipno botnick quizstate
global userlist
global quizconf
## only accept revolts on the quizchannel
if {![mx_str_ieq $channel $quizconf(quizchannel)]} {
return
}
if {$quizstate == "asked"} {
if {$tipno < 1} {
# mxirc_action $channel "does not react on revolts before at least one tip was given."
return
}
## ensure that the revolting user has an entry
if {![info exists userlist($nick)]} {
mx_getcreate_userentry $nick $nick
}
# ## calculate people needed to make a revolution (50% of active users)
# mx_log "--- a game runs, !revolt. revoltmax = $revoltmax"
# if {$revoltmax == 0} {
# set now [unixtime]
# foreach u [array names userlist] {
# array set afoo $userlist($u)
# if {[expr $now - $afoo(lastspoken)] <= $quizconf(useractivetime)} {
# incr revoltmax
# }
# }
# mx_log "---- active people are $revoltmax"
# # one and two player shoud revolt "both"
# if {$revoltmax > 2} {
# set revoltmax [expr int(ceil(double($revoltmax) / 2))]
# }
# mx_log "---- people needed for a successful revolution: $revoltmax"
# }
# records known users dislike
if {[info exists userlist($nick)]} {
array set anarray $userlist($nick)
set hostmask $anarray(mask)
if {[lsearch -exact $revoltlist $hostmask] == -1} {
mxirc_quick_notc $nick "Since you are revolting, you will be ignored for this question."
# mxirc_action $channel "6sees that $nick and [llength $revoltlist] other dislike the question, you need $revoltmax people."
lappend revoltlist $hostmask
# set anarray(lastspoken) [unixtime]
# set userlist($nick) [array get anarray]
mx_log "--- $nick is revolting, revoltmax is $revoltmax"
}
}
if {[llength $revoltlist] >= $revoltmax} {
set revoltmax 0
mx_log "--- solution forced by revolting."
mxirc_action $channel "0,1will solve the question immediately."
tmcquiz_solve $botnick 0 {}
}
}
}
## solve question
proc tmcquiz_solve {handle idx arg} {
global quizstate theq
global botnick lastsolvercount lastsolver timeasked
global quizconf
variable txt
variable answer
if {$quizstate != "asked"} {
mxirc_dcc $idx "There is no open question."
} else {
mx_answered
set lastsolver ""
set lastsolvercount 0
if {[mx_str_ieq $botnick $handle]} {
set txt "0,12 2 0,2 12 2,1 15,1 Times Up :"
set solver ""
} else {
set txt "0,1Manually"
set solver "by $handle"
}
regsub -all "\#(\[^\#\]*\)\#" $theq(Answer) "\\1" answer
set txt "$txt $answer 2,1 12,2 0 2,12 0 "
mxirc_say $quizconf(quizchannel) $txt
# remove area of tip generation tags
# regsub -all "\#(\[^\#\]*\)\#" $theq(Answer) "\\1" answer
# mxirc_say $quizconf(quizchannel) "12 The answer is: $answer"
# remove protection of numbers from regexp
if {[info exists theq(Oldexp)]} {
set theexp $theq(Oldexp)
} else {
set theexp $theq(Regexp)
}
if {$answer != $theexp} {
# mxirc_say $quizconf(quizchannel) "And should match: $theexp"
}
mx_log "--- solved by $handle manually."
# schedule ask
utimer $quizconf(askdelay) mx_timer_ask
}
return 1
}
## show a tip
proc tmcquiz_tip {handle idx arg} {
global tipno quizstate
global botnick tiplist
global quizconf
if {$quizstate == "asked"} {
if {$arg != ""} {
mxirc_dcc $idx "Extra tip \'$arg\' will be given."
set tiplist [linsert $tiplist $tipno $arg]
}
if {$tipno == [llength $tiplist]} {
# enough tips, solve!
set tipno 0
tmcquiz_solve $botnick 0 {}
} else {
set tiptext [lindex $tiplist $tipno]
# mxirc_say $quizconf(quizchannel) "Hint [expr $tipno + 1]:"
# mxirc_say $quizconf(quizchannel) "$tiptext"
foreach j [utimers] {
if {[lindex $j 1] == "mx_timer_tip"} {
killutimer [lindex $j 2]
}
}
mx_log "----- Tip number $tipno: $tiptext"
# only short delay after last tip
incr tipno
if {$tipno == [llength $tiplist]} {
utimer 15 mx_timer_tip
} else {
utimer $quizconf(tipdelay) mx_timer_tip
}
}
} else {
mxirc_dcc $idx "Sorry, no question is open."
}
return 1
}
## schedule a userquest
proc tmcquiz_userquest {nick host handle arg} {
global userqlist
global quizconf
variable uanswer "" uquestion "" umatch ""
variable tmptext ""
if {$quizconf(userquestions) == "no"} {
mxirc_notc $nick "Sorry, userquestions are disabled."
return
}
if {![onchan $nick $quizconf(quizchannel)]} {
mxirc_notc $nick "Sorry, you MUST be in the quizchannel to ask questions."
} else {
if {[mx_userquests_available] >= $quizconf(userqbufferlength)} {
mxirc_notc $nick "Sorry, there are already $quizconf(userqbufferlength) user questions scheduled. Try again later."
} else {
set arg [mx_strip_colors $arg]
if {$quizconf(stripumlauts) == "yes"} {
set arg [mx_tweak_umlauts $arg]
}
if {[regexp "^(.+)::(.+)::(.+)$" $arg foo uquestion uanswer umatch] || \
[regexp "(.+)::(.+)" $arg foo uquestion uanswer]} {
set uquestion [string trim $uquestion]
set uanswer [string trim $uanswer]
set alist [concat "Question" "{$uquestion}" "Answer" "{$uanswer}" "Author" "{$nick}" "Hostmask" "[maskhost $nick]" "Date" "[ctime [unixtime]]"]
if {$umatch != ""} {
set umatch [string trim $umatch]
lappend alist "Regexp" "$umatch"
set mtext ", match \"$umatch\""
}
lappend userqlist $alist
mxirc_notc $nick "Your quest \"$uquestion\" is scheduled with answer \"$uanswer\"$tmptext and will be asked after [expr [mx_userquests_available] - 1] questions."
mx_log "--- Userquest scheduled by $nick: \"$uquestion\"."
} else {
mxirc_notc $nick "Wrong number of parameters. Use alike ::::. The regexp is optional and used with care."
mxirc_notc $nick "You said: \"$arg\". I recognize this as: \"$uquestion\" and \"$uanswer\", regexp: \"$umatch\"."
mx_log "--- userquest from $nick failed with: \"$arg\""
}
}
}
return
}
## usersolve
proc tmcquiz_usersolve {nick host handle arg} {
global quizstate usergame theq
mx_log "--- Usersolve requested by $nick."
if {$quizstate == "asked" && $usergame == 1} {
if {[info exists theq(Author)] && ![mx_str_ieq $nick $theq(Author)]} {
mxirc_notc $nick "No, only $theq(Author) can solve this question!"
} else {
tmcquiz_solve $nick 0 {}
}
} else {
mxirc_notc $nick "No usergame running."
}
return 1
}
## usercancel
proc tmcquiz_usercancel {nick host handle arg} {
global quizstate usergame theq userqnumber userqlist
mx_log "--- Usercancel requested by $nick."
if {$quizstate == "asked" && $usergame == 1} {
if {[info exists theq(Author)] && ![mx_str_ieq $nick $theq(Author)]} {
mxirc_notc $nick "No, only $theq(Author) can cancel this question!"
} else {
mxirc_notc $nick "Your question is canceled and will be solved."
set theq(Comment) "canceled by user"
tmcquiz_solve "user canceling" 0 {}
}
} elseif {[mx_userquests_available]} {
array set aq [lindex $userqlist $userqnumber]
if {[mx_str_ieq $aq(Author) $nick]} {
mxirc_notc $nick "Your question \"$aq(Question)\" will be skipped."
set aq(Comment) "canceled by user"
set userqlist [lreplace $userqlist $userqnumber $userqnumber [array get aq]]
incr userqnumber
} else {
mxirc_notc $nick "Sorry, the next question is by $aq(Author)."
}
} else {
mxirc_notc $nick "No usergame running or ahead."
}
return 1
}
## pubm help wrapper
proc tmcquiz_pub_help {nick host handle channel arg} {
global quizconf
if {![mx_str_ieq $channel $quizconf(quizchannel)]} {
return 0
} else {
tmcquiz_help $nick $nick $handle $arg
return 1
}
}
## pubm !score to report scores
proc tmcquiz_pub_score {nick host handle channel arg} {
global userlist
global quizconf
variable pos 0
variable target
variable self 0
if {![mx_str_ieq $channel $quizconf(quizchannel)]} {
return 0
} else {
set arg [string trim "$arg"]
if {$arg != "" && $arg != $nick} {
set target $arg
} else {
set target $nick
set self 1
}
# report rank entries
if {[info exists userlist($target)]} {
array set userarray $userlist($target)
if {$userarray(score)} {
# calc position
set pos [mx_get_rank_pos $target]
if {$self} {
mxirc_say $channel "0,12 2 0,2 12 2,1 15,1 $nick 15,Kamu punya nilai4 $userarray(score) 15points. Rank:8 $pos 2,1 12,2 0 2,12 0 "
} else {
mxirc_say $channel "0,12 2 0,2 12 2,1 15,1 $nick, 15Teman kamu9 $target 15Punya4 $userarray(score) 15points .Rank:8 $pos 2,1 12,2 0 2,12 0 "
}
} else {
if {$self} {
mxirc_say $channel "0,12 2 0,2 12 2,1 15,1 $nick, 15Score kamu masih kosong 2,1 12,2 0 2,12 0 "
} else {
mxirc_say $channel "0,12 2 0,2 12 2,1 15,1 $target 15masih kosong tuh 2,1 12,2 0 2,12 0 "
}
}
} else {
if {$self} {
# mxirc_say $channel "6kzkz,12 You 6are not yet listed for the current game."
} else {
# mxirc_say $channel "6kzkz,12 $target 6is not yet listed for the current game."
}
}
return 1
}
}
## help
proc tmcquiz_help {nick host handle arg} {
global botnick version_tmcquizz
global quizconf quizhelp quizshorthelp
global funstuff_enabled
variable lines
variable help
variable topics [array names quizhelp]
set arg [string tolower [string trim $arg]]
# choose help text
mx_log "--- help requested by $nick about '$arg'"
# elide some help text based on configuration
if {$quizconf(userquestions) == "no"} {
set index [lsearch $topics "userquestions"]
set topics [lreplace $topics $index $index]
}
if {![info exists funstuff_enabled] || $funstuff_enabled != 1} {
set index [lsearch $topics "fun"]
set topics [lreplace $topics $index $index]
}
# select help text
if {$arg == ""} {
set lines [format $quizshorthelp $topics]
} else {
if {[lsearch $topics $arg] != -1} {
set lines $quizhelp($arg)
} else {
set lines [list "Can't help you about '$arg'. Choose a topic from: $topics."]
}
}
# dump help
mxirc_notc $nick "Help for $botnick version $version_tmcquizz"
foreach line $lines {
mxirc_notc $nick $line
}
return 1
}
## skipuserquest -- removes a scheduled userquest
proc tmcquiz_skipuserquest {handle idx arg} {
global userqnumber userqlist
if {[mx_userquests_available]} {
mxirc_dcc $idx "Skipping the userquest [lindex $userqlist $userqnumber]"
incr userqnumber
} else {
mxirc_dcc $idx "No usergame scheduled."
}
return 1
}
## saveuserquest -- append all asked user questions to $userqfile
proc tmcquiz_saveuserquests {handle idx arg} {
global userqfile userqlist userqnumber
variable uptonum $userqnumber
array set aq ""
if {[llength $userqlist] == 0 || ($userqnumber == 0 && $arg == "")} {
mxirc_dcc $idx "No user questions to save."
} else {
# save all questions?
if {[string tolower [string trim $arg]] == "all"} {
set uptonum [llength $userqlist]
}
mx_log "--- Saving userquestions ..."
if {[file exists $userqfile] && ![file writable $userqfile]} {
mxirc_dcc $idx "Cannot save user questions to \"$userqfile\"."
mx_log "--- Saving userquestions ... failed."
} else {
set fd [open $userqfile a+]
## assumes, that userqlist is correct!!
for {set anum 0} {$anum < $uptonum} {incr anum} {
set q [lindex $userqlist $anum]
# clear old values
foreach val [array names aq] {
unset aq($val)
}
array set aq $q
# write some first elements
foreach n [list "Question" "Answer" "Regexp"] {
if {[info exists aq($n)]} {
puts $fd "$n: $aq($n)"
unset aq($n)
}
}
# spit the rest
foreach n [lsort -dictionary [array names aq]] {
puts $fd "$n: $aq($n)"
}
puts $fd ""
}
close $fd
# prune saved and asked questions
for {set i 0} {$i < $userqnumber} {incr i} {
set userqlist [lreplace $userqlist 0 0]
}
mxirc_dcc $idx "Saved $userqnumber user questions."
mx_log "--- Saving userquestions ... done"
## reset userqnumber
set userqnumber 0
}
}
return 1
}
## set score of open question
proc tmcquiz_set_score {handle idx arg} {
## [pending] obeye state!
global quizstate theq banner
global quizconf
mx_log "--- set_score by $handle: $arg"
if {![regexp {^[0-9]+$} $arg]} {
mxirc_dcc $idx "$arg not a valid number."
} elseif {$arg == $theq(Score)} {
mxirc_dcc $idx "New score is same as old score."
} else {
mxirc_dcc $idx "Setting score for the question to $arg points ([format "%+d" [expr $arg - $theq(Score)]])."
mxirc_say $quizconf(quizchannel) "Setting score for the question to $arg points ([format "%+d" [expr $arg - $theq(Score)]])."
set theq(Score) $arg
}
return 1
}
###########################################################################
#
# commands to manage the rankings
#
###########################################################################
## read ranks from $rankfile
proc tmcquiz_rank_load {handle idx arg} {
global rankfile userlist timerankreset
global lastsolver lastsolvercount qnum_thisgame
global quizconf
variable timeranksaved [unixtime]
variable fd
variable line
variable us 0 sc 0
## clear old userlist (ranks)
foreach u [array names userlist] {
unset userlist($u)
}
## load saved scores
if {[file exists $rankfile] && [file readable $rankfile]} {
set fd [open $rankfile r]
while {![eof $fd]} {
set line [gets $fd]
if {![regexp "#.*" $line]} {
switch -regexp $line {
default {
scan $line "%s %d" us sc
set alist [list "score" $sc]
set userlist($us) $alist
}
}
}
}
close $fd
mxirc_dcc $idx "Ranks loaded ([llength [array names userlist]])"
mx_log "--- Ranks loaded ([llength [array names userlist]])"
} else {
mxirc_dcc $idx "Could not read \"$rankfile\"."
mx_log "---- could not read \"$rankfile\"."
}
return 1
}
## save ranks to $rankfile normally
proc tmcquiz_rank_save {handle idx arg} {
global rankfile userlist
global lastsolver lastsolvercount timerankreset
global qnum_thisgame
global quizconf
variable fd
## save ranks
if {[llength [array names userlist]] > 0} {
set fd [open $rankfile w]
foreach u [lsort -command mx_sortrank [array names userlist]] {
array set aa $userlist($u)
puts $fd [format "%s %d" $u $aa(score)]
}
close $fd
mx_log "--- Ranks saved to \"$rankfile\"."
mxirc_dcc $idx "Ranks saved to \"$rankfile\"."
} else {
mxirc_dcc $idx "Ranks are empty, nothing saved."
}
return 1
}
## save ranks to $rankfile as requested
proc tmcquiz_rank_saver {handle idx arg} {
global rankfile userlist
global lastsolver lastsolvercount timerankreset
global qnum_thisgame
global quizconf
variable fd
## save ranks
if {[llength [array names userlist]] > 0} {
set fd [open $rankfile w]
foreach u [lsort -command mx_sortrank [array names userlist]] {
array set aa $userlist($u)
puts $fd [format "%s %d" $u $aa(score)]
}
close $fd
mx_log "--- Ranks saved to \"$rankfile\"."
mxirc_dcc $idx "Ranks saved to \"$rankfile\"."
mxirc_say $quizconf(quizchannel) "6Don`t worry, 12Your6 score has been saved!"
} else {
mxirc_dcc $idx "Ranks are empty, nothing saved."
}
return 1
}
## set score of a player
proc tmcquiz_rank_set {handle idx arg} {
global userlist botnick
global quizconf
variable list
variable user "" newscore 0 oldscore 0
# variable prefix
## called directly?
# if {[info level] != 1} {
# set prefix
# } else {
# set prefix
# }
mx_log "--- rankset requested by $handle: $arg"
set list [split $arg]
for {set i 0} {$i < [llength $list]} {incr i 2} {
set user [lindex $list $i]
set newscore [lindex $list [expr 1 + $i]]
if {($newscore == "") || ($user == "")} {
mxirc_dcc $idx "Wrong number of parameters. Cannot set \"$user\" to \"$newscore\"."
} elseif {[regexp {^[\+\-]?[0-9]+$} $newscore] == 0} {
mxirc_dcc $idx "$newscore is not a number. Ignoring set for $user."
} else {
if {![info exists userlist($user)]} {
if {[onchan $user $quizconf(quizchannel)]} {
mx_getcreate_userentry $user [getchanhost $user $quizconf(quizchannel)]
} else {
mxirc_dcc $idx "Could not set rank for $user. Not in list nor in quizchannel."
continue
}
}
array set aa $userlist($user)
set oldscore $aa(score)
if {[regexp {^[\+\-][0-9]+$} $newscore]} {
set newscore [expr $oldscore + $newscore]
if {$newscore < 0} {
mxirc_dcc $idx "You set the score of $user to $newscore. Will be corrected to 0."
set newscore 0
}
}
set aa(score) $newscore
set userlist($user) [array get aa]
## did we change something?
if {[expr $newscore - $oldscore] != 0} {
set txt "0,12 2 0,2 12 2,1 15,1 $user 15has repeat bonus4 [format "%+d" [expr $newscore - $oldscore]] 15pts, Total4 $newscore 15pts, Rank8 [mx_get_rank_pos $user] 2,1 12,2 0 2,12 0 "
# set prefix
if {![mx_str_ieq $handle $botnick] && [hand2nick $handle] != ""} {
set txt "$txt Set by [hand2nick $handle]."
}
# mxirc_say $quizconf(quizchannel) $txt
}
# mxirc_dcc $idx "$user has new score $newscore ([format "%+d" [expr $newscore - $oldscore]]) on rank [mx_get_rank_pos $user]."
}
}
return 1
}
## delete a player from rank
proc tmcquiz_rank_delete {handle idx arg} {
global userlist
mx_log "--- rank delete requested by $handle: $arg"
if {$arg == ""} {
mxirc_dcc $idx "Tell me whom to delete."
} else {
foreach u [split $arg " "] {
if {[info exists userlist($u)]} {
array set aa $userlist($u)
mxirc_dcc $idx "Nick $u removed from ranks. Score was $aa(score) points."
unset userlist($u)
} else {
mxirc_dcc $idx "Nick $u not in ranks."
}
}
}
return 1
}
## list ranks by notice to a user
proc tmcquiz_pub_rank {nick host handle channel arg} {
set arg [string trim $arg]
if {$arg == ""} {
set arg 5
} elseif {![regexp "^\[0-9\]+$" $arg]} {
mxirc_notc $nick "Sorry, \"$arg\" is not an acccepted number."
return
}
# mx_spit_rank "NOTC" $nick $arg
mx_spit_rank "NOTC" $channel $arg
}
## show rankings
proc tmcquiz_rank {handle idx arg} {
global quizconf
set arg [string trim $arg]
if {$arg == ""} {
set arg 10
} elseif {![regexp "^\[0-9\]+$" $arg]} {
mxirc_dcc $idx "Sorry, \"$arg\" is not an acccepted number."
}
mx_spit_rank "CHANNEL" $quizconf(quizchannel) $arg
}
## function to show the rank to a nick or channel
proc mx_spit_rank {how where length} {
global timerankreset
global userlist
global quizconf
variable pos 1
variable prevscore 0
variable entries 0
variable lines ""
# anybody with a point?
foreach u [array names userlist] {
array set aa $userlist($u)
if {$aa(score) > 0} {
set entries 1
break
}
}
# build list
if {$entries == 0} {
lappend lines "Highscore list is empty."
} else {
if {$length > $quizconf(maxranklines)} {
set length $quizconf(maxranklines)
# lappend lines "Your requested too many lines, limiting to $quizconf(maxranklines)."
}
lappend lines "0,13 6 0,6 13 6,1 15,1 Top $length Games Highscores: 6,1 13,6 0 6,13 0 "
set pos 1
set prevscore 0
foreach u [lsort -command mx_sortrank [array names userlist]] {
array set aa $userlist($u)
if {$aa(score) == 0} { break }
if {$pos > $length && $aa(score) != $prevscore} { break }
if {$aa(score) == $prevscore} {
set text "0,1= "
} else {
set text [format "%2d " $pos]
}
set text [format "0,1 $text %15s :: %7d pts." $u $aa(score)]
if {$pos == 1} {
set text "0,1$text"
}
lappend lines $text
set prevscore $aa(score)
incr pos
}
lappend lines "0,13 6 0,6 13 6,1 15,1 End of Top $length Rank of Games. 6,1 13,6 0 6,13 0 "
}
# spit lines
foreach line $lines {
if {$how == "NOTC"} {
mxirc_say $quizconf(quizchannel) $line
# mxirc_notc $quizconf(quizchannel) $line
} else {
mxirc_say $quizconf(quizchannel) $line
}
}
return 1
}
## calculate position of nick in the rank table
proc mx_get_rank_pos {nick} {
global userlist
variable pos 0
variable prevscore 0
if {[llength [array names userlist]] == 0 || \
![info exists userlist($nick)]} {
return 0
}
# calc position
foreach name [lsort -command mx_sortrank [array names userlist]] {
array set afoo $userlist($name)
if {$afoo(score) != $prevscore} {
incr pos
}
set prevscore $afoo(score)
if {[mx_str_ieq $name $nick]} {
break
}
}
return $pos
}
## sort routine for the rankings
proc mx_sortrank {a b} {
global userlist
array set aa $userlist($a)
array set bb $userlist($b)
if {$aa(score) == $bb(score)} {
return 0
} elseif {$aa(score) > $bb(score)} {
return -1
} else {
return 1
}
}
###########################################################################
#
# Commands to handle the allstars list
#
###########################################################################
###########################################################################
#
# Configuration file reading and writing, setup
#
###########################################################################
# public interface to set the configuration variables from the config file
proc tmcquiz_config_set {handle idx arg} {
global quizconf
variable key
variable value
variable success 0
# collapse whitespace
regsub -all " +" $arg " " arg
# extract key and value
set list [split $arg]
for {set i 0} {$i < [llength $list]} {incr i 2} {
set key [string tolower [lindex $list $i]]
set value [lindex $list [expr 1 + $i]]
# first lets see if the key exists
set keylist [array names quizconf "*$key*"]
if {[llength $keylist] == 1} { set key [lindex $keylist 0] }
if {[info exists quizconf($key)]} {
if {$value == ""} {
mxirc_dcc $idx "$key = $quizconf($key)"
} else {
mx_log "--- config tried $key = $value"
set success 0
set oldvalue $quizconf($key)
switch -regexp $oldvalue {
"^(yes|no)" {
if {[regexp "^(yes|no)$" $value]} {
set quizconf($key) $value
set success 1
}
}
"^\[0-9\]+$" {
if {[regexp "^\[0-9\]+$" $value]} {
set quizconf($key) $value
set success 1
}
}
default {
set quizconf($key) $value
set success 1
}
}
if {$success == 1} {
mxirc_dcc $idx "Config $key successfully set to $value."
mx_log "-- config $key set to $value."
# action on certain variables
mx_config_apply $key $oldvalue
} else {
mxirc_dcc $idx "Config $key could not be set to '$value', wrong format."
mx_log "-- Config $key could not be set to '$value', wrong format."
}
set success 0
}
} else {
# dump keys with substring
set keylist [array names quizconf "*$key*"]
if {[llength $keylist] == 0} {
mxirc_dcc $idx "Sorry, no configuration matches '$key'"
} else {
mxirc_dcc $idx "Matched configuration settings for '$key':"
for {set j 0} {$j < [llength $keylist]} {incr j 1} {
mxirc_dcc $idx "[lindex $keylist $j] = $quizconf([lindex $keylist $j])"
}
}
}
}
# check if arg was empty and dump _all_ known keys then
if {$arg == ""} {
set keylist [array names quizconf]
mxirc_dcc $idx "Listing all settings:"
for {set j 0} {$j < [llength $keylist]} {incr j 1} {
mxirc_dcc $idx "[lindex $keylist $j] = $quizconf([lindex $keylist $j])"
}
}
return 1
}
# public interface for readconfig
proc tmcquiz_config_load {handle idx arg} {
global configfile
mxirc_dcc $idx "Loaded [mx_config_read $configfile] configuration entries."
}
# public interface for readconfig
proc tmcquiz_config_save {handle idx arg} {
global configfile
mxirc_dcc $idx "Saved [mx_config_write $configfile] configuration entries."
}
# applies a configuration and makes neccessary setup
proc mx_config_apply {key oldvalue} {
global whisperprefix quizconf botnick
variable value $quizconf($key)
switch -exact $key {
"winscore" {
if {$oldvalue != {}} {
# mxirc_say $quizconf(quizchannel) "Score to win set from $oldvalue to $value ([format "%+d" [expr $value - $oldvalue]])."
}
}
"msgwhisper" {
if {$value == "yes"} {
set whisperprefix "PRIVMSG"
} else {
set whisperprefix "NOTICE"
}
}
}
}
# reads configuration from cfile into global variable quizconf
proc mx_config_read {cfile} {
global quizconf
variable num 0
mx_log "--- Loading configuration from $cfile ..."
set fd [open $cfile r]
while {![eof $fd]} {
gets $fd line
if {![regexp "^ *#.*$" $line] && ![regexp "^ *$" $line]} {
set content [split $line {=}]
set key [string trim [lindex $content 0]]
set value [string trim [lindex $content 1]]
set quizconf($key) $value
incr num
}
}
close $fd
mx_log "--- Configuration loaded: $num settings."
foreach $key [array names quizconf] {
mx_config_apply $key {}
}
return $num
}
# writes configuration from global quizconf to cfile
proc mx_config_write {cfile} {
global quizconf
variable num 0
variable written ""
mx_log "--- Saving configuration to $cfile ..."
set fdin [open $cfile r]
set fdout [open "$cfile.tmp" w]
# replace known configs
while {![eof $fdin]} {
gets $fdin line
switch -regexp $line {
"(^ *$|^ *#.*$)" {
puts $fdout $line
}
"^(.*)=(.*)$" {
set content [split $line {=}]
set key [string trim [lindex $content 0]]
set value [string trim [lindex $content 1]]
if {[info exists quizconf([string trim $key])]} {
puts $fdout "$key = $quizconf([string trim $key])"
incr num
} else {
puts $fdout $line
}
lappend written [string trim $key]
}
}
}
# append "new" configs not mentioned in the file
puts $fdout "# New"
set keys [array names quizconf]
for {set i 0} {$i < [llength $keys]} {incr i} {
set key [lindex $keys $i]
if {[lsearch -exact $written $key] == -1} {
puts $fdout "$key = $quizconf($key)"
}
}
close $fdin
close $fdout
# delete old config
file rename -force "$cfile.tmp" $cfile
mx_log "--- Configuration saved: $num settings."
return $num
}
###########################################################################
#
# Handling of certain events, like +m, nickchanges and others
#
###########################################################################
## notification when a user joins in
proc tmcquiz_on_joined {nick host handle channel} {
global qlist version_tmcquizz userlist
global quizconf quizstate qnum_thisgame
# variable text
if {![mx_str_ieq $channel $quizconf(quizchannel)]} {
return
}
# unset text "Scrämßlé © Say \"!start\" untuk memulai"
# mxirc_notc $nick $text
if {[info exists userlist($nick)]} {
array set aa $userlist($nick)
if {$aa(mask) == [maskhost $nick]} {
if {$aa(score) > 0} {
# mxirc_notc $nick "Kamu sudah terdaftar dengan nilai $aa(score) points ranking [mx_get_rank_pos $nick]."
}
} else {
# mxirc_notc $nick "This nick was in the data previously, so we use new score and old scores deleted."
unset userlist($nick)
}
}
mx_log "--- $nick joined the channel."
}
###########################################################################
#
# miscellaneous tmcquiz commands not fitting elsewhere
#
###########################################################################
###########################################################################
###########################################################################
##
## internal routines
##
###########################################################################
###########################################################################
## ----------------------------------------------------------------------
## react on certain events
## ----------------------------------------------------------------------
proc mx_event {type} {
global botnick quizstate
switch -exact $type {
"prerehash" {
mx_log "--- Preparing for rehashing"
if {$quizstate != "halted"} {
tmcquiz_halt $botnick 0 {}
}
tmcquiz_rank_save $botnick 0 {}
tmcquiz_saveuserquests $botnick 0 "all"
tmcquiz_config_save $botnick 0 {}
set tmp_logfiles [logfile]
mx_log "---- will reopen logfiles: $tmp_logfiles"
mx_log "--- Ready for rehashing"
}
"rehash" {
# reopen logfiles
mx_log "--- rehash: reloading ranks"
tmcquiz_rank_load $botnick 0 {}
mx_log "--- rehash: done."
}
}
}
## ----------------------------------------------------------------------
## mxirc ... stuff to speak
## ----------------------------------------------------------------------
## say something on quizchannel
proc mxirc_say {channel text} {
putserv "PRIVMSG $channel :$text"
}
## say something on all channels
proc mxirc_say_everywhere {text} {
foreach channel [channels] {
if {[validchan $channel] && [botonchan $channel]} {
mxirc_say $channel $text
}
}
}
## act on all channels
proc mxirc_action_everywhere {text} {
foreach channel [channels] {
if {[validchan $channel] && [botonchan $channel]} {
mxirc_action $channel $text
}
}
}
## say something through another buffer
proc mxirc_quick {channel text} {
putquick "PRIVMSG $channel :$text"
}
## act in some way (/me)
proc mxirc_action {channel text} {
putserv "PRIVMSG $channel :\001ACTION $text\001"
}
## say something to a user
proc mxirc_msg {nick text} {
global botnick
if {![mx_str_ieq $botnick $nick]} {
puthelp "PRIVMSG $nick :$text"
}
}
## say something through another buffer
proc mxirc_quick_notc {nick text} {
global botnick whisperprefix
if {![mx_str_ieq $botnick $nick]} {
putquick "$whisperprefix $nick :$text"
}
}
## notice something to a user (whisper)
proc mxirc_notc {nick text} {
global botnick whisperprefix
if {![mx_str_ieq $botnick $nick]} {
puthelp "$whisperprefix $nick :$text"
}
}
## notice something to a user
proc mxirc_dcc {idx text} {
if {[valididx $idx]} {
putdcc $idx $text
}
}
## ----------------------------------------------------------------------
## mx.... generic tool functions and internal functions
## ----------------------------------------------------------------------
## func to act according to the value of $aftergame
proc mx_aftergameaction {} {
global botnick aftergame quizconf
switch -exact $aftergame {
"stop" {
tmcquiz_stop $botnick 0 {}
set aftergame "newgame"
}
"halt" {
tmcquiz_halt $botnick 0 {}
set aftergame "newgame"
}
"exit" {
# sleep some milliseconds
tmcquiz_stop $botnick 0 {}
mxirc_say $quizconf(quizchannel) "Thanks for playing ppl, I'll exit now (and thanks for all the fish)."
utimer 2 mx_timer_aftergame
}
"newgame" {
# do nothing special here
}
default {
mx_log "ERROR: Bad aftergame-value: \"$aftergame\" -- halted"
tmcquiz_halt $botnick 0 {}
}
}
}
## timer to shut the bot down from aftergameaction
proc mx_timer_aftergame {} {
global botnick
if {[queuesize] != 0} {
utimer 2 mx_timer_aftergame
} else {
tmcquiz_exit $botnick 0 {}
}
}
## func to log stuff
proc mx_log {text} {
global quizconf
putloglev $quizconf(quizloglevel) $quizconf(quizchannel) $text
}
## return a duration as a string
proc mx_duration {time} {
return [duration [expr [unixtime] - $time]]
}
## return if strings are equal case ignored
proc mx_str_ieq {a b} {
if {[string tolower $a] == [string tolower $b]} {
return 1
} else {
return 0
}
}
## return a mixed list of numbers from 0 ... size
proc mx_mixedlist {size} {
variable alist "" blist ""
for {set i 0} {$i < $size} {incr i} {
lappend alist "$i"
}
set blist ""
for {set i 0} {$i < $size} {incr i} {
set pos [rand [llength $alist]]
lappend blist [lindex $alist $pos]
set alist [lreplace $alist $pos $pos]
}
return $blist
}
## read question data
## RETURNS: 0 if no error
## 1 if no file found
proc mx_read_questions {questionset} {
global qlist qlistorder qnumber datadir gamedata
variable entry
variable tipno 0
variable key
variable errno 0
# 0=out 1=in
variable readstate 0
mx_log "--- Loading questions."
# keep the old questions safe
set tmplist $qlist
set qlist ""
foreach datafile [glob -nocomplain "$datadir/questions*$questionset"] {
set fd [open $datafile r]
while {![eof $fd]} {
set line [gets $fd]
# an empty line terminates an entry
if {[regexp "^ *$" $line]} {
if {$readstate == 1} {
# reject crippled entries
if {[info exists entry(Question)]
&& [info exists entry(Answer)]} {
lappend qlist [array get entry]
} else {
mx_log "[array get entry] not complete."
}
set tipno 0
}
set readstate 0
} elseif {![regexp "^#.*" $line]} {
set readstate 1
set data [split $line {:}]
if {![regexp "(Answer|Author|Category|Comment|Level|Question|Regexp|Score|Tip|Tipcycle)" [lindex $data 0]]} {
mx_log "Key [lindex $data 0] unknown!"
} else {
set key [string trim [lindex $data 0]]
if {$key == "Tip"} {
set key "$key$tipno"
incr tipno
}
set entry($key) [string trim [join [lrange $data 1 end] ":"]]
}
}
}
close $fd
mx_log "---- now [llength $qlist] questions, added $datafile"
}
if {[llength $qlist] == 0} {
set qlist $tmplist
mx_log "----- reset to prior questions ([llength $qlist] ones)."
set errno 1
}
mx_log "--- Questions loaded."
set qlistorder [mx_mixedlist [llength $qlist]]
set qnumber 0
return $errno
}
## sets back all variables when a question is solved
## and goes to state waittoask (no timer set !!)
proc mx_answered {} {
global quizstate tipno usergame qlistfinished userqnumber
global userqlist tiplist revoltlist revoltmax
variable alist
if {$quizstate == "asked"} {
if {$usergame == 1} {
## save usergame
set pos [expr $userqnumber - 1]
set alist [lindex $userqlist $pos]
mx_log "---- userquest stored: $alist"
set i 0
foreach t $tiplist {
lappend alist "Tip$i" [lindex $tiplist $i]
incr i
}
set userqlist [lreplace $userqlist $pos $pos $alist]
## [pending] save each question to disc
}
set quizstate "waittoask"
set tipno 0
set revoltlist ""
set revoltmax 0
foreach j [utimers] {
if {[lindex $j 1] == "mx_timer_tip"} {
killutimer [lindex $j 2]
}
}
}
}
proc mx_timer_ask {} {
# global botnick quizconf
global rankfile
global rankfile userlist timerankreset
global tgcurrentanswer tghinttimer tgtimenext tgchan tgnextqtimer tgstreak tgstreakmin
global tgscoresbyname tgranksbyname tgranksbynum tgcongrats tgscorestotal tgmissed
global tgtimestart tgshowallscores tgrealnames tgscoresbyrank tgtimeanswer
tmcquiz_rank_save {} {} {}
# tmcquiz_ask $botnick {} {} $quizconf(quizchannel) {}
# global KAOSAnswers KAOSNumAnswered KAOSQuestionTimer KAOSAdTimer
# utimer 5 KAOSAskQuestion
set tgnextqtimer [utimer $tgtimenext tgnextq]
set tgplaying 1
set tgstreak 0
set tgmissed 0
}
## give a tip and check if channel is desert!
proc mx_timer_tip {} {
global userlist botnick banner
global aftergame timerankreset qnum_thisgame
global quizconf
variable desert 0
# foreach u [array names userlist] {
# array set afoo $userlist($u)
# if {$afoo(lastspoken) >= [expr [unixtime] - ($quizconf(tipcycle) * $quizconf(tipdelay) * 2) - $quizconf(askdelay)]} {
# set desert 0
# break
# }
# }
#
# ask at least one question
if {$desert && $qnum_thisgame > 2} {
mxirc_say $quizconf(quizchannel) "Channel found desert."
mx_log "--- Channel found desert."
tmcquiz_rank_reset $botnick {} {}
if {$aftergame != "exit"} {
tmcquiz_halt $botnick 0 {}
} else {
mx_aftergameaction
}
} else {
tmcquiz_tip $botnick 0 {}
}
}
## compare length of two elements
proc mx_cmp_length {a b} {
variable la [string length $a] lb [string length $b]
if {$la == $lb} {
return 0
} elseif {$la > $lb} {
return 1
} else {
return -1
}
}
## returns number of open userquests
proc mx_userquests_available {} {
global userqlist userqnumber
set num [expr [llength $userqlist] - $userqnumber]
if {$num < 0} {
return 0
} else {
return $num
}
}
## create an entry in the userlist or update an existing
## then entry is returned
proc mx_getcreate_userentry {nick host} {
global userlist botnick
## prevent myself from being added, though this will never happen
if {[mx_str_ieq $nick $botnick]} {
return
}
if {[info exists userlist($nick)]} {
array set anarray $userlist($nick)
# set anarray(lastspoken) [unixtime]
# set userlist($nick) [array get anarray]
} else {
set userlist($nick) [list "mask" [maskhost $nick] "score" 0]
mx_log "---- new user $nick: $userlist($nick)"
array set anarray $userlist($nick)
}
}
## convert some latin1 special chars
proc mx_tweak_umlauts {text} {
regsub -all "ä" $text "ae" text
regsub -all "ö" $text "oe" text
regsub -all "ü" $text "ue" text
regsub -all "Ä" $text "AE" text
regsub -all "Ö" $text "OE" text
regsub -all "Ü" $text "UE" text
regsub -all "ß" $text "ss" text
regsub -all "è" $text "e" text
regsub -all "È" $text "E" text
regsub -all "é" $text "e" text
regsub -all "É" $text "E" text
return $text
}
##################################################
#
# functions for colors
#
##################################################
## strip color codes from a string
proc mx_strip_colors {txt} {
variable result
regsub -all "\[\002\017\]" $txt "" result
regsub -all "\003\[0-9\]\[0-9\]?\(,\[0-9\]\[0-9\]?\)?" $result "" result
return $result
}
# return botcolor
proc botcolor {thing} {
global quizconf
if {$quizconf(colorize) != "yes"} {return ""}
# if {$thing == "question"} {return "\003[col dblue][col uline]"}
# if {$thing == "answer"} {return "\003[col dblue]"}
# if {$thing == "tip"} {return "\003[col dblue]"}
if {$thing == "question"} {return "[color dblue white][col uline]"}
if {$thing == "answer"} {return "[color dblue white]"}
if {$thing == "tip"} {return "[color dblue white]"}
if {$thing == "nick"} {return "[color lightgreen black]"}
if {$thing == "nickscore"} {return "[color lightgreen blue]"}
if {$thing == "highscore"} {return "\003[col turqois][col uline][col bold]"}
# if {$thing == "txt"} {return "[color red yellow]"}
if {$thing == "txt"} {return "[color blue lightblue]"}
if {$thing == "boldtxt"} {return "[col bold][color blue lightblue]"}
if {$thing == "own"} {return "[color red black]"}
if {$thing == "norm"} {return "\017"}
if {$thing == "grats"} {return "[color purple norm]"}
if {$thing == "score"} {return "[color blue lightblue]"}
if {$thing == ""} {return "\003"}
}
# internal function, never used from ouside. (doesn't check colorize!)
proc color {fg bg} {
return "\003[col $fg]