{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE FlexibleContexts #-}{-# OPTIONS -Wall #-}---------------------------------------------------------------------------------- |-- Module : Wumpus.Core.PictureLanguage-- Copyright : (c) Stephen Tetley 2009-- License : BSD3---- Maintainer : stephen.tetley@gmail.com-- Stability : unstable-- Portability : GHC with TypeFamilies and more---- Type classes and derived functions to compose 2D /pictures/.---- The operations are fairly standard - see Regions in Paul -- Hudak\'s \'The Haskell School of Expression' and the pretty-- printing libraries wl-pprint and Text.PrettyPrint.HughesPJ -- (pretty printing combinators are some ways in \'One and a -- half D\' as they have horizontal operations but only carriage -- return in the vertical.----------------------------------------------------------------------------------moduleWumpus.Core.PictureLanguage(-- * Data types for alignment HAlign(..),VAlign(..)-- * Type family and classes,PUnit,Horizontal(..),Vertical(..),Composite(..),Move(..),Blank(..)-- * Bounds-- $boundsdoc,center,topleft,topright,bottomleft,bottomright-- * Composition,(-@-),(->-),(-<-),(-//-),above,below,at,stackOnto,hcat,vcat,stackOntoCenter,hspace,vspace,hsep,vsep-- * Compose with alignment,alignH,alignV,hcatA,vcatA,hsepA,vsepA)whereimportWumpus.Core.GeometryimportData.AffineSpaceimportData.List(foldl')---------------------------------------------------------------------------------- Data types-- Alignment-- | Horizontal alignment - align to the top, center or bottom.dataHAlign=HTop|HCenter|HBottomderiving(Eq,Show)-- | Vertical alignment - align to the left, center or bottom.dataVAlign=VLeft|VCenter|VRightderiving(Eq,Show)---------------------------------------------------------------------------------- Type family and classes-- | The type of /points/ within a Picture.typefamilyPUnita-- | > a `over` b-- -- Place \'picture\' a over b. The idea of @over@ here is the same-- as z-ordering in 2D design programs. Implementations of this -- class should \'draw\' picture a over b but move neither.-- -- Similarly @beneath@ should \'draw\' the first picture behind -- the second but move neither.---- Beneath has a default definition:---- > beneath = flip over--classCompositeawhereover::a->a->abeneath::a->a->abeneath=flipover-- | Create a /picture/ that has no content but occupies space -- (i.e. it has a bounding box).classBlankawhereblank::PUnita->PUnita->a-- | Move horizontally.classHorizontalawheremoveH::PUnita->a->aleftBound::a->PUnitarightBound::a->PUnita-- | Move vertically.classVerticalawheremoveV::PUnita->a->atopBound::a->PUnitabottomBound::a->PUnita-- | Move in both the horizontal and vertical.classMoveawheremove::PUnita->PUnita->a->a---------------------------------------------------------------------------------- Operations on bounds-- $boundsdoc-- Corresponding operations are available on bounding boxes - the -- definitions here have different type class obligations.-- | The center of a picture.center::(Horizontala,Verticala,Fractionalu,u~PUnita)=>a->Point2ucentera=P2hcentervcenterwherehcenter=leftBounda+0.5*(rightBounda-leftBounda)vcenter=bottomBounda+0.5*(topBounda-bottomBounda)-- | Extract the top-left corner.topleft::(Horizontala,Verticala,u~PUnita)=>a->Point2utoplefta=P2(leftBounda)(topBounda)-- | Extract the top-right corner.topright::(Horizontala,Verticala,u~PUnita)=>a->Point2utoprighta=P2(rightBounda)(topBounda)-- | Extract the bottom-left corner.bottomleft::(Horizontala,Verticala,u~PUnita)=>a->Point2ubottomlefta=P2(leftBounda)(bottomBounda)-- | Extract the bottom-right corner.bottomright::(Horizontala,Verticala,u~PUnita)=>a->Point2ubottomrighta=P2(rightBounda)(bottomBounda)---------------------------------------------------------------------------------- Internal helpersleftmid::(Fractionalu,Horizontala,Verticala,u~PUnita)=>a->Point2uleftmida=P2(leftBounda)(midpt(bottomBounda)(topBounda))rightmid::(Fractionalu,Horizontala,Verticala,u~PUnita)=>a->Point2urightmida=P2(rightBounda)(midpt(bottomBounda)(topBounda))topmid::(Fractionalu,Horizontala,Verticala,u~PUnita)=>a->Point2utopmida=P2(midpt(leftBounda)(rightBounda))(topBounda)bottommid::(Fractionalu,Horizontala,Verticala,u~PUnita)=>a->Point2ubottommida=P2(midpt(leftBounda)(rightBounda))(bottomBounda)midpt::Fractionala=>a->a->amidptab=a+0.5*(b-a)---------------------------------------------------------------------------------- Compositioninfixr5-//-,`above`,`below`infixr6->-,-@--- | > a -@- b-- -- Center @a@ on top of @b@, @a@ is potentially moved and drawn -- 'over' @b@.--(-@-)::(Horizontala,Verticala,Compositea,Movea,Fractionalu,u~PUnita)=>a->a->ap1-@-p2=(movexyp1)`over`p2whereV2xy=centerp2.-.centerp1-- | > a ->- b-- -- Horizontal composition - move @b@, placing it to the right -- of @a@.-- (->-)::(Horizontala,Compositea,Numu,u~PUnita)=>a->a->aa->-b=a`over`(moveHdispb)wheredisp=rightBounda-leftBoundb-- | > a -<- b-- -- Horizontal composition - move @a@, placing it to the left -- of @b@.--(-<-)::(Horizontala,Compositea,Numu,u~PUnita)=>a->a->aa-<-b=(moveHdispa)`over`bwheredisp=leftBoundb-rightBounda-- | > a -//- b---- Vertical composition - move @b@, placing it below @a@.--(-//-)::(Verticala,Compositea,Numu,u~PUnita)=>a->a->aa-//-b=a`over`(moveVdispb)wheredisp=bottomBounda-topBoundb-- | > a `below` b-- -- Vertical composition - move @a@, placing it below @b@--below::(Verticala,Compositea,Numu,u~PUnita)=>a->a->aa`below`b=(moveVdispa)`over`bwheredisp=bottomBounda-topBoundb-- | > a `above` b-- -- Vertical composition - move @a@, placing it above @b@.--above::(Verticala,Compositea,Numu,u~PUnita)=>a->a->aa`above`b=(moveVdispa)`over`bwheredisp=topBoundb-bottomBounda-- | Place the picture at the supplied point.at::(Movea,u~PUnita)=>a->Point2u->ap`at`(P2xy)=movexyp-- | > xs `stackOnto` a-- -- Stack the list of pictures @xs@ 'over' @a@.---- Note, the first picture in the list is drawn at the top, the-- last picture is draw 'over' @a@.--stackOnto::(Compositea)=>[a]->a->astackOnto=flip(foldrover)-- | > x ->- xs-- -- Concatenate the list pictures @xs@ horizontally with @(->-)@ -- starting at @x@.-- hcat::(Horizontala,Compositea,Numu,u~PUnita)=>a->[a]->ahcat=foldl'(->-)-- | > x -//- xs-- -- Concatenate the list of pictures @xs@ vertically with @(-\/\/-)@ -- starting at @x@.--vcat::(Verticala,Compositea,Numu,u~PUnita)=>a->[a]->avcat=foldl'(-//-)-- | Stack pictures centered ontop of each other - the first -- picture in the list is drawn at the top, last picture is on -- drawn at the bottom.stackOntoCenter::(Horizontala,Verticala,Compositea,Movea,Fractionalu,u~PUnita)=>[a]->a->astackOntoCenter=flip$foldr(-@-)---------------------------------------------------------------------------------- HelpersblankH::(Numu,Blanka,u~PUnita)=>u->ablankH=blank`flip`0blankV::(Numu,Blanka,u~PUnita)=>u->ablankV=blank0-- NOTE-- The following simple definition of hspace is invalid:---- > hspace n a b = a ->- (moveH n b)-- -- The movement due to @moveH n@ is annulled by the @->-@ -- operator which moves relative to the bounding box.-- -- The almost as simple definition below, seems to justify -- including Blank as a Picture constructor.---- | > hspace n a b---- Concatenate the pictures @a@ and @b@ with @(->-)@ - injecting -- a space of @n@ units to separate the pictures.--hspace::(Numu,Compositea,Horizontala,Blanka,u~PUnita)=>u->a->a->ahspacenab=a->-blankHn->-b-- | > vspace n a b---- Concatenate the pictures @a@ and @b@ with @(-\/\/-)@ - injecting -- a space of @n@ units to separate the pictures.--vspace::(Numu,Compositea,Verticala,Blanka,u~PUnita)=>u->a->a->avspacenab=a-//-blankVn-//-b-- | > hsep n x xs---- Concatenate the list of pictures @xs@ horizontally with -- @hspace@ starting at @x@. The pictures are interspersed with -- spaces of @n@ units.--hsep::(Numu,Compositea,Horizontala,Blanka,u~PUnita)=>u->a->[a]->ahsepn=foldl'(hspacen)-- | > vsep n x xs---- Concatenate the list of pictures @xs@ vertically with -- @vspace@ starting at @x@. The pictures are interspersed with -- spaces of @n@ units.--vsep::(Numu,Compositea,Verticala,Blanka,u~PUnita)=>u->a->[a]->avsepn=foldl'(vspacen)---------------------------------------------------------------------------------- Aligning pictures-- | > alignH z a b---- Move picture @b@ up or down to be horizontally aligned along a -- line from the top, center or bottom of picture @a@-- alignH::(Fractionalu,Compositea,Horizontala,Verticala,Movea,u~PUnita)=>HAlign->a->a->aalignHHTopp1p2=vecMovep1p2(vvec$topBoundp1-topBoundp2)alignHHBottomp1p2=vecMovep1p2(vvec$bottomBoundp1-bottomBoundp2)alignHHCenterp1p2=vecMovep1p2(vvecv)whereV2_v=rightmidp1.-.leftmidp2-- | > alignV z a b---- Move picture @b@ left or right to be vertically aligned along a -- line from the left side, center or right side of picture @a@-- alignV::(Fractionalu,Compositea,Horizontala,Verticala,Movea,u~PUnita)=>VAlign->a->a->aalignVVLeftp1p2=vecMovep1p2(hvec$leftBoundp1-leftBoundp2)alignVVRightp1p2=vecMovep1p2(hvec$rightBoundp1-rightBoundp2)alignVVCenterp1p2=vecMovep1p2(hvech)whereV2h_=bottommidp1.-.topmidp2-- HelpersvecMove::(Compositea,Movea,u~PUnita)=>a->a->(Vec2u)->avecMoveab(V2xy)=a`over`(movexy)b-- Unlike alignH this function \"moves and concatenates\".moveAlignH::(Fractionalu,Compositea,Horizontala,Verticala,Movea,u~PUnita)=>HAlign->a->a->amoveAlignHHTopp1p2=vecMovep1p2(toprightp1.-.topleftp2)moveAlignHHCenterp1p2=vecMovep1p2(rightmidp1.-.leftmidp2)moveAlignHHBottomp1p2=vecMovep1p2(bottomrightp1.-.bottomleftp2)-- Unlike alignV this function \"moves and concatenates\".moveAlignV::(Fractionalu,Compositea,Horizontala,Verticala,Movea,u~PUnita)=>VAlign->a->a->amoveAlignVVLeftp1p2=vecMovep1p2(bottomleftp1.-.topleftp2)moveAlignVVCenterp1p2=vecMovep1p2(bottommidp1.-.topmidp2)moveAlignVVRightp1p2=vecMovep1p2(bottomrightp1.-.toprightp2)-- | Variant of 'hcat' that aligns the pictures as well as-- concatenating them.hcatA::(Fractionalu,Horizontala,Verticala,Compositea,Movea,u~PUnita)=>HAlign->a->[a]->ahcatAha=foldl'(moveAlignHha)-- | Variant of 'vcat' that aligns the pictures as well as-- concatenating them.vcatA::(Fractionalu,Horizontala,Verticala,Compositea,Movea,u~PUnita)=>VAlign->a->[a]->avcatAva=foldl'(moveAlignVva)-- | Variant of @hsep@ that aligns the pictures as well as-- concatenating and spacing them.hsepA::(Fractionalu,Horizontala,Verticala,Compositea,Movea,Blanka,u~PUnita)=>HAlign->u->a->[a]->ahsepAhan=foldl'opwherea`op`b=moveAlignHha(moveAlignHhaa(blankHn))b-- | Variant of @vsep@ that aligns the pictures as well as-- concatenating and spacing them.vsepA::(Fractionalu,Horizontala,Verticala,Compositea,Movea,Blanka,u~PUnita)=>VAlign->u->a->[a]->avsepAvan=foldl'opwherea`op`b=moveAlignVva(moveAlignVvaa(blankVn))b