ACF7: Add one pick hammer in crate
Players often reported to screw up with the pick hammer, which is quite annoying.
With one pick hammer more, this mission should be slightly less annoying.
{-# LANGUAGE OverloadedStrings #-}module Confuse whereimport Numericimport Data.Charimport Control.Monadimport qualified Data.ByteString as Bimport qualified Data.ByteString.UTF8 as UTF8import qualified Data.Map as Maphx :: [Char] -> Stringhx cs = let ch = (chr . fst . last . readHex $ cs) in case ch of '\'' -> "''" '\\' -> "\\\\" c -> c : []conv :: String -> B.ByteStringconv s = B.concat ["('", UTF8.fromString i, "', '", UTF8.fromString r, "')"] where i :: String i = hx s r :: String r = concatMap hx . words . takeWhile ((/=) ';') . tail $ dropWhile ((/=) '\t') sconvRules :: (B.ByteString, [B.ByteString]) -> B.ByteStringconvRules (a, b) = B.concat ["<reset>", u a, "</reset>\n<s>", B.concat $ map u b, "</s>"] where u a = B.concat ["\\","u",a]toPair :: String -> (B.ByteString, [B.ByteString])toPair s = (UTF8.fromString $ takeWhile isHexDigit s, map UTF8.fromString . words . takeWhile ((/=) ';') . tail $ dropWhile ((/=) '\t') s)main = do ll <- liftM (filter (isHexDigit . head) . filter (not . null) . lines) $ readFile "confusables.txt" B.writeFile "rules.txt" . B.intercalate "\n" . map convRules . Map.toList . Map.fromList . filter notTooLong . filter fits16bit . map toPair $ ll where notTooLong = (>) 6 . length . snd fits16bit (a, b) = let f = (>) 5 . B.length in all f $ a:b