1 -- LML original: Sandra Foubister, 1990
    2 -- Haskell translation: Colin Runciman, May 1991
    3 
    4 module Geomfuns(
    5 mapx, mapy, col, row, lrinvert, antirotate, place, rotatecw, 
    6        tbinvert, tile, t4, xymax) where
    7 
    8 import Mgrfuns
    9 import Drawfuns
   10 
   11 --CR strange instructions here!
   12 -- xymax should be in layout.m, and the functions like t4 in
   13 -- a module specific to the program that #includes "layout.t"
   14 
   15 swapxy :: [Int] -> [Int]
   16 
   17 --xs [x1,y1,x2,y2] = [x1,x2]
   18 --ys [x1,y1,x2,y2] = [y1,y2]
   19 swapxy [x1,y1,x2,y2] = [y1,x1,y2,x2]
   20 
   21 mapx, mapy :: (Int -> Int) -> [Int] -> [Int] 
   22 
   23 mapx f [x1,y1,x2,y2] = [f x1, y1, f x2, y2]
   24 mapy f [x1,y1,x2,y2] = [x1, f y1, x2, f y2]
   25 
   26 toright, down :: Int -> [[Int]] -> [[Int]]
   27 
   28 toright = map . mapx . (+) 
   29 down = map . mapy . (+)
   30 
   31 origin :: Int -> Int -> [[Int]] -> [[Int]]
   32 origin x y = (toright x) . (down y)
   33 
   34 -- place x y takes a print and outputs a string that
   35 -- is interpreted by MGR with the result that
   36 -- the print is drawn at x y
   37 
   38 place :: Int -> Int -> [[Int]] -> [Char]
   39 place x y = drawlines . (origin x y)
   40 
   41 -- 72 is the size of the square in the big tile
   42 xymax :: Int
   43 xymax = 72
   44 
   45 -- lrinvert etc still need the size of the square in which to do it
   46 -- so have not yet reverted to their original generality
   47 
   48 lrinvert, tbinvert, rotatecw, antirotate :: Int -> [[Int]] -> [[Int]]
   49 
   50 lrinvert m   = map (mapx (\x -> m-x))
   51 tbinvert m   = map (mapy (\x -> m-x))
   52 rotatecw m   = map (swapxy . (mapy (\x -> m-x)))
   53 antirotate m = map (swapxy . (mapx (\x -> m-x)))
   54 
   55 --CR this doesn't really belong here - redefinition (cf postscript)!
   56 -- a function specifically for the potatoprinting program
   57 -- ss is the square size
   58 t4 :: [[[Int]]] -> [[Int]]
   59 t4 [c1,c2,c3,c4] = c1 ++
   60                    toright ss c2 ++
   61                    down ss c3 ++
   62                    (down ss . toright ss) c4
   63                    where
   64                    ss = xymax
   65 
   66 -- a tile function specifically for use with t4
   67 --CR ditto
   68 tile :: Int -> Int -> Int -> Int -> [[Int]] -> [Char]
   69 tile _ _ _ 0 coords = ""
   70 tile _ _ 0 _ coords = ""
   71 tile x y c r coords = col x y r coords ++
   72                       row (x + 2*xymax) y (c-1) coords ++
   73                       tile (x + 2*xymax) (y + 2*xymax) (c-1)(r-1) coords
   74 
   75 col, row :: Int -> Int -> Int -> [[Int]] -> [Char]
   76 
   77 col x y 0 coords = ""
   78 col x y n coords = place x y coords ++ col x y' (n-1) coords
   79                    where
   80                    y' = y + (2 * xymax)
   81 
   82 row x y 0 coords = ""
   83 row x y n coords = place x y coords ++ row x' y (n-1) coords
   84                    where
   85                    x' = x + (2 * xymax)
   86 
   87 
   88