{-# LANGUAGE BangPatterns #-}

{-|
Module      : Dep.Bricks.Karnaugh
Description : A module to render Karnaugh cards in an interactive way.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

A module to render, update, and interact with Karnaugh cards.
-}

module Dep.Bricks.Karnaugh (
    renderKarnaugh, renderKarnaugh'
  ) where

import Data.List(transpose)

import Dep.Algorithm.Synthesis(synthesis)
import Dep.Bricks.Utils(fromRaster, inRaster')  -- harrow', varrow'
import Dep.Class.Renderable(CharRenderable(charRenderItem))
import Dep.Data.Product(SumOfProducts)
import Dep.Data.Three(Three(Leaf, Link, Split), depth, leftmost)
import Dep.Data.ThreeValue(ThreeValue)
import Dep.Utils(Operator)

import Graphics.Vty.Attributes(Attr)
import Graphics.Vty.Image(Image, (<->), string)  -- , (<->), (<|>), char, safeWcswidth, string)

type KLine = String
type KRaster = [KLine]

hmask :: Char -> Char -> Char -> Int -> Int -> String
hmask :: Char -> Char -> Char -> Int -> Int -> String
hmask Char
c0 Char
ci Char
cn = Int -> Int -> String
go
  where go :: Int -> Int -> String
go Int
n Int
m = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
c0 Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
m Char
ci String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
cn]

hvar :: String -> Int -> Int -> String
hvar :: String -> Int -> Int -> String
hvar String
st Int
n Int
m = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
stInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
2) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
st

-- twig :: Attr -> Int -> Image
-- twig atr n = foldMap ((<|> char atr '\x2572') . string atr . (`replicate` ' ')) [0 .. n-1]

flipFrameH :: Char -> Char
flipFrameH :: Char -> Char
flipFrameH Char
'\x250f' = Char
'\x2517'
flipFrameH Char
'\x2517' = Char
'\x250f'
flipFrameH Char
'\x2513' = Char
'\x251b'
flipFrameH Char
'\x251b' = Char
'\x2513'
flipFrameH Char
'\x252f' = Char
'\x2537'
flipFrameH Char
'\x2537' = Char
'\x252f'
flipFrameH Char
c = Char
c

flipFrameV :: Char -> Char
flipFrameV :: Char -> Char
flipFrameV Char
'\x250f' = Char
'\x2513'
flipFrameV Char
'\x2513' = Char
'\x250f'
flipFrameV Char
'\x2517' = Char
'\x251b'
flipFrameV Char
'\x251b' = Char
'\x2517'
flipFrameV Char
'\x2520' = Char
'\x2528'
flipFrameV Char
'\x2528' = Char
'\x2520'
flipFrameV Char
c = Char
c

mapFrameH :: String -> String
mapFrameH :: String -> String
mapFrameH = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
flipFrameH

mapFrameV :: String -> String
mapFrameV :: String -> String
mapFrameV = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
flipFrameV

_mergeVertical :: KLine -> KRaster -> Int -> Operator KRaster
_mergeVertical :: String -> KRaster -> Int -> Operator KRaster
_mergeVertical String
spt KRaster
spb Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4 = Operator KRaster
go
  | Bool
otherwise = Operator KRaster
go'
  where cyspt :: [b] -> String
cyspt = (Char -> b -> Char) -> String -> [b] -> String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> b -> Char
forall a b. a -> b -> a
const String
spt
        cyspb :: [b] -> KRaster
cyspb = KRaster -> KRaster
forall a. [[a]] -> [[a]]
transpose (KRaster -> KRaster) -> ([b] -> KRaster) -> [b] -> KRaster
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> b -> String) -> KRaster -> [b] -> KRaster
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> b -> String
forall a b. a -> b -> a
const KRaster
spb
        go :: Operator KRaster
go ([], []) = []
        go (xs :: KRaster
xs@(String
x:KRaster
_), []) = KRaster
xs KRaster -> KRaster -> KRaster
forall a. [a] -> [a] -> [a]
++ [String -> String
forall b. [b] -> String
cyspt String
x]
        go (KRaster
xs, ys :: KRaster
ys@(String
y:KRaster
_)) = KRaster
xs KRaster -> KRaster -> KRaster
forall a. [a] -> [a] -> [a]
++ String -> String
forall b. [b] -> String
cyspt String
y String -> KRaster -> KRaster
forall a. a -> [a] -> [a]
: KRaster -> KRaster
forall a. [a] -> [a]
reverse KRaster
ys
        go' :: Operator KRaster
go' ([], []) = []
        go' (xs :: KRaster
xs@(String
x:KRaster
_), []) = KRaster
xs KRaster -> KRaster -> KRaster
forall a. [a] -> [a] -> [a]
++ String -> KRaster
forall b. [b] -> KRaster
cyspb String
x
        go' (KRaster
xs, ys :: KRaster
ys@(String
y:KRaster
_)) = KRaster
xs KRaster -> KRaster -> KRaster
forall a. [a] -> [a] -> [a]
++ String -> KRaster
forall b. [b] -> KRaster
cyspb String
y KRaster -> KRaster -> KRaster
forall a. [a] -> [a] -> [a]
++ (String -> String) -> KRaster -> KRaster
forall a b. (a -> b) -> [a] -> [b]
map String -> String
mapFrameH (KRaster -> KRaster
forall a. [a] -> [a]
reverse KRaster
ys)


_mergeHorizontal :: KLine -> KRaster -> Int -> Operator KRaster
_mergeHorizontal :: String -> KRaster -> Int -> Operator KRaster
_mergeHorizontal String
spl KRaster
spr Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4 = (KRaster -> KRaster -> KRaster) -> Operator KRaster
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Char -> String -> String -> String)
-> String -> KRaster -> KRaster -> KRaster
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Char -> String -> String -> String
forall a. a -> [a] -> [a] -> [a]
f String
spl)
  | Bool
otherwise = (KRaster -> KRaster -> KRaster) -> Operator KRaster
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> String -> String -> String)
-> KRaster -> KRaster -> KRaster -> KRaster
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 String -> String -> String -> String
f' KRaster
spr)
  where f :: a -> [a] -> [a] -> [a]
f a
sp [a]
xs [a]
ys = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
sp a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys
        f' :: String -> String -> String -> String
f' String
sp String
xs String
ys = String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
mapFrameV (String -> String
forall a. [a] -> [a]
reverse String
ys)

_recurse :: CharRenderable a => (Int -> Operator KRaster) -> (Int -> Operator KRaster) -> Int -> Three a -> KRaster
_recurse :: (Int -> Operator KRaster)
-> (Int -> Operator KRaster) -> Int -> Three a -> KRaster
_recurse Int -> Operator KRaster
ma Int -> Operator KRaster
mb !Int
n = Three a -> KRaster
go
      where fn :: Three a -> KRaster
fn = (Int -> Operator KRaster)
-> (Int -> Operator KRaster) -> Int -> Three a -> KRaster
forall a.
CharRenderable a =>
(Int -> Operator KRaster)
-> (Int -> Operator KRaster) -> Int -> Three a -> KRaster
_recurse Int -> Operator KRaster
mb Int -> Operator KRaster
ma (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
            man :: Operator KRaster
man = Int -> Operator KRaster
ma Int
n
            go :: Three a -> KRaster
go Three a
l |
              Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [[a -> Char
forall a. CharRenderable a => a -> Char
charRenderItem (Three a -> a
forall a. Three a -> a
leftmost Three a
l)]]  -- leftmost is used to prevent cases with multiple items
            go l :: Three a
l@(Leaf a
_) = let fnl :: KRaster
fnl = Three a -> KRaster
fn Three a
l in Operator KRaster
man (KRaster
fnl, KRaster
fnl)
            go (Link Three a
l) = let fnl :: KRaster
fnl = Three a -> KRaster
fn Three a
l in Operator KRaster
man (KRaster
fnl, KRaster
fnl)
            go ~(Split Three a
la Three a
lb) = Operator KRaster
man (Three a -> KRaster
fn Three a
la, Three a -> KRaster
fn Three a
lb)

_horizontalThin :: String
_horizontalThin :: String
_horizontalThin = String -> String
forall a. [a] -> [a]
cycle String
"\x2502\x253c"

_horizontalThick :: [String]
_horizontalThick :: KRaster
_horizontalThick = KRaster -> KRaster
forall a. [a] -> [a]
cycle [String
"\x2503 \x2503", String
"\x2528 \x2520", String
"\x2503 \x2503", String
"\x2528 \x2520", String
"\x2503 \x2503", String
"\x2528 \x2520", String
"\x2503 \x2503", String
"\x251b \x2517", String
"   ", String
"\x2513 \x250f"]

_verticalThin :: String
_verticalThin :: String
_verticalThin = String -> String
forall a. [a] -> [a]
cycle String
"\x2500\x253c"

_verticalThick :: [String]
_verticalThick :: KRaster
_verticalThick = KRaster -> KRaster
forall a. [a] -> [a]
cycle [String
"\x2501 \x2501", String
"\x2537 \x252f", String
"\x2501 \x2501", String
"\x2537 \x252f", String
"\x2501 \x2501", String
"\x2537 \x252f", String
"\x2501 \x2501", String
"\x251b \x2513", String
"   ", String
"\x2517 \x250f"]

-- | Render the given 'Three' as a /Karnaugh/ card, that can
-- also visualize the /sum-of-product/.
renderKarnaugh'
  :: Three ThreeValue  -- ^ The given 'Three' to render as a /Karnaugh card/.
  -> [String]  -- ^ The names of the variables that are rendered. If there are no sufficient variables, it will work with x₀, x₁, x₂, etc.
  -> Attr  -- ^ The base 'Attr'ibute to render the /Karnaugh card/.
  -> Image  -- ^ The image that contains a rendered version of the /Karnaugh card/.
renderKarnaugh' :: Three ThreeValue -> KRaster -> Attr -> Image
renderKarnaugh' = Three ThreeValue -> SumOfProducts -> KRaster -> Attr -> Image
forall a.
CharRenderable a =>
Three a -> SumOfProducts -> KRaster -> Attr -> Image
renderKarnaugh (Three ThreeValue -> SumOfProducts -> KRaster -> Attr -> Image)
-> (Three ThreeValue -> SumOfProducts)
-> Three ThreeValue
-> KRaster
-> Attr
-> Image
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Three ThreeValue -> SumOfProducts
synthesis

-- | Render the given 'Three' as a /Karnaugh/ card, that can
-- also visualize the /sum-of-product/.
renderKarnaugh :: CharRenderable a
  => Three a  -- ^ The given 'Three' to render as a /Karnaugh card/.
  -> SumOfProducts -- ^ The sum of products that will be used to mark the /Karnaugh card/.
  -> [String]  -- ^ The names of the variables that are rendered. If there are no sufficient variables, it will work with x₀, x₁, x₂, etc.
  -> Attr  -- ^ The base 'Attr'ibute to render the /Karnaugh card/.
  -> Image  -- ^ The image that contains a rendered version of the /Karnaugh card/.
renderKarnaugh :: Three a -> SumOfProducts -> KRaster -> Attr -> Image
renderKarnaugh Three a
ts SumOfProducts
_ KRaster
_ Attr
atr = Attr -> String -> Image
string Attr
atr (String -> Int -> Int -> String
hvar String
"x\x2080" Int
10 Int
7) Image -> Image -> Image
<-> Attr -> String -> Image
string Attr
atr (Char -> Char -> Char -> Int -> Int -> String
hmask Char
'\x251c' Char
'\x2500' Char
'\x2524' Int
10 Int
7) Image -> Image -> Image
<-> Attr -> String -> Image
string Attr
atr (String -> Int -> Int -> String
hvar String
"x\x2081" Int
4 Int
9) Image -> Image -> Image
<-> Attr -> String -> Image
string Attr
atr (Char -> Char -> Char -> Int -> Int -> String
hmask Char
'\x251c' Char
'\x2500' Char
'\x2524' Int
4 Int
9) Image -> Image -> Image
<-> Attr -> KRaster -> Image
fromRaster Attr
atr (KRaster -> KRaster
inRaster' KRaster
recs)
-- renderKarnaugh ts _ _ atr = foldr ((<->) . string atr) emptyImage (addBottomMark "x\x2083" (addTopMark "x\x2081" (addLeftMark "x\x2082" (addRightMark "x\x2084" (inRaster' recs)))))
  where dpt :: Int
dpt = Three a -> Int
forall a. Three a -> Int
depth Three a
ts
        recs :: KRaster
recs = ((Int -> Operator KRaster)
 -> (Int -> Operator KRaster) -> Int -> Three a -> KRaster)
-> (Int -> Operator KRaster)
-> (Int -> Operator KRaster)
-> Int
-> Three a
-> KRaster
forall a. a -> a
swapit (Int -> Operator KRaster)
-> (Int -> Operator KRaster) -> Int -> Three a -> KRaster
forall a.
CharRenderable a =>
(Int -> Operator KRaster)
-> (Int -> Operator KRaster) -> Int -> Three a -> KRaster
_recurse (String -> KRaster -> Int -> Operator KRaster
_mergeHorizontal String
_horizontalThin KRaster
_horizontalThick) (String -> KRaster -> Int -> Operator KRaster
_mergeVertical String
_verticalThin KRaster
_verticalThick) Int
dpt Three a
ts
        swapit :: a -> a
swapit | Int -> Bool
forall a. Integral a => a -> Bool
even Int
dpt = a -> a
forall a. a -> a
id
               | Bool
otherwise = a -> a
forall a. a -> a
id