-- Tesselation is one stage of transforming a RSAGL model into OpenGL procedure calls. In tesselation, polyline strips are broken-- down into triangle fans, triangle strips, and triangles.-- The RSAGL tesselator in particular implements the capability to tesselate polyline strips of differing numbers of elements.moduleRSAGL.Modeling.Tesselation(TesselatedSurface,TesselatedElement(..),tesselatedSurfaceToVertexCloud,tesselateSurface,tesselateGrid,tesselatedElementToOpenGL,unmapTesselatedElement)whereimportRSAGL.Math.CurveimportRSAGL.Auxiliary.AuxiliaryimportRSAGL.Math.AffineimportRSAGL.Math.BoundingBoximportData.ListimportControl.DeepSeqimportControl.Parallel.Strategieshiding(r0)importControl.ArrowimportGraphics.Rendering.OpenGL.GL.BeginEndimportRSAGL.Modeling.OpenGLPrimitivesimportText.Parsec.PrimimportText.Parsec.String()importData.OrdimportControl.MonadimportRSAGL.Math.TypestypeTesselatedSurfacea=[TesselatedElementa]dataTesselatedElementa=TesselatedTriangleFan{tesselated_vertices::[a]}|TesselatedTriangleStrip{tesselated_vertices::[a]}|TesselatedTriangles{tesselated_vertices::[a]}deriving(Read,Show)instance(AffineTransformablea)=>AffineTransformable(TesselatedElementa)wheretransformm(TesselatedTriangleFanas)=TesselatedTriangleFan$transformmastransformm(TesselatedTriangleStripas)=TesselatedTriangleStrip$transformmastransformm(TesselatedTrianglesas)=TesselatedTriangles$transformmasinstance(NFDataa)=>NFData(TesselatedElementa)wherernf(TesselatedTriangleFanas)=rnfasrnf(TesselatedTriangleStripas)=rnfasrnf(TesselatedTrianglesas)=rnfasinstanceFunctorTesselatedElementwherefmapf(TesselatedTriangleFanas)=TesselatedTriangleFan$fmapfasfmapf(TesselatedTriangleStripas)=TesselatedTriangleStrip$fmapfasfmapf(TesselatedTrianglesas)=TesselatedTriangles$fmapfas-- | Generates a list of all vertices in a TesselatedSurface.-- There will be duplicate entries.tesselatedSurfaceToVertexCloud::TesselatedSurfacea->[a]tesselatedSurfaceToVertexCloud=concatMaptesselated_verticesinstance(Bound3Da)=>Bound3D(TesselatedElementa)whereboundingBoxx=boundingBox$tesselatedSurfaceToVertexCloud[x]-- | Tesselate a surface into a u-by-v grid of triangles.tesselateSurface::Surfacea->(Integer,Integer)->TesselatedSurfaceatesselateSurfacesuv=tesselateGrid$iterateSurfaceuv(zipSurface(,)(fmapfstuv_identity)s)-- | Tesselate polylines of possibly differing number of elements.tesselateGrid::[[(RSdouble,a)]]->TesselatedSurfaceatesselateGrid=stripTriangles.map(selectiveShatter5).concatMap(uncurrytesselateStrip).doublesselectiveShatter::Int->TesselatedElementa->TesselatedElementaselectiveShatterne=ifisTrianglese||length(taken$tesselated_verticese)==ntheneelseshattere-- | Convert a TesselatedElement into a TesselatedTriangles copy-- of the same element.shatter::TesselatedElementa->TesselatedElementashatter(TesselatedTriangleFan(a:as))=TesselatedTriangles$faswheref(b:c:ds)=a:b:c:f(c:ds)f_=[]shatter(TesselatedTriangleStripas)=TesselatedTriangles$faswheref(a:b:c:d:es)=a:b:c:c:b:d:f(c:d:es)f_=[]shatterx=x-- | Strip out all single-triangle elements and stuff them in a single-- 'TesselatedTriangles' entry. This is an optimization pass, as having a lot-- of single-triangle elements can be detrimental to performance.stripTriangles::TesselatedSurfacea->TesselatedSurfaceastripTriangleselems=TesselatedTriangles(concatMaptesselated_verticestriangles):not_triangleswherefx=isTrianglesx||map(const())(tesselated_verticesx)==[(),(),()]triangles=filterfelemsnot_triangles=filter(not.f)elemsisTriangles::TesselatedElementa->BoolisTriangles(TesselatedTriangles_)=TrueisTriangles_=FalsetesselateStrip::[(RSdouble,a)]->[(RSdouble,a)]->TesselatedSurfaceatesselateStripleftsrights=tesselate$tesselateStepsleftsrightsdataLR=L|Rderiving(Eq)otherLR::LR->LRotherLRL=RotherLRR=LtesselateSteps::[(RSdouble,a)]->[(RSdouble,a)]->[(LR,a)]tesselateStepsleftsrights=map(secondsnd)$sortBy(comparing$fst.snd)$map((,)L)(reorderlefts)++map((,)R)(reorderrights)wherereorder::[(RSdouble,a)]->[(RSdouble,a)]reorder[]=[]reorder[a]=[a]reorder(a:as)=a:map(\((x,_),(y,b))->((x+y)/2,b))(doubles(a:as))-- | A parser used to pick out the correct sequences of vertices from each pair of polylines.typeTesselationParsera=Parsec[(LR,a)]()vertex::(LR->Bool)->TesselationParseraavertextestF=liftMsnd$tokenPrim(const"")(\x__->x)(\(lr,a)->iftestFlrthenJust(lr,a)elseNothing)pushback::[(LR,a)]->TesselationParsera()pushbackas=dosetInput=<<liftM(as++)getInputreturn()triangleFan::TesselationParsera(TesselatedElementa)triangleFan=try(triangleFanSidedL)<|>try(triangleFanSidedR)wheretriangleFanSided::LR->TesselationParsera(TesselatedElementa)triangleFanSidedx_side=dolety_side=otherLRx_sidexs1<-many$vertex(==x_side)y<-vertex$(==y_side)xs2<-many$vertex(==x_side)letxs=xs1++xs2when(null$drop1xs)$fail"triangleFanSided: not enough x-vertices"pushback$ifnullxs2then[(x_side,lastxs1),(y_side,y)]else[(y_side,y),(x_side,lastxs2)]return$TesselatedTriangleFan$casex_sideofL->y:xsR->y:reversexstriangleStrip::TesselationParsera(TesselatedElementa)triangleStrip=do(pairs,pbs)<-liftM(first(concatMap$\(x,y)->[x,y]).unzip)$many$try(opposingPairL)<|>try(opposingPairR)when(null$drop2pairs)$fail"triangleStrip: not enough vertex pairs"pushback$lastpbsreturn$TesselatedTriangleStrippairswhereopposingPair::LR->TesselationParsera((a,a),[(LR,a)])opposingPairx_side=dolety_side=otherLRx_sidex<-vertex(==x_side)y<-vertex(==y_side)return$(casex_sideofL->(y,x)R->(x,y),[(x_side,x),(y_side,y)])tesselate::[(LR,a)]->TesselatedSurfaceatesselate=either(error.("tesselate: "++).show)id.runParserparser()""whereparser=dotesselated_surface<-many$trytriangleStrip<|>trytriangleFanskipMany(vertex$constTrue)returntesselated_surfacetesselatedElementToOpenGL::(OpenGLPrimitivea)=>Bool->TesselatedElementa->IO()tesselatedElementToOpenGLcolors_ontesselated_element=renderPrimitivesprim_modecolors_onaswhere(prim_mode,as)=unmapTesselatedElementtesselated_elementunmapTesselatedElement::TesselatedElementa->(PrimitiveMode,[a])unmapTesselatedElement(TesselatedTriangleFanas)=(TriangleFan,as)unmapTesselatedElement(TesselatedTriangleStripas)=(TriangleStrip,as)unmapTesselatedElement(TesselatedTrianglesas)=(Triangles,as)