[htoolkit-cvs] gio/src/examples/worm HighScore.hs,1.1,1.2 Main.hs,1.3,1.4 WormShow.hs,1.1,1.2 WormState.hs,1.1,1.2

[<kr_...@us...>]

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]