diff options
Diffstat (limited to 'testsuite/tests/programs/lex/lex.stdin')
| -rw-r--r-- | testsuite/tests/programs/lex/lex.stdin | 170 |
1 files changed, 170 insertions, 0 deletions
diff --git a/testsuite/tests/programs/lex/lex.stdin b/testsuite/tests/programs/lex/lex.stdin new file mode 100644 index 0000000000..dcd009c41b --- /dev/null +++ b/testsuite/tests/programs/lex/lex.stdin @@ -0,0 +1,170 @@ +module Graph where + +import Parse +import StdLib +import PSlib +import GRIP + +paperX = 280::Int +paperY = 190::Int + +fromInt :: Num a => Int -> a +fromInt = fromInteger . toInteger + +gspostscript str = initialise stdheader ++ portrait ++ str ++ "showpage\n" +postscript str = initialise stdheader ++ landscape ++ str ++ "showpage\n" + +ePostscript (reqdx,reqdy) str = initialise (stdheader++ + "%%BoundingBox: 0 0 "++show (cms2pts reqdx)++" "++show (cms2pts reqdy)++"\n" + ++ "%%EndComments\n") + ++ scale (fromInt reqdx*10/fromInt paperX) (fromInt reqdy*10/fromInt paperY) ++ str ++ + showpage + +initGraph title pedata (topX,topY) (xlabel,ylabel) keys = + drawBox (Pt 0 0) paperX paperY ++ + drawBox (Pt 1 1) (paperX-2) 5 ++ + drawBox (Pt 1 (paperY-7)) (paperX-2) 6 ++ + setfont "BOLD" ++ moveto (Pt (paperX `div` 2) (paperY-6)) ++ cjustify (title) ++ + setfont "NORM" ++ + placePEs pedata ++ + translate 20 25 ++ + newpath ++ moveto (Pt 0 (-5)) ++ lineto (Pt 0 dimY) ++ + moveto (Pt (-5) 0) ++ lineto (Pt dimX 0) ++ stroke ++ + setfont "SMALL" ++ + markXAxis dimX topX++ + markYAxis dimY topY++ + moveto (Pt 0 (dimY+4)) ++ rjustify ylabel ++ stroke ++ + moveto (Pt dimX (-8)) ++ rjustify xlabel ++ stroke ++ + setfont "NORM" ++ + dokeys dimX keys + +placePEs (pes,on) | checkPEs (tail pes) on = + showActive (length pes) (length used) ++ + showUsed pes used ++ setfont "NORM" + where used = if on==[] then tail pes else on + + +cms2pts :: Int -> Int +cms2pts x = round (28.4584 * fromInt x) + +plotCurve :: Int -> [Point] -> Postscript +plotCurve x pts = setgray x ++ fillObject pts + +plot :: [Point] -> Postscript +plot points = plotCurve 5 (Pt 0 0:points) + +dokeys left keys = concat (map2 format (places 0) keys) + where + format pt@(Pt x y) (col,tex,pc) = fillBox pt 16 9 col ++ stroke ++ moveto (Pt (x+17) (y+3)) + ++ text tex ++ stroke ++ moveto (Pt (x+8) (y+3)) ++ + inv col ++ setfont "BOLD" ++ cjustify (pc) ++ + stroke ++ setfont "NORM" ++ setgray 10 + no=left `div` length keys + places n | n == no = [] + places n = (Pt (n*no) (-17)):places (n+1) + +showActive t f = + setfont "LARGE" ++ moveto (Pt 10 16) ++ cjustify (show f) ++ + setfont "SMALL" ++ moveto (Pt 10 12) ++ cjustify "PE(s)" ++ stroke ++ + setfont "SMALL" ++ moveto (Pt 10 8) ++ cjustify "displayed" ++ stroke ++ + setfont "NORM" + +showUsed (m:pes) on = moveto (Pt 2 2) ++ setfont "SMALL" ++ text "Configuration:" ++ + dopes (paperX-27) (("SMALLITALIC",showPE m):map f pes) ++ stroke + where + f pe | elem pe on = ("SMALLBOLD",showPE pe) + | otherwise = ("SMALL",showPE pe) + +dopes left pes = concat (map2 format (places 0) pes) + where + format pt@(Pt x y) (font,tex) = setfont font ++ moveto pt ++ text tex ++ stroke + no=left `div` ((length pes*2)+1) + f x = (no*((x*2)+1)) + 27 + places n | n>2*no = [] + places n = (Pt (f n) 2):places (n+1) + + + +checkPEs pes [] = True +checkPEs pes (p:ps) | elem p pes = checkPEs pes ps + | otherwise = error ("Attempt to gather information from inactive PE - "++ showPE p) + +showPE :: PElement -> String +showPE (PE str no) = str++"."++show no + +inv x | x>=5 = setgray 0 + | otherwise = setgray 10 + +dimX = paperX-30 +dimY = paperY-40 + +markXAxis :: Int -> Int -> Postscript +markXAxis dimX maxX = label 10 ++ markOnX 100 + where + label 0 = "" + label x = newpath ++ moveto (Pt (notch x) 0) ++ rlineto 0 (-2) ++ + moveto (Pt (notch x) (-5)) ++ + cjustify (printFloat (t x)) ++ stroke ++ label (x-1) + t x = fromInt x*(fromInt maxX / fromInt 10) + notch x = x*(dimX `div` 10) + +markOnX n = mapcat notches [1..n] ++ stroke + where + notches n = movetofloat (m*fromInt n) 0 ++ (rlineto 0 (-1)) ++ stroke + m = fromInt dimX/fromInt n + + +markYAxis :: Int -> Int -> Postscript +markYAxis dimY maxY = label 10 ++ markOnY (calibrate maxY) + where + label 0 = "" + label x = newpath ++ moveto (Pt 0 (notch x)) ++ rlineto (-2) 0 ++ + moveto (Pt (-3) (notch x)) ++ + rjustify (printFloat (t x)) ++ stroke ++ label (x-1) + t x = fromInt x*(fromInt maxY / fromInt 10) + notch x = x*(dimY `div` 10) + +calibrate x | x<=1 = 1 + | x<=100 = x + | otherwise = calibrate (x `div` 10) + +markOnY n = mapcat notches [1..n] ++ stroke + where + notches n = movetofloat 0 (m*fromInt n) ++ (rlineto (-1) 0) + m = fromInt dimY/fromInt n + +movetofloat x y = show x ++ " " ++ show y ++ " moveto\n" + + +determineScale :: [Point] -> (Int,Int) +determineScale pts = (axisScale x, axisScale y) + where (min,Pt x y) = minandmax pts + +axisScale :: Int -> Int +axisScale x = axisScale' x 1 +axisScale' x m | x <= m = m + | x <= m*2 = m*2 + | x <= m*5 = m*5 + | x <= m*10 = m*10 + | otherwise = axisScale' x (m*10) + +minandmax :: [Point] -> (Point,Point) +minandmax [] = error "No points" +minandmax (p:ps) = f (p,p) ps + where + f p [] = p + f (Pt minx miny,Pt maxx maxy) (Pt x y:ps) = f (Pt minx' miny',Pt maxx' maxy') ps + where minx' = min x minx + miny' = min y miny + maxx' = max x maxx + maxy' = max y maxy + + +printFloat :: Float -> String +printFloat x = f (show (round (x*10))) + where + f "0" = "0" + f r | x<1 = "0."++r + f (r:"0") | x<10 = [r] + f (r:m) | x<10 = r:'.':m + f _ = show (round x) |