{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Rasterific.Command ( Drawing
, DrawCommand( .. )
, DrawContext
, TextRange( .. )
, dumpDrawing
, Texture( .. )
, Gradient
, ShaderFunction
, ImageTransformer
, dumpTexture
) where
import Data.Kind ( Type )
import Control.Monad.ST( ST )
import Control.Monad.State( StateT )
import Control.Monad.Primitive( PrimState )
import Control.Monad.Free( Free( .. ), liftF )
import Control.Monad.Free.Church( F, fromF )
import Codec.Picture.Types( Image, Pixel( .. ), Pixel8 )
import Codec.Picture.Types( MutableImage )
import Graphics.Rasterific.Types
import Graphics.Rasterific.Transformations
import Graphics.Rasterific.PatchTypes
import Graphics.Text.TrueType( Font, PointSize )
type Drawing px = F (DrawCommand px)
type DrawContext m px =
StateT (MutableImage (PrimState m) px) m
data px =
{ TextRange px -> Font
_textFont :: Font
, TextRange px -> PointSize
_textSize :: PointSize
, TextRange px -> String
_text :: String
, TextRange px -> Maybe (Texture px)
_textTexture :: Maybe (Texture px)
}
type ShaderFunction px = Float -> Float -> px
type ImageTransformer px = Int -> Int -> px -> px
type Gradient px = [(Float, px)]
data Texture (px :: Type)
= SolidTexture !px
| LinearGradientTexture !(Gradient px) !Line
| RadialGradientTexture !(Gradient px) !Point !Float
| RadialGradientWithFocusTexture !(Gradient px) !Point !Float !Point
| WithSampler !SamplerRepeat (Texture px)
| WithTextureTransform !Transformation (Texture px)
| SampledTexture !(Image px)
| RawTexture !(Image px)
| ShaderTexture !(ShaderFunction px)
| ModulateTexture (Texture px) (Texture (PixelBaseComponent px))
| AlphaModulateTexture (Texture px) (Texture (PixelBaseComponent px))
| PatternTexture !Int !Int !px (Drawing px ()) (Image px)
| MeshPatchTexture !PatchInterpolation !(MeshPatch px)
data DrawCommand px next
= Fill FillMethod [Primitive] next
| CustomRender (forall s. DrawContext (ST s) px ()) next
| MeshPatchRender !PatchInterpolation (MeshPatch px) next
| Stroke Float Join (Cap, Cap) [Primitive] next
| DashedStroke Float DashPattern Float Join (Cap, Cap) [Primitive] next
| TextFill Point [TextRange px] next
| SetTexture (Texture px)
(Drawing px ()) next
| WithGlobalOpacity (PixelBaseComponent px) (Drawing px ()) next
| WithImageEffect (Image px -> ImageTransformer px) (Drawing px ()) next
| WithCliping (forall innerPixel. Drawing innerPixel ())
(Drawing px ()) next
| WithTransform Transformation (Drawing px ()) next
| WithPathOrientation Path Float (Drawing px ()) next
dumpDrawing :: ( Show px
, Show (PixelBaseComponent px)
, PixelBaseComponent (PixelBaseComponent px)
~ (PixelBaseComponent px)
) => Drawing px () -> String
dumpDrawing :: Drawing px () -> String
dumpDrawing = Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go (Free (DrawCommand px) () -> String)
-> (Drawing px () -> Free (DrawCommand px) ())
-> Drawing px ()
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF where
go ::
( Show px
, Show (PixelBaseComponent px)
, PixelBaseComponent (PixelBaseComponent px)
~ (PixelBaseComponent px)
) => Free (DrawCommand px) () -> String
go :: Free (DrawCommand px) () -> String
go (Pure ()) = String
"return ()"
go (Free (MeshPatchRender PatchInterpolation
i MeshPatch px
m Free (DrawCommand px) ()
next)) =
String
"renderMeshPatch (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PatchInterpolation -> String
forall a. Show a => a -> String
show PatchInterpolation
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ MeshPatch px -> String
forall a. Show a => a -> String
show MeshPatch px
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") >>= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (CustomRender forall s. DrawContext (ST s) px ()
_r Free (DrawCommand px) ()
next)) =
String
"customRender _ >>= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (WithImageEffect Image px -> ImageTransformer px
_effect Drawing px ()
sub Free (DrawCommand px) ()
next)) =
String
"withImageEffect ({- fun -}) (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go (Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
sub) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") >>= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (WithGlobalOpacity PixelBaseComponent px
opa Drawing px ()
sub Free (DrawCommand px) ()
next)) =
String
"withGlobalOpacity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PixelBaseComponent px -> String
forall a. Show a => a -> String
show PixelBaseComponent px
opa String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go (Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
sub) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") >>= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (WithPathOrientation Path
path Float
point Drawing px ()
drawing Free (DrawCommand px) ()
next)) =
String
"withPathOrientation (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Path -> String
forall a. Show a => a -> String
show Path
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
point String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go (Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
drawing) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") >>= "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (Fill FillMethod
_ [Primitive]
prims Free (DrawCommand px) ()
next)) =
String
"fill " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Primitive] -> String
forall a. Show a => a -> String
show [Primitive]
prims String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" >>=\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (TextFill Point
_ [TextRange px]
texts Free (DrawCommand px) ()
next)) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"-- Text : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TextRange px -> String
forall px. TextRange px -> String
_text TextRange px
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" | TextRange px
t <- [TextRange px]
texts] String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (SetTexture Texture px
tx Drawing px ()
drawing Free (DrawCommand px) ()
next)) =
String
"withTexture (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Texture px -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Texture px -> String
dumpTexture Texture px
tx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") (" String -> String -> String
forall a. [a] -> [a] -> [a]
++
Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go (Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
drawing) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") >>=\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (DashedStroke Float
o DashPattern
pat Float
w Join
j (Cap, Cap)
cap [Primitive]
prims Free (DrawCommand px) ()
next)) =
String
"dashedStrokeWithOffset "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ DashPattern -> String
forall a. Show a => a -> String
show DashPattern
pat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Join -> String
forall a. Show a => a -> String
show Join
j String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Cap, Cap) -> String
forall a. Show a => a -> String
show (Cap, Cap)
cap String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Primitive] -> String
forall a. Show a => a -> String
show [Primitive]
prims String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" >>=\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (Stroke Float
w Join
j (Cap, Cap)
cap [Primitive]
prims Free (DrawCommand px) ()
next)) =
String
"stroke " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Join -> String
forall a. Show a => a -> String
show Join
j String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Cap, Cap) -> String
forall a. Show a => a -> String
show (Cap, Cap)
cap String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Primitive] -> String
forall a. Show a => a -> String
show [Primitive]
prims String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" >>=\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (WithTransform Transformation
trans Drawing px ()
sub Free (DrawCommand px) ()
next)) =
String
"withTransform (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Transformation -> String
forall a. Show a => a -> String
show Transformation
trans String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go (Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
sub) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") >>=\n "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
go (Free (WithCliping forall innerPixel. Drawing innerPixel ()
clipping Drawing px ()
draw Free (DrawCommand px) ()
next)) =
String
"withClipping (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand Pixel8) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go (F (DrawCommand Pixel8) () -> Free (DrawCommand Pixel8) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF (F (DrawCommand Pixel8) () -> Free (DrawCommand Pixel8) ())
-> F (DrawCommand Pixel8) () -> Free (DrawCommand Pixel8) ()
forall a b. (a -> b) -> a -> b
$ Texture Pixel8
-> F (DrawCommand Pixel8) () -> F (DrawCommand Pixel8) ()
forall px (m :: * -> *).
MonadFree (DrawCommand px) m =>
Texture px -> Drawing px () -> m ()
withTexture Texture Pixel8
clipTexture F (DrawCommand Pixel8) ()
forall innerPixel. Drawing innerPixel ()
clipping)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go (Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
draw) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")\n >>= " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Free (DrawCommand px) () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Free (DrawCommand px) () -> String
go Free (DrawCommand px) ()
next
where clipTexture :: Texture Pixel8
clipTexture = Pixel8 -> Texture Pixel8
forall px. px -> Texture px
SolidTexture (Pixel8
0xFF :: Pixel8)
withTexture :: Texture px -> Drawing px () -> m ()
withTexture Texture px
texture Drawing px ()
subActions =
DrawCommand px () -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> m ()) -> DrawCommand px () -> m ()
forall a b. (a -> b) -> a -> b
$ Texture px -> Drawing px () -> () -> DrawCommand px ()
forall px next.
Texture px -> Drawing px () -> next -> DrawCommand px next
SetTexture Texture px
texture Drawing px ()
subActions ()
dumpTexture :: ( Show px
, Show (PixelBaseComponent px)
, PixelBaseComponent (PixelBaseComponent px)
~ (PixelBaseComponent px)
) => Texture px -> String
dumpTexture :: Texture px -> String
dumpTexture (SolidTexture px
px) = String
"uniformTexture (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ px -> String
forall a. Show a => a -> String
show px
px String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
dumpTexture (MeshPatchTexture PatchInterpolation
i MeshPatch px
mpx) = String
"meshTexture (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PatchInterpolation -> String
forall a. Show a => a -> String
show PatchInterpolation
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ MeshPatch px -> String
forall a. Show a => a -> String
show MeshPatch px
mpx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
dumpTexture (LinearGradientTexture Gradient px
grad (Line Point
a Point
b)) =
String
"linearGradientTexture " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Gradient px -> String
forall a. Show a => a -> String
show Gradient px
grad String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point -> String
forall a. Show a => a -> String
show Point
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point -> String
forall a. Show a => a -> String
show Point
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
dumpTexture (RadialGradientTexture Gradient px
grad Point
p Float
rad) =
String
"radialGradientTexture " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Gradient px -> String
forall a. Show a => a -> String
show Gradient px
grad String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point -> String
forall a. Show a => a -> String
show Point
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
rad
dumpTexture (RadialGradientWithFocusTexture Gradient px
grad Point
center Float
rad Point
focus) =
String
"radialGradientWithFocusTexture " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Gradient px -> String
forall a. Show a => a -> String
show Gradient px
grad String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point -> String
forall a. Show a => a -> String
show Point
center
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
rad String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point -> String
forall a. Show a => a -> String
show Point
focus String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
dumpTexture (WithSampler SamplerRepeat
sampler Texture px
sub) =
String
"withSampler " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SamplerRepeat -> String
forall a. Show a => a -> String
show SamplerRepeat
sampler String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Texture px -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Texture px -> String
dumpTexture Texture px
sub String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
dumpTexture (WithTextureTransform Transformation
trans Texture px
sub) =
String
"transformTexture (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Transformation -> String
forall a. Show a => a -> String
show Transformation
trans String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Texture px -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Texture px -> String
dumpTexture Texture px
sub String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
dumpTexture (SampledTexture Image px
_) = String
"sampledImageTexture <IMG>"
dumpTexture (RawTexture Image px
_) = String
"<RAWTEXTURE>"
dumpTexture (ShaderTexture ShaderFunction px
_) = String
"shaderFunction <FUNCTION>"
dumpTexture (ModulateTexture Texture px
sub Texture (PixelBaseComponent px)
mask) =
String
"modulateTexture (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Texture px -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Texture px -> String
dumpTexture Texture px
sub String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Texture (PixelBaseComponent px) -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Texture px -> String
dumpTexture Texture (PixelBaseComponent px)
mask String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
dumpTexture (AlphaModulateTexture Texture px
sub Texture (PixelBaseComponent px)
mask) =
String
"alphaModulate (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Texture px -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Texture px -> String
dumpTexture Texture px
sub String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Texture (PixelBaseComponent px) -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Texture px -> String
dumpTexture Texture (PixelBaseComponent px)
mask String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
dumpTexture (PatternTexture Int
w Int
h px
px Drawing px ()
sub Image px
_) =
String
"patternTexture " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ px -> String
forall a. Show a => a -> String
show px
px
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Drawing px () -> String
forall px.
(Show px, Show (PixelBaseComponent px),
PixelBaseComponent (PixelBaseComponent px)
~ PixelBaseComponent px) =>
Drawing px () -> String
dumpDrawing Drawing px ()
sub String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
instance Functor (DrawCommand px) where
fmap :: (a -> b) -> DrawCommand px a -> DrawCommand px b
fmap a -> b
f (WithImageEffect Image px -> ImageTransformer px
effect Drawing px ()
sub a
next) =
(Image px -> ImageTransformer px)
-> Drawing px () -> b -> DrawCommand px b
forall px next.
(Image px -> ImageTransformer px)
-> Drawing px () -> next -> DrawCommand px next
WithImageEffect Image px -> ImageTransformer px
effect Drawing px ()
sub (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (TextFill Point
pos [TextRange px]
texts a
next) =
Point -> [TextRange px] -> b -> DrawCommand px b
forall px next.
Point -> [TextRange px] -> next -> DrawCommand px next
TextFill Point
pos [TextRange px]
texts (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (CustomRender forall s. DrawContext (ST s) px ()
m a
next) =
(forall s. DrawContext (ST s) px ()) -> b -> DrawCommand px b
forall px next.
(forall s. DrawContext (ST s) px ()) -> next -> DrawCommand px next
CustomRender forall s. DrawContext (ST s) px ()
m (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (WithGlobalOpacity PixelBaseComponent px
opa Drawing px ()
sub a
next) =
PixelBaseComponent px -> Drawing px () -> b -> DrawCommand px b
forall px next.
PixelBaseComponent px
-> Drawing px () -> next -> DrawCommand px next
WithGlobalOpacity PixelBaseComponent px
opa Drawing px ()
sub (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (Fill FillMethod
method [Primitive]
prims a
next) = FillMethod -> [Primitive] -> b -> DrawCommand px b
forall px next.
FillMethod -> [Primitive] -> next -> DrawCommand px next
Fill FillMethod
method [Primitive]
prims (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (SetTexture Texture px
t Drawing px ()
sub a
next) = Texture px -> Drawing px () -> b -> DrawCommand px b
forall px next.
Texture px -> Drawing px () -> next -> DrawCommand px next
SetTexture Texture px
t Drawing px ()
sub (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (WithCliping forall innerPixel. Drawing innerPixel ()
sub Drawing px ()
com a
next) =
(forall innerPixel. Drawing innerPixel ())
-> Drawing px () -> b -> DrawCommand px b
forall px next.
(forall innerPixel. Drawing innerPixel ())
-> Drawing px () -> next -> DrawCommand px next
WithCliping forall innerPixel. Drawing innerPixel ()
sub Drawing px ()
com (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (Stroke Float
w Join
j (Cap, Cap)
caps [Primitive]
prims a
next) =
Float -> Join -> (Cap, Cap) -> [Primitive] -> b -> DrawCommand px b
forall px next.
Float
-> Join -> (Cap, Cap) -> [Primitive] -> next -> DrawCommand px next
Stroke Float
w Join
j (Cap, Cap)
caps [Primitive]
prims (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (DashedStroke Float
st DashPattern
pat Float
w Join
j (Cap, Cap)
caps [Primitive]
prims a
next) =
Float
-> DashPattern
-> Float
-> Join
-> (Cap, Cap)
-> [Primitive]
-> b
-> DrawCommand px b
forall px next.
Float
-> DashPattern
-> Float
-> Join
-> (Cap, Cap)
-> [Primitive]
-> next
-> DrawCommand px next
DashedStroke Float
st DashPattern
pat Float
w Join
j (Cap, Cap)
caps [Primitive]
prims (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (WithTransform Transformation
trans Drawing px ()
draw a
next) =
Transformation -> Drawing px () -> b -> DrawCommand px b
forall px next.
Transformation -> Drawing px () -> next -> DrawCommand px next
WithTransform Transformation
trans Drawing px ()
draw (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (WithPathOrientation Path
path Float
point Drawing px ()
draw a
next) =
Path -> Float -> Drawing px () -> b -> DrawCommand px b
forall px next.
Path -> Float -> Drawing px () -> next -> DrawCommand px next
WithPathOrientation Path
path Float
point Drawing px ()
draw (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
fmap a -> b
f (MeshPatchRender PatchInterpolation
i MeshPatch px
mesh a
next) =
PatchInterpolation -> MeshPatch px -> b -> DrawCommand px b
forall px next.
PatchInterpolation -> MeshPatch px -> next -> DrawCommand px next
MeshPatchRender PatchInterpolation
i MeshPatch px
mesh (b -> DrawCommand px b) -> b -> DrawCommand px b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
next
instance Semigroup (Drawing px ()) where
<> :: Drawing px () -> Drawing px () -> Drawing px ()
(<>) Drawing px ()
a Drawing px ()
b = Drawing px ()
a Drawing px () -> Drawing px () -> Drawing px ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Drawing px ()
b
instance Monoid (Drawing px ()) where
mempty :: Drawing px ()
mempty = () -> Drawing px ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mappend :: Drawing px () -> Drawing px () -> Drawing px ()
mappend = Drawing px () -> Drawing px () -> Drawing px ()
forall a. Semigroup a => a -> a -> a
(<>)