Дешифровка текста из картинки

lab3/app/Main.hs

@@ -14,21 +14,18 @@ bitsPerByte = 1
 
 main :: IO ()
 main = do
+    putStrLn "Чтение текста из файла \"resources/biography.txt\""    
     inputText <- readFile "resources/biography.txt"
-    putStrLn $ take 30 inputText
-    let alphabet = createAlphabetFromText inputText
-    putStrLn $ show (length alphabet)
-    let encryptedText = encryptCaesar alphabet caesarShift inputText
-    putStrLn $ take 30 encryptedText
-    let encryptedTextBits = textToBits encryptedText
-    putStrLn $ concat (take 30 (map show (VU.toList encryptedTextBits)))
-    let encryptedTextFromBits = bitsToText encryptedTextBits
-    putStrLn $ take 30 encryptedTextFromBits
-    let decryptedText = decryptCaesar alphabet caesarShift encryptedTextFromBits
-    putStrLn $ take 30 decryptedText
 
-    readImageResult <- readImage "resources/david.bmp"
-    case readImageResult of
+    putStrLn "\nШифрование текста"    
+    let alphabet = createAlphabetFromText inputText
+    putStrLn $ "Размер алфавита: " ++ show (length alphabet)
+    let encryptedText = encryptCaesar alphabet caesarShift inputText
+    let encryptedTextBits = textToBits encryptedText
+
+    putStrLn "\nКодирование текста в изображение"
+    readSourceImageResult <- readImage "resources/david.bmp"
+    case readSourceImageResult of
         Left err -> putStrLn $ "Ошибка при чтении изображения: " ++ err
         Right dynImg -> do
             let img = convertRGB8 dynImg
@@ -39,3 +36,16 @@ main = do
 
             let resultImage = generateImage (encodePixel bitsPerByte img bitsPadded) width height
             saveBmpImage "tmp/david.bmp" (ImageRGB8 resultImage)
+
+
+    putStrLn "\nДекодирование текста из изображения"
+    readEncodedImageResult <- readImage "tmp/david.bmp"
+    case readEncodedImageResult of
+        Left err -> putStrLn $ "Ошибка при чтении изображения: " ++ err
+        Right dynImg -> do
+            let img = convertRGB8 dynImg
+            let bits = VU.fromList $ extractBitsFromImage bitsPerByte img
+            let fullText = bitsToText bits
+            let encryptedTextFromImage = takeWhile (/= '\NUL') fullText
+            let decryptedText = decryptCaesar alphabet caesarShift encryptedTextFromImage
+            writeFile "tmp/biography.txt" decryptedText

lab3/src/Lib.hs

@@ -95,3 +95,21 @@ encodePixel bitsPerByte img bits x y = PixelRGB8 newR newG newB
         newR = intToWord8 $ ((word8ToInt r) .&. mask) .|. bitsIntR
         newG = intToWord8 $ ((word8ToInt g) .&. mask) .|. bitsIntG
         newB = intToWord8 $ ((word8ToInt b) .&. mask) .|. bitsIntB
+
+extractBits :: Int -> Pixel8 -> [Int]
+extractBits bitsPerByte pixelByte = 
+    [ if testBit pixelByte i then 1 else 0 | i <- [bitsPerByte-1, bitsPerByte-2..0] ] 
+
+extractBitsFromPixel :: Int -> PixelRGB8 -> [Int]
+extractBitsFromPixel bitsPerByte (PixelRGB8 r g b) =
+    let bitsR = extractBits bitsPerByte r
+        bitsG = extractBits bitsPerByte g
+        bitsB = extractBits bitsPerByte b
+    in bitsR ++ bitsG ++ bitsB
+
+extractBitsFromImage :: Int -> Image PixelRGB8 -> [Int]
+extractBitsFromImage bitsPerByte img = 
+    let width = imageWidth img
+        height = imageHeight img
+        pixels = [ pixelAt img x y | y <- [0..height - 1], x <- [0..width - 1] ]
+    in concatMap (extractBitsFromPixel bitsPerByte) pixels