done

Makefile

@@ -9,4 +9,5 @@ run: main
 	./${OUT}
 
 clean:
+	-rm *.hi *.o
 	-rm ${OUT}

main.hs

@@ -1,11 +1,19 @@
-import System.IO
+import Numeric
 import Data.Char
-import System.Console.ANSI
 import System.Random
-import Control.Monad.IO.Class
 import System.Random.Shuffle
+import System.IO
+import System.Console.ANSI
+import Control.Monad
 
-target_words =
+-- Settings:
+startingLifes, tableSize :: Int
+startingLifes = 4
+tableSize     = 32
+
+-- Static data
+targetWords :: [String]
+targetWords =
   [ "mutate"
   , "dubbed"
   , "repair"
@@ -17,111 +25,210 @@ target_words =
   , "wagons"
   , "subtle"
   , "carved"
+  , "banana"
+  , "guitar"
+  , "temple"
+  , "frozen"
+  , "candle"
+  , "rocket"
+  , "spring"
+  , "sunset"
+  , "rhythm"
+  , "yellow"
+  , "zephyr"
+  , "jigsaw"
+  , "quasar"
+  , "fluffy"
+  , "whale" 
+  , "glitch"
+  , "pickle"
+  , "planet"
+  , "rabbit"
+  , "silent"
+  , "thirst"
+  , "violet"
+  , "waffle"
+  , "summer"
+  , "breeze"
+  , "flame" 
+  , "rocket"
+  , "dragon"
+  , "bucket"
+  , "palace"
+  , "shadow"
+  , "thorny"
+  , "window"
+  , "fierce"
+  , "ocean" 
+  , "whisky"
+  , "forest"
+  , "python"
+  , "garden"
+  , "humble"
+  , "jungle"
+  , "kettle"
+  , "mellow"
+  , "noodle"
+  , "pickle"
+  , "quartz"
+  , "rattle"
+  , "sizzle"
+  , "tender"
+  , "unique"
+  , "velvet"
+  , "wombat"
+  , "yogurt"
   ]
 
-garbage = "$@#`|:=;_-<>()[]{}%+*^/\\!?'\""
+garbage :: String
+garbage = "$@#`|:=;-<>()[]{}%+*^/\\!?'\""
 
-solution_index = 3
+--
-table_size = 32
+entryWidth :: Int
-entry_width = 12
+entryWidth = 12
-starting_lifes = 4
 
+--
+data GameHand = GameHand
+  { start            :: Int
+  , entries          :: [String]
+  , litteredEntries :: [String]
+  , solution         :: String
+  } deriving Show
 
 likeness :: Eq a => [a] -> [a] -> Int
 likeness [] _ = 0
 likeness _ [] = 0
 likeness (g:gx) (l:lx) = (if g == l then 1 else 0) + (likeness gx lx)
 
-fake_hex' :: String -> String
+truncatedHex' :: String -> String
-fake_hex' s
+truncatedHex' s
-  | len < 4 = fake_hex' ("0" ++ s)
+  | len <  4 = truncatedHex' ("0" ++ s)
   | len == 4 = "0x" ++ s
   where len = length s
-fake_hex :: Int -> String
+truncatedHex :: Int -> String
-fake_hex i
+truncatedHex i
-  | len < 4 = fake_hex' ("0" ++ (show i))
+  | len <  4 = truncatedHex' $ "0" ++ h
-  | len > 4 = fake_hex (mod i 10000)
+  | len >  4 = truncatedHex  $ i' `mod` (16^4 - tableSize)
-  | len == 4 = fake_hex' (show i)
+  | len == 4 = truncatedHex' $ h
-  where len = length (show i)
+  where
+    { i'  = abs i
+    ; h   = showHex i' ""
+    ; len = length h
+    }
 
-garbage_char :: IO Char
+garbageChar :: IO Char
-garbage_char = do
+garbageChar = do
   rindex <- randomIO :: IO Int
   return $ garbage !! (mod rindex (length garbage))
 
-garbage_entry' :: Int -> [IO Char] -> [IO Char]
+garbageEntry' :: Int -> [IO Char] -> [IO Char]
-garbage_entry' i s
+garbageEntry' i s
-  | i > 0 = [garbage_char] ++ (garbage_entry' (i - 1) s)
+  | i > 0 = [garbageChar] ++ (garbageEntry' (i - 1) s)
   | otherwise = s
 
-garbage_entry :: [IO Char]
+garbageEntry :: [IO Char]
-garbage_entry = garbage_entry' entry_width []
+garbageEntry = garbageEntry' entryWidth []
 
-litter_entry :: String -> IO String
+litterRight :: String -> IO String
-litter_entry e
+litterRight e
-  | (length e) < entry_width = do a <- garbage_char
+  | (length e) < entryWidth = do
-	  litter_entry (e ++ [a])
+    { a <- garbageChar
+    ; litterRight (e ++ [a])
+    }
   | otherwise = return e
 
-litter_entries :: [String] -> IO [String]
+litterEntry' :: String -> Int -> IO String
-litter_entries l
+litterEntry' e i
-  | (length l) < table_size = do a <- sequence garbage_entry; litter_entries (l ++ [a])
+  | i > 0 = do
-  | otherwise = do a <- sequence garbage_entry; return l
+    { a <- garbageChar
+    ; litterEntry' ([a] ++ e) (i - 1)
+    }
+  | otherwise = litterRight e
 
-render_entry :: Int -> String -> String
+litterEntry :: String -> IO String
-render_entry i w =
+litterEntry e = do
-  (fake_hex i) ++ " " ++ w
+  r <- randomIO :: IO Int
+  let i = (r `mod` entryWidth - (length e))
+  litterEntry' e i
  
-render_odd, render_even, render_entries :: Int -> [String] -> String
+litterEntries :: [String] -> IO [String]
-render_odd i [] = ""
+litterEntries l
-render_odd i (l:ls) =
+  | (length l) < tableSize = do
-  (render_entry i l) ++ " " ++ (render_even (i + 1) ls)
+    { a <- sequence garbageEntry
-render_even i [] = ""
+    ; litterEntries (l ++ [a])
-render_even i (l:ls) =
+    }
-  (render_entry i l) ++ "\n" ++ (render_odd (i + 1) ls)
+  | otherwise = do
-render_entries i l =
+    { a <- sequence garbageEntry
-  render_odd i l
+    ; return l
+    }
 
-print_console :: [String] -> IO ()
+renderEntry :: Int -> String -> String
-print_console l = do
+renderEntry i w =
-  rng <- newStdGen
+  (truncatedHex i) ++ " " ++ w
-  start <- randomIO :: IO Int
-  entries <- litter_entries target_words
-  entries <- (mapM litter_entry entries)
-  putStr $ render_entries start (shuffle' entries (length entries) rng)
 
-print_lifes' :: Int -> IO ()
+renderOdd, renderEven, renderEntries :: Int -> [String] -> String
-print_lifes' i
+renderOdd i [] = ""
-  | i > 0 = do putStr " #"; print_lifes' (i - 1)
+renderOdd i (l:ls) =
+  (renderEntry i l) ++ " " ++ (renderEven (i + entryWidth) ls)
+renderEven i [] = ""
+renderEven i (l:ls) =
+  (renderEntry i l) ++ "\n" ++ (renderOdd (i + entryWidth) ls)
+renderEntries i l =
+  renderOdd i l
+
+printConsole :: GameHand -> IO ()
+printConsole s = do
+  putStr $ renderEntries (start s) (litteredEntries s)
+
+printLifes, printLifes' :: Int -> IO ()
+printLifes' i
+  | i > 0 = do 
+    { putStr " #"
+    ; printLifes' (i - 1)
+    }
   | otherwise = putStrLn ""
-  
+printLifes i = do
-
-print_lifes :: Int -> IO ()
-print_lifes i = do
   putStr "Attempts remaining:"
-  print_lifes' i
+  printLifes' i
 
-game_cycle :: Int -> IO ()
+gameCycle :: Int -> GameHand -> IO ()
-game_cycle i = do
+gameCycle i s = do
   putStrLn "Password Required"
   putStrLn ""
-  print_lifes i
+  printLifes i
   putStrLn ""
-  print_console target_words
+  printConsole s
-  putStr "$:"
+  putStr ">"
   hFlush stdout
-  guess_index <- readLn :: IO Int
+  guess <- getLine
-  let guess = target_words !! (guess_index - 1)
+  putStrLn ""
-  let solution = target_words !! solution_index
+  putStrLn $ ">" ++ (map toUpper guess)
-  print $ ">" ++ (map toUpper guess)
+  if guess == (solution s) then do
-  if guess == solution then
+    putStrLn ""
-    print "I'm in!"
+    putStrLn "> Password Accepted."
   else do
-    print ">Entry denied."
+    putStrLn ">Entry denied."
-    print $ ">Likeness=" ++ show (likeness guess solution)
+    let l = likeness guess (solution s)
-    game_cycle (i - 1)
+    when (elem guess (entries s)) $ putStrLn $ ">Likeness=" ++ show l
+    putStrLn ""
+    putStrLn ""
+    when (i > 1) $ gameCycle (i - 1) s
 
 main :: IO ()
 main = do
   setSGR [SetConsoleIntensity BoldIntensity, SetColor Foreground Dull Yellow]
-  game_cycle starting_lifes
+  seed <- randomIO :: IO Int
+  i    <- randomIO :: IO Int
+  let ronnie   = mkStdGen seed
+  let e        = take 12 (shuffle' targetWords (length targetWords) ronnie)
+  e' <- litterEntries e
+  e' <- mapM litterEntry e'
+  let e''           = shuffle' e' (length e') ronnie
+  let solutionIndex = i `mod` (length targetWords)
+  gameCycle startingLifes (GameHand
+    { entries          = e
+    , litteredEntries  = e''
+    , start            = seed
+    , solution         = targetWords !! solutionIndex
+    }
+    )