scala-logo.hs

{- stack script --resolver lts-23.15
    --package linear
    --package waterfall-cad
    --extra-dep waterfall-cad-0.6.0.0
    --extra-dep opencascade-hs-0.6.0.0
-}

-- short-description: Scala Logo
--
-- description: It's the Scala logo, but it's designed in Haskell
--
-- image: https://doscienceto.it/blog/photos/scala-logo-01.jpg

import qualified Waterfall
import Linear

-- References:
-- 1. A. Riskus, "Approximation of a Cubic Bezier Curve by Circular Arcs and Vice Versa"
-- 2. Imre Juhasz, "Approximating the helix with rational cubic Bezier curves"
createHelicalArc :: Double -> Double -> Double -> Waterfall.Path 
createHelicalArc r pitch incAngle =
  let alpha = incAngle / 2 -- half included angle
      p = pitch/(2* pi) --  helix height per radian
      ax = r * cos alpha
      ay = r * sin alpha
      b = p * alpha * (r - ax) * (3*r - ax)/(ay * (4*r - ax) * tan alpha)
      b0 = V3 ax (negate ay) (negate alpha*p)
      b1 = V3 ((4*r - ax)/3) (negate $ (r - ax)*(3*r - ax)/(3*ay)) (negate b)
      b2 = V3 ((4*r - ax)/3) ((r - ax)*(3*r - ax)/(3*ay)) b
      b3 = V3 ax ay (alpha*p)
  in Waterfall.bezier b0 b1 b2 b3

scalaLogo :: Waterfall.Solid
scalaLogo = 
    let radius = 8 
        pitch = 8
        segmentsPerTurn = 8
        segmentsPerTurn' = fromIntegral segmentsPerTurn
        incAngle = 2 * pi / segmentsPerTurn'
        incHeight = pitch / segmentsPerTurn'
        segment = createHelicalArc radius pitch incAngle
        oneStep = Waterfall.translate (incHeight *^ unit _z) . Waterfall.rotate (unit _z) incAngle
        totalSegments = 5 * segmentsPerTurn `div` 2 
        path = mconcat . take totalSegments . iterate oneStep $ segment
        profile = Waterfall.uScale2D 3 Waterfall.unitCircle
        mask = Waterfall.scale (V3 radius radius 100) Waterfall.centeredCylinder `Waterfall.difference`
            Waterfall.scale (V3 (radius-1) (radius-1) 200) Waterfall.centeredCylinder
    in Waterfall.rotate (unit _z) pi 
        (Waterfall.sweep path profile `Waterfall.intersection` mask)

main :: IO ()
main = Waterfall.writeSTL 0.05 "scala-logo.stl" scalaLogo