{-# LANGUAGE TypeFamilies #-}{-# OPTIONS -Wall #-}---------------------------------------------------------------------------------- |-- Module : Wumpus.Drawing.Text.Base.Label-- Copyright : (c) Stephen Tetley 2011-- License : BSD3---- Maintainer : stephen.tetley@gmail.com-- Stability : unstable-- Portability : GHC---- Annotation labels.-- --------------------------------------------------------------------------------moduleWumpus.Drawing.Text.Base.Label(locImageLabel,label_center_of,label_left_of,label_right_of,label_above,label_below,connectorPathLabel,label_midway_of,label_atstart_of,label_atend_of,centerRelative,right_of,left_of,above_right_of,below_right_of,above_left_of,below_left_of)whereimportWumpus.Drawing.Paths.AbsoluteimportWumpus.Basic.Kernel-- package: wumpus-basicimportWumpus.Core-- package: wumpus-coretypeBoundedLocRectGraphicu=RectAddress->LocImageu(BoundingBoxu)locImageLabel::Floatingu=>(a->Anchoru)->RectAddress->(RectAddress->LocImageu(BoundingBoxu))->LocImageua->LocImageualocImageLabelfnrposmklabelobj=promoteLoc$\pt->elaborate(obj`at`pt)(\a->ignoreAns$mklabelrpos`at`fna)label_center_of::(Floatingu,CenterAnchora,u~DUnita)=>BoundedLocRectGraphicu->LocImageua->LocImageualabel_center_of=locImageLabelcenterCENTERlabel_left_of::(Floatingu,CardinalAnchora,u~DUnita)=>BoundedLocRectGraphicu->LocImageua->LocImageualabel_left_of=locImageLabelwestEElabel_right_of::(Floatingu,CardinalAnchora,u~DUnita)=>BoundedLocRectGraphicu->LocImageua->LocImageualabel_right_of=locImageLabeleastWWlabel_above::(Floatingu,CardinalAnchora,u~DUnita)=>BoundedLocRectGraphicu->LocImageua->LocImageualabel_above=locImageLabelnorthSSlabel_below::(Floatingu,CardinalAnchora,u~DUnita)=>BoundedLocRectGraphicu->LocImageua->LocImageualabel_below=locImageLabelsouthNNconnectorPathLabel::Floatingu=>(AbsPathu->Point2u)->RectAddress->BoundedLocRectGraphicu->Imageu(AbsPathu)->Imageu(AbsPathu)connectorPathLabelfnrposlblimg=elaborateimg(\a->ignoreAns$lblrpos`at`(fna))label_midway_of::(Realu,Floatingu)=>RectAddress->BoundedLocRectGraphicu->Imageu(AbsPathu)->Imageu(AbsPathu)label_midway_of=connectorPathLabelmidway_label_atstart_of::(Realu,Floatingu)=>RectAddress->BoundedLocRectGraphicu->Imageu(AbsPathu)->Imageu(AbsPathu)label_atstart_of=connectorPathLabelatstart_label_atend_of::(Realu,Floatingu)=>RectAddress->BoundedLocRectGraphicu->Imageu(AbsPathu)->Imageu(AbsPathu)label_atend_of=connectorPathLabelatend_-- | Absolute units.-- centerRelative::(CenterAnchora,Fractionalu,InterpretUnitu,u~DUnita)=>(Int,Int)->a->Queryu(Anchoru)centerRelativecoorda=snapmovecoord>>=\v->return$displacev(centera)-- TODO - These are really for Anchors.---- Should the have a separate module or be rolled into the same-- module as the classes?---- | Value is 1 snap unit right.---- This function should be considered obsolete, pending a -- re-think.-- right_of::(CenterAnchora,Fractionalu,InterpretUnitu,u~DUnita)=>a->Queryu(Anchoru)right_of=centerRelative(1,0)-- | Value is 1 snap move left.---- This function should be considered obsolete, pending a -- re-think.-- left_of::(CenterAnchora,Fractionalu,InterpretUnitu,u~DUnita)=>a->Queryu(Anchoru)left_of=centerRelative((-1),0)-- | Value is 1 snap move up, 1 snap move right.---- This function should be considered obsolete, pending a -- re-think.-- above_right_of::(CenterAnchora,Fractionalu,InterpretUnitu,u~DUnita)=>a->Queryu(Anchoru)above_right_of=centerRelative(1,1)-- | Value is 1 snap move below, 1 snap move right.---- This function should be considered obsolete, pending a -- re-think.-- below_right_of::(CenterAnchora,Fractionalu,InterpretUnitu,u~DUnita)=>a->Queryu(Anchoru)below_right_of=centerRelative(1,(-1))-- | Value is 1 snap move up, 1 snap move left.---- This function should be considered obsolete, pending a -- re-think.-- above_left_of::(CenterAnchora,Fractionalu,InterpretUnitu,u~DUnita)=>a->Queryu(Anchoru)above_left_of=centerRelative((-1),1)-- | Value is 1 snap move down, 1 snap move left.---- This function should be considered obsolete, pending a -- re-think.-- below_left_of::(CenterAnchora,Fractionalu,InterpretUnitu,u~DUnita)=>a->Queryu(Anchoru)below_left_of=centerRelative((-1),(-1))-- TikZ has label=below etc.-- -- This would probably translate to a functions:-- @labelBelow@---- Design note - there aren\'t many Images that support anchors,-- except for LocImages that have been /saturated/ (i.e. applied -- to a point with @at@).-- -- For a saturated Image, getting at the anchors via bind does -- not seem so bad (indeed, this was the original point of -- anchors). Obviously it is important to add labels to LocImages-- (the original point of the label functions) but what about -- LocThetaImages and LocRectImages. Is it acceptable to /saturate/-- them to LocImages before labelling them?-- -- Connectors support different /anchor-like/ positions so they -- will different labelling functions.--