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