72 lines
3.4 KiB
Haskell
72 lines
3.4 KiB
Haskell
module Main (main) where
|
||
|
||
import Codec.Picture
|
||
import qualified Data.Vector.Unboxed as VU
|
||
import Lib
|
||
|
||
|
||
caesarShift :: Int
|
||
caesarShift = 66
|
||
|
||
bitsPerByte :: Int
|
||
bitsPerByte = 1
|
||
|
||
sourceTextPath :: String
|
||
sourceTextPath = "resources/biography.txt"
|
||
sourceImagePath :: String
|
||
sourceImagePath = "resources/david.bmp"
|
||
encodedImagePath :: String
|
||
encodedImagePath = "tmp/david_" ++ show caesarShift ++ ".bmp"
|
||
decodedTextPath :: String
|
||
decodedTextPath = "tmp/biography.txt"
|
||
|
||
main :: IO ()
|
||
main = do
|
||
putStrLn $ "Чтение текста из файла \"" ++ sourceTextPath ++ "\""
|
||
inputText <- readFile sourceTextPath
|
||
putStrLn $ "10 символов текста: \"" ++ take 10 inputText ++ "\""
|
||
|
||
putStrLn "\nШифрование текста"
|
||
let alphabet = createAlphabetFromText inputText
|
||
putStrLn $ "Размер алфавита: " ++ show (length alphabet)
|
||
let encryptedText = encryptCaesar alphabet caesarShift inputText
|
||
putStrLn $ "10 символов шифра: \"" ++ take 10 encryptedText ++ "\""
|
||
let encryptedTextBits = textToBits encryptedText
|
||
putStrLn $ "10 битов шифра: \"" ++ show (take 10 $ VU.toList encryptedTextBits) ++ "\""
|
||
|
||
putStrLn "\nКодирование текста в изображение"
|
||
readSourceImageResult <- readImage sourceImagePath
|
||
case readSourceImageResult of
|
||
Left err -> putStrLn $ "Ошибка при чтении изображения: " ++ err
|
||
Right dynImg -> do
|
||
let img = convertRGB8 dynImg
|
||
let width = imageWidth img
|
||
let height = imageHeight img
|
||
let totalBits = width * height * 3 * bitsPerByte
|
||
let bits = encryptedTextBits VU.++ VU.replicate (totalBits - VU.length encryptedTextBits) 0
|
||
|
||
let resultImage = generateImage (encodePixel bitsPerByte img bits) width height
|
||
saveBmpImage encodedImagePath (ImageRGB8 resultImage)
|
||
putStrLn $ "Изображение сохранено по пути: \"" ++ encodedImagePath ++ "\""
|
||
|
||
|
||
putStrLn "\nДекодирование текста из изображения"
|
||
case extractShift encodedImagePath of
|
||
Just extractedCaesarShift -> do
|
||
putStrLn $ "Из названия файла извлечён ключ: " ++ show extractedCaesarShift
|
||
|
||
readEncodedImageResult <- readImage encodedImagePath
|
||
case readEncodedImageResult of
|
||
Left err -> putStrLn $ "Ошибка при чтении изображения: " ++ err
|
||
Right dynImg -> do
|
||
let img = convertRGB8 dynImg
|
||
let bits = VU.fromList $ extractBitsFromImage bitsPerByte img
|
||
putStrLn $ "10 битов шифра: \"" ++ show (take 10 $ VU.toList bits) ++ "\""
|
||
let encryptedTextFromImage = takeWhile (/= '\NUL') (bitsToText bits)
|
||
putStrLn $ "10 символов шифра: \"" ++ take 10 encryptedTextFromImage ++ "\""
|
||
let decryptedText = decryptCaesar alphabet extractedCaesarShift encryptedTextFromImage
|
||
putStrLn $ "10 символов текста: \"" ++ take 10 decryptedText ++ "\""
|
||
writeFile decodedTextPath decryptedText
|
||
putStrLn $ "Текст сохранён по пути: \"" ++ decodedTextPath ++ "\""
|
||
|
||
Nothing -> putStrLn "Не удалось извлечь ключ." |