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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
#!/usr/bin/env stack
{- stack script --resolver lts-16.31 --install-ghc
--ghc-options -Wall --ghc-options -Wno-unused-imports --ghc-options -Wno-name-shadowing -}
{-# language NoImplicitPrelude #-}
{-# 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]
}
roryShelf :: Shelf
roryShelf = Shelf {
boardLength = 6 * 12,
boardThickness = 5/8,
kickerHeight = 4 + 1/2,
shelves = [4, 4, 3, 3, 4]
}
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
printDadoMarkings :: Shelf -> IO ()
printDadoMarkings x = do
if symmetrical
then putStrLn "\nDado markings (symmetrical):\n"
else putStrLn "\nDado markings:\n"
mapM_ putStrLn $ formatFeet <$> positions x
when (not symmetrical) $ do
putStrLn "\nReversed:\n"
mapM_ putStrLn $ formatFeet <$> positions' x
where
symmetrical = positions x == reverse (positions' x)
printCutlist :: Shelf -> IO ()
printCutlist x = do
putStrLn "Length:"
putStrLn $ formatFeet $ boardLength x
printDadoMarkings x
printPianoCubbies :: IO ()
printPianoCubbies = do
putStrLn "Piano Cubbies"
putStrLn "-------------\n"
printCutlist pianoCubbies
printRoryShelf :: IO ()
printRoryShelf = do
putStrLn "Rory Shelf"
putStrLn "----------\n"
printCutlist roryShelf
main :: IO ()
main = printRoryShelf
|
