summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2020-12-29 09:41:47 -0500
committerAndrew Cady <d@jerkface.net>2020-12-29 09:41:47 -0500
commitab981deb57eedc35ec7bbb4f20e9deecd307123c (patch)
tree80e069b8faf435820c190f29bc300128655f2f9d
parent9357f8327450bb8fa64230e434e060f48338aaa7 (diff)
better
-rwxr-xr-xmain.hs2
-rwxr-xr-xshelf.hs34
2 files changed, 33 insertions, 3 deletions
diff --git a/main.hs b/main.hs
index beeb0f3..a3b1dcb 100755
--- a/main.hs
+++ b/main.hs
@@ -1,5 +1,5 @@
1#!/usr/bin/env stack 1#!/usr/bin/env stack
2{- stack script --resolver lts-16.14 --install-ghc 2{- stack script --resolver lts-16.27 --install-ghc
3 --ghc-options -Wall --ghc-options -Wno-unused-imports -} 3 --ghc-options -Wall --ghc-options -Wno-unused-imports -}
4{-# language NoImplicitPrelude #-} 4{-# language NoImplicitPrelude #-}
5{-# language DuplicateRecordFields #-} 5{-# language DuplicateRecordFields #-}
diff --git a/shelf.hs b/shelf.hs
index 2c27b52..61710e8 100755
--- a/shelf.hs
+++ b/shelf.hs
@@ -1,11 +1,32 @@
1#!/usr/bin/env stack 1#!/usr/bin/env stack
2{- stack script --resolver lts-16.14 --install-ghc 2{- stack script --resolver lts-16.27 --install-ghc
3 --ghc-options -Wall --ghc-options -Wno-unused-imports -} 3 --ghc-options -Wall --ghc-options -Wno-unused-imports -}
4{-# language NoImplicitPrelude #-} 4{-# language NoImplicitPrelude #-}
5{-# language DuplicateRecordFields #-} 5{-# language DuplicateRecordFields #-}
6import Rebase.Prelude 6import Rebase.Prelude
7import Control.Lens 7import Control.Lens
8 8
9import Data.Ratio
10import Text.Printf
11
12toCarpenter :: RealFrac a => a -> (Int, Int, Ratio Int)
13toCarpenter l = (feet, div r 32, mod r 32 % 32) where
14 (feet, r) = divMod (round $ l * 32) (32 * 12)
15
16feetAndInches :: RealFrac a => a -> String
17feetAndInches l = case toCarpenter l of
18 (0,0,0) -> "0 feet 0 inches"
19 (f,i,t) -> showUnit "foot" "feet" (f % 1) ++
20 (if f > 0 && (i%1 + t) > 0 then " " else "") ++
21 showUnit "inch" "inches" (i % 1 + t)
22 where
23 showUnit _ _ 0 = ""
24 showUnit s m n = printf "%s %s" (showVal n) $ if n <= 1 then s else m
25 showVal v | d == 1 = show n
26 | v < 1 = printf "%d/%d" n d
27 | otherwise = printf "%d and %d/%d" (div n d) (mod n d) d
28 where (n,d) = (numerator v, denominator v)
29
9type Inches = Rational 30type Inches = Rational
10 31
11boardLength, boardThickness, kickerHeight, numShelves, numHorizontals, availableSpace :: Inches 32boardLength, boardThickness, kickerHeight, numShelves, numHorizontals, availableSpace :: Inches
@@ -18,11 +39,20 @@ numHorizontals = numShelves + 1
18availableSpace = boardLength - kickerHeight - numHorizontals * boardThickness 39availableSpace = boardLength - kickerHeight - numHorizontals * boardThickness
19 40
20shelves :: [Rational] 41shelves :: [Rational]
21shelves = [2%9, 2%9, 2%9, 1%6, 1%6] 42shelves = kickerHeight : map (* availableSpace) [2%9, 2%9, 2%9, 1%6, 1%6]
43
44positions :: [Inches]
45positions = map (+ boardThickness) $ map sum $ tails shelves
22 46
47positions' = map (boardLength -) positions
23 48
24main :: IO () 49main :: IO ()
25main = do 50main = do
26 _ <- return $ assert $ sum shelves == 1 51 _ <- return $ assert $ sum shelves == 1
27 print shelves 52 print shelves
53 print positions
54 print $ map (fromRational :: Rational -> Float) positions
55 print positions'
56 print $ map (fromRational :: Rational -> Float) positions'
57 mapM_ putStrLn $ feetAndInches <$> positions'
28 return () 58 return ()