module FlexibleDrawing where
import Geometry
import DrawTypes
--import Xtypes(CoordMode(..),Shape(..))
import LayoutRequest
--import EitherUtils(Cont(..))
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])

--filledRect = filler False False
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

-- top level pattern bindings (with pbu) can't be trusted...
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

{-
polyLine p [] = []
polyLine p (v:vs) = (p,p'):polyLine p' vs
  where p' = p+v
-}

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))