module FlexibleDrawing where
import Geometry
import DrawTypes
import LayoutRequest
import Utils(aboth)
import Graphic
import MeasuredGraphics(MeasuredGraphics(..))
import GCtx(GCtx(..))
data FlexibleDrawing = FlexD Size Bool Bool (Rect->[DrawCommand]) deriving Int -> FlexibleDrawing -> ShowS
[FlexibleDrawing] -> ShowS
FlexibleDrawing -> String
(Int -> FlexibleDrawing -> ShowS)
-> (FlexibleDrawing -> String)
-> ([FlexibleDrawing] -> ShowS)
-> Show FlexibleDrawing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlexibleDrawing] -> ShowS
$cshowList :: [FlexibleDrawing] -> ShowS
show :: FlexibleDrawing -> String
$cshow :: FlexibleDrawing -> String
showsPrec :: Int -> FlexibleDrawing -> ShowS
$cshowsPrec :: Int -> FlexibleDrawing -> ShowS
Show
instance Graphic FlexibleDrawing where
measureGraphicK :: FlexibleDrawing -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (FlexD Size
s Bool
fh Bool
fv Rect -> [DrawCommand]
drawf) (GC GCId
gc FontData
_) MeasuredGraphics -> k i o
k =
MeasuredGraphics -> k i o
k (LayoutRequest
-> (Rect -> [(GCId, [DrawCommand])]) -> MeasuredGraphics
LeafM (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
s Bool
fh Bool
fv) Rect -> [(GCId, [DrawCommand])]
drawf')
where drawf' :: Rect -> [(GCId, [DrawCommand])]
drawf' Rect
r = [(GCId
gc,Rect -> [DrawCommand]
drawf Rect
r)]
filler :: Bool -> Bool -> Int -> FlexibleDrawing
filler Bool
fh Bool
fv Int
d = Size -> Bool -> Bool -> (Rect -> [DrawCommand]) -> FlexibleDrawing
FlexD (Int -> Size
diag Int
d) Bool
fh Bool
fv (\Rect
r->[Rect -> DrawCommand
FillRectangle Rect
r])
hFiller :: Int -> FlexibleDrawing
hFiller = Bool -> Bool -> Int -> FlexibleDrawing
filler Bool
False Bool
True
vFiller :: Int -> FlexibleDrawing
vFiller = Bool -> Bool -> Int -> FlexibleDrawing
filler Bool
True Bool
False
flex' :: Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Size
s = Size -> Bool -> Bool -> (Rect -> [DrawCommand]) -> FlexibleDrawing
FlexD Size
s Bool
False Bool
False
flex :: (Rect -> [DrawCommand]) -> FlexibleDrawing
flex = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Size
5
blank' :: Size -> FlexibleDrawing
blank' Size
s = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Size
s ([DrawCommand] -> Rect -> [DrawCommand]
forall a b. a -> b -> a
const [])
blank :: FlexibleDrawing
blank = Size -> FlexibleDrawing
blank' Size
5
frame' :: Size -> FlexibleDrawing
frame' Size
s = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Size
s (\Rect
r->[Rect -> DrawCommand
DrawRectangle (Rect
r Rect -> Size -> Rect
`growrect` (-Size
1))])
frame :: FlexibleDrawing
frame = Size -> FlexibleDrawing
frame' Size
5
ellipse :: FlexibleDrawing
ellipse = Size -> FlexibleDrawing
ellipse' Size
5
ellipse' :: Size -> FlexibleDrawing
ellipse' Size
s = Size -> Int -> Int -> FlexibleDrawing
arc' Size
s Int
0 (Int
360Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
64)
arc :: Int -> Int -> FlexibleDrawing
arc = Size -> Int -> Int -> FlexibleDrawing
arc' Size
5
arc' :: Size -> Int -> Int -> FlexibleDrawing
arc' Size
s Int
a1 Int
a2 = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Size
s (Int -> Int -> Rect -> [DrawCommand]
drawarc Int
a1 Int
a2)
filledEllipse :: FlexibleDrawing
filledEllipse = Size -> FlexibleDrawing
filledEllipse' Size
5
filledEllipse' :: Size -> FlexibleDrawing
filledEllipse' Size
s = Size -> Int -> Int -> FlexibleDrawing
filledarc' Size
s Int
0 (Int
360Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
64)
filledarc :: Int -> Int -> FlexibleDrawing
filledarc = Size -> Int -> Int -> FlexibleDrawing
filledarc' Size
5
filledarc' :: Size -> Int -> Int -> FlexibleDrawing
filledarc' Size
s Int
a1 Int
a2 = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Size
s (Int -> Int -> Rect -> [DrawCommand]
fillarc Int
a1 Int
a2)
drawarc :: Int -> Int -> Rect -> [DrawCommand]
drawarc Int
a1 Int
a2 Rect
r = [Rect -> Int -> Int -> DrawCommand
DrawArc (Rect
r Rect -> Size -> Rect
`growrect` (-Size
1)) Int
a1 Int
a2]
fillarc :: Int -> Int -> Rect -> [DrawCommand]
fillarc Int
a1 Int
a2 Rect
r = [Rect -> Int -> Int -> DrawCommand
FillArc (Rect
r Rect -> Size -> Rect
`growrect` (-Size
1)) Int
a1 Int
a2]
rpar :: FlexibleDrawing
rpar = (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex (Int -> Int -> Rect -> [DrawCommand]
drawarc (-Int
60Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
64) (Int
120Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
64)(Rect -> [DrawCommand]) -> (Rect -> Rect) -> Rect -> [DrawCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> Rect
doubleleft)
lpar :: FlexibleDrawing
lpar = (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex (Int -> Int -> Rect -> [DrawCommand]
drawarc (Int
120Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
64) (Int
120Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
64)(Rect -> [DrawCommand]) -> (Rect -> Rect) -> Rect -> [DrawCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> Rect
doubleright)
doubleleft :: Rect -> Rect
doubleleft (Rect Size
p s :: Size
s@(Point Int
w Int
_)) = Size -> Size -> Rect
Rect (Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
d) (Size
sSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
d) where d :: Size
d=Int -> Int -> Size
Point Int
w Int
0
doubleright :: Rect -> Rect
doubleright (Rect Size
p s :: Size
s@(Point Int
w Int
_)) = Size -> Size -> Rect
Rect Size
p (Size
sSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
d) where d :: Size
d=Int -> Int -> Size
Point Int
w Int
0
lbrack :: FlexibleDrawing
lbrack = (FlexibleDrawing, FlexibleDrawing) -> FlexibleDrawing
forall a b. (a, b) -> a
fst (FlexibleDrawing, FlexibleDrawing)
bracks
rbrack :: FlexibleDrawing
rbrack = (FlexibleDrawing, FlexibleDrawing) -> FlexibleDrawing
forall a b. (a, b) -> b
snd (FlexibleDrawing, FlexibleDrawing)
bracks
bracks :: (FlexibleDrawing, FlexibleDrawing)
bracks = ((Rect -> [DrawCommand]) -> FlexibleDrawing)
-> (Rect -> [DrawCommand], Rect -> [DrawCommand])
-> (FlexibleDrawing, FlexibleDrawing)
forall t b. (t -> b) -> (t, t) -> (b, b)
aboth (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex (Bool -> Rect -> [DrawCommand]
draw Bool
False, Bool -> Rect -> [DrawCommand]
draw Bool
True)
where
draw :: Bool -> Rect -> [DrawCommand]
draw Bool
right Rect
r = [Line -> DrawCommand
DrawLine (Size -> Size -> Line
Line Size
p1 Size
p2) | (Size
p1,Size
p2) <- [(Size, Size)]
ls ]
where (Size
p1,Size
p2,Size
p3,Size
p4) = Rect -> (Size, Size, Size, Size)
corners (Rect
r Rect -> Size -> Rect
`moverect` Size
1 Rect -> Size -> Rect
`growrect` (-Size
2))
ls :: [(Size, Size)]
ls = if Bool
right
then [(Size
p1,Size
p2),(Size
p2,Size
p4),(Size
p3,Size
p4)]
else [(Size
p1,Size
p2),(Size
p1,Size
p3),(Size
p3,Size
p4)]
corners :: Rect -> (Size, Size, Size, Size)
corners (Rect Size
p s :: Size
s@(Point Int
w Int
h)) = (Size
p,Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Int -> Int -> Size
pP Int
w Int
0,Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Int -> Int -> Size
pP Int
0 Int
h,Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
s)
lbrace :: FlexibleDrawing
lbrace = (FlexibleDrawing, FlexibleDrawing) -> FlexibleDrawing
forall a b. (a, b) -> a
fst (FlexibleDrawing, FlexibleDrawing)
braces
rbrace :: FlexibleDrawing
rbrace = (FlexibleDrawing, FlexibleDrawing) -> FlexibleDrawing
forall a b. (a, b) -> b
snd (FlexibleDrawing, FlexibleDrawing)
braces
braces :: (FlexibleDrawing, FlexibleDrawing)
braces = ((Rect -> [DrawCommand]) -> FlexibleDrawing)
-> (Rect -> [DrawCommand], Rect -> [DrawCommand])
-> (FlexibleDrawing, FlexibleDrawing)
forall t b. (t -> b) -> (t, t) -> (b, b)
aboth (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex2 (Bool -> Rect -> [DrawCommand]
draw Bool
False, Bool -> Rect -> [DrawCommand]
draw Bool
True)
where
draw :: Bool -> Rect -> [DrawCommand]
draw Bool
right Rect
r = [CoordMode -> [Size] -> DrawCommand
DrawLines CoordMode
CoordModePrevious [Size]
ls]
where (Size
tl,Size
tr,Size
bl,Size
br) = Rect -> (Size, Size, Size, Size)
corners (Rect
r Rect -> Size -> Rect
`moverect` Size
1 Rect -> Size -> Rect
`growrect` (-Size
2))
h :: Int
h = Size -> Int
ycoord (Size
blSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
tl)
d :: Int
d = Int
h Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4
ls :: [Size]
ls = if Bool
right
then [Size
tl,Int -> Size
east Int
1,Int -> Size
se Int
2,Int -> Size
south Int
d,Int -> Size
se Int
2,Int -> Size
sw Int
2,Int -> Size
south Int
d,Int -> Size
sw Int
2,Int -> Size
west Int
1]
else [Size
tr,Int -> Size
west Int
1,Int -> Size
sw Int
2,Int -> Size
south Int
d,Int -> Size
sw Int
2,Int -> Size
se Int
2,Int -> Size
south Int
d,Int -> Size
se Int
2,Int -> Size
east Int
1]
west :: Int -> Size
west Int
n = Int -> Int -> Size
pP (-Int
n) Int
0
east :: Int -> Size
east Int
n = Int -> Int -> Size
pP Int
n Int
0
sw :: Int -> Size
sw Int
n = Int -> Int -> Size
pP (-Int
n) Int
n
se :: Int -> Size
se Int
n = Int -> Int -> Size
pP Int
n Int
n
south :: Int -> Size
south Int
n = Int -> Int -> Size
pP Int
0 Int
n
bFlex2 :: (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex2 = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex' (Int -> Int -> Size
pP Int
8 Int
12)
bFlex :: (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex' (Int -> Int -> Size
pP Int
5 Int
10)
bFlex' :: Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex' Size
size = Size -> Bool -> Bool -> (Rect -> [DrawCommand]) -> FlexibleDrawing
FlexD Size
size Bool
True Bool
False
rAngleBracket :: FlexibleDrawing
rAngleBracket = (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex2 ([Size] -> [DrawCommand]
drawpoly ([Size] -> [DrawCommand])
-> (Rect -> [Size]) -> Rect -> [DrawCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> [Size]) -> Rect -> [Size]
hMirror Rect -> [Size]
abPoints)
lAngleBracket :: FlexibleDrawing
lAngleBracket = (Rect -> [DrawCommand]) -> FlexibleDrawing
bFlex2 ([Size] -> [DrawCommand]
drawpoly ([Size] -> [DrawCommand])
-> (Rect -> [Size]) -> Rect -> [DrawCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> [Size]
abPoints)
abPoints :: Rect -> [Size]
abPoints = Rect -> [Size]
abPoints'
abPoints' :: Rect -> [Size]
abPoints' Rect
r = [Size
ur,Size
ml,Size
lr]
where
(ul :: Size
ul@(Point Int
lx Int
ty),Size
ur,Size
_,lr :: Size
lr@(Point Int
rx Int
by)) =
Rect -> (Size, Size, Size, Size)
corners (Rect
r Rect -> Size -> Rect
`moverect` Size
1 Rect -> Size -> Rect
`growrect` (-Size
2))
ml :: Size
ml = Int -> Int -> Size
Point (Int
rxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d) Int
my
my :: Int
my = Int
tyInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h2
h2 :: Int
h2 = (Int
byInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ty) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
d :: Int
d = (Int
h2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` (Int
rxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lx)
triangleUp :: FlexibleDrawing
triangleUp = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Size
size ([Size] -> [DrawCommand]
drawpoly ([Size] -> [DrawCommand])
-> (Rect -> [Size]) -> Rect -> [DrawCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> [Size]
trianglePoints')
filledTriangleUp :: FlexibleDrawing
filledTriangleUp = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Size
size ([Size] -> [DrawCommand]
fillpoly ([Size] -> [DrawCommand])
-> (Rect -> [Size]) -> Rect -> [DrawCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> [Size]
trianglePoints')
triangleDown :: FlexibleDrawing
triangleDown = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Size
size ([Size] -> [DrawCommand]
drawpoly ([Size] -> [DrawCommand])
-> (Rect -> [Size]) -> Rect -> [DrawCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> [Size]) -> Rect -> [Size]
vMirror Rect -> [Size]
trianglePoints')
filledTriangleDown :: FlexibleDrawing
filledTriangleDown = Size -> (Rect -> [DrawCommand]) -> FlexibleDrawing
flex' Size
size ([Size] -> [DrawCommand]
fillpoly ([Size] -> [DrawCommand])
-> (Rect -> [Size]) -> Rect -> [DrawCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> [Size]) -> Rect -> [Size]
vMirror Rect -> [Size]
trianglePoints')
size :: Size
size = Int -> Int -> Size
Point Int
18 Int
14
drawpoly :: [Size] -> [DrawCommand]
drawpoly [Size]
ps = [CoordMode -> [Size] -> DrawCommand
DrawLines CoordMode
CoordModeOrigin [Size]
ps]
fillpoly :: [Size] -> [DrawCommand]
fillpoly [Size]
ps = [Shape -> CoordMode -> [Size] -> DrawCommand
FillPolygon Shape
Convex CoordMode
CoordModeOrigin [Size]
ps]
shrink :: Rect -> Rect
shrink = (Rect -> Size -> Rect) -> Size -> Rect -> Rect
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rect -> Size -> Rect
growrect (-Size
1)
trianglePoints' :: Rect -> [Size]
trianglePoints' = Rect -> [Size]
trianglePoints (Rect -> [Size]) -> (Rect -> Rect) -> Rect -> [Size]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> Rect
shrink
trianglePoints :: Rect -> [Size]
trianglePoints (Rect Size
p s :: Size
s@(Point Int
w Int
h)) = [Size
p1,Size
p2,Size
p3,Size
p1]
where m :: Int
m = Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
p1 :: Size
p1 = Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Int -> Int -> Size
pP Int
m Int
0
p2 :: Size
p2 = Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
s
p3 :: Size
p3 = Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Int -> Int -> Size
pP Int
0 Int
h
vMirror :: (Rect -> [Size]) -> Rect -> [Size]
vMirror Rect -> [Size]
f r :: Rect
r@(Rect (Point Int
x0 Int
y0) s :: Size
s@(Point Int
_ Int
h)) =
[ Size -> Size
m Size
p | Size
p <- Rect -> [Size]
f (Size -> Size -> Rect
Rect (Int -> Int -> Size
Point Int
x0 Int
0) Size
s)]
where m :: Size -> Size
m (Point Int
x Int
y) = Int -> Int -> Size
Point Int
x (Int
y1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y)
y1 :: Int
y1 = Int
y0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
hMirror :: (Rect -> [Size]) -> Rect -> [Size]
hMirror Rect -> [Size]
f r :: Rect
r@(Rect (Point Int
x0 Int
y0) s :: Size
s@(Point Int
w Int
_)) =
[ Size -> Size
m Size
p | Size
p <- Rect -> [Size]
f (Size -> Size -> Rect
Rect (Int -> Int -> Size
Point Int
0 Int
y0) Size
s)]
where m :: Size -> Size
m (Point Int
x Int
y) = Int -> Int -> Size
Point (Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) Int
y
x1 :: Int
x1 = Int
x0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
padFD :: Int -> FlexibleDrawing -> FlexibleDrawing
padFD Int
d (FlexD Size
s Bool
fh Bool
fv Rect -> [DrawCommand]
f) = Size -> Bool -> Bool -> (Rect -> [DrawCommand]) -> FlexibleDrawing
FlexD (Size
sSize -> Size -> Size
forall a. Num a => a -> a -> a
+Int -> Size
diag (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d)) Bool
fh Bool
fv Rect -> [DrawCommand]
f'
where f' :: Rect -> [DrawCommand]
f' (Rect Size
p Size
s) = Rect -> [DrawCommand]
f (Size -> Size -> Rect
Rect (Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Int -> Size
diag Int
d) (Size
sSize -> Size -> Size
forall a. Num a => a -> a -> a
-Int -> Size
diag Int
d))