summaryrefslogtreecommitdiff
path: root/shelf.hs
blob: 61710e80e60eed8ed94242273c996a6d5c255b4c (plain)
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
#!/usr/bin/env stack
{- stack script --resolver lts-16.27 --install-ghc
  --ghc-options -Wall --ghc-options -Wno-unused-imports -}
{-# language NoImplicitPrelude #-}
{-# language DuplicateRecordFields #-}
import Rebase.Prelude
import Control.Lens

import Data.Ratio
import Text.Printf

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)

feetAndInches :: RealFrac a => a -> String
feetAndInches l = case toCarpenter l of
    (0,0,0) -> "0 feet 0 inches"
    (f,i,t) -> showUnit "foot" "feet" (f % 1) ++
                (if f > 0 && (i%1 + t) > 0 then " " else "") ++
                showUnit "inch" "inches" (i % 1 + t)
    where
    showUnit _ _ 0 = ""
    showUnit s m n = printf "%s %s" (showVal n) $ if n <= 1 then s else m
    showVal v | d == 1    = show n
              | v < 1     = printf "%d/%d" n d
              | otherwise = printf "%d and %d/%d" (div n d) (mod n d) d
              where (n,d) = (numerator v, denominator v)

type Inches = Rational

boardLength, boardThickness, kickerHeight, numShelves, numHorizontals, availableSpace :: Inches
boardLength = 6 * 12
boardThickness = 5/8
kickerHeight = 4
numShelves = 5

numHorizontals = numShelves + 1
availableSpace = boardLength - kickerHeight - numHorizontals * boardThickness

shelves :: [Rational]
shelves = kickerHeight : map (* availableSpace) [2%9, 2%9, 2%9, 1%6, 1%6]

positions :: [Inches]
positions = map (+ boardThickness) $ map sum $ tails shelves

positions' = map (boardLength -) positions

main :: IO ()
main = do
  _ <- return $ assert $ sum shelves == 1
  print shelves
  print positions
  print $ map (fromRational :: Rational -> Float) positions
  print positions'
  print $ map (fromRational :: Rational -> Float) positions'
  mapM_ putStrLn $ feetAndInches <$> positions'
  return ()