1 -- LML original: Sandra Foubister, 1990 2 -- Haskell translation: Colin Runciman, May 1991 3 4 module Tilefuns( 5 alistind, initalist, mark, unmark, sqid, sqas, btlocate, newas, 6 pam, put, ineights, tpatformat, rot, inv, turn, squas, inbox) where 7 8 import Layout 9 import Drawfuns 10 import Geomfuns 11 12 -- to get the (0,0)..(7,7) part of the state of 13 -- the tiling area 14 15 nextoct :: Int -> Int 16 nextoct n = (n + 1) `mod` 8 17 18 nop :: (Int, Int) -> (Int, Int) 19 nop (n1,n2) = if n2 == 7 then (nextoct n1, 0) else (n1, nextoct n2) 20 21 indlist :: (Int, Int) -> [(Int, Int)] 22 indlist n1n2 = n1n2 : (indlist . nop) n1n2 23 24 alistind :: [(Int,Int)] 25 alistind = take 64 (indlist (0,0)) 26 27 initalist :: [((Int,Int),Int)] 28 initalist = map (\x -> (x,0)) alistind 29 30 -- the mark to show the current selection 31 32 unmark :: Int -> [Char] 33 unmark = undo . mark 34 35 mark :: Int -> [Char] 36 mark 0 = "" 37 mark n = rectangle [x-3, y-3, x + w + 3, y + h + 3] --CR why the 3's? 38 where 39 [x,y,w,h] = picbox n 40 41 -- to find the x of the top left corner of 42 -- the square in which the middle button is pressed 43 44 tlx, tly :: Int -> Int 45 tlx = \x -> tpxorig + (((x - tpxorig) `div` tpxygap) * tpxygap) 46 tly = \y -> tpyorig + (((y - tpyorig) `div` tpxygap) * tpxygap) 47 48 -- counting squares to give it an id 49 50 tlidx, tlidy :: Int -> Int 51 tlidx = \x -> ((x-tpxorig) `div` tpxygap) 52 tlidy = \y -> ((y-tpyorig) `div` tpxygap) 53 54 -- sqas -- square associated with 55 -- refers to tiling area 56 -- gives top left coordinates of the square 57 58 sqas :: Int -> Int -> [Int] 59 sqas x y = [tlx x, tly y] 60 61 -- sqid -- square id 62 -- refers to tiling area 63 -- gives id of the square as reflected in the state 64 65 sqid :: [Int] -> (Int,Int) 66 sqid [x,y] = (tlidy y, tlidx x) 67 68 -- squas returns the coordinates associated with a particular 69 -- tilist square. 70 71 squas :: (Int,Int) -> [Int] 72 squas (ln1,ln2) = [tpxorig + ln2 * tpxygap, tpyorig + ln1 * tpxygap] 73 74 -- btlocate -- locate in the big tile 75 -- if it's not there gives a default [0,0] 76 77 btlocate :: [Int] -> [Int] 78 btlocate [x,y] = if inbigtile x y then sqas x y else [0,0] 79 80 put :: [Int] -> [[Int]] -> [Char] 81 put [x,y] = place x y 82 83 -- for grouping tiles in rows for printing them out 84 85 ineights :: [a] -> [[a]] 86 ineights [] = [] 87 ineights ns = take 8 ns : ineights (drop 8 ns) 88 89 rot :: Int -> Int 90 rot n = case n of 91 0 -> 0 92 4 -> 1 93 8 -> 7 94 7 -> 6 95 6 -> 5 96 5 -> 8 97 n -> n + 1 98 99 turn :: Int -> Int 100 turn n = if n==0 then 0 else 101 (if n == 4 then 8 else (n + 4) `mod` 8) 102 103 -- Because of the arrangement of the 8 pictures 104 -- inv is effectively tbinvert in this version 105 106 inv :: Int -> Int 107 inv = turn --CR 108 --CR inv n = if n==0 then 0 else 109 --CR (if n == 4 then 8 else (n + 4) `mod` 8) 110 111 -- CR removed apparently redundant x' and y' and restructured conditional 112 inbox :: [Int] -> Int 113 inbox [xp,yp] = inbox' 1 114 where 115 inbox' n = 116 if n > 8 then 0 117 else if inrect x y w h xp yp then n 118 else inbox' (n+1) 119 where 120 [x,y,w,h] = picbox n 121 122 tpatformat :: [[Int]] -> [Char] 123 tpatformat [] = "" 124 tpatformat (ln:lns) = formline ln ++ "\n" ++ tpatformat lns 125 where 126 formline (n:ns) = if (ns /= []) then 127 show n ++ " " ++ formline ns 128 else show n 129 130 pam :: (a -> b -> c) -> [a] -> b -> [c] 131 pam f xs y = map (\x -> f x y) xs --CR 132 --CR pam f [] _ = [] 133 --CR pam f (x:xs) y = f x y : pam f xs y 134 135 newas :: (Eq a) => a -> b -> [(a,b)] -> [(a,b)] 136 newas i e [] = [(i,e)] 137 newas i e ((g1,g2):gs) = if g1 == i then (i,e) : gs 138 else (g1,g2) : newas i e gs 139 140 141