{-# LANGUAGE TypeFamilies #-}{-# OPTIONS -Wall #-}---------------------------------------------------------------------------------- |-- Module : Wumpus.Basic.Text.LRText-- Copyright : (c) Stephen Tetley 2010-- License : BSD3---- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>-- Stability : highly unstable-- Portability : GHC---- LRText monad - left-to-right text, with kerning.-- -- Note - because Wumpus has no access to the metrics data inside-- a font file, the default spacing is not good and it is -- expected that kerning will need to be added per-letter for-- variable width fonts.---- This module makes precise horizontal text spacing \*possible\*, -- it does not make it \*easy\*.-- --------------------------------------------------------------------------------moduleWumpus.Basic.Text.LRText(LRText,runLRText,execLRText,kern,char,escInt,escName,symb,symbEscInt,symbEscName)whereimportWumpus.Basic.GraphicimportWumpus.Basic.SafeFontsimportWumpus.Basic.Utils.HListimportWumpus.Core-- package: wumpus-coreimportControl.ApplicativeimportControl.MonadimportData.Monoid-- Need a note in wumpus-core and here about space:preserve-- Note - if we have font change (e.g. to symbol font) then we -- have to generate more than one hkernline.-- -- Apropos /optimization/ we have two two simultaneous and -- overlayed lines - one in the regular font, and one in Symbol. ---- Result should be a LocGraphic (so cannot do a trace as we go). ---- Note - the the state tracks two kernlines: one for symbols, dataStu=St{delta_chr::!u,delta_sym::!u,acc_chr::H(KerningCharu),acc_sym::H(KerningCharu)}dataEnvu=Env{char_width::!u,spacer_width::!u}-- Note - unlike Turtle for example, Text is a monad not a -- transformer.---- The rationale for this is to avoid complications percolating -- from the Drawing monad. It Text were built over the Drawing-- monad what would it do on a font change, a colour change...-- -- That say Text must still be run /within/ the Drawing so it -- can take the initial font size, stroke colour etc.--newtypeLRTextua=LRText{getLRText::Envu->Stu->(a,Stu)}typeinstanceMonUnit(LRTextu)=uinstanceFunctor(LRTextu)wherefmapfmf=LRText$\rs->let(a,s')=getLRTextmfrsin(fa,s')instanceApplicative(LRTextu)wherepurea=LRText$\_s->(a,s)mf<*>ma=LRText$\rs->let(f,s')=getLRTextmfrs(a,s'')=getLRTextmars'in(fa,s'')instanceMonad(LRTextu)wherereturna=LRText$\_s->(a,s)m>>=k=LRText$\rs->let(a,s')=getLRTextmrsin(getLRText.k)ars'runLRText::(Numu,FromPtSizeu)=>LRTextua->LocImageuarunLRTextma=\pt->envZero>>=\e1->let(a,st)=getLRTextmae1st_zeroinmklinept(acc_chrst)>>=\g1->localize(fontfacesymbol)(mklinept(acc_symst))>>=\g2->return(a,g1`mappend`g2)wheremklinepth=casetoListHhof[]->returnmemptyxs->hkernlinexsptexecLRText::(Numu,FromPtSizeu)=>LRTextua->LocGraphicuexecLRTextma=\pt->liftMsnd(runLRTextmapt)st_zero::Numu=>Stust_zero=St{delta_chr=0,delta_sym=0,acc_chr=emptyH,acc_sym=emptyH}envZero::FromPtSizeu=>DrawingR(Envu)envZero=(\sz->Env{char_width=fromPtSize$charWidthsz,spacer_width=fromPtSize$spacerWidthsz})<$>fontSizegets::(Stu->a)->LRTextuagetsfn=LRText$\_s->(fns,s)charMove::Numu=>LRTextu()charMove=LRText$\(Env{char_width=cw,spacer_width=sw})s->letstep_width=cw+swd_sym=(delta_syms)+step_widthin((),s{delta_chr=step_width,delta_sym=d_sym})symbMove::Numu=>LRTextu()symbMove=LRText$\(Env{char_width=cw,spacer_width=sw})s->letstep_width=cw+swd_chr=(delta_chrs)+step_widthin((),s{delta_chr=d_chr,delta_sym=step_width})snocSymb::KerningCharu->LRTextu()snocSymbkc=LRText$\_s->((),upds)whereupd=(\sa->s{acc_sym=a`snocH`kc})<*>acc_symsnocChar::KerningCharu->LRTextu()snocCharkc=LRText$\_s->((),upds)whereupd=(\sa->s{acc_chr=a`snocH`kc})<*>acc_chrkern::Numu=>u->LRTextu()kerndx=LRText$\_s->((),upds)whereupd=(\sab->s{delta_chr=a+dx,delta_sym=b+dx})<*>delta_chr<*>delta_symchar::Numu=>Char->LRTextu()charch=getsdelta_chr>>=\u->snocChar(kerncharuch)>>charMoveescInt::Numu=>Int->LRTextu()escInti=getsdelta_chr>>=\u->snocChar(kernEscIntui)>>charMoveescName::Numu=>String->LRTextu()escNames=getsdelta_chr>>=\u->snocChar(kernEscNameus)>>charMovesymb::Numu=>Char->LRTextu()symbsy=getsdelta_sym>>=\u->snocSymb(kerncharusy)>>symbMovesymbEscInt::Numu=>Int->LRTextu()symbEscInti=getsdelta_sym>>=\u->snocSymb(kernEscIntui)>>symbMovesymbEscName::Numu=>String->LRTextu()symbEscNames=getsdelta_sym>>=\u->snocSymb(kernEscNameus)>>symbMove