diff options
| author | Justus Winter <4winter@informatik.uni-hamburg.de> | 2015-08-18 19:07:54 +0200 | 
|---|---|---|
| committer | Justus Winter <4winter@informatik.uni-hamburg.de> | 2015-08-18 19:07:54 +0200 | 
| commit | a15ce7db6e8cdc9a860bdc3163b95f0dd925f662 (patch) | |
| tree | a8f0c7fe42b040c17a1f32b5b5653f207eecee00 | |
| parent | ae7023ba666bbac6a02d9b8fbd9a33083bc944e3 (diff) | |
| -rw-r--r-- | puzzle.hs | 83 | 
1 files changed, 79 insertions, 4 deletions
@@ -1,3 +1,19 @@ +-- +-- Copyright (c) 2014 Justus Winter <4winter@informatik.uni-hamburg.de> +-- +-- Permission to use, copy, modify, and distribute this software for any +-- purpose with or without fee is hereby granted, provided that the above +-- copyright notice and this permission notice appear in all copies. +-- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +-- +  {-# LANGUAGE DeriveDataTypeable #-}  module Main where @@ -6,13 +22,17 @@ import Control.Monad (when)  import Data.Array (Array, array, bounds, (!), (//))  import Data.Functor ((<$>))  import Data.Maybe -import Data.List (sort) +import Data.List (sort, intersperse)  import Data.Ord (compare)  import Data.Char (toUpper) +import Debug.Trace (traceShow)  import System.Console.CmdArgs (Data, Typeable, cmdArgs) +import System.IO (hPutStrLn, stderr)  import System.Random (RandomGen, getStdGen, split, randomR, randomRs)  import System.Random.Shuffle +traceShow' x = traceShow x x +  -- Vectors to represent position and orientation.  data Vec = Vec { x::Int, y::Int } deriving (Show, Eq) @@ -113,7 +133,7 @@ insertAll rnd (w:ws) b = do    b' <- insert w (pose $ sort moves !! nth) b    insertAll rnd' ws b'    where -    (nth, rnd') = randomR (0, min 10 (length moves)) rnd +    (nth, rnd') = randomR (0, min 10 (length moves - 1)) rnd      moves = mapMaybe (\x -> tryInsert w x b) shuffled      shuffled = shuffle' all (length all) rnd      all = allPoses b @@ -125,16 +145,71 @@ fill rnd b = b // zip [(x, y) | x <- [sX..eX], y <- [sY..eY], (b ! (x, y)) == em         ((sX, sY), (eX, eY)) = bounds b  data Puzzle = Puzzle { blanks :: Bool +                     , latex :: Bool +                     , pages :: Int                       , dimension :: (Int, Int)                       } deriving (Data, Typeable, Show)  main :: IO ()  main = do -  args <- cmdArgs $ Puzzle False (30, 30) +  args <- cmdArgs $ Puzzle False False 1 (30, 30)    rnd <- getStdGen    c <- getContents -  let guests = lines (map toUpper c) in +  let guests = lines (map toUpper c) +  if latex args then +      generateLatex rnd (mkBoard (28, 39)) guests (pages args) +  else      case (showBoard . (if blanks args then id else fill rnd)) <$> insertAll rnd guests (mkBoard $ dimension args) of        Just s -> putStr s        Nothing -> putStr "goesnt" +-- LaTeX generation ahead. +texBoard :: Board -> String +texBoard b = +  unlines $ map ((++ "\\\\") . intersperse '&') $ lines $ showBoard b + +generateLatex :: (RandomGen gen) => gen -> Board -> [String] -> Int -> IO () +generateLatex rnd b ws c = do +  putStr latexHeader +  generateLatexPage rnd b ws c +    where +      generateLatexPage _ _ _ 0 = putStr latexFooter +      generateLatexPage rnd b ws c = do +        hPutStrLn stderr $ show c ++ " more puzzles to go..." +        case (texBoard . fill rnd) <$> insertAll rnd ws b of +          Just s -> do +            putStr pageHeader +            putStr s +            putStr pageFooter +            when (c > 1) $ putStr "\\newpage\n" +            generateLatexPage rnd' b ws (c - 1) +          Nothing -> generateLatexPage rnd'' b ws c +          where +            (rnd', rnd'') = split rnd + +latexHeader = unlines ["\\documentclass[11pt, a4paper]{article}" +                      ,"\\usepackage{libertine}" +                      ,"\\usepackage[cm]{fullpage}" +                      ,"\\usepackage{tikz}" +                      ,"\\usetikzlibrary{matrix,backgrounds}" +                      ,"\\begin{document}" +                      ] +latexFooter = "\\end{document}" + +pageHeader = unlines ["\\thispagestyle{empty}" +                     ,"\\center" +                     ,"\\Huge" +                     ,"ABC-Konwaenschn-Puzzle" +                     ,"\\normalsize" +                     ,"\\\\" +                     ,"\\vspace{1cm}" +                     ,"\\begin{tikzpicture}" +                     ,"  \\matrix(m)[" +                     ,"    matrix of nodes," +                     ,"    every node/.append style={minimum size=2ex, inner sep=4pt}," +                     ,"  ]{" +                     ] +pageFooter = unlines ["  };" +                     ,"\\end{tikzpicture}" +                     ,"Waagerecht und senkrecht verstecken sich nette Menschen! Findest du sie?  Findest du sie auf der Convention?" +                     ]  | 
