packages feed

moonlight-triangulation-0.1.0.0: fuzz/support/Moonlight/Triangulation/Fuzz/Input.hs

module Moonlight.Triangulation.Fuzz.Input
  ( decodeConstraints
  , decodePoints
  , decodeRefinementParameters
  , inputByte
  ) where

import qualified Data.ByteString as BS
import qualified Data.Vector as V
import Data.Word (Word8)
import Moonlight.Triangulation

decodePoints :: BS.ByteString -> V.Vector Point
decodePoints bytes =
  V.generate pointCount $ \index ->
    Point
      (coordinate (inputByte bytes (2 * index)) + fromIntegral (index `mod` 3) / 1024)
      (coordinate (inputByte bytes (2 * index + 1)) + fromIntegral ((index * index) `mod` 5) / 1024)
 where
  pointCount = max 3 (min 64 ((BS.length bytes + 1) `quot` 2))
  coordinate :: Word8 -> Double
  coordinate value = (fromIntegral value - 127.5) / 4

decodeConstraints :: BS.ByteString -> Int -> V.Vector (Int, Int)
decodeConstraints bytes pointCount =
  V.generate constraintCount $ \index ->
    (endpoint (inputByte bytes (2 * index)), endpoint (inputByte bytes (2 * index + 1)))
 where
  constraintCount = max 1 (min 96 ((BS.length bytes + 1) `quot` 2))
  endpoint value
    | value `mod` 8 == 0 = pointCount + fromIntegral (value `mod` 5)
    | otherwise = fromIntegral value `mod` pointCount

decodeRefinementParameters :: BS.ByteString -> RefinementParameters
decodeRefinementParameters bytes =
  defaultRefinementParameters
    { refineMaxAdditionalVertices = budget (inputByte bytes 0)
    , refineMinArea = metric (inputByte bytes 1)
    , refineMaxArea = metric (inputByte bytes 2)
    , refineMaxRadiusEdgeRatio = metric (inputByte bytes 3)
    , refinePreserveConvexHull = odd (inputByte bytes 4)
    , refineKeepConstraintEdges = odd (inputByte bytes 5)
    , refineExcludeOuterFaces = odd (inputByte bytes 6)
    }
 where
  budget :: Word8 -> Maybe Int
  budget value =
    case value `mod` 5 of
      0 -> Nothing
      1 -> Just (-1)
      _ -> Just (fromIntegral value `mod` 17)
  metric :: Word8 -> Maybe Double
  metric value =
    case value `mod` 8 of
      0 -> Nothing
      1 -> Just (-1)
      2 -> Just 0
      3 -> Just (0 / 0)
      4 -> Just (1 / 0)
      _ -> Just (fromIntegral value / 8)

inputByte :: BS.ByteString -> Int -> Word8
inputByte bytes index
  | BS.null bytes = fromIntegral index
  | otherwise = BS.index bytes (index `mod` BS.length bytes)