1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
#!/usr/bin/env stack
{- stack script --resolver lts-16.27 --install-ghc
--ghc-options -Wall --ghc-options -Wno-unused-imports --ghc-options -Wno-name-shadowing -}
{-# language NoImplicitPrelude #-}
{-# language DuplicateRecordFields #-}
import Rebase.Prelude
import Control.Lens
import Data.Ratio
import Text.Printf
formatFeet :: RealFrac a => a -> String
formatFeet 0 = "0"
formatFeet l = unwords $ toList (feet f) ++ toList (inches i n d)
where
feet 0 = Nothing
feet f = Just $ printf "%d'" f
inches 0 0 _ = Nothing
inches i 0 _ = Just $ printf "%d\"" i
inches 0 n d = Just $ printf "%d/%d\"" n d
inches i n d = Just $ printf "%d %d/%d\"" i n d
n = numerator t
d = denominator t
(f, i, t) = toCarpenter l
toCarpenter :: RealFrac a => a -> (Int, Int, Ratio Int)
toCarpenter l = (feet, div r 32, mod r 32 % 32) where
(feet, r) = divMod (round $ l * 32) (32 * 12)
type Inches = Rational
boardLength, boardThickness, kickerHeight, availableSpace :: Inches
boardLength = 6 * 12
boardThickness = 5/8
kickerHeight = 4
numHorizontals, numShelves :: Int
numShelves = length shelves
numHorizontals = numShelves + 1
availableSpace = boardLength - kickerHeight - (toRational numHorizontals) * boardThickness
shelves :: [Inches]
shelves = map (* availableSpace) $ map (% 18) [4, 4, 4, 3, 3]
positions, positions' :: [Inches]
positions = map sum $ (tail . inits) $ concatMap (: [boardThickness]) $ kickerHeight : shelves
positions' = map (boardLength -) positions
main :: IO ()
main = do
return $ assert $ sum shelves == 1
mapM_ putStrLn $ formatFeet <$> positions
putStrLn ""
mapM_ putStrLn $ formatFeet <$> positions'
return ()
|
