1 -- LML original: Sandra Foubister, 1990 2 -- Haskell translation: Colin Runciman, May 1991 3 4 module Psfuns(pos8head, introline, lf, tile4, concrep) where 5 6 import Geomfuns 7 import Auxprogfuns 8 9 concrep :: Int -> [a] -> [a] 10 concrep x y = concat (take x (repeat y)) 11 12 --CR headN, fN, ff and f replaced by newf - still needs cleaning up! 13 pos8head :: [[Int]] -> [Char] 14 pos8head coords = header ++ pamcat (map newf [1 .. 8]) coords 15 where 16 header = "%!PS-Adobe-1.0\n0.75 setlinewidth\n" ++ 17 "/print0\n{\n} def\n" 18 topos [x1,y1,x2,y2] = show x1++" "++show y1++" moveto\n"++ 19 show x2++" "++show y2++" lineto\n" 20 pamcat (f:fs) a = f a ++ pamcat fs a 21 pamcat [] a = [] 22 fpat h f coords = h ++ 23 (concat . map topos . f) coords ++ 24 "stroke} def\n" 25 newf n = fpat ("/print" ++ show n ++ "\n{") (orient psmax n) 26 27 28 introline, rowline, ss :: [Char] 29 introline = "400 400 translate" 30 rowline = "\n-288 36 translate" 31 ss = "\n36 0 translate\nprint" 32 33 sq :: Int -> [Char] 34 sq num = ss ++ show num 35 36 lf :: [Int] -> [Char] 37 lf list = rowline ++ concat (map sq list) 38 39 --CR this shouldn't be here :-) 40 tile4 :: [Int] -> [Char] 41 tile4 [n1,n2,n3,n4] = introline ++ 42 concrep 4 (posrow n1 n2 ++ posrow n3 n4) ++ 43 "\nshowpage\n" 44 where 45 posrow i j = rowline ++ concrep 4 (sq i ++ sq j) 46 47 -- 36 is the size of the postscript square 48 psmax :: Int 49 psmax = 36 50 51 52