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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
#!/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 #-}
{-# language RecordWildCards #-}
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
data Shelf = Shelf {
boardLength :: Inches,
boardThickness :: Inches,
kickerHeight :: Inches,
shelves :: [Integer]
}
bookshelf :: Shelf
bookshelf = Shelf {
boardLength = 6 * 12,
boardThickness = 5/8,
kickerHeight = 4 + 1/2,
shelves = [4, 4, 4, 3, 3]
}
pianoCubbies :: Shelf
pianoCubbies = Shelf {
boardLength = 52 + 1%8,
boardThickness = 5/8,
kickerHeight = 0,
shelves = [1, 1, 1, 1]
}
positions, positions' :: Shelf -> [Inches]
positions Shelf{..} = map sum $ (tail . inits) $ concatMap (: [boardThickness]) $ kickerHeight : shelvesAbs
where
shelvesAbs = map (* availableSpace) shelves'
shelves' = map (% (sum shelves)) shelves
numHorizontals, numShelves :: Int
numShelves = length shelves
numHorizontals = numShelves + 1
availableSpace = boardLength - kickerHeight - (toRational numHorizontals) * boardThickness
positions' x@Shelf{..} = map (boardLength -) $ positions x
printPositions :: Shelf -> IO ()
printPositions x = do
mapM_ putStrLn $ formatFeet <$> positions x
when (positions x /= reverse (positions' x)) $ do
putStrLn "\nReversed:\n"
mapM_ putStrLn $ formatFeet <$> positions' x
main :: IO ()
main = do
putStrLn "Piano cubbies:\n"
printPositions pianoCubbies
putStrLn "\n\nBookshelf:\n"
printPositions bookshelf
|
