Skip to content

Instantly share code, notes, and snippets.

@antonycourtney
Created March 4, 2016 23:47
Show Gist options
  • Save antonycourtney/17b5e5f1a28905e3be20 to your computer and use it in GitHub Desktop.
Save antonycourtney/17b5e5f1a28905e3be20 to your computer and use it in GitHub Desktop.
Layout thought of as an attribute grammar, encoded in Haskell
--
-- Some experiments with a Picture type based on an attribute-grammar
-- model of Layout
module FunPic where
import Haven
-- A type for representing the dimensions of a rectangle, as (width,height)
type Dimension = (Double,Double)
type Bounds = Rectangle
-- A FunPic inherits a maximum Dimension and a RenderContext,
-- and synthesizes a minimum Dimension and a picture.
--
type FunPic = RenderContext -> Dimension -> (Dimension,Picture)
-- An anchor point within a box:
data Anchor = N | S | W | E | NW | NE | SW | SE | C
text :: String -> FunPic
text s rc _ =
let tp = textPic s
bounds = picBounds tp rc
in (rdim bounds,tp)
-- rdim: the Dimension of a Rectangle
rdim :: Rectangle -> Dimension
rdim r = (rectWidth r,rectHeight r)
-- tbox: just renders a bounding box around the bounds of its child
tbox :: FunPic -> FunPic
tbox child rc dim =
let (cmind,cpic) = child rc dim
cbounds = picBounds cpic rc
boxPic = withColor red (outlinePic cbounds)
in (cmind,boxPic `overPic` cpic)
-- pcborder: surrounds it child by a border that is the given percentage
-- larger than the child
pcborder :: Double -> FunPic -> FunPic
pcborder pc child rc maxDim =
let ((childMinW,childMinH),childPic) = child rc maxDim
minWidth = childMinW * (1 + pc)
minHeight = childMinH * (1 + pc)
minDim = (minWidth,minHeight)
-- now center child within the border:
dim@(w,h) = dmax minDim maxDim
-- now center the child within the boxPic:
childBounds = picBounds childPic rc
dx = (w - (rectWidth childBounds)) / 2
dy = (h - (rectHeight childBounds)) / 2
ctrChildPic = (translate (point dx dy)) %$ childPic
boundsRect = rectangle origin w h
boxedPic = clipPic boundsRect ctrChildPic
in (minDim, boxedPic)
-- cbox places its argument picture in a box that is at least the given
-- percent larger than the bounding box of the child picture.
--
-- The cbox will try to expand up to max(minDim,maxDim)
cbox :: FunPic -> Double -> FunPic
cbox child pc rc maxDim =
let ((childMinW,childMinH),childPic) = child rc maxDim
minWidth = childMinW * (1 + pc)
minHeight = childMinH * (1 + pc)
minDim = (minWidth,minHeight)
dim@(w,h) = dmax minDim maxDim
boxPic = withColor red (outlinePic (drect dim))
-- now center the child within the boxPic:
childBounds = picBounds childPic rc
dx = (w - (rectWidth childBounds)) / 2
dy = (h - (rectHeight childBounds)) / 2
ctrChildPic = (translate (point dx dy)) %$ childPic
in (minDim, boxPic `overPic` ctrChildPic)
drect :: Dimension -> Rectangle
drect (w,h) = rectangle origin w h
dmax :: Dimension -> Dimension -> Dimension
dmax (w1,h1) (w2,h2) = (max w1 w2, max h1 h2)
-- rectangle whose width and height are the max. of each argument:
-- (smallest rectangle that encloses both)?
rmax :: Rectangle -> Rectangle -> Rectangle
rmax r1 r2 =
rectangle origin
(max (rectWidth r1) (rectWidth r2))
(max (rectHeight r1) (rectHeight r2))
-- tcenter: Center a tightened picture in the given container
-- N.B.: by "tightening", we mean setting the child's max. bounds to
-- its min. bounds.
tcenter :: FunPic -> FunPic
tcenter child rc maxDim =
let (childMinDim,childPic) = child rc childMinDim
-- of course, our minDim is the same as our child's:
minDim = childMinDim
-- but our actual dimension is the space we are given:
dim@(w,h) = maxDim
childBounds = picBounds childPic rc
dx = (w - (rectWidth childBounds)) / 2
dy = (h - (rectHeight childBounds)) / 2
ctrChildPic = (translate (point dx dy)) %$ childPic
in (minDim, ctrChildPic)
-- place: place a picture at some absolute position:
place :: RenderContext -> Point -> Picture -> Picture
place rc pt pic =
let bounds = picBounds pic rc
ul = rectPtA bounds
dx = pointX pt - pointX ul
dy = pointY pt - pointY ul
in translate (point dx dy) %$ pic
-- spread the given pictures vertically, and make them all the same size:
vspread :: FunPic -> FunPic -> FunPic
vspread topFP botFP rc maxDim@(w,h) =
let (topMinDim, topPic) = topFP rc childMaxDim
(botMinDim, botPic) = botFP rc childMaxDim
childMaxDim@(cmw, cmh) = dmax topMinDim botMinDim
-- now distribute the children evenly:
topBounds = picBounds topPic rc
botBounds = picBounds botPic rc
vspace = h - ((rectHeight topBounds) + (rectHeight botBounds))
dv = vspace / 3
hspace = w - cmw
topPic' = place rc (point (hspace / 2) dv) topPic
botPic' = place rc (point (hspace / 2) (dv*2 + (rectHeight topBounds))) botPic
in (childMaxDim,topPic' `overPic` botPic')
testFP :: FunPic -> IO ()
testFP fpic =
let dim = (400,400)
bpic = withColor blue (outlinePic (drect dim))
in do w <- openWindow "Test 10" 200 200 500 500
let (_,pic) = fpic (windowRenderContext w) dim
setPicture w (bpic `overPic` pic)
-- anchor some point on this picture to some point in the immediate parent:
anchorToParent :: FunPic -> Anchor -> Anchor -> FunPic
anchorToParent child ca pa rc dim = undefined
fpic0 = text "hello, World!"
fpic1 = cbox fpic0 0.1
fpic2 = cbox (text "hi") 0.1
fpic3 = cbox (text "there sally horse!") 0.1
fpic4 = vspread fpic2 fpic3
fpic5 = tcenter $ tbox (pcborder 0.25 (text "hello"))
fpic6 = tcenter (text "hello")
fpic7 = tbox (text "hello")
fpic8 = tcenter (tbox (text "hello"))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment