Generate random key sequences with lcg

3 files changed, 35 insertions, 31 deletions

diff --git a/specs/Specs/KeySequenceSpec.hs b/specs/Specs/KeySequenceSpec.hs
index 707646d..2efbece 100644
--- a/specs/Specs/KeySequenceSpec.hs
+++ b/specs/Specs/KeySequenceSpec.hs
@@ -1,6 +1,7 @@
 module Specs.KeySequenceSpec where
 
-import Chelleport.KeySequence (findMatchPosition, generateKeyCells, nextChars)
+import Chelleport.KeySequence (findMatchPosition, generateGrid, nextChars)
+import qualified Debug.Trace as Debug
 import Test.Hspec
 
 test = do
@@ -22,22 +23,15 @@ test = do
         nextChars "FOO" [["XYZ", "ABC"], ["AMK", "BBL", "ABD"]]
           `shouldBe` Nothing
 
-  describe "#generateKeyCells" $ do
+  describe "#generateGrid" $ do
     it "generates grid of key sequences" $ do
-      generateKeyCells (4, 4) "ABCDEF"
-        `shouldBe` [ ["HKA", "HKB", "LKA", "LKB"],
-                     ["HKC", "HKD", "LKC", "LKD"],
-                     ["HJA", "HJB", "LJA", "LJB"],
-                     ["HJC", "HJD", "LJC", "LJD"]
-                   ]
+      generateGrid 0 (4, 4) "ABCDEF"
+        `shouldBe` Just [["AE", "BD", "CC", "BB"], ["AC", "FD", "EE", "EC"], ["FB", "EA", "DF", "DD"], ["CA", "DB", "CE", "BF"]]
+
     context "when the the keys set is too short" $ do
       it "cycles back to first character" $ do
-        generateKeyCells (4, 4) "AB"
-          `shouldBe` [ ["HKA", "HKB", "LKA", "LKB"],
-                       ["HKA", "HKB", "LKA", "LKB"],
-                       ["HJA", "HJB", "LJA", "LJB"],
-                       ["HJA", "HJB", "LJA", "LJB"]
-                     ]
+        generateGrid 0 (4, 4) "AB"
+          `shouldBe` Nothing
 
   describe "#findMatchPosition" $ do
     it "returns the position of the matching key sequence" $ do
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 82188b9..cb0ed84 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -7,6 +7,8 @@ import Chelleport.KeySequence (eventToKeycode, findMatchPosition, generateGrid,
 import Chelleport.Types
 import Chelleport.Utils (intToCInt)
 import qualified Chelleport.View
+import Data.List ((\\))
+import Data.Maybe (fromMaybe)
 import qualified SDL
 
 open :: IO ()
@@ -14,12 +16,12 @@ open = setupAppShell initialState update eventToAction Chelleport.View.render
 
 initialState :: DrawContext -> IO State
 initialState _ctx = do
-  let cells = generateGrid (rows, columns) hintKeys
+  let cells = fromMaybe (pure undefined) $ generateGrid 0 (rows, columns) hintKeys
   pure $ State {stateGrid = cells, stateKeySequence = []}
   where
     rows = 12
     columns = 12
-    hintKeys = "ABCDEFGHIJKLMNOPRSTUVWXYZ1234567890"
+    hintKeys = ['A' .. 'Z'] \\ "Q"
 
 update :: Update State AppAction
 update state _ctx (FilterSequence key) =
diff --git a/src/Chelleport/KeySequence.hs b/src/Chelleport/KeySequence.hs
index f112b57..9f7b5db 100644
--- a/src/Chelleport/KeySequence.hs
+++ b/src/Chelleport/KeySequence.hs
@@ -25,22 +25,30 @@ findMatchPosition keySequence = findWithIndex searchRows 0
 isValidKey :: SDL.Keycode -> Bool
 isValidKey = (`Map.member` keycodeMapping)
 
-generateKeyCells :: (Int, Int) -> KeySequence -> KeyGrid
-generateKeyCells (rows, columns) hintKeys =
-  (\row -> getCellSeq row <$> [1 .. columns]) <$> [1 .. rows]
+-- Linear Congruential Generator
+lcg :: Int -> Int
+lcg seed = (a * seed + c) `mod` fromIntegral m
   where
-    getCellSeq row col = [getPrefixHoriz row col, getPrefixVert row col, getKey row col]
-    getKey row col = hintKeys !! index
-      where
-        index = (secRow * (columns `div` 2) + secCol) `mod` length hintKeys
-        secCol = (col - 1) `mod` (columns `div` 2)
-        secRow = (row - 1) `mod` (rows `div` 2)
-    getPrefixHoriz _row col
-      | col <= (columns `div` 2) = 'H'
-      | otherwise = 'L'
-    getPrefixVert row _col
-      | row <= (rows `div` 2) = 'K'
-      | otherwise = 'J'
+    a = 1664525
+    c = 1013904223
+    m = (2 :: Integer) ^ (32 :: Integer)
+
+getIndexRounded :: Int -> [a] -> a
+getIndexRounded i ls = ls !! (i `mod` length ls)
+
+generateGrid :: Int -> (Int, Int) -> KeySequence -> Maybe KeyGrid
+generateGrid seed (rows, columns) hintKeys
+  | rows * columns > length hintKeys * length hintKeys = Nothing
+  | otherwise = Just $ (\row -> getKeySeq row <$> [0 .. columns - 1]) <$> [0 .. rows - 1]
+  where
+    allKeySeq = take numPairs . uniq $ generatePairs
+    numPairs = rows * columns
+    getKeySeq row col = allKeySeq !! (row * columns + col)
+    randomNumbers = iterate lcg seed
+    generatePairs =
+      [ [getIndexRounded i hintKeys, getIndexRounded j hintKeys]
+        | (i, j) <- zip randomNumbers (drop numPairs randomNumbers)
+      ]
 
 toKeyChar :: SDL.Keycode -> Maybe Char
 toKeyChar = (`Map.lookup` keycodeMapping)