83 lines
4.4 KiB
Haskell
83 lines
4.4 KiB
Haskell
module Main (main) where
|
||
|
||
import Text.Read (readMaybe)
|
||
import Codec.Picture
|
||
import qualified Data.Vector.Unboxed as VU
|
||
import Lib
|
||
|
||
|
||
main :: IO ()
|
||
main = do
|
||
putStrLn "Введите значение сдвига для шифра Цезаря:"
|
||
inputCaesarShift <- getLine
|
||
let caesarShift = case readMaybe inputCaesarShift of
|
||
Just value -> value
|
||
Nothing -> error "Ожидалось целое число!"
|
||
|
||
putStrLn "Введите количество бит для кодирования:"
|
||
inputBitsPerByte <- getLine
|
||
let bitsPerByte = case readMaybe inputBitsPerByte of
|
||
Just value -> value
|
||
Nothing -> error "Ожидалось целое число!"
|
||
|
||
let sourceTextPath = "resources/biography.txt"
|
||
let sourceImagePath = "resources/david.bmp"
|
||
let alphabetPath = "tmp/alphabet.txt"
|
||
let encryptedTextPath = "tmp/biography_encrypted.txt"
|
||
let encodedImagePath = "tmp/david_" ++ show bitsPerByte ++ "_" ++ show caesarShift ++ ".bmp"
|
||
let decodedTextPath = "tmp/biography.txt"
|
||
|
||
putStrLn $ "\nЧтение текста из файла \"" ++ sourceTextPath ++ "\""
|
||
inputText <- readFile sourceTextPath
|
||
putStrLn $ "10 символов текста: \"" ++ take 10 inputText ++ "\""
|
||
|
||
putStrLn "\nШифрование текста"
|
||
let alphabet = createAlphabetFromText inputText
|
||
putStrLn $ "Размер алфавита: " ++ show (length alphabet)
|
||
writeFile alphabetPath alphabet
|
||
putStrLn $ "Алфавит сохранён в файл \"" ++ alphabetPath ++ "\""
|
||
let encryptedText = encryptCaesar alphabet caesarShift inputText
|
||
putStrLn $ "10 символов шифра: \"" ++ take 10 encryptedText ++ "\""
|
||
writeFile encryptedTextPath encryptedText
|
||
putStrLn $ "Зашифрованный текст сохранён в файл \"" ++ encryptedTextPath ++ "\""
|
||
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Чтение алфавита из файла \"" ++ alphabetPath ++ "\""
|
||
alphabetFromFile <- readFile alphabetPath
|
||
|
||
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 alphabetFromFile extractedCaesarShift encryptedTextFromImage
|
||
putStrLn $ "10 символов текста: \"" ++ take 10 decryptedText ++ "\""
|
||
writeFile decodedTextPath decryptedText
|
||
putStrLn $ "Текст сохранён по пути: \"" ++ decodedTextPath ++ "\""
|
||
|
||
Nothing -> putStrLn "Не удалось извлечь ключ." |