geomancy-layout-0.1.1: Geometry and matrix manipulation
Safe HaskellNone
LanguageGHC2021

Geomancy.Layout.View

Description

SwiftUI-like view tree

The layout keeps the propose-report-place protocol, but chops some parts away.

  • Views are abstracted and the View constructor punches a hole in a tree (a hollow?) for a UI toolkit to fill in later.
  • There's no "tree builder", so containers and modifiers are constructed directly. Although it is easy to recover modifier with the "Data.Function.(&)" operator.
  • There's no "ideal size", "fixed size" etc. and the views are fully flexible. The UI tookit wrappers can instead self-wrap their Views in a Frame/FlexibleFrame as needed.
Synopsis

Documentation

layout :: LayoutView stuff => Box -> View () stuff -> View Box (Placed stuff) Source #

Run all the layout steps to annotate the nodes with their final placement boxes.

foldWith :: (LayoutView stuff, Monoid a) => (Placed stuff -> a) -> Box -> View () stuff -> a Source #

Do all of the layout steps and fold placed views

Mostly an example. The better way is to cache intermediate steps.

(Actually a pun on "fold views".)

class LayoutView stuff where Source #

An interface to plug UI toolkits into the layout.

Alternatively, convert them to ViewFun, which has the instance.

The "minimal: none" is a lie. Most likely you will need to adjust either 'ReportedCache ' or Placed types and implement the other function accordingly.

The most gnarly code would be for "rendered text" widgets since they would be dynamically sized and have to be processed/cached on each step.

Minimal complete definition

Nothing

Associated Types

type ReportedCache stuff Source #

type ReportedCache stuff = stuff

type Placed stuff Source #

type Placed stuff = stuff

Methods

viewFlexibility :: stuff -> ViewSize Source #

Measurement pre-pass

default viewFlexibility :: stuff -> ViewSize Source #

Default implementation is "the view *will* adapt to any size"

proposeView :: Vec2 -> stuff -> (Vec2, ReportedCache stuff) Source #

Propose step: return the actual size and store intermediate data.

default proposeView :: ReportedCache stuff ~ stuff => Vec2 -> stuff -> (Vec2, ReportedCache stuff) Source #

Default implementation for "accept everything" reporting

placeView :: Box -> ReportedCache stuff -> Placed stuff Source #

Placement step: get the reported size augmented with a final position, produce the result.

default placeView :: ReportedCache stuff ~ (Box -> Placed stuff) => Box -> ReportedCache stuff -> Placed stuff Source #

Default implementation for "box function" placement

Instances

Instances details
LayoutView (Identity stuff) Source #

Do-nothing pass-through instance

You'll have to peek at the View{ann} of the placement tree.

Instance details

Defined in Geomancy.Layout.View

Associated Types

type ReportedCache (Identity stuff) 
Instance details

Defined in Geomancy.Layout.View

type ReportedCache (Identity stuff) = Identity stuff
type Placed (Identity stuff) 
Instance details

Defined in Geomancy.Layout.View

type Placed (Identity stuff) = Identity stuff
LayoutView (ViewFun stuff) Source # 
Instance details

Defined in Geomancy.Layout.View

Associated Types

type ReportedCache (ViewFun stuff) 
Instance details

Defined in Geomancy.Layout.View

type ReportedCache (ViewFun stuff) = Box -> stuff
type Placed (ViewFun stuff) 
Instance details

Defined in Geomancy.Layout.View

type Placed (ViewFun stuff) = stuff
(LayoutView l, LayoutView r) => LayoutView (Either l r) Source #

"Variant-lite" instance to mix widgets of different type

XXX: the foldable/traversable would skip the Lefts. Use something like foldWith to pre-process and normalize to a common "backend" type

Instance details

Defined in Geomancy.Layout.View

Associated Types

type ReportedCache (Either l r) 
Instance details

Defined in Geomancy.Layout.View

type Placed (Either l r) 
Instance details

Defined in Geomancy.Layout.View

type Placed (Either l r) = Either (Placed l) (Placed r)

data ViewFun stuff Source #

A model type for the protocol

The fields correspond to the 3 steps:

  • Measurement into ViewSize - static.
  • Proposing and reporting - depends on parent size / caches size-related data.
  • Placement - depends on placement (Box = reported size + position), can use cached data.

Constructors

ViewFun ViewSize (Vec2 -> (Vec2, Box -> stuff)) 

Instances

Instances details
Functor ViewFun Source # 
Instance details

Defined in Geomancy.Layout.View

Methods

fmap :: (a -> b) -> ViewFun a -> ViewFun b #

(<$) :: a -> ViewFun b -> ViewFun a #

LayoutView (ViewFun stuff) Source # 
Instance details

Defined in Geomancy.Layout.View

Associated Types

type ReportedCache (ViewFun stuff) 
Instance details

Defined in Geomancy.Layout.View

type ReportedCache (ViewFun stuff) = Box -> stuff
type Placed (ViewFun stuff) 
Instance details

Defined in Geomancy.Layout.View

type Placed (ViewFun stuff) = stuff
type Placed (ViewFun stuff) Source # 
Instance details

Defined in Geomancy.Layout.View

type Placed (ViewFun stuff) = stuff
type ReportedCache (ViewFun stuff) Source # 
Instance details

Defined in Geomancy.Layout.View

type ReportedCache (ViewFun stuff) = Box -> stuff

viewFun :: ViewSize -> (Vec2 -> (Vec2, Box -> stuff)) -> View () (ViewFun stuff) Source #

A wrapper to construct ViewFun-based views

boxFun :: (Box -> stuff) -> View () (ViewFun stuff) Source #

A wrapper to construct ViewFun-based views by assuming infinite flex and no intrinsic size

View tree

data View ann stuff Source #

Layout skeleton

It is Functor-Foldable-Traversable on View so you can use things like void to suppress payload and show the intermediate structure.

Constructors

View

UI-specific payload

Fields

Spacer 

Fields

HStack

Place children side-by-side (LTR)

Fields

VStack

Place children top-to-bottom

Fields

ZStack

Place children atop of each other

Fields

Overlay

Propose the size of the primary view to the secondary view

Fields

Frame

Propose/report size unconditionally

Fields

FlexibleFrame 

Fields

AspectRatio 

Fields

  • ann :: ann
     
  • aspect :: Vec2

    Like 'Ratio Float', for example vec2 16 9 or 1 (= vec2 1 1, i.e. square)

  • align :: Alignment
     
  • inner :: View ann stuff

    Adjust measurement flex and clamp proposed/reported size

Padding

Subtracts a CSS-tyle padding (toprightbottom/left) from parent

Fields

  • ann :: ann
     
  • trbl :: TRBL
     
  • inner :: View ann stuff

    Adjust measurement flex and clamp proposed/reported size

Offset

Adds offset when placing a view

Fields

  • ann :: ann
     
  • xy :: Vec2
     
  • inner :: View ann stuff

    Adjust measurement flex and clamp proposed/reported size

Instances

Instances details
Bifunctor View Source # 
Instance details

Defined in Geomancy.Layout.View

Methods

bimap :: (a -> b) -> (c -> d) -> View a c -> View b d #

first :: (a -> b) -> View a c -> View b c #

second :: (b -> c) -> View a b -> View a c #

Foldable (View ann) Source # 
Instance details

Defined in Geomancy.Layout.View

Methods

fold :: Monoid m => View ann m -> m #

foldMap :: Monoid m => (a -> m) -> View ann a -> m #

foldMap' :: Monoid m => (a -> m) -> View ann a -> m #

foldr :: (a -> b -> b) -> b -> View ann a -> b #

foldr' :: (a -> b -> b) -> b -> View ann a -> b #

foldl :: (b -> a -> b) -> b -> View ann a -> b #

foldl' :: (b -> a -> b) -> b -> View ann a -> b #

foldr1 :: (a -> a -> a) -> View ann a -> a #

foldl1 :: (a -> a -> a) -> View ann a -> a #

toList :: View ann a -> [a] #

null :: View ann a -> Bool #

length :: View ann a -> Int #

elem :: Eq a => a -> View ann a -> Bool #

maximum :: Ord a => View ann a -> a #

minimum :: Ord a => View ann a -> a #

sum :: Num a => View ann a -> a #

product :: Num a => View ann a -> a #

Traversable (View ann) Source # 
Instance details

Defined in Geomancy.Layout.View

Methods

traverse :: Applicative f => (a -> f b) -> View ann a -> f (View ann b) #

sequenceA :: Applicative f => View ann (f a) -> f (View ann a) #

mapM :: Monad m => (a -> m b) -> View ann a -> m (View ann b) #

sequence :: Monad m => View ann (m a) -> m (View ann a) #

Functor (View ann) Source # 
Instance details

Defined in Geomancy.Layout.View

Methods

fmap :: (a -> b) -> View ann a -> View ann b #

(<$) :: a -> View ann b -> View ann a #

(Show stuff, Show ann) => Show (View ann stuff) Source # 
Instance details

Defined in Geomancy.Layout.View

Methods

showsPrec :: Int -> View ann stuff -> ShowS #

show :: View ann stuff -> String #

showList :: [View ann stuff] -> ShowS #

(Eq stuff, Eq ann) => Eq (View ann stuff) Source # 
Instance details

Defined in Geomancy.Layout.View

Methods

(==) :: View ann stuff -> View ann stuff -> Bool #

(/=) :: View ann stuff -> View ann stuff -> Bool #

Some shortcuts

view_ :: stuff -> View () stuff Source #

spacer_ :: View () stuff Source #

Containers

hstack_ :: [View () stuff] -> View () stuff Source #

vstack_ :: [View () stuff] -> View () stuff Source #

zstack_ :: [View () stuff] -> View () stuff Source #

overlay_ :: View () stuff -> View () stuff -> View () stuff Source #

Modifiers

frame_ :: Vec2 -> View () stuff -> View () stuff Source #

flexible_ :: ViewSize -> Alignment -> View () stuff -> View () stuff Source #

aspect_ :: Vec2 -> View () stuff -> View () stuff Source #

padding_ :: Vec4 -> View () stuff -> View () stuff Source #

offset_ :: Vec2 -> View () stuff -> View () stuff Source #

Flexibility helper

data ViewSize Source #

Represents size constraints and flexibility for a layout node.

Instances

Instances details
Show ViewSize Source # 
Instance details

Defined in Geomancy.Layout.View

Eq ViewSize Source # 
Instance details

Defined in Geomancy.Layout.View

fixed_ :: Vec2 -> ViewSize Source #

Creates a ViewSize for a fixed-size view.

infinite_ :: ViewSize Source #

Creates a ViewSize for a fully flexible view.

parent_ :: ViewSize Source #

Creates a ViewSize that reports parent size

Layout steps

measure :: LayoutView stuff => View () stuff -> View ViewSize stuff Source #

Measurement pre-pass

place :: LayoutView stuff => Box -> View ViewSize stuff -> View Box (Placed stuff) Source #

Run the propose-report-place protocol on a flex-measured view tree

suspend :: LayoutView stuff => Vec2 -> View ViewSize stuff -> (Vec2, Box -> View Box (Placed stuff)) Source #

Propose-Report-Place protocol using continuations

Inner children can't be placed until the whole propose-report dance finishes.

Internals

maybeBoth :: t1 -> (t2 -> t3 -> t1) -> Maybe t2 -> Maybe t3 -> t1 Source #