Commit f6da700f45f1fa4cfb996300b336ab1207922e04 - raincat

+3

-0

.gitignore less more

	0	*.o
	1	*.hi
	2	dist⏎

+14

-3

README less more

6	6	----------------------
7	7	./raincat
8	8
	9	COMPILATION:
	10	----------------------
	11	runhaskell Setup.lhs --user configure
	12	runhaskell Setup.lhs build
	13	runhaskell Setup.lhs install
	14
	15	Alternative method: cabal install Raincat
9	16
10	17	CHANGELOG:
11	18	----------
	19	Version 1.2:
	20	- Ported to SDL2
12	21	Version 1.1:
13	22	- Changed initial item placement from click to select, click to place
14	23	to drag n' drop.

27	36	Runtimes for the following libraries are assumed to be installed:
28	37	GLUT
29	38	OpenGL
30		SDL
31		SDL_image
32		SDL_mixer
	39	SDL2
	40	SDL2_image
	41	SDL2_mixer
33	42
34	43
35	44	TROUBLESHOOTING:

59	68	-------------------
60	69	Mikhail Pobolovets - Programmer
61	70	Sergei Trofimovich - Programmer
	71	Raahul Kumar - Programmer
	72	Alvaro F. García - Programmer

+6

-8

Raincat.cabal less more

0	0	name: Raincat
1		version: 1.1.1.2
	1	version: 1.2.1
2	2	cabal-version: >= 1.8
3	3	build-type: Simple
4	4	license: BSD3

21	21	Sergei Trofimovich
22	22
23	23	stability: stable
24		tested-with: GHC==6.12.1
	24	tested-with: GHC==7.6.2
25	25	data-files: LICENSE README
26	26	data/effects/.png data/cat/cat-walk/.png data/cat/cat-idle/*.png
27	27	data/music/.ogg data/levels/skyline/.lvl data/levels/movement1/*.lvl

54	54	time,
55	55	GLUT,
56	56	OpenGL,
57		SDL,
58		SDL-image,
59		SDL-mixer
60
	57	sdl2,
	58	sdl2-image,
	59	sdl2-mixer
61	60	other-modules:
62	61	Cat.Cat
63	62	Error.Error

76	75	Menu.PostVictory
77	76	Nxt.Audio
78	77	Nxt.Graphics
79		Nxt.Input
80	78	Nxt.Types
81	79	Panels.ItemPanel
82	80	Panels.MainPanel
83	81	Panels.MessagePanel
	82	Paths_Raincat
84	83	Program.Program
85	84	Rain.Rain
86	85	Settings.CatSettings

89	88	Settings.RainSettings
90	89	Settings.UISettings
91	90	Settings.WorldSettings
92		UI.ItemPanel
93	91	World.World

+0

-0

Setup.lhs less more

(No changes)

+4

-5

src/Cat/Cat.hs less more

134	134	updateCatVel c@(Cat (catPosX, catPosY) _ catDir _ _ _ _) (newVelX, newVelY) =
135	135	c {catPos = (catPosX + newVelX, catPosY + newVelY), catVelocity = (newVelX, newVelY),
136	136	catDirection = newDir}
137		where newDir = if newVelX < 0.0
138		then DirLeft
139		else if newVelX > 0.0
140		then DirRight
141		else catDir
	137	where newDir
	138	\| newVelX < 0.0 = DirLeft
	139	\| newVelX > 0.0 = DirRight
	140	\| otherwise = catDir
142	141
143	142	-- updateCatPos
144	143	updateCatPos :: Cat -> Nxt.Types.Vector2d -> Cat

+8

-7

src/Game/GameGraphics.hs less more

1	1	(gameDraw) where
2	2
3	3	import Data.Maybe
	4	import Data.Foldable (forM_)
4	5	import Graphics.UI.GLUT as Glut
5	6	import Data.IORef
6	7	import World.World

93	94	-- drawItems
94	95	drawItems :: WorldState -> IO ()
95	96	drawItems worldState = do
96		let itemlist = (MainPanel.itemList (mainPanel worldState))
97		corklist = (MainPanel.corkList (mainPanel worldState))
98		tarplist = (MainPanel.tarpList (mainPanel worldState))
	97	let itemlist = MainPanel.itemList (mainPanel worldState)
	98	corklist = MainPanel.corkList (mainPanel worldState)
	99	tarplist = MainPanel.tarpList (mainPanel worldState)
99	100
100	101	mapM_ drawItem itemlist
101	102	mapM_ drawItem corklist

107	108	let (mousex, mousey) = translateMousePos mousePos winW winH
108	109
109	110	let placingItem' = MainPanel.placingItem $ mainPanel worldState
110		(when (isJust placingItem') $
111		drawItemAt (mousex - cameraX) (mousey - cameraY) (fromJust placingItem'))
	111	forM_ placingItem'
	112	(drawItemAt (mousex - cameraX) (mousey - cameraY))
112	113
113	114	-- drawPanels
114	115	drawPanels :: WorldState -> IO ()

128	129
129	130	-- message panel: message
130	131	let messagePanelStr = messageDisplay (messagePanel worldState)
131		(when (messagePanelStr /= "") $
	132	when (messagePanelStr /= "") $
132	133	sequence_
133	134	[drawRect UISettings.messagePanelRect UISettings.messagePanelColor,
134		drawString 80.0 739.0 messagePanelStr (Color4 0.0 0.0 0.0 1.0)])
	135	drawString 80.0 739.0 messagePanelStr (Color4 0.0 0.0 0.0 1.0)]
135	136
136	137	-- drawDebug
137	138	{-

+1

-1

src/Game/GameInput.hs less more

78	78
79	79	-- quit key
80	80	keyboardAct _ (Char 'q') Down =
81		exitWith ExitSuccess
	81	exitSuccess
82	82
83	83	-- left mouse button
84	84	keyboardAct keysStateRef (MouseButton LeftButton) Down = do

+41

-39

src/Game/GameMain.hs less more

47	47
48	48	-- update camera pos
49	49	let (cameraX, cameraY) = cameraPos $ mainPanel worldState
50		cameraX' = if leftKeyDown keys' && cameraX < 0.0
51		then cameraX + WorldSettings.cameraSpeed
52		else
53		if rightKeyDown keys' && cameraX > -(fromIntegral $ levelWidth lvl :: Double) + fromGLdouble screenResWidth
54		then cameraX - WorldSettings.cameraSpeed
55		else cameraX
56		cameraY' = if upKeyDown keys' && cameraY > 0.0
57		then cameraY - WorldSettings.cameraSpeed
58		else
59		if downKeyDown keys' && cameraY < (fromIntegral $ levelHeight lvl :: Double) - fromGLdouble screenResHeight
60		then cameraY + WorldSettings.cameraSpeed
61		else cameraY
62
	50	cameraX'
	51	\| leftKeyDown keys' && cameraX < 0.0 =
	52	cameraX + WorldSettings.cameraSpeed
	53	\| rightKeyDown keys' &&
	54	cameraX >
	55	(-(fromIntegral $ levelWidth lvl :: Double)) +
	56	fromGLdouble screenResWidth
	57	= cameraX - WorldSettings.cameraSpeed
	58	\| otherwise = cameraX
	59	cameraY'
	60	\| upKeyDown keys' && cameraY > 0.0 =
	61	cameraY - WorldSettings.cameraSpeed
	62	\| downKeyDown keys' &&
	63	cameraY <
	64	(fromIntegral $ levelHeight lvl :: Double) -
	65	fromGLdouble screenResHeight
	66	= cameraY + WorldSettings.cameraSpeed
	67	\| otherwise = cameraY
63	68	-- update rain
64	69	rain' <- updateRain worldState
65	70
66	71	-- update go/stop state
67		let goStopState' = if catItemName c == "Hurt" && isJust (catItemDuration c) && fromJust (catItemDuration c) == 1
	72	let goStopState' = if catItemName c == "Hurt" && (catItemDuration c == Just 1)
68	73	then GoState
69	74	else goStopState $ goStopButton $ itemPanel worldState
70	75	where c = cat mainpanel

116	121	-- update fire hydrants
117	122	let _ = if catItemName cat' == "Wrench"
118	123	then foldr (\fh fhList -> if rectIntersect (catHitbox cat') (fireHydrantRect fh)
119		then case (fireHydrantDir fh) of
	124	then case fireHydrantDir fh of
120	125	DirLeft -> if fst (catPos cat') > (rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh))
121	126	then (fh {fireHydrantDisabled = True}):fhList
122	127	else fh:fhList

129	134	let fireHydrants' = updateFireHydrants goStopState' cat' worldState
130	135
131	136	-- update game state (menu, post victory)
132		let gameState' = if escKeyDown keys'
133		then MainMenuState
134		else if catItemName cat' == "Win" && isJust (catItemDuration cat') && fromJust (catItemDuration cat') == 1
135		then PostVictoryState
136		else GameRunningState
	137	let gameState'
	138	\| escKeyDown keys' = MainMenuState
	139	\| catItemName cat' == "Win" && (catItemDuration cat' == Just 1) =
	140	PostVictoryState
	141	\| otherwise = GameRunningState
137	142
138	143	-- update panels
139	144	let mainPanel' = mainpanel {cameraPos = (cameraX', cameraY'), raindrops = rain', cat = cat', curItem = item',

163	168	updateFireHydrants StopState theCat worldState =
164	169	let fireHydrantsL = if catItemName theCat == "Wrench"
165	170	then foldr (\fh fhList -> if rectIntersect (catHitbox theCat) (fireHydrantRect fh)
166		then case (fireHydrantDir fh) of
	171	then case fireHydrantDir fh of
167	172	DirLeft -> if fst (catPos theCat) > (rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh))
168	173	then (fh {fireHydrantDisabled = True}):fhList
169	174	else fh:fhList

228	233	else countValid) True itemButList
229	234
230	235	let placeItem = forceItemEval && lMousePrevDown keys && not (lMouseDown keys) && not curItemIntersects && mousex < maxWorldX && itemName item' /= "Eraser" && itemCountValid && isJust (placingItem mainpanel)
231		let placingItem' = if placeItem \|\| not (lMouseDown keys)
232		then Nothing
233		else if lMouseDown keys && itemName item' /= "Eraser" && itemCountValid
234		then if isJust (placingItem mainpanel)
235		then placingItem mainpanel
236		else Just item'
237		else Nothing
	236	let placingItem'
	237	\| placeItem \|\| not (lMouseDown keys) = Nothing
	238	\| lMouseDown keys && itemName item' /= "Eraser" && itemCountValid =
	239	if isJust (placingItem mainpanel) then placingItem mainpanel else
	240	Just item'
	241	\| otherwise = Nothing
238	242
239	243	-- placing new item in world
240	244	let (itemList', corkList', tarpList') = if placeItem
241		then case (itemName item') of
	245	then case itemName item' of
242	246	"Cork" -> (itemListE, item':corkListE, tarpListE)
243	247	"Tarp" -> (itemListE, corkListE, item':tarpListE)
244	248	"Eraser" -> (itemListE, corkListE, tarpListE)

307	311
308	312	-- gravity
309	313	(velXg, velYg) <- get
310		put (if catitemname /= "UpsUmbrellaActive" && catitemname /= "Hurt" && catitemname /= "Win"
	314	put (if catitemname `notElem` ["UpsUmbrellaActive", "Hurt", "Win"]
311	315	then (velXg, velYg + gravity)
312	316	else (velXg, velYg))
313	317

364	368
365	369	catWetFromFireHydrant = isJust catTouchedFireHydrant &&
366	370	let fh = fromJust catTouchedFireHydrant
367		in if fireHydrantDisabled fh \|\| catitemname == "Shield"
368		then False
369		else case fireHydrantDir fh of
	371	in (not (fireHydrantDisabled fh \|\| catitemname == "Shield") &&
	372	(case fireHydrantDir fh of
370	373	DirLeft -> if catitemname == "Poncho"
371	374	then case catdirection of
372	375	DirLeft -> False

376	379	then case catdirection of
377	380	DirRight -> False
378	381	_ -> rectX catrect + rectWidth catrect < rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh)
379		else rectX catrect + rectWidth catrect > rectX (fireHydrantRect fh) + 100
	382	else rectX catrect + rectWidth catrect > rectX (fireHydrantRect fh) + 100))
380	383
381	384	catIsWet = catWetFromPuddle \|\| catWetFromRain \|\| catWetFromFireHydrant
382	385

483	486	catRectResponse (catX, catY) (catVelX, catVelY) catDir (Rect catRX catRY catRW catRH) (Rect rectx recty rectwidth rectheight) =
484	487	let displaceY = (recty + rectheight) - catY
485	488	displaceDownY = (recty + rectheight) - (catRY + catRH)
486		displaceX = if catVelX < 0.0
487		then (rectx + rectwidth) - catRX
488		else if catVelX > 0.0
489		then rectx - (catRX + catRW)
490		else 0.0
	489	displaceX
	490	\| catVelX < 0.0 = (rectx + rectwidth) - catRX
	491	\| catVelX > 0.0 = rectx - (catRX + catRW)
	492	\| otherwise = 0.0
491	493	oppDir = case catDir of
492	494	DirLeft -> DirRight
493	495	DirRight -> DirLeft

+2

-2

src/Input/InputState.hs less more

46	46	translateMousePos (MousePos x y) winW winH =
47	47	let x' = fromIntegral x
48	48	sW' = fromGLdouble screenResWidth :: Double
49		wW' = (fromIntegral (fromGLsizei winW))
	49	wW' = fromIntegral (fromGLsizei winW)
50	50	y' = fromIntegral y
51	51	sH' = fromGLdouble screenResHeight :: Double
52		wH' = (fromIntegral (fromGLsizei winH))
	52	wH' = fromIntegral (fromGLsizei winH)
53	53	in (x' * (sW' / wW'),
54	54	sH' - ((sH' - y') * (sH' / wH')))
55	55

+5

-4

src/Items/ItemEffects.hs less more

59	59	-- Hair Dryer
60	60	hairDryerEffect :: Cat -> Cat
61	61	hairDryerEffect cat =
62		let (velX, velY) = (catVelocity cat)
	62	let (velX, velY) = catVelocity cat
63	63	in updateCatVel cat (-velX, velY)
64	64
65	65	-- Speed Boots

68	68	let speedBootsTex = speedBootsTextures $ catAnimations cat
69	69	vel = (case catDirection cat of
70	70	DirRight -> CatSettings.catSpeedVelX
71		DirLeft -> (-CatSettings.catSpeedVelX),
	71	DirLeft -> -CatSettings.catSpeedVelX,
72	72	snd $ catVelocity cat)
73	73	in updateCatVel (cat {catTexture = speedBootsTex, catItemName = "SpeedBoots",
74	74	catItemDuration = Just CatSettings.catSpeedDuration}) vel

129	129	let skateboardTex = skateboardTextures $ catAnimations cat
130	130	vel = (case catDirection cat of
131	131	DirRight -> CatSettings.catSkateVelX
132		DirLeft -> (-CatSettings.catSkateVelX),
133		snd (catVelocity cat))
	132	-- DirLeft -> (-CatSettings.catSkateVelX),
	133	-- snd (catVelocity cat))
	134	DirLeft -> -CatSettings.catSkateVelX,snd (catVelocity cat))
134	135	in updateCatVel (cat {catTexture = skateboardTex, catItemName = "Skateboard",
135	136	catItemDuration = Just CatSettings.catSkateDuration}) vel
136	137

+1

-1

src/Main.hs less more

27	27
28	28	mainLoop
29	29
30		exitWith ExitSuccess
	30	exitSuccess

+1

-1

src/Menu/PostVictory.hs less more

30	30	else c
31	31	cat' = updateCatItemDuration $ updateCatAnim catLaser
32	32
33		let gameState' = if catPos cat' == (540.0, 340.0) && isJust (catItemDuration cat') && fromJust (catItemDuration cat') == 1
	33	let gameState' = if catPos cat' == (540.0, 340.0) && (catItemDuration cat' == Just 1)
34	34	then MainMenuState
35	35	else PostVictoryState
36	36

+11

-8

src/Nxt/Audio.hs less more

3	3	loadMusic,
4	4	playMusic) where
5	5
6		import qualified Graphics.UI.SDL.Mixer.General as SDL.Mixer
7		import qualified Graphics.UI.SDL.Mixer.Music as SDL.Mixer.Music
8		import qualified Graphics.UI.SDL.Mixer.Types as SDL.Mixer.Types
	6	import qualified SDL.Mixer
9	7
10		type Music = SDL.Mixer.Types.Music
	8	type Music = SDL.Mixer.Music
11	9
12	10	-- initAudio
13	11	initAudio :: IO ()
14		initAudio = SDL.Mixer.openAudio 44100 SDL.Mixer.AudioS16Sys 2 4096
	12	initAudio =
	13	let audio = SDL.Mixer.Audio
	14	{ SDL.Mixer.audioFrequency = 44100
	15	, SDL.Mixer.audioFormat = SDL.Mixer.FormatS16_Sys
	16	, SDL.Mixer.audioOutput = SDL.Mixer.Stereo }
	17	in SDL.Mixer.openAudio audio 4096
15	18
16	19	-- loadMusic
17	20	loadMusic :: String -> IO Music
18		loadMusic = SDL.Mixer.Music.loadMUS
	21	loadMusic = SDL.Mixer.load
19	22
20	23	-- playMusic
21	24	playMusic :: Music -> IO ()
22	25	playMusic m = do
23		SDL.Mixer.Music.setMusicVolume 50
24		SDL.Mixer.Music.playMusic m (-1)
	26	SDL.Mixer.setMusicVolume 50
	27	SDL.Mixer.playMusic SDL.Mixer.Forever m
25	28

+19

-11

src/Nxt/Graphics.hs less more

	0	{-# LANGUAGE CPP #-}
0	1	module Nxt.Graphics
1	2	(begin,
2	3	end,

19	20	import Control.Monad
20	21	import Graphics.UI.GLUT as GLUT hiding (windowSize, windowTitle)
21	22	import Graphics.Rendering.OpenGL as GL
22		import Graphics.UI.SDL.Image as SDLImage
23		import Graphics.UI.SDL.Types
24		import Graphics.UI.SDL.Video
	23	import qualified SDL.Image as SDLImage hiding (loadTexture)
	24	import qualified SDL.Vect
	25	import qualified SDL.Video
25	26	import Nxt.Types hiding (rectX, rectY, rectWidth, rectHeight)
26	27	import Unsafe.Coerce
27	28

73	74	-- loadTexture (only specified to load PNGs)
74	75	loadTexture :: String -> IO Nxt.Types.Texture
75	76	loadTexture textureFilePath = do
76		surface <- SDLImage.loadTyped textureFilePath SDLImage.PNG
77
78		let width = fromIntegral (surfaceGetWidth surface)
79		let height = fromIntegral (surfaceGetHeight surface)
	77	surface <- SDLImage.load textureFilePath
	78
	79	SDL.Vect.V2 rawWidth rawHeight <- SDL.Video.surfaceDimensions surface
	80	let width = fromIntegral rawWidth
	81	let height = fromIntegral rawHeight
80	82	let surfaceSize = TextureSize2D width height
81	83
82	84	textureObj <- liftM head (genObjectNames 1)

84	86	textureWrapMode Texture2D S $= (Repeated, Repeat)
85	87	textureWrapMode Texture2D T $= (Repeated, Repeat)
86	88	textureFilter Texture2D $= ((Nearest, Nothing), Nearest)
87		surfacePixels <- surfaceGetPixels surface
	89	surfacePixels <- SDL.Video.surfacePixels surface
88	90
89	91	let pixelData = PixelData RGBA UnsignedByte surfacePixels
90		texImage2D Nothing NoProxy 0 RGBA' surfaceSize 0 pixelData
91
92		freeSurface surface
	92	texImage2D
	93	#if MIN_VERSION_OpenGL(2,9,0)
	94	Texture2D
	95	#else
	96	Nothing
	97	#endif
	98	NoProxy 0 RGBA' surfaceSize 0 pixelData
	99
	100	SDL.Video.freeSurface surface
93	101
94	102	return (Nxt.Types.Texture width height textureObj)
95	103

+0

-13

~~src/Nxt/Input.hs~~ less more

0		module Nxt.Input
1		(InputState) where
2
3
4
5		data InputState = InputState
6		{
7		up :: Bool,
8		left :: Bool,
9		down :: Bool,
10		right :: Bool
11		}
12

+0

-11

~~src/UI/ItemPanel.hs~~ less more

0		module UI.ItemPanel
1		(ItemPanel(ItemPanel),
2		itemButtonList) where
3
4		import Item.Items
5
6		data ItemPanel = ItemPanel
7		{
8		itemButtonlist :: [ItemButton]
9		}
10

+2

-2

src/World/World.hs less more

118	118	-- free previous level's textures
119	119	-- mapM_ (\(_, oldBg) -> freeTexture oldBg) (levelBackgrounds lvlData)
120	120
121		let lvlPos = case (drop (length dataPath) levelPath) of
	121	let lvlPos = case drop (length dataPath) levelPath of
122	122	"/data/levels/water1/water1.lvl" -> [(0.0, 0.0), (1024.0, 0.0)]
123	123	"/data/levels/movement1/movement1.lvl" -> [(-15.0, -265.0), (1009.0, -265.0), (2033, -265.0)]
124	124	"/data/levels/water2/water2.lvl" -> [(0.0, -200.0), (1024.0, -200.0)]

131	131	"/data/levels/pinball/pinball.lvl" -> [(110.0, -330.0), (1134.0, -330.0)]
132	132	_ -> []
133	133
134		lvlBgs <- case (drop (length dataPath) levelPath) of
	134	lvlBgs <- case drop (length dataPath) levelPath of
135	135	"/data/levels/water1/water1.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/water1/water1_0_0.png"),
136	136	Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/water1/water1_1_0.png")]
137	137	"/data/levels/movement1/movement1.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement1/movement1_0_0.png"),