[Haskell-cafe] building a regular polygon
Frank Buss
fb at frank-buss.de
Sun Aug 19 03:09:31 EDT 2007
> (*) Exercise 2.2
>
> Define a function regularPolygon :: Int -> Side -> Shape such that
> regularPolygon n s is a regular polygon with n sides, each of length
> s. (Hint: consider using some of Haskell's trigonometric
> functions, such
> as sin :: Float -> Float, cos :: Float -> Float, and tan :: Float ->
> Float.)
I'm a Haskell newbie, too, but I would use the angle between the line, which
is defined from the point of orign to every corner of the polygon, and a
coordinate axis. Then I would add some Postscript output for easier testing.
http://www.frank-buss.de/tmp/polygons.png
import System
type Shape = [Vertex]
type Side = Float
type Vertex = (Float, Float)
regularPolygon :: Int -> Side -> Shape
regularPolygon n s = (buildList n)
where buildList 0 = []
buildList i = let x = cos(alpha) * s
y = sin(alpha) * s
alpha = 2*pi/(fromIntegral n)*(fromIntegral i)
in (x,y) : buildList (i-1)
showVertex vertex = show (fst vertex) ++ " " ++ show (snd vertex)
postscriptPolygon n s =
(showVertex first ++ " moveto\n")
++ (unlines (map (\vertex -> (showVertex vertex ++ " lineto")) rest))
++ (show (fst first) ++ " " ++ show (snd first) ++ " lineto") ++ "\n"
where poly = regularPolygon n s
first = head poly
rest = tail poly
main = do
let file = "c:\\tmp\\test.ps"
writeFile file
("20 20 scale 0.1 setlinewidth\n"
++ "5 5 translate\n"
++ (postscriptPolygon 4 4)
++ "8 4 translate\n"
++ (postscriptPolygon 7 2)
++ "stroke showpage\n")
system ("c:\\Programme\\gs\\gs8.15\\bin\\gswin32.exe -g500x500 " ++
file)
--
Frank Buss, fb at frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
More information about the Haskell-Cafe
mailing list