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