scala-logo-with-base.hs
It’s the Scala logo, but it’s designed in Haskell
{- stack script --resolver lts-22.6
--package linear
--package waterfall-cad
--extra-dep waterfall-cad-0.4.0.0
--extra-dep opencascade-hs-0.4.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-02.jpg
-- image: https://doscienceto.it/blog/photos/scala-logo-03.jpg
import qualified Waterfall
import Linear
import Control.Lens ((^.))
import Data.Function ((&))
-- 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 = 20
pitch = 20
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 7.5 Waterfall.unitCircle
mask = Waterfall.scale (V3 radius radius 150) Waterfall.centeredCylinder `Waterfall.difference`
Waterfall.scale (V3 (radius-2.5) (radius-2.5) 200) Waterfall.centeredCylinder
logo = Waterfall.rotate (unit _z) (pi + incAngle/2)
(Waterfall.sweep path profile `Waterfall.intersection` mask)
Just (V3 _ _ minZ, _) = Waterfall.axisAlignedBoundingBox logo
in Waterfall.translate (negate minZ *^ unit _z) logo
lsugBase :: Waterfall.Font -> Waterfall.Solid
lsugBase font =
let mkText = Waterfall.rotate (unit _x) (pi/2) . Waterfall.prism 2 . Waterfall.text font
textLines = mkText <$> reverse ["London", "Scala", "User", "Group"]
allText = mconcat $ zipWith (Waterfall.translate . (V3 0 0)) [5, 12 .. ] textLines
sideL = 50
sideH = 31
bevelCondition :: (V3 Double, V3 Double) -> Maybe Double
bevelCondition (v1, v2) =
if ((v1 ^. _z) == 0) && ((v2 ^. _z) == 0)
then Nothing
else if ((v1 ^. _xy) == (v2 ^. _xy))
then Just 10
else Just 2
box = Waterfall.centeredCube
& Waterfall.translate (0.5 *^ unit _z)
& Waterfall.scale (V3 sideL sideL sideH)
& Waterfall.roundConditionalFillet bevelCondition
coinGap = Waterfall.scale (V3 15 15 12) Waterfall.centeredCylinder
positionedText = Waterfall.translate ((1 - sideL/2) *^ unit _y) allText
positionedLogo = Waterfall.translate ((sideH - 5) *^ unit _z) scalaLogo
in (box `Waterfall.difference` (positionedText <> coinGap)) <> positionedLogo
subtleBase :: Waterfall.Solid
subtleBase =
let r = 18
h = 5
coinGap = Waterfall.scale (V3 15 15 8) Waterfall.centeredCylinder
in Waterfall.centeredCylinder
& Waterfall.translate (unit _z /2)
& Waterfall.scale (V3 r r h)
& (`Waterfall.difference` coinGap )
& (<> scalaLogo)
main :: IO ()
main = do
font <- Waterfall.fontFromSystem "monospace" Waterfall.Regular 8
Waterfall.writeSTL 0.25 "scala-logo-lsug-base.stl" (lsugBase font)
Waterfall.writeSTL 0.25 "scala-logo-subtle-base.stl" subtleBase