Drop Rasterific for non-filled circles
Rasterific appears to generate some pretty surprising, if not completely wrong, circles at especially low sizes - this was resulting in unexpected behavior with vision calculation, including the character never being able to see directly to the left of them, among other things. This moves back to the old midpoint circle algorithm I pulled off of rosetta code, but only for the non-filled circle. The filled circle is still using the wonky algorithm for now, but at some point I'd love to refactor it such that empty circles are eg always a subset of non-filled circles.
This commit is contained in:
		
							parent
							
								
									1265155ae4
								
							
						
					
					
						commit
						22b7a9be84
					
				
					 5 changed files with 118 additions and 52 deletions
				
			
		|  | @ -30,16 +30,45 @@ import           Linear.V2 | |||
| -------------------------------------------------------------------------------- | ||||
| 
 | ||||
| 
 | ||||
| circle :: (Num i, Integral i, Ix i) | ||||
| -- | Generate a circle centered at the given point and with the given radius | ||||
| -- using the <midpoint circle algorithm | ||||
| -- https://en.wikipedia.org/wiki/Midpoint_circle_algorithm>. | ||||
| -- | ||||
| -- Code taken from <https://rosettacode.org/wiki/Bitmap/Midpoint_circle_algorithm#Haskell> | ||||
| circle :: (Num i, Ord i) | ||||
|        => (i, i) -- ^ center | ||||
|        -> i      -- ^ radius | ||||
|        -> [(i, i)] | ||||
| circle (ox, oy) radius | ||||
|   = pointsFromRaster (ox + radius) (oy + radius) | ||||
|   $ stroke 1 JoinRound (CapRound, CapRound) | ||||
|   $ Raster.circle (Raster.V2 (fromIntegral ox) (fromIntegral oy)) | ||||
|   $ fromIntegral radius | ||||
| circle (x₀, y₀) radius | ||||
|   -- Four initial points, plus the generated points | ||||
|   = (x₀, y₀ + radius) : (x₀, y₀ - radius) : (x₀ + radius, y₀) : (x₀ - radius, y₀) : points | ||||
|     where | ||||
|       -- Creates the (x, y) octet offsets, then maps them to absolute points in all octets. | ||||
|       points = concatMap generatePoints $ unfoldr step initialValues | ||||
| 
 | ||||
|       generatePoints (x, y) | ||||
|         = [ (x₀ `xop` x', y₀ `yop` y') | ||||
|           | (x', y') <- [(x, y), (y, x)] | ||||
|           , xop <- [(+), (-)] | ||||
|           , yop <- [(+), (-)] | ||||
|           ] | ||||
| 
 | ||||
|       initialValues = (1 - radius, 1, (-2) * radius, 0, radius) | ||||
| 
 | ||||
|       step (f, ddf_x, ddf_y, x, y) | ||||
|         | x >= y = Nothing | ||||
|         | otherwise = Just ((x', y'), (f', ddf_x', ddf_y', x', y')) | ||||
|         where | ||||
|           (f', ddf_y', y') | f >= 0 = (f + ddf_y' + ddf_x', ddf_y + 2, y - 1) | ||||
|                            | otherwise = (f + ddf_x, ddf_y, y) | ||||
|           ddf_x' = ddf_x + 2 | ||||
|           x' = x + 1 | ||||
| 
 | ||||
| 
 | ||||
| -- | Generate a *filled* circle centered at the given point and with the given | ||||
| -- radius using the Rasterific package. Note that since this uses a different | ||||
| -- implementation, this is not a strict superset of the 'circle' function | ||||
| -- (unfortunately - would like to make that not the case!) | ||||
| filledCircle :: (Num i, Integral i, Ix i) | ||||
|              => (i, i) -- ^ center | ||||
|              -> i      -- ^ radius | ||||
|  | @ -72,8 +101,6 @@ pointsFromRaster w h raster | |||
|            $ renderDrawing @Word8 (fromIntegral w) (fromIntegral h) 0 | ||||
|            $ withTexture (uniformTexture 1) raster | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| -- | Draw a line between two points using Bresenham's line drawing algorithm | ||||
| -- | ||||
| -- Code taken from <https://wiki.haskell.org/Bresenham%27s_line_drawing_algorithm> | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue