------------------------------------------------------------------------------- |-- Module : Diagrams.TwoD.Path.Turtle-- Copyright : (c) 2011 Michael Sloan-- License : BSD-style (see LICENSE)-- Maintainer : Michael Sloan <mgsloan at gmail>---- Stateful domain specific language for diagram paths, modelled after the-- classic \"turtle\" graphics language.-------------------------------------------------------------------------------moduleDiagrams.TwoD.Path.Turtle(Turtle,TurtleT-- * Turtle control commands,runTurtle,runTurtleT-- * Motion commands,forward,backward,left,right-- * State accessors / setters,heading,setHeading,towards,pos,setPos-- * Drawing control,penHop,penUp,penDown,isDown,closeCurrent)whereimportDiagrams.PreludeimportqualifiedControl.Monad.StateasSTimportControl.Monad.IdentitytypeTurtleT=ST.StateTTStatetypeTurtle=TurtleTIdentitydataTState=TStateBoolDeg(PathR2)-- Unexported utilities-- The path is stored backwards to make accumulation efficient.-- TODO: consider keeping the output backwards, and always update the position?-- This would make the "position" query more efficient.getPath::TState->PathR2getPath(TStated_(Pathxs))=Path.reverse$map(\(p,(Trailysc))->(p,Trail(reverseys)c))$ifdthenxselsetailxs-- Adds a segment to the accumulated path.logoseg::Monadm=>(SegmentR2)->TurtleTm()logosegseg=ST.modify(\(TStatedangp)->TStatedang$modifyTrail(\(Trailxsc)->Trail(rotateangseg:xs)c)p)modifyAngle::Monadm=>(Deg->Deg)->TurtleTm()modifyAnglef=ST.modify(\(TStatedap)->TStated(fa)p)modifyPath::(PathR2->PathR2)->TState->TStatemodifyPathf(TStatedangp)=TStatedang$fpmodifyTrail::(Trailv->Trailv)->Pathv->PathvmodifyTrailf(Path((p,t):ps))=Path$(p,ft):psmodifyTrail_p=p-- | A more general way to run the turtle. Returns a computation in the-- underlying monad @m@ yielding a path consisting of the traced trailsrunTurtleT::(Monadm,Functorm)=>TurtleTma->m(PathR2)runTurtleTt=getPath.snd<$>ST.runStateTt(TStateTrue0(Path[(origin,Trail[]False)]))-- | Run the turtle, yielding a path consisting of the traced trails.runTurtle::Turtlea->PathR2runTurtlet=getPath.snd.ST.runStatet$TStateTrue0(Path[(origin,Trail[]False)])-- Motion commands-- | Move the turtle forward, along the current heading.forward::Monadm=>Double->TurtleTm()forwardx=logoseg$Linear(r2(x,0))-- | Move the turtle backward, directly away from the current heading.backward::Monadm=>Double->TurtleTm()backwardx=logoseg$Linear(r2((negatex),0))-- | Modify the current heading to the left by the specified angle in degrees.left::Monadm=>Double->TurtleTm()lefta=modifyAngle(+(Dega))-- | Modify the current heading to the right by the specified angle in degrees.right::Monadm=>Double->TurtleTm()righta=modifyAngle(subtract(Dega))-- Based on "bezierFromSweepQ1" from Diagrams.TwoD.Arc{-
smoothTurn f s =
where (x,y) = rotate s (1, 0)
(u,v) = ((4-x)/3, (1-x)*(3-x)/(3*y))
bezierFromSweepQ1 :: Rad -> Segment R2
bezierFromSweepQ1 s = fmap (^-^ v) . rotate (s/2) $ Cubic p2 p1 p0
p2 = reflectY p1
-}-- State accessors / setters-- | Set the current turtle angle, in degrees.setHeading::Monadm=>Double->TurtleTm()setHeadinga=modifyAngle(const(Dega))-- | Get the current turtle angle, in degrees.heading::Monadm=>TurtleTmDoubleheading=ST.gets(\(TState_(Degx)_)->x)-- | Sets the heading towards a given location.towards::Monadm=>P2->TurtleTm()towardspt=dop<-possetHeading.(*360).(/tau).uncurryatan2.unr2$pt.-.p-- | Set the current turtle X/Y position.setPos::Monadm=>P2->TurtleTm()setPosp=ST.modifyhelperwherehelper(TStateda(Pathps))=TStateda$Path$(p,Trail[]False):ifdthenpselsetailps-- | Get the current turtle X/Y position.pos::Monadm=>TurtleTmP2pos=ST.getsfwheref(TState__(Path((p,t):_)))=p.+^trailOffsettf_=error"Diagrams.TwoD.Path.Turtle.pos: no path. Please report this as a bug."-- Drawing control.-- | Starts a new path at the current location.penHop::Monadm=>TurtleTm()penHop=pos>>=setPos-- | Ends the current path, and enters into "penUp" modepenUp::Monadm=>TurtleTm()penUp=penHop>>ST.modify(\(TState_ap)->TStateFalseap)-- | Ends the current path, and enters into "penDown" modepenDown::Monadm=>TurtleTm()penDown=penHop>>ST.modify(\(TState_ap)->TStateTrueap)-- | Queries whether the pen is currently drawing a path or not.isDown::Monadm=>TurtleTmBoolisDown=ST.gets(\(TStated__)->d)-- | Closes the current path, to the last penDown / setPosition-- Maintains current position - does this make sense?closeCurrent::Monadm=>TurtleTm()closeCurrent=dop<-posST.modify$modifyPath$modifyTrailclosesetPosp