DAG-Tournament (empty) → 0.1
raw patch · 8 files changed
+1052/−0 lines, 8 filesdep +basedep +cairodep +containerssetup-changed
Dependencies added: base, cairo, containers, directory, filepath, gtk, mtl, time
Files
- DAG-Tournament.cabal +49/−0
- LICENSE +340/−0
- README +101/−0
- Setup.hs +3/−0
- src/Data.hs +32/−0
- src/Graph.hs +57/−0
- src/Physics.hs +72/−0
- src/main.hs +398/−0
+ DAG-Tournament.cabal view
@@ -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 <mail@joachim-breitner.de>+maintainer: Joachim Breitner <mail@joachim-breitner.de>+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
+ LICENSE view
@@ -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.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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.++ <signature of Ty Coon>, 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.
+ README view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,3 @@+module Main where+import Distribution.Simple+main = defaultMain
+ src/Data.hs view
@@ -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)
+ src/Graph.hs view
@@ -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)])
+ src/Physics.hs view
@@ -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
+ src/main.hs view
@@ -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