Menu
▾
▴
htoolkit-cvs
|
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]
! ...
[truncated message content] |
Thanks for helping keep SourceForge clean.
X