Remove bezier shader

src/Dodge/Render/Connectors.hs

@@ -1,7 +1,6 @@
 module Dodge.Render.Connectors
     ( zConnect
     , zConnectCol
-    , bConnect
     , lConnect
     ) where
 import Picture
@@ -24,16 +23,6 @@ zConnectCol (V2 x y) (V2 a b) c1 c2 c3 c4 = lineCol $ zip
     ]
     ) [c1,c2,c3,c4]
 
-bConnect :: Point2 -> Point2 -> Picture
-bConnect (V2 x y) (V2 z w) = pictures 
-    [ bline 0.2 0.050 0.010
-    , bline 0.5 0.045 0.005
-    , bline 0.5 0.035 0.002
-    ] --cheapo antialiasing
-  where
-    bline alph lwidth rwidth
-        = bezierQuad (withAlpha 0.0 white) (withAlpha alph white) lwidth rwidth (V2 x y) (V2 0 y) (V2 z w)
-
 lConnect :: Point2 -> Point2 -> Picture
 lConnect sp@(V2 _ y) ep@(V2 x _) = line 
     [ sp

src/Dodge/Render/HUD.hs

@@ -23,7 +23,7 @@ import Dodge.ListDisplayParams
 import Dodge.Render.Connectors
 import Dodge.Render.List
 import Dodge.Tweak.Show
-import Dodge.WorldPos
+--import Dodge.WorldPos
 import Geometry
 import qualified IntMapHelp as IM
 import Justify
@@ -312,22 +312,23 @@ drawCarte :: Configuration -> World -> Picture
 drawCarte cfig w =
     pictures $
         renderListAt 0 0 cfig locs :
-        zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
+       -- zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
-            ++ mapOverlay cfig w
+       --     ++ 
+        mapOverlay cfig w
             ++ [mainListCursor white iPos cfig]
   where
     iPos = w ^. cWorld . lWorld . selLocation
     locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
-    locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
+    --locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
-    locTexts = map fst locs
+    --locTexts = map fst locs
 
-displayListEndCoords :: Configuration -> [String] -> [Point2]
+--displayListEndCoords :: Configuration -> [String] -> [Point2]
-displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
+--displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
-  where
+--  where
-    f :: Int -> Point2
+--    f :: Int -> Point2
-    f i = V2 (15 - halfWidth cfig) (2.5 + halfHeight cfig - (20 * fromIntegral i))
+--    f i = V2 (15 - halfWidth cfig) (2.5 + halfHeight cfig - (20 * fromIntegral i))
-    h :: String -> Point2 -> Point2
+--    h :: String -> Point2 -> Point2
-    h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
+--    h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
 
 mapOverlay :: Configuration -> World -> [Picture]
 mapOverlay cfig w =

src/Picture/Base.hs

@@ -11,7 +11,6 @@ module Picture.Base (
     polygonCol,
     poly3,
     poly3Col,
-    bezierQuad,
     arc,
     arcSolid,
     thickArc,
@@ -88,61 +87,20 @@ poly3Col = map f . polyToTris
   where
     f (pos, col) = Verx pos col [] BottomLayer polyNum
 
--- note that much of work computing the width of the bezier curve is done here
-bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
-bezierQuad cola colc ra rc a b c
-    | a == b && b == c = blank
-    | a == b || b == c = bezierQuad cola colc ra rc a (0.5 *.* (a +.+ c)) c
-    | otherwise =
-        bzhelp
-            [ (aIn, cola, V2 (fa aIn) (fc aIn), V2 1 0)
-            , (aIn, cola, V2 (fa aIn) (fc aIn), V2 1 0)
-            , (cIn, colc, V2 (fa cIn) (fc cIn), V2 0 1)
-            , (aX, cola, V2 1 0, V2 (fa' aX) (fc' aX))
-            , (cX, colc, V2 0 1, V2 (fa' cX) (fc' cX))
-            , (bX, colb, V2 0 0, V2 (fa' bX) (fc' bX))
-            , (bX, colb, V2 0 0, V2 (fa' bX) (fc' bX))
-            ]
-  where
-    colb = mixColors 0.5 0.5 cola colc
-    b2a
-        | isLHS a b c = a -.- b
-        | otherwise = b -.- a
-    aRadVec = 0.5 * ra *.* normalizeV (vNormal b2a)
-    aX = a -.- aRadVec
-    aIn = a +.+ aRadVec
-    b2c
-        | isLHS a b c = b -.- c
-        | otherwise = c -.- b
-    cRadVec = 0.5 * rc *.* normalizeV (vNormal b2c)
-    cX = c -.- cRadVec
-    cIn = c +.+ cRadVec
-    bRadVec = 0.25 * (ra + rc) *.* normalizeV (a +.+ b -.- 2 *.* c)
-    bX = b +.+ bRadVec
-    bIn = b -.- bRadVec
-    fa = extrapolate aX cX bX
-    fc = extrapolate cX aX bX
-    fa' = extrapolate aIn cIn bIn
-    fc' = extrapolate cIn aIn bIn
 
-bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture
+---- given a one and two zeros of a linear function over x and y,
-bzhelp = map f
+---- determine the function
-  where
+---- so if f(ox,oy) = 1 and f(ax,ay) = f(bx,by) = 0, determines f
-    f (V2 x y, col, V2 a b, V2 c d) = Verx (V3 x y 0) col [a, b, c, d] BottomLayer bezNum
+--extrapolate :: Point2 -> Point2 -> Point2 -> Point2 -> Float
-
+--extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) =
--- given a one and two zeros of a linear function over x and y,
+--    ( x * (ay - by)
--- determine the function
+--        + y * (bx - ax)
--- so if f(ox,oy) = 1 and f(ax,ay) = f(bx,by) = 0, determines f
+--        + (ax * by - bx * ay)
-extrapolate :: Point2 -> Point2 -> Point2 -> Point2 -> Float
+--    )
-extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) =
+--        / ( ox * (ay - by)
-    ( x * (ay - by)
+--                + ax * (by - oy)
-        + y * (bx - ax)
+--                + bx * (oy - ay)
-        + (ax * by - bx * ay)
+--          )
-    )
-        / ( ox * (ay - by)
-                + ax * (by - oy)
-                + bx * (oy - ay)
-          )
 
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}

src/Picture/Data.hs

@@ -51,17 +51,15 @@ _unShadNum = fromEnum
 toShadNum :: Int -> ShadNum
 toShadNum = toEnum
 
-polyNum, bezNum, textNum, arcNum, ellNum :: ShadNum
+polyNum, textNum, arcNum, ellNum :: ShadNum
 {-# INLINE polyNum #-}
-{-# INLINE bezNum #-}
 {-# INLINE textNum #-}
 {-# INLINE arcNum #-}
 {-# INLINE ellNum #-}
 polyNum = toShadNum 0
-bezNum = toShadNum 1
+textNum = toShadNum 1
-textNum = toShadNum 2
+arcNum = toShadNum 2
-arcNum = toShadNum 3
+ellNum = toShadNum 3
-ellNum = toShadNum 4
 
 type Picture = [Verx]
 

src/Preload/Render.hs

@@ -128,7 +128,6 @@ preloadRender = do
     --glVertexArrayElementBuffer (bslista ^. shaderVAO . vaoName) shEBOname
     aslist <- makeShader "dualTwoD/arc" [vert, frag] [3, 4, 3] pmTriangles
     eslist <- makeShader "dualTwoD/ellipse" [vert, geom, frag] [3, 4] pmTriangles
-    bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] pmTriangleStrip
     cslist <-
         makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] pmTriangles
             >>= _1 (vaddTextureNoFilter "data/texture/charMap.png")
@@ -194,12 +193,11 @@ preloadRender = do
     -- reset to default framebuffer, ready for drawing direct to screen
     glBindFramebuffer GL_FRAMEBUFFER 0
 
-    shadV <- MV.new 5
+    shadV <- MV.new 4
     zipWithM_
         (MV.write shadV)
-        [0 .. 4]
+        [0 .. 3]
         [ bslist -- note the ordering is very important
-        , bezierQuadShader
         , cslist
         , aslist
         , eslist

src/Shader/Poke.hs

@@ -427,10 +427,9 @@ pokeLayVerx vbos counts vx = do
 pokeStride :: Int -> Int
 {-# INLINE pokeStride #-}
 pokeStride 0 = 7
-pokeStride 1 = 11
+pokeStride 1 = 9
-pokeStride 2 = 9
+pokeStride 2 = 10
-pokeStride 3 = 10
+pokeStride 3 = 7
-pokeStride 4 = 7
 pokeStride _ = undefined
 
 poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()