|
From: <kr_...@us...> - 2003-06-21 10:04:32
|
Update of /cvsroot/htoolkit/gio/src/examples/worm
In directory sc8-pr-cvs1:/tmp/cvs-serv17905
Modified Files:
HighScore.hs Main.hs WormShow.hs WormState.hs
Log Message:
Formatting
Index: HighScore.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/worm/HighScore.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** HighScore.hs 7 Jun 2003 18:30:05 -0000 1.1
--- HighScore.hs 21 Jun 2003 10:04:29 -0000 1.2
***************
*** 1,10 ****
module HighScore
! ( HiScores, HiScore(..)
! , readHiScores
! , writeHiScores
! , itsAHighScore
! , addScore
! , showHiScores
! ) where
import Graphics.UI.GIO
--- 1,10 ----
module HighScore
! ( HiScores, HiScore(..)
! , readHiScores
! , writeHiScores
! , itsAHighScore
! , addScore
! , showHiScores
! ) where
import Graphics.UI.GIO
***************
*** 13,60 ****
data HiScore
= HiScore
! { name :: !String
! , score :: !Int
! }
! deriving (Show,Read)
! -- Read in the high scores:
readHiScores :: FilePath -> IO HiScores
readHiScores fname = do
! content <- fmap lines (readFile fname)
! return (map read content)
! -- Write the high scores:
writeHiScores :: FilePath -> HiScores -> IO ()
writeHiScores fname highs = do
! let content = map show highs
! writeFile fname (unlines content)
! -- Determine whether, given the number of high scores, a given score is actually a new high score:
itsAHighScore :: Int -> Int -> HiScores -> Bool
itsAHighScore nrOfHiScores score' hiscores
! | score'==0 = False
! | length hiscores<nrOfHiScores = True
! | otherwise = any (\hiscore -> score' > score hiscore) hiscores
!
! -- Add a HiScore to the current list of high scores:
addScore :: Int -> HiScore -> HiScores -> HiScores
addScore nrOfHighScores hi hiscores =
! take nrOfHighScores (addscore hi hiscores)
! where
! addscore :: HiScore -> HiScores -> HiScores
! addscore hi' hiscores@(hi:his)
! | score hi > score hi' = hi : addscore hi' his
! | otherwise = hi' : hiscores
! addscore hi [] = [hi]
! -- Display high scores in a modal dialog to the user:
showHiScores :: String -> HiScores -> IO ()
showHiScores header highs = do
! w <- dialog [title =: "High Scores", resizeable =: False] Nothing
! hdr <- label [title =: header] w
! btnOK <- button [title =: "OK", on command =: dismissWidget w >> return ()] w
! cs <- sequence [label [title =: show hi++". "++take 20 name++" "++show score] w
! | (hi,HiScore{name=name,score=score}) <- zip [1..] highs]
! set w [layout =: padding 10 (padding 15 hdr ^^^ column cs ^^^ padding 15 (hcenter btnOK))]
! runDialog w
--- 13,60 ----
data HiScore
= HiScore
! { name :: !String
! , score :: !Int
! }
! deriving (Show,Read)
! -- Read in the high scores:
readHiScores :: FilePath -> IO HiScores
readHiScores fname = do
! content <- fmap lines (readFile fname)
! return (map read content)
! -- Write the high scores:
writeHiScores :: FilePath -> HiScores -> IO ()
writeHiScores fname highs = do
! let content = map show highs
! writeFile fname (unlines content)
! -- Determine whether, given the number of high scores, a given score is actually a new high score:
itsAHighScore :: Int -> Int -> HiScores -> Bool
itsAHighScore nrOfHiScores score' hiscores
! | score'== 0 = False
! | length hiscores<nrOfHiScores = True
! | otherwise = any (\hiscore -> score' > score hiscore) hiscores
!
! -- Add a HiScore to the current list of high scores:
addScore :: Int -> HiScore -> HiScores -> HiScores
addScore nrOfHighScores hi hiscores =
! take nrOfHighScores (addscore hi hiscores)
! where
! addscore :: HiScore -> HiScores -> HiScores
! addscore hi' hiscores@(hi:his)
! | score hi > score hi' = hi : addscore hi' his
! | otherwise = hi' : hiscores
! addscore hi [] = [hi]
! -- Display high scores in a modal dialog to the user:
showHiScores :: String -> HiScores -> IO ()
showHiScores header highs = do
! w <- dialog [title =: "High Scores", resizeable =: False] Nothing
! hdr <- label [title =: header] w
! btnOK <- button [title =: "OK", on command =: dismissWidget w >> return ()] w
! cs <- sequence [label [title =: show hi++". "++take 20 name++" "++show score] w
! | (hi,HiScore{name=name,score=score}) <- zip [1..] highs]
! set w [layout =: padding 10 (padding 15 hdr ^^^ column cs ^^^ padding 15 (hcenter btnOK))]
! runDialog w
Index: Main.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/worm/Main.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Main.hs 8 Jun 2003 11:11:03 -0000 1.3
--- Main.hs 21 Jun 2003 10:04:29 -0000 1.4
***************
*** 4,8 ****
import WormShow
import WormState
- --import Help
import HighScore
import System.Random
--- 4,7 ----
***************
*** 11,500 ****
! -- GUI constants.
hiScoresFile = "wormhi"
nrOfHiScores = 8
! -- Start of the program.
main :: IO ()
main = do
! hiscores <- readHiScores hiScoresFile
! start "Worm" "1.0" SDI [] (startWorm hiscores)
startWorm :: HiScores -> IO ()
startWorm best = do
! ref <- newIORef (initState best)
! -- File menu
! mfile <- menu [title =: "File"] mainMenu
! mnew <- menuitem [title =: "New", accel =: KeyChar '\^N'] mfile
! mplay <- menuitem [title =: "Play", accel =: KeyChar '\^P'] mfile
! menuline mfile
! mexit <- menuitem [title =: "Exit", on command =: halt] mfile
!
! -- Options menu
! mopts <- menu [title =: "Options"] mainMenu
! mspeed <- menuRadioGroup [] mopts
! menuRadioItem [title =: "Slow", on command =: onSetSpeed ref easySpeed ] mspeed
! menuRadioItem [title =: "Medium", on command =: onSetSpeed ref mediumSpeed] mspeed
! menuRadioItem [title =: "Fast", on command =: onSetSpeed ref hardSpeed ] mspeed
! menuline mopts
! menuitem [title =: "High Scores", accel =: KeyChar '\^S', on command =: onShowBest ref] mopts
!
! -- Help menu
! mhelp <- menu [title =: "Help"] mainMenu
! menuitem [title =: "About Worm...", on command =: onAbout] mhelp
!
! -- Main window
! w <- window [ bgcolor =: wormBackGroundColour
! , bkDrawMode =: True
! , view =: Size 488 303
! , on paint =: onPaint ref
! , on dismiss =: halt
! , resizeable =: False
! ]
!
! -- Timer
! tm <- timer [enabled =: False]
! set tm [on command =: onTimer ref mnew mopts mplay mexit tm w]
!
! set mplay [on command =: onPlay ref mnew mopts mplay mexit tm w]
! set mnew [on command =: onNew ref w]
onPaint ref can _ _ = do
! state <- readIORef ref
! let (State {gamelevel=gamelevel,food=food,points=points,worm=worm,lives=lives}) = state
! drawGame state can
onNew ref w = do
! modifyIORef ref (initState . best)
! repaint w
onPlay ref mnew mopts mplay mexit tm w = do
! state <- readIORef ref
! set mplay [title =: "Stop", on command =: onStop ref mnew mopts mplay mexit tm w]
! set mnew [enabled =: False]
! set mopts [enabled =: False]
! set mexit [enabled =: False]
! set w [on keyboard =: onKeyboard ref mnew mopts mplay mexit tm w]
! set tm [enabled =: True, interval =: speed (gamelevel state)]
onStop ref mnew mopts mplay mexit tm w = do
! set mplay [title =: "Play", on command =: onPlay ref mnew mopts mplay mexit tm w]
! set mnew [enabled =: True]
! set mopts [enabled =: True]
! set mexit [enabled =: True]
! set w [off keyboard]
! set tm [enabled =: False]
!
onHalt ref mnew mopts mplay mexit tm w = do
! onStop ref mnew mopts mplay mexit tm w
! onNew ref w
!
onAbout = do
! logo <- readBitmap "logo.bmp" []
! runAboutDialog "Worm" "1.0" "(C) Krasimir Angelov, 2003" "The Worm is an example program\nfreely distributed with HToolkit" [] [] [] logo Nothing
!
onSetSpeed ref speed =
! modifyIORef ref (\state -> state{gamelevel=(gamelevel state){fix=speed,speed=speed}})
onShowBest ref = do
! state <- readIORef ref
! showHiScores "Worm High Scores:" (best state)
onTimer ref mnew mopts mplay mexit tm w = do
! state <- readIORef ref
! let (event,state1) = stepGame state
! writeIORef ref state1
! case event of
! IncreaseLevel -> switchLevel state1
! DecreaseLevel -> switchLevel state1
! Collide -> nextLife state
! _ -> drawInWindow UnBuffered w (drawStep state state1)
! where
! switchLevel :: State -> IO ()
! switchLevel state@(State {gamelevel=gamelevel}) = do
! set w [off keyboard]
! set tm [interval =: 80, on command =: betweenLevels nrAnimationSteps (-1)]
! where
! betweenLevels :: Int -> Int -> IO ()
! betweenLevels animationStep step
! | animationStep<=1 = set tm [on command =: betweenLevels 2 1]
! | animationStep<=nrAnimationSteps = do
! drawInWindow UnBuffered w (drawAnimation animationStep step)
! set tm [on command =: betweenLevels (animationStep+step) step]
! | otherwise = do
! set tm [interval =: speed gamelevel, on command =: onTimer ref mnew mopts mplay mexit tm w]
! set w [on keyboard =: onKeyboard ref mnew mopts mplay mexit tm w]
! repaint w
- nextLife :: State -> IO ()
- nextLife state@(State {gamelevel=gamelevel,foodsupply=foodsupply,points=points,best=best,worm=worm,lives=lives})
- | lives>0 =
- let
- deadWorm :: Worm -> IO ()
- deadWorm (segment:rest) = do
- drawInWindow UnBuffered w (eraseSegment segment)
- set tm [on command =: deadWorm rest]
- deadWorm [] = do
- set tm [interval =: speed gamelevel, on command =: onTimer ref mnew mopts mplay mexit tm w]
- set w [on keyboard =: onKeyboard ref mnew mopts mplay mexit tm w]
- repaint w
- in do
- set w [off keyboard]
- set tm [interval =: 100, on command =: deadWorm worm]
- | itsAHighScore nrOfHighScores points best = do
- onHalt ref mnew mopts mplay mexit tm w
- refName <- newIORef ""
- dlg <- dialog [] Nothing
- lbl1 <- label [title =: "Game Over with a new high score!"] dlg
- lbl2 <- label [title =: "Your name:"] dlg
- e <- entry [] dlg
- let onOK refName dlg e = do
- get e title >>= writeIORef refName
- destroyWidget dlg
- btnOK <- button [title =: "OK", on command =: onOK refName dlg e] dlg
- set dlg [layout =: padding 5 (lbl1 ^^^ padding 15 (lbl2 ^^^ hfill e) ^^^ hcenter btnOK)]
- runDialog dlg
- name <- readIORef refName
- when (name /= "") $ do
- let best' = addScore nrOfHighScores (HiScore name points) best
- writeHiScores hiScoresFile best'
- modifyIORef ref (\state -> state{best=best'})
- | otherwise = do
- onHalt ref mnew mopts mplay mexit tm w
- messageAlert "Game Over, no high score."
-
onKeyboard ref mnew mopts mplay mexit tm w (KeyDown key _) = do
! modifyIORef ref (\state@(State {dir=dir}) -> case key of
! KeyArrowUp _ | dir == West || dir == East -> state{dir=North}
! KeyArrowDown _ | dir == West || dir == East -> state{dir=South}
! KeyArrowLeft _ | dir == North || dir == South -> state{dir=West}
! KeyArrowRight _ | dir == North || dir == South -> state{dir=East}
! _ -> state)
! onTimer ref mnew mopts mplay mexit tm w
onKeyboard ref mnew mopts mplay mexit tm w _ = return ()
-
- {- state <- openWindow undefined window state
- state <- openMenu undefined filemenu state
- state <- openMenu undefined optionsmenu state
- state <- openTimer undefined timer state
- state <- initFoodSupply (mkStdGen 0) state
- state <- initWindowPicture state
- return state
- where
- [fileID,playID,haltID,quitID,levelID,contID,windowID,timerID] = ids
-
- initFoodSupply :: StdGen -> State -> GUI State State
- initFoodSupply seed state@(State {worm=worm,gamelevel=gamelevel}) = do
- let (food,foods) = newFood worm gamelevel (randoms seed)
- return state{food=food,foodsupply=foods}
-
- initWindowPicture :: State -> GUI State State
- initWindowPicture state = do
- drawInWindow windowID setPenFontSize
- return state
- where
- setPenFontSize :: Draw ()
- setPenFontSize = do
- font <- getPenFont
- setPenFont font{fontSize=wormFontSize}
-
- filemenu = Menu "File"
- ( MenuItem "Play" [MenuId playID,MenuShortKey 'r',MenuFunction (noLS play)]
- :+: MenuItem "Halt" [MenuId haltID,MenuShortKey '.',MenuFunction (noLS halt),MenuSelectState Unable]
- :+: MenuSeparator []
- :+: MenuItem "About Worm..." [MenuFunction (noLS (showAbout "Worm" helpFile))]
- :+: MenuItem "Help" [MenuFunction (noLS (showHelp helpFile))]
- :+: MenuSeparator []
- :+: MenuItem "Quit" [MenuId quitID,MenuShortKey 'q',MenuFunction (noLS quit)]
- ) [MenuId fileID]
- optionsmenu = Menu "Options"
- ( RadioMenu
- [ ("Slow" ,Nothing,Just '1',noLS (setSpeed easySpeed) )
- , ("Medium",Nothing,Just '2',noLS (setSpeed mediumSpeed))
- , ("Fast" ,Nothing,Just '3',noLS (setSpeed hardSpeed) )
- ] 1 []
- :+: MenuSeparator []
- :+: MenuItem "High Scores" [MenuShortKey 'h',MenuFunction (noLS showBest)]
- )
- [ MenuId levelID
- ]
- window = Window "Worm" NilLS
- [ WindowId windowID
- , WindowClose (noLS quit)
- , WindowKeyboard keyFilter Unable (noLS1 makeTurn)
- , WindowPen [PenBack wormBackGroundColour]
- , WindowViewDomain zero{corner2=Point2{x=488,y=303}}
- , WindowLook True (updateWindow (initState best))
- ]
- timer = Timer easySpeed NilLS [TimerId timerID, TimerSelectState Unable, TimerFunction (noLS1 oneStep)]
-
- -- The update function for the playfield window.
- updateWindow :: State -> SelectState -> UpdateState -> Draw ()
- updateWindow (State {gamelevel=gamelevel,food=food,points=points,worm=worm,lives=lives}) _ (UpdateState {updArea=updArea}) = do
- mapM_ unfill updArea
- drawGame gamelevel food points worm lives
-
- -- The function for the Play command.
- play :: State -> GUI State State
- play state = do
- disableMenus [levelID]
- disableMenuElements [playID,quitID]
- enableMenuElements [haltID]
- setTimerInterval timerID (speed (gamelevel state))
- enableWindowKeyboard windowID
- enableTimer timerID
- drawInWindow windowID (drawGame initlevel newfood initpoints initworm initlives)
- setWindowCursor windowID HiddenCursor
- return initstate
- where
- initlevel = initLevel (fix (gamelevel state))
- initworm = newWorm initlevel
- (newfood,foods1) = newFood initworm initlevel (foodsupply state)
- initpoints = 0
- initlives = nrOfWorms
- initstate = state
- { gamelevel = initlevel
- , food = newfood
- , foodsupply = foods1
- , grow = 0
- , points = initpoints
- , dir = rightKey
- , worm = initworm
- , lives = initlives
- }
-
- -- The functions for the Halt/Continue command(s).
- halt :: State -> GUI State State
- halt state = do
- setWindowCursor windowID StandardCursor
- disableWindowKeyboard windowID
- disableTimer timerID
- enableMenuElements [quitID]
- closeMenuElements fileID [haltID]
- openMenuElements fileID 1 undefined continue
- return state
- where
- continue = MenuItem "Continue" [MenuId contID, MenuShortKey '.', MenuFunction (noLS contf)]
-
- contf :: State -> GUI State State
- contf state = do
- enableWindowKeyboard windowID
- enableTimer timerID
- setWindowCursor windowID HiddenCursor
- disableMenuElements [quitID]
- closeMenuElements fileID [contID]
- openMenuElements fileID 1 undefined hlt
- return state
- where
- hlt = MenuItem "Halt" [MenuId haltID, MenuShortKey '.', MenuFunction (noLS halt)]
-
- -- The function for the Quit command: stop the program and write the high scores to file.
- quit :: State -> GUI State State
- quit state@(State {best=best}) = do
- state <- closeProcess state
- liftIO (writeHiScores hiScoresFile best)
- return state
-
- -- Set a new speed (called when one of the Options commands is chosen).
- setSpeed :: Int -> State -> GUI State State
- setSpeed fix state =
- return state{gamelevel=(gamelevel state){fix=fix,speed=fix}}
-
- -- Show the high scores.
- showBest :: State -> GUI State State
- showBest state@(State {best=best}) = showHiScores "Worm High Scores:" best state
-
- -- The MakeTurn function is called when an arrow key is pressed.
- keyFilter :: KeyboardState -> Bool
- keyFilter (SpecialKey key (KeyDown _) _) = key `elem` [downKey,leftKey,rightKey,upKey]
- keyFilter _ = False
-
- makeTurn :: KeyboardState -> State -> GUI State State
- makeTurn (SpecialKey key _ _) state@(State {dir=dir})
- | (dir==upKey || dir==downKey) && (key==leftKey || key==rightKey) = oneStep 1 state{dir=key}
- | (dir==leftKey || dir==rightKey) && (key==upKey || key==downKey ) = oneStep 1 state{dir=key}
- | otherwise = return state
-
- -- The function for the Timer device: do one step of the worm game.
- oneStep :: NrOfIntervals -> State -> GUI State State
- oneStep _ state@(State {gamelevel=gamelevel,food=food,foodsupply=foodsupply,grow=grow,points=points,dir=dir,worm=worm,best=best,lives=lives})
- | newlevel/=curlevel = switchLevel gamelevel foodsupply points2 points best lives state
- | otherwise =
- let
- state1 = state{food=food1,foodsupply=foods1,grow=grow1,points=points2,worm=worm1}
- in
- if collide
- then nextLife state1
- else do
- drawInWindow windowID (drawStep scored food food1 points2 (head worm) hd tl)
- return state1
- where
- (hd,tl,worm1) = stepWorm dir grow worm
- scored = hd==pos food
- collide = collision gamelevel worm hd
- (food1,foods1) = if scored then (newFood worm1 gamelevel foodsupply) else (food,foodsupply)
- grow1 = if scored then (grow+((value food)*3)`div`2) else (max 0 (grow-1))
- points1 = if scored then points+(value food)*(length worm1) `div` 2 else points
- points2 = if collide then max 0 (points1-100) else points1
- curlevel = points `div` pointsPerLevel
- newlevel = points2 `div` pointsPerLevel
-
- collision :: Level -> Worm -> Segment -> Bool
- collision level worm head
- = (not (inRectangle head (Rectangle {corner1=Point2{x=1,y=1},corner2=Point2{x=sizeX,y=sizeY}})))
- || (any (inRectangle head) (obstacles level))
- || (head `elem` worm)
- where
- inRectangle :: Point2 -> Obstacle -> Bool
- inRectangle (Point2 x y) (Rectangle (Point2 lx ty) (Point2 rx by)) =
- x>=lx && x<=rx && y>=ty && y<=by
-
- stepWorm :: SpecialKey -> Grow -> Worm -> (Segment,Segment,Worm)
- stepWorm dir 0 worm = (hd,tl,(hd:worm1))
- where
- (tl,worm1) = getAndRemoveLast worm
- hd = newHead dir (head worm)
-
- getAndRemoveLast :: [x] -> (x,[x])
- getAndRemoveLast [x] = (x,[])
- getAndRemoveLast (x:xs) = (x1,x:xs1)
- where
- (x1,xs1) = getAndRemoveLast xs
- stepWorm dir _ worm = (hd,zero,hd:worm)
- where
- hd = newHead dir (head worm)
-
- newHead :: SpecialKey -> Segment -> Segment
- newHead key segment@(Point2 x y)
- | key==upKey = segment{y=y-1}
- | key==downKey = segment{y=y+1}
- | key==leftKey = segment{x=x-1}
- | key==rightKey = segment{x=x+1}
- | otherwise = error ("newHead applied to unknown SpecialKey: "++show key)
-
- switchLevel :: Level -> [Food] -> Points -> Points -> HiScores -> Lives -> State -> GUI State State
- switchLevel curlevel foods newPoints oldPoints high lives state = do
- id <- openId
- nextLevelAnimation id newstate
- where
- newlevel = (if newPoints>oldPoints then increaseLevel else decreaseLevel) curlevel
- initworm = newWorm newlevel
- (newfood,foods1) = newFood initworm newlevel foods
- newstate = State
- { gamelevel = newlevel
- , food = newfood
- , foodsupply = foods1
- , grow = 0
- , points = newPoints
- , dir = rightKey
- , worm = initworm
- , best = high
- , lives = if newPoints>oldPoints then lives+1 else lives-1
- }
-
- nextLevelAnimation :: Id -> State -> GUI State State
- nextLevelAnimation id state = do
- disableWindowKeyboard windowID
- disableTimer timerID
- state <- openTimer (nrAnimationSteps,-1) (Timer (ticksPerSecond `div` 30) NilLS
- [ TimerId id
- , TimerFunction betweenLevels
- ]) state
- return state
- where
- nrAnimationSteps= 40
-
- betweenLevels :: NrOfIntervals -> GUIFun (Int,Int) State
- betweenLevels _ ((animationStep,step), state@(State{gamelevel=gamelevel,food=food,points=points,worm=worm,lives=lives}))
- | animationStep<=1 = return ((2,1),state)
- | animationStep<=nrAnimationSteps = do
- drawInWindow windowID (drawAnimation animationStep step)
- return ((animationStep+step,step),state)
- | otherwise = do
- drawInWindow windowID (drawGame gamelevel food points worm lives)
- enableTimer timerID
- closeTimer id
- enableWindowKeyboard windowID
- return ((animationStep,step),state)
-
- nextLife :: State -> GUI State State
- nextLife state@(State {gamelevel=gamelevel,foodsupply=foodsupply,points=points,best=best,worm=worm,lives=lives})
- | lives>0 =
- let
- (newfood,foods1)= newFood newworm gamelevel foodsupply
- newworm = newWorm gamelevel
-
- deadWormAlert :: Id -> Worm -> State -> GUI State State
- deadWormAlert id worm state = do
- disableTimer timerID
- disableWindowKeyboard windowID
- state <- openTimer worm (Timer (ticksPerSecond `div` 30) NilLS [TimerId id,TimerFunction deadWorm]) state
- return state
- where
- deadWorm :: NrOfIntervals -> GUIFun Worm State
- deadWorm _ (segment:rest,state) = do
- drawInWindow windowID (eraseSegment segment)
- return (rest,state)
- deadWorm _ (segments,state@(State {gamelevel=gamelevel,food=food,points=points,worm=worm,lives=lives})) = do
- drawInWindow windowID (drawGame gamelevel food points worm lives)
- enableTimer timerID
- closeTimer id
- enableWindowKeyboard windowID
- return (segments,state)
- in do
- id <- openId
- deadWormAlert id worm state{ food = newfood
- , foodsupply = foods1
- , grow = 0
- , dir = rightKey
- , worm = newworm
- , lives = lives-1
- }
- | otherwise =
- let
- dialog [overId,okId,editId]
- = Dialog "Game Over"
- ( TextControl "Game Over with a new high score!" [ControlPos (Left,zero)]
- :+: TextControl "Your name:" [ControlPos (Left,zero)]
- :+: EditControl "" (PixelWidth (hmm 45.0)) 1 [ControlId editId]
- :+: ButtonControl "OK" [ControlPos (Center,zero),ControlFunction (noLS overOK)]
- )
- [ WindowId overId
- , WindowOk okId
- , WindowItemSpace (hmm 6.0) (vmm 6.0)
- ]
- where
- overOK :: State -> GUI State State
- overOK state = do
- (_, mb_name) <- getControlText editId
- state <- (case mb_name of
- Nothing -> error "OK button could not retrieved."
- Just name -> addscore name state)
- closeWindow overId state
- where
- addscore :: String -> State -> GUI State State
- addscore name state@(State {points=points,best=curBest})
- | null name = return state
- | otherwise = do
- let newBest = addScore nrOfHiScores (HiScore{name=name,score=points}) curBest
- return state{best=newBest}
- in do
- enableMenus [levelID]
- enableMenuElements [playID,quitID]
- disableMenuElements [haltID]
- disableTimer timerID
- disableWindowKeyboard windowID
- setWindowCursor windowID StandardCursor
- (if (itsAHighScore nrOfHiScores points best)
- then do
- ids <- openIds 3
- openModalDialog undefined (dialog ids) state
- return state
- else return state)
- | otherwise = do
- openModalDialog undefined (Notice ["Game Over, no high score."] (NoticeButton "OK" return) []) state
- return state
- -}
\ No newline at end of file
--- 10,216 ----
! -- GUI constants.
hiScoresFile = "wormhi"
nrOfHiScores = 8
! -- Start of the program.
main :: IO ()
main = do
! hiscores <- readHiScores hiScoresFile
! start "Worm" "1.0" SDI [] (startWorm hiscores)
startWorm :: HiScores -> IO ()
startWorm best = do
! ref <- newIORef (initState best)
! -- File menu
! mfile <- menu [title =: "File"] mainMenu
! mnew <- menuitem [title =: "New", accel =: KeyChar '\^N'] mfile
! mplay <- menuitem [title =: "Play", accel =: KeyChar '\^P'] mfile
! menuline mfile
! mexit <- menuitem [title =: "Exit", on command =: halt] mfile
!
! -- Options menu
! mopts <- menu [title =: "Options"] mainMenu
! mspeed <- menuRadioGroup [] mopts
! menuRadioItem [title =: "Slow"
! ,on command =: onSetSpeed ref easySpeed
! ] mspeed
! menuRadioItem [title =: "Medium"
! , on command =: onSetSpeed ref mediumSpeed
! ] mspeed
! menuRadioItem [title =: "Fast"
! ,on command =: onSetSpeed ref hardSpeed
! ] mspeed
! menuline mopts
! menuitem [title =: "High Scores"
! ,accel =: KeyChar '\^S'
! ,on command =: onShowBest ref
! ] mopts
!
! -- Help menu
! mhelp <- menu [title =: "Help"] mainMenu
! menuitem [title =: "About Worm..."
! ,on command =: onAbout
! ] mhelp
!
! -- Main window
! w <- window [ bgcolor =: wormBackGroundColour
! , bkDrawMode =: True
! , view =: Size 488 303
! , on paint =: onPaint ref
! , on dismiss =: halt
! , resizeable =: False
! ]
!
! -- Timer
! tm <- timer [enabled =: False]
! set tm [on command =: onTimer ref mnew mopts mplay mexit tm w]
!
! set mplay [on command =: onPlay ref mnew mopts mplay mexit tm w]
! set mnew [on command =: onNew ref w]
onPaint ref can _ _ = do
! state <- readIORef ref
! drawGame state can
onNew ref w = do
! modifyIORef ref (initState . best)
! repaint w
onPlay ref mnew mopts mplay mexit tm w = do
! state <- readIORef ref
! set mplay [title =: "Stop"
! ,on command =: onStop ref mnew mopts mplay mexit tm w
! ]
! set mnew [enabled =: False]
! set mopts [enabled =: False]
! set mexit [enabled =: False]
! set w [on keyboard =: onKeyboard ref mnew mopts mplay mexit tm w]
! set tm [enabled =: True
! ,interval =: speed (gamelevel state)
! ]
onStop ref mnew mopts mplay mexit tm w = do
! set mplay [title =: "Play"
! ,on command =: onPlay ref mnew mopts mplay mexit tm w
! ]
! set mnew [enabled =: True]
! set mopts [enabled =: True]
! set mexit [enabled =: True]
! set w [off keyboard]
! set tm [enabled =: False]
!
onHalt ref mnew mopts mplay mexit tm w = do
! onStop ref mnew mopts mplay mexit tm w
! onNew ref w
!
onAbout = do
! logo <- readBitmap "logo.bmp" []
! runAboutDialog "Worm" "1.0"
! "(C) Krasimir Angelov, 2003"
! "The Worm is an example program
! freely distributed with HToolkit"
! [] [] [] logo Nothing
!
onSetSpeed ref speed =
! modifyIORef ref (\state -> state{gamelevel=
! (gamelevel state){fix=speed,speed=speed}})
onShowBest ref = do
! state <- readIORef ref
! showHiScores "Worm High Scores:" (best state)
onTimer ref mnew mopts mplay mexit tm w = do
! state <- readIORef ref
! let (event,state1) = stepGame state
! writeIORef ref state1
! case event of
! IncreaseLevel -> switchLevel state1
! DecreaseLevel -> switchLevel state1
! Collide -> nextLife state
! _ -> drawInWindow UnBuffered w (drawStep state state1)
! where
! switchLevel :: State -> IO ()
! switchLevel state@(State {gamelevel=gamelevel}) = do
! set w [off keyboard]
! set tm [interval =: 80
! ,on command =: betweenLevels nrAnimationSteps (-1)
! ]
! where
! betweenLevels :: Int -> Int -> IO ()
! betweenLevels animationStep step
! | animationStep<=1 =
! set tm [on command =: betweenLevels 2 1]
! | animationStep<=nrAnimationSteps = do
! drawInWindow UnBuffered w
! (drawAnimation animationStep step)
! set tm [on command =: betweenLevels (animationStep+step) step]
! | otherwise = do
! set tm [interval =: speed gamelevel
! ,on command =: onTimer ref mnew mopts mplay mexit tm w
! ]
! set w [on keyboard =: onKeyboard ref mnew mopts mplay mexit tm w]
! repaint w
!
! nextLife :: State -> IO ()
! nextLife state@(State {gamelevel=gamelevel
! ,foodsupply=foodsupply
! ,points=points
! ,best=best
! ,worm=worm
! ,lives=lives
! })
! | lives>0 =
! let
! deadWorm :: Worm -> IO ()
! deadWorm (segment:rest) = do
! drawInWindow UnBuffered w (eraseSegment segment)
! set tm [on command =: deadWorm rest]
! deadWorm [] = do
! set tm [interval =: speed gamelevel
! ,on command =: onTimer ref mnew mopts mplay mexit tm w
! ]
! set w [on keyboard =: onKeyboard ref mnew mopts mplay mexit tm w]
! repaint w
! in do
! set w [off keyboard]
! set tm [interval =: 100
! ,on command =: deadWorm worm
! ]
! | itsAHighScore nrOfHighScores points best = do
! onHalt ref mnew mopts mplay mexit tm w
! refName <- newIORef ""
! dlg <- dialog [] Nothing
! lbl1 <- label [title =: "Game Over with a new high score!"] dlg
! lbl2 <- label [title =: "Your name:"] dlg
! e <- entry [] dlg
! let onOK refName dlg e = do
! get e title >>= writeIORef refName
! destroyWidget dlg
! btnOK <- button [title =: "OK"
! ,on command =: onOK refName dlg e
! ] dlg
! set dlg [layout =: padding 5
! (lbl1 ^^^ padding 15 (lbl2 ^^^ hfill e) ^^^ hcenter btnOK)]
! runDialog dlg
! name <- readIORef refName
! when (name /= "") $ do
! let best' = addScore nrOfHighScores (HiScore name points) best
! writeHiScores hiScoresFile best'
! modifyIORef ref (\state -> state{best=best'})
! | otherwise = do
! onHalt ref mnew mopts mplay mexit tm w
! messageAlert "Game Over, no high score."
onKeyboard ref mnew mopts mplay mexit tm w (KeyDown key _) = do
! modifyIORef ref (\state@(State {dir=dir}) -> case key of
! KeyArrowUp _ | dir == West || dir == East -> state{dir=North}
! KeyArrowDown _ | dir == West || dir == East -> state{dir=South}
! KeyArrowLeft _ | dir == North || dir == South -> state{dir=West}
! KeyArrowRight _ | dir == North || dir == South -> state{dir=East}
! _ -> state)
! onTimer ref mnew mopts mplay mexit tm w
onKeyboard ref mnew mopts mplay mexit tm w _ = return ()
Index: WormShow.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/worm/WormShow.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** WormShow.hs 7 Jun 2003 18:30:05 -0000 1.1
--- WormShow.hs 21 Jun 2003 10:04:29 -0000 1.2
***************
*** 1,10 ****
module WormShow
! ( drawGame
! , drawStep
! , drawAnimation
! , eraseSegment
! , wormBackGroundColour
! , nrAnimationSteps
! ) where
import Graphics.UI.GIO
--- 1,10 ----
module WormShow
! ( drawGame
! , drawStep
! , drawAnimation
! , eraseSegment
! , wormBackGroundColour
! , nrAnimationSteps
! ) where
import Graphics.UI.GIO
***************
*** 13,117 ****
-- The drawing constants.
! wormBackGroundColour = lightyellow
! wormFontSize = 12 :: Int
! pointsPos = Point 72 15
! lifesPos = Point 255 5
! levelPos = Point 465 15
! cornerX = 15 :: Int
! cornerY = 23 :: Int
! segSize = 4 :: Int
! cellSize = 10 :: Int
! nrAnimationSteps = 40 :: Int
-- Draw the game.
drawGame :: State -> Canvas -> IO ()
! drawGame (State {gamelevel=Level {level=level,obstacles=obstacles},food=food,points=points,worm=worm,lives=lives}) can = do
! drawBorders can
! drawObstacles obstacles can
! drawPoints points can
! drawWorm worm can
! drawFood food can
! drawLevel level can
! drawLives lives can
! where
! drawObstacles :: [Obstacle] -> Canvas -> IO ()
! drawObstacles [] can = return ()
! drawObstacles obstacles can = do
! setCanvasPen can [color =: purple]
! mapM_ drawObstacle obstacles
! setCanvasPen can [color =: black]
! where
! drawObstacle :: Obstacle -> IO ()
! drawObstacle (Rect ltx lty rbx rby) =
! fillRect (Rect lx ty rx by) can
! where
! lx = cornerX+cellSize*ltx-2
! ty = cornerY+cellSize*lty-2
! rx = cornerX+cellSize*rbx+2
! by = cornerY+cellSize*rby+2
!
! drawPoints :: Points -> Canvas -> IO ()
! drawPoints points can = do
! setCanvasPen can [color =: magenta]
! drawString pointsPos{px=(px pointsPos) - 57} "Points: " can
! setCanvasPen can [color =: black]
! drawString pointsPos (show points) can
! drawWorm :: Worm -> Canvas -> IO ()
! drawWorm [] can = return ()
! drawWorm (head:rest) can = do
! mapM_ (\s -> drawSegment red s can) rest
! drawSegment lightgreen head can
! setCanvasPen can [color =: black]
! drawLevel :: Int -> Canvas -> IO ()
! drawLevel level can = do
! setCanvasPen can [color =: magenta]
! drawString levelPos{px=px levelPos-50} "Level: " can
! setCanvasPen can [color =: black]
! drawString levelPos (show level) can
! drawLives :: Lives -> Canvas -> IO ()
! drawLives lives can
! | lives /= 0 = drawLittleWorms lives can
! | otherwise = do
! setCanvasPen can [color =: magenta]
! drawString (Point (lx-63) (ly+10)) "No more worms!" can
! setCanvasPen can [color =: black]
! where
! Point lx ly = lifesPos
! drawLittleWorms :: Lives -> Canvas -> IO ()
! drawLittleWorms lives can
! | lives>0 = do
! drawLittleWorm lives can
! drawLittleWorms (lives-1) can
! | otherwise = do
! setCanvasPen can [color =: magenta]
! drawString (Point (lx-63) (ly+10)) "Worms:" can
! setCanvasPen can [color =: black]
! where
! drawLittleWorm :: Int -> Canvas -> IO ()
! drawLittleWorm n can = do
! setCanvasPen can [thickness=:5, color =: red]
! drawLine (Point x y) (Point (x+9) y) can
! setCanvasPen can [color =: lightgreen]
! drawLine (Point (x+9) y) (Point (x+14) y) can
! setCanvasPen can [thickness=:1, color =: black]
! where
! x = lx+20*((n-1) `div` 2)
! y = ly+ 7*((n-1) `mod` 2)
drawBorders :: Canvas -> IO ()
drawBorders can = do
! setCanvasPen can [color=:black, thickness=:3]
! drawRect (Rect (cornerX-3) (cornerY-3) (cornerX+sizeX*cellSize+11) (cornerY+sizeY*cellSize+11)) can
! setCanvasPen can [thickness=:1]
drawSegment :: Color -> Segment -> Canvas -> IO ()
drawSegment c (Point x y) can = do
! setCanvasPen can [color=:c]
! fillCircle (Point (cornerX+cellSize*x) (cornerY+cellSize*y)) segSize can
eraseSegment :: Segment -> Canvas -> IO ()
--- 13,122 ----
-- The drawing constants.
! wormBackGroundColour = lightyellow
! wormFontSize = 12 :: Int
! pointsPos = Point 72 15
! lifesPos = Point 255 5
! levelPos = Point 465 15
! cornerX = 15 :: Int
! cornerY = 23 :: Int
! segSize = 4 :: Int
! cellSize = 10 :: Int
! nrAnimationSteps = 40 :: Int
-- Draw the game.
drawGame :: State -> Canvas -> IO ()
! drawGame (State {gamelevel=Level {level=level,obstacles=obstacles}
! ,food=food
! ,points=points
! ,worm=worm
! ,lives=lives
! }) can = do
! drawBorders can
! drawObstacles obstacles can
! drawPoints points can
! drawWorm worm can
! drawFood food can
! drawLevel level can
! drawLives lives can
! where
! drawObstacles :: [Obstacle] -> Canvas -> IO ()
! drawObstacles [] can = return ()
! drawObstacles obstacles can = do
! setCanvasPen can [color =: purple]
! mapM_ drawObstacle obstacles
! setCanvasPen can [color =: black]
! where
! drawObstacle :: Obstacle -> IO ()
! drawObstacle (Rect ltx lty rbx rby) =
! fillRect (Rect lx ty rx by) can
! where
! lx = cornerX+cellSize*ltx-2
! ty = cornerY+cellSize*lty-2
! rx = cornerX+cellSize*rbx+2
! by = cornerY+cellSize*rby+2
! drawPoints :: Points -> Canvas -> IO ()
! drawPoints points can = do
! setCanvasPen can [color =: magenta]
! drawString pointsPos{px=(px pointsPos) - 57} "Points: " can
! setCanvasPen can [color =: black]
! drawString pointsPos (show points) can
! drawWorm :: Worm -> Canvas -> IO ()
! drawWorm [] can = return ()
! drawWorm (head:rest) can = do
! mapM_ (\s -> drawSegment red s can) rest
! drawSegment lightgreen head can
! setCanvasPen can [color =: black]
! drawLevel :: Int -> Canvas -> IO ()
! drawLevel level can = do
! setCanvasPen can [color =: magenta]
! drawString levelPos{px=px levelPos-50} "Level: " can
! setCanvasPen can [color =: black]
! drawString levelPos (show level) can
! drawLives :: Lives -> Canvas -> IO ()
! drawLives lives can
! | lives /= 0 = drawLittleWorms lives can
! | otherwise = do
! setCanvasPen can [color =: magenta]
! drawString (Point (lx-63) (ly+10)) "No more worms!" can
! setCanvasPen can [color =: black]
! where
! Point lx ly = lifesPos
+ drawLittleWorms :: Lives -> Canvas -> IO ()
+ drawLittleWorms lives can
+ | lives>0 = do
+ drawLittleWorm lives can
+ drawLittleWorms (lives-1) can
+ | otherwise = do
+ setCanvasPen can [color =: magenta]
+ drawString (Point (lx-63) (ly+10)) "Worms:" can
+ setCanvasPen can [color =: black]
+ where
+ drawLittleWorm :: Int -> Canvas -> IO ()
+ drawLittleWorm n can = do
+ setCanvasPen can [thickness=:5, color =: red]
+ drawLine (Point x y) (Point (x+9) y) can
+ setCanvasPen can [color =: lightgreen]
+ drawLine (Point (x+9) y) (Point (x+14) y) can
+ setCanvasPen can [thickness=:1, color =: black]
+ where
+ x = lx+20*((n-1) `div` 2)
+ y = ly+ 7*((n-1) `mod` 2)
drawBorders :: Canvas -> IO ()
drawBorders can = do
! setCanvasPen can [color=:black, thickness=:3]
! drawRect (Rect (cornerX-3) (cornerY-3)
! (cornerX+sizeX*cellSize+11) (cornerY+sizeY*cellSize+11)) can
! setCanvasPen can [thickness=:1]
drawSegment :: Color -> Segment -> Canvas -> IO ()
drawSegment c (Point x y) can = do
! setCanvasPen can [color=:c]
! fillCircle (Point (cornerX+cellSize*x) (cornerY+cellSize*y)) segSize can
eraseSegment :: Segment -> Canvas -> IO ()
***************
*** 120,150 ****
drawFood :: Food -> Canvas -> IO ()
drawFood (Food _ (Point x y)) can = do
! setCanvasPen can [color=:magenta]
! fillRect (Rect x1 y1 (x1+6) (y1+6)) can
! setCanvasPen can [color=:black]
! where
! x1 = cornerX+cellSize*x-3
! y1 = cornerY+cellSize*y-3
!
eraseFood :: Food -> Canvas -> IO ()
eraseFood (Food _ (Point x y)) can = do
! setCanvasPen can [color=:yellow]
! fillRect (Rect x1 y1 (x1+6) (y1+6)) can
! setCanvasPen can [color=:black]
! where
! x1 = cornerX+cellSize*x-3
! y1 = cornerY+cellSize*y-3
!
-- Show a step of the worm.
drawStep :: State -> State -> Canvas -> IO ()
! drawStep (State{food=oldfood,worm=oldworm}) (State{food=newfood,worm=newworm,points=points}) can = do
! eraseFood oldfood can
! drawFood newfood can
! drawString pointsPos (show points) can
! drawSegment red (head oldworm) can
! drawSegment lightgreen (head newworm) can
! when (length oldworm == length newworm) (drawSegment wormBackGroundColour (last oldworm) can)
! setCanvasPen can [color=:black]
--- 125,158 ----
drawFood :: Food -> Canvas -> IO ()
drawFood (Food _ (Point x y)) can = do
! setCanvasPen can [color=:magenta]
! fillRect (Rect x1 y1 (x1+6) (y1+6)) can
! setCanvasPen can [color=:black]
! where
! x1 = cornerX+cellSize*x-3
! y1 = cornerY+cellSize*y-3
!
eraseFood :: Food -> Canvas -> IO ()
eraseFood (Food _ (Point x y)) can = do
! setCanvasPen can [color=:yellow]
! fillRect (Rect x1 y1 (x1+6) (y1+6)) can
! setCanvasPen can [color=:black]
! where
! x1 = cornerX+cellSize*x-3
! y1 = cornerY+cellSize*y-3
!
-- Show a step of the worm.
drawStep :: State -> State -> Canvas -> IO ()
! drawStep (State{food=oldfood,worm=oldworm}) (State{food=newfood
! ,worm=newworm
! ,points=points}) can = do
! eraseFood oldfood can
! drawFood newfood can
! drawString pointsPos (show points) can
! drawSegment red (head oldworm) can
! drawSegment lightgreen (head newworm) can
! when (length oldworm == length newworm)
! (drawSegment wormBackGroundColour (last oldworm) can)
! setCanvasPen can [color=:black]
***************
*** 153,175 ****
drawAnimation 40 1 can = drawBorders can
drawAnimation n step can
! | step<0 = do
! setCanvasPen can [color=:wormBackGroundColour]
! fillRect (Rect l b x y) can
! fillRect (Rect r t x y) can
! setCanvasPen can [color=:black, thickness=:3]
! drawRect (Rect l t r b) can
! | otherwise = do
! setCanvasPen can [color=:wormBackGroundColour]
! fillRect (Rect l b x (y-4)) can
! fillRect (Rect r t (x-4) y ) can
! setCanvasPen can [color=:black, thickness=:3]
! drawRect (Rect l t r b) can
! where
! l = cornerX-3
! t = cornerY-3
! r = l+w*n
! b = t+h*n
! x = r-step*w
! y = b-step*h
! w = (48+sizeX*cellSize) `div` nrAnimationSteps
! h = (48+sizeY*cellSize) `div` nrAnimationSteps
--- 161,183 ----
drawAnimation 40 1 can = drawBorders can
drawAnimation n step can
! | step<0 = do
! setCanvasPen can [color=:wormBackGroundColour]
! fillRect (Rect l b x y) can
! fillRect (Rect r t x y) can
! setCanvasPen can [color=:black, thickness=:3]
! drawRect (Rect l t r b) can
! | otherwise = do
! setCanvasPen can [color=:wormBackGroundColour]
! fillRect (Rect l b x (y-4)) can
! fillRect (Rect r t (x-4) y ) can
! setCanvasPen can [color=:black, thickness=:3]
! drawRect (Rect l t r b) can
! where
! l = cornerX-3
! t = cornerY-3
! r = l+w*n
! b = t+h*n
! x = r-step*w
! y = b-step*h
! w = (48+sizeX*cellSize) `div` nrAnimationSteps
! h = (48+sizeY*cellSize) `div` nrAnimationSteps
Index: WormState.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/worm/WormState.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** WormState.hs 7 Jun 2003 18:30:05 -0000 1.1
--- WormState.hs 21 Jun 2003 10:04:29 -0000 1.2
***************
*** 1,25 ****
module WormState
! ( -- data structures
! State(..)
! , Direction(..)
! , Level(..)
! , Food(..)
! , GameEvent(..)
!
! -- type aliases
! , Grow, Obstacle, Segment, Worm, Points, Lives
!
! -- constants
! , sizeX, sizeY
! , nrOfWorms, nrOfLevels, nrOfHighScores
! , pointsPerLevel
! , startLevel
! , easySpeed, mediumSpeed, hardSpeed
! , accelation
!
! , initState
! , stepGame
! ) where
import Graphics.UI.GIO
--- 1,25 ----
module WormState
! ( -- data structures
! State(..)
! , Direction(..)
! , Level(..)
! , Food(..)
! , GameEvent(..)
! -- type aliases
! , Grow, Obstacle, Segment, Worm, Points, Lives
!
! -- constants
! , sizeX, sizeY
!
! , nrOfWorms, nrOfLevels, nrOfHighScores
! , pointsPerLevel
! , startLevel
! , easySpeed, mediumSpeed, hardSpeed
! , accelation
!
! , initState
! , stepGame
! ) where
import Graphics.UI.GIO
***************
*** 28,263 ****
! -- The worm data types.
data State
= State
! { gamelevel :: Level
! , food :: Food
! , foodsupply :: [Food]
! , grow :: Grow
! , points :: Points
! , dir :: Direction
! , worm :: Worm
! , best :: HiScores
! , lives :: Lives
! }
data Direction
= North | West | East | South deriving Eq
data Level
= Level
! { fix :: Int
! , speed :: Int
! , level :: Int
! , obstacles :: [Obstacle]
! }
data Food = Food Int Point
! type Grow = Int
! type Obstacle = Rect
! type Segment = Point
! type Worm = [Segment]
! type Points = Int
! type Lives = Int
data GameEvent
= Scored | Collide | IncreaseLevel | DecreaseLevel | None deriving Show
! sizeX = 45 :: Int
! sizeY = 26 :: Int
! nrOfWorms = 4 :: Int
! nrOfLevels = 8 :: Int
! nrOfHighScores = 10 :: Int
! pointsPerLevel = 500 :: Int
! startLevel = 0 :: Int
! easySpeed = 300 :: Int
! mediumSpeed = 200 :: Int
! hardSpeed = 100 :: Int
! accelation = 100 :: Int
! -- Initial State.
initState :: HiScores -> State
initState best =
! State
! { gamelevel = initlevel
! , food = food
! , foodsupply = foodsupply
! , grow = 0
! , points = 0
! , dir = East
! , worm = initworm
! , best = best
! , lives = nrOfWorms
! }
! where
! (food,foodsupply) = newFood initworm initlevel (randoms (mkStdGen 0))
! initlevel = initLevel easySpeed
! initworm = newWorm initlevel
stepGame :: State -> (GameEvent,State)
stepGame state@(State { gamelevel=curlevel
! , food=food@(Food value pos)
! , foodsupply=foodsupply
! , grow=grow
! , points=points
! , dir=dir
! , worm=worm
! , best=best
! , lives=lives
! })
! | levelpoints > levelpoints1 =
! let
! newlevel = decreaseLevel curlevel
! (food1,foodsupply1) = newFood worm1 newlevel foodsupply
! initworm = newWorm newlevel
! in (DecreaseLevel,state
! { food=food1
! , foodsupply=foodsupply1
! , grow=0
! , points=points1
! , worm=initworm
! , gamelevel=newlevel
! , dir=East
! , lives=lives-1
! })
! | levelpoints1 > levelpoints =
! let
! newlevel = increaseLevel curlevel
! (food1,foodsupply1) = newFood worm1 newlevel foodsupply
! initworm = newWorm newlevel
! in (IncreaseLevel,state
! { food=food1
! , foodsupply=foodsupply1
! , grow=0
! , points=points1
! , worm=initworm
! , gamelevel=newlevel
! , dir=East
! , lives=lives+1
! })
! | scored =
! let
! (food1,foodsupply1) = newFood worm1 curlevel foodsupply
! in (Scored,state
! { food=food1
! , foodsupply=foodsupply1
! , grow=grow1
! , points=points1
! , worm=worm1
! })
! | collide= (Collide,state
! { grow=0
! , points=points1
! , worm=newWorm curlevel
! , dir=East
! , lives=lives-1
! })
! | otherwise = (None,state
! { grow=grow1
! , worm=worm1
! })
! where
! levelpoints = points `div` pointsPerLevel
! levelpoints1 = points1 `div` pointsPerLevel
!
! hd = newHead dir (head worm)
!
! worm1 | grow == 0 = hd : init worm
! | otherwise = hd : worm
!
! grow1 | scored = grow+(value*3) `div` 2
! | otherwise = max 0 (grow-1)
!
! points1 | scored = points+value*(length worm1) `div` 2
! | collide = max 0 (points-100)
! | otherwise = points
!
! collide = (not (pointInRect hd (Rect 1 1 sizeX sizeY)))
! || (any (pointInRect hd) (obstacles curlevel))
! || (hd `elem` worm)
!
! scored = hd == pos
! newHead :: Direction -> Segment -> Segment
! newHead North (Point x y) = Point x (y-1)
! newHead South (Point x y) = Point x (y+1)
! newHead West (Point x y) = Point (x-1) y
! newHead East (Point x y) = Point (x+1) y
!
!
! -- Make a new initial worm.
newWorm :: Level -> Worm
newWorm Level{level=level} =
! [Point x y | x<-[5,4..1]]
! where
! y = startHeights !! (level `mod` nrOfLevels)
startHeights :: [Int]
startHeights = [13,5,13,13,13,1,1,14]
!
! -- Construct the next level.
initLevel :: Int -> Level
initLevel fix =
! Level {fix=fix,speed=fix,level=startLevel,obstacles=sampleObstacles!!startLevel}
decreaseLevel :: Level -> Level
decreaseLevel curlevel@(Level {speed=speed,level=level}) =
! let
! newLevel = level-1
! newSpeed = if level `mod` nrOfLevels==0 && level/=0 then speed+accelation else speed
! in
! curlevel
! { fix = newSpeed
! , speed = newSpeed
! , level = newLevel
! , obstacles = sampleObstacles !! (newLevel `mod` nrOfLevels)
! }
increaseLevel :: Level -> Level
increaseLevel curlevel@(Level {speed=speed,level=level}) =
! let
! newLevel = level+1
! newSpeed = if level `mod` nrOfLevels==0 && level/=0 then speed-accelation else speed
! in
! curlevel
! { fix = newSpeed
! , speed = newSpeed
! , level = newLevel
! , obstacles = sampleObstacles !! (newLevel `mod` nrOfLevels)
! }
sampleObstacles :: [[Obstacle]]
sampleObstacles =
! [ []
! , [Rect 12 11 34 16]
! , [Rect 12 1 34 3, Rect 12 24 34 26]
! , [Rect 7 7 38 9, Rect 7 17 38 19]
! , [Rect 1 1 18 10, Rect 28 17 45 26]
! , [Rect 14 3 15 24, Rect 30 3 31 24]
! , [Rect 3 13 43 14, Rect 22 3 24 24]
! , [Rect 3 3 20 12, Rect 26 15 43 24]
! ]
! -- Generate a food supply.
instance Random Food where
! random seed = (Food value pos, seed3)
! where
! (random1,seed1) = random seed
! (random2,seed2) = random seed1
! (random3,seed3) = random seed2
! foodx = (incMod random2 (sizeX-2))+1
! foody = (incMod random3 (sizeY-2))+1
! pos = Point foodx foody
! value = incMod random1 9
! incMod a b = (a `mod` b)+1
! randomR _ seed = random seed
! -- Think of some new random food.
newFood :: Worm -> Level -> [Food] -> (Food, [Food])
newFood worm level@(Level {obstacles=obstacles}) (food@(Food _ pos):foods)
! | pos `elem` worm || any (pointInRect pos) obstacles = newFood worm level foods
! | otherwise = (food, foods)
--- 28,259 ----
! -- The worm data types.
data State
= State
! { gamelevel :: Level
! , food :: Food
! , foodsupply :: [Food]
! , grow :: Grow
! , points :: Points
! , dir :: Direction
! , worm :: Worm
! , best :: HiScores
! , lives :: Lives
! }
data Direction
= North | West | East | South deriving Eq
data Level
= Level
! { fix :: Int
! , speed :: Int
! , level :: Int
! , obstacles :: [Obstacle]
! }
data Food = Food Int Point
! type Grow = Int
! type Obstacle = Rect
! type Segment = Point
! type Worm = [Segment]
! type Points = Int
! type Lives = Int
data GameEvent
= Scored | Collide | IncreaseLevel | DecreaseLevel | None deriving Show
! sizeX = 45 :: Int
! sizeY = 26 :: Int
! nrOfWorms = 4 :: Int
! nrOfLevels = 8 :: Int
! nrOfHighScores = 10 :: Int
! pointsPerLevel = 500 :: Int
! startLevel = 0 :: Int
! easySpeed = 300 :: Int
! mediumSpeed = 200 :: Int
! hardSpeed = 100 :: Int
! accelation = 100 :: Int
! -- Initial State.
initState :: HiScores -> State
initState best =
! State
! { gamelevel = initlevel
! , food = food
! , foodsupply = foodsupply
! , grow = 0
! , points = 0
! , dir = East
! , worm = initworm
! , best = best
! , lives = nrOfWorms
! }
! where
! (food,foodsupply) = newFood initworm initlevel (randoms (mkStdGen 0))
! initlevel = initLevel easySpeed
! initworm = newWorm initlevel
stepGame :: State -> (GameEvent,State)
stepGame state@(State { gamelevel=curlevel
! , food=food@(Food value pos)
! , foodsupply=foodsupply
! , grow=grow
! , points=points
! , dir=dir
! , worm=worm
! , best=best
! , lives=lives
! })
! | levelpoints > levelpoints1 =
! let
! newlevel = decreaseLevel curlevel
! (food1,foodsupply1) = newFood worm1 newlevel foodsupply
! initworm = newWorm newlevel
! in (DecreaseLevel,state
! { food=food1
! , foodsupply=foodsupply1
! , grow=0
! , points=points1
! , worm=initworm
! , gamelevel=newlevel
! , dir=East
! , lives=lives-1
! })
! | levelpoints1 > levelpoints =
! let
! newlevel = increaseLevel curlevel
! (food1,foodsupply1) = newFood worm1 newlevel foodsupply
! initworm = newWorm newlevel
! in (IncreaseLevel,state
! { food=food1
! , foodsupply=foodsupply1
! , grow=0
! , points=points1
! , worm=initworm
! , gamelevel=newlevel
! , dir=East
! , lives=lives+1
! })
! | scored =
! let
! (food1,foodsupply1) = newFood worm1 curlevel foodsupply
! in (Scored,state
! { food=food1
! , foodsupply=foodsupply1
! , grow=grow1
! , points=points1
! , worm=worm1
! })
! | collide= (Collide,state
! { grow=0
! , points=points1
! , worm=newWorm curlevel
! , dir=East
! , lives=lives-1
! })
! | otherwise = (None,state
! { grow=grow1
! , worm=worm1
! })
! where
! levelpoints = points `div` pointsPerLevel
! levelpoints1 = points1 `div` pointsPerLevel
! hd = newHead dir (head worm)
!
! worm1 | grow == 0 = hd : init worm
! | otherwise = hd : worm
!
! grow1 | scored = grow+(value*3) `div` 2
! | otherwise = max 0 (grow-1)
!
! points1 | scored = points+value*(length worm1) `div` 2
! | collide = max 0 (points-100)
! | otherwise = points
!
! collide = (not (pointInRect hd (Rect 1 1 sizeX sizeY)))
! || (any (pointInRect hd) (obstacles curlevel))
! || (hd `elem` worm)
!
! scored = hd == pos
!
! newHead :: Direction -> Segment -> Segment
! newHead North (Point x y) = Point x (y-1)
! newHead South (Point x y) = Point x (y+1)
! newHead West (Point x y) = Point (x-1) y
! newHead East (Point x y) = Point (x+1) y
!
! -- Make a new initial worm.
newWorm :: Level -> Worm
newWorm Level{level=level} =
! [Point x y | x<-[5,4..1]]
! where
! y = startHeights !! (level `mod` nrOfLevels)
startHeights :: [Int]
startHeights = [13,5,13,13,13,1,1,14]
! -- Construct the next level.
initLevel :: Int -> Level
initLevel fix =
! Level {fix=fix,speed=fix,level=startLevel,obstacles=sampleObstacles!!startLevel}
decreaseLevel :: Level -> Level
decreaseLevel curlevel@(Level {speed=speed,level=level}) =
! let
! newLevel = level-1
! newSpeed = if level `mod` nrOfLevels==0 && level/=0 then speed+accelation else speed
! in
! curlevel{ fix = newSpeed
! , speed = newSpeed
! , level = newLevel
! , obstacles = sampleObstacles !! (newLevel `mod` nrOfLevels)
! }
increaseLevel :: Level -> Level
increaseLevel curlevel@(Level {speed=speed,level=level}) =
! let
! newLevel = level+1
! newSpeed = if level `mod` nrOfLevels==0 && level/=0 then speed-accelation else speed
! in
! curlevel{ fix = newSpeed
! , speed = newSpeed
! , level = newLevel
! , obstacles = sampleObstacles !! (newLevel `mod` nrOfLevels)
! }
...
[truncated message content] |