Critique required

Andy Fugard andyfugard@ecosse.net
Mon, 27 May 2002 17:23:29 +0100


Hi all,

I'm a Haskell newbie.  Recently I threw together an answer to Exercise 3.2 on 
p47 of Hudak, which is attached below.  Essentially all it does is draw a 
star, then on each point of the star draw another star, and so on, 
recursively.

Would it be possible for someone to comment briefly on my answer.  For example 
is there anything in there that is immediately annoying to an experienced 
Haskell programmer?  How are programs usually commented?  (I come from an 
imperative background, where functions are often longer -- there it makes 
sense to write pre- and post-conditions for each function, but I'm not sure if 
that's relevant for Haskell.)  Any ideas for making it more efficient?

So, essentially I'm asking someone to rip me to shreds :)

I don't yet have any technical queries, but have just reached the section on 
"fold", so I expect it won't be long....

Cheers,

Andy


----------------------------------------------------------


import SOEGraphics

intToFloat :: Int -> Float
intToFloat n = fromInteger (toInteger n)

starOfDavidList :: Point -> Int -> [Point]
starOfDavidList (x,y) side
    = [ ( x, y - halfHeight ),
        ( x - halfWidth, y + halfHeight ),
        ( x + halfWidth, y + halfHeight ),
        ( x, y + halfHeight + offset ),
        ( x - halfWidth, y - halfHeight + offset ),
        ( x + halfWidth, y - halfHeight + offset ) ]
      where s = intToFloat side
            height     = sqrt (s^2 - (s^2 / 4))
            halfHeight = round (height/2)
            halfWidth  = round (s/2)
            offset     = round (1/3 * height)

drawStar :: Window -> Color -> Point -> Int -> IO ()
drawStar w c pos side
    = do drawInWindow w equiTriUp
         drawInWindow w equiTriDown
      where equiTriUp   = withColor c (polygon (take 3 list))
            equiTriDown = withColor c (polygon (drop 3 list))
            list        = starOfDavidList pos side

snowFlake :: Window -> [Color] -> Int -> Int -> Point -> IO ()
snowFlake w colors side itr pos
    | length colors < itr  = error "Not enough colours in list"
    | itr > 0              = do drawStar w (head colors) pos side
                                sequence_ (map funct ptList)
    | otherwise            = return ()
      where funct = snowFlake w (tail colors) newWidth (itr - 1)
            ptList = starOfDavidList pos side
            newWidth = round (1/3 * intToFloat(side))

main = runGraphics(
           do w <- openWindow "A Snowflake Fractal" (700,650)
              snowFlake w [Cyan, Blue, Magenta, White, Blue] 400 5
                        (300,250)
              k <- getKey w
              closeWindow w
       )

--
[ Andy Fugard ]
[ +44 (0)7901 603075 ]