diff --git a/DAG-Tournament.cabal b/DAG-Tournament.cabal new file mode 100644 --- /dev/null +++ b/DAG-Tournament.cabal @@ -0,0 +1,49 @@ +name: DAG-Tournament +version: 0.1 +license: GPL +license-file: LICENSE +category: Game +cabal-version: >= 1.6 +build-type: Simple +author: Joachim Breitner +maintainer: Joachim Breitner +copyright: Joachim Breitner 2009 +synopsis: Real-Time Game Tournament Evaluator +description: + DAG-Tournament, where DAG stands for directed acyclic graph, is a graphical + program to manage an informal tournament of games such as foosball. It is + designed for open-for-all tournaments without schedule, for example to + record all games as they happen in the free time program of a serious + event, such as a conference. + . + Games can be entered as they happen. The program does not generate a + complete ranking, but only visualizes what it knows about who is better + than who based on direct comparison, or a path of direct comparisons. + Cycles are broken at the edge of least significance. The visualisation is + baesd on springs and forces and updated in real time, already producing + entertaining effects. + . + DAG-Tournaments supports more than one tournament at the same time, e.g. + foosball and pool billard, and can switch between the two rankings with one + keypress, again showing an entaining shuffling of nodes until a stable + state is reached again. +-- homepage: http://www.joachim-breitner.de/projects#DAG-Tournament + + +extra-source-files: + README + +executable DAG-Tournament + main-is: main.hs + hs-source-dirs: src + build-depends: + base == 4.*, filepath, directory, mtl, time, containers, + gtk, cairo + other-modules: + Data + Graph + Physics + +source-repository head + type: darcs + location: http://darcs.nomeata.de/DAG-Tournament diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,101 @@ +DAG-Tournament +============== + +Introduction +------------ + +DAG-Tournament, where DAG stands for directed acyclic graph, is a graphical +program to manage an informal tournament of games such as foosball. It is +designed for open-for-all tournaments without schedule, for example to +record all games as they happen in the free time program of a serious +event, such as a conference. + +Games can be entered as they happen. The program does not generate a +complete ranking, but only visualizes what it knows about who is better +than who based on direct comparison, or a path of direct comparisons. +Cycles are broken at the edge of least significance. The visualisation is +baesd on springs and forces and updated in real time, already producing +entertaining effects. + +DAG-Tournaments supports more than one tournament at the same time, e.g. +foosball and pool billard, and can switch between the two rankings with one +keypress, again showing an entaining shuffling of nodes until a stable +state is reached again. + +Using +----- + +DAG-Tournament has no configuration file and takes no command line optins. +Only if you want to handle more than one game at a time, you need to pass +the names of the games as command line parameters. +$ DAG-Tournament +or +$ DAG-Tournament Foosball Billard + +At first, the screen will be blank, because no players or games have been +added. You can now interact with the game in these ways: + +Double click + Add a new player. You will be asked for the name of the player. + +Drag’n’drop one player onto another + Add a new game result. You will be asked for the final score. If + your game does not have scores, just enter 1:0. + +Tab + Switch between games, if you have more than one. + +Hold shift + Show the number of games per player. Useful to decide who ought to + play next. + +These are sufficient to use the program. Additionally, there is +functionality meant to be used by the tournament organizer: + +Ctrl-R + Re-set the position of the players. If the nodes are in a + somehow stuck and you expect that they are not yet in their optimal + position, this puts them all into a straigt line, possibly allowing + them to find a better possition on the screen. + +Ctrl-E + Edit the game state. This opens a text edit window with the list of + players and games as a raw Haskell value. Here you can edit + mistakes. If the result does not parse, it will be discarded, so + edit with care! + + After each change to the game state (adding a new player, adding a + game result, or using Ctrl-E), it is written to + ~/.DAG-Tournamet.backup. If you need to resume the program, e.g. + after an accidential close or a crash, you can paste the contents + of that file to the edit window provided by Ctrl-E + + +Explanation of the screen contents +---------------------------------- + +Player names are sometimes coloured. These colours mean: + +Red + Currently hovered by the mouse. All games with this players are + shown on the left. +Blue + Start of a drag action. Let go of the mouse above another player to + enter a game. +Yellow + A player that has already played at least against once against the + player marked in red. Useful to find out who he has not yet played + against. + +The back arrows, usually pointing down, indicate that at the current +standings, the upper player is better than the lower, either by direct +comparision or a series of comparisions with intermediate players. Only a +minimal amount of arrows are shown. So if there is an arrow from A to B and +from B to C, there will not be an arrow from A to C, independently of +whether A and C have played each other. + +Credits +------- + +DAG-Tournamet is © 2009 Joachim Breitner and published under the terms of +the GNU General Public License, Version 2 or later. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +module Main where +import Distribution.Simple +main = defaultMain diff --git a/src/Data.hs b/src/Data.hs new file mode 100644 --- /dev/null +++ b/src/Data.hs @@ -0,0 +1,32 @@ +module Data where + +import Data.Complex +import Data.Time + +type Player = String +type Edge = (Player, Player) +type Result = (Integer, Integer) +type Game = (Edge, Result) +type GameSum = (Edge, (Integer,Integer,Integer)) +type GameName = String + +data GameState = GameState + { gsPlayer :: [Player] + , gsGames :: [(GameName,[Game])] + } + deriving (Show, Read) + +-- | Coordinate system in use: (0,0) lower left, (1,0) lower right corner +type Coord = Complex Double + +data UIState = UIState + { uisPositions :: [(Player, Coord)] + , uisCurrentGame :: GameName + , uisBBoxes :: [(Player, (Double, Double, Double, Double))] + , uisMousePos :: (Double, Double) + , uisHover :: Maybe Player + , uisDragStart :: Maybe Player + , uisShowGameCount :: Bool + , uisLastFrameTime :: UTCTime + } + deriving (Show) diff --git a/src/Graph.hs b/src/Graph.hs new file mode 100644 --- /dev/null +++ b/src/Graph.hs @@ -0,0 +1,57 @@ +module Graph where + +import Data + +import qualified Data.Map as M +import Control.Arrow (second, (***)) +import Data.Maybe +import Data.Ord +import Data.List +import Debug.Trace + + +transHull :: [GameSum] -> [Edge] +transHull = foldr insert [] . map fst . sortBy (comparing snd) + where insert (p1,p2) graph + | reachable graph p2 p1 = graph -- Do not build cycles + | reachable graph p1 p2 = graph -- No useful edge + | otherwise = (p1,p2) : removeObs (p1,p2) graph + +-- | Removes any edge pointing towards p2 that can also reach p1 +removeObs (p1,p2) graph = filter go graph + where go (p1', p2') = not $ p2' == p2 && reachable graph p1' p1 + || p1' == p1 && reachable graph p2 p2' + + +-- | Tests whether a player is reachable. Stupid algorithm, breaks when there +-- are cycles +reachable :: [Edge] -> Player -> Player -> Bool +reachable g p1 p2 = go p1 + where go p = any (\(_,p') -> p2 == p' || go p') $ filter ((==) p . fst) g + +sumGames :: [Game] -> [GameSum] +sumGames = mapMaybe flipRight . M.toList . M.map sumUp . + M.fromListWith (\(a,b) (a',b') -> (a ++ a', b `max` b')) . + zipWith (\n (a,b) -> (a,([b],n))) [1,2..] . + map sortName + where sumUp :: ([Result],Integer) -> (Integer, Integer, Integer) + sumUp (ress,o) = ( sum (map gameCount ress) + , sum (map (uncurry (-)) ress) + , o + ) + flipRight ((p1,p2),c@(c1,c2,c3)) = + if c1 == 0 && c2 == 0 + then Nothing + else if c >= (0,0,0) + then Just ((p1,p2),c) + else Just ((p2,p1),(-c1,-c2,c3)) + + sortName x@((p1,p2),(c1,c2)) | p1 <= p2 = x + | otherwise = ((p2,p1),(c2,c1)) + +gameCount (a,b) | a > b = 1 + | a < b = -1 + | otherwise = 0 + +countGames :: [Game] -> [(Player, Integer)] +countGames = M.toList . M.fromListWith (+) . concat . map (\((p1,p2),_) -> [(p1,1),(p2,1)]) diff --git a/src/Physics.hs b/src/Physics.hs new file mode 100644 --- /dev/null +++ b/src/Physics.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE PatternGuards #-} + +module Physics where + +import Data + +import Data.Complex +import Debug.Trace + +-- Constants +gravityForce = 1/2 +borderForce = 100 +forceStrength = 1/10 +repellStrength = 1 +repellDist = 0.1 +attractStrength = 10 +angleShiftForce = 2 + +edgePadding = 10/100 +botPadding = 2/100 + +-- Physics functions + +gravity = 0 :+ negate gravityForce + +repell (player1, c1) (player2, c2) = + if player1 == player2 + then 0 + else let d = c2 - c1 + m = magnitude d + in - signum d * repellStrength * ((repellDist / m)^2 :+ 0) + +attract (player, c) pos (player1, player2) + | player1 == player2 = 0 --safeguard + | player /= player1 && player /= player2 = 0 + | Nothing <- lookup player1 pos = 0 + | Nothing <- lookup player2 pos = 0 + | d == 0 = 0 + | otherwise = distForce + angleForce + + where winner = player == player1 + other = if winner then player2 else player1 + Just c2 = lookup other pos + d = c2 - c + distForce = d * attractStrength + ddiff = normAngle $ phase d - if winner then -pi/2 else pi/2 + angleForce = cis (signum ddiff * pi/2) * signum d * (ddiff^2 :+ 0) * angleShiftForce + + +bound (x :+ y) = boundBottom . boundLeft . boundRight + where boundBottom = if y < botPadding then clampPhase (pi/2) else id + boundLeft = if x < edgePadding then clampPhase 0 else id + boundRight = if x > 1- edgePadding then clampPhase pi else id + +applyForces elapsedTime gameState spanningTree uis = uis { uisPositions = map go (uisPositions uis) } + where go p@(player, coord) = let totalForce = sum $ + [ gravity + ] ++ + map (repell p) (uisPositions uis) ++ + map (attract p (uisPositions uis)) spanningTree + in (player, + coord + bound coord totalForce * forceStrength * elapsedTime) + +atLeast x = max x +atMost x = min x + +normAngle x | x <= -pi = normAngle $ x + 2*pi + | x > pi = normAngle $ x - 2*pi + | otherwise = x + +clampPhase p d = cis p * go (cis (-p) * d) + where go (x :+ y) = atLeast 0 x :+ y diff --git a/src/main.hs b/src/main.hs new file mode 100644 --- /dev/null +++ b/src/main.hs @@ -0,0 +1,398 @@ +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import Data +import Graph +import Physics + +import Graphics.UI.Gtk +import Graphics.Rendering.Cairo +import Graphics.UI.Gtk.Gdk.Events +import Data.Time +import Data.IORef +import Data.Complex +import Control.Monad +import Control.Applicative +import Text.Printf +import Data.List +import System.Environment +import Data.Maybe +import System.Directory +import System.FilePath + +fontSize = 1/50 + +removePlayers (GameState players _) uis = uis { uisPositions = filter (\(p,_) -> p `elem` players) (uisPositions uis) } + +addNewPlayers (GameState players _) uis = foldr go uis players + where go player uis | player `elem` map fst (uisPositions uis) = uis + | otherwise = let x = fromIntegral ((4 + length (uisPositions uis)) `mod` 10) + in uis { uisPositions = (player,((x*0.1 + 0.05) :+ 0.3)) : + uisPositions uis } + +setHover uiState = uiState { uisHover = msum $ map check (uisBBoxes uiState) } + where (mx, my) = uisMousePos uiState + check (player, (x,y,w,h)) = + if x <= mx && mx <= x + w && + y <= my && my <= y + h + then Just player else Nothing + +updateUIState elapsedTime gameState spanningTree = + applyForces elapsedTime gameState spanningTree . + removePlayers gameState . + addNewPlayers gameState . + setHover + +playedWith curGame gameState p1 p2 = let Just games = lookup curGame (gsGames gameState) + pairings = map fst games + in (p1,p2) `elem` pairings || (p2,p1) `elem` pairings + +tick :: IORef GameState -> IORef UIState -> DrawingArea -> IO () +tick gameStateRef uiStateRef canvas = do + -- Simulations logic here + gameState <- readIORef gameStateRef + uiState <- readIORef uiStateRef + + now <- getCurrentTime + backThen <- uisLastFrameTime <$> readIORef uiStateRef + modifyIORef uiStateRef (\uis -> uis { uisLastFrameTime = now }) + + let elapsedTime = realToFrac (now `diffUTCTime` backThen) + + let spanningTree = transHull $ sumGames (getGames (uisCurrentGame uiState) gameState) + + modifyIORef uiStateRef (updateUIState elapsedTime gameState spanningTree) + + +redraw :: IORef GameState -> IORef UIState -> DrawingArea -> IO () +redraw gameStateRef uiStateRef canvas = do + gameState <- readIORef gameStateRef + uiState@(UIState {..}) <- readIORef uiStateRef + + let spanningTree = transHull $ sumGames (getGames uisCurrentGame gameState) + + -- Graphics here + render canvas $ do + + -- Background + preserve $ setSourceRGB 1 1 1 >> paint + + -- Setup + setLineWidth (1/1000) + setFontSize fontSize + let padding = (2/1000) + + let important = msum [uisDragStart, uisHover] + + let gameCounts = countGames (getGames uisCurrentGame gameState) + + -- Calculate bounding boxes for player while drawing them + bb <- forM uisPositions $ \(player, x :+ y) -> preserve $ do + let text1 = player + let text2 = printf " (%d)" (fromMaybe 0 (lookup player gameCounts)) + let text = if uisShowGameCount + then text1 ++ text2 + else text1 + TextExtents xb1 yb1 w1 h1 _ _ <- textExtents text1 + TextExtents xb yb w h _ _ <- textExtents text + scale 1 (-1) + translate x (-y) + let (ux, uy, uw, uh) = + ( -w1/2 + xb1 - padding + , h1/2 + yb1 - padding + , w + 2*padding + , h + 2*padding + ) + roundedRect ux uy uw uh + + if Just player == uisDragStart + then setSourceRGB 0 0 1 >> fillPreserve >> setSourceRGB 0 0 0 + else if Just player == uisHover + then setSourceRGB 1 0 0 >> fillPreserve >> setSourceRGB 0 0 0 + else when (maybe False (playedWith uisCurrentGame gameState player) important) $ + setSourceRGB 1 1 0 >> fillPreserve >> setSourceRGB 0 0 0 + stroke + + moveTo (-w1/2) (h1/2) + showText text1 + when uisShowGameCount $ do + setSourceRGB 0.5 0.5 0.5 + showText text2 + + (dx,dy) <- userToDevice ux uy + (dw,dh) <- userToDeviceDistance uw uh + return (player, (dx,dy,dw,dh)) + + forM_ spanningTree $ \(p1,p2) -> preserve $ do + setLineWidth (4/1000) + setLineCap LineCapRound + let Just v1@(x1 :+ y1) = lookup p1 uisPositions + let Just v2@(x2 :+ y2) = lookup p2 uisPositions + let d = signum (v2 - v1) + + let rv1@(rx1 :+ ry1) = v1 + 2/100 * d + let rv2@(rx2 :+ ry2) = v2 - 2/100 * d + + let (tlx :+ tly) = rv2 + 1/100 * cis (3/4*pi) * d + let (trx :+ try) = rv2 + 1/100 * cis (-3/4*pi) * d + + moveTo rx1 ry1 + lineTo rx2 ry2 + moveTo rx2 ry2 + lineTo tlx tly + moveTo rx2 ry2 + lineTo trx try + stroke + + case uisHover of + Just player -> showStats uiState gameState player + Nothing -> return () + + -- Only show game name if there is more than one + case gsGames gameState of + [] -> return () + [_] -> return () + _ -> showGames uiState gameState + + liftIO $ modifyIORef uiStateRef (\uis -> uis { uisBBoxes = bb }) + +showStats uiState gameState player = do + let texts = map (\((p1,p2),(s1,s2)) -> printf "%s vs. %s: %d:%d" p1 p2 s1 s2) $ + filter (\((p1,p2),_) -> p1 == player || p2 == player) $ + getGames (uisCurrentGame uiState) gameState + + unless (null texts) $ preserve $ do + scale 1 (-1) + translate 0 (-2*fontSize) + + forM_ texts $ \text -> do + setSourceRGB 0 0 0 + moveTo 0 0 + showText text + translate 0 (-fontSize) + +showGames uiState gameState = preserve $ do + newPath + let text = uisCurrentGame uiState + scale 1 (-1) + TextExtents xb yb w h _ _ <- textExtents text + translate (1-w-xb- 1/2*fontSize) (-1/2*fontSize) + showText text + + +gameDialog :: Window -> Player -> Player -> IO (Maybe Game) +gameDialog window player1 player2 = do + dlg <- messageDialogNew (Just window) [] MessageQuestion ButtonsOk "Please enter the game scores!" + upper <- dialogGetUpper dlg + + hbox <- hBoxNew False 10 + l1 <- labelNew (Just player1) + l2 <- labelNew (Just "vs.") + l3 <- labelNew (Just player2) + e1 <- entryNew + e2 <- entryNew + set e1 [ entryAlignment := 1, entryWidthChars := 3, entryText := "1", entryActivatesDefault := True ] + set e2 [ entryAlignment := 0, entryWidthChars := 3, entryText := "0", entryActivatesDefault := True ] + boxPackStartDefaults hbox l1 + boxPackStartDefaults hbox e1 + boxPackStartDefaults hbox l2 + boxPackStartDefaults hbox e2 + boxPackStartDefaults hbox l3 + + boxPackStartDefaults upper hbox + + dialogSetDefaultResponse dlg ResponseOk + widgetShowAll dlg + responseId <- dialogRun dlg + + ret <- if responseId == ResponseOk then do + t1 <- get e1 entryText + t2 <- get e2 entryText + case (maybeRead t1, maybeRead t2) of + (Just s1, Just s2) -> return (Just ((player1,player2),(s1,s2))) + _ -> return Nothing + else return Nothing + + widgetDestroy dlg + + return ret + +addNewPlayer :: Window -> IORef GameState -> IO () +addNewPlayer window gameStateRef = do + gameState <- readIORef gameStateRef + dlg <- messageDialogNew (Just window) [] MessageQuestion ButtonsOk "Please enter the name of the player!" + upper <- dialogGetUpper dlg + + let defaultText = "Player " ++ [head (drop (length (gsPlayer gameState)) (cycle $ ['X','Y','Z'] ++ ['A'..'W']))] + + hbox <- hBoxNew False 10 + e1 <- entryNew + set e1 [ entryAlignment := 0, entryWidthChars := 10, entryText := defaultText, entryActivatesDefault := True ] + boxPackStartDefaults hbox e1 + + boxPackStartDefaults upper hbox + + dialogSetDefaultResponse dlg ResponseOk + widgetShowAll dlg + + responseId <- dialogRun dlg + + when (responseId == ResponseOk) $ do + name <- get e1 entryText + modifyIORef gameStateRef (\gs -> gs { gsPlayer = nub $ name : gsPlayer gs }) + saveGameState gameStateRef + + widgetDestroy dlg + +editGameState :: Window -> IORef GameState -> IO () +editGameState window gameStateRef = do + dlg <- messageDialogNew (Just window) [] MessageQuestion ButtonsOk "Edit the game state." + upper <- dialogGetUpper dlg + + tv <- textViewNew + tb <- textViewGetBuffer tv + set tv [ textViewWrapMode := WrapWord ] + + readIORef gameStateRef >>= textBufferInsertAtCursor tb . show + + boxPackStartDefaults upper tv + + dialogSetDefaultResponse dlg ResponseOk + widgetShowAll dlg + + responseId <- dialogRun dlg + + when (responseId == ResponseOk) $ do + text <- get tb textBufferText + case maybeRead text of + Just gs -> writeIORef gameStateRef gs >> saveGameState gameStateRef + Nothing -> return () + + widgetDestroy dlg + +saveGameState :: IORef GameState -> IO () +saveGameState gameStateRef = do + home <- getHomeDirectory + readIORef gameStateRef >>= writeFile (home ".DAG-Tournamet.backup") . show + +main = do + games <- (\a -> if null a then ["XXX"] else a) <$> getArgs + now <- getCurrentTime + gameStateRef <- newIORef $ GameState [] (map (\gn -> (gn,[])) games) + uiStateRef <- newIORef $ UIState [] (head games) [] (0,0) Nothing Nothing False now + + initGUI + window <- windowNew + canvas <- drawingAreaNew + onDestroy window mainQuit + + onExpose canvas $ const $ do + tick gameStateRef uiStateRef canvas + redraw gameStateRef uiStateRef canvas + return True + + onMotionNotify canvas False $ \e -> do + modifyIORef uiStateRef (\uis -> uis { uisMousePos = (eventX e, eventY e) }) + return True + + onButtonPress canvas $ \e -> do + when (eventButton e == LeftButton && eventClick e == SingleClick) $ + modifyIORef uiStateRef $ \uis -> uis { uisDragStart = uisHover uis } + + when (eventButton e == LeftButton && eventClick e == DoubleClick) $ + addNewPlayer window gameStateRef + + return True + + onButtonRelease canvas $ \e -> do + uiState <- readIORef uiStateRef + case (uisDragStart uiState, uisHover uiState) of + (Just p1, Just p2) | p1 /= p2 -> do + ret <- gameDialog window p1 p2 + case ret of + Just game -> do + modifyIORef gameStateRef $ \gs -> + gs { gsGames = map (\(gn,gs) -> + (gn, if gn == uisCurrentGame uiState then game : gs else gs) + ) (gsGames gs) } + saveGameState gameStateRef + Nothing -> return () + _ -> return () + modifyIORef uiStateRef $ \uis -> uis { uisDragStart = Nothing } + return True + + return False + + onKeyPress window $ \e -> do + when (eventModifier e == [Control] && eventKeyChar e == Just 'e') $ + editGameState window gameStateRef + when (eventModifier e == [Control] && eventKeyChar e == Just 'r') $ + modifyIORef uiStateRef (\uis -> uis { uisPositions = [] }) + when (eventKeyName e == "Tab") $ + modifyIORef uiStateRef (\uis -> uis { + uisCurrentGame = followingElement (uisCurrentGame uis) games + }) + when (eventKeyName e `elem` ["Shift_L","Shift_R"]) $ + modifyIORef uiStateRef (\uis -> uis { + uisShowGameCount = True }) + widgetQueueDraw canvas + return False + + onKeyRelease window $ \e -> do + when (eventKeyName e `elem` ["Shift_L","Shift_R"]) $ + modifyIORef uiStateRef (\uis -> uis { + uisShowGameCount = False }) + widgetQueueDraw canvas + return False + + flip timeoutAdd 30 $ do + widgetQueueDraw canvas + return True + + set window [containerChild := canvas] + windowFullscreen window + widgetShowAll window + mainGUI + + +render canvas r = do + win <- widgetGetDrawWindow canvas + (w, h) <- widgetGetSize canvas + let s = fromIntegral w + renderWithDrawable win $ do + selectFontFace "DejaVu Sans" FontSlantNormal FontWeightNormal + translate 0 (fromIntegral h) + scale s (-s) + r + +roundedRect x y w h = do + moveTo x (y+pad) + lineTo x (y + h - pad) + arcNegative (x + pad) (y + h - pad) pad pi (pi/2) + lineTo (x + w - pad) (y + h) + arcNegative (x + w - pad) (y + h - pad) pad (pi/2) 0 + lineTo (x + w) (y + pad) + arcNegative (x + w - pad) (y + pad) pad 0 (-pi/2) + lineTo (x + pad) y + arcNegative (x + pad) (y + pad) pad (-pi/2) (-pi) + closePath + + where pad = 1/10 * min w h + +preserve r = do + save + v <- r + restore + return v + +maybeRead :: Read a => String -> Maybe a +maybeRead s = case reads s of + [(x, "")] -> Just x + _ -> Nothing + +getGames :: GameName -> GameState -> [Game] +getGames gameName = fromJust . lookup gameName . gsGames + +followingElement e l = go (cycle l) + where go (x:xs) = if x == e then head xs else go xs