Advertisement
Seb

uno.tcl (Topic updates)

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