103 lines
3.6 KiB
Haskell
103 lines
3.6 KiB
Haskell
{-# LANGUAGE OverloadedStrings, NamedFieldPuns #-}
|
|
|
|
module Formatter (
|
|
prettyFormatState
|
|
, prettyFormatState'
|
|
, prettyPrintState
|
|
, prettyPrintState'
|
|
) where
|
|
|
|
import Base (State(..), Address)
|
|
import Memory (getMemAdr)
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.IO as T
|
|
import Data.String (fromString)
|
|
|
|
data PrinterConfig = PrinterConfig { cellCountHorizontal :: Int
|
|
, cellRowsAbove :: Int
|
|
, cellRowsBelow :: Int
|
|
}
|
|
deriving (Read, Show, Eq)
|
|
|
|
defaultPrinterConfig = PrinterConfig { cellCountHorizontal = 7
|
|
, cellRowsAbove = 0
|
|
, cellRowsBelow = 0
|
|
}
|
|
|
|
divideBy2IntoInts :: Bool -> Int -> (Int, Int)
|
|
divideBy2IntoInts preferLeft n = if preferLeft then (ceiling x, floor x) else (floor x, ceiling x)
|
|
where
|
|
x = fromIntegral n / 2.0
|
|
|
|
createSideCell :: Bool -> Address -> Int -> T.Text
|
|
createSideCell isLeft addr value = fromString str
|
|
where
|
|
topLength = length $ show addr
|
|
innerLength = length $ show value
|
|
len = max topLength innerLength
|
|
|
|
topLen2 = divideBy2IntoInts True (len - topLength)
|
|
fstTopSpc = replicate (fst topLen2) '─'
|
|
sndTopSpc = replicate (snd topLen2) '─'
|
|
|
|
innerLen2 = divideBy2IntoInts True (len - innerLength)
|
|
fstInnerSpc = replicate (fst innerLen2) ' '
|
|
sndInnerSpc = replicate (snd innerLen2) ' '
|
|
|
|
l x = if isLeft then x else ""
|
|
r x = if isLeft then "" else x
|
|
|
|
str = l "┬" ++ fstTopSpc ++ "[" ++ show addr ++ "]" ++ sndTopSpc ++ r "┬" ++ "\n"
|
|
++ l "│" ++ " " ++ fstInnerSpc ++ show value ++ sndInnerSpc ++ " " ++ r "│" ++ "\n"
|
|
++ l "┴" ++ replicate (len + 2) '─' ++ r "┴"
|
|
|
|
createLeftCell = createSideCell True
|
|
createRightCell = createSideCell False
|
|
|
|
createMidCell :: Address -> Int -> T.Text
|
|
createMidCell addr value = fromString str
|
|
where
|
|
topLength = length $ show addr
|
|
innerLength = length $ show value
|
|
len = max topLength innerLength
|
|
|
|
topLen2 = divideBy2IntoInts True (len - topLength)
|
|
fstTopSpc = replicate (fst topLen2) '─'
|
|
sndTopSpc = replicate (snd topLen2) '─'
|
|
|
|
innerLen2 = divideBy2IntoInts True (len - innerLength)
|
|
fstInnerSpc = replicate (fst innerLen2) ' '
|
|
sndInnerSpc = replicate (snd innerLen2) ' '
|
|
|
|
str = "╦" ++ fstTopSpc ++ "[" ++ show addr ++ "]" ++ sndTopSpc ++ "╦\n"
|
|
++ "║ " ++ fstInnerSpc ++ show value ++ sndInnerSpc ++ " ║\n"
|
|
++ "╩" ++ replicate (len + 2) '═' ++ "╩"
|
|
|
|
mergeTextBlocks :: T.Text -> T.Text -> T.Text
|
|
mergeTextBlocks a b = T.unlines $ zipWith T.append (T.lines a) (T.lines b)
|
|
|
|
prettyFormatState :: PrinterConfig -> State -> T.Text
|
|
prettyFormatState
|
|
c@PrinterConfig { cellCountHorizontal, cellRowsAbove, cellRowsBelow }
|
|
s@State {memory, codePos}
|
|
= foldl1 mergeTextBlocks cells
|
|
where
|
|
cellsAround = divideBy2IntoInts False (cellCountHorizontal - 1)
|
|
|
|
fetchCellWithOffset offset = getMemAdr memory $ codePos + offset
|
|
|
|
cells :: [T.Text]
|
|
cells = map (\x -> createLeftCell (codePos + x) (fetchCellWithOffset x)) [(negate (fst cellsAround))..(-1)]
|
|
++ [createMidCell codePos (fetchCellWithOffset 0) ]
|
|
++ map (\x -> createRightCell (codePos + x) (fetchCellWithOffset x)) [(snd cellsAround)..3]
|
|
|
|
prettyFormatState' :: State -> T.Text
|
|
prettyFormatState' = prettyFormatState defaultPrinterConfig
|
|
|
|
prettyPrintState :: PrinterConfig -> State -> IO ()
|
|
prettyPrintState c s = T.putStrLn $ prettyFormatState c s
|
|
|
|
prettyPrintState' :: State -> IO ()
|
|
prettyPrintState' s = T.putStrLn $ prettyFormatState' s
|