Commit 6d8dce6f authored by Peter Achten's avatar Peter Achten

(PA): Object IO/Game Lib/Tcp + Examples adapted to Clean 2.0.

Polymorphic local state.
parent 72a43281
......@@ -73,14 +73,14 @@ DuckGame =
/* if the quit function returns true, the game engine quit the level */
QuitFunction :: GameState -> (Bool, GameState)
QuitFunction :: GameState -> *(Bool, GameState)
QuitFunction gst
= (gst.quit, {gst & quit = False})
/* function that returns the next level to run, 0 = end game */
NextLevelFunction :: GameState -> (Int, GameState)
NextLevelFunction :: GameState -> *(Int, GameState)
NextLevelFunction gst =: {curlevel, maxlevel, titlescreen, exitcode, lives, gameover}
| exitcode == EC_QUIT
= (0, gst)
......@@ -114,7 +114,7 @@ where
/* function that returns text to be displayed */
TextItems :: GameState -> ([GameText], GameState)
TextItems :: GameState -> *([GameText], GameState)
TextItems gst
| gst.titlescreen
= ([ TitleTextShadow, TitleText
......@@ -221,32 +221,32 @@ OBJ_FLASH :== 0x102
OBJ_STAT :== 0x110
GameObjectList = [ AutoInitObject
, MainCharObject
, StaticCoinObject
, FallingCoinObject
, StaticDiamondObject
, FallingDiamondObject
, HeartObject
, LifeObject
, CrateObject
, InvisibleCrateObject
, CratePartObject
, EnemyObject
, BeeObject
, FrogObject
, CloudObject
, PalmFrontObject
, WaterObject
, SplashObject
, BounceBlockObject
, FlashObject
, EndingObject
, StatHeartObject
, BlockInFrontObject OBJ_GROUND1 (InFrontSprite1)
, BlockInFrontObject OBJ_GROUND2 (InFrontSprite2)
, BlockInFrontObject OBJ_GROUND3 (InFrontSprite3)
, PinObject
GameObjectList = [ GameObjectLS AutoInitObject
, GameObjectLS MainCharObject
, GameObjectLS StaticCoinObject
, GameObjectLS FallingCoinObject
, GameObjectLS StaticDiamondObject
, GameObjectLS FallingDiamondObject
, GameObjectLS HeartObject
, GameObjectLS LifeObject
, GameObjectLS CrateObject
, GameObjectLS InvisibleCrateObject
, GameObjectLS CratePartObject
, GameObjectLS EnemyObject
, GameObjectLS BeeObject
, GameObjectLS FrogObject
, GameObjectLS CloudObject
, GameObjectLS PalmFrontObject
, GameObjectLS WaterObject
, GameObjectLS SplashObject
, GameObjectLS BounceBlockObject
, GameObjectLS FlashObject
, GameObjectLS EndingObject
, GameObjectLS StatHeartObject
, GameObjectLS (BlockInFrontObject OBJ_GROUND1 (InFrontSprite1))
, GameObjectLS (BlockInFrontObject OBJ_GROUND2 (InFrontSprite2))
, GameObjectLS (BlockInFrontObject OBJ_GROUND3 (InFrontSprite3))
, GameObjectLS PinObject
]
......@@ -1268,7 +1268,7 @@ TitleScreen
= { boundmap = ChTitleBoundMap
, initpos = {x = 0, y = 13 * H + H / 2}
, layers = [BackGr3Map1Layer, ChTitleLayer]
, objects = [{MainCharObject & keydown = nop, keyup = nop}, AutoMenuObject]
, objects = [GameObjectLS {MainCharObject & keydown = nop, keyup = nop}, GameObjectLS AutoMenuObject]
, music = Just BackgroundMusic
, soundsamples = []
, leveloptions = { fillbackground = Nothing
......@@ -1341,7 +1341,7 @@ where
/* get number of lives */
getlives gs = accGSt getgstlives gs
where
getgstlives :: GameState -> (Int, GameState)
getgstlives :: GameState -> *(Int, GameState)
getgstlives gst = (gst.lives, gst)
/* increment the number of diamonds */
......@@ -1389,7 +1389,7 @@ RRnd n gs
where
max = (toReal MAX_RAND)
gsrand :: GameState -> (Int, GameState)
gsrand :: GameState -> *(Int, GameState)
gsrand gs=:{randseed}
# (x, newrandseed) = random randseed
= (x, {gs & randseed=newrandseed})
......
This diff is collapsed.
......@@ -271,14 +271,14 @@ SintGame =
/* if the quit function returns true, the game engine quits the level */
QuitFunction :: GameState -> (Bool, GameState)
QuitFunction :: GameState -> *(Bool, GameState)
QuitFunction gst
= (gst.quit, {gst & quit = False})
/* function that returns the next level to run, 0 = end game */
NextLevelFunction :: GameState -> (Int, GameState)
NextLevelFunction :: GameState -> *(Int, GameState)
NextLevelFunction gst =: {curlevel, maxlevel, exitcode, lives, gameover, bonus}
| exitcode == EC_QUIT
= (0, gst)
......@@ -350,7 +350,7 @@ where
/* function that returns text to be displayed */
GameTexts :: GameState -> ([GameText], GameState)
GameTexts :: GameState -> *([GameText], GameState)
GameTexts gst
| gst.statusline
# (msg, gst) = if (gst.morningmsg > STOP_MSG)
......@@ -496,41 +496,41 @@ ITEM_SIZE :== {w = W, h = 16}
NEVER_FORGET :== {x = 10000, y = 10000}
GameObjectList = [ AutoInitObject
, StatHeartObject
GameObjectList = [ GameObjectLS AutoInitObject
, GameObjectLS StatHeartObject
, StaticPepernoot
, FallingPepernoot
, FallingLetter
, HeartObject
, LifeObject
, GameObjectLS StaticPepernoot
, GameObjectLS FallingPepernoot
, GameObjectLS FallingLetter
, GameObjectLS HeartObject
, GameObjectLS LifeObject
, Kado1, Kado2, Kado3, Kado4, Kado5
, GameObjectLS Kado1, GameObjectLS Kado2, GameObjectLS Kado3, GameObjectLS Kado4, GameObjectLS Kado5
] ++
, KadoObject 1, KadoObject 2, KadoObject 3, KadoObject 4, KadoObject 5
[ GameObjectLS (KadoObject i) \\ i<-[1..5] ] ++
, ChimneyObject 1, ChimneyObject 2, ChimneyObject 3, ChimneyObject 4
, ChimneyObject 5
[ GameObjectLS (ChimneyObject i) \\ i<-[1..5] ] ++
, BounceBlockObject
, TrampObject
[ GameObjectLS BounceBlockObject
, GameObjectLS TrampObject
, BirdObject
, GameObjectLS BirdObject
] ++
, FadeObject 0, FadeObject 1, FadeObject 2, FadeObject 3, FadeObject 4
, FadeObject 5, FadeObject 6, FadeObject 7, FadeObject 8, FadeObject 9
[ GameObjectLS (FadeObject i) \\ i<-[0..9] ] ++
, AntenneObject
[ GameObjectLS AntenneObject
, FlitsObject
, GameObjectLS FlitsObject
, SunObject
, GameObjectLS SunObject
, EndingObject
, GameObjectLS EndingObject
, CarObject
, GameObjectLS CarObject
, MainCharObject
, GameObjectLS MainCharObject
]
......@@ -665,12 +665,7 @@ where
/* ---------- in front ---------- */
Level1FrontObj = [ L1FrontObject 1
, L1FrontObject 2
, L1FrontObject 3
, L1FrontObject 4
]
Level1FrontObj = [GameObjectLS (L1FrontObject i) \\ i<-[1..4]]
L1FrontObject n
# obj = defaultGameObject (OBJ_FRONT - n + 1) BLOCK_SIZE Void
......@@ -1290,7 +1285,7 @@ TRAILTURNSPEED :== 2
, lasthdir :: !HDirection
, turning :: !Bool
, traildelta :: !Int
, trail :: [!Int]
, trail :: [Int]
, lastypos :: !Int
, readytodrop :: !Bool
, pepernoten :: !Int
......@@ -1402,7 +1397,7 @@ where
= {st = {st & turning = False}, or = {or & currentsprite = MC_TURN}, gs=gs}
= {st=st, or=or, gs=gs}
where
broadcastposition :: !Int !Int !Int [!Int] !(GSt gs) -> (GSt gs)
broadcastposition :: !Int !Int !Int [Int] !(GSt gs) -> (GSt gs)
broadcastposition n x y [] gs = gs
broadcastposition n x y [l:ls] gs
# (_, gs) = createUserGameEvent (EV_POS + n)
......@@ -1785,7 +1780,7 @@ where
/* get exitcode */
getexitcode gs = accGSt getgstexitcode gs
where
getgstexitcode :: GameState -> (Int, GameState)
getgstexitcode :: GameState -> *(Int, GameState)
getgstexitcode gst = (gst.exitcode, gst)
/* bonus functions */
......@@ -1796,7 +1791,7 @@ setgstbonus b gst = {gst & bonus = b}
/* get bonus */
getbonus gs = accGSt getgstbonus gs
where
getgstbonus :: GameState -> (Bool, GameState)
getgstbonus :: GameState -> *(Bool, GameState)
getgstbonus gst = (gst.bonus, gst)
......@@ -1809,20 +1804,20 @@ where
/* get number of lives */
getlives gs = accGSt getgstlives gs
where
getgstlives :: GameState -> (Int, GameState)
getgstlives :: GameState -> *(Int, GameState)
getgstlives gst = (gst.lives, gst)
/* get number of lives */
GetTime gs = accGSt getgsttime gs
where
getgsttime :: GameState -> (Int, GameState)
getgsttime :: GameState -> *(Int, GameState)
getgsttime gst = (gst.time, gst)
/* get current level number */
getlevel gs = accGSt getgstlevel gs
where
getgstlevel :: GameState -> (Int, GameState)
getgstlevel :: GameState -> *(Int, GameState)
getgstlevel gst = (gst.curlevel, gst)
......@@ -1879,7 +1874,7 @@ dectime gs
= (time, gs)
= (time, gs)
where
decgsttime :: Int GameState -> (Int, GameState)
decgsttime :: Int GameState -> *(Int, GameState)
decgsttime n gst
# gst = {gst & time = gst.time - n}
= (gst.time, gst)
......@@ -1892,7 +1887,7 @@ where
getppn gs = accGSt getgstppn gs
where
getgstppn :: GameState -> (Int, GameState)
getgstppn :: GameState -> *(Int, GameState)
getgstppn gst = (gst.ppn, gst)
......@@ -1903,7 +1898,7 @@ where
getplayer gs = accGSt getgstplayer gs
where
getgstplayer :: GameState -> (String, GameState)
getgstplayer :: GameState -> *(String, GameState)
getgstplayer gst = (gst.player, gst)
......@@ -1957,7 +1952,7 @@ crgb n
TitleScreen
= { blankScreen & layers = [TitleLayer]
, objects = [AutoMenuObject]
, objects = [GameObjectLS AutoMenuObject]
, soundsamples = MenuSoundSampleList
, leveloptions.escquit = False
, leveloptions.fillbackground = Nothing
......@@ -2371,7 +2366,7 @@ RRnd n gs
where
max = (toReal MAX_RAND)
gsrand :: GameState -> (Int, GameState)
gsrand :: GameState -> *(Int, GameState)
gsrand gs=:{randseed}
# (x, newrandseed) = random randseed
= (x, {gs & randseed=newrandseed})
......
This diff is collapsed.
......@@ -64,13 +64,13 @@ WormsDemo =
/* if the quit function returns true, the game engine quit the level */
WormsQuitFunction :: GameState -> (Bool, GameState)
WormsQuitFunction :: GameState -> *(Bool, GameState)
WormsQuitFunction gst
= (gst.quit, gst)
/* function that returns the next level to run, 0 = end game */
WormsNextLevelFunction :: GameState -> (Int, GameState)
WormsNextLevelFunction :: GameState -> *(Int, GameState)
WormsNextLevelFunction gst =: {curlevel, maxlevel, gameover}
= (nextLevel, {gst & curlevel = nextLevel
, quit = False
......@@ -82,7 +82,7 @@ where
/* function that returns text to be displayed */
WormsTextItems :: GameState -> ([GameText], GameState)
WormsTextItems :: GameState -> *([GameText], GameState)
WormsTextItems gst =: {curlevel, gameover, timecounter, maxlevel}
# gst = {gst & timecounter = timecounter - 1}
| gst.timecounter == 0
......@@ -165,7 +165,7 @@ SPR_WH_LEFT :== 2
SPR_WH_DOWN :== 3
SPR_WH_RIGHT :== 4
ObjectList = [WormHead, WormSegment, Food, Wall]
ObjectList = [GameObjectLS WormHead, GameObjectLS WormSegment, GameObjectLS Food, GameObjectLS Wall]
/* bounds */
BND_WORMHEAD :== 0x0001
......@@ -262,7 +262,7 @@ where
# gs = setwormlist (take st.count [nextspeed:wormlist]) gs
# or = {or & speed = nextspeed
, currentsprite = st.next
, skipmove = (24 / (toInt V)) -1
, skipmove = (24 / (toInt V)) - 1
}
| st.more == 0
# last = wormlist!!((length wormlist) - 1)
......@@ -351,7 +351,7 @@ where
newMove objst=:{st, or, gs}
# (wormlist, gs) = getwormlist gs
# or = { or & skipmove = (24 / (toInt V)) -1 }
# or = { or & skipmove = (24 / (toInt V)) - 1 }
| or.subcode + 1 > length wormlist
= {st=st, or=or, gs=gs}
# or = {or & speed = wormlist!!(or.subcode)}
......@@ -474,7 +474,7 @@ setgstwormlist :: [RealXY] GameState -> GameState
setgstwormlist l gst = {gst & wormlist = l}
getwormlist gs = accGSt getgstwormlist gs
getgstwormlist :: GameState -> ([RealXY], GameState)
getgstwormlist :: GameState -> *([RealXY], GameState)
getgstwormlist gst = (gst.wormlist, gst)
/* gameover functions */
......@@ -483,7 +483,7 @@ setgstgameover :: Bool GameState -> GameState
setgstgameover b gst = {gst & gameover = b}
getgameover gs = accGSt getgstgameover gs
getgstgameover :: GameState -> (Bool, GameState)
getgstgameover :: GameState -> *(Bool, GameState)
getgstgameover gst = (gst.gameover, gst)
......@@ -569,4 +569,3 @@ SoundSampleList =
[ { soundid = SND_FOOD, soundfile = "sounds\\FOOD.WAV", soundbuffers = 3 }
, { soundid = SND_HIT, soundfile = "sounds\\HIT.WAV", soundbuffers = 5 }
]
This diff is collapsed.
definition module GameFunctions
// Version 1.0
// ********************************************************************************
// Clean Standard Game library, version 1.2.2
//
// Author: Mike Wiering
// Modified: 7 Sept 2001 for Clean 2.0 (Peter Achten)
// ********************************************************************************
import gameintrface_12, osgame
from StdIOBasic import Point2
......
implementation module GameFunctions
// Version 1.0
import StdArray, StdList, StdString
import osgame
......
definition module StdGSt
// ********************************************************************************
// Clean Standard Game library, version 1.2.1
// Clean Standard Game library, version 1.2.2
//
// StdGSt imports the GSt type and some handy access functions.
// Author: Mike Wiering
// Modified: 7 Sept 2001 for Clean 2.0 (Peter Achten)
// ********************************************************************************
from gst import GSt, appGSt, accGSt, IdFun, St
definition module StdGame
// ********************************************************************************
// Clean Standard Game library, version 1.2.1
// Clean Standard Game library, version 1.2.2
//
// StdGame contains the functions one needs during a game.
// Author: Mike Wiering
// Modified: 15 October 2001 for Clean 2.0 (Peter Achten)
// ********************************************************************************
......@@ -90,23 +91,24 @@ playSoundSample :: !SoundID
!GameTime !(GSt .gs) -> (!GRESULT, !GSt .gs)
getBoundMap :: !Int !Int !(GSt .gs)
-> (!GRESULT, !(!Int, !DirectionSet), !GSt .gs)
setBoundMap :: !Int !Int !(!Int, !DirectionSet) !(GSt .gs)
-> (!GRESULT, !GSt .gs)
getBoundMap :: !Int !Int !(GSt .gs)
-> (!GRESULT, !(!Int, !DirectionSet), !GSt .gs)
setBoundMap :: !Int !Int !(!Int, !DirectionSet) !(GSt .gs)
-> (!GRESULT, !GSt .gs)
defaultInitObject :: Size state SubCode Point2 GameTime
!*(GSt .gs) -> GameObjectState state *(GSt .gs)
defaultGameObject :: !ObjectCode !Size state -> GameObject *(GSt .gs)
defaultObjectRec :: SubCode Point2 Size GameTime
!*(GSt .gs) -> (!GameObjectRec,!*GSt .gs)
defaultInitObject :: Size state SubCode Point2 GameTime !*(GSt .gs)
-> GameObjectState state *(GSt .gs)
defaultGameObject :: !ObjectCode !Size state
-> GameObject state *(GSt .gs)
defaultObjectRec :: SubCode Point2 Size GameTime !*(GSt .gs)
-> (!GameObjectRec,!*GSt .gs)
blankScreen :: Level (GSt .gs)
blankScreen :: Level (GSt .gs)
defaultShadow :: !Int -> Shadow
defaultShadow :: !Int -> Shadow