~jack/misc

d9d6fb050d3ad258fbd3480042c670882a16ada5 — Jack Kelly 1 year, 4 months ago 20f55a7
functional-images: add line
M functional-images/app/Main.hs => functional-images/app/Main.hs +3 -1
@@ 21,4 21,6 @@ import qualified Image
import Rasterize

main :: IO ()
main = drawingOf $ rasterize 0.1 $ Image.circle 1.2 black
main =
  drawingOf . rasterizeSS 0.1 $
    Image.circle black 1.2 <> Image.line blue 0.2 (-4, -4) (4, 4)

M functional-images/src/Image.hs => functional-images/src/Image.hs +29 -4
@@ 1,3 1,4 @@
{-# LANGUAGE DerivingVia #-}
-- functional-images - Tinkering with functional representation of images
-- Copyright (C) 2021  Jack Kelly <jack@jackkelly.name>
--


@@ 13,8 14,7 @@
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <https://www.gnu.org/licenses/>.

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE MultiWayIf #-}

module Image where



@@ 24,6 24,31 @@ import Data.Monoid (First (..))
newtype Image = Image (Point -> Maybe Color)
  deriving (Semigroup, Monoid) via (Point -> First Color)

circle :: Double -> Color -> Image
circle r col = Image $ \(px, py) ->
circle :: Color -> Double -> Image
circle col r = Image $ \(px, py) ->
  if px ** 2 + py ** 2 < r ** 2 then Just col else Nothing

line :: Color -> Double -> Point -> Point -> Image
line col thick p1 p2 = Image $ \p ->
  if segmentDist (p1, p2) p < thick then Just col else Nothing

segmentDist :: (Point, Point) -> Point -> Double
segmentDist (a, b) p =
  let n = v2sub b a
      pa = v2sub a p
      bp = v2sub p b
      c = v2dot n pa
      e = v2sub pa (v2mul n (c / v2dot n n))
   in if
          | c > 0 -> v2dot pa pa
          | v2dot n bp > 0 -> v2dot bp bp
          | otherwise -> v2dot e e

v2mul :: Point -> Double -> Point
v2mul (px, py) c = (px * c, py * c)

v2sub :: Point -> Point -> Point
v2sub (px, py) (qx, qy) = (px - qx, py - qy)

v2dot :: Point -> Point -> Double
v2dot (px, py) (qx, qy) = px * qx + py * qy

M functional-images/src/Rasterize.hs => functional-images/src/Rasterize.hs +22 -0
@@ 30,3 30,25 @@ rasterize width (Image imageAt) =
    sample p@(px, py) =
      imageAt p <&> \c ->
        colored c $ translated px py $ solidRectangle width width

rasterizeSS :: Double -> Image -> Picture
rasterizeSS width (Image imageAt) =
  mconcat . mapMaybe superSample $
    [(px, py) | px <- [-10, -10 + width .. 10], py <- [-5, -5 + width .. 5]]
  where
    superSample :: Point -> Maybe Picture
    superSample (px, py) =
      let samples =
            mapMaybe
              imageAt
              [ (px - width / 2, py),
                (px + width / 2, py),
                (px, py - width / 2),
                (px, py + width / 2)
              ]

          average = case samples of
            [] -> Nothing
            (_:_) -> Just $ mixed samples
       in average <&> \c ->
            colored c $ translated px py $ solidRectangle width width