{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Diagrams.Backend.Braille
(
Braille(..)
, B
, Options(..)
, rasterBraille
, renderBraille
, size
) where
import Codec.Picture
import Codec.Picture.Types (convertImage,
promoteImage)
import Control.Lens hiding ((#), transform)
import Control.Monad (when)
import Control.Monad.Reader (ReaderT, runReaderT, ask, local)
import Control.Monad.Writer (Writer, execWriter, tell)
import Data.Bits (setBit)
import Data.Char (chr)
import Data.Foldable (foldMap)
import Data.Hashable (Hashable(..))
import Data.Maybe (fromMaybe)
import Data.Tree
import Data.Typeable
import Diagrams.Backend.Rasterific.Text
import Diagrams.Core.Compile
import Diagrams.Core.Transform (matrixHomRep)
import Diagrams.Core.Types
import Diagrams.Prelude hiding (local)
import Diagrams.TwoD.Adjust (adjustDia2D)
import Diagrams.TwoD.Text hiding (Font)
import qualified Graphics.Rasterific as R
import Graphics.Rasterific.Texture (Gradient,
linearGradientTexture,
radialGradientWithFocusTexture,
transformTexture,
uniformTexture,
withSampler)
import qualified Graphics.Rasterific.Transformations as R
import System.FilePath (takeExtension)
data Braille = Braille deriving (Braille -> Braille -> Bool
(Braille -> Braille -> Bool)
-> (Braille -> Braille -> Bool) -> Eq Braille
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Braille -> Braille -> Bool
$c/= :: Braille -> Braille -> Bool
== :: Braille -> Braille -> Bool
$c== :: Braille -> Braille -> Bool
Eq, Eq Braille
Eq Braille
-> (Braille -> Braille -> Ordering)
-> (Braille -> Braille -> Bool)
-> (Braille -> Braille -> Bool)
-> (Braille -> Braille -> Bool)
-> (Braille -> Braille -> Bool)
-> (Braille -> Braille -> Braille)
-> (Braille -> Braille -> Braille)
-> Ord Braille
Braille -> Braille -> Bool
Braille -> Braille -> Ordering
Braille -> Braille -> Braille
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Braille -> Braille -> Braille
$cmin :: Braille -> Braille -> Braille
max :: Braille -> Braille -> Braille
$cmax :: Braille -> Braille -> Braille
>= :: Braille -> Braille -> Bool
$c>= :: Braille -> Braille -> Bool
> :: Braille -> Braille -> Bool
$c> :: Braille -> Braille -> Bool
<= :: Braille -> Braille -> Bool
$c<= :: Braille -> Braille -> Bool
< :: Braille -> Braille -> Bool
$c< :: Braille -> Braille -> Bool
compare :: Braille -> Braille -> Ordering
$ccompare :: Braille -> Braille -> Ordering
$cp1Ord :: Eq Braille
Ord, ReadPrec [Braille]
ReadPrec Braille
Int -> ReadS Braille
ReadS [Braille]
(Int -> ReadS Braille)
-> ReadS [Braille]
-> ReadPrec Braille
-> ReadPrec [Braille]
-> Read Braille
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Braille]
$creadListPrec :: ReadPrec [Braille]
readPrec :: ReadPrec Braille
$creadPrec :: ReadPrec Braille
readList :: ReadS [Braille]
$creadList :: ReadS [Braille]
readsPrec :: Int -> ReadS Braille
$creadsPrec :: Int -> ReadS Braille
Read, Int -> Braille -> ShowS
[Braille] -> ShowS
Braille -> String
(Int -> Braille -> ShowS)
-> (Braille -> String) -> ([Braille] -> ShowS) -> Show Braille
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Braille] -> ShowS
$cshowList :: [Braille] -> ShowS
show :: Braille -> String
$cshow :: Braille -> String
showsPrec :: Int -> Braille -> ShowS
$cshowsPrec :: Int -> Braille -> ShowS
Show, Typeable)
type B = Braille
type instance V Braille = V2
type instance N Braille = Double
type RenderM n = ReaderT (Style V2 n) (Writer Draw)
newtype Draw = Draw (R.Drawing PixelRGBA8 (), [((Int, Int), String)])
deriving (b -> Draw -> Draw
NonEmpty Draw -> Draw
Draw -> Draw -> Draw
(Draw -> Draw -> Draw)
-> (NonEmpty Draw -> Draw)
-> (forall b. Integral b => b -> Draw -> Draw)
-> Semigroup Draw
forall b. Integral b => b -> Draw -> Draw
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Draw -> Draw
$cstimes :: forall b. Integral b => b -> Draw -> Draw
sconcat :: NonEmpty Draw -> Draw
$csconcat :: NonEmpty Draw -> Draw
<> :: Draw -> Draw -> Draw
$c<> :: Draw -> Draw -> Draw
Semigroup, Semigroup Draw
Draw
Semigroup Draw
-> Draw
-> (Draw -> Draw -> Draw)
-> ([Draw] -> Draw)
-> Monoid Draw
[Draw] -> Draw
Draw -> Draw -> Draw
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Draw] -> Draw
$cmconcat :: [Draw] -> Draw
mappend :: Draw -> Draw -> Draw
$cmappend :: Draw -> Draw -> Draw
mempty :: Draw
$cmempty :: Draw
$cp1Monoid :: Semigroup Draw
Monoid)
tellR :: R.Drawing PixelRGBA8 () -> RenderM n ()
tellR :: Drawing PixelRGBA8 () -> RenderM n ()
tellR = Draw -> RenderM n ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Draw -> RenderM n ())
-> (Drawing PixelRGBA8 () -> Draw)
-> Drawing PixelRGBA8 ()
-> RenderM n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Drawing PixelRGBA8 (), [((Int, Int), String)]) -> Draw
Draw ((Drawing PixelRGBA8 (), [((Int, Int), String)]) -> Draw)
-> (Drawing PixelRGBA8 ()
-> (Drawing PixelRGBA8 (), [((Int, Int), String)]))
-> Drawing PixelRGBA8 ()
-> Draw
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,[((Int, Int), String)]
forall a. Monoid a => a
mempty)
tellT :: Int -> Int -> String -> RenderM n ()
tellT :: Int -> Int -> String -> RenderM n ()
tellT Int
x Int
y String
t = Draw -> RenderM n ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Draw -> RenderM n ()) -> Draw -> RenderM n ()
forall a b. (a -> b) -> a -> b
$ (Drawing PixelRGBA8 (), [((Int, Int), String)]) -> Draw
Draw (() -> Drawing PixelRGBA8 ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), [((Int
x, Int
y), String
t)])
runRenderM :: TypeableFloat n => RenderM n a -> Draw
runRenderM :: RenderM n a -> Draw
runRenderM = Writer Draw a -> Draw
forall w a. Writer w a -> w
execWriter (Writer Draw a -> Draw)
-> (RenderM n a -> Writer Draw a) -> RenderM n a -> Draw
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RenderM n a -> Style V2 n -> Writer Draw a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Style V2 n
sty) where
sty :: Style V2 n
sty = Style V2 n
forall a. Monoid a => a
mempty Style V2 n -> (Style V2 n -> Style V2 n) -> Style V2 n
forall a b. a -> (a -> b) -> b
# AlphaColour Double -> Style V2 n -> Style V2 n
forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
recommendFillColor AlphaColour Double
forall a. Num a => AlphaColour a
transparent Style V2 n -> (Style V2 n -> Style V2 n) -> Style V2 n
forall a b. a -> (a -> b) -> b
# Measure (N (Style V2 n)) -> Style V2 n -> Style V2 n
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
recommendFontSize (N (Style V2 n) -> Measure (N (Style V2 n))
forall n. n -> Measure n
output N (Style V2 n)
4)
instance TypeableFloat n => Backend Braille V2 n where
newtype Render Braille V2 n = R (RenderM n ())
type Result Braille V2 n = String
data Options Braille V2 n = BrailleOptions
{ Options Braille V2 n -> SizeSpec V2 n
_sizeSpec :: SizeSpec V2 n
} deriving (Int -> Options Braille V2 n -> ShowS
[Options Braille V2 n] -> ShowS
Options Braille V2 n -> String
(Int -> Options Braille V2 n -> ShowS)
-> (Options Braille V2 n -> String)
-> ([Options Braille V2 n] -> ShowS)
-> Show (Options Braille V2 n)
forall n. Show n => Int -> Options Braille V2 n -> ShowS
forall n. Show n => [Options Braille V2 n] -> ShowS
forall n. Show n => Options Braille V2 n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options Braille V2 n] -> ShowS
$cshowList :: forall n. Show n => [Options Braille V2 n] -> ShowS
show :: Options Braille V2 n -> String
$cshow :: forall n. Show n => Options Braille V2 n -> String
showsPrec :: Int -> Options Braille V2 n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Options Braille V2 n -> ShowS
Show, Options Braille V2 n -> Options Braille V2 n -> Bool
(Options Braille V2 n -> Options Braille V2 n -> Bool)
-> (Options Braille V2 n -> Options Braille V2 n -> Bool)
-> Eq (Options Braille V2 n)
forall n.
Eq n =>
Options Braille V2 n -> Options Braille V2 n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options Braille V2 n -> Options Braille V2 n -> Bool
$c/= :: forall n.
Eq n =>
Options Braille V2 n -> Options Braille V2 n -> Bool
== :: Options Braille V2 n -> Options Braille V2 n -> Bool
$c== :: forall n.
Eq n =>
Options Braille V2 n -> Options Braille V2 n -> Bool
Eq)
renderRTree :: Braille
-> Options Braille V2 n
-> RTree Braille V2 n Annotation
-> Result Braille V2 n
renderRTree Braille
_ Options Braille V2 n
opts RTree Braille V2 n Annotation
t =
(((Int, Int), String) -> ShowS)
-> String -> [((Int, Int), String)] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Int, Int), String) -> ShowS
drawText (Image PixelRGBA8 -> String
img2brl (Image PixelRGBA8 -> String) -> Image PixelRGBA8 -> String
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> PixelRGBA8 -> Drawing PixelRGBA8 () -> Image PixelRGBA8
forall px.
RenderablePixel px =>
Int -> Int -> px -> Drawing px () -> Image px
R.renderDrawing (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round n
w) (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round n
h) PixelRGBA8
bgColor Drawing PixelRGBA8 ()
r) [((Int, Int), String)]
txt
where
Draw (Drawing PixelRGBA8 ()
r, [((Int, Int), String)]
txt) = RenderM n () -> Draw
forall n a. TypeableFloat n => RenderM n a -> Draw
runRenderM (RenderM n () -> Draw)
-> (RTree Braille V2 n Annotation -> RenderM n ())
-> RTree Braille V2 n Annotation
-> Draw
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Render Braille V2 n -> RenderM n ()
forall n. Render Braille V2 n -> RenderM n ()
runR (Render Braille V2 n -> RenderM n ())
-> (RTree Braille V2 n Annotation -> Render Braille V2 n)
-> RTree Braille V2 n Annotation
-> RenderM n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTree Braille V2 n Annotation -> Render Braille V2 n
forall n.
TypeableFloat n =>
RTree Braille V2 n Annotation -> Render Braille V2 n
fromRTree (RTree Braille V2 n Annotation -> Draw)
-> RTree Braille V2 n Annotation -> Draw
forall a b. (a -> b) -> a -> b
$ RTree Braille V2 n Annotation
t
V2 n
w n
h = n -> SizeSpec V2 n -> V2 n
forall (v :: * -> *) n.
(Foldable v, Functor v, Num n, Ord n) =>
n -> SizeSpec v n -> v n
specToSize n
100 (Options Braille V2 n
optsOptions Braille V2 n
-> Getting (SizeSpec V2 n) (Options Braille V2 n) (SizeSpec V2 n)
-> SizeSpec V2 n
forall s a. s -> Getting a s a -> a
^.Getting (SizeSpec V2 n) (Options Braille V2 n) (SizeSpec V2 n)
forall n. Lens' (Options Braille V2 n) (SizeSpec V2 n)
sizeSpec)
bgColor :: PixelRGBA8
bgColor = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
0 Pixel8
0 Pixel8
0 Pixel8
0
adjustDia :: Braille
-> Options Braille V2 n
-> QDiagram Braille V2 n m
-> (Options Braille V2 n, Transformation V2 n,
QDiagram Braille V2 n m)
adjustDia Braille
c Options Braille V2 n
opts QDiagram Braille V2 n m
d = Lens' (Options Braille V2 n) (SizeSpec V2 n)
-> Braille
-> Options Braille V2 n
-> QDiagram Braille V2 n m
-> (Options Braille V2 n, Transformation V2 n,
QDiagram Braille V2 n m)
forall n m b.
(TypeableFloat n, Monoid' m) =>
Lens' (Options b V2 n) (SizeSpec V2 n)
-> b
-> Options b V2 n
-> QDiagram b V2 n m
-> (Options b V2 n, Transformation V2 n, QDiagram b V2 n m)
adjustDia2D forall n. Lens' (Options Braille V2 n) (SizeSpec V2 n)
Lens' (Options Braille V2 n) (SizeSpec V2 n)
sizeSpec Braille
c Options Braille V2 n
opts (QDiagram Braille V2 n m
d QDiagram Braille V2 n m
-> (QDiagram Braille V2 n m -> QDiagram Braille V2 n m)
-> QDiagram Braille V2 n m
forall a b. a -> (a -> b) -> b
# QDiagram Braille V2 n m -> QDiagram Braille V2 n m
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY)
drawText :: ((Int, Int), String) -> ShowS
drawText ((Int
x, Int
y), String
t) = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [(Int, Char)] -> [String])
-> [(Int, Char)] -> [String] -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Int, Char) -> [String] -> [String])
-> [String] -> [(Int, Char)] -> [String]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Int, Char) -> [String] -> [String])
-> [String] -> [(Int, Char)] -> [String])
-> ((Int, Char) -> [String] -> [String])
-> [String]
-> [(Int, Char)]
-> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> Char -> [String] -> [String])
-> (Int, Char) -> [String] -> [String]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Char -> [String] -> [String]
f) ([Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
x..] String
t) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
where f :: Int -> Char -> [String] -> [String]
f Int
x' = ASetter [String] [String] Char Char -> Char -> [String] -> [String]
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter [String] [String] Char Char
-> Char -> [String] -> [String])
-> ASetter [String] [String] Char Char
-> Char
-> [String]
-> [String]
forall a b. (a -> b) -> a -> b
$ Int -> IndexedTraversal' Int [String] String
forall (t :: * -> *) a.
Traversable t =>
Int -> IndexedTraversal' Int (t a) a
element Int
y ((String -> Identity String) -> [String] -> Identity [String])
-> ((Char -> Identity Char) -> String -> Identity String)
-> ASetter [String] [String] Char Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IndexedTraversal' Int String Char
forall (t :: * -> *) a.
Traversable t =>
Int -> IndexedTraversal' Int (t a) a
element Int
x'
fromRTree :: TypeableFloat n => RTree Braille V2 n Annotation -> Render Braille V2 n
fromRTree :: RTree Braille V2 n Annotation -> Render Braille V2 n
fromRTree (Node RNode Braille V2 n Annotation
n Forest (RNode Braille V2 n Annotation)
rs) = case RNode Braille V2 n Annotation
n of
RPrim Prim Braille V2 n
p -> Braille
-> Prim Braille V2 n
-> Render Braille (V (Prim Braille V2 n)) (N (Prim Braille V2 n))
forall t b. Renderable t b => b -> t -> Render b (V t) (N t)
render Braille
Braille Prim Braille V2 n
p
RStyle Style V2 n
sty -> RenderM n () -> Render Braille V2 n
forall n. RenderM n () -> Render Braille V2 n
R (RenderM n () -> Render Braille V2 n)
-> RenderM n () -> Render Braille V2 n
forall a b. (a -> b) -> a -> b
$ (Style V2 n -> Style V2 n) -> RenderM n () -> RenderM n ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Style V2 n -> Style V2 n -> Style V2 n
forall a. Semigroup a => a -> a -> a
<> Style V2 n
sty) RenderM n ()
r
RNode Braille V2 n Annotation
_ -> RenderM n () -> Render Braille V2 n
forall n. RenderM n () -> Render Braille V2 n
R RenderM n ()
r
where R r = (RTree Braille V2 n Annotation -> Render Braille V2 n)
-> Forest (RNode Braille V2 n Annotation) -> Render Braille V2 n
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap RTree Braille V2 n Annotation -> Render Braille V2 n
forall n.
TypeableFloat n =>
RTree Braille V2 n Annotation -> Render Braille V2 n
fromRTree Forest (RNode Braille V2 n Annotation)
rs
runR :: Render Braille V2 n -> RenderM n ()
runR :: Render Braille V2 n -> RenderM n ()
runR (R r) = RenderM n ()
r
instance Semigroup (Render Braille V2 n) where
R rd1 <> :: Render Braille V2 n -> Render Braille V2 n -> Render Braille V2 n
<> R rd2 = RenderM n () -> Render Braille V2 n
forall n. RenderM n () -> Render Braille V2 n
R (RenderM n () -> Render Braille V2 n)
-> RenderM n () -> Render Braille V2 n
forall a b. (a -> b) -> a -> b
$ RenderM n ()
rd1 RenderM n () -> RenderM n () -> RenderM n ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RenderM n ()
rd2
instance Monoid (Render Braille V2 n) where
mempty :: Render Braille V2 n
mempty = RenderM n () -> Render Braille V2 n
forall n. RenderM n () -> Render Braille V2 n
R (RenderM n () -> Render Braille V2 n)
-> RenderM n () -> Render Braille V2 n
forall a b. (a -> b) -> a -> b
$ () -> RenderM n ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance Hashable n => Hashable (Options Braille V2 n) where
hashWithSalt :: Int -> Options Braille V2 n -> Int
hashWithSalt Int
s (BrailleOptions sz) = Int
s Int -> SizeSpec V2 n -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` SizeSpec V2 n
sz
sizeSpec :: Lens' (Options Braille V2 n) (SizeSpec V2 n)
sizeSpec :: (SizeSpec V2 n -> f (SizeSpec V2 n))
-> Options Braille V2 n -> f (Options Braille V2 n)
sizeSpec = (Options Braille V2 n -> SizeSpec V2 n)
-> (Options Braille V2 n -> SizeSpec V2 n -> Options Braille V2 n)
-> Lens
(Options Braille V2 n)
(Options Braille V2 n)
(SizeSpec V2 n)
(SizeSpec V2 n)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Options Braille V2 n -> SizeSpec V2 n
forall n. Options Braille V2 n -> SizeSpec V2 n
_sizeSpec (\Options Braille V2 n
o SizeSpec V2 n
s -> Options Braille V2 n
R:OptionsBrailleV2n n
o {_sizeSpec :: SizeSpec V2 n
_sizeSpec = SizeSpec V2 n
s})
rasterificStrokeStyle :: TypeableFloat n => Style v n
-> (n, R.Join, (R.Cap, R.Cap), Maybe (R.DashPattern, n))
rasterificStrokeStyle :: Style v n -> (n, Join, (Cap, Cap), Maybe (DashPattern, n))
rasterificStrokeStyle Style v n
s = (n
strokeWidth, Join
strokeJoin, (Cap
strokeCap, Cap
strokeCap), Maybe (DashPattern, n)
strokeDash)
where
strokeWidth :: n
strokeWidth = LensLike' (Const n) (Style v n) (Maybe n)
-> (Maybe n -> n) -> Style v n -> n
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const n) (Style v n) (Maybe n)
forall n (v :: * -> *). Typeable n => Lens' (Style v n) (Maybe n)
_lineWidthU (n -> Maybe n -> n
forall a. a -> Maybe a -> a
fromMaybe n
1) Style v n
s
strokeJoin :: Join
strokeJoin = LensLike' (Const Join) (Style v n) LineJoin
-> (LineJoin -> Join) -> Style v n -> Join
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Join) (Style v n) LineJoin
forall (v :: * -> *) n. Lens' (Style v n) LineJoin
_lineJoin LineJoin -> Join
fromLineJoin Style v n
s
strokeCap :: Cap
strokeCap = LensLike' (Const Cap) (Style v n) LineCap
-> (LineCap -> Cap) -> Style v n -> Cap
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Cap) (Style v n) LineCap
forall (v :: * -> *) n. Lens' (Style v n) LineCap
_lineCap LineCap -> Cap
fromLineCap Style v n
s
strokeDash :: Maybe (DashPattern, n)
strokeDash = LensLike'
(Const (Maybe (DashPattern, n))) (Style v n) (Maybe (Dashing n))
-> (Maybe (Dashing n) -> Maybe (DashPattern, n))
-> Style v n
-> Maybe (DashPattern, n)
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike'
(Const (Maybe (DashPattern, n))) (Style v n) (Maybe (Dashing n))
forall n (v :: * -> *).
Typeable n =>
Lens' (Style v n) (Maybe (Dashing n))
_dashingU ((Dashing n -> (DashPattern, n))
-> Maybe (Dashing n) -> Maybe (DashPattern, n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dashing n -> (DashPattern, n)
forall n. Real n => Dashing n -> (DashPattern, n)
fromDashing) Style v n
s
fromLineCap :: LineCap -> R.Cap
fromLineCap :: LineCap -> Cap
fromLineCap LineCap
LineCapButt = Float -> Cap
R.CapStraight Float
0
fromLineCap LineCap
LineCapRound = Cap
R.CapRound
fromLineCap LineCap
LineCapSquare = Float -> Cap
R.CapStraight Float
1
fromLineJoin :: LineJoin -> R.Join
fromLineJoin :: LineJoin -> Join
fromLineJoin LineJoin
LineJoinMiter = Float -> Join
R.JoinMiter Float
0
fromLineJoin LineJoin
LineJoinRound = Join
R.JoinRound
fromLineJoin LineJoin
LineJoinBevel = Float -> Join
R.JoinMiter Float
1
fromDashing :: Real n => Dashing n -> (R.DashPattern, n)
fromDashing :: Dashing n -> (DashPattern, n)
fromDashing (Dashing [n]
ds n
d) = ((n -> Float) -> [n] -> DashPattern
forall a b. (a -> b) -> [a] -> [b]
map n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac [n]
ds, n
d)
fromFillRule :: FillRule -> R.FillMethod
fromFillRule :: FillRule -> FillMethod
fromFillRule FillRule
EvenOdd = FillMethod
R.FillEvenOdd
fromFillRule FillRule
_ = FillMethod
R.FillWinding
rasterificColor :: SomeColor -> Double -> PixelRGBA8
rasterificColor :: SomeColor -> Double -> PixelRGBA8
rasterificColor SomeColor
c Double
o = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
a
where
(Pixel8
r, Pixel8
g, Pixel8
b, Pixel8
a) = (Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
int Double
r', Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
int Double
g', Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
int Double
b', Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
int (Double
o Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a'))
(Double
r', Double
g', Double
b', Double
a') = AlphaColour Double -> (Double, Double, Double, Double)
forall c. Color c => c -> (Double, Double, Double, Double)
colorToSRGBA (SomeColor -> AlphaColour Double
forall c. Color c => c -> AlphaColour Double
toAlphaColour SomeColor
c)
int :: a -> b
int a
x = a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (a
255 a -> a -> a
forall a. Num a => a -> a -> a
* a
x)
rasterificSpreadMethod :: SpreadMethod -> R.SamplerRepeat
rasterificSpreadMethod :: SpreadMethod -> SamplerRepeat
rasterificSpreadMethod SpreadMethod
GradPad = SamplerRepeat
R.SamplerPad
rasterificSpreadMethod SpreadMethod
GradReflect = SamplerRepeat
R.SamplerReflect
rasterificSpreadMethod SpreadMethod
GradRepeat = SamplerRepeat
R.SamplerRepeat
rasterificStops :: TypeableFloat n => [GradientStop n] -> Gradient PixelRGBA8
rasterificStops :: [GradientStop n] -> Gradient PixelRGBA8
rasterificStops = (GradientStop n -> (Float, PixelRGBA8))
-> [GradientStop n] -> Gradient PixelRGBA8
forall a b. (a -> b) -> [a] -> [b]
map GradientStop n -> (Float, PixelRGBA8)
forall a a.
(Real a, Fractional a) =>
GradientStop a -> (a, PixelRGBA8)
fromStop
where
fromStop :: GradientStop a -> (a, PixelRGBA8)
fromStop (GradientStop SomeColor
c a
v) = (a -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
v, SomeColor -> Double -> PixelRGBA8
rasterificColor SomeColor
c Double
1)
rasterificLinearGradient :: TypeableFloat n => LGradient n -> R.Texture PixelRGBA8
rasterificLinearGradient :: LGradient n -> Texture PixelRGBA8
rasterificLinearGradient LGradient n
g = Transformation -> Texture PixelRGBA8 -> Texture PixelRGBA8
forall px. Transformation -> Texture px -> Texture px
transformTexture Transformation
tr Texture PixelRGBA8
tx
where
tr :: Transformation
tr = T2 n -> Transformation
forall n. TypeableFloat n => T2 n -> Transformation
rasterificMatTransf (T2 n -> T2 n
forall (v :: * -> *) n.
(Functor v, Num n) =>
Transformation v n -> Transformation v n
inv (T2 n -> T2 n) -> T2 n -> T2 n
forall a b. (a -> b) -> a -> b
$ LGradient n
gLGradient n -> Getting (T2 n) (LGradient n) (T2 n) -> T2 n
forall s a. s -> Getting a s a -> a
^.Getting (T2 n) (LGradient n) (T2 n)
forall n. Lens' (LGradient n) (Transformation V2 n)
lGradTrans)
tx :: Texture PixelRGBA8
tx = SamplerRepeat -> Texture PixelRGBA8 -> Texture PixelRGBA8
forall px. SamplerRepeat -> Texture px -> Texture px
withSampler SamplerRepeat
spreadMethod (Gradient PixelRGBA8 -> Point -> Point -> Texture PixelRGBA8
forall px. Gradient px -> Point -> Point -> Texture px
linearGradientTexture Gradient PixelRGBA8
gradDef Point
p0 Point
p1)
spreadMethod :: SamplerRepeat
spreadMethod = SpreadMethod -> SamplerRepeat
rasterificSpreadMethod (LGradient n
gLGradient n
-> Getting SpreadMethod (LGradient n) SpreadMethod -> SpreadMethod
forall s a. s -> Getting a s a -> a
^.Getting SpreadMethod (LGradient n) SpreadMethod
forall n. Lens' (LGradient n) SpreadMethod
lGradSpreadMethod)
gradDef :: Gradient PixelRGBA8
gradDef = [GradientStop n] -> Gradient PixelRGBA8
forall n.
TypeableFloat n =>
[GradientStop n] -> Gradient PixelRGBA8
rasterificStops (LGradient n
gLGradient n
-> Getting [GradientStop n] (LGradient n) [GradientStop n]
-> [GradientStop n]
forall s a. s -> Getting a s a -> a
^.Getting [GradientStop n] (LGradient n) [GradientStop n]
forall n. Lens' (LGradient n) [GradientStop n]
lGradStops)
p0 :: Point
p0 = P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 (LGradient n
gLGradient n -> Getting (P2 n) (LGradient n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (LGradient n) (P2 n)
forall n. Lens' (LGradient n) (Point V2 n)
lGradStart)
p1 :: Point
p1 = P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 (LGradient n
gLGradient n -> Getting (P2 n) (LGradient n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (LGradient n) (P2 n)
forall n. Lens' (LGradient n) (Point V2 n)
lGradEnd)
rasterificRadialGradient :: TypeableFloat n => RGradient n -> R.Texture PixelRGBA8
rasterificRadialGradient :: RGradient n -> Texture PixelRGBA8
rasterificRadialGradient RGradient n
g = Transformation -> Texture PixelRGBA8 -> Texture PixelRGBA8
forall px. Transformation -> Texture px -> Texture px
transformTexture Transformation
tr Texture PixelRGBA8
tx
where
tr :: Transformation
tr = T2 n -> Transformation
forall n. TypeableFloat n => T2 n -> Transformation
rasterificMatTransf (T2 n -> T2 n
forall (v :: * -> *) n.
(Functor v, Num n) =>
Transformation v n -> Transformation v n
inv (T2 n -> T2 n) -> T2 n -> T2 n
forall a b. (a -> b) -> a -> b
$ RGradient n
gRGradient n -> Getting (T2 n) (RGradient n) (T2 n) -> T2 n
forall s a. s -> Getting a s a -> a
^.Getting (T2 n) (RGradient n) (T2 n)
forall n. Lens' (RGradient n) (Transformation V2 n)
rGradTrans)
tx :: Texture PixelRGBA8
tx = SamplerRepeat -> Texture PixelRGBA8 -> Texture PixelRGBA8
forall px. SamplerRepeat -> Texture px -> Texture px
withSampler SamplerRepeat
spreadMethod (Gradient PixelRGBA8
-> Point -> Float -> Point -> Texture PixelRGBA8
forall px. Gradient px -> Point -> Float -> Point -> Texture px
radialGradientWithFocusTexture Gradient PixelRGBA8
gradDef Point
c (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
r1) Point
f)
spreadMethod :: SamplerRepeat
spreadMethod = SpreadMethod -> SamplerRepeat
rasterificSpreadMethod (RGradient n
gRGradient n
-> Getting SpreadMethod (RGradient n) SpreadMethod -> SpreadMethod
forall s a. s -> Getting a s a -> a
^.Getting SpreadMethod (RGradient n) SpreadMethod
forall n. Lens' (RGradient n) SpreadMethod
rGradSpreadMethod)
c :: Point
c = P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 (RGradient n
gRGradient n -> Getting (P2 n) (RGradient n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (RGradient n) (P2 n)
forall n. Lens' (RGradient n) (Point V2 n)
rGradCenter1)
f :: Point
f = P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 (RGradient n
gRGradient n -> Getting (P2 n) (RGradient n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (RGradient n) (P2 n)
forall n. Lens' (RGradient n) (Point V2 n)
rGradCenter0)
gradDef :: Gradient PixelRGBA8
gradDef = [GradientStop n] -> Gradient PixelRGBA8
forall n.
TypeableFloat n =>
[GradientStop n] -> Gradient PixelRGBA8
rasterificStops [GradientStop n]
ss
r0 :: n
r0 = RGradient n
gRGradient n -> Getting n (RGradient n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (RGradient n) n
forall n. Lens' (RGradient n) n
rGradRadius0
r1 :: n
r1 = RGradient n
gRGradient n -> Getting n (RGradient n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (RGradient n) n
forall n. Lens' (RGradient n) n
rGradRadius1
stopFracs :: [n]
stopFracs = n
r0 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
r1 n -> [n] -> [n]
forall a. a -> [a] -> [a]
: (GradientStop n -> n) -> [GradientStop n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (\GradientStop n
s -> (n
r0 n -> n -> n
forall a. Num a => a -> a -> a
+ (GradientStop n
sGradientStop n -> Getting n (GradientStop n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (GradientStop n) n
forall n. Lens' (GradientStop n) n
stopFraction) n -> n -> n
forall a. Num a => a -> a -> a
* (n
r1 n -> n -> n
forall a. Num a => a -> a -> a
- n
r0)) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
r1)
(RGradient n
gRGradient n
-> Getting [GradientStop n] (RGradient n) [GradientStop n]
-> [GradientStop n]
forall s a. s -> Getting a s a -> a
^.Getting [GradientStop n] (RGradient n) [GradientStop n]
forall n. Lens' (RGradient n) [GradientStop n]
rGradStops)
gradStops :: [GradientStop n]
gradStops = case RGradient n
gRGradient n
-> Getting [GradientStop n] (RGradient n) [GradientStop n]
-> [GradientStop n]
forall s a. s -> Getting a s a -> a
^.Getting [GradientStop n] (RGradient n) [GradientStop n]
forall n. Lens' (RGradient n) [GradientStop n]
rGradStops of
[] -> []
xs :: [GradientStop n]
xs@(GradientStop n
x:[GradientStop n]
_) -> GradientStop n
x GradientStop n -> [GradientStop n] -> [GradientStop n]
forall a. a -> [a] -> [a]
: [GradientStop n]
xs
ss :: [GradientStop n]
ss = (GradientStop n -> n -> GradientStop n)
-> [GradientStop n] -> [n] -> [GradientStop n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\GradientStop n
gs n
sf -> GradientStop n
gs GradientStop n
-> (GradientStop n -> GradientStop n) -> GradientStop n
forall a b. a -> (a -> b) -> b
& (n -> Identity n) -> GradientStop n -> Identity (GradientStop n)
forall n. Lens' (GradientStop n) n
stopFraction ((n -> Identity n) -> GradientStop n -> Identity (GradientStop n))
-> n -> GradientStop n -> GradientStop n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
sf ) [GradientStop n]
gradStops [n]
stopFracs
rasterificTexture :: TypeableFloat n => Texture n -> Double -> R.Texture PixelRGBA8
rasterificTexture :: Texture n -> Double -> Texture PixelRGBA8
rasterificTexture (SC SomeColor
c) Double
o = PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
uniformTexture (PixelRGBA8 -> Texture PixelRGBA8)
-> PixelRGBA8 -> Texture PixelRGBA8
forall a b. (a -> b) -> a -> b
$ SomeColor -> Double -> PixelRGBA8
rasterificColor SomeColor
c Double
o
rasterificTexture (LG LGradient n
g) Double
_ = LGradient n -> Texture PixelRGBA8
forall n. TypeableFloat n => LGradient n -> Texture PixelRGBA8
rasterificLinearGradient LGradient n
g
rasterificTexture (RG RGradient n
g) Double
_ = RGradient n -> Texture PixelRGBA8
forall n. TypeableFloat n => RGradient n -> Texture PixelRGBA8
rasterificRadialGradient RGradient n
g
p2v2 :: Real n => P2 n -> R.Point
p2v2 :: P2 n -> Point
p2v2 (P V2 n
v) = V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 V2 n
v
{-# INLINE p2v2 #-}
r2v2 :: Real n => V2 n -> R.Point
r2v2 :: V2 n -> Point
r2v2 (V2 n
x n
y) = Float -> Float -> Point
forall a. a -> a -> V2 a
R.V2 (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
x) (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
y)
{-# INLINE r2v2 #-}
rv2 :: (Real n, Fractional n) => Iso' R.Point (P2 n)
rv2 :: Iso' Point (P2 n)
rv2 = (Point -> V2 n) -> (V2 n -> Point) -> Iso Point Point (V2 n) (V2 n)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(R.V2 Float
x Float
y) -> n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (Float -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x) (Float -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y)) V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 (p (V2 n) (f (V2 n)) -> p Point (f Point))
-> (p (P2 n) (f (P2 n)) -> p (V2 n) (f (V2 n)))
-> p (P2 n) (f (P2 n))
-> p Point (f Point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso (P2 n) (P2 n) (V2 n) (V2 n)
-> Iso (V2 n) (V2 n) (P2 n) (P2 n)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso (P2 n) (P2 n) (V2 n) (V2 n)
forall (f :: * -> *) a. Iso' (Point f a) (f a)
_Point
{-# INLINE rv2 #-}
rasterificPtTransf :: TypeableFloat n => T2 n -> R.Point -> R.Point
rasterificPtTransf :: T2 n -> Point -> Point
rasterificPtTransf T2 n
t = ASetter Point Point (Point V2 n) (Point V2 n)
-> (Point V2 n -> Point V2 n) -> Point -> Point
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Point Point (Point V2 n) (Point V2 n)
forall n. (Real n, Fractional n) => Iso' Point (P2 n)
rv2 (T2 n -> Point V2 n -> Point V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Point v n -> Point v n
papply T2 n
t)
rasterificMatTransf :: TypeableFloat n => T2 n -> R.Transformation
rasterificMatTransf :: T2 n -> Transformation
rasterificMatTransf T2 n
tr = Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
R.Transformation Float
a Float
c Float
e Float
b Float
d Float
f
where
[[Float
a, Float
b], [Float
c, Float
d], [Float
e, Float
f]] = (n -> Float) -> [n] -> DashPattern
forall a b. (a -> b) -> [a] -> [b]
map n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([n] -> DashPattern) -> [[n]] -> [DashPattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T2 n -> [[n]]
forall (v :: * -> *) n.
(Additive v, Traversable v, Num n) =>
Transformation v n -> [[n]]
matrixHomRep T2 n
tr
renderSeg :: TypeableFloat n => Located (Segment Closed V2 n) -> R.Primitive
renderSeg :: Located (Segment Closed V2 n) -> Primitive
renderSeg Located (Segment Closed V2 n)
l =
case Located (Segment Closed V2 n)
-> (Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n)),
Segment Closed V2 n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc Located (Segment Closed V2 n)
l of
(Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
p, Linear (OffsetClosed V2 n
v)) ->
Line -> Primitive
R.LinePrim (Line -> Primitive) -> Line -> Primitive
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Line
R.Line Point
p' (Point
p' Point -> Point -> Point
forall a. Num a => a -> a -> a
+ V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 V2 n
v)
where
p' :: Point
p' = P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
P2 n
p
(Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
p, Cubic V2 n
u1 V2 n
u2 (OffsetClosed V2 n
u3)) ->
CubicBezier -> Primitive
R.CubicBezierPrim (CubicBezier -> Primitive) -> CubicBezier -> Primitive
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point -> Point -> CubicBezier
R.CubicBezier Point
q0 Point
q1 Point
q2 Point
q3
where
(Point
q0, Point
q1, Point
q2, Point
q3) = (P2 n -> Point
forall n. Real n => P2 n -> Point
p2v2 Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
P2 n
p, Point
q0 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 V2 n
u1, Point
q0 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 V2 n
u2, Point
q0 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ V2 n -> Point
forall n. Real n => V2 n -> Point
r2v2 V2 n
u3)
renderPath :: TypeableFloat n => Path V2 n -> [[R.Primitive]]
renderPath :: Path V2 n -> [[Primitive]]
renderPath Path V2 n
p = (([Located (Segment Closed V2 n)] -> [Primitive])
-> [[Located (Segment Closed V2 n)]] -> [[Primitive]]
forall a b. (a -> b) -> [a] -> [b]
map (([Located (Segment Closed V2 n)] -> [Primitive])
-> [[Located (Segment Closed V2 n)]] -> [[Primitive]])
-> ((Located (Segment Closed V2 n) -> Primitive)
-> [Located (Segment Closed V2 n)] -> [Primitive])
-> (Located (Segment Closed V2 n) -> Primitive)
-> [[Located (Segment Closed V2 n)]]
-> [[Primitive]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (Segment Closed V2 n) -> Primitive)
-> [Located (Segment Closed V2 n)] -> [Primitive]
forall a b. (a -> b) -> [a] -> [b]
map) Located (Segment Closed V2 n) -> Primitive
forall n.
TypeableFloat n =>
Located (Segment Closed V2 n) -> Primitive
renderSeg (Path V2 n -> [[Located (Segment Closed V2 n)]]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Path v n -> [[Located (Segment Closed v n)]]
pathLocSegments Path V2 n
p)
mkStroke :: TypeableFloat n => n -> R.Join -> (R.Cap, R.Cap) -> Maybe (R.DashPattern, n)
-> [[R.Primitive]] -> R.Drawing PixelRGBA8 ()
mkStroke :: n
-> Join
-> (Cap, Cap)
-> Maybe (DashPattern, n)
-> [[Primitive]]
-> Drawing PixelRGBA8 ()
mkStroke (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> Float
l) Join
j (Cap, Cap)
c Maybe (DashPattern, n)
d [[Primitive]]
primList =
Drawing PixelRGBA8 ()
-> ((DashPattern, n) -> Drawing PixelRGBA8 ())
-> Maybe (DashPattern, n)
-> Drawing PixelRGBA8 ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Float -> Join -> (Cap, Cap) -> [Primitive] -> Drawing PixelRGBA8 ()
forall geom px.
Geometry geom =>
Float -> Join -> (Cap, Cap) -> geom -> Drawing px ()
R.stroke Float
l Join
j (Cap, Cap)
c ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive] -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ [[Primitive]] -> [Primitive]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Primitive]]
primList)
(\(DashPattern
dsh, n
off) -> Float
-> DashPattern
-> Float
-> Join
-> (Cap, Cap)
-> [Primitive]
-> Drawing PixelRGBA8 ()
forall geom px.
Geometry geom =>
Float
-> DashPattern
-> Float
-> Join
-> (Cap, Cap)
-> geom
-> Drawing px ()
R.dashedStrokeWithOffset (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
off) DashPattern
dsh Float
l Join
j (Cap, Cap)
c ([Primitive] -> Drawing PixelRGBA8 ())
-> [Primitive] -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ [[Primitive]] -> [Primitive]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Primitive]]
primList)
Maybe (DashPattern, n)
d
instance TypeableFloat n => Renderable (Path V2 n) Braille where
render :: Braille
-> Path V2 n -> Render Braille (V (Path V2 n)) (N (Path V2 n))
render Braille
_ Path V2 n
p = RenderM n () -> Render Braille V2 n
forall n. RenderM n () -> Render Braille V2 n
R (RenderM n () -> Render Braille V2 n)
-> RenderM n () -> Render Braille V2 n
forall a b. (a -> b) -> a -> b
$ do
Style V2 n
sty <- ReaderT (Style V2 n) (Writer Draw) (Style V2 n)
forall r (m :: * -> *). MonadReader r m => m r
ask
let f :: Texture n
f = Style V2 n
sty Style V2 n
-> Getting (Texture n) (Style V2 n) (Texture n) -> Texture n
forall s a. s -> Getting a s a -> a
^. Getting (Texture n) (Style V2 n) (Texture n)
forall n.
(Typeable n, Floating n) =>
Lens' (Style V2 n) (Texture n)
_fillTexture
s :: Texture n
s = Style V2 n
sty Style V2 n
-> Getting (Texture n) (Style V2 n) (Texture n) -> Texture n
forall s a. s -> Getting a s a -> a
^. Getting (Texture n) (Style V2 n) (Texture n)
forall n.
(Floating n, Typeable n) =>
Lens' (Style V2 n) (Texture n)
_lineTexture
o :: Double
o = Style V2 n
sty Style V2 n -> Getting Double (Style V2 n) Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double (Style V2 n) Double
forall (v :: * -> *) n. Lens' (Style v n) Double
_opacity
r :: FillRule
r = Style V2 n
sty Style V2 n -> Getting FillRule (Style V2 n) FillRule -> FillRule
forall s a. s -> Getting a s a -> a
^. Getting FillRule (Style V2 n) FillRule
forall n. Lens' (Style V2 n) FillRule
_fillRule
(n
l, Join
j, (Cap, Cap)
c, Maybe (DashPattern, n)
d) = Style V2 n -> (n, Join, (Cap, Cap), Maybe (DashPattern, n))
forall n (v :: * -> *).
TypeableFloat n =>
Style v n -> (n, Join, (Cap, Cap), Maybe (DashPattern, n))
rasterificStrokeStyle Style V2 n
sty
canFill :: Bool
canFill = Getting Any (Path V2 n) (Trail V2 n)
-> (Trail V2 n -> Bool) -> Path V2 n -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf ((Located (Trail V2 n) -> Const Any (Located (Trail V2 n)))
-> Path V2 n -> Const Any (Path V2 n)
forall s a. Cons s s a a => Traversal' s a
_head ((Located (Trail V2 n) -> Const Any (Located (Trail V2 n)))
-> Path V2 n -> Const Any (Path V2 n))
-> ((Trail V2 n -> Const Any (Trail V2 n))
-> Located (Trail V2 n) -> Const Any (Located (Trail V2 n)))
-> Getting Any (Path V2 n) (Trail V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail V2 n -> Const Any (Trail V2 n))
-> Located (Trail V2 n) -> Const Any (Located (Trail V2 n))
forall a b. SameSpace a b => Lens (Located a) (Located b) a b
located) Trail V2 n -> Bool
forall (v :: * -> *) n. Trail v n -> Bool
isLoop Path V2 n
p Bool -> Bool -> Bool
&& (Texture n
f Texture n
-> Getting
(First (AlphaColour Double)) (Texture n) (AlphaColour Double)
-> Maybe (AlphaColour Double)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
(First (AlphaColour Double)) (Texture n) (AlphaColour Double)
forall n. Prism' (Texture n) (AlphaColour Double)
_AC) Maybe (AlphaColour Double) -> Maybe (AlphaColour Double) -> Bool
forall a. Eq a => a -> a -> Bool
/= AlphaColour Double -> Maybe (AlphaColour Double)
forall a. a -> Maybe a
Just AlphaColour Double
forall a. Num a => AlphaColour a
transparent
rule :: FillMethod
rule = FillRule -> FillMethod
fromFillRule FillRule
r
primList :: [[Primitive]]
primList = Path V2 n -> [[Primitive]]
forall n. TypeableFloat n => Path V2 n -> [[Primitive]]
renderPath Path V2 n
p
prms :: [Primitive]
prms = [[Primitive]] -> [Primitive]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Primitive]]
primList
Bool -> RenderM n () -> RenderM n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
canFill (RenderM n () -> RenderM n ()) -> RenderM n () -> RenderM n ()
forall a b. (a -> b) -> a -> b
$
Drawing PixelRGBA8 () -> RenderM n ()
forall n. Drawing PixelRGBA8 () -> RenderM n ()
tellR (Texture PixelRGBA8
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px. Texture px -> Drawing px () -> Drawing px ()
R.withTexture (Texture n -> Double -> Texture PixelRGBA8
forall n.
TypeableFloat n =>
Texture n -> Double -> Texture PixelRGBA8
rasterificTexture Texture n
f Double
o) (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ FillMethod -> [Primitive] -> Drawing PixelRGBA8 ()
forall geom px.
Geometry geom =>
FillMethod -> geom -> Drawing px ()
R.fillWithMethod FillMethod
rule [Primitive]
prms)
Drawing PixelRGBA8 () -> RenderM n ()
forall n. Drawing PixelRGBA8 () -> RenderM n ()
tellR (Texture PixelRGBA8
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px. Texture px -> Drawing px () -> Drawing px ()
R.withTexture (Texture n -> Double -> Texture PixelRGBA8
forall n.
TypeableFloat n =>
Texture n -> Double -> Texture PixelRGBA8
rasterificTexture Texture n
s Double
o) (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ n
-> Join
-> (Cap, Cap)
-> Maybe (DashPattern, n)
-> [[Primitive]]
-> Drawing PixelRGBA8 ()
forall n.
TypeableFloat n =>
n
-> Join
-> (Cap, Cap)
-> Maybe (DashPattern, n)
-> [[Primitive]]
-> Drawing PixelRGBA8 ()
mkStroke n
l Join
j (Cap, Cap)
c Maybe (DashPattern, n)
d [[Primitive]]
primList)
instance TypeableFloat n => Renderable (Text n) Braille where
render :: Braille -> Text n -> Render Braille (V (Text n)) (N (Text n))
render Braille
_ (Text T2 n
tr TextAlignment n
al String
str) = RenderM n () -> Render Braille V2 n
forall n. RenderM n () -> Render Braille V2 n
R (RenderM n () -> Render Braille V2 n)
-> RenderM n () -> Render Braille V2 n
forall a b. (a -> b) -> a -> b
$ do
n
fs <- LensLike' (Const n) (Style V2 n) (Maybe n)
-> (Maybe n -> n) -> ReaderT (Style V2 n) (Writer Draw) n
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const n) (Style V2 n) (Maybe n)
forall n (v :: * -> *). Typeable n => Lens' (Style v n) (Maybe n)
_fontSizeU (n -> Maybe n -> n
forall a. a -> Maybe a -> a
fromMaybe n
12)
FontSlant
slant <- Getting FontSlant (Style V2 n) FontSlant
-> ReaderT (Style V2 n) (Writer Draw) FontSlant
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FontSlant (Style V2 n) FontSlant
forall (v :: * -> *) n. Lens' (Style v n) FontSlant
_fontSlant
FontWeight
fw <- Getting FontWeight (Style V2 n) FontWeight
-> ReaderT (Style V2 n) (Writer Draw) FontWeight
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FontWeight (Style V2 n) FontWeight
forall (v :: * -> *) n. Lens' (Style v n) FontWeight
_fontWeight
let fs' :: PointSize
fs' = Float -> PointSize
R.PointSize (n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
fs)
fnt :: Font
fnt = FontSlant -> FontWeight -> Font
fromFontStyle FontSlant
slant FontWeight
fw
bb :: BoundingBox V2 n
bb = Font -> PointSize -> String -> BoundingBox V2 n
forall n.
RealFloat n =>
Font -> PointSize -> String -> BoundingBox V2 n
textBoundingBox Font
fnt PointSize
fs' String
str
P (V2 n
x n
y) = Transformation (V (Point V2 n)) (N (Point V2 n))
-> Point V2 n -> Point V2 n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Point V2 n)) (N (Point V2 n))
T2 n
tr (Point V2 n -> Point V2 n) -> Point V2 n -> Point V2 n
forall a b. (a -> b) -> a -> b
$ case TextAlignment n
al of
TextAlignment n
BaselineText -> PrevDim (Point V2 n)
0 PrevDim (Point V2 n) -> FinalCoord (Point V2 n) -> Point V2 n
forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& FinalCoord (Point V2 n)
0
BoxAlignedText n
xt n
yt -> case BoundingBox V2 n -> Maybe (Point V2 n, Point V2 n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox V2 n
bb of
Just (P (V2 n
xl n
yl), P (V2 n
xu n
yu)) -> (-n -> n -> n -> n
forall a b. (Real a, Fractional b) => a -> a -> a -> b
lerp' n
xt n
xu n
xl) PrevDim (Point V2 n) -> FinalCoord (Point V2 n) -> Point V2 n
forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& n -> n -> n -> n
forall a b. (Real a, Fractional b) => a -> a -> a -> b
lerp' n
yt n
yu n
yl
Maybe (Point V2 n, Point V2 n)
Nothing -> PrevDim (Point V2 n)
0 PrevDim (Point V2 n) -> FinalCoord (Point V2 n) -> Point V2 n
forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& FinalCoord (Point V2 n)
0
Int -> Int -> String -> RenderM n ()
forall n. Int -> Int -> String -> RenderM n ()
tellT (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (n -> Int) -> n -> Int
forall a b. (a -> b) -> a -> b
$ n
x n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2) (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (n -> Int) -> n -> Int
forall a b. (a -> b) -> a -> b
$ n
y n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
4) String
str
where
lerp' :: a -> a -> a -> b
lerp' a
t a
u a
v = a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
t a -> a -> a
forall a. Num a => a -> a -> a
* a
u a -> a -> a
forall a. Num a => a -> a -> a
+ (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
t) a -> a -> a
forall a. Num a => a -> a -> a
* a
v
toImageRGBA8 :: DynamicImage -> Image PixelRGBA8
toImageRGBA8 :: DynamicImage -> Image PixelRGBA8
toImageRGBA8 (ImageRGBA8 Image PixelRGBA8
i) = Image PixelRGBA8
i
toImageRGBA8 (ImageRGB8 Image PixelRGB8
i) = Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGB8
i
toImageRGBA8 (ImageYCbCr8 Image PixelYCbCr8
i) = Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
i :: Image PixelRGB8)
toImageRGBA8 (ImageY8 Image Pixel8
i) = Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel8
i
toImageRGBA8 (ImageYA8 Image PixelYA8
i) = Image PixelYA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
i
toImageRGBA8 (ImageCMYK8 Image PixelCMYK8
i) = Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
i :: Image PixelRGB8)
toImageRGBA8 DynamicImage
_ = String -> Image PixelRGBA8
forall a. HasCallStack => String -> a
error String
"Unsupported Pixel type"
instance TypeableFloat n => Renderable (DImage n Embedded) Braille where
render :: Braille
-> DImage n Embedded
-> Render Braille (V (DImage n Embedded)) (N (DImage n Embedded))
render Braille
_ (DImage ImageData Embedded
iD Int
w Int
h Transformation V2 n
tr) = RenderM n () -> Render Braille V2 n
forall n. RenderM n () -> Render Braille V2 n
R (RenderM n () -> Render Braille V2 n)
-> RenderM n () -> Render Braille V2 n
forall a b. (a -> b) -> a -> b
$ Drawing PixelRGBA8 () -> RenderM n ()
forall n. Drawing PixelRGBA8 () -> RenderM n ()
tellR
(Transformation -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px. Transformation -> Drawing px () -> Drawing px ()
R.withTransformation
(Transformation V2 n -> Transformation
forall n. TypeableFloat n => T2 n -> Transformation
rasterificMatTransf (Transformation V2 n
tr Transformation V2 n -> Transformation V2 n -> Transformation V2 n
forall a. Semigroup a => a -> a -> a
<> Transformation V2 n
forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
reflectionY))
(Image PixelRGBA8 -> Float -> Point -> Drawing PixelRGBA8 ()
forall px. Image px -> Float -> Point -> Drawing px ()
R.drawImage Image PixelRGBA8
img Float
0 Point
p))
where
ImageRaster DynamicImage
dImg = ImageData Embedded
iD
img :: Image PixelRGBA8
img = DynamicImage -> Image PixelRGBA8
toImageRGBA8 DynamicImage
dImg
trl :: Transformation V2 n
trl = V2 n -> Transformation V2 n -> Transformation V2 n
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, HasOrigin t) =>
v n -> t -> t
moveOriginBy ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 (Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2, Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2 :: n)) Transformation V2 n
forall a. Monoid a => a
mempty
p :: Point
p = Transformation V2 n -> Point -> Point
forall n. TypeableFloat n => T2 n -> Point -> Point
rasterificPtTransf Transformation V2 n
trl (Float -> Float -> Point
forall a. a -> a -> V2 a
R.V2 Float
0 Float
0)
rasterBraille :: SizeSpec V2 n -> QDiagram Braille V2 n m -> Result Braille V2 n
rasterBraille SizeSpec V2 n
sz = Braille
-> Options Braille V2 n
-> QDiagram Braille V2 n m
-> Result Braille V2 n
forall b (v :: * -> *) n m.
(Backend b v n, HasLinearMap v, Metric v, Typeable n,
OrderedField n, Monoid' m) =>
b -> Options b v n -> QDiagram b v n m -> Result b v n
renderDia Braille
Braille (SizeSpec V2 n -> Options Braille V2 n
forall n. SizeSpec V2 n -> Options Braille V2 n
BrailleOptions SizeSpec V2 n
sz)
renderBraille :: TypeableFloat n => FilePath -> SizeSpec V2 n
-> QDiagram Braille V2 n Any -> IO ()
renderBraille :: String -> SizeSpec V2 n -> QDiagram Braille V2 n Any -> IO ()
renderBraille String
outFile SizeSpec V2 n
spec QDiagram Braille V2 n Any
d =
case ShowS
takeExtension String
outFile of
String
_ -> String -> String -> IO ()
writeBrl String
outFile String
Result Braille V2 n
brl
where
brl :: Result Braille V2 n
brl = Braille
-> Options Braille V2 n
-> QDiagram Braille V2 n Any
-> Result Braille V2 n
forall b (v :: * -> *) n m.
(Backend b v n, HasLinearMap v, Metric v, Typeable n,
OrderedField n, Monoid' m) =>
b -> Options b v n -> QDiagram b v n m -> Result b v n
renderDia Braille
Braille (SizeSpec V2 n -> Options Braille V2 n
forall n. SizeSpec V2 n -> Options Braille V2 n
BrailleOptions SizeSpec V2 n
spec) QDiagram Braille V2 n Any
d
writeBrl :: String -> String -> IO ()
writeBrl = String -> String -> IO ()
writeFile
img2brl :: Image PixelRGBA8 -> String
img2brl = Int -> (PixelRGBA8 -> Bool) -> Image PixelRGBA8 -> String
forall t. Pixel t => Int -> (t -> Bool) -> Image t -> String
img2brl' Int
8 PixelRGBA8 -> Bool
f where
f :: PixelRGBA8 -> Bool
f (PixelRGBA8 Pixel8
_ Pixel8
_ Pixel8
_ Pixel8
a) | Pixel8
a Pixel8 -> Pixel8 -> Bool
forall a. Ord a => a -> a -> Bool
> Pixel8
20 = Bool
True
f PixelRGBA8
_ = Bool
False
img2brl' :: Int -> (t -> Bool) -> Image t -> String
img2brl' Int
dots t -> Bool
c Image t
img = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
(Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
y -> (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Char
f Int
y) [Int]
columnIndices) [Int]
lineIndices where
f :: Int -> Int -> Char
f Int
y Int
x = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ ((Int -> Int) -> Int -> Int) -> Int -> [Int -> Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
($) Int
0x2800 ([Int -> Int] -> Int) -> [Int -> Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [Int -> Int] -> [Int -> Int]
forall a. Int -> [a] -> [a]
take Int
dots ([Int -> Int] -> [Int -> Int]) -> [Int -> Int] -> [Int -> Int]
forall a b. (a -> b) -> a -> b
$ ((Int -> Int -> Int) -> Int -> Int -> Int)
-> [Int -> Int -> Int] -> [Int] -> [Int -> Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int -> Int -> Int) -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
($) [
Int -> Int -> Bool -> Int -> Int -> Int
g Int
y Int
x Bool
True
, let y' :: Int
y' = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 in Int -> Int -> Bool -> Int -> Int -> Int
g Int
y' Int
x (Bool -> Int -> Int -> Int) -> Bool -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
y' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h
, let y'' :: Int
y'' = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2 in Int -> Int -> Bool -> Int -> Int -> Int
g Int
y'' Int
x (Bool -> Int -> Int -> Int) -> Bool -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
y'' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h
, let x' :: Int
x' = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 in Int -> Int -> Bool -> Int -> Int -> Int
g Int
y Int
x' (Bool -> Int -> Int -> Int) -> Bool -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w
, let {y' :: Int
y' = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1; x' :: Int
x' = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1} in Int -> Int -> Bool -> Int -> Int -> Int
g Int
y' Int
x' (Bool -> Int -> Int -> Int) -> Bool -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
y' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h Bool -> Bool -> Bool
&& Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w
, let {y'' :: Int
y'' = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2; x' :: Int
x' = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1} in Int -> Int -> Bool -> Int -> Int -> Int
g Int
y'' Int
x' (Bool -> Int -> Int -> Int) -> Bool -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
y'' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h Bool -> Bool -> Bool
&& Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w
, let y''' :: Int
y''' = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3 in Int -> Int -> Bool -> Int -> Int -> Int
g Int
y''' Int
x (Bool -> Int -> Int -> Int) -> Bool -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
y''' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h
, let {y''' :: Int
y''' = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3; x' :: Int
x' = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1} in Int -> Int -> Bool -> Int -> Int -> Int
g Int
y''' Int
x' (Bool -> Int -> Int -> Int) -> Bool -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
y''' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h Bool -> Bool -> Bool
&& Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w] [Int
0..]
g :: Int -> Int -> Bool -> Int -> Int -> Int
g Int
y Int
x Bool
True Int
b Int
a | t -> Bool
c (t -> Bool) -> t -> Bool
forall a b. (a -> b) -> a -> b
$ Image t -> Int -> Int -> t
forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image t
img Int
x Int
y = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
setBit Int
a Int
b
g Int
_ Int
_ Bool
_ Int
_ Int
a = Int
a
lineIndices :: [Int]
lineIndices = [Int
0, (Int
dots Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) .. Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
columnIndices :: [Int]
columnIndices = [Int
0, Int
2 .. Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
(Int
h, Int
w) = (Image t -> Int
forall a. Image a -> Int
imageHeight Image t
img, Image t -> Int
forall a. Image a -> Int
imageWidth Image t
img)