moduleGraphics.Vty.TypeswhereimportData.Bits((.&.),(.|.),shiftL)importForeign.PtrimportForeign.StorableimportForeign.C.Types(CChar)importForeign.Marshal.ArrayimportqualifiedData.ByteStringasBinfixr5<|>infixr4<->-- |This type represents the visible cursor state.dataCursor=NoCursor-- ^ Hide the cursor.|CursorIntInt-- ^ Display the cursor at the given XY position.-- Gah. GHC can't unbox bitfields itself :(-- | Opaque data type representing character attributes.newtypeAttr=AttrIntderiving(Eq)-- | Set the foreground color of an `Attr'.setFG::Color->Attr->AttrsetFG(Colorc)(Attra)=Attr((a.&.0xFFFFFF00).|.(30+c))-- | Set the background color of an `Attr'.setBG::Color->Attr->AttrsetBG(Colorc)(Attra)=Attr((a.&.0xFFFF00FF).|.((40+c)`shiftL`8))-- | Set the foreground color of an `Attr'.setFGVivid::Color->Attr->AttrsetFGVivid(Colorc)(Attra)=Attr((a.&.0xFFFFFF00).|.(90+c))-- | Set the background color of an `Attr'.setBGVivid::Color->Attr->AttrsetBGVivid(Colorc)(Attra)=Attr((a.&.0xFFFF00FF).|.((100+c)`shiftL`8))-- | Set bold attribute of an `Attr'.setBold::Attr->AttrsetBold(Attra)=Attr(a.|.0x10000)-- | Set blink attribute of an `Attr'.setBlink::Attr->AttrsetBlink(Attra)=Attr(a.|.0x20000)-- | Set reverse-video attribute of an `Attr'.setRV::Attr->AttrsetRV(Attra)=Attr(a.|.0x40000)-- | Set half-bright attribute of an `Attr'.setHalfBright::Attr->AttrsetHalfBright(Attra)=Attr(a.|.0x80000)-- | Set underline attribute of an `Attr'.setUnderline::Attr->AttrsetUnderline(Attra)=Attr(a.|.0x100000)-- |'Attr' with all default values.attr::Attrattr=Attr0x909-- |Abstract data type representing a color.newtypeColor=ColorIntderiving(Eq)-- FIXME: this assumes a 8-color terminal.-- |Basic color definitions.black,red,green,yellow,blue,magenta,cyan,white,def::Colorblack=Color0;red=Color1;green=Color2;yellow=Color3blue=Color4;magenta=Color5;cyan=Color6;white=Color7def=Color9-- This uses a somewhat tricky implementation, for efficiency.-- |A two-dimensional array of (Char,Attr) pairs.dataImage=Image(Int->PtrInt->IO())!Int!Int-- | Access the width of an Image.imgWidth::Image->IntimgWidth(Image_w_)=w-- | Access the height of an Image.imgHeight::Image->IntimgHeight(Image__h)=h-- | The empty image.empty::Imageempty=Image(\__->return())00-- | Compose two images side by side. The images must of the same height,-- or one must be empty.(<|>)::Image->Image->ImageImagef1x1y1<|>Imagef2x2y2|y1==y2||x1==0||x2==0=Image(\strideptr->dof1strideptrf2stride(ptr`plusPtr`((sizeOf(undefined::Int)*2)*x1)))(x1+x2)(maxy1y2)_<|>_=error"Graphics.Vty.(<|>) : image heights do not match"-- | Compose two images vertically. The images must of the same width,-- or one must be empty.(<->)::Image->Image->ImageImagef1x1y1<->Imagef2x2y2|x1==x2||y1==0||y2==0=Image(\strideptr->dof1strideptrf2stride(ptr`plusPtr`(stride*y1)))(maxx1x2)(y1+y2)_<->_=error"Graphics.Vty.(<->) : image widths do not match"-- | Helper - fill a buffer segment with a char\/attr.fillSeg::Attr->Char->PtrInt->PtrInt->IO()fillSeg(Attra)chp1pe=a`seq`ch`seq`pe`seq`workerp1whereworkerp|p==pe=return()|otherwise=dopokeElemOffp0apokeElemOffp1(fromEnumch)worker(p`advancePtr`2)-- | Compose any number of images horizontally.horzcat::[Image]->Imagehorzcat=foldr(<|>)empty-- | Compose any number of images vertically.vertcat::[Image]->Imagevertcat=foldr(<->)empty-- | Create an `Image' from a `B.ByteString' with a single uniform `Attr'.renderBS::Attr->B.ByteString->ImagerenderBS(Attra)bs=a`seq`Image(\_strideptr->B.useAsCStringLenbs(workerptr))(B.lengthbs)1whereworker::PtrInt->(PtrCChar,Int)->IO()worker_op(_ip,0)=return()workerop(ip,ct)=doinp<-peekippokeElemOffop0apokeElemOffop1(fromIntegralinp)worker(op`advancePtr`2)((ip`advancePtr`1),(ct-1))-- | Create a 1x1 image. Warning, this is likely to be inefficient.renderChar::Attr->Char->ImagerenderChar(Attra)ch=a`seq`ch`seq`Image(\_strideptr->pokeElemOffptr0a>>pokeElemOffptr1(fromEnumch))11-- | Create an image by repeating a single character and attribute horizontally.renderHFill::Attr->Char->Int->ImagerenderHFill__w|w<0||w>10000=error"renderHFill: bizarre width"renderHFillachw=a`seq`ch`seq`Image(\_strideptr->fillSegachptr(ptr`advancePtr`(2*w)))w1-- | Create an image by repeating a single character and attribute.renderFill::Attr->Char->Int->Int->ImagerenderFill__w_|w<0||w>10000=error"renderFill: bizarre width"renderFill___h|h<0||h>10000=error"renderFill: bizarre height"renderFill(Attra)chwh=a`seq`ch`seq`Image(workerh)whwhereworker::Int->Int->PtrInt->IO()worker0_stride_ptr=return()workerctstrideptr=doletptr2=ptr`advancePtr`(2*w)fillSeg(Attra)chptrptr2worker(ct-1)strideptr2-- |The type of images to be displayed using 'update'. You probably shouldn't-- create this directly if you care about compatibility with future versions of-- vty; instead use 'pic' and record update syntax.dataPicture=Pic{-- |The position and visibility status of the virtual-- cursor.pCursor::Cursor,-- |A 2d array of (character,attribute) pairs, representing-- the screen image.pImage::Image}-- |Create a 'Picture' object with all default values. By using this and record-- update, rather than directly using the Pic constructor, your code will be-- compatible with additions to the Picture object. You must specify at least-- 'pImage'.pic::Picturepic=Pic{pCursor=NoCursor,pImage=error"Pic.pImage not initialized"}