implementation module layout import StdBool, StdInt, StdList, StdMisc, StdTuple import commondef, id from windowhandle import :: LayoutInfo(LayoutFix,LayoutFun,LayoutFrame), :: Origin layoutError :: String String -> .x layoutError rule message = error rule "layout" message layoutFatalError :: String String -> .x layoutFatalError rule message = fatalError rule "layout" message // The data types used for calculating the layout: :: LayoutItem = { liId :: !Id // The Id of the item , liItemPos :: !ItemPos // The ItemPos of the item , liItemSize :: !Size // The Size of the item } :: Root = { rootItem :: !LayoutItem // The original item that has been laid out , rootPos :: !Vector2 // The exact location of the item relative to current origin , rootTree :: ![Relative] // The dependent items } :: Relative = { relativeItem:: !LayoutItem // The original item that has been laid out , relativePos :: !Vector2 // The exact location of the item relative to current origin } // Basic operations on LayoutItems, Roots, and Relatives: identifyLayoutItem :: !Id !LayoutItem -> Bool identifyLayoutItem id {liId} = id==liId identifyRoot :: !Id !Root -> Bool identifyRoot id {rootItem} = identifyLayoutItem id rootItem identifyRelative :: !Id !Relative -> Bool identifyRelative id {relativeItem} = identifyLayoutItem id relativeItem /* removeRoot id removes that Root from the [Root] that either: * can be identified by id, or * contains a Relative that can be identified by id */ removeRoot :: !Id ![Root] -> (!Bool,Root,![Root]) removeRoot id [item:items] | identifyRoot id item = (True,item,items) | contains (identifyRelative id) item.rootTree = (True,item,items) | otherwise # (found,root,items) = removeRoot id items = (found,root,[item:items]) removeRoot _ items = (False,undef,items) /* getLayoutItemPosSize id retrieves the position and size of: * the Root argument in case id identifies the root, or * the Relative that can be identified by id */ getLayoutItemPosSize :: !Id !Root -> (!Bool,!Vector2,!Size) getLayoutItemPosSize id item | identifyRoot id item = (True,item.rootPos,item.rootItem.liItemSize) # (found,relative) = cselect (identifyRelative id) undef item.rootTree | not found = (False,zero,zero) | otherwise = (True,relative.relativePos,relative.relativeItem.liItemSize) /* shiftRelative v shifts the position of the Relative argument by v. */ shiftRelative :: !Vector2 !Relative -> Relative shiftRelative v item=:{relativePos} = {item & relativePos=relativePos+v} /* shiftRoot v shifts the position of the Root argument and its Relatives by v. */ shiftRoot :: !Vector2 !Root -> Root shiftRoot offset item=:{rootPos,rootTree} = {item & rootPos=rootPos+offset,rootTree=map (shiftRelative offset) rootTree} /* getRootBoundingBox calculates the smallest enclosing rectangle of the Root argument and its Relatives. */ getRootBoundingBox :: !Root -> OSRect getRootBoundingBox item=:{rootPos={vx,vy},rootItem={liItemSize},rootTree} = getRelativeBoundingBox rootTree (posSizeToRect {x=vx,y=vy} liItemSize) where getRelativeBoundingBox :: ![Relative] !OSRect -> OSRect getRelativeBoundingBox [item:items] boundBox = getRelativeBoundingBox items (mergeBoundingBox boundBox (posSizeToRect {x=vx,y=vy} item.relativeItem.liItemSize)) where {vx,vy} = item.relativePos mergeBoundingBox :: !OSRect !OSRect -> OSRect mergeBoundingBox {rleft=lR,rtop=tR,rright=rR,rbottom=bR} {rleft=lB,rtop=tB,rright=rB,rbottom=bB} = {rleft=min lR lB,rtop=min tR tB,rright=max rR rB,rbottom=max bR bB} getRelativeBoundingBox _ boundBox = boundBox /* getLayoutItem id roots retrieves the position (Vector2) and size (Size) of the item identified by id. In case the item is a relative, it is removed from the [Root]. In case the item is a root, it is removed only if it has an empty layout tree. The LayoutInfo classifies the ItemPos of the layout root of the retrieved item. getLayoutItem returns a runtime error in case no item could be identified. */ getLayoutItem :: !Id ![Root] -> (!LayoutInfo,!Vector2,!Size,![Root]) getLayoutItem id items=:[root:roots] | identifyRoot id root | isEmpty depends = (layoutInfo,corner,size,roots) // otherwise = (layoutInfo,corner,size,items) | inTree = (layoutInfo,rPos,rSize,[{root & rootTree=depends1}:roots]) | otherwise # (layoutInfo,pos,size,roots) = getLayoutItem id roots = (layoutInfo,pos,size,[root:roots]) where corner = root.rootPos size = root.rootItem.liItemSize depends = root.rootTree (inTree,rPos,rSize,depends1) = getRelativeItem id depends layoutInfo = case root.rootItem.liItemPos of (Fix,_) -> LayoutFix (_,OffsetFun i f) -> LayoutFun i f _ -> LayoutFrame getRelativeItem :: !Id ![Relative] -> (!Bool,!Vector2,!Size,![Relative]) getRelativeItem id [item:items] | identifyRelative id item = (True,item.relativePos,item.relativeItem.liItemSize,items) | otherwise # (found,pos,size,items) = getRelativeItem id items = (found,pos,size,[item:items]) getRelativeItem _ items = (False,zero,zero,items) getLayoutItem id _ = layoutError "getLayoutItem" "Unknown Id" /* layoutItems is the actual layout algorithm. It calculates the precise position (in pixels) of each LayoutItem. The position is calculated from a zero origin. Assumptions: - All LayoutItems have a layout element ItemPos. - All relative references to previous elements have been identified (so LeftOfPrev --> LeftOf id and so on). */ layoutItems :: !(!Int,!Int) !(!Int,!Int) !(!Int,!Int) !Size !Size ![(ViewDomain,Point2)] ![LayoutItem] -> (!Size,![Root]) layoutItems hMargins=:(lMargin,rMargin) vMargins=:(tMargin,bMargin) itemSpaces reqSize minSize orientations layoutItems # reqSize = if (reqSize<>zero) {w=reqSize.w-lMargin-rMargin,h=reqSize.h-tMargin-bMargin} reqSize # layoutItems = sortLayoutItems layoutItems # (_,roots) = stateMap2 (calcRootPosition itemSpaces orientations) layoutItems (0,[]) size = calcAreaSize orientations roots reqSize minSize # roots = stateMap2 (calcFramePosition hMargins vMargins orientations size) roots [] finalSize = {w=lMargin+size.w+rMargin,h=tMargin+size.h+bMargin} = (finalSize,roots) /* sortLayoutItems sorts the list of item positions such that relatively laynout items are placed immediately(!!) behind their target items. They are not placed in the rootTree of the target item. This is done by calcRootPosition. sortLayoutItems failures: - a cyclic dependency has been located: the Ids are printed and computation stops - unknown references have been located: the Ids are printed and computation stops */ sortLayoutItems :: ![LayoutItem] -> [LayoutItem] sortLayoutItems layoutItems # (lineItems,relItems) = divide (\{liItemPos}->IsLine liItemPos) layoutItems # layoutItems = lineItems++relItems # layoutItems = sortLayoutItems` [] layoutItems = layoutItems where sortLayoutItems` :: ![LayoutItem] ![LayoutItem] -> [LayoutItem] sortLayoutItems` done todo | isEmpty todo = reverse done # (item1,todo) = hdtl todo pos1 = item1.liItemPos (isRelative,id2) = IsRelative pos1 | not isRelative = sortLayoutItems` [item1:done] todo | otherwise # (done,chain,todo) = getItemPosChain id2 done [item1] todo = sortLayoutItems` (insertItemPosChain chain done) todo where getItemPosChain :: !Id ![LayoutItem] ![LayoutItem] ![LayoutItem] -> (![LayoutItem],![LayoutItem],![LayoutItem]) getItemPosChain nextId done chain todo # in_chain = contains (identifyLayoutItem nextId) chain | in_chain = layoutError "calculating layout" "cyclic dependency between Ids" # in_done = contains (identifyLayoutItem nextId) done | in_done = (done,chain,todo) # (in_todo,next,todo) = remove (identifyLayoutItem nextId) undef todo | not in_todo = layoutError "calculating layout" "reference to unknown Id" # nextPos = next.liItemPos (isRelative,id2) = IsRelative nextPos | not isRelative = (done,[next:chain],todo) | otherwise = getItemPosChain id2 done [next:chain] todo insertItemPosChain :: ![LayoutItem] ![LayoutItem] -> [LayoutItem] insertItemPosChain chain=:[final:_] done | not isRelative = chain`++done | otherwise = insertchain id chain` done where (isRelative,id) = IsRelative final.liItemPos chain` = reverse chain insertchain :: !Id [LayoutItem] ![LayoutItem] -> [LayoutItem] insertchain id chain [item:items] | identifyLayoutItem id item = chain++[item:items] | otherwise = [item:insertchain id chain items] insertchain _ chain _ = chain insertItemPosChain _ done // this alternative will actually never be reached = done /* Calculate the positions of line oriented items and the space they occupy. Place relatively placed items in the root tree of the item referred to. Items that are positioned at a fixed spot (Fix pos) are laid out relative to the given origin. Assumptions: - All relative layout positions refer to existing elements which must occur in the done list. Note: Renter = Right or Center, Corner = LeftTop, RightTop, LeftBottom or RightBottom */ calcRootPosition :: !(!Int,!Int) ![(ViewDomain,Origin)] !LayoutItem !(!Int,![Root]) -> (!Int,![Root]) calcRootPosition itemSpaces orientations item1 sDone=:(sizeY,done) | isFix // {Fix} = (sizeY, [item1`:done]) with (_,origin) = hd orientations itemoffset = case itemPosOffset fixpos orientations of Alt1Of2 v = v otherwise = layoutFatalError "calcRootPosition" "root item with ItemPos=Fix has illegal ItemOffset argument: OffsetAlign" pos = itemoffset-toVector origin item1` = {rootItem=item1,rootPos=pos,rootTree=[]} | isRelative && exists // {LeftOf,RightTo,Above,Below} = (sizeY`,[item2`:done1]) with (sizeY`,item2`) = if (IsRelativeX pos1) (calcXPosition itemSpaces orientations item1 id2 sizeY item2) (calcYPosition itemSpaces orientations item1 id2 sizeY item2) | isRelative = layoutFatalError "calculating layout" "reference to unknown Id (not caught by sortLayoutItems)" | IsCorner pos1 // {LeftTop,RightTop,LeftBottom,RightBottom} = (sizeY, [item1`:done]) with item1` = {rootItem=item1,rootPos=zero,rootTree=[]} | otherwise // {Left,Center,Right} = (max sizeY (sizeY+yOffset1+h), [{rootItem=item1,rootPos={zero & vy=sizeY+yOffset1},rootTree=[]}:done]) with h = item1.liItemSize.h itemoffset = case itemPosOffset (snd pos1) orientations of Alt1Of2 v = v otherwise = layoutFatalError "calcRootPosition" "root item with ItemPos in {Left,Center,Right} has illegal ItemOffset argument: OffsetAlign" yOffset = itemoffset.vy yOffset1 = if (sizeY==0) yOffset (snd itemSpaces+yOffset) where pos1 = item1.liItemPos (isFix,fixpos) = IsFix pos1 (isRelative,id2) = IsRelative pos1 (exists,item2,done1) = removeRoot id2 done /* calcXPosition calculates the position of item1 which is horizontally relative to the item identified by id2. This item is either item2 or occurs in the layout tree of item2. item1 is placed as a Relative in the layout tree of item2. */ calcXPosition :: !(!Int,!Int) ![(ViewDomain,Origin)] !LayoutItem !Id !Int !Root -> (!Int,!Root) calcXPosition itemSpaces orientations item1 id2 sizeY item2=:{rootItem=root2,rootTree=tree2} | not ok = layoutFatalError "calcXPosition" "dependent item could not be found in rootTree" | otherwise = ( if (IsCorner pos2 || isFix2) sizeY (max (t+size1.h) sizeY) , {item2 & rootTree=[depend:tree2]} ) where pos1 = item1.liItemPos; size1 = item1.liItemSize; pos2 = root2.liItemPos; (isFix2,_) = IsFix pos2 l = if (IsLeftOf pos1) (corner2.vx-size1.w-fst itemSpaces+if isVectorOffset v.vx zero) (corner2.vx+size2.w+fst itemSpaces+if isVectorOffset v.vx zero) t = corner2.vy + dy dy = if isVectorOffset // determine vertical offset: v.vy // take exact offset of vector (case align of AlignTop = zero // align top coordinates AlignCenter = (size2.h-size1.h)/2 // center bodies of items AlignBottom = size2.h-size1.h // align bottom coordinates ) offset = itemPosOffset (snd pos1) orientations isVectorOffset = isAlt1Of2 offset; v = alt1Of2 offset isAlignOffset = isAlt2Of2 offset; align = alt2Of2 offset; (ok,corner2,size2) = getLayoutItemPosSize id2 item2 depend = {relativeItem=item1,relativePos={vx=l,vy=t}} /* calcYPosition calculates the position of item1 which is vertically relative to the item identified by id2. This item is either item2 or occurs in the layout tree of item2. item1 is placed as a Relative in the layout tree of item2. */ calcYPosition :: !(!Int,!Int) ![(ViewDomain,Origin)] !LayoutItem !Id !Int !Root -> (!Int,!Root) calcYPosition itemSpaces orientations item1 id2 sizeY item2=:{rootItem=root2,rootTree=tree2} | not ok = layoutFatalError "calcXPosition" "dependent item could not be found in rootTree" | otherwise = ( if (IsCorner pos2 || isFix2) sizeY (max (t+size1.h) sizeY) , {item2 & rootTree=[depend:tree2]} ) where pos1 = item1.liItemPos; size1 = item1.liItemSize; pos2 = root2.liItemPos; (isFix2,_) = IsFix pos2 l = corner2.vx + dx dx = if isVectorOffset // determine horizontal offset: v.vx // take exact offset of vector (case align of AlignLeft = zero // align left coordinates AlignCenter = (size2.w-size1.w)/2 // align bodies of items AlignRight = size2.w-size1.w // align right coordinates ) t = if (IsBelow pos1) (corner2.vy+size2.h+snd itemSpaces+if isVectorOffset v.vy zero) (corner2.vy-size1.h-snd itemSpaces+if isVectorOffset v.vy zero) offset = itemPosOffset (snd pos1) orientations isVectorOffset = isAlt1Of2 offset; v = alt1Of2 offset; isAlignOffset = isAlt2Of2 offset; align = alt2Of2 offset; (ok,corner2,size2) = getLayoutItemPosSize id2 item2 depend = {relativeItem=item1,relativePos={vx=l,vy=t}} /* In case no requested size is given (requested size==zero), calculate the actual width and height of the overall area. The overall area is the smallest enclosing rectangle of the line and fix layout items, provided it fits the corner oriented items. In case of a requested size, yield this size. */ calcAreaSize :: ![(ViewDomain,Origin)] ![Root] !Size !Size -> Size calcAreaSize orientations roots reqSize minimumSize | reqSize<>zero = stretchSize minimumSize reqSize | otherwise = stateMap2 (fitRootInArea origin orientations) roots minimumSize where origin = snd (hd orientations) stretchSize :: !Size !Size -> Size stretchSize size1 size2 = {w=max size1.w size2.w, h=max size1.h size2.h} // fitRootInArea stretches the Size argument such that the bounding box of the Root argument fits. fitRootInArea :: !Origin ![(ViewDomain,Origin)] !Root !Size -> Size fitRootInArea origin orientations root frameSize = stretchSize frameSize {w=reqX,h=reqY} where corner = root.rootPos size = root.rootItem.liItemSize (loc,offset) = root.rootItem.liItemPos v = case itemPosOffset offset orientations of Alt1Of2 v = v otherwise = layoutFatalError "fitRootInArea" "root control has illegal ItemOffset argument" itemBoundBox = getRootBoundingBox root (reqX,reqY) = delimit loc itemBoundBox delimit :: !ItemLoc !OSRect -> (!Int,!Int) delimit Fix {rright,rbottom} | r`<=0 || b`<=0 = (0,0) | otherwise = (r`,b`) where r` = rright -origin.x b` = rbottom-origin.y delimit LeftTop {rright,rbottom} = (rright-lefttop.vx,rbottom-lefttop.vy) where lefttop = corner-v delimit RightTop {rleft,rbottom} = (righttop.vx-rleft,rbottom-righttop.vy) where righttop = corner+{zero & vx=size.w}-v delimit LeftBottom {rtop,rright} = (rright-leftbottom.vx,leftbottom.vy-rtop) where leftbottom = corner+{zero & vy=size.h}-v delimit RightBottom {rleft,rtop} = (rightbottom.vx-rleft,rightbottom.vy-rtop) where rightbottom = corner+toVector size-v delimit Left {rright,rbottom} = (rright-left,rbottom) where left = corner.vx-v.vx delimit Center {rleft,rright,rbottom} = (rright-rleft,rbottom) delimit Right {rleft,rbottom} = (right-rleft,rbottom) where right = corner.vx+size.w-v.vy /* calcFramePosition calculates the layout of all frame aligned items. In addition it adds the margin offsets to each item. */ calcFramePosition :: !(!Int,Int) !(!Int,Int) ![(ViewDomain,Origin)] !Size !Root ![Root] -> [Root] calcFramePosition hMargins=:(lMargin,_) vMargins=:(tMargin,_) orientations sizeArea=:{w=width,h=height} item done | IsRenter pos || IsCorner pos = [item`:done] with sizeItem = item.rootItem.liItemSize widthLeft = width-sizeItem.w v = if (IsCorner pos) (cornerShift orientations pos sizeItem sizeArea) {vx=lineShift orientations pos widthLeft,vy=0} shift = {vx=v.vx+lMargin,vy=v.vy+tMargin} item` = shiftRoot shift item | otherwise = [shiftRoot {vx=lMargin,vy=tMargin} item:done] where pos = item.rootItem.liItemPos /* lineShift determines the offset of centered and right-oriented elements. Note that this function assumes that ItemOffset in ItemPos is not OffsetAlign. */ lineShift :: [(ViewDomain,Origin)] !ItemPos !Int -> Int lineShift orientations (Center,offset) space = case itemPosOffset offset orientations of Alt1Of2 {vx} = space/2+vx lineShift orientations (_,offset) space = case itemPosOffset offset orientations of Alt1Of2 {vx} = space+vx /* cornerShift determines the offset vector of the ItemPos argument. Note that this function assumes that ItemOffset in ItemPos is not OffsetAlign. */ cornerShift :: [(ViewDomain,Origin)] !ItemPos !Size !Size -> Vector2 cornerShift orientations (LeftTop,offset) _ _ = case itemPosOffset offset orientations of Alt1Of2 v = v otherwise = layoutFatalError "cornerShift _ (LeftTop,_) _ _" "ItemOffset argument is an Alignment instead of a Vector2" cornerShift orientations (RightTop,offset) {w=wItem} {w} = case itemPosOffset offset orientations of Alt1Of2 v = {v & vx=w-wItem+v.vx} otherwise = layoutFatalError "cornerShift _ (RightTop,_) _ _" "ItemOffset argument is an Alignment instead of a Vector2" cornerShift orientations (LeftBottom,offset) {h=hItem} {h} = case itemPosOffset offset orientations of Alt1Of2 v = {v & vy=h-hItem+v.vy} otherwise = layoutFatalError "cornerShift _ (LeftBottom,_) _ _" "ItemOffset argument is an Alignment instead of a Vector2" cornerShift orientations (RightBottom,offset) {w=wItem,h=hItem} {w,h} = case itemPosOffset offset orientations of Alt1Of2 v = {vx=w-wItem+v.vx,vy=h-hItem+v.vy} otherwise = layoutFatalError "cornerShift _ (RightBottom,_) _ _" "ItemOffset argument is an Alignment instead of a Vector2" // itemPosOffset calculates the actual offset vector of the given ItemOffset value. itemPosOffset :: !ItemOffset [(ViewDomain,Origin)] -> Alt2 Vector2 Alignment itemPosOffset NoOffset _ = Alt1Of2 zero itemPosOffset (OffsetVector v) _ = Alt1Of2 v itemPosOffset (OffsetAlign a) _ = Alt2Of2 a itemPosOffset (OffsetFun i f) orientations | isBetween i 1 (length orientations) = Alt1Of2 (f (orientations!!(i-1))) | otherwise = layoutError "calculating OffsetFun" ("illegal ParentIndex value: "+++toString i) // ItemPos predicates. IsFix :: !ItemPos -> (!Bool,!ItemOffset) IsFix (Fix,offset) = (True, offset) IsFix _ = (False,NoOffset) IsLine :: !ItemPos -> Bool IsLine (Left,_) = True IsLine (Center,_) = True IsLine (Right,_) = True IsLine _ = False IsRelative :: !ItemPos -> (!Bool,!Id) IsRelative (LeftOf id,_) = (True,id) IsRelative (RightTo id,_) = (True,id) IsRelative (Above id,_) = (True,id) IsRelative (Below id,_) = (True,id) IsRelative _ = (False,sysId 0) IsRelativeX :: !ItemPos -> Bool IsRelativeX (LeftOf _,_) = True IsRelativeX (RightTo _,_) = True IsRelativeX _ = False IsRenter :: !ItemPos -> Bool IsRenter (Center,_) = True IsRenter (Right, _) = True IsRenter _ = False IsCorner :: !ItemPos -> Bool IsCorner (LeftTop, _) = True IsCorner (RightTop, _) = True IsCorner (LeftBottom, _) = True IsCorner (RightBottom,_) = True IsCorner _ = False IsLeftOf :: !ItemPos -> Bool IsLeftOf (LeftOf _,_) = True IsLeftOf _ = False IsBelow :: !ItemPos -> Bool IsBelow (Below _,_) = True IsBelow _ = False // Auxiliary functions: divide :: !(Cond x) ![x] -> (![x],![x]) // divide cond xs = (filter cond xs,filter (not o cond) xs) divide f [x:xs] | f x = ([x:yes],no) | otherwise = (yes,[x:no]) where (yes,no) = divide f xs divide _ _ = ([],[])