diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index ed66746fc..3694fbd6f 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -2,7 +2,7 @@ module Dodge.Render.ShapePicture ( worldSPic, ) where -import Picture.Test +import Picture.Arc import Dodge.Viewpoints import Dodge.Render.Label import Dodge.WorldEvent.ThingsHit @@ -79,7 +79,7 @@ drawSweep cr cfig w = fromMaybe mempty $ do -- $ arc (rot + a) (rot + _crDir cr) (dist mwp p * campos ^. camZoom) $ color white (circle 100) -- <> arcTest (3*pi/4) 100 green 0 1 red 100 - <> arcTest 0 5 green (3*pi/4) 50 red 100 white + <> arcFull 0 5 green (3*pi/4) 50 red 100 white -- <> f green 0 (pi/2) 100 -- <> f red 2 3 100 <> f blue 4 4.5 100 white @@ -87,7 +87,7 @@ drawSweep cr cfig w = fromMaybe mempty $ do -- <> f 3 0 220 <> f 4 0 240 -- <> f (-0.5) 0.5 260 <> f 0.5 (-0.5) 280 where - f col a b c = arcTest a 25 col b 1 red c + f col a b c = arcFull a 25 col b 1 red c --f a b c = thickArc a b c 5 --rot = campos ^. camRot p = _crPos cr diff --git a/src/Picture/Arc.hs b/src/Picture/Arc.hs new file mode 100644 index 000000000..23a283f13 --- /dev/null +++ b/src/Picture/Arc.hs @@ -0,0 +1,49 @@ +module Picture.Arc where + +import Color +import Geometry +import Picture.Data + +-- this should work regardless of which angle is larger, though swapping the +-- angles will affect the winding of the drawn triangles +arcFull :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture +arcFull startA swidth scol endA ewidth ecol r centercol + | abs (difference startA endA) > pi / 2 = + arcFull startA swidth scol midA mw mc r centercol + <> arcFull midA mw mc endA ewidth ecol r centercol + | otherwise = arcPart startA swidth scol endA ewidth ecol r centercol + where + midA = 0.5 * (startA + endA) + mw = 0.5 * (swidth + ewidth) + mc = mixColors 0.5 0.5 scol ecol + +-- should work if the angles are pi/2 or less apart. +arcPart :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture +arcPart startA sw sc endA ew ec r centercol = + map + f + [ (V3 0 0 0, centercol, V3 0 0 mwdth) + , (V3 xa ya 0, sc, V3 ad op wdth) + , (V3 xb yb 0, mc, V3 1 1 mwdth) + , (V3 0 0 0, centercol, V3 0 0 mwdth) + , (V3 xb yb 0, mc, V3 1 1 mwdth) + , (V3 xc yc 0, ec, V3 ad op ewdth) + ] + where + mc = mixColors 0.5 0.5 sc ec + ang = endA - startA + -- imagine that the arc is centered on the diagonal of the first quadrant + -- then the x-y values for the start and end of the arc are the following + op = sin ((pi / 2 - ang) / 2) + ad = cos ((pi / 2 - ang) / 2) + -- for most of the drawn triangles, the "width" value is interpolated towards the center + wdth = (wdth' + (wdth' - 1) * mwdth) / wdth' + wdth' = 1 - sw / r + -- along the middle line the "width" value is the following constant + mwdth = 1 - (0.5 * (sw + ew)) / r + ewdth' = 1 - ew / r + ewdth = (ewdth' + (ewdth' - 1) * mwdth) / ewdth' + (V2 xa ya) = rotateV startA (V2 r 0) + (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (r * sqrt 2) 0) + (V2 xc yc) = rotateV endA (V2 r 0) + f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum diff --git a/src/Picture/Base.hs b/src/Picture/Base.hs index 8e4a31c99..2bfb69d36 100644 --- a/src/Picture/Base.hs +++ b/src/Picture/Base.hs @@ -3,6 +3,7 @@ module Picture.Base ( module Picture.Data, + module Picture.Arc, module Color, blank, polygon, @@ -15,7 +16,7 @@ module Picture.Base ( arc, arcSolid, thickArc, - thickArcFull, + --thickArcFull, thickCircle, thickLine, lineThick, @@ -51,6 +52,7 @@ import Color import Data.Foldable import Geometry import Picture.Data +import Picture.Arc blank :: Picture {-# INLINE blank #-} @@ -327,58 +329,59 @@ arc :: arc startA endA rad = thickArc startA endA rad 1 {-# INLINE arc #-} -thickArcFull :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Picture -{-# INLINE thickArcFull #-} -thickArcFull sa sw sc ea ew ec rad - | difference sa ea > pi / 2 = thickArcFull sa sw sc ma mw mc rad <> thickArcFull ma mw mc ea ew ec rad - | otherwise = map f - [ (V3 0 0 0, mc, V3 0 0 mw) - , (V3 xa ya 0, sc, V3 1 0 sw) - , (V3 xb yb 0, mc, V3 1 1 mw) - , (V3 0 0 0, sc, V3 0 0 sw) - , (V3 xb yb 0, mc, V3 1 1 mw) - , (V3 xc yc 0, ec, V3 0 1 ew) - ] - where - (V2 xa ya) = rotateV sa (V2 rad 0) - (V2 xb yb) = rotateV (0.5 * (sa + ea)) (V2 (rad * sqrt 2) 0) - (V2 xc yc) = rotateV ea (V2 rad 0) - f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum - ma = 0.5 * (sa + ea) - mw = 0.5 * (sw + ew) - mc = mixColors 0.5 0.5 sc ec +--thickArcFull :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Picture +--{-# INLINE thickArcFull #-} +--thickArcFull sa sw sc ea ew ec rad +-- | difference sa ea > pi / 2 = thickArcFull sa sw sc ma mw mc rad <> thickArcFull ma mw mc ea ew ec rad +-- | otherwise = map f +-- [ (V3 0 0 0, mc, V3 0 0 mw) +-- , (V3 xa ya 0, sc, V3 1 0 sw) +-- , (V3 xb yb 0, mc, V3 1 1 mw) +-- , (V3 0 0 0, sc, V3 0 0 sw) +-- , (V3 xb yb 0, mc, V3 1 1 mw) +-- , (V3 xc yc 0, ec, V3 0 1 ew) +-- ] +-- where +-- (V2 xa ya) = rotateV sa (V2 rad 0) +-- (V2 xb yb) = rotateV (0.5 * (sa + ea)) (V2 (rad * sqrt 2) 0) +-- (V2 xc yc) = rotateV ea (V2 rad 0) +-- f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum +-- ma = 0.5 * (sa + ea) +-- mw = 0.5 * (sw + ew) +-- mc = mixColors 0.5 0.5 sc ec thickArc :: Float -> Float -> Float -> Float -> Picture {-# INLINE thickArc #-} -thickArc startA endA rad wdth - | endA - startA > (pi / 2) = - pictures - [ thickArc (startA + pi / 2) endA rad wdth - , thickArcHelp startA (startA + pi / 2) r w - ] - | otherwise = thickArcHelp startA endA r w - where - r = rad + 0.5 * wdth - w = 1 - wdth / r +thickArc startA endA rad wdth = arcFull startA wdth white endA wdth white rad white +--thickArc startA endA rad wdth +-- | endA - startA > (pi / 2) = +-- pictures +-- [ thickArc (startA + pi / 2) endA rad wdth +-- , thickArcHelp startA (startA + pi / 2) r w +-- ] +-- | otherwise = thickArcHelp startA endA r w +-- where +-- r = rad + 0.5 * wdth +-- w = 1 - wdth / r -thickArcHelp :: Float -> Float -> Float -> Float -> Picture -{-# INLINE thickArcHelp #-} -thickArcHelp startA endA rad wdth = - picFormat $ - map - f - [ (V3 0 0 0, black, V3 0 0 wdth) - , (V3 xa ya 0, black, V3 1 0 wdth) - , (V3 xb yb 0, black, V3 1 1 wdth) - , (V3 0 0 0, black, V3 0 0 wdth) - , (V3 xb yb 0, black, V3 1 1 wdth) - , (V3 xc yc 0, black, V3 0 1 wdth) - ] - where - (V2 xa ya) = rotateV startA (V2 rad 0) - (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) 0) - (V2 xc yc) = rotateV endA (V2 rad 0) - f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum +--thickArcHelp :: Float -> Float -> Float -> Float -> Picture +--{-# INLINE thickArcHelp #-} +--thickArcHelp startA endA rad wdth = +-- picFormat $ +-- map +-- f +-- [ (V3 0 0 0, black, V3 0 0 wdth) +-- , (V3 xa ya 0, black, V3 1 0 wdth) +-- , (V3 xb yb 0, black, V3 1 1 wdth) +-- , (V3 0 0 0, black, V3 0 0 wdth) +-- , (V3 xb yb 0, black, V3 1 1 wdth) +-- , (V3 xc yc 0, black, V3 0 1 wdth) +-- ] +-- where +-- (V2 xa ya) = rotateV startA (V2 rad 0) +-- (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) 0) +-- (V2 xc yc) = rotateV endA (V2 rad 0) +-- f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum -- Currently the lens version is much slower overPos :: (Point3 -> Point3) -> Verx -> Verx diff --git a/src/Picture/Test.hs b/src/Picture/Test.hs index 4df1d2d42..a8ced258c 100644 --- a/src/Picture/Test.hs +++ b/src/Picture/Test.hs @@ -1,40 +1,48 @@ module Picture.Test where -import Picture.Data -import Geometry import Color +import Geometry +import Picture.Data +-- this should work regardless of which angle is larger, though swapping the +-- angles will affect the winding of the drawn triangles arcTest :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture -arcTest startA sw sc endA ew ec r centercol - | abs (difference startA endA) > pi / 2 = arcTest startA sw sc midA mw mc r centercol - <> arcTest midA mw mc endA ew ec r centercol - | otherwise = arcTest' startA sw sc endA ew ec r centercol +arcTest startA swidth scol endA ewidth ecol r centercol + | abs (difference startA endA) > pi / 2 = + arcTest startA swidth scol midA mw mc r centercol + <> arcTest midA mw mc endA ewidth ecol r centercol + | otherwise = arcTest' startA swidth scol endA ewidth ecol r centercol where midA = 0.5 * (startA + endA) - mw = 0.5 * (sw + ew) - mc = mixColors 0.5 0.5 sc ec + mw = 0.5 * (swidth + ewidth) + mc = mixColors 0.5 0.5 scol ecol +-- should work if the angles are pi/2 or less apart. arcTest' :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture arcTest' startA sw sc endA ew ec r centercol = - map - f - [ (V3 0 0 0, centercol, V3 0 0 mwdth) - , (V3 xa ya 0, sc, V3 ad op wdth) - , (V3 xb yb 0, mc, V3 1 1 mwdth) - , (V3 0 0 0, centercol, V3 0 0 mwdth) - , (V3 xb yb 0, mc, V3 1 1 mwdth) - , (V3 xc yc 0, ec, V3 ad op ewdth) - ] + map + f + [ (V3 0 0 0, centercol, V3 0 0 mwdth) + , (V3 xa ya 0, sc, V3 ad op wdth) + , (V3 xb yb 0, mc, V3 1 1 mwdth) + , (V3 0 0 0, centercol, V3 0 0 mwdth) + , (V3 xb yb 0, mc, V3 1 1 mwdth) + , (V3 xc yc 0, ec, V3 ad op ewdth) + ] where mc = mixColors 0.5 0.5 sc ec ang = endA - startA - op = sin ((pi/2 - ang)/2) - ad = cos ((pi/2 - ang)/2) - wdth = (wdth' + (wdth' - 1) * mwdth)/wdth' + -- imagine that the arc is centered on the diagonal of the first quadrant + -- then the x-y values for the start and end of the arc are the following + op = sin ((pi / 2 - ang) / 2) + ad = cos ((pi / 2 - ang) / 2) + -- for most of the drawn triangles, the "width" value is interpolated towards the center + wdth = (wdth' + (wdth' - 1) * mwdth) / wdth' wdth' = 1 - sw / r + -- along the middle line the "width" value is the following constant mwdth = 1 - (0.5 * (sw + ew)) / r ewdth' = 1 - ew / r - ewdth = (ewdth' + (ewdth' - 1) * mwdth)/ewdth' + ewdth = (ewdth' + (ewdth' - 1) * mwdth) / ewdth' (V2 xa ya) = rotateV startA (V2 r 0) (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (r * sqrt 2) 0) (V2 xc yc) = rotateV endA (V2 r 0)