Implement arc rendering, works for increasing angle difference < 2pi

shader/arc.frag

@@ -1,18 +1,33 @@
 #version 430 core
 in vec4 gColor;
 in vec2 cenPosT;
-in float gRad;
+in float gRadIn;
-in float gWdth;
+in float gRadOut;
+in vec2 angles;
 out vec4 fColor;
 out float gl_FragDepth;
 
 void main()
 {
   vec2 pos = gl_FragCoord.xy;
- // fColor = vec4( gColor.xyz , 0 );
+  float d = distance(pos,cenPosT);
- // fColor = vec4( gColor.xyz , 1 - step(distance(pos,cenPos.xy),gRad) );
+  float dTest = max ( step(gRadOut/2,d)
- // fColor = vec4( gColor.xyz , distance(pos,cenPos.xy)/gRad );
+                    , 1 - step(gRadIn/2,d)
-  fColor = vec4( gColor.rgb, gColor.a * (1-step(gRad/2,distance(pos,cenPosT))) );
+                    );
-  gl_FragDepth = max(gl_FragCoord.z , step(gRad/2,distance(pos,cenPosT)));
+
-  //fColor = vec4( 0.5,0,0 , 1 );
+  vec2 posDiff = pos - cenPosT;
+  float sa = angles.x;
+  vec2 sv = vec2 (-sin(sa), cos(sa));
+  float saTest = dot(sv,posDiff) >= 0 ? 0 : 1;
+  float ea = angles.y;
+  vec2 ev = vec2 (-sin(ea), cos(ea));
+  float eaTest = dot(ev,posDiff) <= 0 ? 0 : 1;
+  float aTest = ea - sa < radians(180) ? max (saTest,eaTest) 
+                                       : min (saTest,eaTest);
+
+  float onArcTest = max(dTest,aTest); 
+
+  //gl_FragDepth = max(gl_FragCoord.z , step(gRadOut/2,distance(pos,cenPosT)));
+  gl_FragDepth = max(gl_FragCoord.z , onArcTest);
+  fColor = gColor;
 }

shader/arc.geom

@@ -4,32 +4,32 @@ layout (triangle_strip, max_vertices = 4) out;
 in vec4 vColor [];
 in vec4 vparams [];
 out vec4 gColor;
-out float gRad;
+out float gRadIn;
-out float gWdth;
+out float gRadOut;
 out vec2 cenPosT;
+out vec2 angles;
 
 uniform vec2 winSize;
 uniform float zoom;
 
 void main()
 {
+  angles = vparams[0].xy;
   vec3 cenPos = gl_in[0].gl_Position.xyz;
-  //cenPos = vec3 (0.5,0,0);
   gColor = vColor[0];
-  gRad = vparams[0].x * zoom * 2;
+  float gWdth = vparams[0].w * 0.5;
-  gWdth = vparams[0].w * zoom * 2;
+  gRadOut = (vparams[0].z + gWdth) * zoom * 2;
-//  gRad = 0.2;
+  gRadIn = (vparams[0].z - gWdth) * zoom * 2;
 
   cenPosT = vec2 ( (cenPos.x + 1) * 0.5 * winSize.x , (cenPos.y + 1) * 0.5 * winSize.y);
 
-  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
+  gl_Position = vec4 (cenPos.x + gRadOut/winSize.x, cenPos.y + gRadOut/winSize.y, cenPos.z , 1);
-  //gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
   EmitVertex();
-  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
+  gl_Position = vec4 (cenPos.x - gRadOut/winSize.x, cenPos.y + gRadOut/winSize.y, cenPos.z , 1);
   EmitVertex();
-  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y - gRad/winSize.y, cenPos.z , 1);
+  gl_Position = vec4 (cenPos.x + gRadOut/winSize.x, cenPos.y - gRadOut/winSize.y, cenPos.z , 1);
   EmitVertex();
-  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y - gRad/winSize.y, cenPos.z , 1);
+  gl_Position = vec4 (cenPos.x - gRadOut/winSize.x, cenPos.y - gRadOut/winSize.y, cenPos.z , 1);
   EmitVertex();
 
   EndPrimitive();

shader/circle.frag

@@ -5,15 +5,14 @@ in float gRad;
 out vec4 fColor;
 out float gl_FragDepth;
 
-uniform vec2 winSize;
-
 void main()
 {
   vec2 pos = gl_FragCoord.xy;
  // fColor = vec4( gColor.xyz , 0 );
  // fColor = vec4( gColor.xyz , 1 - step(distance(pos,cenPos.xy),gRad) );
  // fColor = vec4( gColor.xyz , distance(pos,cenPos.xy)/gRad );
-  fColor = vec4( gColor.rgb, gColor.a * (1-step(gRad/2,distance(pos,cenPosT))) );
+//  fColor = vec4( gColor.rgb, gColor.a * (1-step(gRad/2,distance(pos,cenPosT))) );
   gl_FragDepth = max(gl_FragCoord.z , step(gRad/2,distance(pos,cenPosT)));
-  //fColor = vec4( 0.5,0,0 , 1 );
+  fColor = gColor;
 }
+//note it is the fragdepth that stops this from being square

shader/circle.geom

@@ -21,7 +21,6 @@ void main()
   cenPosT = vec2 ( (cenPos.x + 1) * 0.5 * winSize.x , (cenPos.y + 1) * 0.5 * winSize.y);
 
   gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
-  //gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
   EmitVertex();
   gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
   EmitVertex();

src/Dodge/Critters.hs

@@ -365,6 +365,7 @@ startCr = basicCreature
                             ,hvAutoGun
                             ,teslaGun
                             ,latchkey 0
+                            ,frontArmour
                             ] 
                             ++ repeat NoItem)) 
                           -- startInv

src/Dodge/Weapons.hs

@@ -1811,8 +1811,8 @@ throwArmReset x =
 grenadePic :: Int -> Picture
 grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5
                         , color green $ arc 
-                                            ((179 * fromIntegral x / 50) - 180 ) 
+                                            (degToRad $ (179 * fromIntegral x / 50) - 180 ) 
-                                            (180 - (179 * fromIntegral x / 50) ) 
+                                            (degToRad $ 180 - (179 * fromIntegral x / 50) ) 
                                             5
                         , translate (-2) 2 $ rotate (pi*0.5) 
                             $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 
@@ -2003,7 +2003,7 @@ explodeRemoteBomb itid ptid n w
           j = _crInvSel $ _creatures w IM.! n
 remoteBombPic :: Int -> Picture
 remoteBombPic x = pictures [ color (dark $ dark orange) $ circleSolid 5
-                         , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color red $ arc  0 90 5
+                         , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color red $ arc  0 (pi/2) 5
                          , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color (withAlpha 0.05 red) 
                                                              $ arcSolid 0 90 50
                          , rotate (0 - degToRad (fromIntegral x * 10 + 20)) $ color (withAlpha 0.05 red) 
@@ -2372,13 +2372,14 @@ frontArmour = basicEquipment
     , _itName = "FRONTARMOUR"
     , _itMaxStack = 1
     , _itAmount = 1
-    , _itFloorPict = onLayer FlItLayer $ translate 0 (-5) $ pictures [color (greyN 0.1) $ thickArc 0 90 10 5
+    , _itFloorPict = onLayer FlItLayer $ translate 0 (-5) 
-                                                 ,color (greyN 0.1) $ thickArc 270 360 10 5
+                        $ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
-                                                 ]
+                                   ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
+                                   ]
     , _itEquipPict = (\cr _ -> onLayer CrLayer 
-                                     $ pictures [color (greyN 0.1) $ thickArc 0 90 (_crRad cr) 5
+                        $ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
-                                                ,color (greyN 0.1) $ thickArc 270 360 (_crRad cr) 5
+                                   ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
-                                                ]
+                                   ]
                      )
     , _itEffect = NoItEffect
     , _itID = Nothing

src/Dodge/WorldActions.hs

@@ -484,7 +484,7 @@ crGlareWidth wdth col alphay p cr =
     where l x = uncurry translate x
                 $ rotate (pi*0.5 + argV (p -.- x))
                 $ color (withAlpha alphay col) 
-                $ thickArc 0 180 (_crRad cr) wdth
+                $ thickArc 0 (pi/2) (_crRad cr) wdth
           cp = _crPos cr
           cid = _crID cr
           upp cid' w' = case w' ^? creatures . ix cid . crPos of

src/Picture.hs

@@ -160,7 +160,8 @@ thickLine ps t = pictures $ f ps
 
 thickCircle :: Float -> Float -> Picture
 {-# INLINE thickCircle #-}
-thickCircle rad wdth = thickLine (makeArc rad (0,2*pi)) wdth
+--thickCircle rad wdth = thickLine (makeArc rad (0,2*pi)) wdth
+thickCircle rad wdth = thickArc 0 (2*pi) rad wdth
 
 arcSolid :: Float -> Float -> Float -> Picture
 {-# INLINE arcSolid #-}
@@ -172,8 +173,9 @@ arc startA endA rad = thickArc startA endA rad 1
 
 thickArc :: Float -> Float -> Float -> Float -> Picture
 {-# INLINE thickArc #-}
-thickArc startA endA rad wdth
+thickArc = ThickArc
-    = thickLine (makeArc rad (startA,endA)) wdth
+--thickArc startA endA rad wdth
+--    = thickLine (makeArc rad (startA,endA)) wdth
 
 withAlpha :: Float -> RGBA -> RGBA
 {-# INLINE withAlpha #-}

src/Picture/Render.hs

@@ -74,13 +74,15 @@ overCol _ RenderBlank = RenderBlank
 scaleRen,translateRen :: Float -> Float -> RenderType -> RenderType
 {-# INLINE scaleRen #-}
 scaleRen x y (RenderText vs) = overPos (scale3 x y) $ RenderText $ map (scaleT x) vs
---scaleRen x y (RenderCirc (a,b,c)) = overPos (scale3 x y) $ RenderCirc (a,b,c)
 scaleRen x y rt = overPos (scale3 x y) rt
 {-# INLINE translateRen #-}
 translateRen x y = overPos $ translate3 x y
 rotateRen,setDepthRen :: Float -> RenderType -> RenderType
 {-# INLINE rotateRen #-}
-rotateRen a = overPos $ rotate3 a
+rotateRen a (RenderArc (p,c,(as,ae,r,w))) = overPos (rotate3 a) $ RenderArc (p,c,(f as,f ae,r,w))
+    --where f b = normalizeAngle $ a + b
+    where f b = a + b
+rotateRen a pic = overPos (rotate3 a) pic
 {-# INLINE setDepthRen #-}
 setDepthRen d = overPos $ \(x,y,_) -> (x,y,-d)
 {-# INLINE colorRen #-}
@@ -106,7 +108,7 @@ picToFTree (PolygonCol vs) = let (ps,cs) = unzip vs
                              in  FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
 picToFTree (Circle r)   = FLeaf $ RenderCirc $ ((0,0,0),black,r)
 picToFTree (ThickArc startA endA rad wdth) 
-    = FLeaf $ RenderArc $ ((0,0,0),white,(startA,endA,rad,wdth))
+    = FLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
 picToFTree Blank    = FLeaf $ RenderBlank
 picToFTree (Text s) = FLeaf $ RenderText $ stringToList s
 picToFTree (Scale x y pic) = FBranch (scaleRen x y) $ picToFTree pic
@@ -121,43 +123,38 @@ doubleLine :: [Point2] -> [Point2]
 doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (\a -> [a]) (y:xs)
 doubleLine _ = []
 
-pokeFold :: (Ptr Float, Ptr Float) -> F.FoldM IO RenderType Int
+theFold :: TwoPtrs
-pokeFold (pa,pb) = F.FoldM
+        -> ThreePtrs
-    (pokePoly pa pb)
+        -> ThreePtrs
-    (return 0)
+        -> TwoPtrs
-    return
+        -> ThreePtrs
-pokeTextFold :: (Ptr Float, Ptr Float,Ptr Float) -> F.FoldM IO RenderType Int
-pokeTextFold (pa,pb,pc) = F.FoldM
-    (pokeText pa pb pc)
-    (return 0)
-    return
-pokeCircFold :: (Ptr Float, Ptr Float,Ptr Float) -> F.FoldM IO RenderType Int
-pokeCircFold (pa,pb,pc) = F.FoldM
-    (pokeCirc pa pb pc)
-    (return 0)
-    return
-
-theFold :: (Ptr Float,Ptr Float) 
-        -> (Ptr Float,Ptr Float,Ptr Float)
-        -> (Ptr Float,Ptr Float,Ptr Float)
-        -> (Ptr Float,Ptr Float)
-        -> (Ptr Float,Ptr Float,Ptr Float)
         -> F.FoldM IO RenderType (Int,Int,Int,Int,Int)
 theFold pas pbs pcs pds pes 
-    = (,,,,) <$> pokeFold pas <*> pokeTextFold pbs <*> pokeCircFold pcs
+   -- = (,,,,) <$> pokeFold pas <*> pokeTextFold pbs <*> pokeCircFold pcs
-                                    <*> pokeLineFold pds
+    = (,,,,) <$> pokeTwoPtrsWith pokePoly pas 
-                                    <*> pokeThreePtrsWith pokeArc pes
+             <*> pokeThreePtrsWith pokeText pbs 
+             <*> pokeThreePtrsWith pokeCirc pcs
+             <*> pokeTwoPtrsWith pokeLine pds
+             <*> pokeThreePtrsWith pokeArc pes
 
 type ThreePtrs = (Ptr Float,Ptr Float,Ptr Float)
+type TwoPtrs = (Ptr Float,Ptr Float)
 
 pokeThreePtrsWith :: (ThreePtrs -> Int -> RenderType -> IO Int)
     -> ThreePtrs -> F.FoldM IO RenderType Int
 pokeThreePtrsWith pokeF ptrs = F.FoldM (pokeF ptrs) (return 0) return
+pokeTwoPtrsWith :: (TwoPtrs -> Int -> RenderType -> IO Int)
+    -> TwoPtrs -> F.FoldM IO RenderType Int
+pokeTwoPtrsWith  pokeF ptrs = F.FoldM (pokeF ptrs) (return 0) return
 
 pokeArc:: ThreePtrs -> Int -> RenderType -> IO Int
-pokeArc (pa,pb,pc) n (RenderArc ((x,y,z),(r,g,b,a),(s,t,u,v)))
+pokeArc (pa,pb,pc) n (RenderArc (p,c,s))
     | n > 20000 * 2 = return n
-    | otherwise = return n
+    | otherwise = do
+        pokeThreeOff pa n p
+        pokeFourOff  pb n c
+        pokeFourOff  pc n s
+        return $ n + 1
 pokeArc _ n _ = return n
 
 pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
@@ -177,14 +174,9 @@ pokeFourOff ptr n (x,y,z,w) = do
     pokeElemOff ptr (4*n+3) w
 
 
-pokeLineFold :: (Ptr Float, Ptr Float) -> F.FoldM IO RenderType Int
+pokeLine :: TwoPtrs -> Int -> RenderType -> IO Int
-pokeLineFold (pa,pb) = F.FoldM
+pokeLine (pa,pb) n (RenderLine vs) = foldM (pokeLineVert pa pb) n vs
-    (pokeLine pa pb)
+pokeLine _       n _               = return n
-    (return 0)
-    return
-pokeLine :: Ptr Float -> Ptr Float -> Int -> RenderType -> IO Int
-pokeLine pa pb n (RenderLine vs) = foldM (pokeLineVert pa pb) n vs
-pokeLine _  _  n _               = return n
 
 pokeLineVert :: Ptr Float -> Ptr Float -> Int -> (Point3, Point4) -> IO Int
 pokeLineVert pa pb n (p,c)
@@ -194,22 +186,19 @@ pokeLineVert pa pb n (p,c)
         pokeFourOff  pb n c
         return (n+1)
 
-pokeCirc :: Ptr Float -> Ptr Float ->  Ptr Float -> Int -> RenderType -> IO Int
+pokeCirc :: ThreePtrs -> Int -> RenderType -> IO Int
-pokeCirc pa pb pc n (RenderCirc vs) = pokeCircVert pa pb pc n vs
+pokeCirc (pa,pb,pc) n (RenderCirc (p,c,s)) 
-pokeCirc _  _  _  n _               = return n
-
-pokeCircVert :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> (Point3, Point4, Float) -> IO Int
-pokeCircVert pa pb pc n (p,c,s)
     | n > 20000 * 2 = return n
     | otherwise = do
         pokeThreeOff pa n p
         pokeFourOff  pb n c
         pokeElemOff  pc n s
         return (n+1)
+pokeCirc _          n _               = return n
 
-pokeText :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> RenderType -> IO Int
+pokeText :: (Ptr Float, Ptr Float, Ptr Float) -> Int -> RenderType -> IO Int
-pokeText pa pb pc n (RenderText vs) = foldM (pokeTextVert pa pb pc) n vs
+pokeText (pa,pb,pc) n  (RenderText vs) = foldM (pokeTextVert pa pb pc) n vs
-pokeText _  _  _  n _               = return n
+pokeText _          n _               = return n
 
 pokeTextVert :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> (Point3, Point4, Point2) -> IO Int
 pokeTextVert pa pb pc n (p,c,t)
@@ -220,13 +209,9 @@ pokeTextVert pa pb pc n (p,c,t)
         pokeTwoOff   pc n t
         return (n+1)
 
-pokePic :: Ptr Float -> Ptr Float -> FTree RenderType -> IO Int
+pokePoly :: TwoPtrs -> Int -> RenderType -> IO Int
-pokePic = go 0
+pokePoly (pa,pb) n (RenderPoly vs) = foldM (pokeVert pa pb) n vs
-    where go n pa pb t = foldM (pokePoly pa pb) n t
+pokePoly _       n _               = return n
-
-pokePoly :: Ptr Float -> Ptr Float -> Int -> RenderType -> IO Int
-pokePoly pa pb n (RenderPoly vs) = foldM (pokeVert pa pb) n vs
-pokePoly _  _  n _               = return n
 
 pokeVert :: Ptr Float -> Ptr Float -> Int -> (Point3, Point4) -> IO Int
 pokeVert pa pb n (p,c)
@@ -255,18 +240,16 @@ bindArrayBuffers numVs ps = do
         bindBuffer ArrayBuffer $= Just bo
         bufferData ArrayBuffer $= (fromIntegral $ fSize * numVs * i, ptr, StreamDraw)
         
-
 renderPicture' :: PreloadData -> Float -> (Float,Float) -> Picture -> IO ()
 renderPicture' pdata zoom (winx,winy) pic = do
     let firstIndex = 0
-        numArcVs = 0
 
-    (nTriVs,numVert',numCircVs,nLineVs,nArcVs) 
+    (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs) 
         <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)  
-                                          (_ptrCharPos pdata, _ptrCharCol pdata, _ptrCharTex pdata)
+                            (_ptrCharPos pdata, _ptrCharCol pdata, _ptrCharTex pdata)
-                                          (_ptrCircPos pdata, _ptrCircCol pdata, _ptrCircSca pdata)
+                            (_ptrCircPos pdata, _ptrCircCol pdata, _ptrCircSca pdata)
-                                          (_ptrLinePos pdata, _ptrLineCol pdata)
+                            (_ptrLinePos pdata, _ptrLineCol pdata)
-                                          (_ptrArcPos pdata, _ptrArcCol pdata, _ptrArcSca pdata)
+                            (_ptrArcPos pdata, _ptrArcCol pdata, _ptrArcSca pdata)
                    ) $ picToFTree pic
 
     depthFunc $= Just Less
@@ -299,24 +282,21 @@ renderPicture' pdata zoom (winx,winy) pic = do
     uniform (_asWinUni pdata) $= Vector2 winx winy
     uniform (_asZoomUni pdata)  $= zoom
     bindVertexArrayObject $= Just (_arcVAO pdata)
-    bindArrayBuffers numArcVs 
+    bindArrayBuffers nArcVs 
         [(_posVBO pdata, _ptrArcPos pdata, 3)
         ,(_colVBO pdata, _ptrArcCol pdata, 4)
         ,(_texVBO pdata, _ptrArcSca pdata, 4)
         ]
-    drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numArcVs)
+    drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nArcVs)
 -- draw text
     currentProgram $= Just (_textShader pdata)
     bindVertexArrayObject $= Just (_textVAO pdata)
-    bindArrayBuffers numVert' 
+    bindArrayBuffers nTextVs 
         [(_posVBO pdata, _ptrCharPos pdata, 3)
         ,(_colVBO pdata, _ptrCharCol pdata, 4)
         ,(_texVBO pdata, _ptrCharTex pdata, 2)
         ]
-    drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numVert')
+    drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs)
-
-
 
 bufferOffset :: Integral a => a -> Ptr b
 bufferOffset = plusPtr nullPtr . fromIntegral
-