diff --git a/src/SlideRules.hs b/src/SlideRules.hs index 597b10b..34332f2 100644 --- a/src/SlideRules.hs +++ b/src/SlideRules.hs @@ -480,6 +480,68 @@ tSpec = ScaleSpec } } +-- | A circular log wheel with more details. +-- Negative @norm@ inverts the ticks. +cSpecCircularDetailed :: InternalFloat -> ScaleSpec +cSpecCircularDetailed norm = ScaleSpec + { baseTolerance = 0.0026 + , tickIdentifier = defaultIdentifier + , generator = + let labelCenter | norm < 0 = labelCenterUnder 0.00 + | otherwise = labelCenterOver 0.00 in + postTransform (Log 10) $ + withTickCreator (fromInfo (label %~ labelCenter <<< end .~ norm) . mainText) $ do + withInfo (label %~ (fontSize .~ 0.3 <<< labelColor %~ D.dissolve 0.5) + <<< tickColor .~ D.opaque D.orange + <<< start .~ (norm * 0.0) + <<< end .~ (norm * 1.0)) $ do + withInfo (label %~ text .~ "π/3") $ output (pi/3) + withInfo (label %~ text .~ "√2") $ output (sqrt 2) + withInfo (label %~ text .~ "π/2") $ output (pi/2) + withInfo (label %~ text .~ "√3") $ output (sqrt 3) + withInfo (label %~ text .~ "π") $ output pi + withInfo (label %~ text .~ "2π") $ output (2*pi) + withInfo (label %~ text .~ "π²") $ output (pi*pi) + withInfo (label %~ text .~ "e") $ output e + preTransform (Offset 1) $ preTransform (Scale 9) $ + let part9 = Partition 9 0 $ fromXInfo $ \x -> + label %~ (text .~ showIOrF (show . fst . sigExp) (showF round) x) + partN n = Partition n 0 $ fromXInfo $ \x -> + end %~ (* 0.66) + <<< tickColor %~ D.dissolve 0.75 + <<< mlabel %~ (>>= text (const $ pure . last <$> shower x) + <<< labelColor %~ D.dissolve 0.75 + <<< fontSize %~ (* 0.75)) + tree = fillOptionTree [part9] subtree + subtree = + [ fillOptionTree [partN 10] subtree + , fillOptionTree [partN 5] subtree + , fillOptionTree [partN 2] subtree + , OptionTree [partN 10] [] + , OptionTree [partN 5] [] + , OptionTree [partN 2] [] + ] + shower :: InternalFloat -> Maybe String + shower = showIOrF (handleInt =<< sigExp) handleFloat + where + handleInt (m, e) i + | e >= 5 && m /= 1 = Nothing + | e >= 4 = Just $ showEFloat (Just 0) (fromIntegral i) "" + | otherwise = Just $ show i + handleFloat = Just . showM + in runOptionTrees (True, False) [tree] + , offsetter = unitRadius 1.2 + , renderSettings = + RenderSettings + { heightMultiplier = 0.02 + , textMultiplier = 1 + , padding = 0.05 + , lineWidth = 0.0003 + , xPow = 3 + , yPow = 3 + } + } + example = do writeRepToFile (Proxy @SRD.Dias) "ex1.svg" $ fold @@ -505,3 +567,53 @@ example = do , cSpecCircularUpsideDownInverted ] ] + -- # For the clog files + -- ## Build + -- Both clog SVG files are meant to be printed in color on A4 paper and plasticized: + -- convert clog-0026-stator.svg -page a4 -background white -bordercolor white -border 100 clog-0026-stator.pdf + -- convert clog-0026-rotor.svg -page a4 -background white -bordercolor white -border 100 clog-0026-rotor.pdf + -- The rotor is inward and should be cut around the second bigger circle + -- to be pinned on the stator and a piece of wood or cardboard below. + + -- ## Usage + -- The operands should be put in scientific notation + -- to facilitate the handling of the orders of magnitude, + -- then on the wheels big digits corresponds to the unit, + -- middle digits to the decimal and small digits to the hundredth. + + -- To multiply, align the 1 on the rotor + -- with the first operand outward on the stator, + -- then move your eyes clockwise on the rotor up to the second operand + -- and read the result outward on the stator. + + -- To divide, align the divising operand on the rotor + -- with the divided operand on the stator, + -- then move your eyes counter-clockwise up to the 1 on the rotor + -- and read the result outward on the stator. + + -- Beware that if the rotor's measure encompasses + -- the 1 on the stator you must multiply (resp. divide) by 10 + -- on top of adding the exponents of the scientific notations of the operands. + writeRepToFile (Proxy @SRD.Dias) "clog-0026-stator.svg" $ + fold + [ lasercircle 0.025 + , laserline [D.r2 (0, 0), D.r2 (0, 0.05)] + , laserline [D.r2 (-0.05, 0), D.r2 (0.10, 0)] + , lasercircle 0.191 & D.lc D.blue + , lasercircle (0.191 + 0.009) & D.lc D.blue + , lasercircle 0.227 & D.lc D.blue + , foldMap (renderScales (Proxy @SRD.Dias)) + [ cSpecCircularDetailed 1 + ] + ] + writeRepToFile (Proxy @SRD.Dias) "clog-0026-rotor.svg" $ + fold + [ lasercircle 0.025 + , laserline [D.r2 (0, 0), D.r2 (0, 0.191)] + , lasercircle (0.191 - 0.009) & D.lc D.blue + , lasercircle 0.191 & D.lc D.blue + , lasercircle 0.227 & D.lc D.blue + , foldMap (renderScales (Proxy @SRD.Dias)) + [ cSpecCircularDetailed (-1) + ] + ] diff --git a/src/SlideRules/Renderer/Diagrams.hs b/src/SlideRules/Renderer/Diagrams.hs index 5f8b9e4..6ea54f9 100644 --- a/src/SlideRules/Renderer/Diagrams.hs +++ b/src/SlideRules/Renderer/Diagrams.hs @@ -59,7 +59,7 @@ tickToDiagram renderSettings@RenderSettings{ heightMultiplier, textMultiplier } tickToDiagramStatic :: RenderSettings -> Tick -> D.Diagram D.B tickToDiagramStatic RenderSettings{ heightMultiplier, textMultiplier } tick = let Tick { _prePos, _postPos, _info } = tick - TickInfo { _start, _end, _mlabel } = _info + TickInfo { _start, _end, _mlabel, _tickColor } = _info startV2 = D.r2 (0, heightMultiplier * _start) endV2 = D.r2 (0, heightMultiplier * _end) diffV2 = endV2 - startV2 @@ -77,8 +77,9 @@ tickToDiagramStatic RenderSettings{ heightMultiplier, textMultiplier } tick = FromBottomAbs x -> startV2 + D.r2 (0, heightMultiplier * x) pure $ D.alignedText (realToFrac $ _xPct _textAnchor) (realToFrac $ _yPct _textAnchor) _text - & D.fontSizeL (realToFrac $ heightMultiplier * textMultiplier * _fontSize) & D.fc D.black - & D.font "Comfortaa" + & D.fontSizeL (realToFrac $ heightMultiplier * textMultiplier * _fontSize) + & D.fcA _labelColor + & D.font "Bitstream Charter, monospace" & D.translate (fmap realToFrac labelOffset) - in D.lc D.red tickDia <> labelDia + in D.lcA _tickColor tickDia <> labelDia diff --git a/src/SlideRules/Tick.hs b/src/SlideRules/Tick.hs index a79bc7a..98deb83 100644 --- a/src/SlideRules/Tick.hs +++ b/src/SlideRules/Tick.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} module SlideRules.Tick where @@ -83,10 +84,13 @@ data TickInfo = TickInfo { _start :: InternalFloat , _end :: InternalFloat , _mlabel :: Maybe Label + , _tickColor :: D.AlphaColour Double } deriving (Show, Generic) instance NFData TickInfo +instance NFData c => NFData (D.AlphaColour c) where + rnf _c = () instance Default TickInfo where def = @@ -94,6 +98,7 @@ instance Default TickInfo where { _start = 0 , _end = 1 , _mlabel = Nothing + , _tickColor = D.opaque D.red } data Label = Label @@ -102,6 +107,7 @@ data Label = Label , _textAnchor :: TextAnchor , _tickAnchor :: TickAnchor , _anchorOffset :: D.V2 InternalFloat + , _labelColor :: D.AlphaColour Double } deriving (Show, Generic) @@ -115,6 +121,7 @@ instance Default Label where , _textAnchor = TextAnchor { _xPct = 0, _yPct = 0 } , _tickAnchor = FromTopAbs 0 , _anchorOffset = D.V2 0 0 + , _labelColor = D.opaque D.black } data TextAnchor = TextAnchor