diff options
| -rw-r--r-- | Crosswords.icl | 54 | ||||
| -rw-r--r-- | README.md | 8 |
2 files changed, 43 insertions, 19 deletions
diff --git a/Crosswords.icl b/Crosswords.icl index 038dc5b..324f484 100644 --- a/Crosswords.icl +++ b/Crosswords.icl @@ -2,6 +2,7 @@ module Crosswords import StdEnv, StdDebug, StdOverloadedList import MersenneTwister +import ArgEnv instance + String where (+) x y = x +++ y @@ -24,28 +25,33 @@ instance zero Crossword where zero = [] :: RandomSeed :== Int -dictionary :== "dictionary.txt" - // Reads words from stdin (end with empty line) and builds a crossword that // connects all these words (if possible); then fills the crossword with words // from dict-3-6.txt. Outputs LaTeX code (uses cwpuzzle.dtx from the crossword // package). Start w -# (rand,w) = time 0 w -# (fillwords,w) = readFillWords w +// Read dictionary +# cmd = getCommandLine +# dictionary = if (size cmd > 1) cmd.[1] "dictionary.txt" +# (fillwords,w) = readFillWords dictionary w # fillwords = sortl fillwords +// Read input # (io,w) = stdio w # (words,io) = readWords [] io # (ok,w) = fclose io w +| not ok = abort "Couldn't close stdio\n" +// Make crossword +# (rand,w) = time 0 w +# rand = if (size cmd > 2) (toInt cmd.[2]) rand # cw = makeCrossword rand words # cw = trace_n ("\nIntermediate:\n" + toString cw) cw # cw = fill rand fillwords cw # cw = trace_n ("\nResult:\n" + toString cw) cw -= toLaTeX cw += toLaTeX False cw where - readFillWords :: *World -> *([[#Char]], *World) - readFillWords w - # (ok,f,w) = fopen dictionary FReadText w + readFillWords :: String *World -> *([[#Char]], *World) + readFillWords fname w + # (ok,f,w) = fopen fname FReadText w | not ok = ([], w) # (words,f) = readWords [] f # (ok,w) = fclose f w @@ -72,8 +78,8 @@ miny cw :== minList [wp.y \\ wp <- cw] maxx cw :== maxList [minx cw:[wp.x+Length wp.word-1 \\ wp<-cw | wp.dir==Hor]] maxy cw :== maxList [miny cw:[wp.y+Length wp.word-1 \\ wp<-cw | wp.dir==Ver]] -toLaTeX :: Crossword -> String -toLaTeX cw +toLaTeX :: Bool Crossword -> String +toLaTeX fillBorders cw = "\\begin{Puzzle}{" + toString width + "}{" + toString height + "}%\n" + tex (minx cw) (miny cw) 1 (fromString (toString cw)) + "\\end{Puzzle}\n" @@ -82,9 +88,14 @@ where height = maxy cw - miny cw + 1 tex :: Int Int Int [Char] -> String - tex _ _ _ [] = "" - tex x y n [' ':cs] = "|* " + tex (x+1) y n cs - tex x y n ['\n':cs] = "|.\n" + tex (minx cw) (y+1) n cs + tex _ _ _ [] + = "" + tex x y n [' ':cs] + | pathToBorder [] x y && not fillBorders + = "|{} " + tex (x+1) y n cs + = "|* " + tex (x+1) y n cs + tex x y n ['\n':cs] + = "|.\n" + tex (minx cw) (y+1) n cs tex x y n [c:cs] | occ (x+1) y && not (occ (x-1) y) || occ x (y+1) && not (occ x (y-1)) = "|[" + toString n + "]" + {c} + pad + " " + tex (x+1) y (n+1) cs @@ -94,6 +105,19 @@ where occ :: Int Int -> Bool occ x y = any (any (\(_,x`,y`) -> x`==x && y`==y) o poss) cw + pathToBorder :: [(Int,Int)] Int Int -> Bool + pathToBorder seen x y + | isMember (x,y) seen = False + | occ x y = False + | x <= minx cw || x >= maxx cw = True + | y <= miny cw || y >= maxy cw = True + = any + (app2 (pathToBorder [(x,y):seen])) + [(x-1,y),(x+1,y),(x,y-1),(x,y+1)] + where + app2 :: (a a -> b) (a,a) -> b + app2 f (x,y) = f x y + instance toString Crossword where toString cw = foldl (+) "" @@ -139,7 +163,7 @@ where // Make a crossword, try to lay all words connected makeCrossword :: RandomSeed [[#Char]] -> Crossword -makeCrossword r words = place r fits words 0 zero +makeCrossword r words = place r fits (sortl words) 0 zero // Place a number of words in a crossword, satisfying a predicate place :: RandomSeed PlacementOK [[#Char]] Int Crossword -> Crossword @@ -160,7 +184,7 @@ placements :: RandomSeed PlacementOK [#Char] Crossword -> [WordPlacement] placements _ fits word [] = [{word=word, dir=Hor, x=0, y=0}] placements r fits word cw = (flatten o flatten) [[[wp - \\ wp <- [{word=word,dir=Hor,x=x-i,y=y},{word=word,dir=Ver,x=x,y=y-i}] + \\ wp <- [if (fixedwp.dir == Ver) {word=word,dir=Hor,x=x-i,y=y} {word=word,dir=Ver,x=x,y=y-i}] | fits wp cw] \\ (x,y) <- letterPositions letter fixedwp] \\ letter <|- word & i <- [0..], fixedwp <- shuffle r cw] @@ -1,7 +1,7 @@ # Crosswords Crossword generator tool - + ### Features @@ -18,15 +18,15 @@ Crossword generator tool ### Installation - $ clm -I $CLEAN_HOME/lib/MersenneTwister -b -h 100M Crosswords -o cwgen + $ clm -I $CLEAN_HOME/lib/ArgEnv -I $CLEAN_HOME/lib/MersenneTwister -b -h 100M Crosswords -o cwgen ### Usage example Words are read from stdin, ended with an empty line or `EOF`, and of course from the dictionary installed. The example above was created with the words -`crossword`, `english` and `puzzling`. +`newspaper`, `crossword`, `english` and `puzzling`. - $ ./cwgen < words.txt > cw-gen.tex + $ ./cwgen [dictionary.txt] < words.txt > cw-gen.tex $ pdflatex cw.tex Remove `\PuzzleSolution[true]` from `cw.tex` to not show the solution in the |