Added android pattern lock schema.

src/Scat/Schemas.hs

@@ -18,9 +18,12 @@ module Scat.Schemas
     -- * Pass phrases
     , pokemons
     , diceware
+
+    -- * Pattern lock
+    , androidPatternLock
     ) where
 
-import Data.List (intercalate)
+import Data.List (intercalate, (\\))
 import Data.Vector (Vector)
 import qualified Data.Vector as V
 import Data.Monoid
@@ -75,6 +78,61 @@ alphanumeric = do
 pin :: Int -> Schema
 pin n = replicateM n digit
 
+
+-- | Generates an Android lock pattern, of specified length.
+androidPatternLock :: Int -> Schema
+androidPatternLock number = do
+    xs <- loop (min number (height * width)) []
+    return $ intercalate " - " $ map showPosition xs
+  where
+    -- Gets `n` points.
+    loop :: Int -> [(Int, Int)] -> Builder [(Int, Int)]
+    loop n xs | n <= 0 = return $ reverse xs
+    loop n xs = do
+        x <- oneOf $ possibilities xs
+        loop (n - 1) (x : xs)
+
+    -- Grid dimensions.
+    height = 3
+    width = 3
+
+    -- Text representation for a position.
+    showPosition (1, 1) = "center"
+    showPosition (i, j) = vshow i ++ hshow j
+      where
+        vshow 0 = "north"
+        vshow 1 = ""
+        vshow _ = "south"
+
+        hshow 0 = "west"
+        hshow 1 = ""
+        hshow _ = "east"
+
+    -- All positions.
+    allPositions = [(i, j) | i <- [0 .. height - 1], j <- [0 .. width - 1]]
+
+    {- Possible positions given a list of already used ones.
+       The head of the list is the last used position. -}
+    possibilities [] = allPositions
+    possibilities pps@(p : ps) = filter isPossible candidates
+      where
+        candidates = allPositions \\ pps
+
+        isPossible q = all (`elem` ps) $ interfere p q
+
+    -- The list of positions that are on the way between two positions.
+    interfere (i, j) (k, l) = do
+        r <- [1 .. steps - 1]
+        return (i + r * vstep, j + r * hstep)
+      where
+        vdiff = k - i
+        hdiff = l - j
+
+        steps = gcd vdiff hdiff
+
+        vstep = vdiff `div` steps
+        hstep = hdiff `div` steps
+
 {- | Generates a password with 4 of the original Pokemons and their level.
      Entropy of about 55.5 bits. -}
 pokemons :: IO Schema