Remove bezier shader

2023-03-23 00:38:14 +00:00
parent db53a1ffb2
commit 68b43f29ff
6 changed files with 35 additions and 92 deletions
@@ -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
@@ -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
-            ++ mapOverlay cfig w
+       -- zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
+       --     ++ 
+        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
-    locTexts = map fst locs
+    --locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
+    --locTexts = map fst locs

-displayListEndCoords :: Configuration -> [String] -> [Point2]
-displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
-  where
-    f :: Int -> Point2
-    f i = V2 (15 - halfWidth cfig) (2.5 + halfHeight cfig - (20 * fromIntegral i))
-    h :: String -> Point2 -> Point2
-    h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
+--displayListEndCoords :: Configuration -> [String] -> [Point2]
+--displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
+--  where
+--    f :: Int -> Point2
+--    f i = V2 (15 - halfWidth cfig) (2.5 + halfHeight cfig - (20 * fromIntegral i))
+--    h :: String -> Point2 -> Point2
+--    h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y

 mapOverlay :: Configuration -> World -> [Picture]
 mapOverlay cfig w =
@@ -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
-bzhelp = map f
-  where
-    f (V2 x y, col, V2 a b, V2 c d) = Verx (V3 x y 0) col [a, b, c, d] BottomLayer bezNum
-
-- given a one and two zeros of a linear function over x and y,
-- determine the function
-- so if f(ox,oy) = 1 and f(ax,ay) = f(bx,by) = 0, determines f
-extrapolate :: Point2 -> Point2 -> Point2 -> Point2 -> Float
-extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) =
-    ( x * (ay - by)
-        + y * (bx - ax)
-        + (ax * by - bx * ay)
-    )
-        / ( ox * (ay - by)
-                + ax * (by - oy)
-                + bx * (oy - ay)
-          )
+---- given a one and two zeros of a linear function over x and y,
+---- determine the function
+---- so if f(ox,oy) = 1 and f(ax,ay) = f(bx,by) = 0, determines f
+--extrapolate :: Point2 -> Point2 -> Point2 -> Point2 -> Float
+--extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) =
+--    ( x * (ay - by)
+--        + y * (bx - ax)
+--        + (ax * by - bx * ay)
+--    )
+--        / ( ox * (ay - by)
+--                + ax * (by - oy)
+--                + bx * (oy - ay)
+--          )

 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
@@ -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 2
-arcNum = toShadNum 3
-ellNum = toShadNum 4
+textNum = toShadNum 1
+arcNum = toShadNum 2
+ellNum = toShadNum 3

 type Picture = [Verx]

@@ -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
@@ -427,10 +427,9 @@ pokeLayVerx vbos counts vx = do
 pokeStride :: Int -> Int
 {-# INLINE pokeStride #-}
 pokeStride 0 = 7
-pokeStride 1 = 11
-pokeStride 2 = 9
-pokeStride 3 = 10
-pokeStride 4 = 7
+pokeStride 1 = 9
+pokeStride 2 = 10
+pokeStride 3 = 7
 pokeStride _ = undefined

 poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()