SHARE
TWEET

Untitled

a guest Jun 19th, 2017 45 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module AlphabetCake where
  2.  
  3. -- Angel Canal (716205)
  4. -- Jorge Pinilla (715750)
  5.  
  6. -- maxW maxH (Letter, StartX, StartY, EndX, EndY)
  7. type CakeElement = (Char, Int, Int, Int, Int)
  8. data Cake = CakeTuple [CakeElement] Int Int deriving Show
  9. data SplitMode = HOR | VERT deriving (Enum,Eq)
  10.  
  11. --
  12. -- CONSTRUCTOR
  13. --
  14. bakeCake :: Int -> Int -> Cake
  15. bakeCake width height = CakeTuple [] width height
  16.  
  17. --
  18. -- GETTERS
  19. --
  20.  
  21. getLetter :: CakeElement -> Char
  22. getLetter (l,_,_,_,_) = l
  23.  
  24. getStartPos :: CakeElement -> (Int, Int)
  25. getStartPos (_,x,y,_,_) = (x,y)
  26.  
  27. getStartX :: CakeElement -> Int
  28. getStartX (_,x,_,_,_) = x
  29.  
  30. getStartY :: CakeElement -> Int
  31. getStartY (_,_,y,_,_) = y
  32.  
  33. getEndX :: CakeElement -> Int
  34. getEndX (_,_,_,x,_) = x
  35.  
  36. getEndY :: CakeElement -> Int
  37. getEndY (_,_,_,_,y) = y
  38.  
  39. --
  40. -- INSERTS
  41. --
  42.  
  43. duplicatedLetter :: [CakeElement] -> Char -> Bool
  44. duplicatedLetter [] c = False
  45. duplicatedLetter (x:xs) c
  46.   | (getLetter x) == c = True
  47.   | otherwise = duplicatedLetter xs c
  48.  
  49. addLetter :: Cake -> Char -> Int -> Int -> Cake
  50. addLetter (CakeTuple cake w h) c x y
  51.   | x < 0 = error "Letter placed outside left bound!"
  52.   | x >= w = error "Letter placed outside right bound!"
  53.   | y < 0 = error "Letter placed outside top bound!"
  54.   | y >= h = error "Letter placed outside bottom bound!"
  55.   | (duplicatedLetter cake c) = error "Tried to place a duplicated letter!"
  56.   | otherwise = CakeTuple ([(c, x, y, x+1, y+1)] ++ cake) w h
  57.  
  58. splitCake :: Cake -> Cake
  59. splitCake (CakeTuple cake w h) = (CakeTuple (splitHor 0 0 w h cake) w h)
  60.    
  61. splitHor :: Int -> Int -> Int -> Int -> [CakeElement] -> [CakeElement]
  62. splitHor x0 y0 xn yn [] = error "We reached an empty chunk"
  63. splitHor x0 y0 xn yn [c] = [(getLetter c, x0, y0, xn, yn)]
  64. splitHor x0 y0 xn yn l@(x:xs)
  65.   | null (snd cakeTuple) = (splitVert x0 y0 xn yn l)
  66.   | otherwise = (splitVert x0 y0 xn ((getStartY x) + 1) ([x] ++ (fst cakeTuple))) ++ (splitVert x0 ((getStartY x) + 2) xn yn (snd cakeTuple))
  67.   where
  68.     cakeTuple = splitChunks x0 y0 xn ((getStartY x) + 1) xs HOR
  69.  
  70. splitVert :: Int -> Int -> Int -> Int -> [CakeElement] -> [CakeElement]
  71. splitVert x0 y0 xn yn [] = error "We reached an empty chunk"
  72. splitVert x0 y0 xn yn [c] = [(getLetter c, x0, y0, xn, yn)]
  73. splitVert x0 y0 xn yn l@(x:xs)
  74.   | null (snd cakeTuple) = (splitHor x0 y0 xn yn l)
  75.   | otherwise = (splitHor x0 y0 ((getStartX x) + 1) yn ([x] ++ (fst cakeTuple))) ++ (splitHor ((getStartX x) + 2) y0 xn yn (snd cakeTuple))
  76.   where
  77.     cakeTuple = splitChunks x0 y0 ((getStartX x) + 1) yn xs VERT
  78.  
  79.  
  80. splitChunks :: Int -> Int -> Int -> Int -> [CakeElement] -> SplitMode -> ([CakeElement], [CakeElement])
  81. splitChunks x0 y0 xn yn [] mode = error "We reached an empty chunk in splitting chunks"
  82. splitChunks x0 y0 xn yn [c] mode
  83.   | ((getStartX c) < xn) && (mode == VERT) = ([c], [])
  84.   | ((getStartY c) < yn) || (mode == HOR) = ([c], [])
  85.   | otherwise = ([], [c])
  86. splitChunks x0 y0 xn yn (x:xs) mode = (fst l ++ fst l2, snd l ++ snd l2)
  87.   where
  88.     l = splitChunks x0 y0 xn yn [x] mode
  89.     l2 = splitChunks x0 y0 xn yn xs mode
RAW Paste Data
Pastebin PRO Summer Special!
Get 40% OFF on Pastebin PRO accounts!
Top