module MeasuredGraphics(DPath,up,MeasuredGraphics(..),compileMG,emptyMG,emptyMG',measureString,measureImageString{-,measurePackedString-}) where
import Geometry
import LayoutRequest
--import Placers2(overlayP)
import AutoPlacer(autoP)
import XDraw
import ResourceIds(GCId)
import Font
import TextExtents(queryTextExtents16K)
import Rects(boundingRect)
import CompiledGraphics
import GCtx(GCtx(..))
import GCAttrs(FontData(..),fontdata2struct)
--import PackedString(unpackPS)
import Utils(lunconcat)
--import CmdLineEnv(argFlag)
import Debug.Trace(trace)

tr :: p -> p -> p
tr p
x p
y = p
y

type DPath = [Int] -- path to a part of a drawing

up :: DPath -> DPath
up :: DPath -> DPath
up [] = []
up DPath
path = forall a. [a] -> [a]
init DPath
path

data MeasuredGraphics
--  = LeafM LayoutRequest GCtx (Rect->[DrawCommand])
	    -- GCtx should be replaced by GCId !
  = LeafM LayoutRequest (Rect->[(GCId,[DrawCommand])])
  | SpacedM Spacer MeasuredGraphics
  | PlacedM Placer MeasuredGraphics
  | MarkM GCtx MeasuredGraphics -- path & Gctx preserving nodes
  | ComposedM [MeasuredGraphics]

emptyMG :: Size -> MeasuredGraphics
emptyMG Size
size = LayoutRequest -> MeasuredGraphics
emptyMG' (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
size Bool
False Bool
False)
emptyMG' :: LayoutRequest -> MeasuredGraphics
emptyMG' LayoutRequest
layout = LayoutRequest
-> (Rect -> [(GCId, [DrawCommand])]) -> MeasuredGraphics
LeafM LayoutRequest
layout (forall a b. a -> b -> a
const [])

compileMG :: (Size -> Size)
-> MeasuredGraphics -> (CompiledGraphics, LayoutRequest)
compileMG Size -> Size
f MeasuredGraphics
mg = (CompiledGraphics
cg,LayoutRequest
req)
  where
    ([LayoutRequest]
reqs,CompiledGraphics
cg) = forall {p} {p}. p -> p -> p
tr String
"layoutMG" forall a b. (a -> b) -> a -> b
$ MeasuredGraphics -> [Rect] -> ([LayoutRequest], CompiledGraphics)
layoutMG MeasuredGraphics
mg [Rect]
places
    (LayoutRequest
req0,Rect -> [Rect]
placer2) = Placer -> Placer1
unP Placer
autoP [LayoutRequest]
reqs
    req :: LayoutRequest
req = (Size -> Size) -> LayoutRequest -> LayoutRequest
mapLayoutSize Size -> Size
f LayoutRequest
req0
    place :: Rect
place = forall {p} {p}. p -> p -> p
tr String
"Rect" forall a b. (a -> b) -> a -> b
$ Size -> Size -> Rect
Rect Size
origin (LayoutRequest -> Size
minsize LayoutRequest
req)
    places :: [Rect]
places = Rect -> [Rect]
placer2 Rect
place

    layoutMG :: MeasuredGraphics -> [Rect] -> ([LayoutRequest],CompiledGraphics)
    layoutMG :: MeasuredGraphics -> [Rect] -> ([LayoutRequest], CompiledGraphics)
layoutMG MeasuredGraphics
mg [Rect]
rs =
      case MeasuredGraphics
mg of
        MarkM GCtx
_ MeasuredGraphics
mg' -> ([LayoutRequest]
lls,CompiledGraphics -> CompiledGraphics
cgMark CompiledGraphics
cg)
	  where ([LayoutRequest]
lls,CompiledGraphics
cg) = MeasuredGraphics -> [Rect] -> ([LayoutRequest], CompiledGraphics)
layoutMG MeasuredGraphics
mg' [Rect]
rs
	LeafM LayoutRequest
ll Rect -> [(GCId, [DrawCommand])]
rcmds -> (forall {p} {p}. p -> p -> p
tr String
"LeafM"  [LayoutRequest
ll],Rect -> (Rect -> [(GCId, [DrawCommand])]) -> CompiledGraphics
cgLeaf Rect
r Rect -> [(GCId, [DrawCommand])]
rcmds)
	  where [Rect
r] = [Rect]
rs -- bug if length rs/=1 !!
	SpacedM (S Spacer1
spacer1) MeasuredGraphics
mg' -> (forall {p} {p}. p -> p -> p
tr String
"SpaceM" [LayoutRequest]
lls',CompiledGraphics -> CompiledGraphics
cgMark CompiledGraphics
cg)
	  where ([LayoutRequest]
lls,CompiledGraphics
cg) = MeasuredGraphics -> [Rect] -> ([LayoutRequest], CompiledGraphics)
layoutMG MeasuredGraphics
mg' [Rect]
rs'
	        ([LayoutRequest]
lls',[Rect -> Rect]
spacer2s) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall a b. (a -> b) -> [a] -> [b]
map Spacer1
spacer1 [LayoutRequest]
lls)
	        rs' :: [Rect]
rs' = forall {t} {t} {a}. (t -> t -> a) -> [t] -> [t] -> [a]
map2' forall a. a -> a
id [Rect -> Rect]
spacer2s [Rect]
rs
	PlacedM (P Placer1
placer1) MeasuredGraphics
mg -> (forall {p} {p}. p -> p -> p
tr String
"PlacedM" [LayoutRequest
ll'],CompiledGraphics -> CompiledGraphics
cgMark CompiledGraphics
cg)
	  where ([LayoutRequest]
lls,CompiledGraphics
cg) = MeasuredGraphics -> [Rect] -> ([LayoutRequest], CompiledGraphics)
layoutMG MeasuredGraphics
mg [Rect]
rs'
		(LayoutRequest
ll',Rect -> [Rect]
placer2) = Placer1
placer1 [LayoutRequest]
lls
		rs' :: [Rect]
rs' = Rect -> [Rect]
placer2 Rect
r
		[Rect
r] = forall {p} {p}. p -> p -> p
tr (String
"#rs="forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rect]
rs)) [Rect]
rs
	ComposedM [] -> (forall {p} {p}. p -> p -> p
tr String
"ComposedM []" [],Rect -> [CompiledGraphics] -> CompiledGraphics
cgCompose (Size -> Size -> Rect
Rect Size
origin Size
origin) [])
	ComposedM [MeasuredGraphics]
mgs -> (forall {p} {p}. p -> p -> p
tr String
"ComposedM" [LayoutRequest]
lls',Rect -> [CompiledGraphics] -> CompiledGraphics
cgCompose Rect
r [CompiledGraphics]
cgs)
	  where ([[LayoutRequest]]
llss,[CompiledGraphics]
cgs) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall {t} {t} {a}. (t -> t -> a) -> [t] -> [t] -> [a]
map2' MeasuredGraphics -> [Rect] -> ([LayoutRequest], CompiledGraphics)
layoutMG [MeasuredGraphics]
mgs [[Rect]]
rss)
	        lls' :: [LayoutRequest]
lls' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LayoutRequest]]
llss
		r :: Rect
r = case [Rect]
rs of
		      [] -> forall a. String -> a -> a
trace (String
"ComposedM, rs=[], length mgs="forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [MeasuredGraphics]
mgs)) (Int -> Int -> Int -> Int -> Rect
rR Int
0 Int
0 Int
1 Int
1)
		      [Rect]
_ -> forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Rect -> Rect -> Rect
boundingRect [Rect]
rs -- !!
	        rss :: [[Rect]]
rss = forall {a1} {a2}. [[a1]] -> [a2] -> [[a2]]
lunconcat [[LayoutRequest]]
llss [Rect]
rs

measureString'' :: (p -> String)
-> (Size -> p -> DrawCommand)
-> p
-> GCtx
-> (MeasuredGraphics -> f hi ho)
-> f hi ho
measureString'' p -> String
unpack Size -> p -> DrawCommand
draw p
s (GC GCId
gc FontData
fd) MeasuredGraphics -> f hi ho
k =
     forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
(Int -> Int -> Int -> Size -> f hi ho) -> f hi ho
measure forall a b. (a -> b) -> a -> b
$ \ Int
a Int
d Int
next Size
size ->
     let p1 :: Size
p1 = Int -> Int -> Size
Point Int
0 Int
a
	 p2 :: Size
p2 = Int -> Int -> Size
Point Int
next Int
a
	 drawit :: Rect -> [(GCId, [DrawCommand])]
drawit (Rect Size
p (Point Int
_ Int
h)) = [(GCId
gc,[Size -> p -> DrawCommand
draw (Size
pforall a. Num a => a -> a -> a
+(Int -> Int -> Size
Point Int
0 (Int
hforall a. Num a => a -> a -> a
-Int
d))) p
s])]
	 size' :: Size
size' = Int -> Int -> Size
Point (Size -> Int
xcoord Size
p2) (Size -> Int
ycoord Size
size) -- paragraphP bug workaround
     in --trace (unwords ["measureString ",unpack s,"rect",show r]) $
        MeasuredGraphics -> f hi ho
k (LayoutRequest
-> (Rect -> [(GCId, [DrawCommand])]) -> MeasuredGraphics
LeafM (Size -> Bool -> Bool -> [Size] -> LayoutRequest
refpLayout Size
size' Bool
True Bool
True [Size
p1,Size
p2]) Rect -> [(GCId, [DrawCommand])]
drawit)
  where
    us :: String
us = p -> String
unpack p
s
    measure :: (Int -> Int -> Int -> Size -> f hi ho) -> f hi ho
measure Int -> Int -> Int -> Size -> f hi ho
k =
      case FontData
fd of
        FS FontStruct
fs -> Int -> Int -> Int -> Size -> f hi ho
k Int
a Int
d Int
next Size
size
	  where
	    Rect Size
_ Size
size = FontStruct -> String -> Rect
string_rect FontStruct
fs String
us
	    a :: Int
a = forall per_char. FontStructF per_char -> Int
font_ascent FontStruct
fs
	    d :: Int
d = forall per_char. FontStructF per_char -> Int
font_descent FontStruct
fs
	    next :: Int
next = FontStruct -> String -> Int
next_pos FontStruct
fs String
us
	FID FontStruct
fs ->
          let fid :: FontId
fid = forall per_char. FontStructF per_char -> FontId
font_id FontStruct
fs
	  in  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
us
   	      then forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FontId
-> String -> (Int -> Int -> CharStruct -> f hi ho) -> f hi ho
queryTextExtents16K FontId
fid String
" " forall a b. (a -> b) -> a -> b
$ \ Int
a Int
d CharStruct
cs ->
	           Int -> Int -> Int -> Size -> f hi ho
k Int
a Int
d Int
0 (Int -> Int -> Size
Point Int
0 (Int
aforall a. Num a => a -> a -> a
+Int
d))
	      else forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FontId
-> String -> (Int -> Int -> CharStruct -> f hi ho) -> f hi ho
queryTextExtents16K FontId
fid String
us forall a b. (a -> b) -> a -> b
$ \ Int
a Int
d CharStruct
cs ->
	           Int -> Int -> Int -> Size -> f hi ho
k Int
a Int
d (CharStruct -> Int
char_width CharStruct
cs) (Int -> Int -> Size
Point (CharStruct -> Int
char_rbearing CharStruct
cs) (Int
aforall a. Num a => a -> a -> a
+Int
d))

measureString' :: (Size -> String -> DrawCommand)
-> (Size -> String -> DrawCommand)
-> String
-> GCtx
-> (MeasuredGraphics -> f hi ho)
-> f hi ho
measureString' Size -> String -> DrawCommand
draw8 Size -> String -> DrawCommand
draw16 String
s gctx :: GCtx
gctx@(GC GCId
_ FontData
fd) MeasuredGraphics -> f hi ho
k =
    forall {f :: * -> * -> *} {p} {hi} {ho}.
FudgetIO f =>
(p -> String)
-> (Size -> p -> DrawCommand)
-> p
-> GCtx
-> (MeasuredGraphics -> f hi ho)
-> f hi ho
measureString'' forall a. a -> a
id Size -> String -> DrawCommand
draw String
s GCtx
gctx MeasuredGraphics -> f hi ho
k
  where
    fs :: FontStruct
fs = forall {t}. FontData -> (FontStruct -> t) -> t
fontdata2struct FontData
fd forall a. a -> a
id
    draw :: Size -> String -> DrawCommand
draw = if forall a b. (a, b) -> b
snd (forall {per_char}. FontStructF per_char -> (Char, Char)
font_range FontStruct
fs) forall a. Ord a => a -> a -> Bool
<= Char
'\xff' then Size -> String -> DrawCommand
draw8 else Size -> String -> DrawCommand
draw16

measureString :: String -> GCtx -> (MeasuredGraphics -> f hi ho) -> f hi ho
measureString String
s = forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
(Size -> String -> DrawCommand)
-> (Size -> String -> DrawCommand)
-> String
-> GCtx
-> (MeasuredGraphics -> f hi ho)
-> f hi ho
measureString' Size -> String -> DrawCommand
DrawString Size -> String -> DrawCommand
DrawString16 String
s
measureImageString :: String -> GCtx -> (MeasuredGraphics -> f hi ho) -> f hi ho
measureImageString String
s = forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
(Size -> String -> DrawCommand)
-> (Size -> String -> DrawCommand)
-> String
-> GCtx
-> (MeasuredGraphics -> f hi ho)
-> f hi ho
measureString' Size -> String -> DrawCommand
DrawImageString Size -> String -> DrawCommand
DrawImageString16 String
s

{- old:
measureString =
  if argFlag "string16bit" False
  then measureString' id DrawString16
  else measureString' id DrawString
-}

--measurePackedString ps = measureString'' unpackPS DrawStringPS ps


-- map2' is a lazier version of map2 (aka zipWith)
-- length (map2' f xs ys) = length xs,
-- map2' f xs ys = map2' f xs (ys++repeat undefined)
map2' :: (t -> t -> a) -> [t] -> [t] -> [a]
map2' t -> t -> a
f [] [t]
_ = []
map2' t -> t -> a
f (t
x:[t]
xs) ~(t
y:[t]
ys) = t -> t -> a
f t
x t
yforall a. a -> [a] -> [a]
:(t -> t -> a) -> [t] -> [t] -> [a]
map2' t -> t -> a
f [t]
xs [t]
ys