From 45a55dbc5e4f3141872a50588aa2424d0d22a80f Mon Sep 17 00:00:00 2001 From: Vivian McPhail Date: Thu, 2 Sep 2010 02:54:50 +1200 Subject: [PATCH] initial repository darcs-hash:20100901145450-af16d-11f5ac7750d938d81276e005e7b4a63d27620fb0.gz --- CHANGES | 2 + LICENSE | 27 ++ README | 65 +++ Setup.lhs | 3 + TODO | 12 + examples/perturbed-sine.hs | 92 ++++ examples/perturbed-sine.png | Bin 0 -> 38208 bytes lib/Control/Monad/Supply.hs | 116 +++++ lib/Graphics/Rendering/Plot.hs | 73 ++++ lib/Graphics/Rendering/Plot/Defaults.hs | 177 ++++++++ lib/Graphics/Rendering/Plot/Figure.hs | 231 ++++++++++ lib/Graphics/Rendering/Plot/Figure/Line.hs | 136 ++++++ lib/Graphics/Rendering/Plot/Figure/Plot.hs | 215 ++++++++++ .../Rendering/Plot/Figure/Plot/Axis.hs | 76 ++++ .../Rendering/Plot/Figure/Plot/Data.hs | 397 +++++++++++++++++ lib/Graphics/Rendering/Plot/Figure/Point.hs | 119 ++++++ lib/Graphics/Rendering/Plot/Figure/Text.hs | 181 ++++++++ lib/Graphics/Rendering/Plot/Render.hs | 129 ++++++ lib/Graphics/Rendering/Plot/Render/Plot.hs | 127 ++++++ .../Rendering/Plot/Render/Plot/Axis.hs | 398 ++++++++++++++++++ .../Rendering/Plot/Render/Plot/Data.hs | 327 ++++++++++++++ lib/Graphics/Rendering/Plot/Render/Text.hs | 154 +++++++ lib/Graphics/Rendering/Plot/Render/Types.hs | 190 +++++++++ lib/Graphics/Rendering/Plot/Types.hs | 367 ++++++++++++++++ lib/Test.hs | 92 ++++ plot.cabal | 88 ++++ 26 files changed, 3794 insertions(+) create mode 100644 CHANGES create mode 100644 LICENSE create mode 100644 README create mode 100755 Setup.lhs create mode 100644 TODO create mode 100644 examples/perturbed-sine.hs create mode 100644 examples/perturbed-sine.png create mode 100644 lib/Control/Monad/Supply.hs create mode 100644 lib/Graphics/Rendering/Plot.hs create mode 100644 lib/Graphics/Rendering/Plot/Defaults.hs create mode 100644 lib/Graphics/Rendering/Plot/Figure.hs create mode 100644 lib/Graphics/Rendering/Plot/Figure/Line.hs create mode 100644 lib/Graphics/Rendering/Plot/Figure/Plot.hs create mode 100644 lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs create mode 100644 lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs create mode 100644 lib/Graphics/Rendering/Plot/Figure/Point.hs create mode 100644 lib/Graphics/Rendering/Plot/Figure/Text.hs create mode 100644 lib/Graphics/Rendering/Plot/Render.hs create mode 100644 lib/Graphics/Rendering/Plot/Render/Plot.hs create mode 100644 lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs create mode 100644 lib/Graphics/Rendering/Plot/Render/Plot/Data.hs create mode 100644 lib/Graphics/Rendering/Plot/Render/Text.hs create mode 100644 lib/Graphics/Rendering/Plot/Render/Types.hs create mode 100644 lib/Graphics/Rendering/Plot/Types.hs create mode 100644 lib/Test.hs create mode 100644 plot.cabal diff --git a/CHANGES b/CHANGES new file mode 100644 index 0000000..4cf0431 --- /dev/null +++ b/CHANGES @@ -0,0 +1,2 @@ +0.1: + * initial version diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..30c528a --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) A. V. H. McPhail 2010 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of other contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/README b/README new file mode 100644 index 0000000..f3cb5a8 --- /dev/null +++ b/README @@ -0,0 +1,65 @@ +THIS README COPIED FROM THE diagrams PACKAGE + +Graphics.Rendering.Figures provides an embedded domain-specific +language (EDSL) for creating figures rendered with Cairo + +For some examples of use, see http://code.haskell.org/figures/ . + +------------------------------------------------------------------------ + +To install the Figures library: + +1. Get the dependencies + + The figures library uses Haskell bindings to the Cairo vector + graphics library. In order to build the figures library, you + will first need the following: + + * The Cairo library itself. This is probably available through + your system's package manager and may even already be installed. + On Ubuntu, for example, it is available from the 'libcairo' + package. + + * The Haskell cairo bindings, which are packaged as part of + gtk2hs. Unfortunately, for various technical reasons, gtk2hs is + not cabalized and cannot be downloaded and installed from + Hackage. To get gtk2hs you will need to go to the gtk2hs + website (http://www.haskell.org/gtk2hs/) and follow the + instructions to download and build it. + + * The colour library, which is available from Hackage. If you use + the cabal-install build option described below, the colour + library will be downloaded and installed for you automatically. + +2. Build + + * Option 1: use cabal-install + + If you have cabal-install, *after* installing gtk2hs, you can + install figures and the remaining dependencies with + cabal-install: + + cabal install figures + + Optionally, you can also pass options such as --user + --prefix=$HOME to install locally. + + * Option 2: manual build + + Once all the dependencies are built and installed, you can build + and install figures as follows: + + runhaskell Setup.lhs configure --prefix=$HOME --user + runhaskell Setup.lhs build + runhaskell Setup.lhs install + + (Optionally, you can omit the --prefix and --user arguments to the + configure step, and run the install step with 'sudo' in order to + install the library systemwide.) + +3. Building Haddock documentation (recommended) + + runhaskell Setup.lhs haddock + + Once the documentation has been built, you can access it by + pointing your browser to dist/doc/html/figures/index.html. diff --git a/Setup.lhs b/Setup.lhs new file mode 100755 index 0000000..5bde0de --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/TODO b/TODO new file mode 100644 index 0000000..bf90254 --- /dev/null +++ b/TODO @@ -0,0 +1,12 @@ + * text labels for major ticks + * columns + * bars + * impulses + * steps + * legend + * annotations + +| * pad side opposite of axis label only if there is no label on that side + * using padding functions not raw data structure pdFoo, pdBar + + * simple interface \ No newline at end of file diff --git a/examples/perturbed-sine.hs b/examples/perturbed-sine.hs new file mode 100644 index 0000000..9dcac91 --- /dev/null +++ b/examples/perturbed-sine.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverlappingInstances #-} +-- thanks to http://www.muitovar.com/gtk2hs/app1.html + +--module Test where + +import Control.Concurrent +import Control.Concurrent.MVar + +import Control.Monad.Trans + +import Graphics.UI.Gtk hiding(Circle,Cross) +import qualified Graphics.Rendering.Cairo as C +import qualified Graphics.Rendering.Pango as P + +import Data.Colour.Names + +import Data.Packed.Vector +--import Data.Packed.Random +import Data.Packed() + +import qualified Data.Array.IArray as A + +import Numeric.LinearAlgebra.Linear +--import Numeric.LinearAlgebra.Instances +--import Numeric.LinearAlgebra.Interface + +import Numeric.GSL.Statistics + +import Graphics.Rendering.Plot + +import Debug.Trace + +ln = 25 +ts = linspace ln (0,1) +rs = ln |> take ln [0.306399512330476,-0.4243863460546792,-0.20454667402138094,-0.42873761654774106,1.3054721019673694,0.6474765138733175,1.1942346875362946,-1.7404737823144103,0.2607101951530985,-0.26782584645524893,-0.31403631431884504,3.365508546473985e-2,0.6147856889630383,-1.191723225061435,-1.9933460981205509,0.6015225906539229,0.6394073044477114,-0.6030919788928317,0.1832742199706381,0.35532918011648473,0.1982646055874545,1.7928383756822786,-9.992760294442601e-2,-1.401166614128362,-1.1088031929569364,-0.827319908453775,1.0406363628775428,-0.3070345979284644,0.6781735212645198,-0.8431706723519456,-0.4245730055085966,-0.6503687925251668,-1.4775567962221399,0.5587634921497298,-0.6481020127107823,7.313441602898768e-2,0.573580543636529,-0.9036472376122673,2.650805059813826,9.329324044673039e-2,1.9133487025468563,-1.5366337588254542,-1.0159359710920388,7.95982933517428e-2,0.5813673663649735,-6.93329631989878e-2,1.1024137719307867,-0.6046286796589855,-0.8812842030098401,1.4612246471009083,0.9584060744500491,9.210899579679932e-2,-0.15850413664405813,-0.4754694827227343,0.8669922262489788,0.4593351854708853,-0.2015350278936992,0.8829710664887649,0.7195048491420026] + +ss = sin (15*2*pi*ts) +ds = 0.25*rs + ss +es = constant (0.25*(stddev rs)) ln + +fs :: Double -> Double +fs = sin . (15*2*pi*) + +figure = do + withTextDefaults $ setFontFamily "OpenSymbol" + withTitle $ setText "Testing plot package:" + withSubTitle $ do + setText "with 1 second of a 15Hz sine wave" + setFontSize 10 + setPlots 1 1 + withPlot (1,1) $ do + setDataset (ts,[point (ds,es) (Cross,red),line fs blue]) + addAxis XAxis (Side Lower) $ withAxisLabel $ setText "time (s)" + addAxis YAxis (Side Lower) $ withAxisLabel $ setText "amplitude" + addAxis XAxis (Value 0) $ return () + setRangeFromData XAxis Lower + setRange YAxis Lower (-1.25) 1.25 + +display :: ((Int,Int) -> C.Render ()) -> IO () +display r = do + initGUI -- is start + + window <- windowNew + set window [ windowTitle := "Cairo test window" + , windowDefaultWidth := 400 + , windowDefaultHeight := 300 + , containerBorderWidth := 1 + ] + +-- canvas <- pixbufNew ColorspaceRgb True 8 300 200 +-- containerAdd window canvas + frame <- frameNew + containerAdd window frame + canvas <- drawingAreaNew + containerAdd frame canvas + widgetModifyBg canvas StateNormal (Color 65535 65535 65535) + + widgetShowAll window + + on canvas exposeEvent $ tryEvent $ do s <- liftIO $ widgetGetSize canvas + drw <- liftIO $ widgetGetDrawWindow canvas + --dat <- liftIO $ takeMVar d + --liftIO $ renderWithDrawable drw (circle 50 10) + liftIO $ renderWithDrawable drw (r s) + + onDestroy window mainQuit + mainGUI + + +main = display $ render figure + +test = writeFigure PNG "perturbed-sine.png" (400,400) figure \ No newline at end of file diff --git a/examples/perturbed-sine.png b/examples/perturbed-sine.png new file mode 100644 index 0000000000000000000000000000000000000000..8bbc69b5064c9716fe955b26e6074b65bbefe2cd GIT binary patch literal 38208 zcmb@uV|-i<*giP1)!1olvq57tY8y1RZL>jR+qP}nHX1j{#EsKrPoDq#?uY%jyQj); zI%m!~H?HgEgnm_!LO~=z1c5*(GScGTK_G~j_doEkz$<>;+!Me*um-YH;-I(pUpbw{ z@gNWxNJd;l*)0R??dhhx*!s#py8o&5moOO~21dvC3Z4qwnmmI>6)c$Eyx(*h_-t|q)nLiqC z0wm{x+6RMw-2}9`n+X3dxR36N=S%H9_~Ve#@EYLD{$Ndy_xI04=Cm*i5pA#GY(q}l zu`tV6nStD=lyZ0HWA1t|C@3m2=<$PayBfsh*RC!v?}tJY@KaJ0#Fmkf8JU_I;#$@U zaNTl;6aE!Gv3DizBRBB+nFw|7YM4~&+c%83_;@zAOTCWEJ|ug`r<3w(yR*jSzN4Fu z{QQLX8;)p@{-9;zqboObcxYDRF)Slf)BdBIou|`kDP!Zpy`wFkXKQ3qAtIq{G~jpt zFSOw>Y=+%GHF>jV0%c`oc5nagDFg+Hy`TQ}PW#+(1d8S=+=I6|30*gxai8wa!V?m( zypH&{do8Ow4|#tn3Ozyx1qD6ylfIJu)m|{2Ugsg8K}Z>r3Hn2&+wQ`|KufDPp3Gt@ zFE0-+ukJE1&9H~ntTm9>&jQX*noQ#gKU;5(4(iu;dAQWSyIZ%d2VP%tkZZqy>?x8< z?K_-E?Z3O&p4QONP?L~=Arx?9WuT)A-Dq~dF)o!0TXlHj)4 z;9b86eT`bT?apMy{SB)n0;D?QcRl~FG6%P|2f`bgZdVMgi zE+PWKz`(FK_s4`Jf=yLfc>sq+XM%u`aJ9?(c_q_zYm~(6vUlWmv)#2mFOU2#efuR? zMMb5ysEGP*lqS0--L`Ah#m2V#A2$Otv&q51f#|k`_g#WFhr_<~UFU^&^veWil%g4g zL)^zSj18A{Yp`qgvv%?6Mb|SkA(w^n{(V6K<*KNuza zMM%F7`fkHU5-N+x5a&Emvu8xDWZ@-mWU$MFQ3f z*8t)hMW2L!`g@EyZ1%I4Yc6>=%~M#F3fFh;XqcKZP@e0ic;q0bPD`uoLWw^5-rC?>8vIb zc$Acs1Ci$U+6wA&v&+Ec($dpoQ&Lurv+Q^y0GSW>bl{uTK3QpK5NK#>26eG;adBOH ziPzPX+&qjb`usdOu@JZ#z{CU0&Pzy_C=+l{Gb^jWWy@^V<14qBxw)S{|DJYEtGgw) zyS(?#bG`nLG>2q<+F)oBYzF_Kx>zj7Ew8Mk@~$c^4XxB{j{0{M?Q4{*<$%zBGsVv| z-0;j?Tp5garrHQo=lk|bqVGR2ML|RJOXbH8*EZAVyR*!$@|v2N*{ATVby=3q0az4* z0dDIxELXIH_L6BGBS0)GGwNzIY*lS1^c}ZLngyPd;OtVR;@yAu+rz+}k+deIq=Ymz zaZ@?A0cdeGL})wk&wI7bxL{h-n1)Hc4mw{lvaaJTPL}yN!QR+lFbun8KTejsJA6($ zRm#zk1Hc>p&713S7S|{5zkg;Qw%`8g&bcaN3E(5)G7r3C)nYktuab|NvrBmOTniy)!DlQjyR8AM(#aD0Se66SnA3UdDMb3lBkz5L&A zjee$^e$&y30!05$fQyqd7e*Q_(8O#Qw)-^&DCQkt#o$DDJ_*L zy#zf>t0O@~Vj`>sIU}=~&5$Xps!IAq3(XYQ)qMznMS+~@^~!sTG?w-S$dgsC2SiCj zv-ff{{bP;pcGGoxu=OY_e1G2v8IKj@`!t_TzPz@!b~!>3o#T43C9SA9{BX600S`^S ztf{HVW;le5g@r}N!-MC(5W+(-VtYeBtQPMC}4z@hAQFM`~nZLfpcFzN-7xL;1%KB!ST?f4-wX zr2M><#($68rn8#QXLHUS+mC=NhyVNuxv;qCOwioagad>OBHG%SGhUo+s2YAmVp>4R z@bD);8UzAhtRGM--s)d~8}S4^oQj|2trPK&nw;8HRaJw1UvIKYfG{Y9&5+gkMA`Tz zgVX#&me;imG$e%A-&v`Wl9CWD&!^+!T9Zivug8PrlCm;U0J2Rc)394#2QU?L0FhcQ zR}D^O^4HpKca1bkk$Pjnp%V2hRch86kK=$>>*1mW@9!vZBhYk(`Q+>IyxjnQN-Z@MJenhB_!ze1tN@0PGYA; zOXB8@D-z9y{03mbU~eeWFoF$$Hv!eJUwd$vGzRbt!9W0H>ifLDjc520kOHa!qBAKU zTQf5~o$6#xxUslwhcUYM(1Ccp-PLxZ5eOL*y>BLYVz<#q1V-L@`>_+?5UZQR$)vrz z)8%OE)jF!{=flZ#^>5$46}R%uswgWj9E*2Prt|R6i9HHo08UZ^sBo@R!SGkV{@vma z-P-c1wlMj0?#g-73?GA9i$!{u*T*A{?rqy=Z3RpG_UVi)LEFuIk%MCk&#{{0K6$JPR!7!rshpu;`dTtjnnJvM`CO_|&L^+1PYF5D10XA3#L;mDF%R2o}$YCGe($?1W_V)Hmwxfy)_W0Nsxi|Hb z2Jj;xyAix*rw5lgbA)u5;0!QLT#{8;JPD2Bi&SNW-q%=V6y5S#5$dlLDh#kQe*uOK< z_b~=buLe>1QE_e^u@0eed`S1YtRbWK)+T@HxIJDFpzrkz6|W%kd3^xsPu>R@ryV;Fc=@wi4QNunwuo$|5~KPWw(> zUtg=)*f4wEt(sCS0}<+fj5{%51hBf*SOOg*7GmtNg_V_2Jhi+5K(!SB27^;gv+N7R z4xjU`mb+gQQHXeBsHmyy0A{%Z?!Db(N;a9 zKE$H~bmb-xOG=_zr4m< zi3~o>cYtm%$E>Tbw;v{URg0owuX>k=q<{dJcPEb|S}JAdm*__zy~qWa)&u!J^0)l! zhBSbpTB#8PM9B^F+W?5fW@JQs6bsfn-)J?nv^*_ZH3u$7w0-Gv58Z}%x>VW!_jtb6 z;b3fJTkbT!vJxdRF)@YPngB4eTDzUT5y8U3!Y0Eg0IxvNu+P{DY!DtB8?&32 z=g}XHqXM!5yA1%D#F2?VVO4irBLYdI9DyV7KW_W6QdrZH18nods&XmGyPd+y{$7(PD|4wKuKpml$LK3)DV&L*E&*$e^ zgEEnO)RE2YYydYcEH4`Z^4k=|2BaKG;!k4h|E@H%zj7INB2J66baW6PFTiW?*o~xl zrr$p%|40}K9d)9j!g{^Qc{7<&2ifZerN*28^69iEflgQig4KbN)x&AoyBbibhnqmp zaWRzkD2E4p187I@caJ~FucM=*N_LM6%AY|M57KCj^LNKh+hIFERc$2e&93*zQ3y`R z|6|l^kh3#2qDq*T1DHc^+dhOPrEFT^AiHgEpuDol#SxhmV%x>0H9MOkxc+btU6r&9 zctby8X(=(w>sDva(=81r#f)7j$253_^yY~0EerZt0;t)%9|bu~=y1x)$~he!M4+!g z$f(~R?0kl6VhV+;1u7_XKD!5`;6z+k@1Jgaey&c0X$Gb zJsx?7{H_|7D5B$Yd?F4r+@$|;ZJ0d$Xr66odV0T1e*Z$*$i5+2W;V!R8YRs3c?GDy zqlp9r_JHg5lkjX?y;SJh!pEd?_!HXvIaeq46u4D(o&LRIc zewuqO`J%nL-L!aC?7zrYQb01A+vg6<20ij{)e{I*wHP8vV1WpIW`tK*wYXAwWD1Hir^*!|Y2ac?OBQ)83ab|nYiEVrpZA&hWqqhDCS zlbE8f^=w|d0vT4S>@FxRM!CNI6U@%;di^xBR%X+2;j4RAyZ810cX`%)GIWaA@kD<) zE43*YPRok&;czN*9JtKpu`MPIyUUjQN!MNwE}l{+`Tgebiabv#;YI7w!qioMbi~!# z`eFnwJl@{fX1R&L5Z?2pSR?1fhIs@oav33}9#FAahy*Si!K7VgBjBjrWTV1E-Lq0> zd@{tqXaqL>ti-c5l^G$QIku9ivk-ZN1E>X}Ti4p*ior!&dT%~@bCiv$bM@1Z+s|2TSAc2#gw&g- z=Gr3`vQp!mU9GgKb?3ND?gm9hS`2yKs{H2PW_xld6E>unDaWmGsZ6^9C zv0n=j>fazX9HT$wwmO&37M;W^E<~8-x!Q`6mG@}cLZAskgVzd8I;y*2eO?UrbX6|h z{Pg>=T4IkTp|-p*7Z-biaLXLSJMXius!BY9=>e;!goNmSYT5trTleid$6=NpNmn?F zeT~j!XrPJ;EaumsN=^TdViBY&T}PAYD3UoR_~+}U@VqLc@V`(Yf`TMb4zdI-hAJwc zhoWG(ZIn5-qKJEPM1;S`rCmWnkTHyp{I0B0l<1^ zQX5H28^ND>DPoSwDsC;70Jw6;?m*FC^{TNiYt7Roo^sM(9RsCQuw$lCb6dQV>x`hI zhgbN^vUcvyf^}=S()NV)S(evs0 z1TnW|qgDl+mMb>&qI_nJ4WP>h%_h7wH=V4VrEd^uc#$D$#+a2{9GptR zs|O#`Cn^@M>VM~A*ilB$wYRu{hx7en%L4Cjm3FY->855TJ5DcW6g$iaU2(}QB^n9mAzX>92$!~6rzhdW7?Cc{;-WBw#n%YIhhj*if~qMyG>8-E zBY&vi#l`aE-WLV_$$xJDp72G*C1ToI)vd|l^eAhLOdwlZEwEZP+xfRlu|-=N1=;e5 zO4rtZp%LByb;bS@r}n9L8$&r9#B!TR=cxvqmqIGy)fzbK=O52|$U*!eVT3Sn-;+mx zIyN@Gk6QDpQe$H<8aK`GWqkW!EXB|b6f%kmjOa%)!A*3cs){N*JX!{^+Y)L2zX`M_`SGn?Nw=TP-dc3G~#bakpSN)E3f^@^t?LbA;b(MbBq-751OaH{I>tUrI_SL%TRdO{N-THufb# z2%X;|b$A2CZqM@pL5n2J;W0hc|3 z&)5`7DBFl!)T0d}Aq+*N%J*0#~#(bv`^6C7~oTH4zBPrm00N+IoR zXmK%DB;k<7E;49xnNO2Vc zTh6((XfmfsdFk#Q`rnzZ1w$p3T-T@|!z!Cp^M>1MdRY8$GX^PGAK&4&61TSrEFEE_ zm_0~1G?Ia*+f$0}i|uaGL2juw6C*tQ4?@{5_Y$@(I-MKYJD5x{1-ffI+ni4}K==*H z@!p2eyBqIGH6<7PcP>2?&!{{sd~(Xq7_)E0btadm?X0eziQj~5VY%2=leg*j_-LV} zHjDTzsTxJZsArIUZzeYiFXRz+rpB?g+~wh`Wji}g8EFbO;JZO z*t6FL_7MUo5g=u_AExroD@Q{B0ePnq@T77~Bb6XFd>@-CPbMZjFdkY=g!+b8{S}83 zEvr4b+P639wPg9_b6rIVPT*=xa>VauHl!06G;dikjW3z9y!nX5&L*6O1oUc zQ#Dou>#Xm)|B7h|If!UBD|aghrbYMY?r!QQEk_{?gwdL>pPz8f|1q6qGzbfWm{~+s zlOj*c6>y?yRB>OBv4*`Mf`*?oS=tqZ#Y@dBu+{TdOrNd5wWc5{I6mX zOwv~9+7if=K!lS{w=|QZ<0p;_~4V2te9xn0&T=4PFb?a8@zi6488xH5$ z^!w~boam9ze@B?qQS&1(Az%uGxM$8(HsGB0eUT1v9SzB0V2m+KYwv@UQRK1ko1=WTAJVYLH@%bk{Wb|j@>K~h zZwxZj=WT9&hd#I8>d~<8NJ&Z9Tr>z~Ze}J`s6OR~F~xWM_l&}LJW1lU8)z~~pCRUD50Wi^))v<9v@-V(Ndq^zPQN1 z%l-Kn)KC2OBbRmnF$Qd9D5nBR$-#oqyKv(t`p73)+~3wD%xxpSS&T3;%I9%1KUX*+ z-w7l2TKwVoGa&_+Q3cHIP3v@8*w#8dv@}?UGdq9Gz~sMs^M`_ye9gvH5y3s}W9K4E z{CeiY##0Lzu%&;CJeO)D?-^ge_L8y{5gmi9wx=Ve4U-rH(!iungm+Q4E0mL7KMgSR^{q<_KHEBa5trkbjqmBR2luCF5oG#p>T^WN-K*%4RnsgX-sD?C92|@_k zwd~tKL}xIT1i%lg7Lt--JafHA-l`8ZGBR^o%WnL|fGekg({-Y?w6xw2D#E7C27PlH z-i}oEJF)ov^ImG{k6N^zGo1zps5T6;+Uc(_226_$ocE_62%+rjZ4I(>5jnY>w-^9w z88)+0F29w49ywW*%=*`4Jyy@K!L1z8D9p|gDbIw|tt&KR`Adyyx)O;2{VSn(^PJo! z;-nhVkTr^!7P{bk=OT7FQEOztfW{HvasnV#Hgq1&;UQ9$9t+!Y0a;0$cNAC(R8VxS zhA=knT^Y4p0+J4C8GBr}aBN{47-=iy0qYuWtT0@%V<0cK;M}m7E~~F0Al$&hxqqE-Yt+56OM0IDGGIT5J7ie+=YD6HLM+Guj_`)FRTRL+I6iPNFqfCZp)zJdRggt0#1| zV8wf@YH{`*VpnPwabg%c4?bM6@X4XT7ir2?0e8vDpW#b!zT?Gv6_(_{0jRZMKmdA& z*m!iR+~Bi;axe2PQcdi#feulTj3aDLQPHSbXRHW;sdJ>MvCn@Imcl?Bv@Ej0_fIS= zWe-7ZF)UIYi(Ri6RAT^OaMMjS@!1ADXvNtjebR(VSa~^X6krreboc>VULN!2UcC<3 zeQFTVIvf%!cgDK%uo}efP_ZR8+Q?LrFI`1l+lGn0dMkNeeTTSypCI3vcrAd59RUeP$G;@79Ph_5mp0L!m$v(uO zU6^3PTzvR}Y_=V09}_ChO=_nWro#vcR=n;hn?Mso!;Wwcrb+K_3{FP(~t`;MCg7 zH(1k!L3pe=!0FI_>FIz+t|OB(6z!U12K2h6ZL)qYSIc;R1>#te@c!9wS5=Ve@@`k^aP@H_5wc^plfkIQ_r|HL;Ff zZG6IM$7i(#qmtAIx#P{J_;b5E9pI@)e~QA^=%e<_dg@CN5Z0R^>rJ76bXXh9bXs!k zF0w?oTgpPZ+}XbWrL7OL_Ct(Nwm^N|{1Bi*119-qZHx*=D4xN<+^;V>ax$^HxaHpS zN{r}deY@{PClF{ztspf|rK8`-hy5r|lkIc1VwVjCUc_?QhYuU(MaWktE$IZX3}>rH zPAH^f&bPK;*O=He#OdE05gfmxv!KvGU7f;?q^%z-HBt+T#+F&t27z?JHO+j( z6pcjO;W!z-BQpxjFNGLwx;Qo9Pjs-Y-;{6hw}FPj#7F3x1^ zm(SYp(u4!*WK2vW6`PSsVh%`{>!`3_FZv)i&a4@5lhT93e0*P0Mn|tz<1!6Ss42c; zw`u#a4zXG;G43B8lC!X&MGIWRrv%(w0R{9v=Vk3*5fR8(*w{OT$vRInKh#FMHQ z_33xClaotfKf!LQi!Xl9sNM84XOIO21<<74e=+D87;1sybV6d{&LFOCLx(FcI`J?Y z?GxyE(TTgbxcKmQUa{8W_GIMNG}{}8!*ohqULFM)WeEg>tu}x{f98;0g!208Aiw2rbc424Z-$v)XH~}@e<9$ z!a6>W#uKR=a6l#CD0C9|A^P(x@9Ww2E7SQFO_m#E_tRpv9WX=z0)>T#^Q)6xNWr*s zu(Q|b_5M_#K`8T6nZ@|c{5)uZSzJ8Mag>CU)3Xb2xr3bd72eE7vcK6!%x{4U55+Am z&MyM_$Ha8i(^e#UQ=a-ARXt)LuqULL-JR#N25M6Z7qj?YJc)hdNE zzYeoc{W8B$UcpbznC6{(Dr@ba+V58*A(v;+FTTsl#6~}Ja%;?2w3$f3Zrb<*0|vXm z2t&k+4-gmuE%CYQEuaU04x~}yKm_^w=F#r?tT}%wH-Du}rQ8l^Cb~Rn`uGUF&lA4) zx-eAG4w=rih`4Y%;*|-e3tP?(TE9}AUS6qGO#780aN>wi# z_I62bRQ^*#;*8S`a{7A5i0DgEJPNI=!+NC_LP8>h&*wP^&SY=I2_17~ z(Jfa}cR7BE-bf@_V}TxpE4%z2_2U8?=r|QAXyNu65MEW09&1QNzKanVx^U5?y$&#e ziG;%_4746W6o>XFrNu*=KY)RV_VYF*zWa3)zIb|CnRxtO&)!7)Rz=BoFgR|_VyM+b#c<>Wk9u3&Myl02dCyJbI3XM zlCeZR;UL9KMuf6r2j`8)fx_Tvfm;NL^$X|{1um@vL>)3c`{iqkv%dOlViL7feY~tj zl87b(kUP7lomK4o{rjNA8_m_W8RR_0cl0})r7Ps63z)~qaGc^xx<@7c#CdL8o2p#h zc}MWxh346EgTi%ulBNP0T-r5?0osS*>8dcQ6RVX&27_|O^ER5AmAdRa*1X`lfemQp z$|Z>N-)VvS9I%Z8TeUJnxBwW;Zg`6fkOx=*R9F0A4dA#LE3T|` z9VeG1yB`g97!u7$F*5PgJF`-xgFs$l_qzu|;OS33(9ddTy2uo8XE&M32yJWo1PrU_ z1FiD+!3~P#_kQF5bl1#_Tf##5&s(5?X((Y{q9LF$&gOn?6hX|dYSvZzOD6Tw@T? zCgY^)aj_o|`qPXU{kvB^8UbBb3G)N!Pu8|6V6;xWs@`v75K}gD#$54^l>9E>5H;fa zEl-wnpiMn;i$NhNz7`^v$_~@+dNBl81O{TzWdP|52$(;K^(6Iq&XLRVVsDS(lX0ALW7*zs@zBduB`j6}~&rLHp<3>}m%oS!&Eu9;!h?7wLi z=W-5ltZYblrk?b;+KRG)rMRX}P&bJfz_i57sD5bL+`OqQxIRd|0Z&-o3IAjCxNu-!p9TRI!DsVS%(Q3-s|O<76>rS zav!?(a6+R8xm}OaT{pSGMet=p|zH;>Byr3L?N1YGp2&cui#1l(Z1%J->t zz=(4*3CGh~i#uSXjF5$F`USiJTesKPv^LL}$?P%2THsa3b$(GdFKt*=5|MUn|FTFj)wNrS)PP`o~)ODdjqL{naesY6`p6C9W> zL7{aM3kvgG-LkMroMKsz>cm>mBXF~XglE_=tGscULz#(GN6fXK_K{eZz6>qf9Kk~G zFRwkj6)R)za>NrTApTG zm%?Xay5$Viw^Y#io9pjj!j_-?f!kN}C)Tt7QQhHlsP11ivDV0IOwfIlw1 zx;@$qm<%HtGCMVmss}ftsgEwAcro{l>*hsujZ`kB<8|t4{(haJWa*iE`yb+SS5LGE zgnhPGT7@9oPuFa=DQU*rmCg_YjLlpeRK_&YTrSkuHQEG`WRcKCIJs7fug1*UTtwV^ z^n7d-J~a?120yN{d96C)X=s2et0Iv3a*b#@jQ50GUOiXIdE3Dsd-Qng&J`I(=B$pD^p`J*wXBg+?l_X;m9=uEt-9ewG-)q!BVJTG}5RYsdcCn^9}`M-6r{vO<9J$ zFgpX~Sl&oIzuwW4IQNfhYvAIT0~CaI@(i!Dy5kfD!!j#4sFA_xj0(}!eON%ilJGY_ z|KvdqgszSw795&*1_>{rm=(K?6!@(Vl0vvkh)@9qM0DT+MHo5SUrA!-)iStitTux& zZ{kby?w-#o8w&!t^?!(KrvH1{;KXqXQxEBrfggu{%Cs;yN-b6LXk?sJ_^G{MU}sQN zCpv%pFTR#DbHjx_6sqGPf2@Df2&jgVWq9@0iSV>X()Yu=u~f?C%!Zn%^8^z2D=J#y zEL~>eWn007_Jq(wmLj_jW6rKsXX zhRv9htE(3CFUJ3Ue9Etg?3Jo2=omw2g|vFBFXfn%?D#SY5GQ{JO!Qqtm9#@Ew$+_o z!Z9gg5Q0Aq?iv}IDj>$3lv&|7XJSs)Ej0q~7jY_<<4z5ZRtS?aFt~4a1jaJZ71F;* z655R+CF?^gP*+>6WyiZu&&ASNdjTaZGbc^7Tr;zYi&bjbvhG=T;{Us>jpF@IJtVS1)MP1Pr+EH>`1rQ*MIi-7Uv$kc2B_tw4hyP zZbv!(6lNm>CI*mUW+vjBxb}#G`J*4vm_`McLX z3Tk_?d{RedwNjYa13G_}psdQ}XOI zO!4o-0aZ#8x*AORX)PsSLM0tb43EQO5l^3+8DrL&Mw9^H2tBiO=xo%(P7sa>0MmJ9 z*a^tKGWvdQtbn?#O5g57pI^%oE<7)X5`J1{gZ++NZTp2JFaC(u-@2>kg;M+Gkhuv* zs5m?y2??6WV)r-J2l_6^;0#n`JanF{KSY^{zxV-{3Mg z&T6V7&=)$Z(M#7z03fWxhcE2vO1UvRsS#r8_%#kxUR~}6Q1rn#WZVyj>9#dMS7PMi zbh%neXR9@8twnArVIFpJ3I{E&vFTGcRvt5VafgerLb=1-mhttYJF>2mk56|!40*qr z75>x1)ulFagTM>ZjUYtbfgFZWB2k2j(v5qvP#QT3-@Agiug`bh8Q5+EUA{d{K6#cK?!Va|L`vPOj zz}}wSMi0A)Esgx_9>#s+jTT1U6(|dVNwdTh4nKTolnOS)l=2EXE+VgI+z2UfKrUDq zB;D}UiqvyXrVhOjCpkLpTVM05hm@D%c1Mzu;dp zqNiFB6ypl=6Pj7#a^Smhh9k<8Ov=dYipKvi{7Ap=#!Qo{mVr5mfUt|aEz>jFF>Q|s ztQryWZA)>DA7;Y&#knGv--7E0VSj*_0NdQk`dyMb)}{+4%dh2yx$?`ef>NxD?G?L> zzKYUFlp(Tf)0HH<(!wY$g(X%-NlZp$N}smfa!c`jSr%XA02X>4$J!2=jc5~S<72lA0Z4ZQSM;;dxio!O_aJ8I-dxT6dmtc zT|PE|FoZQV^CBBXb#P-AucR_WU7UkLap5|*VO+ty_|MZ# zHMvBk-w|!pY_G!^2b)a5T8k4j5$+Gq_5uw3t2KrZF2~Z9?X{kX2NKz48po-*g$0%D z_NM1sd6KKd;E=t~tyi@k61-RCK7Mg--3cbVyzhR~9^LmK=-Z)`LJ=EMoL~TBq9Cui z+;7&y(b9>WRN2l1=8GpJ;C)8@ZQcf8m`-f^AKCHxIPpDtf#j43?kT2+u~9a78Y4Xj zFW`RmekBJ{Ehts^`T{czMkahn60`XrH=F=7t)L^=1Q~;!!Vlpj*@VbzGaZ(=HQwz` zXsjwRVgA6%A3RV)=((Bx9L-SG0*U`k(HhA6Qh01he1JTWHr>co52%1-`mnIDNL4p! z#(dy~246xA4%*vhM8NbJinFIx6(%}89rskIORu7E`q(RzPoxbJPnT{AkR_*$%%_N> zvFyV9kbvQ5!PaPsufQ}q;m$}&EQ#4$^dD)k-SO`J!(lYRXY!H2@Hd?lVDn?hEGBgE z*EZ((hx;HtzVFONi7_9@6a{aw{@Xo$uN15S>rGd{rd3;(nyaBIvZHZC?n5kl!!0Rv zf(;C{T!?3Yg!f*=m3DGoL{PEdvzIW^pE6RGF0!@xkl_*#-!^Zw35LkT{J8`^HVem8 zhZJ-NZ=_j-zi53(;i#;5jEHxqqj$I&o}X!Jn2StN$8_GReMc2M`&h&mX@r;nI5dNi zn2&b>V-1jks5OQTs~h#v;y$y~J%O!1%$i!?e<%|kE|O-NgYh6d5vD|iLs zqFDx>WCYfQ=;XmuKetj+B3B*D=kxZ-$y8LwcgTHU%Dop@HL7*J(AjX?iv;EIimTVPDc*LbVzRADIBlWraN>YQCt_MxL010{&xA&r2wHZ`Cap5^mo{xa3BhWC2g6Q!r>TqXJ(s4E*=_6 zNv>$ZaXT(lxaYih!l8A?emGW?i8>RGztLnUE4dc}*=v5zEt-a$q)@)t`9;aG1F7~QUM zI{u#Mczk8{TaAp4&Hx8qf&&|c=IWs`BI$7d1LmY%n4vNZ4DqTS&`kk-hr^9$ACNOD z;O!R4W9L*hs z$3pSAnTnNBfECsMG<>99B`j4-;cR;&fS4D`UnYV>M$&7>e0tvRp=|&t36IagX#d{* z=1_mNPE^V|bm96FFn0?hydi#IEm!@6(J~-el2*x3zg$M>4lgDvYN9$Mf{YIF=X~$~ z&H^B`oN*VNI~`6TAZ+}6R`_kc2LLOHAqEQQ#_Kq*v&cjvG+pbf1{KTN>!;jOeT8XmugcvO!G=g;B~5TB_t#s4p@9cFMQvgQ%qvR zeaUkQgR;5v*o9F-igUheSaje#i+J$l(dCD}y1vj7J(7~(mJ2_b;4GOf)U(lAa78P_mN$x$aNo)w-I(}+ z3|QPBZn58Etlk9LGj9KGm$l`~ihmmThd_7I5vozcEF$C)AO)Gk`e=7F=m~2P9L15G49~4_3LXIAJj>{reSMP=B-E zOhA%b^U|Jw{FX+SxJP~}SKB7e7-N^x-7H~Vv``kJCf)IBw7M;)$g^V!hv2(;$2%Fn zx9WgzC5Ry8L4Dtf1U9>Lyl+)r4tctJf!>SqbiF3}W^6OCTEN7#*P8v!+CSt$j;=I5 zj|&;=K6R{~8&n%X2}ocvu^8TJQNo#=Q>lVE)j*15WN$JfH0cdFclm7!O0U}c!OO`y z<9h+k7Y>Qo@Bf6tTUKc~Nt1C#W^%=@fUk?#16Gy?-oI)9=+XUd-~Pu8>_h$nwzcpI*^SB7opNcWwh)G+vZL zkxV?`!@bNy3Gyq0E%f2!UevOH?Z@vtUJ#7BHYrT?ri7n?>diSuC0dT!)V{&+{k9a8 z*JTsmXD1Bn3^AFyI(`X4-+ z?_5x0NJ^NyGsXS z<@-i!&(I9rB?t)8DIg#*;2 zi+hn8er1x2dionJ3wa?%PlT5n;i?ukF0NJfQfoCVUYZkJ0__C_*lVt8{*g}wj!O8X zNWIGgvvB87!JKlG5(6=EGf$}irof<~fot4;gX6WTqV25`u)n< z$KYV;VA#Pk>ffthkXN(s`v(|^2=eME8~5eShnbiDEq=LDGB7lyROwLNsG6u5xUBqo z%jmR45hroPwA3s=dw}32jqu=e^w2sDDel*tOpSlTYKhXcG@S?S?ru1`bd=7@{`Kqc zprImYH+T>9AXY=v{+#$+xQ7dVg$EW?YhHIzI!STi+t0lqC^J)|Pe4aUHfC^wq47FH zzP9LPFgi6N&)`XqU;C|}IanS)Hvg!C7pRN+zY4*HyRCzXA@S9NICuagRcT**kr#aT zr{bcCe4o!?%hGF>XPAa&!kz$o$Lf7ADIm)bxVc`uWyHiG>;SI6e9K=8MMfy@& z-g{wX<$bl)$VV*e6PGpr5|7h<_%&e?C2SCkYV3WkSCMJ=7( z{7XeKHC}fp zb{Hd6ZGLtfL!;+BxnS#T8agM$*o0VH~@;9VAj;ex$aVX-BBzTN}1GzSxvo+#AIO$gd}J zzFZ=atwVW7NM`@RX5+4(o`Eyj zT(d`qT^7{$G@D9!f5#XTyuosB{;E#CPX-ob5uKp}9D9*S`#<9z1-lI3i>dMS7~Uqu zSwl>_!Z;@V1Bn?VW}iHJ-#~5j2a!)PE1bz{o?kLCjOfNW3xO1 z%|WWRh+xTkHMP%mxfgMYOyU0+RzsJlzY)<%It0lRP19hh11{q`aGt z*nSd+gq5Bk-{JnS7PP-5B~6mcnBp7e zRA^Fy)sZY7`X@N=-dfHERDi! zXSL46*!!~UlPJz4d=j5N#CVTw$+RQr$@`|+;|FhOazz!q$hUk#eKMlJ- zEfi5lN8LNJsJ6U}IO3^n4U+afH6;G&o0Tia1;-}*#_yU~iNwPv1@fb6{{CCVTd?Oa z2Zad3#y1uzs*^C#uD*joXc`%X0~yEN%LwqhqPKj@;eSJIQtB=0msJb4>Xso(`^(0o zS7jn&H8nMj|Iogq2cH~tD6&){tV_CV)+wp!UGlw;qU2~X*9QKJGrMR|hLPnMJ&)Sg zxR2=ZeeK>nm^+Q{d#cMqSrf3Zc2rZ_TsE2Nzx#N{qt4ilCx?#l*wfgKY2e}ZWo!BK zCgI)J1!9AVEAx9eLX@+tXpXpi^-R&m@dl>W~Bt#&#pM zt9tTEfu9B_a&PZnQvmNgu=WE(e1Xctm!aU9q64jVIiR)~u6!YTCoGDLnS9dNGzG)Q zKgH;pdjmSf6Yq2F3vle`QcF^`MU(yhIg-K{8`{88!wOQ%k@h78P5JE5zP_tYG;f}a^PTSG0ID~jX}t=O#rN=g{*sc&oh5JT)W z(dq)234RXk0#64n$?m4Rx{nB0RRsfX-fd6oghVsovIter9X8|l1g51`f0DiRC^Pv& zd{<@u82z)L-9K^Xj7h>3tHpDtbD_<*+IhbGe1301&e2g3tGTsR%DIi3M-iQuM;;m~ z>T(p(BYUG2c z$Q4c-@HqAP?BM+REW0G)S?yv#y=9uB>LCDe9PveML-C(~D*ap3Mq zy22^=D*J+X;b?4mjT$&mVUPm-l83G?E(S18oWDox*2~+jZ55Taj2s&4=um8KZVrzp z2KDslXc`#UdCw!<+_*cJsew2JIKQF51Ku!H-_|DWEJfk}^*%7)0yxT3H#gcGO;Mm3 z7b)%O>1iBls1x};obxa*Z@hbehn|S&LP?cy#w;bbDOJg>G2MPp!4iG#aa21nz-8~K ztybGBX^>N0ZFP?a5U|qUY-rXBr$u}4>#IJZ98)y`LS-6!{CR~(PM=MTJApV{@u=Bj z{b}_T`}V^h=Ue(Bve$LS zX^)-RMz6Yw#g-4}qw4EO?H4S4)!wg3xFPHptbI*C+2(i@v<(?NCkvS88@QkTm>WYP z%sI(p_1LXU&|#GAP97xwW(h)kPdxAr7XuJ!U$%U0B~B$7)48_ zT)r~Dg##Ef*yck;&!T8Y{=P-74-yY!35$j)mXj!H49RK5Nq-P?C}?1fAr4Vr%J`o7 zS#2W&S8_m?MUjYewymyuOSRx)nB|;44fS*~ftR2E9aZ_Vr2OHqy+obyUr=2GG z{}%C>$?Ta?RaxogD#q*{`?^Ok#iUBMS&vk4FVxJuu?-dO2sEvoDgfL-&$T0Z8eRsa6zUL-_kTm`^x_v_L z;c2r>HVFJ0028%D?=M)>000X9Gm9$c(vSpmIY<95x@5Jw&#NhA`f zsjVFZm^^X2g^qtv5NW2^d*uIj zv;_}Bk_B&*D3$K939*3ZxNUxT)B?5N;gsP`dG~um$Sg%d}#}LX0}v z>ez`;{g5>Bj+dk0?XRd{+T}H<*J{3q+5i5c;{(>x$rKU4*MfHs%9i?#6{=rsXe}Hg z$=0#ZAy7;<&ZD4xh}E=>3qUmNmH-f^kO&!)2)Q`_6I1plZsZYA7^6lM#@vCT1H;1Vib9k3Rf;Ghvd~s88xQrrfY}MFQC7E_T9lT7tM?KrR z{{lnCl$ekKC+hy|3$i%%4qaPhJ~+m+J(896T#L>NrAsqz!LlFcEoyR%aPfbuoVr;O zPwSf@Gk&a-q9=X@nG!${MCbT`oEO3cjqmhEn@wE2`cB6g6*H3t&AuPZl~DW}i!2f~ zX%|uPSDVD}uFiC~xu)!)A$H4LK0hFni*uJH_1Rd2ytI+VD0!XnBM@}z=VtA)h#+`- zn4<~M=fhb~m?lE+idDa5e%Q;vb|n>2molZ>n?#WE9YnMqL|Z5p5W;>LGXo+`H$YEq zI%-Q(U5HU-R%hF@vbMWy3VmWdfr9tn2vG&;WXkOOZ;@1;tS1Dmu$$Pr=g4unjm2!k&HKEO6wrhe0IIGhn&E?t-(_}539PdH zl3V8A_M@x68UfnULrf?Jr%UVZpw4rIUx8F~sE;RPSd<#Ce5=%$fQ?kpj0sjG64@Wu ziG|2y$){>kf^sK8Jvasu+e}{wGz?NUM(=gY*JHCHA9Zg!N*_th1Y&@~z_j87YRb%) z2oz1jTH4+Jj;en>8)xmRz)+xYu!s1ZpraK>42wQLf%+6ggkj51Z%0QTzoL&2TQIv1 zpDZ~;rEH>#LWo-~iW}fXE?GesGhT_wM^WK6Y{ip3#UeUjJ3l!=rJu5Sp1FBu6k@yS z0wdB4uwHgq9BktONG&oh1h0U=_kpe4g+dJ$0O+TNnJ7)us}5kzW3=N5>qgY@;l3!MTlDUvKh z=^bj+@)_H83(sU~4Nc3~CV5{&F6+Qp7gYxOt}+T{HksF8R4X-A-R#}okN}X+#$s01 zx*zLu8`%TF$?X%5Nu!1*57|S9#1Ws09c6{;X{hx&po~DoB?4|eh8zjG+!L#Mp5IVg zvJ46}@J<_g5uO)dXFF<74PJVEO+o;N%(^e3ka+2GywD7ta6OYW@SS19s-fXZZz(^&)Xza34uoTNY3nTpS7xvvtJ5`D`W}_nR+k2(?xt zY`%)D+u?oo%uINH`9sI~jPiD3 zF0Q49hl(GA%H7>C*Kwf!>;23-OToTC9vOItmOY8h`2p_7W;ueHwm1D?! za$|0~V}Y`|P@L~-%BY1vZ5zk!MK6%>c4W}FsOQMd<67VXGbR6`RX z-axes_&aCc_Rg#TK5s)oEl_5V)KA)ebuGeR(Hu_T3x0v;o%b)Z3g zKRP;^Lyel6ii_(VL0)}Qg|c>?3#ceRHhUU;j=9n_Ei|Q9 zL|!C@$W)=yq;#k)*%@!BZS^0^i!I*xHyFc~X<%Jp&v`1c`(JGa=yS;bz%Xj{61sEI z050*wkpv4I)cf8|C(7rT$1Whh-5bMSuKI;j&^V27SZm5a80SLX6--V(6k`G(O+(!= z)uZsgA3fZ>%mdfYf6 zf`d}A&u8$c+W!Hq%*+!3M~`CvEUx075^31or?SJH0lu{L`gFEr-L*5&*!&qb_}q9& zWz+^Zg$%@K5U2}>`Syad+S#!*rmw$Xp#sgAE@`a&te6c+FkIsqin9Or;h>C5f2MUI zWXAMnM%=*FLS9t7V-H`6wTqrA_4&6d%Xti2CH@vHhu;GZ)SIi1qJc zVjCa$(TBKczh@!}$(9b<+Ffdzz%;?;>>&1dHsHMw^VZjO=q**i$5w_7&s{Olcx3}L zL%IvUg;wts5i_J;pd)BySqY5^?a)>&RxV(W)i-luC?jT9>rMWGaR^pg`ZFQS4$mRw z@e^g2!icg*3J0Xod#S0Gp1VpTjU)=a;muu~eKhE;ZR@yy*UXQZs8ERnD*w?XKKC9$ zGbK5MKx7$pKwkv31Po0RPq)w_92`%^=BQ@G^A)v3biey~g$AJIykP@CHvlh9B`-g7 zu^a}E1#Dpa=%52Ptk0E+{$hJPbc2$pLUrB_*ZdojEJGkd^|bvDAQJ zo)XDYp;d%2Gk6k0BrxACGwbNCgR%#>Lr0kBLrP$%=-49o43NVnb>`7$*R0^NZbvgy zWUrNjQU+cx`qZz@E+l{UH$zH zU~T>ZSj3Wb@8_uaV%Cys%~3A}F(Cm)ojT$Wbbh#)+aHGlwA;!EZ^?<)b9L4ONMM#H zkECLz@PkeAT&y;QsnpSL@Q1rrxFdDuuz^IJkF2DASxyvhU0nmckA`Lb?q*t{T5m45 zya25*&Rch4-=|Id`grVM>%}cSz*CAAOuHkbjXK6g5o35X2Ue{#TQgWmkuTnoiG%O~1nBjPR%fV0jwne++6GkS@Uh@B zmvAg?3}EF&%rpU~5i2FTKL%-fp=F`=9;0-s37=2lkm zRDD?De@TcrcB#kdMNd8yrcO>p3PIscg(iUlD`2k4&&CP6zKci-fF^hta#*Ix% zWF*VS3EG3(H?1l8bQPibuK15%1X*H+u(3&SoW)vy4cOjxo3`7lAG$2}zzbPi_x1w( z13R0_wyDecDPtRPU^(M&*%pStU%wXcu^}FlQ8B7!ZJ1Llh@D(ZiOE-ZwW;r_Pi?>(L7VSC7v0e#J` z(&rJ5h~4%Sq@!E#OFj{4i+V79v7NN#_!>9jzHyRQFuuGtGl|sx|Ez8%uiL2ZTFQ4= z&cZBzdOA8fpiK#g0BCQsGmlIc;FqO1lN=E?tK5%$MaQzlCt{7AWYDWTDSSe%n;5EU zb`}=jNGUCEB)6&;gskpq!-_1+-vY-&{lZI6yl;&MvUe4b z^LnCSHYdr0t!{Q0SBR+3u{|hGK_UL9wOJNG$Z_{pjZ{&&vm%Y_XgIX>x)BLPhLS&0 zv*s|OYn4}TYjf34O39A*=qrCo%3=cBSw(5aADRUr&+?KaDzWzUU27(54MG!MwPWmy z@mePw`hWcunEML%L0Ui!41c&q6t-0UtEFYNQix26Nl66Q(eu*m#OsPfg?7o(WV&T1NZgvl>~Ls1ku1Nu4RZ~g9!(#%XOS- zZZ&~Q9?JL_AGYJSCyynh?46tx+}zyGJpkreoBcNf8Vc??A1W(r@2dUPD=7gIagQI@ zenv0vk$wo^?9=0^{5@$m-ECrqku_>JzxsKy#O_Ok=(LP4mnSkyp)-2a?&p&0RxNl| z!$YR6*Ry)hnnmW$%&cIe>_@eq+gECalue|ha{2QoZi5mCVfU zDJ=Q!TyoFaX-)HWn}i+NJGTs6-3~lP@tKg)%M$&Sy_IAZ@<%L4cDGPdRcm$znwc5c z6<+;P#!^Rf;E()=R)uL@S4h@P ze`fqjL2kuEt22;QZg`60wU?LEqI@+{0Tx7#(?95Wf0lB2yNRbW@XA|(6;rK&lAe^K zjmylyIPF~G=NbXUO-rAHr`P@up30Dbg_gIKx>U(Ugfa2pPX1wJJWMWL6gZ{j3{n`k z+eAw~W~YHUghkJ0dznholtC?*6%XL8C1;$Ijhs>le9VXtE>T?8GHaETy}F_{6x6$$ zUpp<)5iUT&M)%JgS_ThM{Upe81^h)h<8R9|LdSx0w^jZmX(rc?j*hiGo=)gKbj*;# zjQGx+Mp>vaX8A|b;1(lJDthcFj~0dw4N3If&}-u`nZQPzQo3n3Qa+VSL=R0Q_)%EqEbGy=#PHST#W!pbhs2FN-f%u*T`OVbSJ$bXADIGK~ z*yb{os&!ns0}UOtd3EBd(7IR=iTCP#lvc>e@y2-xN5x3B5j75UT|JnD8G=??9&GlFx z%hsleM;Q5Q@G_Gj@p%e3Oym!R{GXJS1f-QiImdSs2^;=PjRzb>1Tk|`vAfP``xHhJ zX6sbqaX>-2==%5#em_weI1(I^HA%mOcUcOht6WL10&n6cY2^f6&=(|--LLnrt$Mx% zoaG0Gth3j+7c=}055Z**&x~8%bJH0=bB48wmrSw8L;JLu z?{y-{(VH|8KY1cjwaZ-|%PC0XDJRnAg}gw7%l*j1?o#%S@DL!!a%xK*?bNXTtNk>| z*{{HGFi@glzSRJHtd_?;4+{7fm#4*>7+n`_no0{>2CDIur+d@b*wllX)H2Ni_TbP9PJ98nU|)>)i5YNJJN zYUd^PJYTu@rO!7Qq646nL46Dg+1TDjR3c8*bUjtbbj_#<@*RH=MO5K-&6aEaN6H$C zP!?&Pe_A5SFHCufv%>gpgxhhmX%Zbv+bvAB%G=!HU=kMzLvUJ|yv;f~ocm79F2#mK z>-^gmcb=Ig17&@s>vs>UuGKD{NtThYfk#6bRZEc5omVpkqe%|E&5veKf~$|`Q+|2{xhTQmIlrP!745sIk(Fxsa>B9@H>`CdB&?p)!&CGlj| zdsxe=Kqx1yF9C&3V0n|wi#}9$B%gP()aIFf{*>(YW{*|~DYL-FJyihHdED~d37SU( zAVk=#iFT|oJ?$aGsnh_hE{v>_@%fdf8YBalF0E${4)y}Piav4o!;ERm3GQZZ9y;zw z`;L>-(Lc@Vle>S%>Y(>@nx$Sd?H~SJJ}aV9cXqLKyjmy^3gcEaeVX)T{(bvB@04eW zFS6f@&GiuLv4r=Cb&pZ5o)wv;%y!Cd8mGbGtpe%1XzZf#>W$>WoQJCvm+5^D$z*(N zl#KE#?|U)O#zW4*;*@A3hrfT}ItfRQeRK_vnwLx3wxEJ7NN+xpH5=Lnq1!lQ&U@7ms}NnM8AVg>9`>y!hsN z1oW0nOm2T28INBD6}<^WFO`XX-uSCkN?B`AuGLl%a%1b7#wc?qc?x_-_gX*sA6qVr zT5B}j_;j7^sz}ICYZ=0xL&%mh^cQpEjd;YzG)-!~G0mZD>T<6F<3H+FA7|{qpLo1# ziDuX|T5#SHE3#?z|9YOM1ar=L<(S#SXZIqzI*ohnZR#`olUg23lNEp%d~jwkB8KlK;I+D z=eZ^;Sc~Q|ABlcVN&S1zHi6jhS$$#45c+{r@v=tYh2k`m4A^>Z*v^Up955EW%J8)# zan+exEo*TemSJIB*TRl8p{x9X zH2k9cOdVZFludN7t7pPcF8xIYH~6@*mXqz7mMg18iQ9>v9f#8#WVc645m!26bA_%b zQT|DNq3dL0`n`?6IZ25vdj8tPtSX5tm7T(bm_S~v2!gkOUkgy!k+ea)pd;UMF!0)+ zqN%9~8sOwrFXU!eu}EhP&ZyPgE1kkvHqcBc78y zjJca5fJ}P0^l3{|K}vc zy z0r~OsrYl7R7pX)L^c|YQEE{6Ojd8+cj-vNmwCJj%3O5?Pp@|l z3Z(BmyvU$ZGN3UBDW@F;gSb z!@*6#)p79^Rx>R=moX&;hS)QES z_ZFfvX-AzN=Hp%c_qP8mnI9X8?DhNTJveD$mP4v8oAfcmCK9zerBc7%0PtFxZywol z+SNhUJj6|{OlAeOm`9Xfs(e~sTSK?CG2VQOo0^<_FO`y-l8_L5r?|il=CQdGq=RNf zx1TfM-82GU(E-@tn~&xxyX+N$G?AG)2f)_Dyz4#Z!pmw*pVZj2b}X&bDO)BvVb49} z*F&wWNfPKd;t{+VRMX^ffShS!P26oAiiWz&Dbwf&tL0Ir8>Pssd8B6XLRA8a<#XA< z5D5?I;$A~`={74C&I=Pwu(MhoSGWEzMJ`KriDbQIu2i%g*N|2!y4zjYo?`foq@$J4nMV6$P`QU>zk4`}9iU8gXSfyQ87#VGL z$v-T?iZq6b_8LvHf{!`D-=coZa#@YmhiHZDVdv|jGakl2gJ>D>1pN)im zu48#q0}R6Vvf&rR9CHmJS_khvcFiG>n`3@=VsV4-aWh9xLNaP<$%5`rH;GiQC&uU~ zqg(Xk;&}*b=iSo&lShdkfYd>fQvLGIgFoM0uFhS`jO$@vnlkSD0mI9m_J6xiLGlS0 z8gIaW`E9azsegVAzzfSa|MtFvv>>ZPZfcP2cE{(syu8!|F;908nWOa~4gIO-6w%|# z)OcM4LG4kmR&l!vX0ck~MOjV7&%Qt%txo40W> zugF15I@)M!L}ugX0&uPw*4dN2lerH9C4)g3{to-2YP^{7(8#WE#?iFJq(U3L{xCxi zr+Um97JB@?N_TT+UY%6;0G^TYt3mA2&4t{b8wsr40apw7RO}hjXoj4dU+4sDuZqu~ zeN>|L)*=$1g?S;S5dykBA8DRuA~ckhzdeYN3Q}b9?mF<>QZkDCz~qAm65wM0*tJc1 zfZ#0%0eY}VNzC~oP%GDdN22__-ZbaHx?85TE(-*KKgMSgxanv*)_kdIJRVt^1xl+!%{}Dw`YGUpQvID|5{E2Hl=4CbXv~{CUNx8CpBr{))Ra;d9TM zw~w#suR|R+2orm*)Vo_eA5j*Sw$8Vg{`QdIQ`hCY^_&e5Fd}Tib!~V$A59a+D-)4f zloLBcO>+t@6b^KAJ9+pLr4+_#ELQ(zD|+$Em$AJZ6RtXBlsL~%O8yb5r#rpu0{i^~ z(KP-gIW&dqWi@2M32*ePGu@~K?65AwZO6Zz$*gMu~&VtsHWBJs70Wy*eQ6L20USO_n;@X8e_DXZ9=c z3q9(3(3g}$NA;Pz{9jU739Oo`?hXl?b%FOFBl$S9>qsJ1J^UWdnr>D<#-IG5<& zd-CM(1q9Cba66<@9G6jHHO@%P0;75KF!oWJ*w2g*hr3OlRlS2E`+ak7<`H-15BEAF zrr%qUCT&W07|E63jkUI(|KLxW_rgS-`xa@#h{So+k`8tgV_v=-W9ZcGdjK6AGU{eN z4x&;bcbN(1q|_#mn8sEyNuOb>wW4+G99KTa4t6w&`ITg=_~9m0i<^bFa5Keoh4rQF zRp%7qjj>XZb{M2fRws#(403ccOBMFRxm7*?C-)XS&;oJFu8DqqCO# zXee_}Q%}hZ)bCi;4}9|{ns2-;N-Uw!gMU25{E{$&Ah6^S>XTtP>u3GQt7N|5e>2VBCm&a-`syn`BO=mp9^^bxRwN#N&7-e_q6O^8<>Re=7s2G zMoNd|J9>G6_h9(jw{N{Bd})@KtO^lK9&X|t_wYQwjV@G(!MCS!(MynZQ9^EIsW0y! z)56zFn6$p97;0)lJH>PVZEv5iqvLg4Bng%C;|K7QkYXK_uBS4y1kbGB9Km%fMwlwJ zO*QRS{m@!{0^)Q`C1xppG8}FX6ao`A(3vmbStye*R#K4t$%PzsxM5EfMJNjOBH=d4FdVF1ND2-lc;2u zboq2X3mJA$>gQ;75g8C!NI3ni(EhO75UU9aB*DaWZ*Bf-b{an#=F8w!PIA>M6a{%H zzw`6EEA+HZ;29xVFmpG(pOXsyv!yA>LpDskz@4nb1z929_D}y^60L19K1uus zPQo8JiwdQqb&sI_0c8g{B_W?ns&th!rm_%Uc-SZIg@MUjyDvF;?YVXC;qz^5#y%-k z7$}qJx_?*wtVyKsi-zL8ykkQDUtM`BY+*}8Ym%a|lGnv5aBf0$3OZs)XKc-!+B3z4 zxL9~6bTGD=qJ9L4b{L_GsEOHpUzNTp!0Y-Tt0zr5&%(=W1})|$eTgarV{gy`W3iq5 zTiGr4l@~kYQAqX^rs;;|Th`bA4Ft-~CUosS!wue~jvdoqkz@&d(Gw+fn;*vyc%(X{hbdl1Kr@)YT!(zBFK9V;`RehOs-;=Qc}wI6IfwlspJ$n$IN0w&e2sxuiL- zHL-`Amj0m9!@#2WVL8aL{Wi(MM{oWTKhHzBYmUC}z4CGJb6OF~=Hu|?pddr+(NT1= z;vra7gpJzoH6D-dt0cMc@@{Xj;_$cPH7?`0`cBHr6X=m(g?&Ef;yhD z6F3+79W#A_`HS6)|FUz_9vY)I-sI$lE_MVqV~p&ee&OSwep}Xyp`}R~lPjFTf%*;R zxs1&-4$@%2S<*(Hw_#E|3>}s%hM@vyu-Dc}=$R%a;7)vLTemo&kIk@K&zL}z706!`v$LZ54r zzKkw?PZVg#Q=X5_DPZtYUX&O)s#Cpp0BS_#K$$Gj(@8B0ynZXN9$FW^hk-qrq3S>w6FGwQ8W7K=R z5D{rbrBq{q{k!v9FfIU0EbMQ!`JSOOnDHM8vqqMsr4L|_aQ~7f)w3|xrS$!s^>H(+ zzrWXLzgdb@1(hL*y_8Nj27yp^D&y&)RDv^x>ZmOd`FdZox<2<8Qccw=Ax0L0Q3 z9_Ea6to45qq%=T&EeO&z_rF#nj<|hDvm|X`uc$CkO6LlSgbhWU4U&qup`q}t2V1C4 zdA>PYLHMPxUmVexijQNS7p>e<51o2iDztVcG(YgALzz_yZT+Kt0QffcNF^*T_ zV8i6?A0#c$PJ@W`1SrBpZQb#%;vPKUAlT@Ym2@giPzC+YSdc%9Pw_D1mWtf&O&x~A zD_t6_5hif63jZUo*U^O3)fIdSS0M^w_8AouDO!A5H~`b5lMqIS1gW4VX*b ze_&)px{Y(XsbbQXRLNXZhJH0-bR$WiYbhj`zNM${U$5va(jvn~KV^YlP9=wd#m*W{ zrQ}xI%)I~aLD1@oviY%n{b^utGmP;c5QgC|@w-txV6^d_O%>NefGCza6bH`r#Nc-_~g&#N7>zNu-QOmdBT83`Ahd`l65{6dQ zZKi%%U*gHHnZgumRJ@>|oX#=hGfDQApATC-Loh(bMLq`Ca;LY{>Ka4PFml0Rke6}N z?^ybk<0!>o^+yI7m(JG05=xq_0d_Ei^ez69`cIxe@jwnW(n(7SQ~$dhCmzADoD$q1 z_vhlW{p#U$8))PKlv@|IANOBtX?0MjrZ-v2?)L{vrru8LRv3X_|B7hMqZ0 zGEc^>;Nq08JNx~cR5U4Q4p}VHD%gMGBHwmJDM-~@{M8-f$=fs%PFj(Gg(iw$^(xJ6 z_LV9rxZ2NOaWB2ck!I@M7>R?)m`?akk_|V@8%`RNn!>EN4c%Ivz=z%q_J)PT-X7A_ zN2~IcA|Oy*ri;I%*7Uz6H_=kJu<@O5xv=t>7RuG{h5` zIQv#4jp3e@TF7W?oAyMgun;q(+A4k^gbibT8RCNk`kHM_9EB#`iizRY$ z>9QSxP3uM%_+(Glc?>2ID(^$tYtU|acT`KIFZ5my9m2tes7Ck%EP^iXhj~ohGXAZ_ zBI)T9G<6uZvRj+|TVs0t7SeW%zN^qU&FqTS7(B2aO+9qg5!~WjuIJ?c$R^-n&iC-@ zH$nX)R$ipa!0E^PQ-4^X1yv=LQ?WYJRZt~mIb~yt%`G){^aDcsqyr`iv}ePe+GWAj z>L;dzx3&h}Px=oY9zH`ERZ$Nn0DW@_9SKtN`t5S9Zj5Zc5E1#v7sIWcQa;|}GUo;} zUF~8C0b|?U(ACyaqd6Jp@|$>?pI^W{90y+OmBD>{b6muPZJG3TcmAdG2T?of)g#&#NxQ9#ZQReEP8dmz*~l7tIr69lc}q{n(pXL1E2pl8QWC z82fztk)Oqrj(1Fw(y?gPrK6#f&_)h*EXS7v)sJiX!@4BR)su>K zKx#4S2U2<`DJ31un{)!^FrCjVWtDzJ!1EUv0h8WQ%dj{8{ek#zdO)BV3EZ+%MjRKy4PwdrQ{Pp#tKq{%x6TT zccSl;0HaIC;#G9!X;1R;_iboFFi(Zx1M6n2iEf(omK@TTB)>WN#iXZ>-KCozb(FD6 zdTC~1G+jEnRcyf8R@TyB71{8t?`FDKS3|cO6z7j@Ap-4194O*XIeQ!U?{xpR?r9K-h73|{zdO<~?1-1kA|Ky@6%L^k~R z18!M$lYYo&xg5r+Rux&mUB_ zV!S&k{q)4(weVKy3vBjWB+*;VX;B@obUyZw*>=c`h;+h zBzrgIHjh5rUgvJpcU@-1n1_3>32^~~M`zUUBA<@AeHmx$``1nGrRJ^omz$rCQi&J> z6(Y@fn{c_l`nVQVK7*aYKOF_P>@jWfnA5UwiJ!gl)@LUCPw=UnhiH{emyWw%hdZvP#)6xSF<>; zW+=U{e@Ctrh_JJ-v5kZ#8F=qXxHZ+BTsF)e+cMLwslGXXvwcz9FLCz|{b^LiEvf~g z7WIA~jd%(F`}Ij?{&|t`>jljh;UZ;lEW}=~%6xQ+1?{um@nRp61c~6g?R?t<0guOK z?=3zp!zvMWwC^pHs&G36`-g{T==+u#rR;at9H@eMO-o*X(R}Dog<(N!Yu`JxZW-%# zkJ#e>ly>#;Ozv&m38jpsjwez$ryS(OD3ufDP)VxgM08RkFRLg-DQs)bnq*p@N-Eir z^v1FJcz>NXM#91=l(&)1@iy|ZvA5^C`#jHo=ks|!&*#}c_deV1d%yd>uj_aH?(4d~ z->)s4=SDvY2HEVOngzfu@2a?9rDi=8VnBPvg^E2i$78}Gy-e>;+o8C1obP_51sc#a ztXBTb#=Ol5o^rI*elIUKeE$5oTY^0tmVnN8aqOzPyahpUbDuqXW-yosM{tM_&>Va{ zSfBDuhOriM?3{-%!*&xW3o{gLn{}gkX@mKE3Sh;ls>@!-kEcTVd@Z#50q0TKaQZQj zvL5I<^5`rKY2%&6xaieyep{BbxbLyUnEtgu1E`i|^9ukTEa{Ck0q9&5u)c%dJiw9O zy>hyD(GV`xC7O@c7)ZhEsxluuNI|L&SFc`myR;hy%)MLKr|u;HJ!;_R@o5$Voc?B7 z8U>QW`6sH^DijL0m<#YT(Kc?AdU9xI!EwKmaKjgQd0cj(>k;@G;fzYRK7O4>Tk5Ek z4hi^vKE4-qO`Pc;KYq-JZij#OHav=F>{JWyDbp*qxA#ySYio!ZGp*l|vg(^QkF&Cn zTmU6z7J?Y8_Se35fc0lML_Zl50fnn=NYl4PMMYGy=!wgjGiRpWm@^^Q-8`-M<5=m* z)=Y;2vgfQ)sgQXcIkJ@9Z=>ivWI=^#X8*&V-cKt)dHL#g>g}_YP&QI4<1Z(5ju9sd zdt%G^)6eD?CM(6f@$SOoY@5`m8#hOCYe3eX2ddO`(7x!JDKy7rZIzSAt`jvXrHm&N zv&D-tvI{x#JqP?s=pXBe9iB_nM)JZ+n*fkox$`@A=u^~7{pL8q*TP%b{t9P$Wd zTB7pSH6le$l|m9UBWx*?e|bC9hcAo#4$kIXXJ-=7$n}t96B$^ta;3i|7t>tMKgv{3 z)(ty~HS)^NcZe2J(ZoeaKIN(hS6cFzi>9WnUJJyM-+0a2h+;Q3FOaWoaxGyHDqVg4*YsMy8hm80XW|P zVj1S+pGwh)tUB0Q)@7mLFkg2~@M3dPeEo)9Q4|?Hm@r zLAK_=_lnN%xUJ&KaIRQl^f~||uP82l4+`+U%JImbbNLUpowX~d7=1AnrnUzf?b5Qc z&h5Xy^^LTXtnkfYv2Zeb=7Gi@Yz;Pee6@Kyi9)zHn6&B0TAiH zS&1YGFOf)$U?yr}uD3oUlLN8j+BN=>lqdv7D}fRgy|*&f2+(cz;IA*{;`rMvBn&Y_ zBE1jp_KK_`HAq^YA|qb0D+v{(xk@wM^rQt*Ib@8v^!;LG>^3c zN7J|hat;9j0WP14vr?bY4QsHi^0#ccr)xt|7FvS)$7Z|zzZUBRWyOtJ=Dc{(wBzD< zM$~whE%IJE5kbzAcMB5tGgTl^(*ixVu{xW35@uR>K!lLm@f2s21QMqOY-JqC#82)O z4x=6HzMf`g9F)K52%Y3~^~|(#_pNKE;Li9_cG+Su0diUeMlPZ@d1TB0S=GE4^ zNEN{EVJG10x(839)f&igv;QAABFuyB5eG*_hI^2J!)<^-~Sm2(zw z0&hHF7+q6qti{#Z>)~NI>KO@0v85z7e&1y^mtTKf3l&0`!ZROR1+|(Z;gXU)?|dSD z!rt4*C#@#FUf*{BtD3>uR8ock&{DK_bm(bmL{1cU4yJDJySC8t`OU3qL6XV7el!xgzm5XMb=>YgazQ?o zgsnr^0}-i{KmQ!)z+vli7|z$tJktk0hOz3CSDPO?eE2s=vkbm!FxDnVAYtugz&A$< z{F7mo)rlvshv&h1z#N!WmGGTqD9E;^F7&o+@2B_l_$NSD$jIa*PsAkOFi}YxE)6D| zpL9k9Yt)zNHumY#lHCR4t7wMvWe3tm`qeQXSa_2eWrGPhJeWXeP>>pKtltAzDCu0H zrZyeqmA)5lQO)61A^y=V_M9>*s89s4y^Fkv~z9gKd$4PG|<^) zwOp;Ssp-6eh{NHebI%Vy#gOFE3`bAsa!Gvs`>cHx#4}*!-~y@2HOs?K2IBi=#t6k9 z3WcgmXvNSAODgCNr2%MapvJ~g$|WLiLIPU4b)bAjOH5qyd~Airl4mSd5?_=O&wBcF z86tHHk~7l)SsZ+nV$BhgB$ZRLhYufGY~E~UX-P|_L2%H!dH?=(rBeC07#ln3Up4gom9N1DHIRlmXj}m%mNUP6Sqc*%)ZDitKA2Nf^euAk ze6lhccn6(0VpwhofT7TqE$il!Xh3Wb2s}ZJ&CPW{r1P%5JrOGxplz8u0f7SrrQB+p z=7nV<7X#tC&#;rU-iAamXD0lzSc$aBFi5i-V9{g0+?SV$LzcrLQ+<7XFw*o^KDd2$ zVd1Si%W^d5k==)DDe7H?1hf)B!p;IQ{0X_%?5;mT@U|lv_P2SgGpC6`xdk=dwmcOc wetYrY>C={0=siZ`|6Vu$A2Zm0newD6eH+Eo;fK41)Zpc@`{1qu*MP)-0rO6^1ONa4 literal 0 HcmV?d00001 diff --git a/lib/Control/Monad/Supply.hs b/lib/Control/Monad/Supply.hs new file mode 100644 index 0000000..40b31ba --- /dev/null +++ b/lib/Control/Monad/Supply.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Supply +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- a monad that supplies the next value +-- +----------------------------------------------------------------------------- + +module Control.Monad.Supply ( + Supply(..) + , MonadSupply(..) + , supplyN + , SupplyT(..), evalSupplyT, execSupplyT + , mapSupplyT + ) where + +----------------------------------------------------------------------------- + +import Control.Monad.Writer +import Control.Monad.Reader +import Control.Monad.State +import Control.Monad.Trans() + +----------------------------------------------------------------------------- + +class Supply a b where + nextSupply :: a -> (b,a) + +{- +instance Supply [a] a where nextSupply (x:xs) = (x,xs) +instance Supply ([a],[b]) a where nextSupply ((x:xs),ys) = (x,(xs,ys)) +instance Supply ([a],[b]) b where nextSupply (xs,(y:ys)) = (y,(xs,ys)) +-} +----------------------------------------------------------------------------- + +class Monad m => MonadSupply s m | m -> s where + supply :: Supply s a => m a + +supplyN :: (MonadSupply s m, Supply s a) => Int -> m [a] +supplyN n = replicateM n supply + +----------------------------------------------------------------------------- + +newtype SupplyT s m a = SupplyT { runSupplyT :: s -> m (a, s) } + +evalSupplyT :: Monad m => SupplyT s m a -> s -> m a +evalSupplyT st s = do + ~(a,_) <- runSupplyT st s + return a + +execSupplyT :: Monad m => SupplyT s m a -> s -> m s +execSupplyT st s = do + ~(_,s') <- runSupplyT st s + return s' + +mapSupplyT :: (m (a,s) -> n (b,s)) -> SupplyT s m a -> SupplyT s n b +mapSupplyT f st = SupplyT $ f . runSupplyT st + +----------------------------------------------------------------------------- + +instance Monad m => Functor (SupplyT s m) where + fmap f m = SupplyT $ \s -> do + ~(x, s') <- runSupplyT m s + return (f x,s') + +instance Monad m => Monad (SupplyT s m) where + return a = SupplyT $ \s -> return (a, s) + m >>= f = SupplyT $ \s -> do + ~(a,s') <- runSupplyT m s + runSupplyT (f a) s' + fail str = SupplyT $ \_ -> fail str + +instance MonadTrans (SupplyT s) where + lift m = SupplyT $ \s -> do + a <- m + return (a,s) + +instance Monad m => MonadSupply s (SupplyT s m) where + supply = SupplyT $ \s -> return $ nextSupply s + +----------------------------------------------------------------------------- +{- +instance (Monad (t m), MonadSupply s m, MonadTrans t) => MonadSupply s (t m) where + supply = lift supply +-} +----------------------------------------------------------------------------- + +instance MonadState s m => MonadState s (SupplyT s' m) where + get = lift get + put = lift . put + +instance MonadReader r m => MonadReader r (SupplyT s m) where + ask = lift ask + local f m = SupplyT $ \s -> local f (runSupplyT m s) + +instance MonadWriter w m => MonadWriter w (SupplyT s m) where + tell = lift . tell + listen m = SupplyT $ \s -> do + ~((a,s'),w) <- listen (runSupplyT m s) + return ((a,w),s') + pass m = SupplyT $ \s -> pass $ do + ~((a,f),s') <- runSupplyT m s + return ((a,s'),f) + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot.hs b/lib/Graphics/Rendering/Plot.hs new file mode 100644 index 0000000..54b2407 --- /dev/null +++ b/lib/Graphics/Rendering/Plot.hs @@ -0,0 +1,73 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Graphical plots +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot ( + -- * Example + -- $example + -- * re-exported for convenience + module Graphics.Rendering.Plot.Figure + , module Graphics.Rendering.Plot.Render + ) where + + +----------------------------------------------------------------------------- + +import Graphics.Rendering.Plot.Figure +import Graphics.Rendering.Plot.Render + +----------------------------------------------------------------------------- +{- $example + +Create some data: + +> ln = 25 +> ts = linspace ln (0,1) +> rs = randomVector 0 Gaussian ln +> +> ss = sin (15*2*pi*ts) +> ds = 0.25*rs + ss +> es = constant (0.25*(stddev rs)) ln +> +> fs :: Double -> Double +> fs = sin . (15*2*pi*) + +Perform actions in 'Figure a' to create a figure + +> test_graph = do +> withTextDefaults $ setFontFamily "OpenSymbol" +> withTitle $ setText "Testing plot package:" +> withSubTitle $ do +> setText "with 1 second of a 15Hz sine wave" +> setFontSize 10 +> setPlots 1 1 +> withPlot (1,1) $ do +> setDataset (ts,[point (ds,es) (Cross,red),line fs blue]) +> addAxis XAxis (Side Lower) $ withAxisLabel $ setText "time (s)" +> addAxis YAxis (Side Lower) $ withAxisLabel $ setText "amplitude" +> addAxis XAxis (Value 0) $ return () +> setRangeFromData XAxis Lower +> setRange YAxis Lower (-1.25) 1.25 + +Render the graph to a Cairo 'Render ()' action that takes the width +and height of the drawing area + +> test_render :: (Double,Double) -> Render () +> test_render = render test_graph + +The 'Render a' action can be used in GTK or with Cairo to write to file in PS, PDF, SVG, or PNG + +-} + + +----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Defaults.hs b/lib/Graphics/Rendering/Plot/Defaults.hs new file mode 100644 index 0000000..b8e8087 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Defaults.hs @@ -0,0 +1,177 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Defaults +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Default values +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Defaults where + +----------------------------------------------------------------------------- + +import Data.Colour.Names + +import qualified Data.Array.IArray as A + +import qualified Graphics.Rendering.Pango as P + +import Graphics.Rendering.Plot.Types + +----------------------------------------------------------------------------- + +defaultColourList :: [Color] +defaultColourList = [blue,red,green,yellow,violet,sienna,royalblue + ,pink,tomato,lavender,cyan,crimson,darkgreen + ,cadetblue,darkred,yellowgreen] + ++ defaultColourList + +----------------------------------------------------------------------------- + +defaultGlyphList :: [Glyph] +defaultGlyphList = [Box, Diamond, Asterisk, Triangle, Circle] + ++ defaultGlyphList + +----------------------------------------------------------------------------- + +defaultPointOptions :: PointOptions +defaultPointOptions = PointOptions 1 black + +defaultGlyph :: Glyph +defaultGlyph = Circle + +defaultPointType :: PointType +defaultPointType = FullPoint defaultPointOptions defaultGlyph + +----------------------------------------------------------------------------- + +defaultDashStyle :: DashStyle +defaultDashStyle = [] + +defaultLineWidth :: LineWidth +defaultLineWidth = 1 + +defaultLineOptions :: LineOptions +defaultLineOptions = LineOptions defaultDashStyle defaultLineWidth + +defaultLineType :: LineType +defaultLineType = ColourLine black + +----------------------------------------------------------------------------- + +defaultFontFamily :: FontFamily +defaultFontFamily = "Sans" + +defaultFontStyle :: P.FontStyle +defaultFontStyle = P.StyleNormal + +defaultFontVariant :: P.Variant +defaultFontVariant = P.VariantNormal + +defaultFontWeight :: P.Weight +defaultFontWeight = P.WeightNormal + +defaultFontStretch :: P.Stretch +defaultFontStretch = P.StretchNormal + +defaultFontOptions :: FontOptions +defaultFontOptions = FontOptions defaultFontFamily defaultFontStyle defaultFontVariant + defaultFontWeight defaultFontStretch + +defaultFontSize :: Double +defaultFontSize = 16 + +defaultFontColour :: Color +defaultFontColour = black + +defaultTextOptions :: TextOptions +defaultTextOptions = TextOptions defaultFontOptions defaultFontSize defaultFontColour + +----------------------------------------------------------------------------- + +defaultBounding :: BoundingBox +defaultBounding = BoundingBox 0 0 1 1 + +----------------------------------------------------------------------------- + +defaultRanges :: Double -> Double -> Double -> Double -> Ranges +defaultRanges xmin xmax ymin ymax = Ranges (Left (Range xmin xmax)) (Left (Range ymin ymax)) + +----------------------------------------------------------------------------- + +zeroPadding, defaultPadding, defaultFigurePadding, defaultPlotPadding :: Padding +zeroPadding = Padding 0 0 0 0 +defaultPadding = Padding 10 10 10 10 +defaultFigurePadding = Padding 10 10 10 10 +defaultPlotPadding = Padding 10 10 10 10 + +----------------------------------------------------------------------------- + +solid, empty :: Solid +solid = True +empty = False + +----------------------------------------------------------------------------- + +defaultOptions :: Options +defaultOptions = Options defaultLineOptions defaultPointOptions defaultTextOptions + +----------------------------------------------------------------------------- + +minorTickLength, majorTickLength, tickLabelScale :: Double +minorTickLength = 5.0 +majorTickLength = 7.0 +tickLabelScale = 0.75 + +defaultMinorTicks :: Ticks +defaultMinorTicks = Ticks False (Left 41) + +defaultMajorTicks :: Ticks +defaultMajorTicks = Ticks False (Left 5) + +defaultTickFormat :: TickFormat +defaultTickFormat = "%1f" + +defaultAxis :: AxisType -> AxisPosn -> AxisData +defaultAxis at axp = Axis at axp defaultLineType defaultMinorTicks defaultMajorTicks + defaultTickFormat NoText + +defaultXAxis, defaultYAxis :: AxisData +defaultXAxis = defaultAxis XAxis (Side Lower) +defaultYAxis = defaultAxis YAxis (Side Lower) + +----------------------------------------------------------------------------- + +defaultSupply :: SupplyData +defaultSupply = SupplyData defaultColourList defaultGlyphList + +----------------------------------------------------------------------------- + +emptyPlot :: PlotData +emptyPlot = Plot False defaultPlotPadding NoText (Ranges (Left (Range (-1) 1)) (Left (Range (-1) 1))) + [] Linear undefined Nothing [] + +----------------------------------------------------------------------------- + +emptyPlots :: Plots +emptyPlots = (A.listArray ((0,0),(0,0)) []) + +----------------------------------------------------------------------------- + +emptyFigure :: FigureData +emptyFigure = Figure defaultFigurePadding NoText NoText emptyPlots + +----------------------------------------------------------------------------- + +defaultFigureState :: FigureState +defaultFigureState = FigureState undefined + defaultSupply + undefined + +----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Figure.hs b/lib/Graphics/Rendering/Plot/Figure.hs new file mode 100644 index 0000000..7b8226e --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure.hs @@ -0,0 +1,231 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Creation and manipulation of 'Figure's +-- +-- The same problem of leaked instances as at occurs here. +-- +-- +-- /with/, /set/, /clear/, /new/, and /add/ are the operations that can +-- be performed on various elements of a figure. +-- +-- /glib/\//data-accessor/ abstractions (verbs/modifiers) are planned for future implementations + +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Figure ( + Figure() + -- * Default options + , withTextDefaults + , withLineDefaults + , withPointDefaults + -- * Figures + -- ** Formatting + , setFigurePadding + , withTitle + , withSubTitle + , setPlots + , withPlot, withPlots + -- * Sub-plots + , Plot() + , PlotType(..) + -- ** Plot elements + , Border + , setBorder + , setPlotPadding + , withHeading + -- ** Series data + , Function(), Series(), ErrorSeries() + , Abscissa(), Ordinate(), Dataset() + , FormattedSeries(), SeriesType(..) + , line, point, linepoint + , setDataset + -- ** Plot type + , setSeriesType + , setAllSeriesTypes + -- ** Formatting + , PlotFormats() + , withSeriesFormat + , withAllSeriesFormats + -- * Range + , setRange + , setRangeFromData + -- * Axes + , Axis + , AxisType(..),AxisSide(..),AxisPosn(..) + , addAxis + -- ** Formatting + , Tick(..), TickValues, GridLines + , setTicks + , setTickLabelFormat + , withAxisLabel + , withAxisLine + -- * Lines + , Line(), LineFormat() + , DashStyle,Dash(..),LineWidth + , clearLineFormat + , setDashStyle + , setLineWidth + , setLineColour + -- * Points + , Point(), PointFormat() + , Glyph(..) + , PointSize + , setGlyph + , setPointSize + , setPointColour + -- * Text labels + , Text() + , FontFamily,FontSize,Color + -- | A text element must exist for formatting to work + , setText + , setFontFamily + , setFontStyle + , setFontVariant + , setFontWeight + , setFontStretch + , setFontSize + , setFontColour + ) where + +----------------------------------------------------------------------------- + +--import Data.Packed.Vector +--import Numeric.LinearAlgebra.Linear + +--import Data.Word +--import Data.Colour.SRGB +import Data.Colour.Names + +import qualified Data.Array.IArray as A + +--import qualified Graphics.Rendering.Cairo as C +--import qualified Graphics.Rendering.Pango as P + +--import Control.Monad.State +--import Control.Monad.Reader + +import Prelude hiding(min,max) + +import Graphics.Rendering.Plot.Figure.Text +import Graphics.Rendering.Plot.Figure.Line +import Graphics.Rendering.Plot.Figure.Point +import Graphics.Rendering.Plot.Figure.Plot + +import Graphics.Rendering.Plot.Types +import Graphics.Rendering.Plot.Defaults + +----------------------------------------------------------------------------- + +-- | perform some actions on the text defaults, must be run before other text element modifications +withTextDefaults :: Text () -> Figure () +withTextDefaults m = do + o <- getDefaults + let to' = _textoptions o + let (FontText to _) = execText m to' (FontText to' "") + modifyDefaults $ \s -> s { _textoptions = to } + +-- | perform some actions on the line defaults, must be run before other line element modifications +withLineDefaults :: Line () -> Figure () +withLineDefaults m = do + o <- getDefaults + let lo' = _lineoptions o + let (TypeLine lo _) = execLine m lo' (TypeLine lo' black) + modifyDefaults $ \s -> s { _lineoptions = lo } + +-- | perform some actions on the point defaults, must be run before other point modifications +withPointDefaults :: Point () -> Figure () +withPointDefaults m = do + o <- getDefaults + let po' = _pointoptions o + let (FullPoint po _) = execPoint m po' (FullPoint po' defaultGlyph) + modifyDefaults $ \s -> s { _pointoptions = po } + +----------------------------------------------------------------------------- + +-- | create a new blank 'Figure' +newFigure :: Figure () +newFigure = putFigure $ Figure defaultFigurePadding NoText NoText + (A.listArray ((1,1),(1,1)) [Nothing]) +{- +newLineFigure :: DataSeries -- ^ the y series + -> FigureData +newLineFigure d@(DS_1toN _ _) = let ((xmin,xmax),(ymin,ymax)) = calculateRanges d + plot = Plot False defaultPlotPadding NoText + (defaultRanges xmin xmax ymin ymax) + [defaultXAxis,defaultYAxis] + Nothing Line d [] + in Figure defaultFigurePadding NoText NoText + (A.listArray ((1,1),(1,1)) [Just plot]) +-} +{- +-- | create a new 'Figure' +newFigure :: PlotType -> DataSeries -> Figure () +newFigure Line d@(DS_1toN _ _) = putFigure $ newLineFigure d +--newFigure _ _ = error "Figure type not implemented" +-} + + +----------------------------------------------------------------------------- + +-- | set the padding of the figure +setFigurePadding :: Double -> Double -> Double -> Double -> Figure () +setFigurePadding l r b t = modifyFigure $ \s -> s { _fig_pads = Padding l r b t } + +-- | operate on the title +withTitle :: Text () -> Figure () +withTitle m = do + o <- getDefaults + modifyFigure $ \s -> s { _title = execText m (_textoptions o) (_title s) } + +-- | operate on the sub-title +withSubTitle :: Text () -> Figure () +withSubTitle m = do + o <- getDefaults + modifyFigure $ \s -> s { _subtitle = execText m (_textoptions o) (_title s) } + +-- | set the shape of the plots, losing all current plots +setPlots :: Int -- ^ rows + -> Int -- ^ columns + -> Figure () +setPlots r c = modifyFigure $ \s -> s { _plots = A.listArray ((1,1),(r,c)) (replicate (r*c) Nothing) } + +-- | perform some actions on the specified subplot +withPlot :: (Int,Int) -> Plot () -> Figure () +withPlot i m = do + o <- getDefaults + s <- getSupplies + modifyFigure $ \p -> p { _plots = let plots = _plots p + plot' = plots A.! i + plot = case plot' of + Nothing -> emptyPlot + Just p' -> p' + -- we revert supplies to the original here + -- since we might want the same colour + -- order for all plots + -- HOWEVER: need a better execPlot group + in plots A.// [(i,Just $ execPlot m s o plot)] } + +-- | perform some actions all subplots +withPlots :: Plot () -> Figure () +withPlots m = do + o <- getDefaults + s <- getSupplies + modifyFigure $ \p -> p { _plots = let plots = _plots p + plot p' = case p' of + Nothing -> emptyPlot + Just p'' -> p'' + in plots A.// map (\(i,e) -> (i,Just $ execPlot m s o (plot e))) (A.assocs plots) } + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Line.hs b/lib/Graphics/Rendering/Plot/Figure/Line.hs new file mode 100644 index 0000000..f36f250 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Line.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure.Line +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- 'Text' operations +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Figure.Line ( + Line, LineFormat(..) + , DashStyle,Dash(..),LineWidth + , clearLineFormat + , setDashStyle + , setLineWidth + , setLineColour + , getLineColour + ) where + +----------------------------------------------------------------------------- + +--import Data.Word +import Data.Colour +--import Data.Colour.Names + +--import qualified Graphics.Rendering.Cairo as C +--import qualified Graphics.Rendering.Pango as P + +import Control.Monad.State +import Control.Monad.Reader +import Control.Monad.Supply + +import Graphics.Rendering.Plot.Types + +----------------------------------------------------------------------------- + +changeDashStyle :: DashStyle -> LineOptions -> LineOptions +changeDashStyle ds (LineOptions _ lw) = LineOptions ds lw + +changeLineWidth :: LineWidth -> LineOptions -> LineOptions +changeLineWidth lw (LineOptions ds _) = LineOptions ds lw + +{-changeLineOptions :: (LineOptions -> LineOptions) -> LineType -> LineType +changeLineOptions f (LineType ls c) = LineType (f ls) c + +changeDashStyle :: DashStyle -> LineType -> LineType +changeDashStyle ds = changeLineOptions (changeDashStyleStyle ds) + +changeLineWidth :: LineWidth -> LineType -> LineType +changeLineWidth lw = changeLineOptions (changeLineWidthStyle lw) +-} +changeLineColour :: Color -> LineType -> LineType +changeLineColour c NoLine = ColourLine c +changeLineColour c (ColourLine _) = ColourLine c +changeLineColour c (TypeLine lo _) = TypeLine lo c + +clearLineFormatting :: LineType -> LineType +clearLineFormatting NoLine = NoLine +clearLineFormatting l@(ColourLine _) = l +clearLineFormatting (TypeLine _ c) = ColourLine c + +clearLine :: LineType -> LineType +clearLine _ = NoLine + +getLineColour :: LineType -> Maybe Color +getLineColour NoLine = Nothing +getLineColour (ColourLine c) = Just c +getLineColour (TypeLine _ c) = Just c + +----------------------------------------------------------------------------- + +-- | clear the formatting of a line +clearLineFormat :: Line () +clearLineFormat = do + lt <- get + case lt of + NoLine -> put NoLine + c@(ColourLine _) -> put c + (TypeLine _ c) -> put $ ColourLine c + +changeLineOptions :: (LineOptions -> LineOptions) -> LineType -> Line () +changeLineOptions o NoLine = do + lo <- ask + put $ TypeLine (o lo) black +changeLineOptions o (ColourLine c) = do + lo <- ask + put $ TypeLine (o lo) c +changeLineOptions o (TypeLine lo c) = put $ TypeLine (o lo) c + +-- | change the dash style of a line +setDashStyle :: DashStyle -> Line () +setDashStyle ds = get >>= changeLineOptions (changeDashStyle ds) + +-- | change the line width of a line +setLineWidth :: LineWidth -> Line () +setLineWidth lw = get >>= changeLineOptions (changeLineWidth lw) + +-- | change the line colour of a line +setLineColour :: Color -> Line () +setLineColour c = modify (changeLineColour c) + +----------------------------------------------------------------------------- + +class LineFormat a where + toLine :: (MonadReader Options m, MonadSupply SupplyData m) => a -> m LineType + +instance Real a => LineFormat (Colour a) where toLine c = return $ ColourLine $ colourConvert c +instance LineFormat DashStyle where toLine ds = do + lo <- asks _lineoptions + c <- supply + return $ TypeLine (changeDashStyle ds lo) c +instance LineFormat LineWidth where toLine lw = do + lo <- asks _lineoptions + c <- supply + return $ TypeLine (changeLineWidth lw lo) c +instance Real a => LineFormat (DashStyle,Colour a) where toLine (ds,c) = do + lo <- asks _lineoptions + return $ TypeLine (changeDashStyle ds lo) $ colourConvert c +instance Real a => LineFormat (LineWidth,Colour a) where toLine (lw,c) = do + lo <- asks _lineoptions + return $ TypeLine (changeLineWidth lw lo) $ colourConvert c +instance LineFormat (DashStyle,LineWidth) where toLine (ds,lw) = do + c <- supply + return $ TypeLine (LineOptions ds lw) c +instance Real a => LineFormat (DashStyle,LineWidth,Colour a) where toLine (ds,lw,c) = return $ TypeLine (LineOptions ds lw) $ colourConvert c + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot.hs b/lib/Graphics/Rendering/Plot/Figure/Plot.hs new file mode 100644 index 0000000..70861b4 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Plot.hs @@ -0,0 +1,215 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure.Plot +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Creation and manipulation of 'Plot's +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Figure.Plot ( + Plot + , PlotType(..) + -- * Plot elements + , Border + , setBorder + , setPlotPadding + , withHeading + -- * Series data + , D.Abscissa(), D.Ordinate(), D.Dataset() + , D.FormattedSeries() + , D.line, D.point, D.linepoint + , setDataset + -- ** Plot type + , setSeriesType + , setAllSeriesTypes + -- ** Formatting + , D.PlotFormats(..) + , withSeriesFormat + , withAllSeriesFormats + -- * Range + , setRange + , setRangeFromData + -- * Axes + , AX.Axis + , AxisType(..),AxisSide(..),AxisPosn(..) + , clearAxes + , addAxis +-- , withAxis + -- ** Formatting + , Tick(..), TickValues, GridLines + , AX.setTicks + , AX.setTickLabelFormat + , AX.withAxisLabel + , AX.withAxisLine + ) where + +----------------------------------------------------------------------------- + +import Data.Packed.Vector +import Numeric.LinearAlgebra.Linear + +import qualified Data.Array.IArray as A + +import Control.Monad.State +import Control.Monad.Reader +--import Control.Monad.Supply + +import Prelude hiding(min,max) + +import Graphics.Rendering.Plot.Types +import Graphics.Rendering.Plot.Defaults +import qualified Graphics.Rendering.Plot.Figure.Plot.Data as D +import qualified Graphics.Rendering.Plot.Figure.Plot.Axis as AX + +----------------------------------------------------------------------------- + +-- | whether to draw a boundary around the plot area +setBorder :: Border -> Plot () +setBorder b = modify $ \s -> s { _border = b } + +-- | set the padding of the subplot +setPlotPadding :: Double -> Double -> Double -> Double -> Plot () +setPlotPadding l r b t = modify $ \s -> s { _plot_pads = Padding l r b t } + +-- | set the heading of the subplot +withHeading :: Text () -> Plot () +withHeading m = do + o <- asks _textoptions + modify $ \s -> s { _heading = execText m o (_heading s) } + +----------------------------------------------------------------------------- + +-- | set the axis range +setRange :: AxisType -> AxisSide -> Double -> Double -> Plot () +setRange XAxis sd min max = modify $ \s -> s { _ranges = setXRanges sd min max (_ranges s) } + where setXRanges Lower min' max' (Ranges (Left _) yr) = Ranges (Left (Range min' max')) yr + setXRanges Lower min' max' (Ranges (Right (_,xr)) yr) = Ranges (Right ((Range min' max',xr))) yr + setXRanges Upper min' max' (Ranges (Left xr) yr) = Ranges (Right (xr,Range min' max')) yr + setXRanges Upper min' max' (Ranges (Right (_,xr)) yr) = Ranges (Right (Range min' max',xr)) yr +setRange YAxis sd min max = modify $ \s -> s { _ranges = setYRanges sd min max (_ranges s) } + where setYRanges Lower min' max' (Ranges xr (Left _)) = Ranges xr (Left (Range min' max')) + setYRanges Lower min' max' (Ranges xr (Right (_,yr))) = Ranges xr (Right ((Range min' max',yr))) + setYRanges Upper min' max' (Ranges xr (Left yr)) = Ranges xr (Right (yr,Range min' max')) + setYRanges Upper min' max' (Ranges xr (Right (_,yr))) = Ranges xr (Right ((Range min' max',yr))) + +-- | set the axis ranges to values based on dataset +setRangeFromData :: AxisType -> AxisSide -> Plot () +setRangeFromData ax sd = do + ds <- gets _data + let ((xmin,xmax),(ymin,ymax)) = calculateRanges ds + case ax of + XAxis -> setRange ax sd xmin xmax + YAxis -> setRange ax sd ymin ymax + +----------------------------------------------------------------------------- + +-- | clear the axes of a subplot +clearAxes :: Plot () +clearAxes = modify $ \s -> s { _axes = [] } + +-- | add an axis to the subplot +addAxis :: AxisType -> AxisPosn -> AX.Axis () -> Plot () +addAxis at axp m = do + ax' <- gets _axes + o <- ask + let ax = execAxis m o (defaultAxis at axp) + modify $ \s -> s { _axes = ax : ax' } + +-- | operate on the given axis +withAxis :: AxisType -> AxisPosn -> AX.Axis () -> Plot () +withAxis at axp m = do + axes' <- gets _axes + o <- ask + modify $ \s -> s { _axes = map (\a@(Axis at' ap' _ _ _ _ _) + -> if at == at' && axp == ap' then execAxis m o a else a) axes' } + +----------------------------------------------------------------------------- + +-- | set the type of the subplot +setPlotType :: PlotType -> Plot () +setPlotType pt = modify $ \s -> s { _type = pt } + +----------------------------------------------------------------------------- + +-- | operate on the data +withData :: D.Data () -> Plot () +withData = dataInPlot + +-- | set the data series of the subplot +setDataset :: D.Dataset a => a -> Plot () +setDataset d = withData $ D.setDataSeries d + +-- | set the plot type of a given data series +setSeriesType :: Int -> SeriesType -> Plot () +setSeriesType i t = withData $ D.setSeriesType t i + +-- | change the plot type of all data series +setAllSeriesTypes :: SeriesType -> Plot () +setAllSeriesTypes t = withData $ D.setAllSeriesTypes t + +-- | format the plot elements of a given series +withSeriesFormat :: D.PlotFormats m => Int -> m () -> Plot () +withSeriesFormat i f = withData $ D.withSeriesFormat i f + +{- | + format the plot elements of all series + + the operation to modify the formats is passed the series index. + This allows, for example, colours to be selected from a list + that gets indexed by the argument + +> setColour i = withAllSeriesFormats (\i -> do +> setLineColour $ [black,blue,red,green,yellow] !! i +> setLineWidth 1.0 +-} +withAllSeriesFormats :: D.PlotFormats m => (Int -> m ()) -> Plot () +withAllSeriesFormats f = withData $ D.withAllSeriesFormats f + +----------------------------------------------------------------------------- + + +----------------------------------------------------------------------------- + +findMinMax :: Abscissae -> Ordinates -> (Double,Double) +findMinMax AbsFunction (OrdFunction f) = let v = mapVector f (linspace 100 (-1,1)) + in (vectorMin v,vectorMax v) +findMinMax (AbsPoints x) (OrdFunction f) = let v = mapVector f x + in (vectorMin v,vectorMax v) + -- what if errors go beyond plot? +findMinMax _ (OrdPoints y) = let o = getOrdData y + in (vectorMin o,vectorMax o) + +abscMinMax :: Abscissae -> (Double,Double) +abscMinMax AbsFunction = (-1,1) +abscMinMax (AbsPoints x) = (vectorMin x,vectorMax x) + + +ordDim :: Ordinates -> Int +ordDim (OrdFunction _) = 1 +ordDim (OrdPoints o) = dim $ getOrdData o + + +calculateRanges :: DataSeries -> ((Double,Double),(Double,Double)) +calculateRanges (DS_Y ys) = let xmax = maximum $ map (\(DecSeries o _) -> fromIntegral $ ordDim o) $ A.elems ys + ym = unzip $ map (\(DecSeries o _) -> findMinMax AbsFunction o) $ A.elems ys + ymm = (minimum $ fst ym,maximum $ snd ym) + in ((0,xmax),ymm) +calculateRanges (DS_1toN x ys) = let ym = unzip $ map (\(DecSeries o _) -> findMinMax x o) $ A.elems ys + ymm = (minimum $ fst ym,maximum $ snd ym) + xmm = abscMinMax x + in (xmm,ymm) +calculateRanges (DS_1to1 ys) = let (xm',ym') = unzip $ A.elems ys + ym = unzip $ map (\(x,(DecSeries o _)) -> findMinMax x o) (zip xm' ym') + ymm = (minimum $ fst ym,maximum $ snd ym) + xm = unzip $ map abscMinMax xm' + xmm = (minimum $ fst xm,maximum $ snd ym) + in (xmm,ymm) + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs b/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs new file mode 100644 index 0000000..1375bf1 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs @@ -0,0 +1,76 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure.Plot.Axis +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Axis +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Figure.Plot.Axis ( + Axis + , AxisType(..),AxisSide(..),AxisPosn(..) + , Tick(..), TickValues, GridLines + , setTicks + , setTickLabelFormat + , withAxisLabel + , withAxisLine + ) where + +----------------------------------------------------------------------------- + +import Control.Monad.State +import Control.Monad.Reader + +import Graphics.Rendering.Plot.Types + +----------------------------------------------------------------------------- + +changeLineType :: LineType -> AxisData -> AxisData +changeLineType lt ax = ax { _line_type = lt } + +changeMinorTicks :: Ticks -> AxisData -> AxisData +changeMinorTicks t ax = ax { _minor_ticks = t } + +changeMajorTicks :: Ticks -> AxisData -> AxisData +changeMajorTicks t ax = ax { _major_ticks = t } + +changeTickFormat :: TickFormat -> AxisData -> AxisData +changeTickFormat tf ax = ax { _tick_format = tf } + +changeLabel :: (TextEntry -> TextEntry) -> AxisData -> AxisData +changeLabel f ax = ax { _label = f (_label ax) } + +----------------------------------------------------------------------------- + +-- | format the axis line +withAxisLine :: Line () -> Axis () +withAxisLine m = do + l <- gets _line_type + lo <- asks _lineoptions + let lt = execLine m lo l + modify $ \s -> s { _line_type = lt } + +-- | format the axis ticks +setTicks :: Tick -> GridLines -> TickValues -> Axis () +setTicks Minor g ts = modify $ \s -> changeMinorTicks (Ticks g ts) s +setTicks Major g ts = modify $ \s -> changeMajorTicks (Ticks g ts) s + +-- | printf format that takes one argument, the tick value +setTickLabelFormat :: String -> Axis () +setTickLabelFormat tf = modify $ \s -> changeTickFormat tf s + +-- | operate on the axis label +withAxisLabel :: Text () -> Axis () +withAxisLabel m = do + ax <- get + to <- asks _textoptions + put $ ax { _label = execText m to (_label ax) } + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs b/lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs new file mode 100644 index 0000000..4689b2e --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs @@ -0,0 +1,397 @@ +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure.Plot.Data +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- 'Data' operations +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Figure.Plot.Data ( + Data + -- * Series data + , FormattedSeries() + , line, point, linepoint + , setDataSeries + -- * Plot type + , setSeriesType + , setAllSeriesTypes + -- * Formatting + , PlotType(..), PlotFormats(..) + , withSeriesFormat + , withAllSeriesFormats + -- * Internal + , Abscissa(), Ordinate(), Dataset() + ) where + +----------------------------------------------------------------------------- + +--import Data.Packed.Vector + +import Data.Maybe + +import qualified Data.Array.IArray as A + +import Control.Monad.State +import Control.Monad.Reader +import Control.Monad.Supply + +import Graphics.Rendering.Plot.Types +import Graphics.Rendering.Plot.Figure.Line +import Graphics.Rendering.Plot.Figure.Point + +----------------------------------------------------------------------------- + +dataSeriesNum :: DataSeries -> Int +dataSeriesNum (DS_Y a) = A.rangeSize $ A.bounds $ a +dataSeriesNum (DS_1toN _ a) = A.rangeSize $ A.bounds $ a +dataSeriesNum (DS_1to1 a) = A.rangeSize $ A.bounds $ a + +----------------------------------------------------------------------------- + +class SeriesTypes a where + setSeriesType'' :: SeriesType -> a -> Data a + +instance SeriesTypes Decoration where + setSeriesType'' Line d@(DecLine _) = return d + setSeriesType'' Line (DecPoint pt) = do + let c = getPointColour pt + lt <- toLine c + return $ DecLine lt + setSeriesType'' Line (DecLinPt lt _) = return $ DecLine lt + setSeriesType'' Point (DecLine lt) = do + let c = fromJust $ getLineColour lt + g <- supply + pt <- toPoint (g :: Glyph,c) + return $ DecPoint pt + setSeriesType'' Point d@(DecPoint _) = return d + setSeriesType'' Point (DecLinPt _ pt) = return $ DecPoint pt + setSeriesType'' LinePoint (DecLine lt) = do + let c = fromJust $ getLineColour lt + g <- supply + pt <- toPoint (g :: Glyph,c) + return $ DecLinPt lt pt + setSeriesType'' LinePoint (DecPoint pt) = do + let c = getPointColour pt + lt <- toLine (c :: Color) + return $ DecLinPt lt pt + setSeriesType'' LinePoint d@(DecLinPt _ _) = return d + +instance SeriesTypes DecoratedSeries where + setSeriesType'' t (DecSeries o d) = do + d' <- setSeriesType'' t d + return $ DecSeries o d' + +setSeriesType' :: Int -> SeriesType -> DataSeries -> Data DataSeries +setSeriesType' i t (DS_Y a) = do + s' <- setSeriesType'' t $ a A.! i + return $ DS_Y $ a A.// [(i,s')] +setSeriesType' i t (DS_1toN x a) = do + s' <- setSeriesType'' t $ a A.! i + return $ DS_1toN x $ a A.// [(i,s')] +setSeriesType' i t (DS_1to1 a) = do + let (x,s) = a A.! i + s' <- setSeriesType'' t s + return $ DS_1to1 $ a A.// [(i,(x,s'))] + +-- | set the series type of a given data series +setSeriesType :: SeriesType -> Int -> Data () +setSeriesType t i = do + ds <- get + ds' <- setSeriesType' i t ds + put ds' + +-- | set the series type of all data series +setAllSeriesTypes :: SeriesType -> Data () +setAllSeriesTypes t = do + ds <- get + let ln = dataSeriesNum ds + mapM_ (setSeriesType t) [1..ln] + +----------------------------------------------------------------------------- + +class PlotFormats m where + modifyFormat :: m () -> DecoratedSeries -> Data DecoratedSeries + +instance PlotFormats Line where + modifyFormat l (DecSeries o (DecLine lt)) = do + lo <- asks _lineoptions + let lt' = execLine l lo lt + return $ DecSeries o (DecLine lt') + modifyFormat _ d@(DecSeries _ (DecPoint _)) = return d + modifyFormat l (DecSeries o (DecLinPt lt pt)) = do + lo <- asks _lineoptions + let lt' = execLine l lo lt + return $ DecSeries o (DecLinPt lt' pt) + +instance PlotFormats Point where + modifyFormat _ d@(DecSeries _ (DecLine _)) = return d + modifyFormat p (DecSeries o (DecPoint pt)) = do + po <- asks _pointoptions + let pt' = execPoint p po pt + return $ DecSeries o (DecPoint pt') + modifyFormat p (DecSeries o (DecLinPt lt pt)) = do + po <- asks _pointoptions + let pt' = execPoint p po pt + return $ DecSeries o (DecLinPt lt pt') + +-- | format the plot elements of a given series +withSeriesFormat :: PlotFormats m => Int -> m () -> Data () +withSeriesFormat i f = do + ds <- get + ds' <- case ds of + (DS_Y a) -> do + let d = a A.! i + d' <- modifyFormat f d + return $ DS_Y $ a A.// [(i,d')] + (DS_1toN x a) -> do + let d = a A.! i + d' <- modifyFormat f d + return $ DS_1toN x $ a A.// [(i,d')] + (DS_1to1 a) -> do + let (x,d) = a A.! i + d' <- modifyFormat f d + return $ DS_1to1 $ a A.// [(i,(x,d'))] + put ds' + +-- | format the plot elements of all series +-- | the operation to modify the formats is passed the series index +-- | this allows, for example, colours to be selected from a list +-- | that gets indexed by the argument +-- | @setColour i = setLineColour $ [black,blue,red,green,yellow] !! i@ +withAllSeriesFormats :: PlotFormats m => (Int -> m ()) -> Data () +withAllSeriesFormats f = do + ds <- get + let ln = dataSeriesNum ds + mapM_ (\i -> withSeriesFormat i (f i)) [1..ln] + +----------------------------------------------------------------------------- + +class Abscissa a where + toAbscissa :: a -> Abscissae + +toAbscissae :: Abscissa a => [a] -> [Abscissae] +toAbscissae = map toAbscissa + +instance Abscissa Series where toAbscissa s = AbsPoints s + +class Ordinate a where + toOrdinate :: a -> Ordinates + +toOrdinates :: Ordinate a => [a] -> [Ordinates] +toOrdinates = map toOrdinate + +instance Ordinate Function where toOrdinate f = OrdFunction f +instance Ordinate Series where toOrdinate s = OrdPoints (Plain s) +instance Ordinate (Series,ErrorSeries) where toOrdinate (s,e) = OrdPoints (Error s (e,e)) +instance Ordinate (Series,(ErrorSeries,ErrorSeries)) where toOrdinate (s,(l,u)) = OrdPoints (Error s (l,u)) + +class Decorations a where + toDecoration :: a -> Decoration + +toDecorations :: Decorations a => [a] -> [Decoration] +toDecorations = map toDecoration + +instance Decorations LineType where toDecoration l = DecLine l +instance Decorations PointType where toDecoration p = DecPoint p +instance Decorations (LineType,PointType) where toDecoration (l,p) = DecLinPt l p +instance Decorations (PointType,LineType) where toDecoration (p,l) = DecLinPt l p +instance Decorations Decoration where toDecoration = id + +format :: (Ordinate a, Decorations b) => a -> b -> DecoratedSeries +format o f = DecSeries (toOrdinate o) (toDecoration f) + +line :: (Ordinate a, LineFormat b) => a -> b -> FormattedSeries +line o f = do + f' <- toLine f + return $ format o f' + +point :: (Ordinate a, PointFormat b) => a -> b -> FormattedSeries +point o f = do + f' <- toPoint f + return $ format o f' + +linepoint :: (Ordinate a, LineFormat b, PointFormat c) => a -> b -> c -> FormattedSeries +linepoint o l p = do + l' <- toLine l + p' <- toPoint p + return $ format o (l',p') + +----------------------------------------------------------------------------- + +getType :: SeriesType -> Data Decoration +getType Line = do + c <- supply + lt <- toLine (c :: Color) + return $ toDecoration lt +getType Point = do + g <- supply + pt <- toPoint (g :: Glyph) + return $ toDecoration pt +getType LinePoint = do + c <- supply + g <- supply + lt <- toLine (c :: Color) + pt <- toPoint (g :: Glyph) + return $ toDecoration (lt,pt) + +getNTypes :: Int -> SeriesType -> Data [Decoration] +getNTypes n st = mapM getType (replicate n st) + +----------------------------------------------------------------------------- + +class Dataset a where + toDataSeries :: a -> Data DataSeries + +instance (Ordinate a) => Dataset (SeriesType,[a]) where + toDataSeries (Line,os) = do + let ln = length os + cs <- supplyN ln + ls <- mapM toLine (cs :: [Color]) + return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ls + toDataSeries (Point,os) = do + let ln = length os + cs <- supplyN ln + gs <- supplyN ln + ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color])) + return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ps + toDataSeries (LinePoint,os) = do + let ln = length os + cs <- supplyN ln + gs <- supplyN ln + ls <- mapM toLine cs + ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color])) + let ds = toDecorations (zip ls ps) + return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ds + +instance (Abscissa a, Ordinate b) => Dataset (SeriesType,a,[b]) where + toDataSeries (Line,t,os) = do + let ln = length os + cs <- supplyN ln + ls <- mapM toLine (cs :: [Color]) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ls + toDataSeries (Point,t,os) = do + let ln = length os + cs <- supplyN ln + gs <- supplyN ln + ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color])) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ps + toDataSeries (LinePoint,t,os) = do + let ln = length os + cs <- supplyN ln + gs <- supplyN ln + ls <- mapM toLine cs + ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color])) + let ds = toDecorations (zip ls ps) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ds + +instance (Abscissa a, Ordinate b) => Dataset (SeriesType,[(a,b)]) where + toDataSeries (Line,prs) = do + let ln = length prs + cs <- supplyN ln + ls <- mapM toLine (cs :: [Color]) + let (xs,ys') = unzip prs + ys = zipWith format ys' ls + return $ DS_1to1 $ A.listArray (1,ln) $ zip (toAbscissae xs) ys + toDataSeries (Point,prs) = do + let ln = length prs + cs <- supplyN ln + gs <- supplyN ln + ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color])) + let (xs,ys') = unzip prs + ys = zipWith format ys' ps + return $ DS_1to1 $ A.listArray (1,ln) $ zip (toAbscissae xs) ys + toDataSeries (LinePoint,prs) = do + let ln = length prs + cs <- supplyN ln + gs <- supplyN ln + ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color])) + ls <- mapM toLine (cs :: [Color]) + let ds = toDecorations (zip ls ps) + let (xs,ys') = unzip prs + ys = zipWith format ys' ds + return $ DS_1to1 $ A.listArray (1,ln) $ zip (toAbscissae xs) ys + +instance Dataset [FormattedSeries] where + toDataSeries ds = do + let ln = length ds + ds' <- sequence ds + return $ DS_Y $ A.listArray (1,ln) ds' + +instance (Abscissa a) => Dataset (a,[FormattedSeries]) where + toDataSeries (t,prs) = do + let ln = length prs + prs' <- sequence prs + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) prs' + +instance (Abscissa a) => Dataset [(a,FormattedSeries)] where + toDataSeries prs = do + let ln = length prs + (xs,ys) = unzip prs + ys' <- sequence ys + return $ DS_1to1 $ A.listArray (1,ln) (zip (toAbscissae xs) ys') + +{- +instance (Ordinate a, LineFormat b) => Dataset [(a,LineFormat,b)] where + toDataSeries os = do + let ln = length os + (ys,_,ds) = unzip3 os + ds' <- mapM toLine ds + return $ DS_Y $ A.listArray (1,ln) $ zipWith format (toOrdinates ys) (toDecorations ds') + +instance (Ordinate a, PointFormat b) => Dataset [(a,PointFormat,b)] where + toDataSeries os = do + let ln = length os + (ys,_,ds) = unzip3 os + ds' <- mapM toPoint ds + return $ DS_Y $ A.listArray (1,ln) $ zipWith format (toOrdinates ys) (toDecorations ds') + +instance (Abscissa a, Ordinate b, Decorations c) => Dataset (a,[(b,c)]) where + toDataSeries Line (t,os) = do + let ln = length os + (ys,ds) = unzip os + ds' <- mapM toLine ds + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format (toOrdinates ys) (toDecorations ds') + toDataSeries Point (t,os) = do + let ln = length os + (ys,ds) = unzip os + ds' <- mapM toPoint ds + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format (toOrdinates ys) (toDecorations ds') + +instance (Abscissa a, Ordinate b, Decorations c) => Dataset [(a,b,c)] where + toDataSeries Line prs = do + let ln = length prs + (ts,ys,ds) = unzip3 prs + ds' <- mapM toLine ds + let ys' = zipWith format (toOrdinates ys) (toDecorations ds') + return $ DS_1to1 $ A.listArray (1,ln) $ zip (toAbscissae ts) ys' + toDataSeries Point prs = do + let ln = length prs + (ts,ys,ds) = unzip3 prs + ds' <- mapM toPoint ds + let ys' = zipWith format (toOrdinates ys) (toDecorations ds') + return $ DS_1to1 $ A.listArray (1,ln) $ zip (toAbscissae ts) ys' +-} + +-- | set the data set +setDataSeries :: Dataset a => a -> Data () +setDataSeries d = do + ds <- toDataSeries d + put ds + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Point.hs b/lib/Graphics/Rendering/Plot/Figure/Point.hs new file mode 100644 index 0000000..8ca894e --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Point.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure.Point +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- 'Point' operations +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Figure.Point ( + Point, PointFormat(..) + , PointSize +-- , clearPointFormat + , setGlyph + , setPointSize + , setPointColour + , getPointColour + ) where + +----------------------------------------------------------------------------- + +--import Data.Word +import Data.Colour +--import Data.Colour.SRGB +--import Data.Colour.Names + +--import qualified Graphics.Rendering.Cairo as C +--import qualified Graphics.Rendering.Pango as P + +import Control.Monad.State +import Control.Monad.Reader +import Control.Monad.Supply + +import Graphics.Rendering.Plot.Types + +----------------------------------------------------------------------------- + +changePointSize :: PointSize -> PointOptions -> PointOptions +changePointSize sz (PointOptions _ c) = PointOptions sz c + +changePointColour :: Color -> PointOptions -> PointOptions +changePointColour c (PointOptions sz _) = PointOptions sz c + +getPointColour :: PointType -> Color +getPointColour (FullPoint (PointOptions _ c) _) = c + +changePointGlyph :: Glyph -> PointType -> PointType +--changePointGlyph gt s (BarePoint _) = BarePoint (Glyph gt s) +changePointGlyph g (FullPoint po _) = FullPoint po g + +----------------------------------------------------------------------------- +{- +-- | clear the formatting of a point +clearPointFormat :: Point () +clearPointFormat = do + pt <- get + case pt of + g@(BarePoint _) -> put g + (FullPoint _ g) -> put $ BarePoint g +-} + +changePointOptions :: (PointOptions -> PointOptions) -> PointType -> Point () +--changePointOptions o (BarePoint g) = do +-- po <- ask +-- put $ FullPoint (o po) g +changePointOptions o (FullPoint po g) = put $ FullPoint (o po) g + +-- | change the glyph of a point +setGlyph :: Glyph -> Point () +setGlyph g = modify $ \s -> changePointGlyph g s + +-- | change the size of a point +setPointSize :: PointSize -> Point () +setPointSize sz = get >>= changePointOptions (changePointSize sz) + +-- | change the colour of a point +setPointColour :: Color -> Point () +setPointColour c = get >>= changePointOptions (changePointColour c) + +----------------------------------------------------------------------------- + +class PointFormat a where + toPoint :: (MonadReader Options m, MonadSupply SupplyData m) => a -> m PointType + +instance PointFormat Glyph where toPoint g = do + po <- asks _pointoptions + c <- supply + return $ FullPoint (changePointColour c po) g +--instance PointFormat GlyphType where toPoint g = return $ BarePoint g +instance Real a => PointFormat (Colour a) where toPoint c = do + po <- asks _pointoptions + g <- supply + return $ FullPoint (changePointColour (colourConvert c) po) g +instance PointFormat (Glyph,PointSize) where toPoint (g,s) = do + po <- asks _pointoptions + c <- supply + return $ FullPoint (changePointSize s $ changePointColour c po) g +instance Real a => PointFormat (Glyph,Colour a) where toPoint (g,c) = do + po <- asks _pointoptions + return $ FullPoint (changePointColour (colourConvert c) po) g +instance Real a => PointFormat (Glyph,PointSize,Colour a) where toPoint (g,s,c) = return $ FullPoint (PointOptions s (colourConvert c)) g + +----------------------------------------------------------------------------- + +{- TODO + + fix Glyph/GlyphType differences + NoPoint option? +-} + + diff --git a/lib/Graphics/Rendering/Plot/Figure/Text.hs b/lib/Graphics/Rendering/Plot/Figure/Text.hs new file mode 100644 index 0000000..456049c --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Text.hs @@ -0,0 +1,181 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure.Text +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- 'Text' operations +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Figure.Text ( + Text + , FontFamily,FontSize,Color + -- | A text element must exist for formatting to work + , clearText + , clearTextFormat + , setText + , setFontFamily + , setFontStyle + , setFontVariant + , setFontWeight + , setFontStretch + , setFontSize + , setFontColour + -- + , changeFontSize + , changeFontColour + -- + , scaleFontSize + ) where + +----------------------------------------------------------------------------- + +import Control.Monad.State +import Control.Monad.Reader + +import qualified Graphics.Rendering.Pango as P + +import Graphics.Rendering.Plot.Types + +----------------------------------------------------------------------------- + +changeFontFamilyFont :: FontFamily -> FontOptions -> FontOptions +changeFontFamilyFont ff (FontOptions _ fs fv fw fc) = FontOptions ff fs fv fw fc + +changeFontStyleFont :: P.FontStyle -> FontOptions -> FontOptions +changeFontStyleFont fs (FontOptions ff _ fv fw fc) = FontOptions ff fs fv fw fc + +changeFontVariantFont :: P.Variant -> FontOptions -> FontOptions +changeFontVariantFont fv (FontOptions ff fs _ fw fc) = FontOptions ff fs fv fw fc + +changeFontWeightFont :: P.Weight -> FontOptions -> FontOptions +changeFontWeightFont fw (FontOptions ff fs fv _ fc) = FontOptions ff fs fv fw fc + +changeFontStretchFont :: P.Stretch -> FontOptions -> FontOptions +changeFontStretchFont fc (FontOptions ff fs fv fw _) = FontOptions ff fs fv fw fc + +changeFontOptionsFont :: (FontOptions -> FontOptions) -> TextOptions -> TextOptions +changeFontOptionsFont f (TextOptions fo fz c) = TextOptions (f fo) fz c + +changeFontFamily :: FontFamily -> TextOptions -> TextOptions +changeFontFamily ff = changeFontOptionsFont $ changeFontFamilyFont ff + +changeFontStyle :: P.FontStyle -> TextOptions -> TextOptions +changeFontStyle fs = changeFontOptionsFont $ changeFontStyleFont fs + +changeFontVariant :: P.Variant -> TextOptions -> TextOptions +changeFontVariant fv = changeFontOptionsFont $ changeFontVariantFont fv + +changeFontWeight :: P.Weight -> TextOptions -> TextOptions +changeFontWeight fw = changeFontOptionsFont $ changeFontWeightFont fw + +changeFontStretch :: P.Stretch -> TextOptions -> TextOptions +changeFontStretch fc = changeFontOptionsFont $ changeFontStretchFont fc + +changeFontSize :: FontSize -> TextOptions -> TextOptions +changeFontSize fz (TextOptions fo _ c) = TextOptions fo fz c + +scaleFontSize :: Double -> TextOptions -> TextOptions +scaleFontSize sc (TextOptions fo fz c) = TextOptions fo (sc*fz) c + +changeFontColour :: Color -> TextOptions -> TextOptions +changeFontColour c (TextOptions fo fz _) = TextOptions fo fz c + +changeFontTextSize :: FontSize -> TextEntry -> TextEntry +changeFontTextSize fz (FontText to s) = FontText (changeFontSize fz to) s +changeFontTextSize _ _ = error "changeFontTextSize" + +changeFontTextColour :: Color -> TextEntry -> TextEntry +changeFontTextColour c (FontText to s) = FontText (changeFontColour c to) s +changeFontTextColour _ _ = error "changeFontTextColour" + +changeText :: String -> TextEntry -> TextEntry +changeText s NoText = BareText s +changeText s (BareText _) = BareText s +changeText s (SizeText fz c _) = SizeText fz c s +changeText s (FontText to _) = FontText to s + +clearTextEntryFormat :: TextEntry -> TextEntry +clearTextEntryFormat NoText = NoText +clearTextEntryFormat t@(BareText _) = t +clearTextEntryFormat (SizeText _ _ s) = BareText s +clearTextEntryFormat (FontText _ s) = BareText s + +----------------------------------------------------------------------------- + +-- | clear the text entry +clearText :: Text () +clearText = put NoText + +-- | set the text formatting to the default +clearTextFormat :: Text () +clearTextFormat = modify clearTextEntryFormat + +-- | set the value of a text entry +setText :: String -> Text () +setText l = modify (changeText l) + +changeFontOptions :: (TextOptions -> TextOptions) -> TextEntry -> Text () +changeFontOptions _ NoText = return () +changeFontOptions o (BareText s) = do + to <- ask + put $ FontText (o to) s +changeFontOptions o (SizeText fz c s) = do + to <- ask + let (TextOptions fo _ _) = o to + put $ FontText (TextOptions fo fz c) s +changeFontOptions o (FontText to s) = put $ FontText (o to) s + + +-- | set the font style of a text entry +setFontFamily :: FontFamily -> Text () +setFontFamily ff = get >>= changeFontOptions (changeFontFamily ff) + +-- | set the font style of a text entry +setFontStyle :: P.FontStyle -> Text () +setFontStyle fs = get >>= changeFontOptions (changeFontStyle fs) + +-- | set the font variant of a text entry +setFontVariant :: P.Variant -> Text () +setFontVariant fv = get >>= changeFontOptions (changeFontVariant fv) + +-- | set the font weight of a text entry +setFontWeight :: P.Weight -> Text () +setFontWeight fw = get >>= changeFontOptions (changeFontWeight fw) + +-- | set the font stretch of a text entry +setFontStretch :: P.Stretch -> Text () +setFontStretch fc = get >>= changeFontOptions (changeFontStretch fc) + +-- | set the font size of a text entry +setFontSize :: FontSize -> Text () +setFontSize fz = do + t <- get + case t of + NoText -> return () + (BareText s) -> do + (TextOptions _ _ c) <- ask + put $ SizeText fz c s + (SizeText _ c s) -> put $ SizeText fz c s + (FontText to s) -> put $ FontText (changeFontSize fz to) s + +-- | set the colour of a text entry +setFontColour :: Color -> Text () +setFontColour c = do + t <- get + case t of + NoText -> return () + (BareText s) -> do + (TextOptions _ fz _) <- ask + put $ SizeText fz c s + (SizeText fz _ s) -> put $ SizeText fz c s + (FontText to s) -> put $ FontText (changeFontColour c to) s + +----------------------------------------------------------------------------- + + diff --git a/lib/Graphics/Rendering/Plot/Render.hs b/lib/Graphics/Rendering/Plot/Render.hs new file mode 100644 index 0000000..3336c18 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Rendering 'Figure's +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Render ( + -- * Rendering + render + -- ** Outputting to file + , OutputType(..) + , writeFigure + -- * Notes + -- $notes + ) where + +----------------------------------------------------------------------------- +{- TODO + + store 'next colour' list in state +-} +----------------------------------------------------------------------------- + +--import Data.Either + +--import Data.Packed.Vector +--import Numeric.LinearAlgebra.Linear + +--import Data.Word + +--import Data.Maybe + +--import Data.Colour.SRGB +--import Data.Colour.Names + +--import qualified Data.Array.IArray as A + +import qualified Graphics.Rendering.Cairo as C +import qualified Graphics.Rendering.Pango as P + +--import Control.Monad.Reader +--import Control.Monad.State +--import Control.Monad.Trans + +import Graphics.Rendering.Plot.Types +import Graphics.Rendering.Plot.Defaults + +--import Graphics.Rendering.Plot.Figure.Text + +import Graphics.Rendering.Plot.Render.Types +import Graphics.Rendering.Plot.Render.Text +import Graphics.Rendering.Plot.Render.Plot + +--import qualified Text.Printf as Printf + +--import Prelude hiding(min,max) +--import qualified Prelude(max) + +----------------------------------------------------------------------------- + +-- | render a 'Figure' +render :: Figure () -- ^ the figure to be rendered + -> (Int,Int) -- ^ (width,height) + -> C.Render () -- ^ a Cairo operation +render g = (\(w,h) -> do + pc <- pango $ P.cairoCreateContext Nothing + to <- getDefaultTextOptions pc + let options' = Options defaultLineOptions defaultPointOptions to + let (FigureState options _ figure) = execFigure g (FigureState options' defaultSupply emptyFigure) + evalRender (renderFigure figure) (RenderEnv pc options) (BoundingBox 0 0 (fromIntegral w) (fromIntegral h))) + +----------------------------------------------------------------------------- + +-- | output the 'Figure' +writeFigure :: OutputType -- ^ output file type + -> FilePath -- ^ file path + -> (Int,Int) -- ^ (width,height) + -> Figure () -- ^ the 'Figure' rendering operation + -> IO () +writeFigure PNG fn wh f = withImageSurface wh (writeSurfaceToPNG fn (render f wh)) +writeFigure PS fn wh f = writeSurface C.withPSSurface fn wh f +writeFigure PDF fn wh f = writeSurface C.withPDFSurface fn wh f +writeFigure SVG fn wh f = writeSurface C.withSVGSurface fn wh f + +withImageSurface :: (Int,Int) -> (C.Surface -> IO ()) -> IO () +withImageSurface (w,h) = C.withImageSurface C.FormatARGB32 w h + +writeSurfaceToPNG :: FilePath -> C.Render () -> C.Surface -> IO () +writeSurfaceToPNG fn r s = do + C.renderWith s r + C.surfaceWriteToPNG s fn + +writeSurface :: (FilePath -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) + -> FilePath -> (Int,Int) -> Figure () -> IO () +writeSurface rw fn (w,h) f = rw fn (fromIntegral w) (fromIntegral h) (flip C.renderWith (render f (w,h))) + +----------------------------------------------------------------------------- + +renderFigure :: FigureData -> Render () +renderFigure (Figure p t s d) = do + cairo $ do + C.save + C.setSourceRGBA 1 1 1 1 + C.paint + C.restore + + tx <- bbCentreWidth + ty <- bbTopHeight + (_,th) <- renderText t Centre TTop tx ty + bbLowerTop (th+textPad) + + sx <- bbCentreWidth + sy <- bbTopHeight + (_,sh) <- renderText s Centre TTop sx sy + bbLowerTop (sh+textPad) + + applyPads p + + renderPlots d + diff --git a/lib/Graphics/Rendering/Plot/Render/Plot.hs b/lib/Graphics/Rendering/Plot/Render/Plot.hs new file mode 100644 index 0000000..7458737 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Plot.hs @@ -0,0 +1,127 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render.Plot +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Rendering 'Figure's +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Render.Plot ( + -- * Rendering + renderPlots + ) where + +----------------------------------------------------------------------------- + +--import Data.Either + +--import Data.Packed.Vector +--import Numeric.LinearAlgebra.Linear + +--import Data.Word + +--import Data.Maybe + +--import Data.Colour.SRGB +--import Data.Colour.Names + +import qualified Data.Array.IArray as A + +import qualified Graphics.Rendering.Cairo as C +--import qualified Graphics.Rendering.Pango as P + +--import Control.Monad.Reader +import Control.Monad.State +--import Control.Monad.Trans + +import Graphics.Rendering.Plot.Types +--import Graphics.Rendering.Plot.Defaults + +--import Graphics.Rendering.Plot.Figure.Text + +import Graphics.Rendering.Plot.Render.Types + +import Graphics.Rendering.Plot.Render.Text +import Graphics.Rendering.Plot.Render.Plot.Axis +import Graphics.Rendering.Plot.Render.Plot.Data + +--import qualified Text.Printf as Printf + +--import Prelude hiding(min,max) +--import qualified Prelude(max) + +----------------------------------------------------------------------------- + +bbPlot :: Int -> Int -> (Int,Int) -> Render () +bbPlot r c (px,py) = modify (\(BoundingBox x y w h) -> let rs = w/(fromIntegral r) + cs = h/(fromIntegral c) + in (BoundingBox + (x+rs*((fromIntegral px)-1)) + (y+cs*((fromIntegral py)-1)) + rs cs)) + +renderPlots :: Plots -> Render () +renderPlots d = do + let ((x,y),(x',y')) = A.bounds d + rows = x'-x+1 + cols = y'-y+1 + bb <- get + mapM_ (\(i,e) -> do + case e of + Nothing -> return () + Just e' -> do + bbPlot rows cols i + renderPlot e' + put bb) (A.assocs d) + +renderPlot :: PlotData -> Render () +renderPlot (Plot b p hd r a t d l an) = do + tx <- bbCentreWidth + ty <- bbTopHeight + (_,th) <- renderText hd Centre TTop tx ty + bbLowerTop (th+textPad) +{- attempt to have different colour plot area + (BoundingBox x y w h) <- get + cairo $ do + setColour white + C.moveTo x y + C.lineTo (x+w) y + C.lineTo (x+w) (y+h) + C.lineTo x (y+h) + C.stroke + C.clip + C.fill + C.paint +-} + renderAxes p r a + renderBorder b + cairo C.save + clipBoundary + renderData r t d an + renderLegend l + cairo C.restore + +renderBorder :: Border -> Render () +renderBorder False = return () +renderBorder True = do + (BoundingBox x y w h) <- get + cairo $ do + C.setLineWidth 0.5 + C.moveTo x y + C.lineTo x (y+h) + C.lineTo (x+w) (y+h) + C.lineTo (x+w) y + C.closePath + C.stroke + +renderLegend :: Maybe Legend -> Render () +renderLegend _ = return () + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs new file mode 100644 index 0000000..614b84f --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs @@ -0,0 +1,398 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render.Plot.Axis +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Rendering 'Figure's +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Render.Plot.Axis ( + -- * Rendering + renderAxes + ) where + +----------------------------------------------------------------------------- + +import Data.Either + +--import Data.Maybe + +--import Data.Colour.SRGB +--import Data.Colour.Names + +--import qualified Data.Array.IArray as A + +import qualified Graphics.Rendering.Cairo as C +import qualified Graphics.Rendering.Pango as P + +import Control.Monad.Reader +import Control.Monad.State +--import Control.Monad.Trans + +import Graphics.Rendering.Plot.Types +import Graphics.Rendering.Plot.Defaults + +import Graphics.Rendering.Plot.Figure.Text + +import Graphics.Rendering.Plot.Render.Types +import Graphics.Rendering.Plot.Render.Text + +import qualified Text.Printf as Printf + +import Prelude hiding(min,max) +import qualified Prelude(max) + +----------------------------------------------------------------------------- + +addPadding :: Padding -> Padding -> Padding +addPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = Padding (l0+l1) (r0+r1) (b0+b1) (t0+t1) + +maxPadding :: Padding -> Padding -> Padding +maxPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = Padding (Prelude.max l0 l1) (Prelude.max r0 r1) (Prelude.max b0 b1) (Prelude.max t0 t1) + +-- first is plot padding, second is calculated padding +isZeroPadding :: Padding -> Padding -> Render Padding +isZeroPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = do + l <- if l1 == 0 then do + bbShiftLeft l0 + return l0 + else if l0 > l1 then do + bbShiftLeft (l0 - l1) + return l0 + else return l1 + r <- if r1 == 0 then do + bbShiftRight r0 + return r0 + else if r0 > r1 then do + bbShiftRight (r0 - r1) + return r0 + else return r1 + b <- if b1 == 0 then do + bbRaiseBottom b0 + return b0 + else if b0 > b1 then do + bbRaiseBottom (b0 - b1) + return b0 + else return b1 + t <- if t1 == 0 then do + bbLowerTop t0 + return t0 + else if t0 > t1 then do + bbLowerTop (t0 - t1) + return t0 + else return t1 + return $ Padding l r b t + + +renderAxes :: Padding -> Ranges -> [AxisData] -> Render () +renderAxes p r axes = do + lp <- foldM shiftForAxisLabel (Padding 0 0 0 0) axes + tp <- foldM (shiftForTicks r) (Padding 0 0 0 0) axes + let apd = addPadding lp tp + p' <- isZeroPadding p apd + mapM_ (renderAxisLabel p') axes + mapM_ (renderAxis r) axes + return () + +shiftForAxisLabel :: Padding -> AxisData -> Render Padding +shiftForAxisLabel p (Axis _ _ _ _ _ _ NoText) = return p +shiftForAxisLabel p (Axis ax sd _ _ _ _ lb) = do + (FontText to s) <- formatText lb + pc <- asks _pangocontext + (w,h) <- cairo $ do + lo <- pango $ P.layoutText pc s + setTextOptions to lo + case ax of + XAxis -> do + (_,(twh)) <- textSize lo Centre Middle 0 0 + return twh + YAxis -> do + (_,((w',h'))) <- textSizeVertical lo Centre Middle 0 0 + return (h',w') + shiftForAxisLabel' p ax sd w h + where shiftForAxisLabel' (Padding l r b t) XAxis (Side Lower) _ h' = do + bbRaiseBottom (h'+2*textPad) + return $ Padding l r (b+h'+2*textPad) t + shiftForAxisLabel' (Padding l r b t) XAxis (Side Upper) _ h' = do + bbLowerTop (h'+2*textPad) + return $ Padding l r b (t+h'+2*textPad) + shiftForAxisLabel' (Padding l r b t) YAxis (Side Lower) w' _ = do + bbShiftLeft (w'+2*textPad) + return $ Padding (l+w'+2*textPad) r b t + shiftForAxisLabel' (Padding l r b t) YAxis (Side Upper) w' _ = do + bbShiftRight (w'+2*textPad) + return $ Padding l (r+w'+2*textPad) b t + shiftForAxisLabel' p' _ (Value _) _ _ = return p' + +-- the padding is the tick padding that has been applied +renderAxisLabel :: Padding -> AxisData -> Render () +renderAxisLabel _ (Axis _ _ _ _ _ _ NoText) = return () +renderAxisLabel (Padding _ _ b _) (Axis XAxis (Side Lower) _ _ _ _ la) = do + lx <- bbCentreWidth + ly <- bbBottomHeight + _ <- renderText la Centre TBottom lx (ly+b-textPad) + return () +renderAxisLabel (Padding _ _ _ t) (Axis XAxis (Side Upper) _ _ _ _ la) = do + lx <- bbCentreWidth + ly <- bbTopHeight + _ <- renderText la Centre TTop lx (ly-t+textPad) + return () +renderAxisLabel (Padding l _ _ _) (Axis YAxis (Side Lower) _ _ _ _ la) = do + lx <- bbLeftWidth + ly <- bbCentreHeight + _ <- renderTextVertical la TLeft Middle (lx-l+textPad) ly + return () +renderAxisLabel (Padding _ r _ _) (Axis YAxis (Side Upper) _ _ _ _ la) = do + lx <- bbRightWidth + ly <- bbCentreHeight + _ <- renderTextVertical la TRight Middle (lx+r-textPad) ly + return () +renderAxisLabel _ (Axis _ (Value _) _ _ _ _ _) = return () + +shiftForTicks :: Ranges -> Padding -> AxisData -> Render Padding +shiftForTicks (Ranges (Left (Range xmin xmax)) _) + p (Axis XAxis (Side Lower) _ min maj tf _) + = shiftForTicks' p min maj XAxis (Side Lower) tf (negate $ Prelude.max (abs xmin) (abs xmax)) +shiftForTicks (Ranges (Left (Range xmin xmax)) _) + p (Axis XAxis (Side Upper) _ min maj tf _) + = shiftForTicks' p min maj XAxis (Side Upper) tf (negate $ Prelude.max (abs xmin) (abs xmax)) +shiftForTicks (Ranges (Right ((Range xmin xmax),_)) _) + p (Axis XAxis (Side Lower) _ min maj tf _) + = shiftForTicks' p min maj XAxis (Side Lower) tf (negate $ Prelude.max (abs xmin) (abs xmax)) +shiftForTicks (Ranges (Right (_,(Range xmin xmax))) _) + p (Axis XAxis (Side Upper) _ min maj tf _) + = shiftForTicks' p min maj XAxis (Side Upper) tf (negate $ Prelude.max (abs xmin) (abs xmax)) +shiftForTicks (Ranges _ (Left (Range ymin ymax))) + p (Axis YAxis (Side Lower) _ min maj tf _) + = shiftForTicks' p min maj YAxis (Side Lower) tf (negate $ Prelude.max (abs ymin) (abs ymax)) +shiftForTicks (Ranges _ (Left (Range ymin ymax))) + p (Axis YAxis (Side Upper) _ min maj tf _) + = shiftForTicks' p min maj YAxis (Side Upper) tf (negate $ Prelude.max (abs ymin) (abs ymax)) +shiftForTicks (Ranges _ (Right ((Range ymin ymax),_))) + p (Axis YAxis (Side Lower) _ min maj tf _) + = shiftForTicks' p min maj YAxis (Side Lower) tf (negate $ Prelude.max (abs ymin) (abs ymax)) +shiftForTicks (Ranges _ (Right (_,(Range ymin ymax)))) + p (Axis YAxis (Side Upper) _ min maj tf _) + = shiftForTicks' p min maj YAxis (Side Upper) tf (negate $ Prelude.max (abs ymin) (abs ymax)) +shiftForTicks _ p (Axis _ (Value _) _ _ _ _ _) + = return p + +shiftForTicks' :: Padding -> Ticks -> Ticks -> AxisType -> AxisPosn -> TickFormat -> Double -> Render Padding +shiftForTicks' p (Ticks _ (Left 0)) (Ticks _ (Left 0)) _ _ _ _ = return p +shiftForTicks' (Padding l r b t) (Ticks _ (Left _)) (Ticks _ (Left 0)) XAxis (Side Lower) _ _ = do + bbRaiseBottom minorTickLength + return $ Padding l r (b+minorTickLength) t +shiftForTicks' (Padding l r b t) (Ticks _ (Left _)) (Ticks _ (Left 0)) YAxis (Side Lower) _ _ = do + bbShiftLeft minorTickLength + return $ Padding (l+minorTickLength) r b t +shiftForTicks' (Padding l r b t) (Ticks _ (Left _)) (Ticks _ (Left 0)) XAxis (Side Upper) _ _ = do + bbLowerTop minorTickLength + return $ Padding l r b (t+minorTickLength) +shiftForTicks' (Padding l r b t) (Ticks _ (Left _)) (Ticks _ (Left 0)) YAxis (Side Upper) _ _ = do + bbShiftRight minorTickLength + return $ Padding l (r+minorTickLength) b t +shiftForTicks' p (Ticks _ _) (Ticks _ _) ax sd tf v = do + to <- asks (_textoptions . _renderoptions) + pc <- asks _pangocontext + (tw,th) <- cairo $ do + let s = Printf.printf tf v + lt <- pango $ P.layoutText pc s + setTextOptions (scaleFontSize tickLabelScale to) lt + (_,twh) <- textSize lt Centre Middle 0 0 + return twh + shiftForTicks'' p (tw,th) ax sd + where shiftForTicks'' (Padding l r b t) (_,th) XAxis (Side Lower) = do + bbRaiseBottom (majorTickLength+th+2*textPad) + return $ Padding l r (b+majorTickLength+th+2*textPad) t + shiftForTicks'' (Padding l r b t) (tw,_) YAxis (Side Lower) = do + bbShiftLeft (majorTickLength+tw+2*textPad) + return $ Padding (l+majorTickLength+tw+2*textPad) r b t + shiftForTicks'' (Padding l r b t) (_,th) XAxis (Side Upper) = do + bbLowerTop (majorTickLength+th+2*textPad) + return $ Padding l r b (t+majorTickLength+th+2*textPad) + shiftForTicks'' (Padding l r b t) (tw,_) YAxis (Side Upper) = do + bbShiftRight (majorTickLength+tw+2*textPad) + return $ Padding l (r+majorTickLength+tw+2*textPad) b t + shiftForTicks'' p' (_,_) _ (Value _) = return p' + +renderAxis :: Ranges -> AxisData -> Render () +renderAxis _ (Axis _ _ NoLine _ _ _ _) = return () +renderAxis r (Axis ax sd + (ColourLine c) + min maj tf l) = do + lo <- asks (_lineoptions . _renderoptions) + renderAxis r (Axis ax sd (TypeLine lo c) min maj tf l) +renderAxis r (Axis ax sd + (TypeLine (LineOptions ds lw) c) + min maj tf _) = do + cairo $ do + setColour c + setDashes ds + C.setLineWidth lw + renderAxisLine r ax sd + cairo $ do + lw' <- C.getLineWidth + C.setLineWidth (lw'/2) + renderAxisTicks r ax sd min maj tf + return () + +lowerRange :: Either Range (Range,Range) -> Range +lowerRange (Left r@(Range _ _)) = r +lowerRange (Right (r@(Range _ _),_)) = r + +renderAxisLine :: Ranges -> AxisType -> AxisPosn -> Render () +renderAxisLine (Ranges _ yr) XAxis (Value v) = do + let (Range min max) = lowerRange yr + (BoundingBox x y w h) <- get + cairo $ do + C.moveTo x (y+h*((v-min)/(max-min))) + C.lineTo (x+w) (y+h*((v-min)/(max-min))) + C.stroke +renderAxisLine (Ranges xr _) YAxis (Value v) = do + let (Range min max) = lowerRange xr + (BoundingBox x y w h) <- get + cairo $ do + C.moveTo (x+w*((v-min)/(max-min))) y + C.lineTo (x+w*((v-min)/(max-min))) (y+h) + C.stroke +renderAxisLine _ XAxis (Side Lower) = do + (BoundingBox x y _ h) <- get + cairo $ do + C.moveTo x y + C.lineTo x (y+h) + C.stroke +renderAxisLine _ XAxis (Side Upper) = do + (BoundingBox x y w h) <- get + cairo $ do + C.moveTo (x+w) y + C.lineTo (x+w) (y+h) + C.stroke +renderAxisLine _ YAxis (Side Lower) = do + (BoundingBox x y w h) <- get + cairo $ do + C.moveTo x (y+h) + C.lineTo (x+w) (y+h) + C.stroke +renderAxisLine _ YAxis (Side Upper) = do + (BoundingBox x y w _) <- get + cairo $ do + C.moveTo x (y) + C.lineTo (x+w) (y) + C.stroke + +tickPosition :: Double -> Double -> Int -> [Double] +tickPosition min max n = map (\x -> min + (max-min)*(fromIntegral x)/(fromIntegral (n-1))) (take n [(0 :: Int)..]) +{- +tickPosition min max n = let diff = max - min + (sc,sd) = scaleDiff 1.0 diff n + start = (round (min*sc)) `div` (fromIntegral sd) + in map (\x -> (fromIntegral (x*sd+start))/sc) (take n [0..]) + where scaleDiff :: Double -> Double -> Int -> (Double,Int) + scaleDiff s diff n + | (round (s*diff)) < n = scaleDiff (10*s) (10*diff) n + | otherwise = (s,(round diff) `div` n) +-} +renderAxisTicks :: Ranges -> AxisType -> AxisPosn -> Ticks -> Ticks -> TickFormat -> Render () +renderAxisTicks (Ranges xrange yrange) ax sd + (Ticks gmin (Left tmin)) (Ticks gmaj (Left tmaj)) tf = do + (BoundingBox x y w h) <- get + to <- asks (_textoptions . _renderoptions) + pc <- asks _pangocontext + cairo $ do + let (min,max) = case ax of + XAxis -> case sd of + (Side Lower) -> case xrange of + (Left (Range xmin xmax)) -> (xmin,xmax) + (Right (Range xmin xmax,_)) -> (xmin,xmax) + (Side Upper) -> case xrange of + (Left (Range xmin xmax)) -> (xmin,xmax) + (Right (_,Range xmin xmax)) -> (xmin,xmax) + (Value _) -> case xrange of + (Left (Range xmin xmax)) -> (xmin,xmax) + (Right (Range xmin xmax,_)) -> (xmin,xmax) + YAxis -> case sd of + (Side Lower) -> case yrange of + (Left (Range ymin ymax)) -> (ymin,ymax) + (Right (Range ymin ymax,_)) -> (ymin,ymax) + (Side Upper) -> case yrange of + (Left (Range ymin ymax)) -> (ymin,ymax) + (Right (_,Range ymin ymax)) -> (ymin,ymax) + (Value _) -> case yrange of + (Left (Range ymin ymax)) -> (ymin,ymax) + (Right (Range ymin ymax,_)) -> (ymin,ymax) + -- convert axis position to non-data coordinates + let sd' = case sd of + (Side _) -> sd + (Value v) -> case ax of + XAxis -> let (Range b t) = lowerRange yrange + in Value (y+h*(t-v)/(t-b)) + YAxis -> let (Range b t) = lowerRange xrange + in Value (x+w*(v-b)/(t-b)) + let pos = (tickPosition min max tmaj) + let majpos = let ones = 1.0 : ones + ln = length pos + in zip pos (take ln ones) + minpos' = zip (tickPosition min max tmin) (minorTickLengths tmin tmaj) + minpos = filter (not . (\(p,_) -> elem p pos)) minpos' + let renderAxisTick' = renderAxisTick pc to x y w h min max ax sd' tf + mapM_ (renderAxisTick' Minor gmin) minpos + mapM_ (renderAxisTick' Major gmaj) majpos + return () + return () + +minorTickLengths :: Int -> Int -> [Double] +minorTickLengths min maj = let num = (min-1) `div` (maj-1) + in map ((/ 2) . (+ 1) . (* 2) . (/ (fromIntegral num)) . fromIntegral . (\x -> if x > (num `div` 2) then num - x else x) . (`mod` num)) (take (min+1) [0..]) + --map ((/) 2 . (+) 1 . (/) (fromIntegral tmaj) . fromIntegral . (mod tmaj)) (take (tmin+1) [0..]) + +renderAxisTick :: P.PangoContext -> TextOptions + -> Double -> Double -> Double -> Double -> Double -> Double + -> AxisType -> AxisPosn -> TickFormat -> Tick -> GridLines + -> (Double,Double) -> C.Render () +renderAxisTick pc to x y w h min max xa sd tf t gl (p,l) = do + let tl' = case t of + Minor -> minorTickLength + Major -> majorTickLength + tl = tl' * l + (x1,y1,x2,y2) = case xa of + XAxis -> case sd of + (Side _) -> let xt x' = x + x'*w/(max-min) + ys = if gl then y else y + h + in (xt p,ys,xt p,y+h+tl) + (Value v) -> let xt x' = x + x'*w/(max-min) + yb = if gl then y else v-tl + yt = if gl then y+h else v+tl + in (xt p,yb,xt p,yt) + YAxis -> case sd of + (Side _) -> let xf = if gl then x + w else x + yt y' = (y + h) - (y'-min)*h/(max-min) + in (x-tl,yt p,xf,yt p) + (Value v) -> let xb = if gl then x else v-tl + xt = if gl then x+h else v+tl + yt y' = (y + h) - (y'-min)*h/(max-min) + in (xb,yt p,xt,yt p) + C.moveTo x1 y1 + C.lineTo x2 y2 + C.stroke + let majlab = case sd of + (Side _) -> True + (Value _) -> False + when (t == Major && majlab) $ do + let s = Printf.printf tf p + lo <- pango $ P.layoutText pc s + setTextOptions (scaleFontSize tickLabelScale to) lo + case xa of + XAxis -> do + ((x',y'),_) <- textSize lo Centre TTop x1 (y2+textPad) + showText lo x' y' + YAxis -> do + ((x',y'),_) <- textSize lo TLeft Middle (x1-textPad) y1 + showText lo x' y' + return () + diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs new file mode 100644 index 0000000..f968549 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs @@ -0,0 +1,327 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render.Plot.Data +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Rendering 'Figure's +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Render.Plot.Data ( + -- * Rendering + renderData + ) where + +----------------------------------------------------------------------------- + +--import Data.Either + +import Data.Packed.Vector +import Data.Packed() +import Numeric.LinearAlgebra.Linear + +--import Data.Word + +--import Data.Maybe + +--import Data.Colour.SRGB +--import Data.Colour.Names + +import qualified Data.Array.IArray as A + +import qualified Graphics.Rendering.Cairo as C +import qualified Graphics.Rendering.Cairo.Matrix as CM +--import qualified Graphics.Rendering.Pango as P + +import Control.Monad.Reader +import Control.Monad.State +--import Control.Monad.Trans +import Control.Monad.Maybe + +import Graphics.Rendering.Plot.Types +--import Graphics.Rendering.Plot.Defaults + +--import Graphics.Rendering.Plot.Figure.Text + +import Graphics.Rendering.Plot.Render.Types + +--import qualified Text.Printf as Printf + +import Prelude hiding(min,max,abs) +--import qualified Prelude(max) + +----------------------------------------------------------------------------- + +findMinIdx, findMaxIdx :: Vector Double -> Double -> Int -> Int -> Int +findMinIdx v x n max + | n >= max = error "data not in range" + | v @> n >= x = n + | otherwise = findMinIdx v x (n+1) max + +findMaxIdx v x n min + | n < 0 = error "data not in range" + | v @> n <= x = n + | otherwise = findMaxIdx v x (n-1) min + +flipVerticalMatrix :: CM.Matrix +flipVerticalMatrix = CM.Matrix 1 0 0 (-1) 0 0 + +flipVertical :: C.Render () +flipVertical = C.transform flipVerticalMatrix + +----------------------------------------------------------------------------- + +renderData :: Ranges -> PlotType -> DataSeries -> Annotations -> Render () +renderData r@(Ranges (Left (Range xmin xmax)) (Left (Range ymin ymax))) + Linear + (DS_1toN abs ys) + an = do + (BoundingBox x y w h) <- get + let xscale = w/(xmax-xmin) + yscale = h/(ymax-ymin) + -- transform to data coordinates + cairo $ do + C.translate x (y+h) + C.scale xscale yscale + C.translate xmin ymin + flipVertical + mapM_ (renderSeries r xscale yscale) (zip (repeat abs) (A.elems ys)) + renderAnnotations an + +renderSeries :: Ranges -> Double -> Double -> (Abscissae, DecoratedSeries) -> Render () +renderSeries (Ranges (Left (Range xmin xmax)) _) + xscale yscale ((AbsPoints t),(DecSeries o d)) = do + dat <- case o of + (OrdFunction f) -> do + (BoundingBox _ _ w _) <- get + let ts = linspace (round w) (xmin,xmax) + return $ [(ts,mapVector f ts)] + (OrdPoints (Plain o')) -> return $ [(t,o')] + (OrdPoints (Error o' (l,h))) -> return $ [(t,o'),(t,o'-l),(t,o'+h)] + case d of + (DecLine lt) -> do + formatLineSeries lt xscale yscale + mapM_ (\(t',y') -> renderSamples xmin xmax renderLineSample endLineSample t' y') dat + (DecPoint pt) -> do + g <- formatPointSeries pt xscale yscale + let gs = g : Bot : Top : [] + mapM_ (\(g',(t',y')) -> renderSamples xmin xmax (renderPointSample xscale yscale g') endPointSample t' y') (zip gs dat) + (DecLinPt lt pt) -> do + formatLineSeries lt xscale yscale + mapM_ (\(t',y') -> renderSamples xmin xmax renderLineSample endLineSample t' y') dat + g <- formatPointSeries pt xscale yscale + let gs = g : Bot : Top : [] + mapM_ (\(g',(t',y')) -> renderSamples xmin xmax (renderPointSample xscale yscale g') endPointSample t' y') (zip gs dat) + return () + +----------------------------------------------------------------------------- + +formatLineSeries' :: [Dash] -> LineWidth -> Color -> C.Render () +formatLineSeries' ds lw c = do + setDashes ds + C.setLineWidth lw + setColour c + +formatLineSeries :: LineType -> Double -> Double -> Render () +formatLineSeries NoLine _ _ = error "line format of NoLine in a line series" +formatLineSeries (ColourLine c) xscale yscale = do + (LineOptions ds lw) <- asks (_lineoptions . _renderoptions) + cairo $ formatLineSeries' ds ((lw)/(xscale+yscale)) c +formatLineSeries (TypeLine (LineOptions ds lw) c) xscale yscale = cairo $ formatLineSeries' ds ((lw)/(xscale+yscale)) c + +formatPointSeries' :: LineWidth -> Color -> C.Render () +formatPointSeries' lw c = do + C.setLineWidth lw + setColour c + +formatPointSeries :: PointType -> Double -> Double -> Render Glyph +formatPointSeries (FullPoint (PointOptions pz c) g) xscale yscale = do + cairo $ formatPointSeries' ((pz)/((xscale+yscale)/2)) c + return g + + +----------------------------------------------------------------------------- + +renderSamples :: Double -> Double + -> (Double -> Double -> C.Render ()) -> C.Render () + -> Vector Double -> Vector Double -> Render () +renderSamples xmin xmax f e t y = do + (BoundingBox _ _ w _) <- get + let ln = dim t + xmin_ix = findMinIdx t xmin 0 (ln-1) + xmax_ix = findMaxIdx t xmax (ln-1) 0 + num_pts = xmax_ix - xmin_ix + 1 + diff' = (fromIntegral num_pts)/w + diff = round $ if diff' <= 1 then 1 else diff' + cairo $ do + C.moveTo (t @> xmin_ix) (y @> xmin_ix) + _ <- runMaybeT $ mapVectorWithIndexM_ (\i y' -> do + when (i >= xmin_ix && i `mod` diff == 0) + (do + renderSample i xmax_ix t f e y') + return ()) y + return () + +----------------------------------------------------------------------------- + +renderSample :: Int -> Int -> Vector Double + -> (Double -> Double -> C.Render ()) -> C.Render () + -> Double -> MaybeT C.Render () +renderSample ix xmax_ix t f e y + | ix >= xmax_ix = do + lift $ do + f (t @> ix) y + e + fail "end of bounded area" + | otherwise = do + lift $ f (t @> ix) y + +----------------------------------------------------------------------------- + +renderLineSample :: Double -> Double -> C.Render () +renderLineSample = C.lineTo + +endLineSample :: C.Render () +endLineSample = C.stroke + +renderPointSample :: Double -> Double -> Glyph -> Double -> Double -> C.Render () +renderPointSample xscale yscale g x y = do + C.moveTo x y + renderGlyph xscale yscale g + +endPointSample :: C.Render () +endPointSample = return () + +----------------------------------------------------------------------------- + +renderAnnotations :: [Annotation] -> Render () +renderAnnotations _ = return () + +----------------------------------------------------------------------------- + +glyphWidth :: Double +glyphWidth = 2*pi + +renderGlyph :: Double -> Double -> Glyph -> C.Render () +renderGlyph xscale yscale Box = renderGlyphBox xscale yscale +renderGlyph xscale yscale Cross = renderGlyphCross xscale yscale +renderGlyph xscale yscale Diamond = renderGlyphDiamond xscale yscale +renderGlyph xscale yscale Asterisk = renderGlyphAsterisk xscale yscale +renderGlyph xscale yscale Triangle = renderGlyphTriangle xscale yscale +renderGlyph xscale yscale Circle = renderGlyphCircle xscale yscale +renderGlyph xscale yscale Top = renderGlyphTop xscale yscale +renderGlyph xscale yscale Bot = renderGlyphBot xscale yscale +--renderGlyph _ _ _ = return () + +difference :: Num a => [a] -> [a] +difference [] = [] +difference [_] = [] +difference (x0:x1:xs) = (x1-x0):(difference (x1:xs)) + +renderGlyphBox :: Double -> Double -> C.Render () +renderGlyphBox xscale yscale = do + let x = glyphWidth/xscale + y = glyphWidth/yscale + C.relMoveTo (-x/2) (-y/2) + C.relLineTo 0 y + C.relLineTo x 0 + C.relLineTo 0 (-y) + C.closePath + C.stroke + +renderGlyphCross :: Double -> Double -> C.Render () +renderGlyphCross xscale yscale = do + let x = glyphWidth/xscale + y = glyphWidth/yscale + C.relMoveTo (-x/2) 0 + C.relLineTo x 0 + C.relMoveTo (-x/2) (-y/2) + C.relLineTo 0 y + C.closePath + C.stroke + +renderGlyphDiamond :: Double -> Double -> C.Render () +renderGlyphDiamond xscale yscale = do + let x = glyphWidth/xscale + y = glyphWidth/yscale + C.relMoveTo (-x/2) 0 + C.relLineTo (x/2) y + C.relLineTo (x/2) (-y) + C.relLineTo (-x/2) (-y) + C.closePath + C.stroke + +renderGlyphAsterisk :: Double -> Double -> C.Render () +renderGlyphAsterisk xscale yscale = do + let radius = glyphWidth/2 + angles' = map ((+ 90) . (* (360 `div` 5))) [0..4] + angles = map ((* (2*pi/360)) . fromInteger . (`mod` 360)) angles' + xs = map ((* (radius/xscale)) . cos) angles + ys = map ((* (radius/yscale)) . sin) angles + mapM_ (\(x,y) -> do + C.relLineTo x y + C.relMoveTo (-x) (-y)) (zip xs ys) + C.stroke + +renderGlyphTriangle :: Double -> Double -> C.Render () +renderGlyphTriangle xscale yscale = do + let radius = glyphWidth/2 + angles' = [90,210,330] + --angles' = map ((flip (+) 90) . (* (360 `div` 3))) [0..2] + angles = map ((* (2*pi/360)) . fromInteger . (`mod` 360)) angles' + x@(sx:_) = map ((* (radius/xscale)) . cos) angles + y@(sy:_) = map ((* (radius/yscale)) . sin) angles + xs = difference x + ys = difference y + C.relMoveTo sx sy + mapM_ (uncurry C.relLineTo) (zip xs ys) + C.closePath + C.stroke + +renderGlyphCircle :: Double -> Double -> C.Render () +renderGlyphCircle xscale yscale = do + let radius = glyphWidth/2 + angles = map (*(2*pi/36)) [0..35] + x@(sx:_) = map ((* (radius/xscale)) . cos) angles + y@(sy:_) = map ((* (radius/yscale)) . sin) angles + xs = difference x + ys = difference y + C.relMoveTo sx sy + mapM_ (uncurry C.relLineTo) (zip xs ys) + C.closePath + C.stroke + +renderGlyphTop :: Double -> Double -> C.Render () +renderGlyphTop xscale yscale = do + let x = glyphWidth/xscale + y = glyphWidth/yscale + C.relMoveTo (-x/2) 0 + C.relLineTo x 0 + C.relMoveTo (-x/2) 0 + C.relLineTo 0 (-y) + C.stroke + +renderGlyphBot :: Double -> Double -> C.Render () +renderGlyphBot xscale yscale = do + let x = glyphWidth/xscale + y = glyphWidth/yscale + C.relMoveTo (-x/2) 0 + C.relLineTo x 0 + C.relMoveTo (-x/2) 0 + C.relLineTo 0 (y) + C.stroke + + + + + + + +----------------------------------------------------------------------------- + + diff --git a/lib/Graphics/Rendering/Plot/Render/Text.hs b/lib/Graphics/Rendering/Plot/Render/Text.hs new file mode 100644 index 0000000..4f925d0 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Text.hs @@ -0,0 +1,154 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render.Text +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Rendering 'Figure's +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Render.Text ( + -- * Rendering + renderText + , renderTextVertical + -- * Internal + , textSize + , textSizeVertical + , showText + , formatText + ) where + +----------------------------------------------------------------------------- + +--import Data.Either + +--import Data.Packed.Vector +--import Numeric.LinearAlgebra.Linear + +--import Data.Word + +--import Data.Maybe + +--import Data.Colour.SRGB +--import Data.Colour.Names + +---import qualified Data.Array.IArray as A + +import qualified Graphics.Rendering.Cairo as C +import qualified Graphics.Rendering.Pango as P + +import Control.Monad.Reader +--import Control.Monad.State +--import Control.Monad.Trans + +import Graphics.Rendering.Plot.Types +--import Graphics.Rendering.Plot.Defaults + +import Graphics.Rendering.Plot.Figure.Text + +import Graphics.Rendering.Plot.Render.Types + +--import qualified Text.Printf as Printf + +--import Prelude hiding(min,max) +--import qualified Prelude(max) + +----------------------------------------------------------------------------- + +textSize :: P.PangoLayout -> TextXAlign -> TextYAlign -> Double -> Double -> C.Render ((Double,Double),(Double,Double)) +textSize l xa ya x y = do + (_,P.PangoRectangle _ _ w h) <- pango $ P.layoutGetExtents l + return ((xStart xa x w h,yStart ya y h h),(w,h)) + where xStart TLeft x' w' _ = x' - w' + xStart Centre x' w' _ = x' - (w'/2) + xStart TRight x' _ _ = x' + yStart TBottom y' _ h' = y' - h' + yStart Middle y' _ h' = y' - (h'/2) + yStart TTop y' _ _ = y' + +textSizeVertical :: P.PangoLayout -> TextXAlign -> TextYAlign -> Double -> Double -> C.Render ((Double,Double),(Double,Double)) +textSizeVertical l xa ya x y = do + (_,P.PangoRectangle _ _ w h) <- pango $ P.layoutGetExtents l + return ((xStart xa x w h,yStart ya y w h),(w,h)) + where xStart TLeft x' _ w' = x' - w' + xStart Centre x' _ w' = x' - (w'/2) + xStart TRight x' _ _ = x' + yStart TBottom y' _ _ = y' + yStart Middle y' h' _ = y' + (h'/2) + yStart TTop y' h' _ = y' + (h') + +showText :: P.PangoLayout -> Double -> Double -> C.Render () +showText pl x y = do + C.moveTo x y + P.showLayout pl + +----------------------------------------------------------------------------- + +formatText :: TextEntry -> Render TextEntry +formatText te@NoText = return te +formatText (BareText s) = do + to <- asks (_textoptions . _renderoptions) + return (FontText to s) +formatText (SizeText fz c s) = do + to <- asks (_textoptions . _renderoptions) + return $ (FontText (changeFontSize fz $ changeFontColour c to) s) +formatText te@(FontText _ _) = return te + +{- +getTextSize :: Text -> Render (Double,Double) +getTextSize (Text Nothing s) = do + to <- asks _text + getTextSize (Text to s) +getTextSize (Text (Just (TextOptions (FontOptions ff fs fw) fz _)) s) = cairo $ do + C.selectFontFace ff fs fw + C.setFontSize fz + te <- C.textExtents s + return (C.textExtentsWidth te,C.textExtentsHeight te) +-} +renderText :: TextEntry -> TextXAlign -> TextYAlign -> Double -> Double -> Render (Double,Double) +renderText NoText _ _ _ _ = return (0,0) +renderText te@(BareText _) xa ya x y = do + te' <- formatText te + renderText te' xa ya x y +renderText te@(SizeText _ _ _) xa ya x y = do + te' <- formatText te + renderText te' xa ya x y +renderText (FontText to s) xa ya x y = do + pc <- asks _pangocontext + cairo $ do + lo <- pango $ P.layoutText pc s + setTextOptions to lo + ((x',y'),twh) <- textSize lo xa ya x y + showText lo x' y' + return twh + +renderTextVertical :: TextEntry -> TextXAlign -> TextYAlign -> Double -> Double -> Render (Double,Double) +renderTextVertical NoText _ _ _ _ = return (0,0) +renderTextVertical (BareText s) xa ya x y = do + to <- asks (_textoptions . _renderoptions) + renderTextVertical (FontText to s) xa ya x y +renderTextVertical (SizeText fz c s) xa ya x y = do + to <- asks (_textoptions . _renderoptions) + renderTextVertical (FontText (changeFontSize fz $ + changeFontColour c to) s) xa ya x y +renderTextVertical (FontText to s) xa ya x y = do + pc <- asks _pangocontext + cairo $ do + lo <- pango $ P.layoutText pc s + setTextOptions to lo + C.moveTo x y + C.save + C.rotate (-pi/2) + --P.updateContext pc + P.updateLayout lo + ((x',y'),twh) <- textSizeVertical lo xa ya x y + showText lo (-y') (-x') + C.restore + return twh + +----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Render/Types.hs b/lib/Graphics/Rendering/Plot/Render/Types.hs new file mode 100644 index 0000000..4084723 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Types.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render.Types +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Rendering 'Figure's +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Render.Types where + +----------------------------------------------------------------------------- + +--import Data.Either + +--import Data.Packed.Vector +--import Numeric.LinearAlgebra.Linear + +--import Data.Word + +import Data.Maybe + +import Data.Colour.SRGB +import Data.Colour.Names + +--import qualified Data.Array.IArray as A + +import qualified Graphics.Rendering.Cairo as C +import qualified Graphics.Rendering.Pango as P + +import Control.Monad.Reader +import Control.Monad.State +--import Control.Monad.Trans + +import Graphics.Rendering.Plot.Types +import Graphics.Rendering.Plot.Defaults + +--import Graphics.Rendering.Plot.Figure.Text + +--import qualified Text.Printf as Printf + +--import Prelude hiding(min,max) +--import qualified Prelude(max) + +----------------------------------------------------------------------------- +{- +newtype Render a = FR { runRender :: StateT BoundingBox C.Render a } + deriving(Monad, MonadState BoundingBox, MonadTrans (StateT BoundingBox)) +-} + +data RenderEnv = RenderEnv { + _pangocontext :: P.PangoContext + , _renderoptions :: Options + } + +newtype BoundedT m a = BT { runRender :: ReaderT RenderEnv (StateT BoundingBox m) a } + deriving(Monad, MonadState BoundingBox, MonadReader RenderEnv) + +instance MonadTrans BoundedT where + lift m = BT $ lift $ lift m + +type Render = BoundedT C.Render + +evalRender :: Render a -> RenderEnv -> BoundingBox -> C.Render a +evalRender m r = evalStateT (runReaderT (runRender m) r) + +----------------------------------------------------------------------------- + +cairo :: C.Render a -> Render a +cairo = lift + +pango :: IO a -> C.Render a +pango = liftIO + +----------------------------------------------------------------------------- + +bbX, bbY, bbW, bbH :: Render Double +bbX = gets _bbX +bbY = gets _bbY +bbW = gets _bbW +bbH = gets _bbH + +bbLeftWidth, bbCentreWidth, bbRightWidth, bbBottomHeight, bbCentreHeight, bbTopHeight :: Render Double +bbLeftWidth = gets $ \(BoundingBox x _ _ _) -> x +bbCentreWidth = gets $ \(BoundingBox x _ w _) -> x + w / 2 +bbRightWidth = gets $ \(BoundingBox x _ w _) -> x + w +bbBottomHeight = gets $ \(BoundingBox _ y _ h) -> y + h +bbCentreHeight = gets $ \(BoundingBox _ y _ h) -> y + h / 2 +bbTopHeight = gets $ \(BoundingBox _ y _ _) -> y + +bbShiftLeft, bbShiftRight, bbLowerTop, bbRaiseBottom :: Double -> Render () +bbShiftLeft n = modify $ \(BoundingBox x y w h) -> BoundingBox (x+n) y (w-n) h +bbShiftRight n = modify $ \(BoundingBox x y w h) -> BoundingBox x y (w-n) h +bbLowerTop n = modify $ \(BoundingBox x y w h) -> BoundingBox x (y+n) w (h-n) +bbRaiseBottom n = modify $ \(BoundingBox x y w h) -> BoundingBox x y w (h-n) + +applyPads :: Padding -> Render () +applyPads (Padding l r b t) = modify (\(BoundingBox x y w h) -> BoundingBox (x+l) (y+t) (w-l-r) (h-t-b)) + +----------------------------------------------------------------------------- + +clipBoundary :: Render () +clipBoundary = do + (BoundingBox x y w h) <- get + cairo $ do + C.moveTo x y + C.lineTo x (y+h) + C.lineTo (x+w) (y+h) + C.lineTo (x+w) y + C.closePath + C.clip + +----------------------------------------------------------------------------- + +-- | output file type +data OutputType = PNG | PS | PDF | SVG + +----------------------------------------------------------------------------- + +setColour :: Color -> C.Render () +setColour c = let (RGB r g b) = toSRGB c + in C.setSourceRGB r g b + + +setDashes :: [Dash] -> C.Render () +setDashes [] = C.setDash [] 0 +setDashes xs = do + let xs' = concat $ map (\d -> case d of { Dot -> [0.2,0.3] ; Dash -> [0.6,0.3] }) xs + C.setDash xs' 0 + +----------------------------------------------------------------------------- + +getDefaultTextOptions :: P.PangoContext -> C.Render TextOptions +getDefaultTextOptions pc = do + fd <- pango $ P.contextGetFontDescription pc + getTextOptionsFD fd + +getTextOptionsFD :: P.FontDescription -> C.Render TextOptions +getTextOptionsFD fd = do + ff' <- pango $ P.fontDescriptionGetFamily fd + fs' <- pango $ P.fontDescriptionGetStyle fd + fv' <- pango $ P.fontDescriptionGetVariant fd + fw' <- pango $ P.fontDescriptionGetWeight fd + fc' <- pango $ P.fontDescriptionGetStretch fd + fz' <- pango $ P.fontDescriptionGetSize fd + let ff = fromMaybe defaultFontFamily ff' + fs = fromMaybe defaultFontStyle fs' + fv = fromMaybe defaultFontVariant fv' + fw = fromMaybe defaultFontWeight fw' + fc = fromMaybe defaultFontStretch fc' + fz = fromMaybe defaultFontSize fz' + return $ TextOptions (FontOptions ff fs fv fw fc) fz black + +setTextOptions :: TextOptions -> P.PangoLayout -> C.Render () +setTextOptions to lo = do + fd' <- pango $ P.layoutGetFontDescription lo + fd <- case fd' of + Nothing -> pango $ P.fontDescriptionNew + Just fd'' -> return fd'' + setTextOptionsFD to fd + pango $ P.layoutSetFontDescription lo (Just fd) + +setTextOptionsFD :: TextOptions -> P.FontDescription -> C.Render () +setTextOptionsFD (TextOptions (FontOptions ff fs fv fw fc) fz c) fd = do + pango $ do + P.fontDescriptionSetFamily fd ff + P.fontDescriptionSetStyle fd fs + P.fontDescriptionSetVariant fd fv + P.fontDescriptionSetWeight fd fw + P.fontDescriptionSetStretch fd fc + P.fontDescriptionSetSize fd fz + setColour c + +----------------------------------------------------------------------------- + +textPad :: Double +textPad = 2 + +data TextXAlign = TLeft | Centre | TRight +data TextYAlign = TBottom | Middle | TTop + +----------------------------------------------------------------------------- + + diff --git a/lib/Graphics/Rendering/Plot/Types.hs b/lib/Graphics/Rendering/Plot/Types.hs new file mode 100644 index 0000000..84b5c0a --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Types.hs @@ -0,0 +1,367 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Types +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Types +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Types where + +----------------------------------------------------------------------------- + +import Data.Packed.Vector + +import Data.Colour.SRGB +import Data.Colour() + +import qualified Data.Array.IArray as A + +import qualified Graphics.Rendering.Pango as P + +import Control.Monad.State +import Control.Monad.Reader + +import Control.Monad.Supply + +----------------------------------------------------------------------------- +----------------------------------------------------------------------------- +----------------------------------------------------------------------------- + +type Color = Colour Double + +----------------------------------------------------------------------------- + +-- x,y,w,h +data BoundingBox = BoundingBox { _bbX :: Double, _bbY :: Double + , _bbW :: Double, _bbH :: Double } + +----------------------------------------------------------------------------- + +type FontFamily = String +type FontSize = Double +data FontOptions = FontOptions FontFamily P.FontStyle P.Variant P.Weight P.Stretch +data TextOptions = TextOptions FontOptions FontSize Color +data TextEntry = NoText + | BareText String + | SizeText FontSize Color String + | FontText TextOptions String + +----------------------------------------------------------------------------- + +newtype Text a = FT { runText :: ReaderT TextOptions (State TextEntry) a} + deriving(Monad, MonadReader TextOptions, MonadState TextEntry) + +execText :: Text a -> TextOptions -> TextEntry -> TextEntry +execText m r = execState (runReaderT (runText m) r) + +----------------------------------------------------------------------------- + +type Solid = Bool + +type PointSize = Double +data Glyph = Box | Cross | Diamond | Asterisk | Triangle | Circle | Top | Bot + deriving(Show) +--data GlyphType = Glyph Glyph Solid +data PointOptions = PointOptions PointSize Color + deriving(Show) +data PointType = FullPoint PointOptions Glyph + deriving(Show) + +----------------------------------------------------------------------------- + +newtype Point a = FG { runPoint :: ReaderT PointOptions (State PointType) a} + deriving(Monad, MonadReader PointOptions, MonadState PointType) + +execPoint :: Point a -> PointOptions -> PointType -> PointType +execPoint m r = execState (runReaderT (runPoint m) r) + +----------------------------------------------------------------------------- + +data Dash = Dot | Dash + deriving(Show) +type DashStyle = [Dash] +type LineWidth = Double +-- not using line join +-- not using line cap +-- do we want arrows? +data LineOptions = LineOptions DashStyle LineWidth + deriving(Show) + +data LineType = NoLine + | ColourLine Color + | TypeLine LineOptions Color + deriving(Show) + +----------------------------------------------------------------------------- + +newtype Line a = FL { runLine :: ReaderT LineOptions (State LineType) a} + deriving(Monad, MonadReader LineOptions, MonadState LineType) + +execLine :: Line a -> LineOptions -> LineType -> LineType +execLine m r = execState (runReaderT (runLine m) r) + +----------------------------------------------------------------------------- + +type Length = Double +type Location = (Double,Double) +type Orientation = Double -- angle +type Arrow = Bool + +-- extra glyphs and so on that can be put in a chart +data AnnoteType = AT_Text TextEntry + | AT_Glyph Glyph + | AT_Arrow Arrow LineOptions Length + +data Annotation = Annotation AnnoteType Location Orientation Color +type Annotations = [Annotation] + +----------------------------------------------------------------------------- + +data Range = Range { _range_min :: Double, _range_max :: Double } + +data Ranges = Ranges (Either Range (Range,Range)) (Either Range (Range,Range)) + +defaultRanges :: Double -> Double -> Double -> Double -> Ranges +defaultRanges xmin xmax ymin ymax = Ranges (Left (Range xmin xmax)) (Left (Range ymin ymax)) + +----------------------------------------------------------------------------- + +data AxisType = XAxis | YAxis deriving(Eq) +data AxisSide = Lower | Upper deriving(Eq) +data AxisPosn = Side AxisSide + | Value Double + deriving(Eq) + +data Tick = Minor | Major deriving(Eq) + +type GridLines = Bool +type TickValues = Either Int (Vector Double) -- ^ Either (number of ticks) (tick values) +data Ticks = Ticks GridLines TickValues + +type TickFormat = String + +data AxisData = Axis { + _axis_type :: AxisType + , _position :: AxisPosn + , _line_type :: LineType + , _minor_ticks :: Ticks + , _major_ticks :: Ticks + , _tick_format :: TickFormat + , _label :: TextEntry + } +-- want line styles, so that, e.g., axes in centre of chart are grey or dashed etc. + +----------------------------------------------------------------------------- + +newtype Axis a = FA { runAxis :: ReaderT Options (State AxisData) a} + deriving(Monad, MonadReader Options, MonadState AxisData) + +execAxis :: Axis a -> Options -> AxisData -> AxisData +execAxis m r = execState (runReaderT (runAxis m) r) + +----------------------------------------------------------------------------- + +-- need to have same number of entries as data series +data Legend = Legend { + _bounded :: Bool -- is there a box around the legend? + , _location :: Location + , _labels :: (A.Array Int TextEntry) + } +-- do we want a toggle for legends so the labels don't get destroyed? + +----------------------------------------------------------------------------- + +-- simply padding for left, right, bottom, and top +data Padding = Padding Double Double Double Double + +----------------------------------------------------------------------------- + +data Options = Options { + _lineoptions :: LineOptions + , _pointoptions :: PointOptions + , _textoptions :: TextOptions + } + +----------------------------------------------------------------------------- +{- +data LineFormat = LineFormat +data PointFormat = PointFormat +-} +data SeriesType = Line | Point | LinePoint -- Impulse + +----------------------------------------------------------------------------- + +type Series = Vector Double +type ErrorSeries = Series +type Function = (Double -> Double) + +instance Show Function where show _ = "<>" + +data OrdSeries = Plain Series + | Error Series (ErrorSeries,ErrorSeries) + deriving(Show) + +getOrdData :: OrdSeries -> Series +getOrdData (Plain o) = o +getOrdData (Error o _) = o + +data Abscissae = AbsFunction + | AbsPoints Series + deriving(Show) + +data Ordinates = OrdFunction Function + | OrdPoints OrdSeries + deriving(Show) + +data Decoration = DecLine LineType + | DecPoint PointType + | DecLinPt LineType PointType + deriving(Show) + +data DecoratedSeries = DecSeries Ordinates Decoration + deriving(Show) +-- BarSeries Abscissae Ordinates BarType + +data DataSeries = DS_Y (A.Array Int DecoratedSeries) + | DS_1toN Abscissae (A.Array Int DecoratedSeries) + | DS_1to1 (A.Array Int (Abscissae,DecoratedSeries)) + deriving(Show) + +----------------------------------------------------------------------------- + +newtype Data a = FD { runData :: SupplyT SupplyData (ReaderT Options (State DataSeries)) a } + deriving(Monad, MonadSupply SupplyData, MonadReader Options, MonadState DataSeries) + +execData :: Data a -> SupplyData -> Options -> DataSeries -> DataSeries +execData m r s = execState (runReaderT (runSupplyT (runData m) r) s) + + +type FormattedSeries = Data DecoratedSeries + +----------------------------------------------------------------------------- + +data PlotType = Linear -- LogLinear | LinearLog | Log + +--data PlotType = PT_Line + +----------------------------------------------------------------------------- + +type Border = Bool + +----------------------------------------------------------------------------- + +data SupplyData = SupplyData { + _colours :: [Color] + , _glyphs :: [Glyph] + } + +instance Supply SupplyData Color where + nextSupply (SupplyData [] _ ) = error "Empty supply" + nextSupply (SupplyData (c:cs) gs) = (c,SupplyData cs gs) +instance Supply SupplyData Glyph where + nextSupply (SupplyData _ []) = error "Empty supply" + nextSupply (SupplyData cs (g:gs)) = (g,SupplyData cs gs) + +----------------------------------------------------------------------------- + +-- | a plot +data PlotData = Plot { + _border :: Border + , _plot_pads :: Padding + , _heading :: TextEntry + , _ranges :: Ranges + , _axes :: [AxisData] + , _type :: PlotType + , _data :: DataSeries + , _legend :: Maybe Legend + , _annote :: Annotations + } + +----------------------------------------------------------------------------- + +type Plots = A.Array (Int,Int) (Maybe PlotData) + +----------------------------------------------------------------------------- + +newtype Plot a = FP { runPlot :: SupplyT SupplyData (ReaderT Options (State PlotData)) a } + deriving(Monad, MonadReader Options, MonadSupply SupplyData, MonadState PlotData) + +execPlot :: Plot a -> SupplyData -> Options -> PlotData -> PlotData +execPlot m s r = execState (runReaderT (runSupplyT (runPlot m) s) r) + +----------------------------------------------------------------------------- + +dataInPlot' :: State DataSeries a -> State PlotData a +dataInPlot' m = State $ \s -> let (a,d') = runState m (_data s) + in (a,s { _data = d'}) + +dataInPlot :: Data a -> Plot a +dataInPlot m = FP $ mapSupplyT (mapReaderT dataInPlot') (runData m) + +----------------------------------------------------------------------------- + +-- | a chart has a title and contains one or more plots +data FigureData = Figure { + _fig_pads :: Padding + , _title :: TextEntry + , _subtitle :: TextEntry + , _plots :: Plots + } + +----------------------------------------------------------------------------- + +data FigureState = FigureState { + _defaults :: Options + , _supplies :: SupplyData + , _figure :: FigureData + } + +newtype Figure a = FC { runFigure :: State FigureState a } + deriving(Monad, MonadState FigureState) + +----------------------------------------------------------------------------- + +execFigure :: Figure a -> FigureState -> FigureState +execFigure g = execState (runFigure g) + +getFigure :: Figure FigureData +getFigure = gets _figure + +getDefaults :: Figure Options +getDefaults = gets _defaults + +getSupplies :: Figure SupplyData +getSupplies = gets _supplies + +putFigure :: FigureData -> Figure () +putFigure p = modify $ \s -> s { _figure = p } + +putDefaults :: Options -> Figure () +putDefaults p = modify $ \s -> s { _defaults = p } + +putSupplies :: SupplyData -> Figure () +putSupplies p = modify $ \s -> s { _supplies = p } + +modifyFigure :: (FigureData -> FigureData) -> Figure () +modifyFigure m = modify $ \s -> s { _figure = m (_figure s) } + +modifyDefaults :: (Options -> Options) -> Figure () +modifyDefaults m = modify $ \s -> s { _defaults = m (_defaults s) } + +----------------------------------------------------------------------------- +{-TODO + * eeglab-like data offset in channels up x-axis +-} +----------------------------------------------------------------------------- diff --git a/lib/Test.hs b/lib/Test.hs new file mode 100644 index 0000000..c401846 --- /dev/null +++ b/lib/Test.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverlappingInstances #-} +-- thanks to http://www.muitovar.com/gtk2hs/app1.html + +--module Test where + +import Control.Concurrent +import Control.Concurrent.MVar + +import Control.Monad.Trans + +import Graphics.UI.Gtk hiding(Circle,Cross) +import qualified Graphics.Rendering.Cairo as C +import qualified Graphics.Rendering.Pango as P + +import Data.Colour.Names + +import Data.Packed.Vector +--import Data.Packed.Random +import Data.Packed() + +import qualified Data.Array.IArray as A + +import Numeric.LinearAlgebra.Linear +--import Numeric.LinearAlgebra.Instances +--import Numeric.LinearAlgebra.Interface + +import Numeric.GSL.Statistics + +import Graphics.Rendering.Plot + +import Debug.Trace + +ln = 25 +ts = linspace ln (0,1) +rs = ln |> take ln [0.306399512330476,-0.4243863460546792,-0.20454667402138094,-0.42873761654774106,1.3054721019673694,0.6474765138733175,1.1942346875362946,-1.7404737823144103,0.2607101951530985,-0.26782584645524893,-0.31403631431884504,3.365508546473985e-2,0.6147856889630383,-1.191723225061435,-1.9933460981205509,0.6015225906539229,0.6394073044477114,-0.6030919788928317,0.1832742199706381,0.35532918011648473,0.1982646055874545,1.7928383756822786,-9.992760294442601e-2,-1.401166614128362,-1.1088031929569364,-0.827319908453775,1.0406363628775428,-0.3070345979284644,0.6781735212645198,-0.8431706723519456,-0.4245730055085966,-0.6503687925251668,-1.4775567962221399,0.5587634921497298,-0.6481020127107823,7.313441602898768e-2,0.573580543636529,-0.9036472376122673,2.650805059813826,9.329324044673039e-2,1.9133487025468563,-1.5366337588254542,-1.0159359710920388,7.95982933517428e-2,0.5813673663649735,-6.93329631989878e-2,1.1024137719307867,-0.6046286796589855,-0.8812842030098401,1.4612246471009083,0.9584060744500491,9.210899579679932e-2,-0.15850413664405813,-0.4754694827227343,0.8669922262489788,0.4593351854708853,-0.2015350278936992,0.8829710664887649,0.7195048491420026] + +ss = sin (15*2*pi*ts) +ds = 0.25*rs + ss +es = constant (0.25*(stddev rs)) ln + +fs :: Double -> Double +fs = sin . (15*2*pi*) + +figure = do + withTextDefaults $ setFontFamily "OpenSymbol" + withTitle $ setText "Testing plot package:" + withSubTitle $ do + setText "with 1 second of a 15Hz sine wave" + setFontSize 10 + setPlots 1 1 + withPlot (1,1) $ do + setDataset (ts,[point (ds,es) (Cross,red),line fs blue]) + addAxis XAxis (Side Lower) $ withAxisLabel $ setText "time (s)" + addAxis YAxis (Side Lower) $ withAxisLabel $ setText "amplitude" + addAxis XAxis (Value 0) $ return () + setRangeFromData XAxis Lower + setRange YAxis Lower (-1.25) 1.25 + +display :: ((Int,Int) -> C.Render ()) -> IO () +display r = do + initGUI -- is start + + window <- windowNew + set window [ windowTitle := "Cairo test window" + , windowDefaultWidth := 400 + , windowDefaultHeight := 300 + , containerBorderWidth := 1 + ] + +-- canvas <- pixbufNew ColorspaceRgb True 8 300 200 +-- containerAdd window canvas + frame <- frameNew + containerAdd window frame + canvas <- drawingAreaNew + containerAdd frame canvas + widgetModifyBg canvas StateNormal (Color 65535 65535 65535) + + widgetShowAll window + + on canvas exposeEvent $ tryEvent $ do s <- liftIO $ widgetGetSize canvas + drw <- liftIO $ widgetGetDrawWindow canvas + --dat <- liftIO $ takeMVar d + --liftIO $ renderWithDrawable drw (circle 50 10) + liftIO $ renderWithDrawable drw (r s) + + onDestroy window mainQuit + mainGUI + + +main = display $ render figure + +test = writeFigure PDF "test.pdf" (400,400) figure \ No newline at end of file diff --git a/plot.cabal b/plot.cabal new file mode 100644 index 0000000..de82fff --- /dev/null +++ b/plot.cabal @@ -0,0 +1,88 @@ +Name: plot +Version: 0.1 +License: BSD3 +License-file: LICENSE +Copyright: (c) A.V.H. McPhail 2010 +Author: Vivian McPhail +Maintainer: haskell.vivian.mcphail gmail com +Stability: experimental +Homepage: http://code.haskell.org/plot +Synopsis: A library for creating plots, exportable as eps/pdf/svg/png or renderable with gtk +Description: + A package for creating plots, built on top of the Cairo rendering engine. + . + An ambitious attempt to replace gnuplot. + . + Monadic actions are used to configure a figure, which is a (rxc) array of subplots. + Each plot displays a graph with optional heading, labels, legend, and annotations. + The annotations themselves may be used to draw diagrams. + . + A figure is preprocessed in preparation for rendering by the Cairo renderer. + The Cairo library can be used to output the figure to PS, PDF, SVG, and PNG file formats, + or to display the figure in a GTK Drawable context. (see package 'plot-gtk'). + . + The preprocessed figure can be embedded as an arbitrary Cairo render, including in a diagram + created with the diagram package. Conversely, arbitrary Cairo renders can be embedded in + the data region of a 'Figure'. + . + The data series are type "Data.Packed.Vector" from hmatrix, which, when hmatrix + is compiled with '-fvector', is a synonym for "Data.Vector.Storable" from the + vector package and are thus compatible with packages such as statistics. + . + The example in Graphics.Rendering.Plot can be viewed at + + + +Category: Graphics + +Tested-with: GHC==6.12.1 +Cabal-version: >= 1.8 +Build-type: Simple + +Extra-source-files: README, CHANGES, LICENSE, + examples/perturbed-sine.hs, + examples/perturbed-sine.png + +library + + Build-Depends: base >= 4 && < 5, + mtl, array, + MaybeT, + pango >= 0.11.2 && < 0.12, cairo >= 0.11.1 && < 0.12, + colour >= 2.2.1 && < 2.4, + hmatrix >= 0.10 + + Extensions: MultiParamTypeClasses + GeneralizedNewtypeDeriving + TypeSynonymInstances + FlexibleInstances + FlexibleContexts + UndecidableInstances + + hs-source-dirs: lib + Exposed-Modules: Graphics.Rendering.Plot + Graphics.Rendering.Plot.Figure + Graphics.Rendering.Plot.Render + + Other-modules: Graphics.Rendering.Plot.Types + Graphics.Rendering.Plot.Defaults + Graphics.Rendering.Plot.Figure.Line + Graphics.Rendering.Plot.Figure.Point + Graphics.Rendering.Plot.Figure.Text + Graphics.Rendering.Plot.Figure.Plot + Graphics.Rendering.Plot.Figure.Plot.Axis + Graphics.Rendering.Plot.Figure.Plot.Data + Graphics.Rendering.Plot.Render.Types + Graphics.Rendering.Plot.Render.Text + Graphics.Rendering.Plot.Render.Plot + Graphics.Rendering.Plot.Render.Plot.Axis + Graphics.Rendering.Plot.Render.Plot.Data + Control.Monad.Supply + + ghc-options: -Wall -fno-warn-unused-binds + + ghc-prof-options: -auto + + source-repository head + type: darcs + location: darcs get http://code.haskell.org/plot