init

Makefile

@@ -0,0 +1,12 @@
+.PHONY: run
+
+OUT := main
+
+main: main.hs
+	ghc -o ${OUT} main.hs
+
+run: main
+	./${OUT}
+
+clean:
+	-rm ${OUT}

main.hs

@@ -0,0 +1,127 @@
+import System.IO
+import Data.Char
+import System.Console.ANSI
+import System.Random
+import Control.Monad.IO.Class
+import System.Random.Shuffle
+
+target_words =
+  [ "mutate"
+  , "dubbed"
+  , "repair"
+  , "rugrat"
+  , "system"
+  , "human"
+  , "defend"
+  , "stream"
+  , "wagons"
+  , "subtle"
+  , "carved"
+  ]
+
+garbage = "$@#`|:=;_-<>()[]{}%+*^/\\!?'\""
+
+solution_index = 3
+table_size = 32
+entry_width = 12
+starting_lifes = 4
+
+
+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
+fake_hex' s
+  | len < 4 = fake_hex' ("0" ++ s)
+  | len == 4 = "0x" ++ s
+  where len = length s
+fake_hex :: Int -> String
+fake_hex i
+  | len < 4 = fake_hex' ("0" ++ (show i))
+  | len > 4 = fake_hex (mod i 10000)
+  | len == 4 = fake_hex' (show i)
+  where len = length (show i)
+
+garbage_char :: IO Char
+garbage_char = do
+  rindex <- randomIO :: IO Int
+  return $ garbage !! (mod rindex (length garbage))
+
+garbage_entry' :: Int -> [IO Char] -> [IO Char]
+garbage_entry' i s
+  | i > 0 = [garbage_char] ++ (garbage_entry' (i - 1) s)
+  | otherwise = s
+
+garbage_entry :: [IO Char]
+garbage_entry = garbage_entry' entry_width []
+
+litter_entry :: String -> IO String
+litter_entry e
+  | (length e) < entry_width = do a <- garbage_char
+	  litter_entry (e ++ [a])
+  | otherwise = return e
+ 
+litter_entries :: [String] -> IO [String]
+litter_entries l
+  | (length l) < table_size = do a <- sequence garbage_entry; litter_entries (l ++ [a])
+  | otherwise = do a <- sequence garbage_entry; return l
+
+render_entry :: Int -> String -> String
+render_entry i w =
+  (fake_hex i) ++ " " ++ w
+
+render_odd, render_even, render_entries :: Int -> [String] -> String
+render_odd i [] = ""
+render_odd i (l:ls) =
+  (render_entry i l) ++ " " ++ (render_even (i + 1) ls)
+render_even i [] = ""
+render_even i (l:ls) =
+  (render_entry i l) ++ "\n" ++ (render_odd (i + 1) ls)
+render_entries i l =
+  render_odd i l
+
+print_console :: [String] -> IO ()
+print_console l = do
+  rng <- newStdGen
+  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 ()
+print_lifes' i
+  | i > 0 = do putStr " #"; print_lifes' (i - 1)
+  | otherwise = putStrLn ""
+  
+
+print_lifes :: Int -> IO ()
+print_lifes i = do
+  putStr "Attempts remaining:"
+  print_lifes' i
+
+game_cycle :: Int -> IO ()
+game_cycle i = do
+  putStrLn "Password Required"
+  putStrLn ""
+  print_lifes i
+  putStrLn ""
+  print_console target_words
+  putStr "$:"
+  hFlush stdout
+  guess_index <- readLn :: IO Int
+  let guess = target_words !! (guess_index - 1)
+  let solution = target_words !! solution_index
+  print $ ">" ++ (map toUpper guess)
+  if guess == solution then
+    print "I'm in!"
+  else do
+    print ">Entry denied."
+    print $ ">Likeness=" ++ show (likeness guess solution)
+    game_cycle (i - 1)
+
+main :: IO ()
+main = do
+  setSGR [SetConsoleIntensity BoldIntensity, SetColor Foreground Dull Yellow]
+  game_cycle starting_lifes