------------------------------------------------------------------------------- |-- Module : Graphics.Rendering.Chart.Axis.Types-- Copyright : (c) Tim Docker 2006-- License : BSD-style (see chart/COPYRIGHT)---- Type definitions for Axes--{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-# OPTIONS_GHC -XTemplateHaskell #-}moduleGraphics.Rendering.Chart.Axis.Types(AxisData(..),AxisT(..),AxisStyle(..),PlotValue(..),AxisFn,defaultAxisLineStyle,defaultAxisStyle,defaultGridLineStyle,makeAxis,makeAxis',axisToRenderable,renderAxisGrid,axisOverhang,vmap,invmap,linMap,invLinMap,axisGridAtTicks,axisGridAtBigTicks,axisGridAtLabels,axisGridHide,axisTicksHide,axisLabelsHide,axisLabelsOverride,axis_viewport,axis_tropweiv,axis_ticks,axis_labels,axis_grid,axis_line_style,axis_label_style,axis_grid_style,axis_label_gap,)whereimportqualifiedGraphics.Rendering.CairoasCimportData.TimeimportData.FixedimportData.MaybeimportSystem.Locale(defaultTimeLocale)importControl.MonadimportData.List(sort,intersperse)importData.Accessor.TemplateimportData.Colour(opaque)importData.Colour.Names(black,lightgrey)importGraphics.Rendering.Chart.TypesimportGraphics.Rendering.Chart.Renderable-- | A typeclass abstracting the functions we need-- to be able to plot against an axis of type aclassOrda=>PlotValueawheretoValue::a->DoublefromValue::Double->aautoAxis::AxisFna-- | The basic data associated with an axis showing values of type x.dataAxisDatax=AxisData{-- | The axis_viewport_ function maps values into device coordinates.axis_viewport_::Range->x->Double,-- | The axis_tropweiv_ function maps device coordinates back to values.axis_tropweiv_::Range->Double->x,-- | The tick marks on the axis as pairs.-- The first element is the position on the axis-- (in viewport units) and the second element is the-- length of the tick in output coordinates.-- The tick starts on the axis, and positive numbers are drawn-- towards the plot area.axis_ticks_::[(x,Double)],-- | The labels on an axis as pairs. The first element of the pair-- is the position on the axis (in viewport units) and the-- second is the label text string. Note that multiple sets of-- labels can be specified, and are shown successively further-- away from the axis line.axis_labels_::[[(x,String)]],-- | The positions on the axis (in viewport units) where-- we want to show grid lines.axis_grid_::[x]}-- | Control values for how an axis gets displayed.dataAxisStyle=AxisStyle{axis_line_style_::CairoLineStyle,axis_label_style_::CairoFontStyle,axis_grid_style_::CairoLineStyle,-- | How far the labels are to be drawn from the axis.axis_label_gap_::Double}-- | A function to generate the axis data, given the data values-- to be plotted against it.typeAxisFnx=[x]->AxisDatax-- | Collect the information we need to render an axis. The-- bool is true if the axis direction is reversed.dataAxisTx=AxisTRectEdgeAxisStyleBool(AxisDatax)-- | Construct a renderable from an axis, in order that-- it can be composed with other renderables and drawn. This-- does not include the drawing of the grid, which must be done-- separately by the `renderAxisGrid` function.axisToRenderable::AxisTx->RenderablexaxisToRenderableat=Renderable{minsize=minsizeAxisat,render=renderAxisat}-- | Modifier to remove grid lines from an axisaxisGridHide::AxisDatax->AxisDataxaxisGridHidead=ad{axis_grid_=[]}-- | Modifier to position grid lines to line up with the ticksaxisGridAtTicks::AxisDatax->AxisDataxaxisGridAtTicksad=ad{axis_grid_=mapfst(axis_ticks_ad)}-- | Modifier to position grid lines to line up with only the major ticksaxisGridAtBigTicks::AxisDatax->AxisDataxaxisGridAtBigTicksad=ad{axis_grid_=mapfst$filter((>minimum(map(abs.snd)(axis_ticks_ad))).snd)$axis_ticks_ad}-- | Modifier to position grid lines to line up with the labelsaxisGridAtLabels::AxisDatax->AxisDataxaxisGridAtLabelsad=ad{axis_grid_=mapfstvs}wherevs=caseaxis_labels_adof[]->[]ls->headls-- | Modifier to remove ticks from an axisaxisTicksHide::AxisDatax->AxisDataxaxisTicksHidead=ad{axis_ticks_=[]}-- | Modifier to remove labels from an axisaxisLabelsHide::AxisDatax->AxisDataxaxisLabelsHidead=ad{axis_labels_=[]}-- | Modifier to change labels on an axisaxisLabelsOverride::[(x,String)]->AxisDatax->AxisDataxaxisLabelsOverrideoad=ad{axis_labels_=[o]}minsizeAxis::AxisTx->CRenderRectSizeminsizeAxis(AxisTatasrevad)=dolabelSizes<-preserveCState$dosetFontStyle(axis_label_style_as)mapM(mapMtextSize)(labelTextsad)letag=axis_label_gap_aslettsize=maximum([0]++[max0(-l)|(v,l)<-axis_ticks_ad])lethw=maximum0(map(maximum0.mapfst)labelSizes)lethh=ag+tsize+(sum.intersperseag.map(maximum0.mapsnd)$labelSizes)letvw=ag+tsize+(sum.intersperseag.map(maximum0.mapfst)$labelSizes)letvh=maximum0(map(maximum0.mapsnd)labelSizes)letsz=caseatofE_Top->(hw,hh)E_Bottom->(hw,hh)E_Left->(vw,vh)E_Right->(vw,vh)returnszlabelTexts::AxisDataa->[[String]]labelTextsad=map(mapsnd)(axis_labels_ad)maximum0[]=0maximum0vs=maximumvs-- | Calculate the amount by which the labels extend beyond-- the ends of the axis.axisOverhang::Ordx=>AxisTx->CRender(Double,Double)axisOverhang(AxisTatasrevad)=doletlabels=mapsnd.sort.concat.axis_labels_$adlabelSizes<-preserveCState$dosetFontStyle(axis_label_style_as)mapMtextSizelabelscaselabelSizesof[]->return(0,0)ls->letl1=headlsl2=lastlsohangv=return(sndl1/2,sndl2/2)ohangh=return(fstl1/2,fstl2/2)incaseatofE_Top->ohanghE_Bottom->ohanghE_Left->ohangvE_Right->ohanghrenderAxis::AxisTx->RectSize->CRender(PickFnx)renderAxisat@(AxisTetasrevad)sz=doletls=axis_line_style_aspreserveCState$dosetLineStylels{line_cap_=C.LineCapSquare}strokePath[Pointsxsy,Pointexey]preserveCState$dosetLineStylels{line_cap_=C.LineCapButt}mapM_drawTick(axis_ticks_ad)preserveCState$dosetFontStyle(axis_label_style_as)labelSizes<-mapM(mapMtextSize)(labelTextsad)letsizes=map((+ag).maximum0.mapcoord)labelSizesletoffsets=scanl(+)agsizesmapM_drawLabels(zipoffsets(axis_labels_ad))returnpickfnwhere(sx,sy,ex,ey,tp,axisPoint,invAxisPoint)=axisMappingatszdrawTick(value,length)=lett1=axisPointvaluet2=t1`pvadd`(vscalelengthtp)instrokePath[t1,t2](hta,vta,coord,awayFromAxis)=caseetofE_Top->(HTA_Centre,VTA_Bottom,snd,\v->(Vector0(-v)))E_Bottom->(HTA_Centre,VTA_Top,snd,\v->(Vector0v))E_Left->(HTA_Right,VTA_Centre,fst,\v->(Vector(-v)0))E_Right->(HTA_Left,VTA_Centre,fst,\v->(Vectorv0))avoidOverlapslabels=dorects<-mapMlabelDrawRectlabelsreturn$mapsnd.head.filter(noOverlaps.mapfst)$map(\n->eachNthnrects)[0..lengthrects]labelDrawRect(value,s)=doletpt=axisPointvalue`pvadd`(awayFromAxisag)r<-textDrawRecthtavtaptsreturn(hBufferRectr,(value,s))drawLabels(offset,labels)=dolabels'<-avoidOverlapslabelsmapM_drawLabellabels'wheredrawLabel(value,s)=dodrawTexthtavta(axisPointvalue`pvadd`(awayFromAxisoffset))stextSizesag=axis_label_gap_aspickfn=Just.invAxisPointhBufferRect::Rect->RecthBufferRect(Rectp(Pointxy))=Rectp$Pointx'ywherex'=x+w/2w=x-(p_xp)noOverlaps::[Rect]->BoolnoOverlaps[]=TruenoOverlaps[_]=TruenoOverlaps(x:y:l)|rectsOverlapxy=False|otherwise=noOverlaps(y:l)rectsOverlap::Rect->Rect->BoolrectsOverlap(Rectp1p2)r=any(withinRectr)pswhere(Pointx1y1)=p1(Pointx2y2)=p2p3=Pointx1y2p4=Pointx2y1ps=[p1,p2,p3,p4]eachNthn=skipNwheren'=n-1skipN[]=[]skipN(x:xs)=x:skipN(dropn'xs)withinRect::Rect->Point->BoolwithinRect(Rect(Pointx1y1)(Pointx2y2))(Pointxy)=and[x>=x1&&x<=x2,y>=y1&&y<=y2]axisMapping::AxisTz->RectSize->(Double,Double,Double,Double,Vector,z->Point,Point->z)axisMapping(AxisTetasrevad)(x2,y2)=caseetofE_Top->(x1,y2,x2,y2,(Vector01),mapxy2,imapx)E_Bottom->(x1,y1,x2,y1,(Vector0(-1)),mapxy1,imapx)E_Left->(x2,y2,x2,y1,(Vector(1)0),mapyx2,imapy)E_Right->(x1,y2,x1,y1,(Vector(-1)0),mapyx1,imapy)where(x1,y1)=(0,0)xr=reverse(x1,x2)yr=reverse(y2,y1)mapxyx=Point(axis_viewport_adxrx)ymapyxy=Pointx(axis_viewport_adyry)imapx(Pointx_)=axis_tropweiv_adxrximapy(Point_y)=axis_tropweiv_adyryreverser@(r0,r1)=ifrevthen(r1,r0)elser-- renderAxisGrid::RectSize->AxisTz->CRender()renderAxisGridsz@(w,h)at@(AxisTreasrevad)=dopreserveCState$dosetLineStyle(axis_grid_style_as)mapM_(drawGridLinere)(axis_grid_ad)where(sx,sy,ex,ey,tp,axisPoint,invAxisPoint)=axisMappingatszdrawGridLineE_Top=vlinedrawGridLineE_Bottom=vlinedrawGridLineE_Left=hlinedrawGridLineE_Right=hlinevlinev=letv'=p_x(axisPointv)instrokePath[Pointv'0,Pointv'h]hlinev=letv'=p_y(axisPointv)instrokePath[Point0v',Pointwv']-- | Construct an axis given the positions for ticks, grid lines, and -- labels, and the labelling functionmakeAxis::PlotValuex=>(x->String)->([x],[x],[x])->AxisDataxmakeAxislabelf(labelvs,tickvs,gridvs)=AxisData{axis_viewport_=newViewport,axis_tropweiv_=newTropweiv,axis_ticks_=newTicks,axis_grid_=gridvs,axis_labels_=[newLabels]}wherenewViewport=vmap(min',max')newTropweiv=invmap(min',max')newTicks=[(v,2)|v<-tickvs]++[(v,5)|v<-labelvs]newLabels=[(v,labelfv)|v<-labelvs]min'=minimumlabelvsmax'=maximumlabelvs-- | Construct an axis given the positions for ticks, grid lines, and -- labels, and the positioning and labelling functionsmakeAxis'::Ordx=>(x->Double)->(Double->x)->(x->String)->([x],[x],[x])->AxisDataxmakeAxis'tflabelf(labelvs,tickvs,gridvs)=AxisData{axis_viewport_=linMapt(minimumlabelvs,maximumlabelvs),axis_tropweiv_=invLinMapft(minimumlabelvs,maximumlabelvs),axis_ticks_=ziptickvs(repeat2)++ziplabelvs(repeat5),axis_grid_=gridvs,axis_labels_=[[(v,labelfv)|v<-labelvs]]}----------------------------------------------------------------------defaultAxisLineStyle::CairoLineStyledefaultAxisLineStyle=solidLine1$opaqueblackdefaultGridLineStyle::CairoLineStyledefaultGridLineStyle=dashedLine1[5,5]$opaquelightgreydefaultAxisStyle::AxisStyledefaultAxisStyle=AxisStyle{axis_line_style_=defaultAxisLineStyle,axis_label_style_=defaultFontStyle,axis_grid_style_=defaultGridLineStyle,axis_label_gap_=10}------------------------------------------------------------------------ | A linear mapping of points in one range to another.vmap::PlotValuex=>(x,x)->Range->x->Doublevmap(v1,v2)(v3,v4)v=v3+(toValuev-toValuev1)*(v4-v3)/(toValuev2-toValuev1)-- | The inverse mapping from device co-ordinate range back to-- interesting values.invmap::PlotValuex=>(x,x)->Range->Double->xinvmap(v3,v4)(d1,d2)d=fromValue(toValuev3+((d-d1)*doubleRange/(d2-d1)))wheredoubleRange=toValuev4-toValuev3-- | A linear mapping of points in one range to another.linMap::(a->Double)->(a,a)->Range->a->DoublelinMapf(x1,x2)(d1,d2)x=d1+(d2-d1)*(fx-fx1)/(fx2-fx1)-- | An inverse linear mapping of points from one range to another.invLinMap::(Double->a)->(a->Double)->(a,a)->Range->Double->ainvLinMapft(v3,v4)(d1,d2)d=f(tv3+((d-d1)*doubleRange/(d2-d1)))wheredoubleRange=tv4-tv3------------------------------------------------------------------------ Template haskell to derive an instance of Data.Accessor.Accessor for-- each field.$(deriveAccessors''AxisData)$(deriveAccessors''AxisStyle)