-- LML original: Sandra Foubister, 1990 -- Haskell translation: Colin Runciman, May 1991 module Drawfuns( drawdot, grid, squ, circ, gowin, rectangle, fillrect, undo, undraw, drawlines) where import Mgrfuns import Diff gowin :: Int -> [Char] gowin n = selectwin n ++ setmode 7 ++ setmode 8 rectangle :: [Int] -> [Char] rectangle [x1,y1,x2,y2] = line [x1,y1,x2,y1] ++ line [x2,y1,x2,y2] ++ line [x1,y1,x1,y2] ++ line [x1,y2,x2,y2] fillrect :: [Int] -> [Char] fillrect [x0,y0,x1,y1] = shade (diff x0 x1) where m = min x0 x1 vline n = line [n,y0,n,y1] shade 0 = vline m shade n = vline (m+n) ++ shade (n-1) squ :: Int -> Int -> Int -> [Char] squ n x y = rectangle [x, y, x+n, y+n] circ :: Int -> Int -> Int -> [Char] circ n x y = circle [x,y,n] drawdot :: Int -> Int -> [Char] drawdot x y = fillrect [x-1, y-1, x+1, y+1] undo :: [Char] -> [Char] undo f = func 0 ++ f ++ func 15 undraw :: [Int] -> [Char] undraw = undo . line drawlines :: [[Int]] -> [Char] drawlines = concat . map line allpairs _ [] _ = [] allpairs _ _ [] = [] allpairs f (x:xs) ys = map (f x) ys ++ allpairs f xs ys -- grid -- a function that draws a grid. -- The function drawf is applied to each x y pair in the grid grid :: Int -> Int -> Int -> Int -> Int -> Int -> (Int -> Int -> [a]) -> [a] grid xor yor xgap ygap xlength ylength drawf = concat (allpairs drawf x0list y0list) where x0list = gridlist xor xgap xlength y0list = gridlist yor ygap ylength gridlist orig gap len = take len (gridlist' orig) where gridlist' n = n : gridlist' (n + gap)