Plan 9 from Bell Labs’s /usr/web/sources/contrib/fernan/nhc98/tests/nofib/real/reptile/Drawfuns.hs

Copyright © 2021 Plan 9 Foundation.
Distributed under the MIT License.
Download the Plan 9 distribution.


-- 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)




Bell Labs OSI certified Powered by Plan 9

(Return to Plan 9 Home Page)

Copyright © 2021 Plan 9 Foundation. All Rights Reserved.
Comments to [email protected].