Advertisement
Guest User

Untitled

a guest
Mar 31st, 2010
1,093
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 66.31 KB | None | 0 0
  1. #
  2. # Marky's Color Uno v0.98
  3. # Copyright (C) 2004-2008 Mark A. Day (techwhiz@embarqmail.com)
  4. #
  5. # Uno(tm) is Copyright (C) 2001 Mattel, Inc.
  6. #
  7. # This program is free software; you can redistribute it and/or modify
  8. # it under the terms of the GNU General Public License as published by
  9. # the Free Software Foundation; either version 2 of the License, or
  10. # (at your option) any later version.
  11. #
  12. # This program is distributed in the hope that it will be useful,
  13. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. # GNU General Public License for more details.
  16. #
  17. # You should have received a copy of the GNU General Public License
  18. # along with this program; if not, write to the Free Software
  19. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  20. #
  21.  
  22. # Default settings (these are overridden by uno.cfg)
  23. set UnoAds 1
  24. set UnoDebug 0
  25. set UnoChan "#alluno"
  26. set UnoRobot $botnick
  27. set UnoPointsName "Tarts"
  28. set UnoStopAfter 3
  29. set UnoJoinAnyTime 0
  30. set UnoUseDCC 0
  31. set UnoBonus 1000
  32. set UnoWildDrawTwos 0
  33. set UnoMaxNickLen 9
  34. set UnoMaxPlayers 10
  35. set UnoOpFlags "m|m"
  36. set UnoNTC "NOTICE"
  37. set UnoCFGFile "scripts/uno.cfg"
  38. set UnoScoreFile "scores/UnoScores"
  39.  
  40. set UnoVersion "0.98.7"
  41.  
  42. # Command binds
  43. bind pub - !uno UnoInit
  44. bind pub "o|o" !stop UnoStop
  45. bind pub "o|o" !pause UnoPause
  46. bind pub "o|o" !join UnoJoinBotPlayer
  47. bind pub - !remove UnoRemove
  48. bind pub - !unocmds UnoCmds
  49. bind pub - !unowon UnoWon
  50. bind pub - !unotop10 UnoTopTen
  51. bind pub - !unotop3last UnoTopThreeLast
  52. bind pub - !unostats UnoPlayStats
  53. bind pub - !unorecords UnoRecords
  54. bind pub - !unorow UnoCurrentRow
  55. bind pub - !unoversion UnoVersion
  56.  
  57. # DCC commands
  58. bind dcc - unohands dccunohands
  59. bind dcc - unowritecfg dcc_unowriteconfig
  60. bind dcc - unorehash dcc_unorehash
  61. bind dcc - unopoints dcc_unopoints
  62.  
  63. # Monthly score reset
  64. bind time - "00 00 01 * *" UnoNewMonth
  65.  
  66. # rehash
  67. bind evnt - "prerehash" unoevnt:prerehash
  68. proc unoevnt:prerehash {type} {
  69. global UnoRobot UnoChan
  70. UnoStop $UnoRobot "console" $UnoRobot $UnoChan ""
  71. }
  72. # restart
  73. bind evnt - "prerestart" unoevnt:prerestart
  74. proc unoevnt:prerestart {type} {
  75. global UnoRobot UnoChan
  76. UnoStop $UnoRobot "console" $UnoRobot $UnoChan ""
  77. }
  78.  
  79. # Global variables
  80. set UnoOn 0
  81. set UnoMode 0
  82. set UnoPaused 0
  83. set UnoPlayers 0
  84. set MasterDeck ""
  85. set UnoDeck ""
  86. set DiscardPile ""
  87. set PlayCard ""
  88. set RoundRobin ""
  89. set ThisPlayer ""
  90. set ThisPlayerIDX 0
  91. set UnoStartTime [unixtime]
  92. set IsColorChange 0
  93. set ColorPicker ""
  94. set IsDraw 0
  95. set UnoIDX ""
  96. set UnPlayedRounds 0
  97. set UnoWinDefault 0
  98. set UnoLastWinner ""
  99. set UnoLastIdler ""
  100. set UnoWinsInARow 0
  101.  
  102. # Scores, records and ads
  103. set UnoLastMonthCards(0) "Nobody 0"
  104. set UnoLastMonthCards(1) "Nobody 0"
  105. set UnoLastMonthCards(2) "Nobody 0"
  106. set UnoLastMonthGames(0) "Nobody 0"
  107. set UnoLastMonthGames(1) "Nobody 0"
  108. set UnoLastMonthGames(2) "Nobody 0"
  109. set UnoFast "Nobody 600"
  110. set UnoHigh "Nobody 0"
  111. set UnoPlayed "Nobody 0"
  112. set UnoRow "Nobody 0"
  113. set UnoRecordHigh "Nobody 0"
  114. set UnoRecordFast "Nobody 600"
  115. set UnoRecordCard "Nobody 0"
  116. set UnoRecordWins "Nobody 0"
  117. set UnoRecordPlayed "Nobody 0"
  118. set UnoRecordRow "Nobody 0"
  119. set UnoAdNumber 0
  120.  
  121. # Card stats
  122. set CardStats(played) 0
  123.  
  124. # Timers
  125. set UnoStartTimer ""
  126. set UnoSkipTimer ""
  127. set UnoCycleTimer ""
  128. set UnoBotTimer ""
  129.  
  130. #
  131. # Grace periods and timeouts ( AutoSkipPeriod can be raised but dont go below 2)
  132. #
  133.  
  134. # time to skip an inactive player
  135. set AutoSkipPeriod 2
  136.  
  137. # time to join game
  138. set StartGracePeriod 30
  139.  
  140. # time between games
  141. set UnoCycleTime 30
  142.  
  143. # internal bot player use dont change
  144. set RobotRestartPeriod 1
  145.  
  146. # Nick colours
  147. set UnoNickColors "6 13 3 7 12 10 4 11 9 8 5"
  148.  
  149. # Cards and logo
  150. set UnoRedCard "\0030,04 Red "
  151. set UnoGreenCard "\0030,03 Green "
  152. set UnoBlueCard "\0030,12 Blue "
  153. set UnoYellowCard "\0031,08 Yellow "
  154. set UnoSkipCard "\002Skip\002 \003 "
  155. set UnoReverseCard "\002Reverse\002 \003 "
  156. set UnoDrawTwoCard "\002Draw Two\002 \003 "
  157. set UnoWildCard "\0031,8 \002W\0030,3I \0030,4L\0030,12D\002 \003 "
  158. set UnoWildDrawFourCard "\0031,8 \002W\0030,3I \0030,4L\0030,12D \0031,8D\0030,3r\0030,4a\0030,12w \0031,8F\0030,3o\0030,4u\0030,12r\002 \003 "
  159. set UnoLogo "\002\0033U\00312N\00313O\00308!\002\003"
  160.  
  161. #
  162. # Bind channel commands
  163. #
  164. proc UnoBindCmds {} {
  165. bind pub - jo UnoJoin
  166. bind pub - od UnoOrder
  167. bind pub - ti UnoTime
  168. bind pub - ca UnoShowCards
  169. bind pub - pl UnoPlayCard
  170. bind pub - cd UnoTopCard
  171. bind pub - tu UnoTurn
  172. bind pub - dr UnoDraw
  173. bind pub - co UnoColorChange
  174. bind pub - pa UnoPass
  175. bind pub - ct UnoCardCount
  176. bind pub - st UnoCardStats
  177.  
  178. bind chon - * unologin:dcc
  179. bind chof - * unologout:dcc
  180. bind filt - .quit* unologout:filt
  181. }
  182.  
  183. #
  184. # Unbind channel commands
  185. #
  186. proc UnoUnbindCmds {} {
  187. catch {unbind pub - jo UnoJoin}
  188. catch {unbind pub - od UnoOrder}
  189. catch {unbind pub - ti UnoTime}
  190. catch {unbind pub - ca UnoShowCards}
  191. catch {unbind pub - pl UnoPlayCard}
  192. catch {unbind pub - cd UnoTopCard}
  193. catch {unbind pub - tu UnoTurn}
  194. catch {unbind pub - dr UnoDraw}
  195. catch {unbind pub - co UnoColorChange}
  196. catch {unbind pub - pa UnoPass}
  197. catch {unbind pub - ct UnoCardCount}
  198. catch {unbind pub - st UnoCardStats}
  199.  
  200. catch {unbind chon - * unologin:dcc}
  201. catch {unbind chof - * unologout:dcc}
  202. catch {unbind filt - .quit* unologout:filt}
  203. }
  204.  
  205. #
  206. # Reset game variables
  207. #
  208. proc UnoReset {} {
  209. global UnoOn UnoMode UnoPaused UnoPlayers RoundRobin UnoDeck ThisPlayer ThisPlayerIDX PlayCard
  210. global DiscardPile IsColorChange ColorPicker IsDraw UnoIDX MasterDeck CardStats
  211. global UnoStartTimer UnoSkipTimer UnoCycleTimer UnoWinDefault UnoRobot botnick UnoLastIdler
  212.  
  213. set UnoMode 0
  214. set UnoPaused 0
  215. set UnoPlayers 0
  216. set MasterDeck ""
  217. set UnoDeck ""
  218. set DiscardPile ""
  219. set RoundRobin ""
  220. set ThisPlayer ""
  221. set ThisPlayerIDX 0
  222. set PlayCard ""
  223. set IsColorChange 0
  224. set ColorPicker ""
  225. set IsDraw 0
  226. set UnoIDX ""
  227. set UnoAdNumber 0
  228. set UnoWinDefault 0
  229. set UnoLastIdler ""
  230.  
  231. set CardStats(played) 0
  232.  
  233. set UnoStartTimer ""
  234. set UnoSkipTimer ""
  235. set UnoCycleTimer ""
  236.  
  237. set UnoRobot $botnick
  238.  
  239. return
  240. }
  241.  
  242. # return 1 if is this the uno channel, else return 0
  243. proc uno_ischan {chan} {
  244. global UnoChan
  245. if {([string tolower $chan] == [string tolower $UnoChan])} {return 1}
  246. return 0
  247. }
  248. # return 1 if is this the uno channel and uno is running, else return 0
  249. proc uno_isrunning {chan} {
  250. global UnoMode
  251. if {([uno_ischan $chan])&&($UnoMode == 2)} {return 1}
  252. return 0
  253. }
  254.  
  255. # remove player dcc list
  256. proc uno_removedccplayers { } {
  257. global RoundRobin UnoDCCIDX
  258. set pcount 0
  259. while {[lindex $RoundRobin $pcount] != ""} {
  260. set pnick [lindex $RoundRobin $pcount]
  261. if [info exist UnoDCCIDX($pnick)] {unset UnoDCCIDX($pnick)}
  262. incr pcount
  263. }
  264. }
  265.  
  266. #
  267. # stop a game
  268. #
  269. proc UnoStop {nick uhost hand chan txt} {
  270. global UnoOn UnoPaused UnPlayedRounds UnoStartTimer UnoSkipTimer UnoCycleTimer UnoLastWinner UnoWinsInARow
  271.  
  272. if {(![uno_ischan $chan])||($UnoOn == 0)} {return}
  273.  
  274. catch {killutimer $UnoStartTimer}
  275. catch {killtimer $UnoSkipTimer}
  276. catch {killutimer $UnoCycleTimer}
  277.  
  278. # remove player dcc list
  279. uno_removedccplayers
  280.  
  281. set UnoOn 0
  282. set UnoPaused 0
  283. set UnPlayedRounds 0
  284. set UnoLastWinner ""
  285. set UnoWinsInARow 0
  286.  
  287. UnoUnbindCmds
  288.  
  289. UnoReset
  290.  
  291. unochanmsg "stopped by $nick"
  292.  
  293. return
  294. }
  295.  
  296. #
  297. # first entry
  298. #
  299. proc UnoInit {nick uhost hand chan txt} {
  300. global UnoOn
  301. if {(![uno_ischan $chan])||($UnoOn > 0)} {return}
  302. #unochanmsg "$nick\!$uhost"
  303. set UnoOn 1
  304. UnoBindCmds
  305. UnoNext
  306. return
  307. }
  308.  
  309. #
  310. # initialize a new game
  311. #
  312. proc UnoNext {} {
  313. global UnoOn MasterDeck UnoDeck UnoMode StartGracePeriod UnoHand UnoNickColor UnoVersion UnoStartTimer UnoSkipTimer
  314.  
  315. if {!$UnoOn} {return}
  316.  
  317. UnoReset
  318.  
  319. set UnoMode 1
  320.  
  321. set MasterDeck [list B0 B1 B1 B2 B2 B3 B3 B4 B4 B5 B5 B6 B6 B7 B7 B8 B8 B9 B9 BR BR BS BS BD BD R0 R1 R1 R2 R2 R3 R3 R4 R4 R5 R5 R6 R6 R7 R7 R8 R8 R9 R9 RR RR RS RS RD RD Y0 Y1 Y1 Y2 Y2 Y3 Y3 Y4 Y4 Y5 Y5 Y6 Y6 Y7 Y7 Y8 Y8 Y9 Y9 YR YR YS YS YD YD G0 G1 G1 G2 G2 G3 G3 G4 G4 G5 G5 G6 G6 G7 G7 G8 G8 G9 G9 GR GR GS GS GD GD W W W W WD WD WD WD]
  322.  
  323. unochanmsg "$UnoVersion by Marky"
  324.  
  325. set done 0
  326. while {!$done} {
  327. set rseed [rand 65535]
  328. if {$rseed} {set done 1}
  329. }
  330. set newrand [expr srand($rseed)]
  331. set newrand [rand [llength $MasterDeck]]
  332.  
  333. set UnoDeck ""
  334. while {[llength $UnoDeck] != 108} {
  335. set pnum [rand [llength $MasterDeck]]
  336. set pcard [lindex $MasterDeck $pnum]
  337. lappend UnoDeck $pcard
  338. set MasterDeck [lreplace $MasterDeck $pnum $pnum]
  339. }
  340.  
  341. if [info exist UnoHand] {unset UnoHand}
  342. if [info exist UnoNickColor] {unset UnoNickColor}
  343.  
  344. unochanmsg "You have \00314\002[UnoDuration $StartGracePeriod]\002\003 to join uno"
  345.  
  346. set UnoStartTimer [utimer $StartGracePeriod UnoStart]
  347.  
  348. return
  349. }
  350.  
  351. #
  352. # cycle a new game
  353. #
  354. proc UnoCycle {} {
  355. global UnoOn UnoMode UnoCycleTime UnoCycleTimer UnoSkipTimer UnoAds
  356.  
  357. if {!$UnoOn} {return}
  358.  
  359. set UnoMode 4
  360. catch {killtimer $UnoSkipTimer}
  361.  
  362. if {$UnoAds} {
  363. set AdTime [expr $UnoCycleTime /2]
  364. set UnoAdTimer [utimer $AdTime UnoScoreAdvertise]
  365. }
  366.  
  367. set UnoCycleTimer [utimer $UnoCycleTime UnoNext]
  368.  
  369. return
  370. }
  371.  
  372. # force bot player to join
  373. proc UnoJoinBotPlayer {nick uhost hand chan txt} {
  374. global UnoMode UnoOn
  375. if {!$UnoOn || ($UnoMode != 2)} {return}
  376. UnoBotPlayerJoins
  377. return 0
  378. }
  379.  
  380. # bot player joins in if no one else does
  381. proc UnoBotPlayerJoins {} {
  382. global UnoPlayers RoundRobin UnoIDX UnoRobot UnoLogo UnoDebug UnoHand UnoNickColor
  383. incr UnoPlayers
  384.  
  385. lappend RoundRobin $UnoRobot
  386. lappend UnoIDX $UnoRobot
  387.  
  388. if [info exist UnoHand($UnoRobot)] {unset UnoHand($UnoRobot)}
  389. if [info exist UnoNickColor($UnoRobot)] {unset UnoNickColor($UnoRobot)}
  390.  
  391. set UnoHand($UnoRobot) ""
  392. set UnoNickColor($UnoRobot) [unocolornick $UnoPlayers]
  393.  
  394. unomsg "[unonik $UnoRobot]\003 joins $UnoLogo"
  395.  
  396. # deal hand to bot
  397. uno_newplayerhand $UnoRobot
  398.  
  399. if {$UnoDebug > 1} {unolog $UnoRobot $UnoHand($UnoRobot)}
  400. }
  401.  
  402. #
  403. # start a new game
  404. #
  405. proc UnoStart {} {
  406. global UnoChan UnoOn UnoCycleTime UnoRobot UnoDebug UnoIDX UnoStartTime UnoPlayers RoundRobin ThisPlayer ThisPlayerIDX UnoDeck DiscardPile UnoMode UnoHand AutoSkipPeriod
  407. global UnoSkipTimer UnPlayedRounds UnoStopAfter UnoNickColor UnoLogo
  408.  
  409. if {!$UnoOn} {return}
  410.  
  411. if {![llength $RoundRobin]} {
  412. unochanmsg "no players, next game in \00314[UnoDuration $UnoCycleTime]"
  413. incr UnPlayedRounds
  414. if {($UnoStopAfter > 0)&&($UnPlayedRounds >= $UnoStopAfter)} {
  415. unochanmsg "idle $UnoStopAfter rounds"
  416. utimer 1 "UnoStop $UnoRobot $UnoRobot none $UnoChan none"
  417. return
  418. }
  419.  
  420. UnoCycle
  421.  
  422. return
  423. }
  424.  
  425. # bot joins if one player
  426. if {[llength $RoundRobin] == 1} {
  427. UnoBotPlayerJoins
  428. }
  429.  
  430. unomsg "Welcome to $UnoLogo"
  431. unomsg "\00314$UnoPlayers\003 players this round:\00314 $RoundRobin"
  432.  
  433. set UnoMode 2
  434.  
  435. set ThisPlayer [lindex $RoundRobin 0]
  436.  
  437. # draw first card from deck
  438. set DiscardPile ""
  439. set pcardnum [rand [llength $UnoDeck]]
  440. set pcard [lindex $UnoDeck $pcardnum]
  441.  
  442. # play doesnt start with a wild card
  443. while {[string range $pcard 0 0] == "W"} {
  444. set pcardnum [rand [llength $UnoDeck]]
  445. set pcard [lindex $UnoDeck $pcardnum]
  446. }
  447.  
  448. # put first card on top of discard pile
  449. uno_addtodiscardpile $pcard
  450. set Card [uno_cardcolor $pcard]
  451.  
  452. set UnoDeck [lreplace $UnoDeck $pcardnum $pcardnum]
  453.  
  454. # first player draws two if first card is a draw two, but not skipped
  455. unomsg "[unonik $ThisPlayer]\003 plays first... The top card is $Card"
  456.  
  457. if {([string range $pcard 0 0] != "W")&&([string range $pcard 1 1] == "D")} {
  458. uno_adddrawtohand $ThisPlayer $ThisPlayerIDX 2
  459. unomsg "[unonik $ThisPlayer]\003 \002drew two\002 cards"
  460. }
  461.  
  462. uno_showcards $ThisPlayer $ThisPlayerIDX
  463.  
  464. # start autoskip timer
  465. set UnoSkipTimer [timer $AutoSkipPeriod UnoAutoSkip]
  466.  
  467. set UnPlayedRounds 0
  468.  
  469. # running game time
  470. set UnoStartTime [unixtime]
  471. }
  472.  
  473. #
  474. # deal full hand of 7 cards
  475. #
  476. proc uno_newplayerhand {cplayer} {
  477. global UnoDeck UnoHand
  478. # shuffle deck if needed
  479. UnoShuffle 7
  480. # deal cards to player
  481. set picknum 0
  482. while {[llength $UnoHand($cplayer)] != 7} {
  483. set pick [lindex $UnoDeck $picknum]
  484. lappend UnoHand($cplayer) $pick
  485. set UnoDeck [lreplace $UnoDeck $picknum $picknum]
  486. }
  487. }
  488.  
  489. #
  490. # add a player
  491. #
  492. proc UnoJoin {nick uhost hand chan txt} {
  493. global UnoDebug UnoIDX UnoMode UnoPlayers RoundRobin UnoHand UnoNickColor UnoMaxPlayers UnoDCCIDX UnoLogo UnoJoinAnyTime
  494. global UnoUseDCC
  495.  
  496. if {(![uno_ischan $chan])||($UnoMode < 1)||($UnoMode > 2)} {return}
  497.  
  498. if {!$UnoJoinAnyTime && ($UnoMode == 2)} {return}
  499.  
  500. # player is already joined
  501. set pcount 0
  502. while {[lindex $RoundRobin $pcount] != ""} {
  503. if {[lindex $RoundRobin $pcount] == $nick} {
  504. return
  505. }
  506. incr pcount
  507. }
  508.  
  509. if {[llength $RoundRobin] >= $UnoMaxPlayers} {
  510. unogntc $nick "$UnoLogo maximum of $UnoMaxPlayers players reached... try next round, $nick"
  511. return
  512. }
  513.  
  514. incr UnoPlayers
  515.  
  516. lappend RoundRobin $nick
  517. lappend UnoIDX $nick
  518.  
  519. if [info exist UnoHand($nick)] {unset UnoHand($nick)}
  520. if [info exist UnoNickColor($nick)] {unset UnoNickColor($nick)}
  521. if [info exist UnoDCCIDX($nick)] {unset UnoDCCIDX($nick)}
  522.  
  523. set UnoHand($nick) ""
  524. set UnoNickColor($nick) [unocolornick $UnoPlayers]
  525.  
  526. # if player is in dcc chat, use that socket for card output (fast)
  527. set UnoDCCIDX($nick) -1
  528.  
  529. if {$UnoUseDCC} {
  530. set dhand [nick2hand $nick $chan]
  531. if {($dhand != "")&&($dhand != "*")} {
  532. set idx [hand2idx $dhand]
  533. if {$idx != -1} {
  534. set UnoDCCIDX($nick) $idx
  535. } {
  536. set UnoDCCIDX($nick) -1
  537. }
  538. }
  539. }
  540.  
  541. # deal hand
  542. uno_newplayerhand $nick
  543.  
  544. #if {$UnoDebug > 1} { unolog $nick $UnoHand($nick) }
  545.  
  546. unomsg "[unonik $nick]\003 joins $UnoLogo"
  547.  
  548. unontc $nick "[uno_cardcolorall $nick]"
  549. }
  550.  
  551. #
  552. # Card handling
  553. #
  554.  
  555. # remove played card from hand
  556. proc uno_removecardfromhand {cplayer ccard} {
  557. global UnoHand
  558. set UnoHand($cplayer) [lreplace $UnoHand($cplayer) $ccard $ccard]
  559. }
  560.  
  561. # add card to discard pile
  562. proc uno_addtodiscardpile {ccard} {
  563. global DiscardPile PlayCard
  564. set PlayCard $ccard
  565. if {[string range $ccard 0 0] != ""} { lappend DiscardPile $ccard }
  566. }
  567.  
  568. # add num drawn cards to hand
  569. proc uno_adddrawtohand {cplayer idx num} {
  570. global UnoHand UnoDeck RoundRobin
  571.  
  572. # check if deck needs reshuffling
  573. UnoShuffle $num
  574.  
  575. set newhand [expr [llength $UnoHand($cplayer)] + $num]
  576.  
  577. set Drawn ""
  578. set pcardnum 0
  579. while {[llength $UnoHand($cplayer)] != $newhand} {
  580. set pcard [lindex $UnoDeck $pcardnum]
  581. set UnoDeck [lreplace $UnoDeck $pcardnum $pcardnum]
  582. lappend UnoHand($cplayer) $pcard
  583. append Drawn [uno_cardcolor $pcard]
  584. }
  585. uno_showdraw $idx $Drawn
  586. }
  587.  
  588. # reset isdraw flag
  589. proc uno_isdrawreset {} {
  590. global IsDraw
  591. set IsDraw 0
  592. }
  593.  
  594. #
  595. # player with no cards left wins
  596. #
  597.  
  598. proc uno_checkwin {cplayer crd} {
  599. global UnoHand
  600. if {[llength $UnoHand($cplayer)]} {return 0}
  601. uno_showwin $cplayer $crd
  602. UnoWin $cplayer
  603. UnoCycle
  604. return 1
  605. }
  606.  
  607. # win on a draw card
  608. proc uno_checkwindraw {cplayer crd dplayer dplayeridx num} {
  609. global UnoHand
  610. if {[llength $UnoHand($cplayer)]} {return 0}
  611. uno_adddrawtohand $dplayer $dplayeridx $num
  612. uno_showwin $cplayer $crd
  613. UnoWin $cplayer
  614. UnoCycle
  615. return 1
  616. }
  617.  
  618. #
  619. # check for wdf card in hand
  620. #
  621. proc uno_checkhandwdf {cplayer} {
  622. global UnoHand
  623. set ccount 0
  624. while {$ccount < [llength $UnoHand($cplayer)]} {
  625. set pcard [lindex $UnoHand($cplayer) $ccount]
  626. set hc0 [string range $pcard 0 0]
  627. set hc1 [string range $pcard 1 1]
  628. if {($hc0 == "W") && ($hc1 == "D")} { return 1 }
  629. incr ccount
  630. }
  631. return 0
  632. }
  633.  
  634. #
  635. # check if player has same color card in hand for wdf
  636. #
  637. proc uno_checkhandcolor {cplayer} {
  638. global PlayCard UnoHand
  639.  
  640. # color of card in play
  641. set cip0 [string range $PlayCard 0 0]
  642.  
  643. set ccount 0
  644. while {$ccount < [llength $UnoHand($cplayer)]} {
  645. set pcard [lindex $UnoHand($cplayer) $ccount]
  646. set hc0 [string range $pcard 0 0]
  647. if {([uno_iscolorcard $cip0]) && ($cip0 == $hc0)} {return 1}
  648. incr ccount
  649. }
  650. return 0
  651. }
  652.  
  653. #
  654. # draw a card
  655. #
  656. proc UnoDraw {nick uhost hand chan txt} {
  657. global UnoMode IsDraw ThisPlayer ThisPlayerIDX
  658.  
  659. if {(![uno_ischan $chan])||($UnoMode != 2)||($nick != $ThisPlayer)} {return}
  660.  
  661. uno_autoskipreset $nick
  662.  
  663. if {$IsDraw} {
  664. unontc $nick "You've already drawn a card, $nick, play a card or pass"
  665. return
  666. }
  667.  
  668. if {[uno_checkhandwdf $ThisPlayer]} {
  669. unontc $nick "You have a playable card in your hand already, $nick, you must play it"
  670. return
  671. }
  672.  
  673. set IsDraw 1
  674.  
  675. uno_adddrawtohand $ThisPlayer $ThisPlayerIDX 1
  676.  
  677. uno_showwhodrew $nick
  678.  
  679. return
  680. }
  681.  
  682. #
  683. # pass a turn
  684. #
  685. proc UnoPass {nick uhost hand chan txt} {
  686. global UnoMode IsDraw ThisPlayer ThisPlayerIDX IsColorChange
  687.  
  688. if {(![uno_ischan $chan])||($UnoMode != 2)||($nick != $ThisPlayer)||($IsColorChange == 1)} {return}
  689.  
  690. uno_autoskipreset $nick
  691.  
  692. if {$IsDraw} {
  693. uno_isdrawreset
  694.  
  695. uno_nextplayer
  696.  
  697. uno_showplaypass $nick $ThisPlayer
  698.  
  699. uno_showcards $ThisPlayer $ThisPlayerIDX
  700.  
  701. uno_restartbotplayer
  702. } {
  703. unontc $nick "You must draw a card before you can pass, $nick"
  704. }
  705.  
  706. return
  707. }
  708.  
  709. #
  710. # color change
  711. #
  712. proc UnoColorChange {nick uhost hand chan txt} {
  713. global UnoMode PlayCard ColorPicker IsColorChange ThisPlayer ThisPlayerIDX
  714. global UnoRedCard UnoGreenCard UnoBlueCard UnoYellowCard
  715.  
  716. #if {(![uno_ischan $chan])||($UnoMode != 2)||($nick != $ColorPicker)||(!$IsColorChange)} {return}
  717. if {($UnoMode != 2)||($nick != $ColorPicker)||(!$IsColorChange)} {return}
  718.  
  719. uno_autoskipreset $nick
  720.  
  721. regsub -all \[`.,!{}\ ] $txt "" txt
  722.  
  723. set NewColor [string toupper [string range $txt 0 0]]
  724.  
  725. switch $NewColor {
  726. "R" { set PlayCard "R"; set Card "$UnoRedCard\003"}
  727. "G" { set PlayCard "G"; set Card "$UnoGreenCard\003"}
  728. "B" { set PlayCard "B"; set Card "$UnoBlueCard\003"}
  729. "Y" { set PlayCard "Y"; set Card "$UnoYellowCard\003"}
  730. default { unontc $nick "choose a valid color \(r,g,b or y\)"; return }
  731. }
  732.  
  733. uno_nextplayer
  734.  
  735. unomsg "[unonik $ColorPicker]\003 chose $Card, play continues with [unonik $ThisPlayer]"
  736.  
  737. uno_showcards $ThisPlayer $ThisPlayerIDX
  738.  
  739. uno_isdrawreset
  740.  
  741. set IsColorChange 0
  742. set ColorPicker ""
  743.  
  744. uno_restartbotplayer
  745.  
  746. return
  747. }
  748.  
  749. #
  750. # skip card
  751. #
  752. proc uno_playskipcard {nick pickednum crd} {
  753. global ThisPlayer ThisPlayerIDX RoundRobin
  754.  
  755. uno_removecardfromhand $nick $pickednum
  756.  
  757. uno_addtodiscardpile $crd
  758.  
  759. set SkipPlayer $ThisPlayer
  760.  
  761. uno_nextplayer
  762.  
  763. set SkippedPlayer [lindex $RoundRobin $ThisPlayerIDX]
  764.  
  765. uno_nextplayer
  766.  
  767. if {[uno_checkwin $SkipPlayer [uno_cardcolor $crd]]} { return }
  768.  
  769. uno_showplayskip $nick [uno_cardcolor $crd] $SkippedPlayer $ThisPlayer
  770.  
  771. uno_checkuno $SkipPlayer
  772.  
  773. uno_showcards $ThisPlayer $ThisPlayerIDX
  774.  
  775. uno_isdrawreset
  776. }
  777.  
  778. #
  779. # reverse card
  780. #
  781. proc uno_playreversecard {nick pickednum crd} {
  782. global UnoIDX ThisPlayer ThisPlayerIDX RoundRobin
  783.  
  784. uno_removecardfromhand $nick $pickednum
  785.  
  786. uno_addtodiscardpile $crd
  787.  
  788. # reverse roundrobin and move to next player
  789. set NewRoundRobin ""
  790. set OrigOrderLength [llength $RoundRobin]
  791. set IDX $OrigOrderLength
  792.  
  793. while {$OrigOrderLength != [llength $NewRoundRobin]} {
  794. set IDX [expr ($IDX - 1)]
  795. lappend NewRoundRobin [lindex $RoundRobin $IDX]
  796. }
  797.  
  798. set Newindexorder ""
  799. set OrigindexLength [llength $UnoIDX]
  800. set IDX $OrigindexLength
  801.  
  802. while {$OrigindexLength != [llength $Newindexorder]} {
  803. set IDX [expr ($IDX - 1)]
  804. lappend Newindexorder [lindex $UnoIDX $IDX]
  805. }
  806.  
  807. set UnoIDX $Newindexorder
  808. set RoundRobin $NewRoundRobin
  809.  
  810. set ReversePlayer $ThisPlayer
  811.  
  812. # next player after reversing roundrobin
  813. set pcount 0
  814. while {$pcount != [llength $RoundRobin]} {
  815. if {[lindex $RoundRobin $pcount] == $ThisPlayer} {
  816. set ThisPlayerIDX $pcount
  817. break
  818. }
  819. incr pcount
  820. }
  821.  
  822. # less than 3 players acts like a skip card
  823. if {[llength $RoundRobin] > 2} {
  824. incr ThisPlayerIDX
  825. if {$ThisPlayerIDX >= [llength $RoundRobin]} {set ThisPlayerIDX 0}
  826. }
  827.  
  828. set ThisPlayer [lindex $RoundRobin $ThisPlayerIDX]
  829.  
  830. if {[uno_checkwin $ReversePlayer [uno_cardcolor $crd]]} { return }
  831.  
  832. uno_showplaycard $nick [uno_cardcolor $crd] $ThisPlayer
  833.  
  834. uno_checkuno $ReversePlayer
  835.  
  836. uno_showcards $ThisPlayer $ThisPlayerIDX
  837.  
  838. uno_isdrawreset
  839. }
  840.  
  841. #
  842. # draw two card
  843. #
  844. proc uno_playdrawtwocard {nick pickednum crd} {
  845. global ThisPlayer ThisPlayerIDX RoundRobin
  846.  
  847. uno_removecardfromhand $nick $pickednum
  848.  
  849. uno_addtodiscardpile $crd
  850.  
  851. set DrawPlayer $ThisPlayer
  852. set DrawPlayerIDX $ThisPlayerIDX
  853.  
  854. # move to the player that draws
  855. uno_nextplayer
  856.  
  857. set PlayerThatDrew $ThisPlayer
  858. set PlayerThatDrewIDX $ThisPlayerIDX
  859.  
  860. # move to the player skipped to
  861. uno_nextplayer
  862.  
  863. if {[uno_checkwindraw $nick [uno_cardcolor $crd] $PlayerThatDrew $PlayerThatDrewIDX 2]} { return }
  864.  
  865. uno_showplaydraw $nick [uno_cardcolor $crd] $PlayerThatDrew $ThisPlayer
  866.  
  867. uno_adddrawtohand $PlayerThatDrew $PlayerThatDrewIDX 2
  868.  
  869. uno_checkuno $nick
  870.  
  871. uno_showcards $ThisPlayer $ThisPlayerIDX
  872.  
  873. uno_isdrawreset
  874. }
  875.  
  876. #
  877. # wild draw four card
  878. #
  879. proc uno_playwilddrawfourcard {nick pickednum crd isrobot} {
  880. global ThisPlayer ThisPlayerIDX RoundRobin IsColorChange ColorPicker
  881.  
  882. set ColorPicker $ThisPlayer
  883.  
  884. uno_removecardfromhand $nick $pickednum
  885.  
  886. uno_addtodiscardpile $crd
  887.  
  888. # move to the player that draws
  889. uno_nextplayer
  890.  
  891. set PlayerThatDrew $ThisPlayer
  892. set PlayerThatDrewIDX $ThisPlayerIDX
  893.  
  894. # bot chooses a color
  895. if {$isrobot > 0} {
  896. set cip [uno_botpickcolor]
  897. uno_nextplayer
  898. }
  899.  
  900. if {[uno_checkwindraw $nick [uno_cardcolor $crd] $PlayerThatDrew $PlayerThatDrewIDX 4]} { return }
  901.  
  902. if {$isrobot} {
  903. uno_showbotplaywildfour $ColorPicker $PlayerThatDrew $ColorPicker $cip $ThisPlayer
  904. set ColorPicker ""
  905. set IsColorChange 0
  906. uno_showcards $ThisPlayer $ThisPlayerIDX
  907. } {
  908. uno_showplaywildfour $nick $PlayerThatDrew $ColorPicker
  909. set IsColorChange 1
  910. }
  911.  
  912. uno_adddrawtohand $PlayerThatDrew $PlayerThatDrewIDX 4
  913.  
  914. uno_checkuno $nick
  915.  
  916. uno_isdrawreset
  917. }
  918.  
  919. #
  920. # wild card
  921. #
  922. proc uno_playwildcard {nick pickednum crd isrobot} {
  923. global ThisPlayer ThisPlayerIDX RoundRobin IsColorChange ColorPicker
  924.  
  925. set ColorPicker $ThisPlayer
  926.  
  927. uno_removecardfromhand $nick $pickednum
  928.  
  929. uno_addtodiscardpile $crd
  930.  
  931. if {$isrobot} {
  932. # make a color choice
  933. set cip [uno_botpickcolor]
  934. uno_nextplayer
  935. }
  936.  
  937. # no cards remaining = winner
  938. if {[uno_checkwin $nick [uno_cardcolor $crd]]} { return }
  939.  
  940. if {$isrobot} {
  941. uno_showbotplaywild $nick $ColorPicker $cip $ThisPlayer
  942. set ColorPicker ""
  943. uno_showcards $ThisPlayer $ThisPlayerIDX
  944. set IsColorChange 0
  945. } {
  946. uno_showplaywild $nick $ColorPicker
  947. set IsColorChange 1
  948. }
  949.  
  950. uno_checkuno $nick
  951.  
  952. uno_isdrawreset
  953. }
  954.  
  955. #
  956. # number card
  957. #
  958. proc uno_playnumbercard {nick pickednum crd} {
  959. global ThisPlayer ThisPlayerIDX RoundRobin
  960.  
  961. uno_removecardfromhand $nick $pickednum
  962.  
  963. uno_addtodiscardpile $crd
  964.  
  965. set NumberCardPlayer $ThisPlayer
  966.  
  967. uno_nextplayer
  968.  
  969. if {[uno_checkwin $NumberCardPlayer [uno_cardcolor $crd]]} { return }
  970.  
  971. uno_showplaycard $nick [uno_cardcolor $crd] $ThisPlayer
  972.  
  973. uno_checkuno $NumberCardPlayer
  974.  
  975. uno_showcards $ThisPlayer $ThisPlayerIDX
  976.  
  977. uno_isdrawreset
  978. }
  979.  
  980. #
  981. # attempt to find card in hand
  982. #
  983. proc uno_findcard {nick pickednum crd} {
  984. global UnoRobot ThisPlayer ThisPlayerIDX PlayCard UnoWildDrawTwos
  985.  
  986. #if {$UnoDebug > 1} {unolog $UnoRobot "uno_findcard: [lindex $UnoHand($ThisPlayer) $pickednum"}
  987.  
  988. # card in hand
  989. set c0 [string range $crd 0 0]
  990. set c1 [string range $crd 1 1]
  991.  
  992. # card in play
  993. set cip0 [string range $PlayCard 0 0]
  994. set cip1 [string range $PlayCard 1 1]
  995.  
  996. # skip
  997. if {$c1 == "S"} {
  998. if {($c0 == $cip0)||($c1 == $cip1)} { return 1 }
  999. return 0
  1000. }
  1001.  
  1002. # reverse
  1003. if {$c1 == "R"} {
  1004. if {($c0 == $cip0)||($c1 == $cip1)} { return 2 }
  1005. return 0
  1006. }
  1007.  
  1008. # wild draw four
  1009. if {($c0 == "W")&&($c1 == "D")} {
  1010. if {![uno_checkhandcolor $ThisPlayer]} { return 4 }
  1011. return 7
  1012. }
  1013.  
  1014. # wild
  1015. if {$c0 == "W"} { return 5 }
  1016.  
  1017. # draw two
  1018. if {$c1 == "D"} {
  1019. set CardOk 0
  1020. if {$c0 == $cip0} {set CardOk 1}
  1021. if {$UnoWildDrawTwos != 0} {
  1022. if {($cip0 != "W")&&($cip1 == "D")} {set CardOk 1}
  1023. if {$cip1 != ""} {set CardOk 1}
  1024. } {
  1025. if {($cip0 != "W")&&($cip1 == "D")} {set CardOk 1}
  1026. }
  1027. if {$CardOk} {
  1028. return 3
  1029. }
  1030. return 0
  1031. }
  1032.  
  1033. # number card
  1034. if {($c1 == -1)} {return 0}
  1035. if {($c0 == $cip0)||(($cip1 != "")&&($c1 == $cip1))} { return 6 }
  1036.  
  1037. return 0
  1038. }
  1039.  
  1040. #
  1041. # play the picked card
  1042. #
  1043. # cardfound is set by uno_findcard, which returns a card type as follows:
  1044. #
  1045. # 0 invalid card
  1046. # 1 skip card
  1047. # 2 reverse card
  1048. # 3 draw-two card
  1049. # 4 draw-four card
  1050. # 5 wild card
  1051. # 6 number card
  1052. # 7 illegal card
  1053. #
  1054. proc uno_playactualcard {nick cardfound pickednum crd isrobot} {
  1055. global CardStats
  1056. switch $cardfound {
  1057. 0 {
  1058. if {$isrobot} {
  1059. unolog $nick "UnoRobot: oops $crd"
  1060. } {
  1061. unontc $nick "Oops! Not a valid card... draw or play another"
  1062. }
  1063. }
  1064. 1 {
  1065. uno_playskipcard $nick $pickednum $crd
  1066. incr CardStats(played)
  1067. uno_restartbotplayer
  1068. }
  1069. 2 {
  1070. uno_playreversecard $nick $pickednum $crd
  1071. incr CardStats(played)
  1072. uno_restartbotplayer
  1073. }
  1074. 3 {
  1075. uno_playdrawtwocard $nick $pickednum $crd
  1076. incr CardStats(played)
  1077. uno_restartbotplayer
  1078. }
  1079. 4 {
  1080. uno_playwilddrawfourcard $nick $pickednum $crd $isrobot
  1081. incr CardStats(played)
  1082. if {$isrobot} { uno_restartbotplayer }
  1083. }
  1084. 5 {
  1085. uno_playwildcard $nick $pickednum $crd $isrobot
  1086. incr CardStats(played)
  1087. }
  1088. 6 {
  1089. uno_playnumbercard $nick $pickednum $crd
  1090. incr CardStats(played)
  1091. if {!$isrobot} { uno_restartbotplayer }
  1092. }
  1093. 7 {
  1094. if {$isrobot} {
  1095. unolog $nick "UnoRobot: oops valid card in-hand"; return
  1096. uno_restartbotplayer
  1097. } {
  1098. unontc $nick "You have a valid color card in-hand, $nick, you must play it first"; return
  1099. }
  1100. }
  1101. }
  1102. }
  1103.  
  1104. #
  1105. # attempt to play a card
  1106. #
  1107. proc UnoPlayCard {nick uhost hand chan txt} {
  1108. global UnoMode IsColorChange UnoHand ThisPlayer
  1109.  
  1110. if {(![uno_ischan $chan])||($UnoMode != 2)||($nick != $ThisPlayer)||($IsColorChange == 1)} {return}
  1111.  
  1112. uno_autoskipreset $nick
  1113.  
  1114. regsub -all \[`,.!{}\ ] $txt "" txt
  1115.  
  1116. if {$txt == ""} {return}
  1117.  
  1118. set pcard [string toupper [string range $txt 0 1]]
  1119.  
  1120. set CardInHand 0
  1121.  
  1122. set pcount 0
  1123. while {[lindex $UnoHand($nick) $pcount] != ""} {
  1124. if {$pcard == [lindex $UnoHand($nick) $pcount]} {
  1125. set pcardnum $pcount
  1126. uno_playactualcard $nick [uno_findcard $nick $pcardnum $pcard] $pcardnum $pcard 0
  1127. return
  1128. }
  1129. incr pcount
  1130. }
  1131. unontc $nick "You don't have that card $nick, draw or play another"
  1132. return
  1133. }
  1134.  
  1135. #
  1136. # robot player
  1137. #
  1138.  
  1139. # robot tries to find card from hand
  1140. proc uno_botplayertrycard {} {
  1141. global PlayCard UnoHand ThisPlayer
  1142.  
  1143. # card in play
  1144. set cip0 [string range $PlayCard 0 0]
  1145. set cip1 [string range $PlayCard 1 1]
  1146.  
  1147. set colorcardinplay [uno_iscolorcard $cip0]
  1148.  
  1149. set Tier 0
  1150. set TierMax 8
  1151.  
  1152. # Tier is the order in which the bot player chooses cards:
  1153. # 0 draw two
  1154. # 1 skip
  1155. # 2 reverse
  1156. # skip or reverse on same color
  1157. # color or number match
  1158. # draw four
  1159. # wild
  1160.  
  1161. while {$Tier < $TierMax} {
  1162. set CardCount 0
  1163. while {$CardCount < [llength $UnoHand($ThisPlayer)]} {
  1164.  
  1165. set pcard [lindex $UnoHand($ThisPlayer) $CardCount]
  1166.  
  1167. # card in hand
  1168. set hc0 [string range $pcard 0 0]
  1169. set hc1 [string range $pcard 1 1]
  1170.  
  1171. set colorcardinhand [uno_iscolorcard $hc0]
  1172.  
  1173. switch $Tier {
  1174. 0 {if {($colorcardinplay)&&($hc0 == $cip0)&&($hc1 == "D")} {return $CardCount}}
  1175. 1 {if {($colorcardinplay)&&($cip1 == "D")&&($colorcardinhand)&&($hc1 == "D")} {return $CardCount}}
  1176. 2 {if {($cip1 == "S")&&($hc1 == "S")} {return $CardCount}}
  1177. 3 {if {($cip1 == "R")&&($hc1 == "R")} {return $CardCount}}
  1178. 4 {if {($hc0 == $cip0)&&(($hc1 == "S")||($hc1 == "R"))} {return $CardCount}}
  1179. 5 {if {($hc0 == $cip0)||(($hc1 != "D")&&($hc1 == $cip1))} {return $CardCount}}
  1180. 6 {if {($hc0 == "W")&&($hc1 == "D")} {return $CardCount}}
  1181. 7 {if {($hc0 == "W")} {return $CardCount}}
  1182. }
  1183. incr CardCount
  1184. }
  1185. incr Tier
  1186. }
  1187. return -1;
  1188. }
  1189.  
  1190. proc UnoRobotPlayer {} {
  1191. global UnoDeck UnoHand ThisPlayer ThisPlayerIDX UnoRobot
  1192.  
  1193. set CardOk -1
  1194.  
  1195. uno_isdrawreset
  1196.  
  1197. set UnoHand($ThisPlayer) [uno_sorthand $UnoHand($ThisPlayer)]
  1198.  
  1199. # look for card in hand
  1200. set CardOk [uno_botplayertrycard]
  1201.  
  1202. # play card if found
  1203. if {$CardOk > -1} {
  1204. set pcard [lindex $UnoHand($ThisPlayer) $CardOk]
  1205. uno_playactualcard $UnoRobot [uno_findcard $UnoRobot $CardOk $pcard] $CardOk $pcard 1
  1206. return
  1207. }
  1208.  
  1209. # bot draws a card
  1210. UnoShuffle 1
  1211.  
  1212. set dcardnum 0
  1213. set dcard [lindex $UnoDeck $dcardnum]
  1214. lappend UnoHand($ThisPlayer) $dcard
  1215. set UnoDeck [lreplace $UnoDeck $dcardnum $dcardnum]
  1216.  
  1217. uno_showwhodrew $UnoRobot
  1218.  
  1219. set UnoHand($ThisPlayer) [uno_sorthand $UnoHand($ThisPlayer)]
  1220.  
  1221. # look for card in hand
  1222. set CardOk [uno_botplayertrycard]
  1223.  
  1224. # bot plays drawn card or passes turn
  1225. if {$CardOk > -1} {
  1226. set pcard [lindex $UnoHand($ThisPlayer) $CardOk]
  1227. uno_playactualcard $UnoRobot [uno_findcard $UnoRobot $CardOk $pcard] $CardOk $pcard 1
  1228. } {
  1229. uno_isdrawreset
  1230. uno_nextplayer
  1231. uno_showplaypass $UnoRobot $ThisPlayer
  1232. uno_showcards $ThisPlayer $ThisPlayerIDX
  1233. }
  1234. return
  1235. }
  1236.  
  1237. #
  1238. # autoskip inactive players
  1239. #
  1240. proc UnoAutoSkip {} {
  1241. global UnoMode ThisPlayer ThisPlayerIDX RoundRobin AutoSkipPeriod IsColorChange ColorPicker
  1242. global UnoIDX UnoPlayers UnoDeck UnoHand UnoChan UnoSkipTimer UnoDebug UnoNickColor UnoPaused UnoDCCIDX UnoLastIdler
  1243. global botnick
  1244.  
  1245. if {($UnoMode != 2)||($UnoPaused != 0)} {return}
  1246.  
  1247. set Idler $ThisPlayer
  1248. set IdlerIDX $ThisPlayerIDX
  1249.  
  1250. if {[uno_isrobot $ThisPlayerIDX]} {unolog "uno" "oops: Autoskip called while bot players turn"; return}
  1251.  
  1252. if {[uno_timerexists UnoAutoSkip] != ""} {
  1253. unolog "uno" "oops: Autoskip timer called, but already exists"
  1254. return
  1255. }
  1256.  
  1257. set InChannel 0
  1258. set uclist [chanlist $UnoChan]
  1259.  
  1260. set pcount 0
  1261. while {[lindex $uclist $pcount] != ""} {
  1262. if {[lindex $uclist $pcount] == $Idler} {
  1263. set InChannel 1
  1264. break
  1265. }
  1266. incr pcount
  1267. }
  1268.  
  1269. if {!$InChannel || ($Idler == $UnoLastIdler)} {
  1270. if {!$InChannel} {
  1271. unomsg "[unonik $Idler]\003 left the channel and is removed from Uno"
  1272. } {
  1273. unomsg "[unonik $Idler]\003 has been idle twice in a row and is removed from Uno"
  1274. set UnoLastIdler ""
  1275. }
  1276. if {$IsColorChange == 1} {
  1277. if {$Idler == $ColorPicker} {
  1278. # Make A Color Choice
  1279. set cip [uno_pickcolor]
  1280. unomsg "\0030,13 $Idler \003was picking a color : randomly selecting $cip"
  1281. set IsColorChange 0
  1282. } {
  1283. unolog "uno" "oops: UnoAutoRemove color change set but $Idler not color picker"
  1284. }
  1285. }
  1286.  
  1287. uno_nextplayer
  1288.  
  1289. unomsg "[unonik $Idler]\003 was the current player, continuing with [unonik $ThisPlayer]"
  1290.  
  1291. uno_showcards $ThisPlayer $ThisPlayerIDX
  1292.  
  1293. set UnoPlayers [expr ($UnoPlayers -1)]
  1294.  
  1295. # remove player from game and put cards back in deck
  1296. if {$UnoPlayers > 1} {
  1297. set RoundRobin [lreplace $RoundRobin $IdlerIDX $IdlerIDX]
  1298. set UnoIDX [lreplace $UnoIDX $IdlerIDX $IdlerIDX]
  1299. while {[llength $UnoHand($Idler)] > 0} {
  1300. set pcard [lindex $UnoHand($Idler) 0]
  1301. set UnoHand($Idler) [lreplace $UnoHand($Idler) 0 0]
  1302. lappend UnoDeck $pcard
  1303. }
  1304. if [info exist UnoHand($Idler)] {unset UnoHand($Idler)}
  1305. if [info exist UnoNickColor($Idler)] {unset UnoNickColor($Idler)}
  1306. if [info exist UnoDCCIDX($Idler)] {unset UnoDCCIDX($Idler)}
  1307. }
  1308.  
  1309. switch $UnoPlayers {
  1310. 1 {
  1311. uno_showwindefault $ThisPlayer
  1312. UnoWin $ThisPlayer
  1313. UnoCycle
  1314. }
  1315. 0 {
  1316. unochanmsg "\00306no players, no winner... cycling"
  1317. UnoCycle
  1318. }
  1319. default {
  1320. if {![uno_isrobot $ThisPlayerIDX]} {
  1321. uno_autoskipreset $botnick
  1322. uno_restartbotplayer
  1323. }
  1324. }
  1325. }
  1326. return
  1327. }
  1328.  
  1329. if {$UnoDebug > 0} {unolog "uno" "AutoSkip Player: $Idler"}
  1330.  
  1331. unomsg "[unonik $Idler]\003 idle for \00313$AutoSkipPeriod \003minutes and is skipped"
  1332.  
  1333. set UnoLastIdler $Idler
  1334.  
  1335. # player was color picker
  1336. if {$IsColorChange == 1} {
  1337. if {$Idler == $ColorPicker} {
  1338. # Make A Color Choice
  1339. set cip [uno_pickcolor]
  1340. unomsg "[unonik $Idler]\003 was picking a color : randomly selecting $cip"
  1341. set IsColorChange 0
  1342. } {
  1343. unolog "uno" "UnoRemove: IsColorChange set but $Idler not ColorPicker"
  1344. }
  1345. }
  1346.  
  1347. uno_nextplayer
  1348.  
  1349. unomsg "[unonik $Idler]\003 was the current player, continuing with [unonik $ThisPlayer]"
  1350.  
  1351. uno_showcards $ThisPlayer $ThisPlayerIDX
  1352.  
  1353. if {[uno_isrobot $ThisPlayerIDX]} {
  1354. uno_restartbotplayer
  1355. }
  1356.  
  1357. uno_autoskipreset $botnick
  1358. return
  1359. }
  1360.  
  1361. #
  1362. # pause play
  1363. #
  1364. proc UnoPause {nick uhost hand chan txt} {
  1365. global UnoChan UnoOpFlags UnoPaused
  1366.  
  1367. if {![uno_isrunning $chan]} {return}
  1368.  
  1369. if {([validuser $nick])&&([matchattr $nick $UnoOpFlags $UnoChan])} {
  1370. if {!$UnoPaused} {
  1371. set UnoPaused 1
  1372. UnoUnbindCmds
  1373. unochanmsg "\00304 paused \003by $nick"
  1374. } {
  1375. set UnoPaused 0
  1376. UnoBindCmds
  1377. uno_autoskipreset $nick
  1378. unochanmsg "\00303 resumed \003by $nick"
  1379. }
  1380. }
  1381. }
  1382.  
  1383. #
  1384. # remove user from play
  1385. #
  1386. proc UnoRemove {nick uhost hand chan txt} {
  1387. global UnoChan UnoCycleTime UnoIDX UnoPlayers ThisPlayer ThisPlayerIDX RoundRobin UnoDeck DiscardPile UnoHand IsColorChange ColorPicker UnoNickColor UnoOpFlags UnoDCCIDX
  1388.  
  1389. if {![uno_isrunning $chan]} {return}
  1390.  
  1391. regsub -all \[`,.!{}] $txt "" txt
  1392.  
  1393. # allow ops to remove another player
  1394. set UnoOpRemove 0
  1395.  
  1396. if {[string length $txt] > 0} {
  1397. if {([validuser $nick])&&([matchattr $nick $UnoOpFlags $UnoChan])} {
  1398. set UnoOpRemove 1
  1399. set UnoOpNick $nick
  1400. set nick $txt
  1401. } {
  1402. return
  1403. }
  1404. }
  1405.  
  1406. # remove player if found - put cards back to bottom of deck
  1407. set pcount 0
  1408. set PlayerFound 0
  1409. while {[lindex $RoundRobin $pcount] != ""} {
  1410. if {[string tolower [lindex $RoundRobin $pcount]] == [string tolower $nick]} {
  1411. set PlayerFound 1
  1412. set FoundIDX $pcount
  1413. set nick [lindex $RoundRobin $pcount]
  1414. break
  1415. }
  1416. incr pcount
  1417. }
  1418.  
  1419. if {!$PlayerFound} {return}
  1420.  
  1421. if {$UnoOpRemove > 0} {
  1422. unomsg "[unonik $nick]\003 was removed from uno by $UnoOpNick"
  1423. } {
  1424. unontc $nick "You are now removed from the current uno game."
  1425. unomsg "[unonik $nick]\003 left Uno"
  1426. }
  1427.  
  1428. # player was color picker
  1429. if {$IsColorChange == 1} {
  1430. if {$nick == $ColorPicker} {
  1431. # Make A Color Choice
  1432. set cip [uno_pickcolor]
  1433. unomsg "[unonik $nick]\003 was choosing a color... I randomly select $cip"
  1434. set IsColorChange 0
  1435. } {
  1436. unolog "uno" "UnoRemove: IsColorChange set but $nick not ColorPicker"
  1437. }
  1438. }
  1439.  
  1440. if {$nick == $ThisPlayer} {
  1441. uno_nextplayer
  1442. if {$UnoPlayers > 2} {
  1443. unomsg "[unonik $nick]\003 was the current player, continuing with [unonik $ThisPlayer]"
  1444. }
  1445. uno_autoskipreset $nick
  1446. }
  1447.  
  1448. set UnoPlayers [expr ($UnoPlayers -1)]
  1449.  
  1450. # remove player from game and put cards back in deck
  1451.  
  1452. if {$UnoPlayers > 1} {
  1453. set RoundRobin [lreplace $RoundRobin $FoundIDX $FoundIDX]
  1454. set UnoIDX [lreplace $UnoIDX $FoundIDX $FoundIDX]
  1455. while {[llength $UnoHand($nick)] > 0} {
  1456. set pcard [lindex $UnoHand($nick) 0]
  1457. set UnoHand($nick) [lreplace $UnoHand($nick) 0 0]
  1458. lappend DiscardPile $pcard
  1459. }
  1460. if [info exist UnoHand($nick)] {unset UnoHand($nick)}
  1461. if [info exist UnoNickColor($nick)] {unset UnoNickColor($nick)}
  1462. if [info exist UnoDCCIDX($nick)] {unset UnoDCCIDX($nick)}
  1463. }
  1464.  
  1465. set pcount 0
  1466. while {[lindex $RoundRobin $pcount] != ""} {
  1467. if {[lindex $RoundRobin $pcount] == $ThisPlayer} {
  1468. set ThisPlayerIDX $pcount
  1469. break
  1470. }
  1471. incr pcount
  1472. }
  1473.  
  1474. if {$UnoPlayers == 1} {
  1475. uno_showwindefault $ThisPlayer
  1476. UnoWin $ThisPlayer
  1477. UnoCycle
  1478. return
  1479. }
  1480.  
  1481. uno_restartbotplayer
  1482.  
  1483. if {!$UnoPlayers} {
  1484. unochanmsg "no players, no winner... recycling"
  1485. UnoCycle
  1486. }
  1487. return
  1488. }
  1489.  
  1490. #
  1491. # Move to next player
  1492. #
  1493. proc uno_nextplayer {} {
  1494. global ThisPlayer ThisPlayerIDX RoundRobin
  1495. incr ThisPlayerIDX
  1496. if {$ThisPlayerIDX >= [llength $RoundRobin]} {set ThisPlayerIDX 0}
  1497. set ThisPlayer [lindex $RoundRobin $ThisPlayerIDX]
  1498. }
  1499.  
  1500. #
  1501. # Set global PlayCard to picked color and return colored card
  1502. #
  1503. proc uno_getcolorcard {crd} {
  1504. global PlayCard UnoRedCard UnoGreenCard UnoBlueCard UnoYellowCard
  1505. set pcol [string range $crd 0 0]
  1506. switch $pcol {
  1507. "R" {set PlayCard "R"; return "$UnoRedCard\003" }
  1508. "G" {set PlayCard "G"; return "$UnoGreenCard\003" }
  1509. "B" {set PlayCard "B"; return "$UnoBlueCard\003" }
  1510. "Y" {set PlayCard "Y"; return "$UnoYellowCard\003" }
  1511. }
  1512. }
  1513.  
  1514. #
  1515. # returns 1 if color card, 0 if not
  1516. #
  1517. proc uno_iscolorcard {c} {
  1518. switch $c {
  1519. "R" {return 1}
  1520. "G" {return 1}
  1521. "B" {return 1}
  1522. "Y" {return 1}
  1523. }
  1524. return 0
  1525. }
  1526.  
  1527. #
  1528. # Pick a random color for skipped/removed players
  1529. #
  1530. proc uno_pickcolor {} {
  1531. set ucolors "R G B Y"
  1532. set pcol [lindex $ucolors [rand [llength $ucolors]]]
  1533. return [uno_getcolorcard $pcol]
  1534. }
  1535.  
  1536. #
  1537. # Robot picks a color by checking hand for 1st color card
  1538. # found with matching color, else picks color at random
  1539. #
  1540. proc uno_botpickcolor {} {
  1541. global UnoHand ThisPlayer ColorPicker
  1542.  
  1543. set hlen [llength $UnoHand($ColorPicker)]
  1544.  
  1545. # draw two
  1546. set CardCount 0
  1547. while {$CardCount < $hlen} {
  1548. set thiscolor [string range [lindex $UnoHand($ColorPicker) $CardCount] 0 0]
  1549. set thiscard [string range [lindex $UnoHand($ColorPicker) $CardCount] 1 1]
  1550. if {([uno_iscolorcard $thiscolor])&&($thiscard == "D")} { return [uno_getcolorcard $thiscolor] }
  1551. incr CardCount
  1552. }
  1553.  
  1554. # skip/reverse
  1555. set CardCount 0
  1556. while {$CardCount < $hlen} {
  1557. set thiscolor [string range [lindex $UnoHand($ColorPicker) $CardCount] 0 0]
  1558. set thiscard [string range [lindex $UnoHand($ColorPicker) $CardCount] 1 1]
  1559. if {([uno_iscolorcard $thiscolor])&&(($thiscard == "S")||($thiscard == "R"))} { return [uno_getcolorcard $thiscolor] }
  1560. incr CardCount
  1561. }
  1562.  
  1563. # number card
  1564. set CardCount 0
  1565. while {$CardCount < $hlen} {
  1566. set thiscolor [string range [lindex $UnoHand($ColorPicker) $CardCount] 0 0]
  1567. if {[uno_iscolorcard $thiscolor]} { return [uno_getcolorcard $thiscolor] }
  1568. incr CardCount
  1569. }
  1570.  
  1571. # wild or wdf remain, pick color at random
  1572. return [uno_pickcolor]
  1573. }
  1574.  
  1575. #
  1576. # Timers
  1577. #
  1578.  
  1579. # set robot for next turn
  1580. proc uno_restartbotplayer {} {
  1581. global UnoMode ThisPlayerIDX RobotRestartPeriod UnoBotTimer
  1582. if {$UnoMode != 2} {return}
  1583. if {![uno_isrobot $ThisPlayerIDX]} {return}
  1584. set UnoBotTimer [utimer $RobotRestartPeriod UnoRobotPlayer]
  1585. }
  1586.  
  1587. # reset autoskip timer
  1588. proc uno_autoskipreset {nick} {
  1589. global AutoSkipPeriod UnoMode UnoSkipTimer UnoLastIdler
  1590. catch {killtimer $UnoSkipTimer}
  1591. if {$nick == $UnoLastIdler} { set UnoLastIdler "" }
  1592. if {$UnoMode == 2} { set UnoSkipTimer [timer $AutoSkipPeriod UnoAutoSkip] }
  1593. }
  1594.  
  1595. #
  1596. # Channel Triggers
  1597. #
  1598.  
  1599. # game help
  1600. proc UnoCmds {nick uhost hand chan txt} {
  1601. global UnoLogo
  1602. if {![uno_ischan $chan]} {return}
  1603. unogntc $nick "$UnoLogo Commands: !uno !stop !remove \[nick\] !unowon \[nick\] !unocmds"
  1604. unogntc $nick "$UnoLogo Stats: !unotop10 \[games\|wins\|21\] !unotop3last !unostats !unorecords"
  1605. unogntc $nick "$UnoLogo Card Commands: jo=join pl=play dr=draw pa=pass co=color"
  1606. unogntc $nick "$UnoLogo Chan Commands: ca=cards cd=card tu=turn od=order ct=count st=stats ti=time"
  1607. return
  1608. }
  1609.  
  1610. # game version
  1611. proc UnoVersion {nick uhost hand chan txt} {
  1612. global UnoVersion
  1613. unochanmsg "$UnoVersion by Marky \003"
  1614. return
  1615. }
  1616.  
  1617. # current player order
  1618. proc UnoOrder {nick uhost hand chan txt} {
  1619. global UnoPlayers RoundRobin
  1620. if {![uno_isrunning $chan]} {return}
  1621. unochanmsg "Player order: \00314$RoundRobin\003"
  1622. return
  1623. }
  1624.  
  1625. # game running time
  1626. proc UnoTime {nick uhost hand chan txt} {
  1627. global UnoLogo
  1628. if {![uno_isrunning $chan]} {return}
  1629. unochanmsg "Game time \00314[UnoDuration [uno_gametime]] \003"
  1630. return
  1631. }
  1632.  
  1633. # show player what cards in hand
  1634. proc UnoShowCards {nick uhost hand chan txt} {
  1635. global UnoHand ThisPlayerIDX
  1636.  
  1637. if {![uno_isrunning $chan]} {return}
  1638.  
  1639. if ![info exist UnoHand($nick)] { return }
  1640.  
  1641. set UnoHand($nick) [uno_sorthand $UnoHand($nick)]
  1642.  
  1643. set Card [uno_cardcolorall $nick]
  1644.  
  1645. if {![uno_isrobot $ThisPlayerIDX]} { unontc $nick "$Card\003" }
  1646.  
  1647. return
  1648. }
  1649.  
  1650. # show current player
  1651. proc UnoTurn {nick uhost hand chan txt} {
  1652. global ThisPlayer RoundRobin UnoMode
  1653. if {![uno_isrunning $chan]} {return}
  1654. if {[llength $RoundRobin] < 1 } {return}
  1655. unochanmsg "Current player: \00314$ThisPlayer\003"
  1656. return
  1657. }
  1658.  
  1659. # show current top card
  1660. proc UnoTopCard {nick uhost hand chan txt} {
  1661. global PlayCard
  1662. if {![uno_isrunning $chan]} {return}
  1663. set Card [uno_cardcolor $PlayCard]
  1664. unochanmsg "Card in play: $Card"
  1665. return
  1666. }
  1667.  
  1668. # card stats
  1669. proc UnoCardStats {nick uhost hand chan txt} {
  1670. global CardStats
  1671. if {![uno_isrunning $chan]} {return}
  1672. unochanmsg "Played:\00314$CardStats(played)\003"
  1673. return
  1674. }
  1675.  
  1676. # card count
  1677. proc UnoCardCount {nick uhost hand chan txt} {
  1678. global RoundRobin UnoHand
  1679. if {![uno_isrunning $chan]} {return}
  1680. set ordcnt 0
  1681. set crdcnt ""
  1682. while {[lindex $RoundRobin $ordcnt] != ""} {
  1683. set cp [lindex $RoundRobin $ordcnt]
  1684. set cc [llength $UnoHand($cp)]
  1685. append crdcnt "\00310 $cp \00306 $cc cards "
  1686. incr ordcnt
  1687. }
  1688. unomsg "$crdcnt\003"
  1689. return
  1690. }
  1691.  
  1692. # player's score
  1693. proc UnoWon {nick uhost hand chan txt} {
  1694. global UnoScoreFile UnoPointsName
  1695.  
  1696. if {![uno_ischan $chan]} {return}
  1697.  
  1698. regsub -all \[`,.!] $txt "" txt
  1699.  
  1700. if {![string length $txt]} {set txt $nick}
  1701.  
  1702. set scorer [string tolower $txt]
  1703.  
  1704. set pflag 0
  1705.  
  1706. set f [open $UnoScoreFile r]
  1707. while {[gets $f sc] != -1} {
  1708. set cnick [string tolower [lindex [split $sc] 0]]
  1709. if {$cnick == $scorer} {
  1710. set winratio [format "%4.1f" [expr [lindex $sc 2] /[lindex $sc 1]]]
  1711. set pmsg "\00306[lindex [split $sc] 0] \003 [lindex $sc 2] $UnoPointsName in [lindex $sc 1] games \($winratio p\/g\)"
  1712. set pflag 1
  1713. }
  1714. }
  1715. close $f
  1716.  
  1717. if {!$pflag} {
  1718. set pmsg "\00306$txt\003 no score"
  1719. }
  1720. unochanmsg "$pmsg"
  1721. return
  1722. }
  1723.  
  1724. # current top10 list
  1725. proc UnoTopTen {nick uhost hand chan txt} {
  1726. if {![uno_ischan $chan]} {return}
  1727. regsub -all \[`,.!{}\ ] $txt "" txt
  1728. set txt [string tolower [string range $txt 0 10]]
  1729. switch $txt {
  1730. "won" {set mode 1}
  1731. "games" {set mode 0}
  1732. "points" {set mode 1}
  1733. "21" {set mode 2}
  1734. "blackjack" {set mode 2}
  1735. default {set mode 1}
  1736. }
  1737. UnoTop10 $mode
  1738. return
  1739. }
  1740.  
  1741. # last month's top3
  1742. proc UnoTopThreeLast {nick uhost hand chan txt} {
  1743. if {![uno_ischan $chan]} {return}
  1744. UnoLastMonthTop3 $nick $uhost $hand $chan 0
  1745. UnoLastMonthTop3 $nick $uhost $hand $chan 1
  1746. return
  1747. }
  1748.  
  1749. # month's stats
  1750. proc UnoPlayStats {nick uhost hand chan txt} {
  1751. global UnoFast UnoHigh UnoPlayed UnoPointsName
  1752. if {![uno_ischan $chan]} {return}
  1753. unochanmsg "Current record holders"
  1754. set msg "\00306Fast:\003 [lindex [split $UnoFast] 0] \002[UnoDuration [lindex $UnoFast 1]]\002 "
  1755. append msg "\00306High:\003 [lindex [split $UnoHigh] 0] \002[lindex $UnoHigh 1]\002 $UnoPointsName "
  1756. append msg "\00306Played:\003 [lindex [split $UnoPlayed] 0] \002[lindex $UnoPlayed 1]\002 Cards"
  1757. unochanmsg "$msg"
  1758. return
  1759. }
  1760.  
  1761. # all-time records
  1762. proc UnoRecords {nick uhost hand chan txt} {
  1763. global UnoRecordFast UnoRecordHigh UnoRecordCard UnoRecordWins UnoRecordPlayed
  1764. if {![uno_ischan $chan]} {return}
  1765. unochanmsg "All-Time Records"
  1766. unochanmsg "\00306Points:\003 $UnoRecordCard \00306 Games:\003 $UnoRecordWins \00306 Fast:\003 [lindex $UnoRecordFast 0] [UnoDuration [lindex $UnoRecordFast 1]] \00306 High Score:\003 $UnoRecordHigh \00306 Cards Played:\003 $UnoRecordPlayed \003"
  1767. return
  1768. }
  1769.  
  1770. # current row (streak)
  1771. proc UnoCurrentRow {nick uhost hand chan txt} {
  1772. global UnoLastWinner UnoWinsInARow
  1773. if {![uno_ischan $chan]} {return}
  1774. if {($UnoLastWinner != "")&&($UnoWinsInARow > 0)} {
  1775. switch ($UnoWinsInARow) {
  1776. 1 { unochanmsg "\0036$UnoLastWinner \003 has won \0030,6 $UnoWinsInARow game \003" }
  1777. default { unochanmsg "\0033$UnoLastWinner \003 is on a \0030,6 $UnoWinsInARow game streak \003" }
  1778. }
  1779. }
  1780. return
  1781. }
  1782.  
  1783. # month top10
  1784. proc UnoTop10 {mode} {
  1785. global UnoScoreFile unsortedscores UnoPointsName UnoRobot
  1786.  
  1787. if {($mode < 0)||($mode > 2)} {set mode 0}
  1788.  
  1789. switch $mode {
  1790. 0 {set winners "Top10 Game Wins "}
  1791. 1 {set winners "Top10 $UnoPointsName "}
  1792. 2 {set winners "Top10 Blackjacks "}
  1793. }
  1794.  
  1795. if ![file exists $UnoScoreFile] {
  1796. set f [open $UnoScoreFile w]
  1797. puts $f "$UnoRobot 0 0 0"
  1798. unochanmsg "\0034Uno scores reset"
  1799. close $f
  1800. return
  1801. } {
  1802. unomsg "$winners"
  1803. set winners ""
  1804. }
  1805.  
  1806. if [info exists unsortedscores] {unset unsortedscores}
  1807. if [info exists top10] {unset top10}
  1808.  
  1809. set f [open $UnoScoreFile r]
  1810. while {[gets $f s] != -1} {
  1811. switch $mode {
  1812. 0 {set unsortedscores([lindex [split $s] 0]) [lindex $s 1]}
  1813. 1 {set unsortedscores([lindex [split $s] 0]) [lindex $s 2]}
  1814. 2 {set unsortedscores([lindex [split $s] 0]) [lindex $s 3]}
  1815. }
  1816. }
  1817. close $f
  1818.  
  1819. for {set s 0} {$s < 10} {incr s} {
  1820. set top10($s) "Nobody 0"
  1821. }
  1822.  
  1823. set s 0
  1824. foreach n [lsort -decreasing -command uno_sortscores [array names unsortedscores]] {
  1825. set top10($s) "$n $unsortedscores($n)"
  1826. incr s
  1827. }
  1828.  
  1829. for {set s 0} {$s < 10} {incr s} {
  1830. if {[llength [lindex $top10($s) 0]] > 0} {
  1831. if {[lindex [split $top10($s)] 0] != "Nobody"} {
  1832. append winners "\0030,6 #[expr $s +1] \0030,10 [lindex [split $top10($s)] 0] [lindex $top10($s) 1] "
  1833. }
  1834. }
  1835. }
  1836.  
  1837. unomsg "$winners \003"
  1838. return
  1839. }
  1840.  
  1841. # last month's top3
  1842. proc UnoLastMonthTop3 {nick uhost hand chan txt} {
  1843. global UnoLastMonthCards UnoLastMonthGames UnoPointsName
  1844. if {![uno_ischan $chan]} {return}
  1845. if {!$txt} {
  1846. if [info exists UnoLastMonthCards] {
  1847. set UnoTop3 ""
  1848. unochanmsg "Last Month's Top 3 $UnoPointsName Winners"
  1849. for { set s 0} { $s < 3 } { incr s} {
  1850. append UnoTop3 "\0030,6 #[expr $s +1] \0030,10 $UnoLastMonthCards($s) "
  1851. }
  1852. unomsg "$UnoTop3"
  1853. }
  1854. } {
  1855. if [info exists UnoLastMonthGames] {
  1856. set UnoTop3 ""
  1857. unochanmsg "Last Month's Top 3 Game Winners"
  1858. for { set s 0} { $s < 3 } { incr s} {
  1859. append UnoTop3 "\0030,6 #[expr $s +1] \0030,10 $UnoLastMonthGames($s) "
  1860. }
  1861. unomsg "$UnoTop3"
  1862. }
  1863. }
  1864. }
  1865.  
  1866. #
  1867. # Scores/Records
  1868. #
  1869.  
  1870. # read score file
  1871. proc UnoReadScores {} {
  1872. global unogameswon unoptswon unoblackjackswon UnoScoreFile UnoRobot
  1873.  
  1874. if [info exists unogameswon] { unset unogameswon }
  1875. if [info exists unoptswon] { unset unoptswon }
  1876. if [info exists unoblackjackswon] { unset unoblackjackswon }
  1877.  
  1878. if ![file exists $UnoScoreFile] {
  1879. set f [open $UnoScoreFile w]
  1880. puts $f "$UnoRobot 0 0 0"
  1881. close $f
  1882. }
  1883.  
  1884. set f [open $UnoScoreFile r]
  1885. while {[gets $f s] != -1} {
  1886. set unogameswon([lindex [split $s] 0]) [lindex $s 1]
  1887. set unoptswon([lindex [split $s] 0]) [lindex $s 2]
  1888. set unoblackjackswon([lindex [split $s] 0]) [lindex $s 3]
  1889. }
  1890. close $f
  1891.  
  1892. return
  1893. }
  1894.  
  1895. # clear top10 and write monthly scores
  1896. proc UnoNewMonth {min hour day month year} {
  1897. global unsortedscores unogameswon unoptswon unoblackjackswon UnoLastMonthCards UnoLastMonthGames UnoScoreFile UnoRobot
  1898. global UnoFast UnoHigh UnoPlayed UnoRecordFast UnoRecordHigh UnoRecordPlayed UnoRecordCard UnoRecordWins
  1899.  
  1900. set lmonth [UnoLastMonthName $month]
  1901.  
  1902. unochanmsg "\00306Clearing monthly scores"
  1903.  
  1904. set UnoMonthFileName "$UnoScoreFile.$lmonth"
  1905.  
  1906. # read current scores
  1907. UnoReadScores
  1908.  
  1909. # write to old month file
  1910. if ![file exists $UnoMonthFileName] {
  1911. set f [open $UnoMonthFileName w]
  1912. foreach n [array names unogameswon] {
  1913. puts $f "$n $unogameswon($n) $unoptswon($n) $unoblackjackswon($n)"
  1914. }
  1915. close $f
  1916. }
  1917.  
  1918. # find top 3 card holders and game winners
  1919. set mode 0
  1920.  
  1921. while {$mode < 2} {
  1922. if [info exists unsortedscores] {unset unsortedscores}
  1923. if [info exists top10] {unset top10}
  1924.  
  1925. set f [open $UnoScoreFile r]
  1926. while {[gets $f s] != -1} {
  1927. switch $mode {
  1928. 0 {set unsortedscores([lindex [split $s] 0]) [lindex $s 1]}
  1929. 1 {set unsortedscores([lindex [split $s] 0]) [lindex $s 2]}
  1930. }
  1931. }
  1932. close $f
  1933.  
  1934. set s 0
  1935. foreach n [lsort -decreasing -command uno_sortscores [array names unsortedscores]] {
  1936. set top10($s) "$n $unsortedscores($n)"
  1937. incr s
  1938. }
  1939.  
  1940. for {set s 0} {$s < 3} {incr s} {
  1941. if {[lindex $top10($s) 1] > 0} {
  1942. switch $mode {
  1943. 0 {set UnoLastMonthGames($s) "[lindex [split $top10($s)] 0] [lindex $top10($s) 1]"}
  1944. 1 {set UnoLastMonthCards($s) "[lindex [split $top10($s)] 0] [lindex $top10($s) 1]"}
  1945. }
  1946. } {
  1947. switch $mode {
  1948. 0 {set UnoLastMonthGames($s) "Nobody 0"}
  1949. 1 {set UnoLastMonthCards($s) "Nobody 0"}
  1950. }
  1951. }
  1952. }
  1953. incr mode
  1954. }
  1955.  
  1956. # update records
  1957. if {[lindex $UnoFast 1] < [lindex $UnoRecordFast 1]} {set UnoRecordFast $UnoFast}
  1958. if {[lindex $UnoHigh 1] > [lindex $UnoRecordHigh 1]} {set UnoRecordHigh $UnoHigh}
  1959. if {[lindex $UnoPlayed 1] > [lindex $UnoRecordPlayed 1]} {set UnoRecordPlayed $UnoPlayed}
  1960. if {[lindex $UnoLastMonthCards(0) 1] > [lindex $UnoRecordCard 1]} {set UnoRecordCard $UnoLastMonthCards(0)}
  1961. if {[lindex $UnoLastMonthGames(0) 1] > [lindex $UnoRecordWins 1]} {set UnoRecordWins $UnoLastMonthGames(0)}
  1962.  
  1963. # wipe last months records
  1964. set UnoFast "$UnoRobot 60"
  1965. set UnoHigh "$UnoRobot 100"
  1966. set UnoPlayed "$UnoRobot 100"
  1967.  
  1968. # save top3 and records to config file
  1969. UnoWriteCFG
  1970.  
  1971. # wipe this months score file
  1972. set f [open $UnoScoreFile w]
  1973. puts $f "$UnoRobot 0 0 0"
  1974. close $f
  1975.  
  1976. unolog "uno" "cleared monthly scores"
  1977. return
  1978. }
  1979.  
  1980. # update score of winning player
  1981. proc UnoUpdateScore {winner cardtotals blackjack} {
  1982. global unogameswon unoptswon unoblackjackswon UnoScoreFile
  1983.  
  1984. UnoReadScores
  1985.  
  1986. if {[info exists unogameswon($winner)]} {
  1987. incr unogameswon($winner) 1
  1988. } {
  1989. set unogameswon($winner) 1
  1990. }
  1991.  
  1992. if {[info exists unoptswon($winner)]} {
  1993. incr unoptswon($winner) $cardtotals
  1994. } {
  1995. set unoptswon($winner) $cardtotals
  1996. }
  1997.  
  1998. if {$blackjack} {
  1999. if {[info exists unoblackjackswon($winner)]} {
  2000. incr unoblackjackswon($winner) 1
  2001. } {
  2002. set unoblackjackswon($winner) 1
  2003. }
  2004. } {
  2005. if {![info exists unoblackjackswon($winner)]} {
  2006. set unoblackjackswon($winner) 0
  2007. }
  2008. }
  2009.  
  2010. set f [open $UnoScoreFile w]
  2011. foreach n [array names unogameswon] {
  2012. puts $f "$n $unogameswon($n) $unoptswon($n) $unoblackjackswon($n)"
  2013. }
  2014. close $f
  2015.  
  2016. return
  2017. }
  2018.  
  2019. # display winner and game statistics
  2020. proc UnoWin {winner} {
  2021. global UnoHand ThisPlayer RoundRobin UnoPointsName CardStats UnoMode UnoCycleTime
  2022. global UnoFast UnoHigh UnoPlayed UnoBonus UnoWinDefault UnoDCCIDX UnoRobot UnoLastWinner UnoWinsInARow
  2023.  
  2024. # get time game finished
  2025. set UnoTime [uno_gametime]
  2026.  
  2027. set cardtotals 0
  2028. set UnoMode 3
  2029. set ThisPlayerIDX 0
  2030. set needCFGWrite 0
  2031. set isblackjack 0
  2032. set cardtake 0
  2033.  
  2034. # colour winner's nick
  2035. set cnick [unonik $winner]
  2036.  
  2037. #unomsg "\00306Card Totals"
  2038.  
  2039. # total up all player's cards
  2040. while {$ThisPlayerIDX != [llength $RoundRobin]} {
  2041. set Card ""
  2042. set ThisPlayer [lindex $RoundRobin $ThisPlayerIDX]
  2043. if [info exist UnoDCCIDX($ThisPlayer)] {unset UnoDCCIDX($ThisPlayer)}
  2044. if {$ThisPlayer != $winner} {
  2045. set ccount 0
  2046. while {[lindex $UnoHand($ThisPlayer) $ccount] != ""} {
  2047. set cardtotal [lindex $UnoHand($ThisPlayer) $ccount]
  2048. set c1 [string range $cardtotal 0 0]
  2049. set c2 [string range $cardtotal 1 1]
  2050. set cardtotal 0
  2051.  
  2052. if {$c1 == "W"} {
  2053. set cardtotal 50
  2054. } {
  2055. switch $c2 {
  2056. "S" {set cardtotal 20}
  2057. "R" {set cardtotal 20}
  2058. "D" {set cardtotal 20}
  2059. default {set cardtotal $c2}
  2060. }
  2061. }
  2062. set cardtotals [expr $cardtotals + $cardtotal]
  2063. incr ccount
  2064. }
  2065. set Card [uno_cardcolorall $ThisPlayer]
  2066. unochanmsg "[unonik $ThisPlayer] \003 $Card"
  2067. #unochanmsg "[unonik $ThisPlayer] \003\[$ccount\] $Card"
  2068. incr cardtake $ccount
  2069. }
  2070. incr ThisPlayerIDX
  2071. }
  2072.  
  2073. set bonus 0
  2074. set bbonus 0
  2075.  
  2076. # bonuses not given for win by default
  2077. if {$UnoWinDefault != 1} {
  2078. set HighScore [lindex $UnoHigh 1]
  2079. set HighPlayed [lindex $UnoPlayed 1]
  2080. set FastRecord [lindex $UnoFast 1]
  2081.  
  2082. # out with 21 adds blackjack bonus
  2083. if {$cardtotals == 21} {
  2084. set bbonus [expr $UnoBonus /2]
  2085. unochanmsg "$cnick\003 goes out on 21! \0034\002$bbonus\002\003 Blackjack Bonus $UnoPointsName"
  2086. incr bonus $bbonus
  2087. set isblackjack 1
  2088. }
  2089.  
  2090. # high score record
  2091. if {$cardtotals > $HighScore} {
  2092. unochanmsg "$cnick\003 broke the \002High Score Record\002 \00304$UnoBonus\003 bonus $UnoPointsName"
  2093. set UnoHigh "$winner $cardtotals"
  2094. incr bonus $UnoBonus
  2095. }
  2096.  
  2097. # played cards record
  2098. if {$CardStats(played) > $HighPlayed} {
  2099. unochanmsg "$cnick\003 broke the \002Most Cards Played Record\002 \00304$UnoBonus\003 bonus $UnoPointsName"
  2100. set UnoPlayed "$winner $CardStats(played)"
  2101. incr bonus $UnoBonus
  2102. }
  2103.  
  2104. # fast game record
  2105. if {($UnoTime < $FastRecord)&&($winner != $UnoRobot)} {
  2106. unochanmsg "$cnick\003 broke the \002Fast Game Record\002 \00304$UnoBonus\003 bonus $UnoPointsName"
  2107. incr bonus $UnoBonus
  2108. set UnoFast "$winner $UnoTime"
  2109. }
  2110. }
  2111.  
  2112. # win streak bonus
  2113. if {$winner == $UnoLastWinner} {
  2114. incr UnoWinsInARow
  2115. set RowMod [expr {$UnoWinsInARow %3}]
  2116. if {!$RowMod} {
  2117. set RowBonus [expr int((pow(2,($UnoWinsInARow/3)-1)*($UnoBonus/4)))]
  2118. unochanmsg "$cnick\003 has won \00314\002$UnoWinsInARow\002\003 in a row and earns \00304\002$RowBonus\002\003 bonus $UnoPointsName"
  2119. incr bonus $RowBonus
  2120. }
  2121. } {
  2122. if {($UnoLastWinner != "")&&($UnoWinsInARow > 1)} {
  2123. unochanmsg "$cnick\003 has put an end to \002$UnoLastWinner\'\s\002 streak of \002$UnoWinsInARow\002 wins"
  2124. }
  2125. set UnoLastWinner $winner
  2126. set UnoWinsInARow 1
  2127. }
  2128.  
  2129. # show winner
  2130. set msg "$cnick\003 wins \00314\002$cardtotals\002\003 $UnoPointsName by taking \00314\002$cardtake\002\003 cards"
  2131.  
  2132. # add bonus
  2133. if {$bonus} {
  2134. incr cardtotals $bonus
  2135. set needCFGWrite 1
  2136. append msg " total:\00303\002$cardtotals\002\003 $UnoPointsName"
  2137. }
  2138.  
  2139. unochanmsg "$msg"
  2140.  
  2141. # show game stats
  2142. unochanmsg "\00314$CardStats(played)\003 cards played in \00314[UnoDuration $UnoTime]\003"
  2143.  
  2144. # write scores
  2145. UnoUpdateScore $winner $cardtotals $isblackjack
  2146.  
  2147. # write records
  2148. if {$needCFGWrite} {UnoWriteCFG}
  2149.  
  2150. return
  2151. }
  2152.  
  2153. # reshuffle deck
  2154. proc UnoShuffle {cardsneeded} {
  2155. global UnoDeck DiscardPile
  2156.  
  2157. # no need in shuffling if more cards remain than needed
  2158. if {[llength $UnoDeck] >= $cardsneeded} { return }
  2159.  
  2160. unochanmsg "\0034\002Re-shuffling deck\002"
  2161.  
  2162. set DeckLeft 0
  2163. while {$DeckLeft < [llength $UnoDeck]} {
  2164. lappend DiscardPile [lindex $UnoDeck $DeckLeft]
  2165. incr DeckLeft
  2166. }
  2167.  
  2168. set UnoDeck ""
  2169. set NewDeckSize [llength $DiscardPile]
  2170.  
  2171. while {[llength $UnoDeck] != $NewDeckSize} {
  2172. set pcardnum [rand [llength $DiscardPile]]
  2173. set pcard [lindex $DiscardPile $pcardnum]
  2174. lappend UnoDeck $pcard
  2175. set DiscardPile [lreplace $DiscardPile $pcardnum $pcardnum]
  2176. }
  2177.  
  2178. return
  2179. }
  2180.  
  2181. # read config file
  2182. proc UnoReadCFG {} {
  2183. global UnoChan UnoCFGFile UnoLastMonthCards UnoLastMonthGames UnoPointsName UnoScoreFile UnoStopAfter UnoBonus
  2184. global UnoFast UnoHigh UnoPlayed UnoRecordHigh UnoRecordFast UnoRecordCard UnoRecordWins UnoRecordPlayed UnoWildDrawTwos UnoAds
  2185.  
  2186. if {[file exist $UnoCFGFile]} {
  2187. set f [open $UnoCFGFile r]
  2188. while {[gets $f s] != -1} {
  2189. set kkey [string tolower [lindex [split $s "="] 0]]
  2190. set kval [lindex [split $s "="] 1]
  2191. switch $kkey {
  2192. channel {set UnoChan $kval}
  2193. points {set UnoPointsName $kval}
  2194. scorefile {set UnoScoreFile $kval}
  2195. stopafter {set UnoStopAfter $kval}
  2196. wilddrawtwos {set UnoWildDrawTwos $kval}
  2197. lastmonthcard1 {set UnoLastMonthCards(0) $kval}
  2198. lastmonthcard2 {set UnoLastMonthCards(1) $kval}
  2199. lastmonthcard3 {set UnoLastMonthCards(2) $kval}
  2200. lastmonthwins1 {set UnoLastMonthGames(0) $kval}
  2201. lastmonthwins2 {set UnoLastMonthGames(1) $kval}
  2202. lastmonthwins3 {set UnoLastMonthGames(2) $kval}
  2203. ads {set UnoAds $kval}
  2204. fast {set UnoFast $kval}
  2205. high {set UnoHigh $kval}
  2206. played {set UnoPlayed $kval}
  2207. bonus {set UnoBonus $kval}
  2208. recordhigh {set UnoRecordHigh $kval}
  2209. recordfast {set UnoRecordFast $kval}
  2210. recordcard {set UnoRecordCard $kval}
  2211. recordwins {set UnoRecordWins $kval}
  2212. recordplayed {set UnoRecordPlayed $kval}
  2213. }
  2214. }
  2215. close $f
  2216. if {$UnoStopAfter < 0} {set UnoStopAfter 0}
  2217. if {$UnoBonus <= 0} {set UnoBonus 100}
  2218. if {($UnoWildDrawTwos < 0)||($UnoWildDrawTwos > 1)} {set UnoWildDrawTwos 0}
  2219. if {($UnoAds < 0)||($UnoAds > 1)} {set UnoAds 1}
  2220. return
  2221. }
  2222. putcmdlog "\[Uno\] config file $UnoCFGFile not found... saving defaults"
  2223. UnoWriteCFG
  2224. return
  2225. }
  2226.  
  2227. # write config file
  2228. proc UnoWriteCFG {} {
  2229. global UnoChan UnoCFGFile UnoLastMonthCards UnoLastMonthGames UnoPointsName UnoScoreFile UnoStopAfter UnoBonus
  2230. global UnoFast UnoHigh UnoPlayed UnoRecordHigh UnoRecordFast UnoRecordCard UnoRecordWins UnoRecordPlayed UnoWildDrawTwos UnoAds
  2231.  
  2232. set f [open $UnoCFGFile w]
  2233.  
  2234. puts $f "# This file is automatically overwritten"
  2235. puts $f "Channel=$UnoChan"
  2236. puts $f "Points=$UnoPointsName"
  2237. puts $f "ScoreFile=$UnoScoreFile"
  2238. puts $f "StopAfter=$UnoStopAfter"
  2239. puts $f "WildDrawTwos=$UnoWildDrawTwos"
  2240. puts $f "Ads=$UnoAds"
  2241. puts $f "LastMonthCard1=$UnoLastMonthCards(0)"
  2242. puts $f "LastMonthCard2=$UnoLastMonthCards(1)"
  2243. puts $f "LastMonthCard3=$UnoLastMonthCards(2)"
  2244. puts $f "LastMonthWins1=$UnoLastMonthGames(0)"
  2245. puts $f "LastMonthWins2=$UnoLastMonthGames(1)"
  2246. puts $f "LastMonthWins3=$UnoLastMonthGames(2)"
  2247. puts $f "Fast=$UnoFast"
  2248. puts $f "High=$UnoHigh"
  2249. puts $f "Played=$UnoPlayed"
  2250. puts $f "Bonus=$UnoBonus"
  2251. puts $f "RecordHigh=$UnoRecordHigh"
  2252. puts $f "RecordFast=$UnoRecordFast"
  2253. puts $f "RecordCard=$UnoRecordCard"
  2254. puts $f "RecordWins=$UnoRecordWins"
  2255. puts $f "RecordPlayed=$UnoRecordPlayed"
  2256.  
  2257. close $f
  2258. return
  2259. }
  2260.  
  2261. # score advertiser
  2262. proc UnoScoreAdvertise {} {
  2263. global UnoChan UnoAdNumber UnoRobot
  2264.  
  2265. switch $UnoAdNumber {
  2266. 0 {UnoTop10 1}
  2267. 1 {UnoLastMonthTop3 $UnoRobot none none $UnoChan 0}
  2268. 2 {UnoTop10 0}
  2269. 3 {UnoRecords $UnoRobot none none $UnoChan ""}
  2270. 4 {UnoTop10 2}
  2271. 5 {UnoPlayed $UnoRobot none none $UnoChan ""}
  2272. 6 {UnoHighScore $UnoRobot none none $UnoChan ""}
  2273. 7 {UnoTopFast $UnoRobot none none $UnoChan ""}
  2274. }
  2275.  
  2276. incr UnoAdNumber
  2277.  
  2278. if {$UnoAdNumber > 7} {set UnoAdNumber 0}
  2279.  
  2280. return
  2281. }
  2282.  
  2283. #
  2284. # misc utility functions
  2285. #
  2286.  
  2287. # sort cards in hand
  2288. proc uno_sorthand {playerhand} {
  2289. set uhand [lsort -dictionary $playerhand]
  2290. return $uhand
  2291. }
  2292.  
  2293. # color all cards in hand
  2294. proc uno_cardcolorall {cplayer} {
  2295. global UnoHand
  2296. set ccard ""
  2297. set ccount 0
  2298. set hcount [llength $UnoHand($cplayer)]
  2299. while {$ccount != $hcount} {
  2300. append ccard [uno_cardcolor [lindex $UnoHand($cplayer) $ccount]]
  2301. incr ccount
  2302. }
  2303. return $ccard
  2304. }
  2305.  
  2306. # color a single card
  2307. proc uno_cardcolor {pcard} {
  2308. global UnoRedCard UnoGreenCard UnoBlueCard UnoYellowCard UnoSkipCard UnoReverseCard UnoDrawTwoCard
  2309. global UnoWildCard UnoWildDrawFourCard
  2310. set c1 [string range $pcard 1 1]
  2311. switch [string range $pcard 0 0] {
  2312. "W" {
  2313. if {$c1 == "D"} {
  2314. set cCard $UnoWildDrawFourCard
  2315. } {
  2316. set cCard $UnoWildCard
  2317. }
  2318. return $cCard
  2319. }
  2320. "R" { set cCard $UnoRedCard }
  2321. "G" { set cCard $UnoGreenCard }
  2322. "B" { set cCard $UnoBlueCard }
  2323. "Y" { set cCard $UnoYellowCard }
  2324. default { set cCard "" }
  2325. }
  2326. switch $c1 {
  2327. "S" { append cCard $UnoSkipCard }
  2328. "R" { append cCard $UnoReverseCard }
  2329. "D" { append cCard $UnoDrawTwoCard }
  2330. default { append cCard "$c1 \003 " }
  2331. }
  2332. return $cCard
  2333. }
  2334.  
  2335. # check if player has uno
  2336. proc uno_checkuno {cplayer} {
  2337. global UnoHand
  2338. if {[llength $UnoHand($cplayer)] > 1} {return}
  2339. set has_uno "\002\00309H\00312a\00313s \00309U\00312n\00313o\00308! \002\003"
  2340. unomsg "\001ACTION says [unonik $cplayer] $has_uno\001"
  2341. return
  2342. }
  2343.  
  2344. # show player what cards they have
  2345. proc uno_showcards {cplayer cplayeridx} {
  2346. global UnoIDX
  2347. if {[uno_isrobot $cplayeridx]} {return}
  2348. unontc [lindex $UnoIDX $cplayeridx] "[uno_cardcolorall $cplayer]"
  2349. }
  2350.  
  2351. # check if this is the robot player
  2352. proc uno_isrobot {cplayeridx} {
  2353. global RoundRobin UnoRobot UnoMaxNickLen
  2354. if {[string range [lindex $RoundRobin $cplayeridx] 0 $UnoMaxNickLen] != $UnoRobot} {return 0}
  2355. return 1
  2356. }
  2357.  
  2358. # check if timer exists
  2359. proc uno_timerexists {cmd} {
  2360. foreach i [timers] {
  2361. if {![string compare $cmd [lindex $i 1]]} then {
  2362. return [lindex $i 2]
  2363. }
  2364. }
  2365. return
  2366. }
  2367.  
  2368. # sort scores
  2369. proc uno_sortscores {s1 s2} {
  2370. global unsortedscores
  2371. if {$unsortedscores($s1) < $unsortedscores($s2)} {return -1}
  2372. if {$unsortedscores($s1) == $unsortedscores($s2)} {return 0}
  2373. if {$unsortedscores($s1) > $unsortedscores($s2)} {return 1}
  2374. }
  2375.  
  2376. # calculate game running time
  2377. proc uno_gametime {} {
  2378. global UnoStartTime
  2379. set UnoCurrentTime [unixtime]
  2380. set gt [expr ($UnoCurrentTime - $UnoStartTime)]
  2381. return $gt
  2382. }
  2383.  
  2384. # colorize nickname
  2385. proc unonik {nick} {
  2386. global UnoNickColor
  2387. return "\003$UnoNickColor($nick)$nick"
  2388. }
  2389. proc unocolornick {pnum} {
  2390. global UnoNickColors
  2391. set c [lindex $UnoNickColors [expr $pnum-1]]
  2392. set nik [format "%02d" $c]
  2393. return $nik
  2394. }
  2395.  
  2396. # ratio of two numbers
  2397. proc unoget_ratio {num den} {
  2398. set n 0.0
  2399. set d 0.0
  2400. set n [expr $n +$num]
  2401. set d [expr $d +$den]
  2402. if {!$d} {return 0}
  2403. set ratio [expr (($n /$d) *100.0)]
  2404. return $ratio
  2405. }
  2406.  
  2407. # name of last month
  2408. proc UnoLastMonthName {month} {
  2409. switch $month {
  2410. 00 {return "Dec"}
  2411. 01 {return "Jan"}
  2412. 02 {return "Feb"}
  2413. 03 {return "Mar"}
  2414. 04 {return "Apr"}
  2415. 05 {return "May"}
  2416. 06 {return "Jun"}
  2417. 07 {return "Jul"}
  2418. 08 {return "Aug"}
  2419. 09 {return "Sep"}
  2420. 10 {return "Oct"}
  2421. 11 {return "Nov"}
  2422. default {return "???"}
  2423. }
  2424. }
  2425.  
  2426. # pad a string with spaces
  2427. proc unostrpad {str len} {
  2428. set slen [string length $str]
  2429. if {$slen > $len} {return $str}
  2430. while {$slen < $len} {
  2431. append str " "
  2432. incr slen
  2433. }
  2434. return $str
  2435. }
  2436.  
  2437. # time interval in min and sec
  2438. proc UnoDuration {sec} {
  2439. set s ""
  2440. if {$sec >= 3600} {
  2441. set tmp [expr $sec / 3600]
  2442. set s [format "%s\002%d\002h:" $s $tmp]
  2443. set sec [expr $sec - ($tmp*3600)]
  2444. }
  2445. if {$sec >= 60} {
  2446. set tmp [expr $sec / 60]
  2447. set s [format "%s\002%d\002m:" $s $tmp]
  2448. set sec [expr $sec - ($tmp*60)]
  2449. }
  2450. if {$sec > 0} {
  2451. set tmp $sec
  2452. set s [format "%s\002%d\002s" $s $tmp]
  2453. }
  2454. return $s
  2455. }
  2456.  
  2457. #
  2458. # game messages
  2459. #
  2460.  
  2461. # played card
  2462. proc uno_showplaycard {who crd nplayer} {
  2463. unomsg "[unonik $who]\003 plays $crd \003to [unonik $nplayer]"
  2464. }
  2465.  
  2466. # played draw card
  2467. proc uno_showplaydraw {who crd dplayer nplayer} {
  2468. unomsg "[unonik $who]\003 plays $crd [unonik $dplayer]\003 draws \002two cards\002 and skips to [unonik $nplayer]"
  2469. }
  2470.  
  2471. # played wild card
  2472. proc uno_showplaywild {who chooser} {
  2473. global UnoWildCard
  2474. unomsg "[unonik $who]\003 plays $UnoWildCard choose a color [unonik $chooser]"
  2475. }
  2476.  
  2477. # played wild draw four
  2478. proc uno_showplaywildfour {who skipper chooser} {
  2479. global UnoWildDrawFourCard
  2480. unomsg "[unonik $who]\003 plays $UnoWildDrawFourCard [unonik $skipper]\003 draws \002four cards\002 and is skipped... Choose a color [unonik $chooser]"
  2481. }
  2482.  
  2483. # played skip card
  2484. proc uno_showplayskip {who crd skipper nplayer} {
  2485. unomsg "[unonik $who]\003 plays $crd\003 and skips [unonik $skipper]\003 to [unonik $nplayer]"
  2486. }
  2487.  
  2488. # who drew a card
  2489. proc uno_showwhodrew {who} {
  2490. unomsg "[unonik $who]\003 \002drew\002 a card"
  2491. }
  2492.  
  2493. # player passes a turn
  2494. proc uno_showplaypass {who nplayer} {
  2495. unomsg "[unonik $who]\003 \002passes\002 to [unonik $nplayer]"
  2496. }
  2497.  
  2498. # bot plays wild card
  2499. proc uno_showbotplaywild {who chooser ncolr nplayer} {
  2500. global UnoWildCard
  2501. unomsg "[unonik $who]\003 plays $UnoWildCard and chooses $ncolr \003 Current player [unonik $nplayer]"
  2502. }
  2503.  
  2504. # bot plays wild draw four
  2505. proc uno_showbotplaywildfour {who skipper chooser choice nplayer} {
  2506. global UnoWildDrawFourCard
  2507. unomsg "[unonik $who]\003 plays $UnoWildDrawFourCard [unonik $skipper]\003 draws \002four cards\002 and is skipped. [unonik $chooser]\003 chooses $choice\003 Current player [unonik $nplayer]"
  2508. }
  2509.  
  2510. # show a player what they drew
  2511. proc uno_showdraw {idx crd} {
  2512. global UnoIDX
  2513. if {[uno_isrobot $idx]} {return}
  2514. unontc [lindex $UnoIDX $idx] "Draw $crd"
  2515. }
  2516.  
  2517. # show win
  2518. proc uno_showwin {who crd} {
  2519. global UnoLogo
  2520. unomsg "[unonik $who]\003 plays $crd and \002\00309W\00312i\00313n\00308s\002 $UnoLogo"
  2521. }
  2522.  
  2523. # show win by default
  2524. proc uno_showwindefault {who} {
  2525. global UnoWinDefault UnoLogo
  2526. unomsg "[unonik $who] \002\00309W\00312i\00313n\00308s $UnoLogo \002by default"
  2527. set UnoWinDefault 1
  2528. }
  2529.  
  2530.  
  2531. #
  2532. # Channel and DCC output
  2533. #
  2534.  
  2535. proc unomsg {what} {
  2536. global UnoChan
  2537. putquick "PRIVMSG $UnoChan :$what"
  2538. }
  2539.  
  2540. proc unochanmsg {what} {
  2541. global UnoChan UnoLogo
  2542. putquick "PRIVMSG $UnoChan :$UnoLogo $what"
  2543. }
  2544.  
  2545. proc unogntc {who what} {
  2546. global UnoNTC
  2547. putquick "$UnoNTC $who :$what"
  2548. }
  2549.  
  2550. proc unontc {who what} {
  2551. global UnoNTC UnoDCCIDX
  2552. if {$UnoDCCIDX($who) != -1} {
  2553. putdcc $UnoDCCIDX($who) $what
  2554. } {
  2555. putquick "$UnoNTC $who :$what"
  2556. }
  2557. }
  2558.  
  2559. proc unolog {who what} {
  2560. putcmdlog "\[$who\] $what"
  2561. }
  2562.  
  2563. #
  2564. # DCC routines
  2565. #
  2566.  
  2567. proc unologin:dcc {hand idx} {
  2568. global UnoChan UnoOn UnoDCCIDX RoundRobin
  2569.  
  2570. if ![handonchan $hand $UnoChan] {return 0}
  2571.  
  2572. set tnick [hand2nick $hand $UnoChan]
  2573. if {($tnick == "")||($tnick == "*")} {return 0}
  2574. if ![info exist UnoDCCIDX($tnick)] {return 0}
  2575.  
  2576. set pcount 0
  2577. while {[lindex $RoundRobin $pcount] != ""} {
  2578. set pnick [lindex $RoundRobin $pcount]
  2579. if {$pnick == $tnick} {
  2580. if {[info exist UnoDCCIDX($pnick)]} {
  2581. set UnoDCCIDX($pnick) $idx
  2582. unolog "Uno" "$pnick on new dcc socket $idx"
  2583. break
  2584. }
  2585. }
  2586. incr pcount
  2587. }
  2588. return 0
  2589. }
  2590.  
  2591. proc unologout:dcc {hand idx} {
  2592. global UnoChan UnoDCCIDX party-chan party-just-quit
  2593. if {[info exists party-just-quit] && ${party-just-quit} == $hand} {unset party-just-quit ; return 0}
  2594. if ![handonchan $hand $UnoChan] {return 0}
  2595. set tnick [hand2nick $hand $UnoChan]
  2596. if {($tnick == "")||($tnick == "*")} {return 0}
  2597. if {[info exist UnoDCCIDX($tnick)]} {
  2598. unolog "Uno" "$tnick left dcc \(resuming channel message mode\)"
  2599. set UnoDCCIDX($tnick) -1
  2600. }
  2601. }
  2602.  
  2603. proc unologout:filt {idx text} {
  2604. global UnoChan UnoDCCIDX party-chan party-just-quit
  2605. set hand [idx2hand $idx]
  2606. set party-just-quit $hand
  2607. set tnick [hand2nick $hand]
  2608. if {($tnick == "")||($tnick == "*")} {return $text}
  2609. if {[info exist UnoDCCIDX($tnick)]} {
  2610. unolog "Uno" "$tnick left dcc \(resuming channel message mode\)"
  2611. set UnoDCCIDX($tnick) -1
  2612. }
  2613. return $text
  2614. }
  2615.  
  2616. # Show all players cards
  2617. proc dccunohands {hand idx txt} {
  2618. global UnoHand RoundRobin
  2619. set n 0
  2620. while {$n != [llength $RoundRobin]} {
  2621. set un [lindex $RoundRobin $n]
  2622. unolog $un [uno_sorthand $UnoHand($un)]
  2623. incr n
  2624. }
  2625. }
  2626.  
  2627. # Write configuration
  2628. proc dcc_unowriteconfig {hand idx txt} {
  2629. unolog "$hand" "writing current uno config"
  2630. UnoWriteCFG
  2631. return
  2632. }
  2633.  
  2634. # Rehash configuration
  2635. proc dcc_unorehash {hand idx txt} {
  2636. unolog "$hand" "rehashing uno config"
  2637. UnoReadCFG
  2638. return
  2639. }
  2640.  
  2641. # set points name
  2642. proc dcc_unopoints {hand idx txt} {
  2643. global UnoPointsName
  2644. set pn [string trim $txt]
  2645. if {[string length $pn] > 2} {
  2646. set UnoPointsName $pn
  2647. unolog "$hand" "uno points set to: $UnoPointsName"
  2648. }
  2649. return
  2650. }
  2651.  
  2652. UnoReadCFG
  2653.  
  2654. UnoReadScores
  2655.  
  2656. putlog "Loaded Color Uno $UnoVersion (C) 2006 Marky"
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement