1 -- LML original: Sandra Foubister, 1990 2 -- Haskell translation: Colin Runciman, May 1991 3 4 module Drawfuns( 5 drawdot, grid, squ, circ, gowin, rectangle, 6 fillrect, undo, undraw, drawlines) where 7 8 import Mgrfuns 9 import Diff 10 11 gowin :: Int -> [Char] 12 gowin n = selectwin n ++ setmode 7 ++ setmode 8 13 14 rectangle :: [Int] -> [Char] 15 rectangle [x1,y1,x2,y2] = line [x1,y1,x2,y1] ++ 16 line [x2,y1,x2,y2] ++ 17 line [x1,y1,x1,y2] ++ 18 line [x1,y2,x2,y2] 19 20 fillrect :: [Int] -> [Char] 21 fillrect [x0,y0,x1,y1] = shade (diff x0 x1) 22 where 23 m = min x0 x1 24 vline n = line [n,y0,n,y1] 25 shade 0 = vline m 26 shade n = vline (m+n) ++ shade (n-1) 27 28 squ :: Int -> Int -> Int -> [Char] 29 squ n x y = rectangle [x, y, x+n, y+n] 30 31 circ :: Int -> Int -> Int -> [Char] 32 circ n x y = circle [x,y,n] 33 34 drawdot :: Int -> Int -> [Char] 35 drawdot x y = fillrect [x-1, y-1, x+1, y+1] 36 37 undo :: [Char] -> [Char] 38 undo f = func 0 ++ f ++ func 15 39 40 undraw :: [Int] -> [Char] 41 undraw = undo . line 42 43 drawlines :: [[Int]] -> [Char] 44 drawlines = concat . map line 45 46 allpairs _ [] _ = [] 47 allpairs _ _ [] = [] 48 allpairs f (x:xs) ys = map (f x) ys ++ allpairs f xs ys 49 50 -- grid -- a function that draws a grid. 51 -- The function drawf is applied to each x y pair in the grid 52 53 grid :: Int -> Int -> Int -> Int -> Int -> Int -> (Int -> Int -> [a]) -> [a] 54 grid xor yor xgap ygap xlength ylength drawf = 55 concat (allpairs drawf x0list y0list) 56 where 57 x0list = gridlist xor xgap xlength 58 y0list = gridlist yor ygap ylength 59 gridlist orig gap len = 60 take len (gridlist' orig) 61 where 62 gridlist' n = n : gridlist' (n + gap) 63 64 65