■

というわけでなんか書いてみた。

module Main
    where

import Graphics.HGL
import Graphics.HGL.Utils
import Int

wid::Int
wid = 640
ht::Int
ht = 480
widf = 640.0
htf = 480.0


data BallState = BallState { speedx, speedy :: Float, posx,posy :: Float }

type CursorPoint = (Float,Float)

topos::BallState->Point
topos b = ( round $ posx b, round $ posy b )

type State = ([BallState],CursorPoint)

black = RGB 0 0 0
yellow = RGB 255 255 0
red = RGB 255 0 0 

drawball:: Point->Graphic
drawball (x,y) = do withRGB black $ ellipse (x-10,y-10) (x+10,y+10)
		    withRGB yellow $ ellipse (x-9,y-9) (x+9,y+9)

drawcursor:: Point->Graphic
drawcursor (x,y) = withRGB black $ do line (x,y-4) (x,y+4)
				      line (x-4,y) (x+4,y)

draw::State->Graphic
draw (balls,(cursorx,cursory)) = do mapM_ drawball $ map topos balls
				    drawcursor ((round cursorx),(round cursory))


gravity:: CursorPoint -> BallState -> BallState
gravity (x2,y2) ball =
    let dx = x2- posx ball
	dy = y2- posy ball
	d = 4/(sqrt $ dx^2 + dy^2)
	a = atan2 dy dx
	sx = speedx ball
	sy = speedy ball
    in  BallState { speedx= sx + ((cos a)*d), speedy= sy + ((sin a)*d), posx=(posx ball)+(sx), posy=(posy ball)+(sy) }

updateState::State->State
updateState (balls,cursor) = (map (gravity cursor) balls,cursor)

clear = withRGB (RGB 255 255 255) $ polygon [(0,0), (wid,0), (wid,ht), (0,ht)]

initialSpeed = 0.8
levelFrame l =
    case l of
	   1 -> (30)*10
	   2 -> (30)*15
	   3 -> (30)*20
	   4 -> (30)*40

levelBalls=
    [ BallState{speedx=initialSpeed, speedy=initialSpeed, posx=0, posy=0},
      BallState{speedx= -initialSpeed, speedy=initialSpeed, posx=widf, posy=0},
      BallState{speedx= -initialSpeed, speedy= -initialSpeed, posx=widf, posy=htf},
      BallState{speedx=initialSpeed, speedy= -initialSpeed, posx=0, posy=htf} ]

checkBall::BallState -> Bool
checkBall b =
    let x = posx b
	y = posy b
	in
	if (x < -3) || (x>widf+3) || (y < -3) ||  (y > htf+3)
	      then False
	      else True

checkBalls::[BallState]->Bool

checkBalls (hd:tl) =
     if checkBall hd then
        checkBalls tl
        else
           False

checkBalls [] = True

nextLevel::Int->Window->IO()
nextLevel l w=
    if l > 4 then
       closeWindow w
    else
       loop (l+1) w (take (l+1) levelBalls,(320,240)) (levelFrame (l+1))
       
			 
loop::Int -> Window -> State -> Int -> IO()
loop level w ( balls, cursorpos ) restFrame =
    do e <- maybeGetWindowEvent w
       case e of
	      Just( MouseMove {pt=(x,y)} ) -> loop level w (balls,(fromIntegral x,fromIntegral y)) restFrame
	      Just( Char {char=c} ) ->
		  if c == '\ESC' then closeWindow w else loop level w (balls,cursorpos) restFrame
	      Nothing ->
		  do setGraphic w $ do { clear; draw (balls,cursorpos) }
		     getWindowTick w
		     if checkBalls balls
			then
			if restFrame == 0
			   then nextLevel level w
			   else loop level w (updateState (balls,cursorpos)) (restFrame-1)

			else
			   closeWindow w
	      _ -> loop level w (balls,cursorpos) restFrame




main::IO()
main = runGraphics $ do w <- openWindowEx "grav" Nothing (wid,ht)
			                  DoubleBuffered (Just 33)
			loop 1 w (take 1 levelBalls, (320.0,240.0)) (levelFrame 1)

マウスカーソルに向かってボールが飛んでくる。ボールを外に出してしまうと終了