packages feed

hsdip (empty) → 0.1

raw patch · 25 files changed

+1756/−0 lines, 25 filesdep +HUnitdep +basedep +cairosetup-changedbinary-added

Dependencies added: HUnit, base, cairo, containers, parsec

Files

+ LICENSE view
@@ -0,0 +1,17 @@+Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README view
@@ -0,0 +1,12 @@+-- hsdip -- a Diplomacy parser/renderer.+-- Copyright (C) 2006 Evan Martin <martine@danga.com>++Dependencies:+  - Haskell.+  - rendering requires hscairo, available at+    http://www.haskell.org/gtk2hs/.++Usage:+  runhaskell Main.hs path/to/judge/output output.png+See data/game/* for examples.+
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks
+ data/conf view
@@ -0,0 +1,61 @@+# locations of countries, in pixel coords.+alb (673, 818)+ank (969, 777)+apu (612, 814)+arm (1072, 763)+bel (397, 511)+ber (561, 471)+bla (965, 706)+bot (675, 329)+bre (298, 597)+bud (699, 625)+bul (765, 765)+bur (412, 604)+con (830, 822)+den (520, 391)+edi (357, 327)+eng (308, 517)+gal (750, 597)+gas (309, 651)+gol (380, 760)+gre (726, 832)+hel (483, 437)+hol (462, 480)+ion (638, 897)+kie (497, 477)+lvp (335, 410)+lon (385, 467)+mar (408, 687)+mid (87, 608)+mos (878, 428)+mun (504, 599)+naf (230, 905)+nap (597, 847)+nat (110, 270)+nor (540, 239)+nrg (441, 182)+nth (412, 408)+par (349, 608)+pic (378, 534)+pie (470, 698)+por (136, 709)+rom (531, 756)+ruh (459, 560)+rum (821, 688)+ser (696, 762)+sev (1014, 654)+smy (863, 887)+spa (200, 772)+spaSC (211, 830)+stp (885, 275)+stpSC (746, 326)+swe (603, 399)+tri (606, 727)+tun (477, 946)+ukr (817, 581)+ven (526, 688)+vie (621, 625)+wal (314, 475)+war (714, 508)+wes (311, 850)+
+ data/game/1/1901-0-start view
@@ -0,0 +1,48 @@+:: Judge: USDP  Game: dip  Variant: standard +:: Deadline: S1901M Wed 15 Feb 2006 20:00 PST+:: URL: http://www.diplom.org/dpjudge?game=dip++Starting position for Spring of 1901.  (dip.S1901M)++Austria: Army Budapest.+Austria: Army Vienna.+Austria: Fleet Trieste.++England: Fleet Edinburgh.+England: Fleet London.+England: Army Liverpool.++France: Fleet Brest.+France: Army Marseilles.+France: Army Paris.++Germany: Fleet Kiel.+Germany: Army Berlin.+Germany: Army Munich.++Italy: Fleet Naples.+Italy: Army Rome.+Italy: Army Venice.++Russia: Army Warsaw.+Russia: Army Moscow.+Russia: Fleet Sevastopol.+Russia: Fleet St Petersburg (south coast).++Turkey: Fleet Ankara.+Turkey: Army Constantinople.+Turkey: Army Smyrna.++Ownership of supply centers:++Austria:    Budapest, Trieste, Vienna.+England:    Edinburgh, London, Liverpool.+France:     Brest, Marseilles, Paris.+Germany:    Berlin, Kiel, Munich.+Italy:      Naples, Rome, Venice.+Russia:     Moscow, Sevastopol, St Petersburg, Warsaw.+Turkey:     Ankara, Constantinople, Smyrna.+Unowned:    Belgium, Bulgaria, Denmark, Greece, Holland, Norway, Portugal,+            Rumania, Serbia, Spain, Sweden, Tunis.++The deadline for the first orders is Wednesday 15 February 2006 20:00 PST.
+ data/game/1/1901-1-s1901m view
@@ -0,0 +1,37 @@+:: Judge: USDP  Game: dip  Variant: standard +:: Deadline: S1901M Wed 15 Feb 2006 20:00 PST+:: URL: http://www.diplom.org/dpjudge?game=dip++Movement results for Spring of 1901.  (dip.S1901M)++Austria: Army Budapest -> Serbia.+Austria: Army Vienna -> Budapest.+Austria: Fleet Trieste -> Albania.++England: Fleet Edinburgh -> Norwegian Sea.+England: Fleet London -> North Sea.+England: Army Liverpool -> Edinburgh.++France: Fleet Brest -> Picardy.+France: Army Marseilles SUPPORT Army Paris -> Burgundy.+France: Army Paris -> Burgundy.++Germany: Fleet Kiel -> Denmark.+Germany: Army Berlin -> Kiel.+Germany: Army Munich HOLD.++Italy: Fleet Naples -> Ionian Sea.+Italy: Army Rome -> Apulia.+Italy: Army Venice -> Piedmont.++Russia: Army Warsaw -> Ukraine.+Russia: Army Moscow -> St Petersburg.+Russia: Fleet Sevastopol -> Black Sea.  (*bounce*)+Russia: Fleet St Petersburg (south coast) -> Gulf of Bothnia.++Turkey: Fleet Ankara -> Black Sea.  (*bounce*)+Turkey: Army Constantinople -> Bulgaria.+Turkey: Army Smyrna -> Armenia.++The next phase of 'dip' will be Movement for Fall of 1901.+The deadline for orders will be Monday 20 February 2006 20:00 PST.
+ data/game/1/1901-2-f1901m view
@@ -0,0 +1,56 @@+:: Judge: USDP  Game: dip  Variant: standard+:: Deadline: F1901M Mon 20 Feb 2006 20:00 PST+:: URL: http://www.diplom.org/dpjudge?game=dip++Movement results for Fall of 1901.  (dip.F1901M)++Austria: Army Serbia SUPPORT Army Budapest -> Rumania.+Austria: Army Budapest -> Rumania.+Austria: Fleet Albania SUPPORT Italian Army Apulia -> Greece.++England: Fleet Norwegian Sea CONVOY Army Edinburgh -> Norway.+England: Fleet North Sea SUPPORT Army Edinburgh -> Norway.+England: Army Edinburgh -> Norwegian Sea -> Norway.++France: Army Marseilles -> Spain.+France: Fleet Picardy -> Belgium.+France: Army Burgundy -> Marseilles.++Germany: Army Munich HOLD.+Germany: Fleet Denmark HOLD.+Germany: Army Kiel -> Holland.++Italy: Fleet Ionian Sea CONVOY Army Apulia -> Greece.+Italy: Army Apulia -> Ionian Sea -> Greece.+Italy: Army Piedmont HOLD.++Russia: Fleet Sevastopol -> Black Sea.+Russia: Army Ukraine -> Sevastopol.  (*bounce*)+Russia: Army St Petersburg -> Norway.  (*bounce*)+Russia: Fleet Gulf of Bothnia -> Sweden.++Turkey: Fleet Ankara -> Constantinople.+Turkey: Army Bulgaria -> Rumania.  (*bounce*)+Turkey: Army Armenia -> Sevastopol.  (*bounce*)++Ownership of supply centers:++Austria:    Budapest, Rumania, Serbia, Trieste, Vienna.+England:    Edinburgh, London, Liverpool, Norway.+France:     Belgium, Brest, Marseilles, Paris, Spain.+Germany:    Berlin, Denmark, Holland, Kiel, Munich.+Italy:      Greece, Naples, Rome, Venice.+Russia:     Moscow, Sevastopol, St Petersburg, Sweden, Warsaw.+Turkey:     Ankara, Bulgaria, Constantinople, Smyrna.+Unowned:    Portugal, Tunis.++Austria:     5 Supply centers,  3 Units:  Builds   2 units.+England:     4 Supply centers,  3 Units:  Builds   1 unit.+France:      5 Supply centers,  3 Units:  Builds   2 units.+Germany:     5 Supply centers,  3 Units:  Builds   2 units.+Italy:       4 Supply centers,  3 Units:  Builds   1 unit.+Russia:      5 Supply centers,  4 Units:  Builds   1 unit.+Turkey:      4 Supply centers,  3 Units:  Builds   1 unit.++The next phase of 'dip' will be Adjustments for Winter of 1901.+The deadline for orders will be Thursday 23 February 2006 20:00 PST.
+ data/game/1/1901-3-w1901a view
@@ -0,0 +1,19 @@+:: Judge: USDP  Game: dip  Variant: standard +:: Deadline: F1901B Thu 23 Feb 2006 20:00 PST+:: URL: http://www.diplom.org/dpjudge?game=dip++Adjustment orders for Winter of 1901.  (dip.W1901A)++Austria:    Builds an army in Budapest.+Austria:    Builds an army in Vienna.+England:    Builds a fleet in London.+France:     Builds an army in Paris.+France:     Builds a fleet in Brest.+Germany:    Builds an army in Berlin.+Germany:    Builds a fleet in Kiel.+Italy:      Builds a fleet in Naples.+Russia:     Builds an army in Moscow.+Turkey:     Builds a fleet in Ankara.++The next phase of 'dip' will be Movement for Spring of 1902.+The deadline for orders will be Monday 27 February 2006 20:00 PST.
+ data/game/1/f1902m view
@@ -0,0 +1,66 @@+:: Judge: USDP  Game: dip  Variant: standard+:: Deadline: F1902M Thu 2 Mar 2006 20:00 PST+:: URL: http://www.diplom.org/dpjudge?game=dip++Movement results for Fall of 1902.  (dip.F1902M)++Austria: Army Serbia SUPPORT Italian Army Bulgaria.+Austria: Army Rumania SUPPORT Russian Army Ukraine -> Sevastopol.  (*void*)+Austria: Army Budapest HOLD.+Austria: Army Vienna HOLD.+Austria: Fleet Greece -> Aegean Sea.++England: Fleet Norwegian Sea SUPPORT Army Norway.+England: Fleet North Sea -> English Channel.+England: Army Norway HOLD.+England: Fleet London SUPPORT Fleet North Sea -> English Channel.++France: Army Spain -> Portugal.+France: Fleet Belgium HOLD.+France: Army Marseilles HOLD.+France: Fleet Brest -> Mid-Atlantic Ocean.+France: Army Picardy SUPPORT Fleet Belgium.++Germany: Army Munich HOLD.+Germany: Fleet Denmark SUPPORT Fleet Helgoland Bight -> North Sea.+Germany: Army Holland HOLD.+Germany: Army Kiel HOLD.+Germany: Fleet Helgoland Bight -> North Sea.++Italy: Army Piedmont -> Marseilles.  (*bounce*)+Italy: Fleet Aegean Sea -> Eastern Mediterranean.+Italy: Army Bulgaria SUPPORT Austrian Army Rumania.  (*cut*)+Italy: Fleet Tyrrhenian Sea -> Tunis.++Russia: Army Ukraine SUPPORT Fleet Sevastopol.+Russia: Fleet Sweden -> Norway.  (*bounce*)+Russia: Army Moscow -> St Petersburg.+Russia: Army Finland SUPPORT Fleet Sweden -> Norway.+Russia: Fleet Sevastopol HOLD.++Turkey: Army Armenia -> Smyrna.+Turkey: Fleet Ankara SUPPORT Fleet Black Sea.+Turkey: Fleet Black Sea SUPPORT Army Constantinople -> Bulgaria.+Turkey: Army Constantinople -> Bulgaria.  (*bounce*)+++Ownership of supply centers:++Austria:    Budapest, Rumania, Serbia, Trieste, Vienna.+England:    Edinburgh, London, Liverpool, Norway.+France:     Belgium, Brest, Marseilles, Paris, Portugal, Spain.+Germany:    Berlin, Denmark, Holland, Kiel, Munich.+Italy:      Bulgaria, Greece, Naples, Rome, Tunis, Venice.+Russia:     Moscow, Sevastopol, St Petersburg, Sweden, Warsaw.+Turkey:     Ankara, Constantinople, Smyrna.++Austria:     5 Supply centers,  5 Units:  Builds   0 units.+England:     4 Supply centers,  4 Units:  Builds   0 units.+France:      6 Supply centers,  5 Units:  Builds   1 unit.+Germany:     5 Supply centers,  5 Units:  Builds   0 units.+Italy:       6 Supply centers,  4 Units:  Builds   2 units.+Russia:      5 Supply centers,  5 Units:  Builds   0 units.+Turkey:      3 Supply centers,  4 Units:  Removes  1 unit.++The next phase of 'dip' will be Adjustments for Winter of 1902.+The deadline for orders will be Monday 6 March 2006 20:00 PST.
+ data/game/1/s1902m view
@@ -0,0 +1,52 @@+:: Judge: USDP  Game: dip  Variant: standard+:: Deadline: S1902M Mon 27 Feb 2006 20:00 PST+:: URL: http://www.diplom.org/dpjudge?game=dip++Movement results for Spring of 1902.  (dip.S1902M)++Austria: Army Serbia SUPPORT Italian Army Greece -> Bulgaria.+Austria: Fleet Albania -> Greece.+Austria: Army Rumania SUPPORT Italian Army Greece -> Bulgaria.+Austria: Army Budapest HOLD.+Austria: Army Vienna HOLD.++England: Fleet Norwegian Sea -> North Sea.  (*bounce*)+England: Fleet North Sea -> English Channel.  (*bounce*)+England: Army Norway -> St Petersburg.  (*bounce*)+England: Fleet London SUPPORT Fleet North Sea -> English Channel.++France: Army Spain HOLD.+France: Fleet Belgium SUPPORT Fleet Brest -> English Channel.+France: Army Marseilles HOLD.+France: Army Paris -> Picardy.+France: Fleet Brest -> English Channel.  (*bounce*)++Germany: Army Munich HOLD.+Germany: Fleet Denmark -> North Sea.  (*bounce*)+Germany: Army Holland HOLD.+Germany: Army Berlin -> Kiel.+Germany: Fleet Kiel -> Helgoland Bight.++Italy: Fleet Ionian Sea -> Aegean Sea.+Italy: Army Piedmont -> Marseilles.  (*bounce*)+Italy: Army Greece -> Bulgaria.+Italy: Fleet Naples -> Tyrrhenian Sea.++Russia: Army Ukraine SUPPORT Fleet Black Sea -> Sevastopol.+Russia: Army St Petersburg -> Finland.+Russia: Fleet Black Sea -> Sevastopol.+Russia: Fleet Sweden SUPPORT Army St Petersburg -> Finland.+Russia: Army Moscow -> St Petersburg.  (*bounce*)++Turkey: Army Bulgaria HOLD.  (*dislodged*)+Turkey: Army Armenia -> Sevastopol.  (*bounce*)+Turkey: Fleet Constantinople -> Black Sea.+Turkey: Fleet Ankara SUPPORT Fleet Constantinople -> Black Sea.+++The following units were dislodged:++The Turkish army in Bulgaria can retreat to Constantinople.++The next phase of 'dip' will be Retreats for Spring of 1902.+The deadline for orders will be Wednesday 1 March 2006 20:00 PST.
+ data/game/1/s1902r view
@@ -0,0 +1,10 @@+:: Judge: USDP  Game: dip  Variant: standard+:: Deadline: S1902R Wed 1 Mar 2006 20:00 PST+:: URL: http://www.diplom.org/dpjudge?game=dip++Retreat orders for Spring of 1902.  (dip.S1902R)++Turkey:     Army Bulgaria -> Constantinople.++The next phase of 'dip' will be Movement for Fall of 1902.+The deadline for orders will be Thursday 2 March 2006 20:00 PST.
+ data/game/1/w1902a view
@@ -0,0 +1,71 @@+:: Judge: USDP  Game: dip  Variant: standard+:: Deadline: F1902B Mon 6 Mar 2006 20:00 PST+:: URL: http://www.diplom.org/dpjudge?game=dip++Adjustment orders for Winter of 1902.  (dip.W1902A)++France:     Builds a fleet in Brest.+Italy:      Builds a fleet in Naples.+Italy:      Builds a fleet in Rome.+Turkey:     Removes the fleet in Ankara.++The next phase of 'dip' will be Movement for Spring of 1903.+The deadline for orders will be Wednesday 8 March 2006 20:00 PST.++From dpjudge@diplom.org Wed Mar  8 20:20:31 2006+Subject: Diplomacy results dip S1903M++:: Judge: USDP  Game: dip  Variant: standard+:: Deadline: S1903M Wed 8 Mar 2006 20:00 PST+:: URL: http://www.diplom.org/dpjudge?game=dip++Movement results for Spring of 1903.  (dip.S1903M)++Austria: Army Serbia -> Bulgaria.  (*bounce*)+Austria: Army Rumania SUPPORT Army Serbia -> Bulgaria.  (*cut*)+Austria: Army Budapest SUPPORT Army Rumania.+Austria: Army Vienna HOLD.+Austria: Fleet Aegean Sea SUPPORT Italian Army Bulgaria -> Constantinople.  (*void*)++England: Fleet Norwegian Sea CONVOY Army Norway -> Clyde.+England: Army Norway -> Norwegian Sea -> Clyde.+England: Fleet London -> Yorkshire.  (*bounce*)+England: Fleet English Channel -> Mid-Atlantic Ocean.  (*bounce, dislodged*)++France: Fleet Belgium SUPPORT Fleet Mid-Atlantic Ocean -> English Channel.+France: Army Marseilles -> Piedmont.  (*bounce*)+France: Army Picardy HOLD.+France: Army Portugal -> Spain.+France: Fleet Mid-Atlantic Ocean -> English Channel.+France: Fleet Brest SUPPORT Fleet Mid-Atlantic Ocean -> English Channel.++Germany: Army Munich HOLD.+Germany: Fleet Denmark SUPPORT Fleet North Sea.+Germany: Army Holland -> North Sea -> Yorkshire.  (*bounce*)+Germany: Army Kiel HOLD.+Germany: Fleet North Sea CONVOY Army Holland -> Yorkshire.++Italy: Army Piedmont HOLD.+Italy: Army Bulgaria -> Aegean Sea -> Eastern Mediterranean -> Syria.  (*no convoy*)+Italy: Fleet Eastern Mediterranean CONVOY Army Bulgaria -> Syria.  (*void*)+Italy: Fleet Tunis -> Western Mediterranean.+Italy: Fleet Naples -> Ionian Sea.+Italy: Fleet Rome -> Tyrrhenian Sea.++Russia: Army Ukraine -> Galicia.+Russia: Fleet Sweden SUPPORT Army St Petersburg -> Norway.+Russia: Army Finland SUPPORT Army St Petersburg -> Norway.+Russia: Fleet Sevastopol -> Black Sea.  (*bounce*)+Russia: Army St Petersburg -> Norway.++Turkey: Fleet Black Sea -> Rumania.  (*bounce*)+Turkey: Army Constantinople SUPPORT Army Smyrna.+Turkey: Army Smyrna SUPPORT Army Constantinople.+++The following units were dislodged:++The English fleet in the English Channel can retreat to Irish Sea or Wales.++The next phase of 'dip' will be Retreats for Spring of 1903.+The deadline for orders will be Friday 10 March 2006 20:00 PST.
+ data/game/2/1901-1-s1901m view
@@ -0,0 +1,37 @@+:: Judge: USDP  Game: itson  Variant: standard +:: Deadline: S1901M Fri 12 May 2006 20:00 PDT+:: URL: http://www.diplom.org/dpjudge?game=itson++Movement results for Spring of 1901.  (itson.S1901M)++Austria: Army Budapest -> Serbia.+Austria: Army Vienna -> Budapest.+Austria: Fleet Trieste -> Venice.  (*bounce*)++England: Fleet Edinburgh -> North Sea.+England: Fleet London -> English Channel.+England: Army Liverpool -> Wales.++France: Fleet Brest -> Picardy.+France: Army Marseilles -> Spain.+France: Army Paris -> Burgundy.++Germany: Fleet Kiel -> Denmark.+Germany: Army Berlin -> Kiel.+Germany: Army Munich -> Ruhr.++Italy: Fleet Naples -> Ionian Sea.+Italy: Army Rome -> Apulia.+Italy: Army Venice -> Trieste.  (*bounce*)++Russia: Army Warsaw HOLD.+Russia: Army Moscow -> Ukraine.+Russia: Fleet Sevastopol -> Rumania.+Russia: Fleet St Petersburg (south coast) -> Gulf of Bothnia.++Turkey: Fleet Ankara -> Black Sea.+Turkey: Army Constantinople -> Bulgaria.+Turkey: Army Smyrna -> Constantinople.++The next phase of 'itson' will be Movement for Fall of 1901.+The deadline for orders will be Monday 15 May 2006 20:00 PDT.
+ data/game/2/1901-2-f1901m view
@@ -0,0 +1,56 @@+:: Judge: USDP  Game: itson  Variant: standard +:: Deadline: F1901M Tue 16 May 2006 20:00 PDT+:: URL: http://www.diplom.org/dpjudge?game=itson++Movement results for Fall of 1901.  (itson.F1901M)++Austria: Fleet Trieste -> Venice.  (*bounce*)+Austria: Army Serbia SUPPORT Russian Fleet Rumania -> Bulgaria.  (*void*)+Austria: Army Budapest SUPPORT Russian Army Ukraine -> Rumania.  (*void*)++England: Fleet North Sea SUPPORT Army Wales -> Belgium.+England: Fleet English Channel CONVOY Army Wales -> Belgium.+England: Army Wales -> English Channel -> Belgium.  (*bounce*)++France: Fleet Picardy SUPPORT Army Burgundy -> Belgium.+France: Army Spain -> Portugal.+France: Army Burgundy -> Belgium.  (*bounce*)++Germany: Fleet Denmark -> Sweden.  (*bounce*)+Germany: Army Kiel -> Holland.+Germany: Army Ruhr SUPPORT Army Kiel -> Holland.++Italy: Army Venice -> Trieste.  (*bounce*)+Italy: Fleet Ionian Sea -> Tunis.+Italy: Army Apulia -> Rome.++Russia: Army Warsaw -> Galicia.+Russia: Army Ukraine SUPPORT Fleet Rumania.+Russia: Fleet Rumania HOLD.+Russia: Fleet Gulf of Bothnia -> Sweden.  (*bounce*)++Turkey: Fleet Black Sea SUPPORT Army Constantinople -> Bulgaria.+Turkey: Army Bulgaria -> Greece.+Turkey: Army Constantinople -> Bulgaria.++Ownership of supply centers:++Austria:    Budapest, Serbia, Trieste, Vienna.+England:    Edinburgh, London, Liverpool.+France:     Brest, Marseilles, Paris, Portugal.+Germany:    Berlin, Denmark, Holland, Kiel, Munich.+Italy:      Naples, Rome, Tunis, Venice.+Russia:     Moscow, Rumania, Sevastopol, St Petersburg, Warsaw.+Turkey:     Ankara, Bulgaria, Constantinople, Greece, Smyrna.+Unowned:    Belgium, Norway, Spain, Sweden.++Austria:     4 Supply centers,  3 Units:  Builds   1 unit.+England:     3 Supply centers,  3 Units:  Builds   0 units.+France:      4 Supply centers,  3 Units:  Builds   1 unit.+Germany:     5 Supply centers,  3 Units:  Builds   2 units.+Italy:       4 Supply centers,  3 Units:  Builds   1 unit.+Russia:      5 Supply centers,  4 Units:  Builds   1 unit.+Turkey:      5 Supply centers,  3 Units:  Builds   2 units.++The next phase of 'itson' will be Adjustments for Winter of 1901.+The deadline for orders will be Thursday 18 May 2006 20:00 PDT.
+ data/game/2/full view
@@ -0,0 +1,332 @@+From dpjudge@diplom.org Mon May  8 19:53:56 2006+Subject: Diplomacy game itson starting++:: Judge: USDP  Game: itson  Variant: standard+:: Deadline: S1901M Fri 12 May 2006 20:00 PDT+:: URL: http://www.diplom.org/dpjudge?game=itson++Starting position for Spring of 1901.  (itson.S1901M)++Austria: Army Budapest.+Austria: Army Vienna.+Austria: Fleet Trieste.++England: Fleet Edinburgh.+England: Fleet London.+England: Army Liverpool.++France: Fleet Brest.+France: Army Marseilles.+France: Army Paris.++Germany: Fleet Kiel.+Germany: Army Berlin.+Germany: Army Munich.++Italy: Fleet Naples.+Italy: Army Rome.+Italy: Army Venice.++Russia: Army Warsaw.+Russia: Army Moscow.+Russia: Fleet Sevastopol.+Russia: Fleet St Petersburg (south coast).++Turkey: Fleet Ankara.+Turkey: Army Constantinople.+Turkey: Army Smyrna.++Ownership of supply centers:++Austria:    Budapest, Trieste, Vienna.+England:    Edinburgh, London, Liverpool.+France:     Brest, Marseilles, Paris.+Germany:    Berlin, Kiel, Munich.+Italy:      Naples, Rome, Venice.+Russia:     Moscow, Sevastopol, St Petersburg, Warsaw.+Turkey:     Ankara, Constantinople, Smyrna.+Unowned:    Belgium, Bulgaria, Denmark, Greece, Holland, Norway, Portugal,+           Rumania, Serbia, Spain, Sweden, Tunis.+++The deadline for the first orders is Friday 12 May 2006 20:00 PDT.++From dpjudge@diplom.org Sat May 13 11:20:27 2006+Subject: Diplomacy results itson S1901M++:: Judge: USDP  Game: itson  Variant: standard+:: Deadline: S1901M Fri 12 May 2006 20:00 PDT+:: URL: http://www.diplom.org/dpjudge?game=itson++Movement results for Spring of 1901.  (itson.S1901M)++Austria: Army Budapest -> Serbia.+Austria: Army Vienna -> Budapest.+Austria: Fleet Trieste -> Venice.  (*bounce*)++England: Fleet Edinburgh -> North Sea.+England: Fleet London -> English Channel.+England: Army Liverpool -> Wales.++France: Fleet Brest -> Picardy.+France: Army Marseilles -> Spain.+France: Army Paris -> Burgundy.++Germany: Fleet Kiel -> Denmark.+Germany: Army Berlin -> Kiel.+Germany: Army Munich -> Ruhr.++Italy: Fleet Naples -> Ionian Sea.+Italy: Army Rome -> Apulia.+Italy: Army Venice -> Trieste.  (*bounce*)++Russia: Army Warsaw HOLD.+Russia: Army Moscow -> Ukraine.+Russia: Fleet Sevastopol -> Rumania.+Russia: Fleet St Petersburg (south coast) -> Gulf of Bothnia.++Turkey: Fleet Ankara -> Black Sea.+Turkey: Army Constantinople -> Bulgaria.+Turkey: Army Smyrna -> Constantinople.++The next phase of 'itson' will be Movement for Fall of 1901.+The deadline for orders will be Monday 15 May 2006 20:00 PDT.++From dpjudge@diplom.org Tue May 16 20:00:43 2006+Subject: Diplomacy results itson F1901M++:: Judge: USDP  Game: itson  Variant: standard+:: Deadline: F1901M Tue 16 May 2006 20:00 PDT+:: URL: http://www.diplom.org/dpjudge?game=itson++Movement results for Fall of 1901.  (itson.F1901M)++Austria: Fleet Trieste -> Venice.  (*bounce*)+Austria: Army Serbia SUPPORT Russian Fleet Rumania -> Bulgaria.  (*void*)+Austria: Army Budapest SUPPORT Russian Army Ukraine -> Rumania.  (*void*)++England: Fleet North Sea SUPPORT Army Wales -> Belgium.+England: Fleet English Channel CONVOY Army Wales -> Belgium.+England: Army Wales -> English Channel -> Belgium.  (*bounce*)++France: Fleet Picardy SUPPORT Army Burgundy -> Belgium.+France: Army Spain -> Portugal.+France: Army Burgundy -> Belgium.  (*bounce*)++Germany: Fleet Denmark -> Sweden.  (*bounce*)+Germany: Army Kiel -> Holland.+Germany: Army Ruhr SUPPORT Army Kiel -> Holland.++Italy: Army Venice -> Trieste.  (*bounce*)+Italy: Fleet Ionian Sea -> Tunis.+Italy: Army Apulia -> Rome.++Russia: Army Warsaw -> Galicia.+Russia: Army Ukraine SUPPORT Fleet Rumania.+Russia: Fleet Rumania HOLD.+Russia: Fleet Gulf of Bothnia -> Sweden.  (*bounce*)++Turkey: Fleet Black Sea SUPPORT Army Constantinople -> Bulgaria.+Turkey: Army Bulgaria -> Greece.+Turkey: Army Constantinople -> Bulgaria.+++Ownership of supply centers:++Austria:    Budapest, Serbia, Trieste, Vienna.+England:    Edinburgh, London, Liverpool.+France:     Brest, Marseilles, Paris, Portugal.+Germany:    Berlin, Denmark, Holland, Kiel, Munich.+Italy:      Naples, Rome, Tunis, Venice.+Russia:     Moscow, Rumania, Sevastopol, St Petersburg, Warsaw.+Turkey:     Ankara, Bulgaria, Constantinople, Greece, Smyrna.+Unowned:    Belgium, Norway, Spain, Sweden.++Austria:     4 Supply centers,  3 Units:  Builds   1 unit.+England:     3 Supply centers,  3 Units:  Builds   0 units.+France:      4 Supply centers,  3 Units:  Builds   1 unit.+Germany:     5 Supply centers,  3 Units:  Builds   2 units.+Italy:       4 Supply centers,  3 Units:  Builds   1 unit.+Russia:      5 Supply centers,  4 Units:  Builds   1 unit.+Turkey:      5 Supply centers,  3 Units:  Builds   2 units.++The next phase of 'itson' will be Adjustments for Winter of 1901.+The deadline for orders will be Thursday 18 May 2006 20:00 PDT.++From dpjudge@diplom.org Thu May 18 21:00:11 2006+Subject: Diplomacy results itson W1901A++:: Judge: USDP  Game: itson  Variant: standard+:: Deadline: F1901B Thu 18 May 2006 20:00 PDT+:: URL: http://www.diplom.org/dpjudge?game=itson++Adjustment orders for Winter of 1901.  (itson.W1901A)++Austria:    Builds an army in Vienna.+France:     Builds a fleet in Brest.+Germany:    Builds an army in Munich.+Germany:    Builds a fleet in Kiel.+Italy:      Builds a fleet in Naples.+Russia:     Builds an army in St Petersburg.+Turkey:     Builds an army in Ankara.+Turkey:     Builds a fleet in Constantinople.++The next phase of 'itson' will be Movement for Spring of 1902.+The deadline for orders will be Monday 22 May 2006 20:00 PDT.++From dpjudge@diplom.org Mon May 22 20:00:18 2006+Subject: Diplomacy results itson S1902M++:: Judge: USDP  Game: itson  Variant: standard+:: Deadline: S1902M Mon 22 May 2006 20:00 PDT+:: URL: http://www.diplom.org/dpjudge?game=itson++Movement results for Spring of 1902.  (itson.S1902M)++Austria: Fleet Trieste -> Albania.+Austria: Army Serbia SUPPORT Fleet Trieste -> Albania.  (*cut, dislodged*)+Austria: Army Budapest SUPPORT Army Serbia.  (*cut*)+Austria: Army Vienna -> Trieste.++England: Fleet North Sea -> Norway.+England: Fleet English Channel CONVOY Army Wales -> Belgium.  (*dislodged*)+England: Army Wales -> English Channel -> Belgium.  (*no convoy*)++France: Fleet Picardy -> English Channel.+France: Army Burgundy -> Gascony.+France: Army Portugal HOLD.+France: Fleet Brest SUPPORT Fleet Picardy -> English Channel.++Germany: Fleet Denmark -> North Sea.+Germany: Army Ruhr -> Belgium.+Germany: Army Holland SUPPORT Army Ruhr -> Belgium.+Germany: Army Munich HOLD.+Germany: Fleet Kiel -> Helgoland Bight.++Italy: Army Venice -> Tyrolia.+Italy: Fleet Tunis -> Tyrrhenian Sea.+Italy: Army Rome -> Venice.+Italy: Fleet Naples -> Apulia.++Russia: Army Ukraine SUPPORT Fleet Rumania.+Russia: Fleet Rumania HOLD.+Russia: Fleet Gulf of Bothnia -> Baltic Sea.+Russia: Army Galicia -> Budapest.  (*bounce*)+Russia: Army St Petersburg -> Finland.++Turkey: Fleet Black Sea CONVOY Army Ankara -> Bulgaria.+Turkey: Army Greece SUPPORT Army Bulgaria -> Serbia.+Turkey: Army Bulgaria -> Serbia.+Turkey: Army Ankara -> Black Sea -> Bulgaria.+Turkey: Fleet Constantinople SUPPORT Army Ankara -> Bulgaria.+++The following units were dislodged:++The Austrian army in Serbia with no valid retreats was destroyed.+The English fleet in the English Channel can retreat to Irish Sea or London+or Mid-Atlantic Ocean.++The next phase of 'itson' will be Retreats for Spring of 1902.+The deadline for orders will be Wednesday 24 May 2006 20:00 PDT.++From dpjudge@diplom.org Wed May 24 16:00:21 2006+Subject: Diplomacy results itson S1902R++:: Judge: USDP  Game: itson  Variant: standard+:: Deadline: S1902R Wed 24 May 2006 20:00 PDT+:: URL: http://www.diplom.org/dpjudge?game=itson++Retreat orders for Spring of 1902.  (itson.S1902R)++England:    Fleet English Channel -> Mid-Atlantic Ocean.++The next phase of 'itson' will be Movement for Fall of 1902.+The deadline for orders will be Friday 26 May 2006 20:00 PDT.++From dpjudge@diplom.org Sat May 27 10:40:09 2006+Subject: Diplomacy results itson F1902M++:: Judge: USDP  Game: itson  Variant: standard+:: Deadline: F1902M Fri 26 May 2006 20:00 PDT+:: URL: http://www.diplom.org/dpjudge?game=itson++Movement results for Fall of 1902.  (itson.F1902M)++Austria: Army Budapest SUPPORT Turkish Army Bulgaria -> Rumania.  (*void*)+Austria: Fleet Albania -> Greece.  (*bounce, dislodged*)+Austria: Army Trieste -> Vienna.++England: Army Wales -> London.+England: Fleet Norway HOLD.+England: Fleet Mid-Atlantic Ocean -> Irish Sea.  (*bounce*)++France: Army Portugal SUPPORT Army Gascony -> Spain.+France: Fleet Brest -> Mid-Atlantic Ocean.  (*bounce*)+France: Fleet English Channel -> Irish Sea.  (*bounce*)+France: Army Gascony -> Spain.++Germany: Army Holland -> Kiel.+Germany: Army Munich -> Berlin.+Germany: Fleet North Sea CONVOY Army Belgium -> Edinburgh.+Germany: Army Belgium -> North Sea -> Edinburgh.+Germany: Fleet Helgoland Bight -> Denmark.++Italy: Army Tyrolia SUPPORT Army Venice -> Trieste.+Italy: Fleet Tyrrhenian Sea -> Ionian Sea.  (*bounce*)+Italy: Army Venice -> Trieste.+Italy: Fleet Apulia -> Ionian Sea.  (*bounce*)++Russia: Army Ukraine SUPPORT Fleet Rumania.+Russia: Fleet Rumania HOLD.+Russia: Army Galicia -> Budapest.  (*bounce*)+Russia: Fleet Baltic Sea SUPPORT Army Finland -> Sweden.+Russia: Army Finland -> Sweden.++Turkey: Fleet Black Sea HOLD.+Turkey: Army Greece -> Albania.+Turkey: Fleet Constantinople HOLD.+Turkey: Army Serbia SUPPORT Army Greece -> Albania.+Turkey: Army Bulgaria SUPPORT Army Serbia.+++The following units were dislodged:++The Austrian fleet in Albania can retreat to Adriatic Sea.++The next phase of 'itson' will be Retreats for Fall of 1902.+The deadline for orders will be Wednesday 7 June 2006 20:00 PDT.++From dpjudge@diplom.org Thu Jun  8 18:40:59 2006+Subject: Diplomacy results itson F1902R++:: Judge: USDP  Game: itson  Variant: standard+:: Deadline: F1902R Thu 8 Jun 2006 20:00 PDT+:: URL: http://www.diplom.org/dpjudge?game=itson++Retreat orders for Fall of 1902.  (itson.F1902R)++Austria:    Fleet Albania -> Adriatic Sea.+++Ownership of supply centers:++Austria:    Budapest, Vienna.+England:    London, Liverpool, Norway.+France:     Brest, Marseilles, Paris, Portugal, Spain.+Germany:    Berlin, Denmark, Edinburgh, Holland, Kiel, Munich.+Italy:      Naples, Rome, Trieste, Tunis, Venice.+Russia:     Moscow, Rumania, Sevastopol, St Petersburg, Sweden, Warsaw.+Turkey:     Ankara, Bulgaria, Constantinople, Greece, Serbia, Smyrna.+Unowned:    Belgium.++Austria:     2 Supply centers,  3 Units:  Removes  1 unit.+England:     3 Supply centers,  3 Units:  Builds   0 units.+France:      5 Supply centers,  4 Units:  Builds   1 unit.+Germany:     6 Supply centers,  5 Units:  Builds   1 unit.+Italy:       5 Supply centers,  4 Units:  Builds   1 unit.+Russia:      6 Supply centers,  5 Units:  Builds   1 unit.+Turkey:      6 Supply centers,  5 Units:  Builds   1 unit.++The next phase of 'itson' will be Adjustments for Winter of 1902.+The deadline for orders will be Monday 12 June 2006 20:00 PDT.
+ data/map.png view

binary file changed (absent → 150447 bytes)

+ hsdip.cabal view
@@ -0,0 +1,37 @@+name:                hsdip+version:             0.1+synopsis:            hsdip - a Diplomacy parser/renderer+Stability:           Experimental+category:            System+license:             BSD3+license-file:        LICENSE+author:              Evan Martin+maintainer:          Evan Martin <martine@danga.com>+homepage:            http://neugierig.org/software/darcs/hsdip/++tested-with:         GHC==6.8.2+Cabal-Version:       >= 1.2+build-type:          Simple+data-files:          README, html/index.html, data/conf, data/game/1/s1902r,+                     data/game/1/1901-0-start, data/game/1/f1902m, data/game/1/1901-3-w1901a,+                     data/game/1/w1902a, data/game/1/1901-2-f1901m, data/game/1/1901-1-s1901m,+                     data/game/1/s1902m, data/game/2/full,+                     data/game/2/1901-2-f1901m, data/game/2/1901-1-s1901m, data/map.png+extra-source-files:  test/Test.hs, test/ConfTest.hs++Library+        build-depends:          base>3, containers, parsec, HUnit, cairo+        hs-source-dirs:         src++        ghc-options:            -O2 -Wall -optl-Wl,-s+        ghc-prof-options:       -prof -auto-all++        Exposed-modules:        Conf, Diplomacy, JudgeParser, Render++Executable hsdip+        executable:          hsdip+        main-is:             Main.hs+        hs-source-dirs:      src++        ghc-options:         -O2 -Wall -optl-Wl,-s+        ghc-prof-options:    -prof -auto-al
+ html/index.html view
@@ -0,0 +1,90 @@+<html>+  <head>+    <meta http-equiv='Content-Type' content='text/html; charset=UTF-8'/>+    <style>+html, body {+  height: 100%;+  margin: 0;         +  font-family: sans-serif;+}+#mapview {+  width: 100%;+  height: 100%;+  overflow: auto;+  position: relative;+}+img.layer {+  position: absolute;+  left: 0;+  top: 0;+}+#navbar {+  background: white;+  border-bottom: solid 1px black;+  border-right: solid 1px black;+  padding: 1ex;+  position: absolute;+  left: 0;+  top: 0;+}+a.arrow {+  padding: 0.1ex 0.4ex;+  text-decoration: none;+  color: black;+}+a.arrow:hover {+  background: black;+  color: white;+}+    </style>+    <script>+function $(x) { return document.getElementById(x); }+function registerHandlers() {+  var map = document.getElementById('mapview');+  var dragging = false;+  var drag_x = 0;+  var drag_y = 0;+  map.scrollLeft = (1152 - map.offsetWidth) / 2;+  map.scrollTop  = (965 - map.offsetHeight) / 2;+  map.onmousedown = function(e) {+    dragging = true;+    drag_x = e.clientX;+    drag_y = e.clientY;+    return false;+  }+  map.onmousemove = function(e) {+    if (dragging) {+      map.scrollLeft -= e.clientX - drag_x;+      map.scrollTop  -= e.clientY - drag_y;+      drag_x = e.clientX;+      drag_y = e.clientY;+    }+  }+  map.onmouseup = function(e) {+    dragging = false;+    return false;+  }+}+var curPage = 1;+function changePage(dir) {+  curPage += dir;+  $('map').src = curPage + '.png';+  $('curturn').innerHTML = curPage;+}+    </script>+  </head>+  <body>+    <div id='mapview'>+      <img class='layer' src='map.png' width='1152' height='965'/>+      <img id='map' class='layer' src='1.png' width='1152' height='965'/>+    </div>+    <div id='navbar'>+    <a href='#' class='arrow' onclick='changePage(-1); return false;'>◀</a>+    <span id='curturn'>1</span>+    <a href='#' class='arrow' onclick='changePage(1); return false;'>▶</a>+    </div>+    <script>registerHandlers()</script>+  </body>+</html>++<!-- vim: set ts=2 sw=2 et : -->
+ src/Conf.hs view
@@ -0,0 +1,90 @@+-- hsdip -- a diplomacy parser/renderer.+-- Copyright (C) 2006 Evan Martin <martine@danga.com>++module Conf(+  Conf(..),+  locXY,+  parseFile+) where++import Text.ParserCombinators.Parsec+import qualified Text.ParserCombinators.Parsec.Token as P+import Text.ParserCombinators.Parsec.Language+import qualified Data.Map as Map+import qualified Diplomacy+import qualified Data.Char+-- import Debug.Trace++data Conf = Conf {+  locations :: Map.Map String (Int, Int)+} deriving Show++-- fallback :: a -> Maybe a -> a+-- fallback def try = maybe def id try++keyFromLocation :: Diplomacy.Location -> String+keyFromLocation = tryCases where+  tryCases "Liverpool"       = "lvp"+  tryCases "Gulf of Bothnia" = "bot"+  tryCases "North Sea"       = "nth"+  tryCases "Norwegian Sea"   = "nrg"+  tryCases x                 = defaultMunge x+  defaultMunge = take 3 . spacefree . lowercase+  spacefree = filter (/= ' ')+  lowercase = map Data.Char.toLower++locXY :: Conf -> Diplomacy.Location -> (Double, Double)+locXY conf loc = maybe (error ("Bad location " ++ loc)) toDouble coords where+  toDouble (x, y) = (fromIntegral x, fromIntegral y)+  coords = Map.lookup key (locations conf)+  key = keyFromLocation loc++lexer :: P.TokenParser st+lexer = P.makeTokenParser def where+  def = emptyDef {+          P.commentLine = "#",+          P.opStart = opLetter def,+          P.opLetter = oneOf "(,)"+          -- P.reservedNames = ["location"]+        }+{-+braces :: CharParser st a -> CharParser st a+braces = P.braces lexer+reserved :: String -> CharParser st ()+reserved = P.reserved lexer+-}+comma :: CharParser st String+comma = P.comma lexer+decimal :: CharParser st Integer+decimal = P.decimal lexer+identifier :: CharParser st String+identifier = P.identifier lexer+parens :: CharParser st a -> CharParser st a+parens = P.parens lexer++whiteSpace :: CharParser st ()+whiteSpace = P.whiteSpace lexer++p_conf :: GenParser Char () Conf+p_conf = do+  whiteSpace+  locs <- many1 p_location+  return $ Conf (Map.fromList locs)+  where+    p_location :: Parser (String, (Int,Int))+    p_location = do+      loc <- identifier+      pos <- parens $ do x <- decimal+                         comma+                         y <- decimal+                         return (fromIntegral x, fromIntegral y)+      return (loc, pos)++parseFile :: FilePath -> IO (Either String Conf)+parseFile file = do+  res <- parseFromFile p_conf file+  return $ case res of+    Left err -> Left (show err)+    Right conf -> Right conf++-- vim: set ts=2 sw=2 et :
+ src/Diplomacy.hs view
@@ -0,0 +1,75 @@+-- hsdip -- a diplomacy parser/renderer.+-- Copyright (C) 2006 Evan Martin <martine@danga.com>++module Diplomacy where++data Power = Austria | England | France | Germany+           | Italy | Russia | Turkey deriving (Eq, Show, Read)++powerNames :: [[Char]]+powerNames = ["Austria", "England", "France", "Germany",+              "Italy", "Russia", "Turkey"]++data Unit = Army | Fleet deriving (Eq, Show)+type Location = String+type UnitLoc = (Unit, Location)++data Move = Hold+          | Attack Location+          | Support UnitMove+          | Convoy  UnitMove deriving (Eq, Show)+data UnitMove = UnitMove UnitLoc Move deriving (Eq, Show)++type UnitMoveTry = (UnitMove, Bool)++type Ownership = (Maybe Power, [Location])+type PowerPos = (Power, [UnitLoc])+type PowerMove = (Power, [UnitMoveTry])++type Year = Int+data Season = Spring | Fall deriving (Eq, Show, Ord)+data TurnType = Movement | Adjustment | Retreat deriving (Eq, Show, Ord)+type Time = (Year, Season, TurnType)+data Turn = Turn {+  turnName :: String,+  turnTime :: Time,+  turnUnits :: [PowerPos],+  turnMoves :: [PowerMove],+  turnOwnership :: [Ownership]+}+emptyTurn :: Turn+emptyTurn = Turn "" (1901, Spring, Movement) [] [] []++showTurn :: Turn -> String -> String+showTurn (Turn name time units moves _) =+  lline "Turn" (showString name)+  . lline "Time" (shows time)+  . lline "Units" (showUnits units)+  . lline "Moves" (showMoves moves)+  -- . lline "Ownership" (showOwnership ownership)+    where+      newline :: ShowS+      newline = showChar '\n'+      lline :: String -> ShowS -> ShowS+      lline label s = showString label . showString ": " . s . newline+      indented :: ShowS -> ShowS+      indented s = showString "  " . s . newline+      showPowers :: (a -> ShowS) -> [(Power, [a])] -> ShowS+      showPowers f = mapShowS (\(power,d) ->+                                shows power . newline .+                                mapShowS (indented . f) d)+      showUnits :: [(Power, [UnitLoc])] -> ShowS+      showUnits = showPowers $ showUnitLoc+      showMoves = showPowers $ showMoveTry+      showMoveTry (UnitMove uloc move, failed) =+        showUnitLoc uloc . showChar ' ' . shows move .+        if failed then showString " (*failed*)" else id+      showUnitLoc :: UnitLoc -> ShowS+      showUnitLoc (unit, loc) = shows unit . showChar ' ' . showString loc+      mapShowS :: (a -> ShowS) -> [a] -> ShowS+      mapShowS f = foldl (\a b -> a . f b) id++instance Show Turn where+  showsPrec _ = showTurn++-- vim: set ts=2 sw=2 et :
+ src/JudgeParser.hs view
@@ -0,0 +1,274 @@+-- hsdip -- a diplomacy parser/renderer.+-- Copyright (C) 2006 Evan Martin <martine@danga.com>++module JudgeParser (+  parseFileTurn, parseFileTurns,+  tests+) where++import Text.ParserCombinators.Parsec+import qualified Text.ParserCombinators.Parsec.Token as P+import Text.ParserCombinators.Parsec.Language+import Control.Monad(liftM)+-- import Debug.Trace+import Data.List (groupBy)+import Test.HUnit++import Diplomacy++p_unit :: Parser Unit+p_unit = do symbol "Army";  return Army+     <|> do symbol "Fleet"; return Fleet++p_location :: Parser String+p_location = do+  parts <- many1 (identifier+              <|> try (char '-' >> notFollowedBy (char '>') >> return "-"))+  return (join parts) where+    join :: [String] -> String+    join [] = ""+    join xs = foldr1 (\a b -> a ++ ' ' : b) xs++p_power :: Parser Power+p_power = do+  power <- choice [reserved x >> return x | x <- powerNames]+  return (read power)++p_unitLocation :: Parser UnitLoc+p_unitLocation = do+  unit <- p_unit; loc <- p_location+  return (unit, loc)++optionally :: GenParser tok st a -> GenParser tok st ()+optionally p = option () (try p >> return ())++optionalLine :: String -> GenParser Char st ()+optionalLine match = optionally $ do+  string match+  manyTill anyChar (char '\n')++p_turn :: Parser Turn+p_turn = do+  optionalLine "From dpjudge"+  optionalLine "Subject: "+  whiteSpace+  p_metaHeader+  (name, time, units, moves) <- p_turnbody+  option () (p_ownership >> return ())+  optionalLine "The next phase"+  optionalLine "The deadline"+  whiteSpace+  return $ Turn {+    turnName = name,+    turnTime = time,+    turnUnits = units,+    turnMoves = moves,+    turnOwnership = []+  }++-- TODO: actually parse the guts of these.+p_metaHeader :: GenParser Char () [[Char]]+p_metaHeader = do h <- many1 headerLine; whiteSpace; return h+  where headerLine = reservedOp "::" >> manyTill anyChar newline++p_turnbody :: Parser (String, Time, [PowerPos], [PowerMove])+p_turnbody = p_body "Starting position" p_movement+         <|> p_body "Movement results"  p_movement+         <|> p_body "Retreat orders"    p_movement+         <|> p_body "Adjustment orders" p_adjustment+  where+    p_body str p = do+      (long, time) <- p_header str+      (units, moves) <- p+      return (long, time, units, moves)+    p_header htype = do+      string htype+      string " for "+      longname <- manyTill anyChar (char '.')+      string "  ("+      identifier+      char '.'+      time <- p_shortTurn+      string ")\n\n"+      return (longname, time)++p_shortTurn :: (Read a) => GenParser Char st (a, Season, TurnType)+p_shortTurn = do+  season <- p_season+  year <- p_year+  ttype <- p_type+  return (year, season, ttype) where+    p_season = do char 'S'; return Spring+           <|> do oneOf "FW"; return Fall+    p_year = liftM read $ many1 digit+    p_type = do char 'M'; return Movement+         <|> do char 'A'; return Adjustment+         <|> do char 'R'; return Retreat++-- Given an input like:+--   Austria: bar.+--   Austria: bar2.+--   Germany: baz.+-- Does the natural grouping, running the parser on the bodies.+-- Returns [(Austria, [results]), (Germany, [results)].+p_powerSet :: Parser a -> Parser [(Power, [a])]+p_powerSet p_body = do+  lnes <- many1 p_one+  let groups = groupBy (\a b -> fst a == fst b) lnes+  return $ map simplify groups+  where+    p_one = do power <- p_power; colon; body <- p_body+               return (power, body)+    simplify lnes = (head powers, body) where (powers, body) = unzip lnes++p_movement :: Parser ([PowerPos], [PowerMove])+p_movement = do+  pmoves <- p_powerSet p_fullMove+  optionally $ do+    string "The following units were dislodged:"; whiteSpace+    skipMany (string "The " >> manyTill anyChar (string ".\n") >> return ())+    whiteSpace+  return (positionsFromMoves pmoves, pmoves) where+    positionsFromMoves = mapPowers (\(UnitMove unitloc _, _) -> unitloc)+    mapPowers f = map (\(power, content) -> (power, map f content))++p_adjustment :: Parser ([PowerPos], [PowerMove])+p_adjustment = do+  p_powerSet p_adjust+  return ([], []) where+    p_adjust = do string "Builds "+                  (char 'a' >> (string "n army" <|> string " fleet"))+                  string " in "+                  p_location+                  period+                  return ()++p_fullMove_test :: Test+p_fullMove_test = TestList $ [+    testParse "Army Liverpool -> Edinburgh."+              (UnitMove (Army, "Liverpool") (Attack "Edinburgh"), False)+  , testParse "Army Marseilles SUPPORT Army Paris -> Burgundy."+              (UnitMove (Army, "Marseilles")+                 (Support (UnitMove (Army, "Paris") (Attack "Burgundy"))),+               False)+  , testParse "Army Bulgaria -> Aegean Sea -> Eastern Mediterranean -> Syria.  (*no convoy*)"+              (UnitMove (Army, "Bulgaria") (Attack "Syria"), True)+  , testParse "Fleet Eastern Mediterranean CONVOY Army Bulgaria -> Syria.  (*void*)"+              (UnitMove (Fleet, "Eastern Mediterranean")+                 (Convoy (UnitMove (Army, "Bulgaria") (Attack "Syria"))),+               True)+  , testParse "Army Serbia SUPPORT Italian Army Bulgaria."+              (UnitMove (Army, "Serbia")+                 (Support (UnitMove (Army, "Bulgaria") Hold)),+               False)+  , testParse "Army Serbia SUPPORT Fleet Trieste -> Albania.  (*cut, dislodged*)"+              (UnitMove (Army, "Serbia")+                 (Support (UnitMove (Fleet, "Trieste") (Attack "Albania"))),+               True)+  ]+  where+    testParse str expr = TestCase $ do+      case (parse p_fullMove "" str) of+        Left err -> assertFailure (show err)+        Right r  -> assertEqual "" expr r++tests :: Test+tests = TestList [p_fullMove_test]++p_fullMove :: Parser UnitMoveTry+p_fullMove = do+  unitmove <- p_unitMove; period+  failed <- option False (p_failed >> return True)+  return (unitmove, failed)+  where+    -- a submove can either be "italian army ..." or just "army ..."+    p_unitMove = try (do identifier; p_unitMove')+            <|> p_unitMove'+    p_unitMove' :: Parser UnitMove+    p_unitMove' = do+      unitloc <- p_unitLocation+      move <- p_movetype+      return $ UnitMove unitloc move+    p_movetype = do reservedOp "->";+                    locs <- p_location `sepBy` (reservedOp "->")+                    return $ Attack (last locs)+             <|> do reserved "SUPPORT"+                    return . Support =<< p_unitMove+             <|> do reserved "CONVOY"+                    return . Convoy =<< p_unitMove+             <|> do reserved "HOLD"; return Hold+             <|> return Hold  -- when you support a hold, there's no HOLD text.+    -- failed looks like:  (* cut, dislodged *)+    p_failed = do reservedOp "(*"; skipMany (identifier <|> comma); reservedOp "*)"++-- Austria:    Budapest, Rumania, Serbia, Trieste, Vienna.++p_ownership :: Parser [Ownership]+p_ownership = do+  string "Ownership of supply centers:\n\n"+  owners <- many (try p_owner)+  many p_build+  return owners where+    p_owner = do+      power <- p_maybePower; colon+      countries <- p_location `sepBy1` comma; period+      return (power, countries)+    p_maybePower = (p_power >>= return . Just)+               <|> (string "Unowned" >> return Nothing)+    p_build = do+      p_power; colon+      number; symbol "Supply centers,"+      number; symbol "Units:"+      (symbol "Builds" <|> symbol "Removes"); _ <- number+      (try (symbol "units") <|> symbol "unit"); period+    number = lexeme decimal++simplifyError :: Either ParseError a -> Either String a+simplifyError (Left x) = Left $ show x+simplifyError (Right a) = Right a++parseFullFile :: GenParser Char () a -> SourceName -> IO (Either ParseError a)+parseFullFile p = parseFromFile (do x <- p; eof; return x)++parseFileTurn :: SourceName -> IO (Either String Turn)+parseFileTurn = liftM simplifyError . parseFullFile p_turn++parseFileTurns :: SourceName -> IO (Either String [Turn])+parseFileTurns = liftM simplifyError . parseFullFile (many1 p_turn)++dipLanguage :: LanguageDef st+dipLanguage = emptyDef {+  identStart  = identStart emptyDef <|> oneOf "()",+  identLetter = identLetter emptyDef <|> oneOf "()",+  opStart  = oneOf ":-.(*",+  opLetter = opStart dipLanguage <|> oneOf ">*)",+  reservedNames  = ["SUPPORT", "CONVOY", "HOLD"] ++ powerNames,+  reservedOpNames = [":", "::", "->", ".", "(*", "*)"]+}+lexer :: P.TokenParser ()+lexer = P.makeTokenParser dipLanguage+whiteSpace :: CharParser () ()+whiteSpace = P.whiteSpace lexer+++lexeme :: CharParser () a -> CharParser () a+lexeme = P.lexeme lexer+reservedOp :: String -> CharParser () ()+reservedOp = P.reservedOp lexer+reserved :: String -> CharParser () ()+reserved = P.reserved lexer+identifier :: CharParser () String+identifier = P.identifier lexer+symbol :: String -> CharParser () String+symbol = P.symbol lexer+colon :: CharParser () String+colon  = P.colon lexer+comma :: CharParser () String+comma  = P.comma lexer+period :: CharParser () String+period = P.dot lexer+decimal :: CharParser () Integer+decimal = P.decimal lexer+-- natural = P.natural lexer++-- vim: set ts=2 sw=2 et :
+ src/Main.hs view
@@ -0,0 +1,75 @@+-- hsdip -- a diplomacy parser/renderer.+-- Copyright (C) 2006 Evan Martin <martine@danga.com>++module Main(main) where++import Data.List+import System.IO+import System.Environment+import System.Exit+import Text.ParserCombinators.Parsec.Pos (SourceName)++import Conf+-- import Diplomacy+import JudgeParser+import qualified Render++die :: String -> IO a+die str = do putStrLn str; exitFailure; error "notreached"++okOrDie :: IO (Either String a) -> IO a+okOrDie cmd = cmd >>= either die return++data SubCommand = SubCommand {+  cmdName :: String,+  cmdHelp :: String,+  cmdRun  :: [String] -> IO ()+}+instance Show SubCommand where+  show s = cmdName s++subcommands :: [SubCommand]+subcommands = [+  SubCommand "parse" "rulesfile" doParse,+  SubCommand "render" "rulesfile output.png" doRender+  ]++doParse :: [Text.ParserCombinators.Parsec.Pos.SourceName]+                                       -> IO ()+doParse args = do+  infile <- case args of+              [x] -> return x+              _   -> die "parse expects on argument"+  turn <- okOrDie $ JudgeParser.parseFileTurns infile+  print turn++doRender :: [Text.ParserCombinators.Parsec.Pos.SourceName]+                                        -> IO ()+doRender args = do+  conf <- okOrDie $ Conf.parseFile "data/conf"+  (infile, outfile) <- case args of+                         [x,y] -> return (x,y)+                         _     -> die "render expects two arguments"+  turn <- okOrDie $ JudgeParser.parseFileTurn infile+  print turn+  Render.renderTurnToFile conf turn outfile++usage :: String+usage =+  "usage: render mode [modeargs]\n" +++  "modes are:\n" +++    concatMap (\sc -> "  " ++ cmdName sc ++ " " +++                      cmdHelp sc ++ "\n") subcommands++main :: IO ()+main = do+  args <- getArgs+  (mode, ags) <- case args of+                    (m:a) -> return (m, a)+                    _     -> die usage+  command <- case find (\s -> cmdName s == mode) subcommands of+               Just c  -> return c+               Nothing -> die usage+  cmdRun command ags++-- vim: set ts=2 sw=2 et :
+ src/Render.hs view
@@ -0,0 +1,211 @@+-- hsdip -- a diplomacy parser/renderer.+-- Copyright (C) 2006 Evan Martin <martine@danga.com>++module Render (+  renderTurnToFile+) where++-- import JudgeParser+import Diplomacy+import Conf+import Graphics.Rendering.Cairo+--import Control.Monad++type Color = (Double, Double, Double)++setSourceRGBt :: Color -> Render ()+setSourceRGBt (r, g, b) = setSourceRGB r g b++-- fillWith :: forall a. Render a -> Render ()+-- fillWith r   = newPath >> r >> fill++strokeWith :: Render a -> Render ()+strokeWith r = newPath >> r >> stroke++moveToV :: (Double, Double) -> Render ()+moveToV = uncurry moveTo++lineToV :: (Double, Double) -> Render ()+lineToV = uncurry lineTo++circleV :: (Double, Double) -> Double -> Render ()+circleV pt rad = (uncurry arc) pt rad 0 (2*pi)++shade :: t -> (t, t, t)+shade x = (x,x,x)++white :: (Num t) =>  (t, t, t)+white = shade 1++gray :: (Fractional t) => (t, t, t)+gray  = shade 0.8++black :: (Num t) => (t, t, t)+black = shade 0++data PowerProperties = PowerProperties {+  pPowerColor :: Color, pPowerText :: Color, pPowerBorder :: Color,+  pPowerLetter :: String+}+props :: Power -> PowerProperties+props Austria = PowerProperties (1,0,0) white black "A"+props England = PowerProperties (0,0,1) white black "E"+props France  = PowerProperties (0,1,1) black black "F"+props Germany = PowerProperties (0,0,0) white gray  "G"+props Italy   = PowerProperties (0,1,0) black black "I"+props Russia  = PowerProperties (1,1,1) black black "R"+props Turkey  = PowerProperties (1,1,0) black black "T"++powerColor :: Power -> Color+powerColor  = pPowerColor  . props+-- powerText :: Power -> Color+-- powerText   = pPowerText   . props+powerBorder :: Power -> Color+powerBorder = pPowerBorder . props+-- powerLetter :: Power -> String+-- powerLetter = pPowerLetter . props++renderTitle :: String -> Render ()+renderTitle title = do+  selectFontFace "Times New Roman" FontSlantNormal FontWeightNormal+  setFontSize 100+  setSourceRGBt black+  moveTo 10 100+  showText title++-- centerText :: String -> Render ()+-- centerText text = do+--   extents <- textExtents text+--   let centerx = -1 + negate (textExtentsWidth extents / 2.0)+--   let centery = textExtentsHeight extents / 2.0+--   moveTo centerx centery+--   showText text++renderUnit :: Power -> Unit -> Render ()+renderUnit power units = rUnit units {- >> rText -} where+  rUnit unts = do+    setSourceRGBt (powerColor power); rShape unts; fill+    setSourceRGBt (powerBorder power); rShape unts; stroke+  rShape Army  = circleV (0, 0) armyRadius+  rShape Fleet = rectangle (-w/2) (-h/2) w h where (w, h) = fleetDimensions+--   rText = do+--     selectFontFace "Sans" FontSlantNormal FontWeightBold+--     setFontSize fontSize+--     setSourceRGBt (powerText power)+--     centerText (powerLetter power)+--  fontSize :: Int+--  fontSize = 14+  armyRadius = 10+  fleetDimensions = (40, 20)++renderUnits :: Conf -> Power -> [(Unit, Location)] -> Render ()+renderUnits conf power unitpos = do+  mapM_ tRenderUnitPos unitpos+  where+    tRenderUnitPos (unit, position) = do+      save; uncurry translate (locXY conf position);+      renderUnit power unit; restore++type XY = (Double, Double)++vlen :: (Floating t) => (t, t) -> t+vlen (vx, vy) = sqrt (vx**2 + vy**2)++norm :: (Floating t) => (t, t) -> (t, t)+norm v@(vx, vy) = (vx/l, vy/l) where l = vlen v++vleft :: (Num a) => (t, a) -> (a, t)+vleft  (vx, vy) = (-vy, vx)++vright :: (Num a) => (a, t) -> (t, a)+vright (vx, vy) = (vy, -vx)++(+.) :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1)+(ax, ay) +. (bx, by) = (ax+bx, ay+by)++(-.) :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1)+(ax, ay) -. (bx, by) = (ax-bx, ay-by)++(*.) :: (Num a) => a -> (a, a) -> (a, a)+a *. (bx, by) = (a*bx, a*by)++drawArrow :: Bool -> XY -> XY -> Render ()+drawArrow failure src dst = do+  let vec = dst -. src+  let forward = norm vec+  let left = vleft forward+  let right = vright forward+  let tal = src +. (12 *. forward)+  let tip = dst -. (shyFraction *. vec)+--  let side = headWidth *. forward+  let neck = tip -. (headLength *. forward)+  let arrowshape = do+        newPath+        -- tail+        moveToV $ tal +. (tailSize *. left)+        lineToV $ tal +. ((tailSize/2) *. forward)+        lineToV $ tal +. (tailSize *. right)+        -- neck+        lineToV $ neck +. (neckWidth *. right)+        lineToV $ neck +. (headWidth *. right) +. ((-2) *. forward)+        lineToV $ tip+        lineToV $ neck +. (headWidth *. left) +. ((-2) *. forward)+        lineToV $ neck +. (neckWidth *. left)+        closePath+  if failure then do+      setSourceRGBt gray;  arrowshape; fill+      setSourceRGBt black; arrowshape; stroke+    else do+      setSourceRGBt black; arrowshape; fill+      setSourceRGBt gray;  arrowshape; stroke++  where+    shyFraction = 0.08  -- amount to shy away from src/target+    headLength = 15 -- length of arrow head+    headWidth = 10  -- width of arrow head+    neckWidth = 2+    tailSize = 5++-- given a move, return the point where the move would be supported.+supportPoint :: Conf -> UnitMove -> XY+supportPoint conf (UnitMove (_, source) move) = s move where+  s Hold            = locXY conf source+  s (Attack target) = (sx + (tx-sx) / 2, sy + (ty-sy) / 2) where+                        (sx,sy) = locXY conf source+                        (tx,ty) = locXY conf target++renderMoveTry :: Conf -> UnitMoveTry -> Render ()+renderMoveTry conf (UnitMove (_, source) move, failure) = do+  setDash (if failure then [8, 4] else []) 0+  r move+  where+    r Hold            = return ()+    r (Attack target) = drawArrow failure (locXY conf source) (locXY conf target)+    r (Support mov)  = do let pt = supportPoint conf mov+                          setSourceRGBt black+                          strokeWith $ do+                             moveToV $ locXY conf source+                             lineToV pt+                          strokeWith $ circleV pt 5+    r (Convoy _) = return ()++renderTurn :: Conf -> Turn -> Render ()+renderTurn conf (Turn name _ units moves _) = do+  renderTitle name+  mapM_ (uncurry (renderUnits conf)) units+  mapM_ (\(_, movs) -> mapM_ (renderMoveTry conf) movs) moves++renderTurnToFile :: Conf -> Turn -> FilePath -> IO ()+renderTurnToFile conf turn outfile = do+  withImageSurfaceFromPNG "data/map.png" $ \image -> do+    (width, height) <- renderWith image $ do+      width  <- imageSurfaceGetWidth image+      height <- imageSurfaceGetHeight image+      return (width, height)+    withImageSurface FormatARGB32 width height $ \surface -> do+      renderWith surface $ do+        --save; setSourceSurface image 0 0; paint; restore+        renderTurn conf turn+      surfaceWriteToPNG surface outfile++-- vim: set ts=2 sw=2 et :
+ test/ConfTest.hs view
@@ -0,0 +1,13 @@+-- hsdip -- a diplomacy parser/renderer.+-- Copyright (C) 2006 Evan Martin <martine@danga.com>++import qualified Conf++main = do+  res <- Conf.parseFile "conf"+  case res of+    Left err -> print err+    Right conf -> print conf+  return ()++-- vim: set ts=2 sw=2 et :
+ test/Test.hs view
@@ -0,0 +1,12 @@+-- hsdip -- a diplomacy parser/renderer.+-- Copyright (C) 2006 Evan Martin <martine@danga.com>++import qualified JudgeParser+import Test.HUnit++main :: IO ()+main = do+  runTestTT $ TestList [JudgeParser.tests]+  return ()++-- vim: set ts=2 sw=2 et :