Commit 679155a4 authored by Peter Achten's avatar Peter Achten
Browse files

(PA) Modernised code using new type definitions of Game Lib.

parent 68297802
......@@ -82,14 +82,14 @@ Start world
= startIO SDI 0 init [ProcessClose closeProcess] world
where
init ps
# (_, ps) = OpenGame initialGameState DuckGame [ColorDepth 16] ps
# (_, ps) = openGame initialGameState DuckGame [ColorDepth 16] ps
/* use default mode: 230x240 */
= closeProcess ps
/* ---------- the complete game definition ---------- */
DuckGame :: (Game GameState)
DuckGame :: Game GameState
DuckGame =
{ levels = [ TitleScreen
, GameLevel1
......@@ -138,7 +138,7 @@ where
/* function that returns text to be displayed */
Statistics :: GameState -> ([Statistic], GameState)
Statistics :: GameState -> ([GameText], GameState)
Statistics gst
| gst.titlescreen
= ([ TitleTextShadow, TitleText
......@@ -283,10 +283,10 @@ GameObjectList = [ AutoInitObject
*/
CloudObject
# obj = defaultGameObject OBJ_CLOUD size NoState
# obj = defaultGameObject OBJ_CLOUD size Void
# obj = { obj
& sprites = [CloudSprite]
, init = (newinit size NoState)
, init = newinit size Void
}
= obj
where
......@@ -303,7 +303,7 @@ where
, options.ignorelevelbounds = True
, layer = AtLayer LYR_BACKGROUND
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
/* ---------- palm front object ---------- */
......@@ -315,10 +315,10 @@ where
*/
PalmFrontObject
# obj = defaultGameObject OBJ_PALM size NoState
# obj = defaultGameObject OBJ_PALM size Void
# obj = { obj
& sprites = [PalmSprite 2, PalmSprite 1, PalmSprite 3]
, init = (newinit size NoState)
, init = newinit size Void
}
= obj
where
......@@ -331,14 +331,14 @@ where
, offset = {x = 0, y = ~H}
, currentsprite = (subtype + 1)
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
BlockInFrontObject objtype spr
# obj = defaultGameObject objtype size NoState
# obj = defaultGameObject objtype size Void
# obj = { obj
& sprites = [spr]
, init = (newinit size NoState)
, init = newinit size Void
}
= obj
where
......@@ -349,7 +349,7 @@ where
# objrec = { objrec
& layer = AtLayer LYR_INFRONT
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
/* ---------- coins and diamonds ---------- */
......@@ -367,7 +367,7 @@ LifeObject = FallingGameItem OBJ_LIFE LifeSprite
FallingGameItem objecttype sprite
# obj = StaticGameItem objecttype sprite
# obj = { obj
& init = (newinit size NoState)
& init = newinit size Void
}
= obj
where
......@@ -377,14 +377,14 @@ where
# pos = {pos & x = if (subtype == 1) (pos.x + W / 2) (pos.x)}
# (objrec, gs) = defaultObjectRec subtype pos size time gs
# xv = case subtype of
11 -> ~1.6
12 -> ~0.8
11 -> -1.6
12 -> -0.8
14 -> 0.8
15 -> 1.6
otherwise -> 0.0
# objrec = { objrec
& acceleration = {rx = 0.0, ry = 1.0 / 16.0}
, speed = {rx = xv, ry = ~1.25 + ((abs xv) / 4.0)}
, speed = {rx = xv, ry = -1.25 + ((abs xv) / 4.0)}
, slowdown = {fvx = Factor (1.0 / 32.0), fvy = Value 0.0}
, bounce = {fvx = Value 0.0, fvy = Factor (4.0 / 5.0)}
, layer = AtLayer LYR_FOREGROUND
......@@ -393,13 +393,13 @@ where
, collidebounds = BND_MAIN_CHARACTER
, forgetdistance = {x = 8, y = 8}
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
StaticGameItem objecttype sprite
# obj = defaultGameObject objecttype size NoState
# obj = defaultGameObject objecttype size Void
# obj = { obj
& sprites = [sprite, GlitterSprite 25]
, init = (newinit size NoState)
, init = newinit size Void
, collide = newcollide
, animation = killobject
}
......@@ -417,41 +417,42 @@ where
, collidebounds = BND_MAIN_CHARACTER
, layer = AtLayer LYR_FOREGROUND
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
newcollide (st, or) bnds objtype objrec gs
newcollide bnds objtype objrec objst=:{objectstate=st, objectrec=or, gamestate=gs}
| objtype == OBJ_MAIN_CHAR
# (points, gs) = ItemScoreAndSound objecttype gs
# gs = addscore points gs
= ((st, {or & currentsprite = SPR_GLITTER
= {objst & objectrec={or & currentsprite = SPR_GLITTER
, options.removemapcode = True
, layer = AtLayer LYR_INFRONT
, ownbounds = 0
, collidebounds = 0
}), gs)
= ((st, or), gs)
},
gamestate=gs}
= objst
ItemScoreAndSound ot gs
# (pan, gs) = RandomPan gs
| (ot == OBJ_STATIC_COIN) || (ot == OBJ_FALLING_COIN)
# (_, gs) = PlaySoundSample SND_COIN DefaultVolume pan (getnotefreq 61) 0 gs
# (_, gs) = PlaySoundSample SND_COIN DefaultVolume pan (getnotefreq 73) 4 gs
| ot == OBJ_STATIC_COIN || ot == OBJ_FALLING_COIN
# (_, gs) = playSoundSample SND_COIN DefaultVolume pan (getnotefreq 61) 0 gs
# (_, gs) = playSoundSample SND_COIN DefaultVolume pan (getnotefreq 73) 4 gs
= (50, inccoins gs)
| (ot == OBJ_FALLING_DIAMOND) || (ot == OBJ_STATIC_DIAMOND)
| ot == OBJ_FALLING_DIAMOND || ot == OBJ_STATIC_DIAMOND
# instr = SND_COIN
# (_, gs) = PlaySoundSample instr DefaultVolume pan (getnotefreq 68) 0 gs
# (_, gs) = PlaySoundSample instr DefaultVolume pan (getnotefreq 75) 8 gs
# (_, gs) = PlaySoundSample instr HighVolume pan (getnotefreq 80) 16 gs
# (_, gs) = playSoundSample instr DefaultVolume pan (getnotefreq 68) 0 gs
# (_, gs) = playSoundSample instr DefaultVolume pan (getnotefreq 75) 8 gs
# (_, gs) = playSoundSample instr HighVolume pan (getnotefreq 80) 16 gs
= (150, incdiamonds gs)
| (ot == OBJ_HEART) || (ot == OBJ_LIFE)
| ot == OBJ_HEART || ot == OBJ_LIFE
# instr = if (ot == OBJ_LIFE) SND_FLUTE SND_XYLOFOON
# (_, gs) = PlaySoundSample instr HighVolume pan (getnotefreq 96) 0 gs
# (_, gs) = PlaySoundSample instr HighVolume pan (getnotefreq 100) 5 gs
# (_, gs) = PlaySoundSample instr HighVolume pan (getnotefreq 103) 10 gs
# (_, gs) = PlaySoundSample instr HighVolume pan (getnotefreq 108) 15 gs
# (_, gs) = PlaySoundSample instr HighVolume pan (getnotefreq 112) 20 gs
# (_, gs) = PlaySoundSample instr HighVolume pan (getnotefreq 115) 25 gs
# (_, gs) = PlaySoundSample instr HighVolume pan (getnotefreq 120) 30 gs
# (_, gs) = playSoundSample instr HighVolume pan (getnotefreq 96) 0 gs
# (_, gs) = playSoundSample instr HighVolume pan (getnotefreq 100) 5 gs
# (_, gs) = playSoundSample instr HighVolume pan (getnotefreq 103) 10 gs
# (_, gs) = playSoundSample instr HighVolume pan (getnotefreq 108) 15 gs
# (_, gs) = playSoundSample instr HighVolume pan (getnotefreq 112) 20 gs
# (_, gs) = playSoundSample instr HighVolume pan (getnotefreq 115) 25 gs
# (_, gs) = playSoundSample instr HighVolume pan (getnotefreq 120) 30 gs
= if (ot == OBJ_LIFE) (500, inclives gs) (100, gs)
= (100, gs)
......@@ -464,8 +465,8 @@ OBJ_HEART :== 0x14
OBJ_LIFE :== 0x15
*/
killobject (st, or) gs
= ((st, {or & active = False}), gs)
killobject objst=:{objectrec=or}
= {objst & objectrec={or & active = False}}
/* ---------- crates ---------- */
......@@ -479,10 +480,10 @@ CrateObject = Crate True
InvisibleCrateObject = Crate False
Crate visible
# obj = defaultGameObject (if visible OBJ_CRATE OBJ_INVISIBLE_CRATE) size NoState
# obj = defaultGameObject (if visible OBJ_CRATE OBJ_INVISIBLE_CRATE) size Void
# obj = { obj
& sprites = [CrateSprite]
, init = (newinit size NoState)
, init = newinit size Void
, collide = newcollide
}
= obj
......@@ -499,22 +500,22 @@ where
, collidebounds = BND_MAIN_CHARACTER
, currentsprite = if visible 1 0
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
newcollide (st, or) bnds othertype otherobjrec gs
| ((othertype == OBJ_MAIN_CHAR) && (bnds.bottom))
newcollide bnds othertype otherobjrec objst=:{objectstate=st, objectrec=or, gamestate=gs}
| othertype == OBJ_MAIN_CHAR && bnds.bottom
# pos1 = or.pos
# pos2 = {pos1 & y = pos1.y + 8}
# (_, gs) = CreateNewGameObject OBJ_CRATE_PART 1 pos1 gs
# (_, gs) = createNewGameObject OBJ_CRATE_PART 1 pos1 gs
# pos1 = {pos1 & x = pos1.x + 4}
# (_, gs) = CreateNewGameObject OBJ_CRATE_PART 2 pos1 gs
# (_, gs) = createNewGameObject OBJ_CRATE_PART 2 pos1 gs
# pos1 = {pos1 & x = pos1.x + 4}
# (_, gs) = CreateNewGameObject OBJ_CRATE_PART 3 pos1 gs
# (_, gs) = CreateNewGameObject OBJ_CRATE_PART 4 pos2 gs
# (_, gs) = createNewGameObject OBJ_CRATE_PART 3 pos1 gs
# (_, gs) = createNewGameObject OBJ_CRATE_PART 4 pos2 gs
# pos2 = {pos2 & x = pos2.x + 4}
# (_, gs) = CreateNewGameObject OBJ_CRATE_PART 5 pos2 gs
# (_, gs) = createNewGameObject OBJ_CRATE_PART 5 pos2 gs
# pos2 = {pos2 & x = pos2.x + 4}
# (_, gs) = CreateNewGameObject OBJ_CRATE_PART 6 pos2 gs
# (_, gs) = createNewGameObject OBJ_CRATE_PART 6 pos2 gs
# or = {or & options.removemapcode = True, active = False}
# obj = case or.subtype of
0 -> if visible OBJ_FALLING_COIN OBJ_STATIC_COIN
......@@ -523,21 +524,21 @@ where
3 -> OBJ_LIFE
4 -> OBJ_FALLING_COIN
5 -> OBJ_FALLING_DIAMOND
# (_, gs) = CreateNewGameObject obj 0 or.pos gs
| (or.subtype == 4) || (or.subtype == 5)
# (_, gs) = CreateNewGameObject obj 11 or.pos gs
# (_, gs) = CreateNewGameObject obj 15 or.pos gs
# (_, gs) = CreateNewGameObject obj 12 or.pos gs
# (_, gs) = CreateNewGameObject obj 14 or.pos gs
= ((st, or), gs)
= ((st, or), gs)
= ((st, or), gs)
# (_, gs) = createNewGameObject obj 0 or.pos gs
| or.subtype == 4 || or.subtype == 5
# (_, gs) = createNewGameObject obj 11 or.pos gs
# (_, gs) = createNewGameObject obj 15 or.pos gs
# (_, gs) = createNewGameObject obj 12 or.pos gs
# (_, gs) = createNewGameObject obj 14 or.pos gs
= {objst & objectrec=or, gamestate=gs}
= {objst & objectrec=or, gamestate=gs}
= objst
CratePartObject
# obj = defaultGameObject OBJ_CRATE_PART size NoState
# obj = defaultGameObject OBJ_CRATE_PART size Void
# obj = { obj
& sprites = [CratePartSprite]
, init = (newinit size NoState)
, init = newinit size Void
}
= obj
where
......@@ -546,31 +547,31 @@ where
newinit size state subtype pos time gs
# (objrec, gs) = defaultObjectRec subtype pos size time gs
# ((xv, yv), gs) = case subtype of
1 -> (rnd (~1.0, ~3.0) gs)
2 -> (rnd ( 0.0, ~3.2) gs)
3 -> (rnd ( 1.0, ~3.0) gs)
4 -> (rnd (~1.0, ~2.0) gs)
5 -> (rnd ( 0.0, ~2.2) gs)
6 -> (rnd ( 1.0, ~2.0) gs)
1 -> rnd (-1.0, -3.0) gs
2 -> rnd ( 0.0, -3.2) gs
3 -> rnd ( 1.0, -3.0) gs
4 -> rnd (-1.0, -2.0) gs
5 -> rnd ( 0.0, -2.2) gs
6 -> rnd ( 1.0, -2.0) gs
# objrec = { objrec & acceleration = {rx = 0.0, ry = 1.0 / 12.0}
, speed = {rx = xv, ry = yv}
, forgetdistance = {x = 1, y = 1}
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
where
rnd (x, y) gs
# (r1, gs) = (RRnd 1.0 gs)
# (r2, gs) = (RRnd 1.0 gs)
# (r1, gs) = RRnd 1.0 gs
# (r2, gs) = RRnd 1.0 gs
= ((x + r1, y + r2), gs)
/* ---------- flash ---------- */
FlashObject
# obj = defaultGameObject OBJ_FLASH size NoState
# obj = defaultGameObject OBJ_FLASH size Void
# obj = { obj
& sprites = [FlashSprite]
, init = (newinit size NoState)
, init = newinit size Void
, animation = killobject
}
= obj
......@@ -582,16 +583,16 @@ where
# objrec = { objrec
& layer = AtLayer LYR_INFRONT
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
/* ---------- bounce block ---------- */
BounceBlockObject
# obj = defaultGameObject OBJ_BOUNCEBLOCK size NoState
# obj = defaultGameObject OBJ_BOUNCEBLOCK size Void
# obj = { obj
& sprites = [BounceBlockSprite, BounceBlockShortSprite]
, init = (newinit size NoState)
, init = newinit size Void
, collide = newcollide
, animation = newanimation
}
......@@ -603,29 +604,30 @@ where
# (objrec, gs) = defaultObjectRec subtype pos size time gs
# objrec = { objrec
& layer = AtLayer LYR_FOREGROUND
, speed = {rx = ~(toReal subtype), ry = 0.0}
, speed = {rx = 0.0-toReal subtype, ry = 0.0}
, bounce = {fvx = Factor 1.0, fvy = Value 0.0}
, forgetdistance = {x = 5 + 15 * subtype, y = 5}
, ownbounds = BND_STATIC_BOUNDS + BND_BLOCKS
, collidebounds = BND_MAIN_CHARACTER
, bouncebounds = BND_STATIC_BOUNDS
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
newcollide (st, or) bnds othertype otherobjrec gs
newcollide bnds othertype otherobjrec objst=:{objectstate=st, objectrec=or, gamestate=gs}
| othertype == OBJ_MAIN_CHAR
| (bnds.top || bnds.bottom)
= ((st, {or & offset.y = (if bnds.top 4 (~4))
, currentsprite = 2}), gs)
= ((st, or), gs)
= ((st, or), gs)
newanimation (st, or) gs
| (or.offset.y == 0)
= ((st, {or & currentsprite = 1}), gs)
# or = {or & offset.y = ~(decr or.offset.y)}
= ((st, or), gs)
| bnds.top || bnds.bottom
= {objst & objectrec={or & offset.y = if bnds.top 4 (-4)
, currentsprite = 2}}
= objst
= objst
newanimation objst=:{objectstate=st, objectrec=or, gamestate=gs}
| or.offset.y == 0
= {objst & objectrec={or & currentsprite = 1}}
# or = {or & offset.y = 0-decr or.offset.y}
= {objst & objectrec=or}
where
decr :: !Int -> Int
decr x
| x < 0 = x + 1
| otherwise = x - 1
......@@ -634,10 +636,10 @@ where
/* ---------- water ---------- */
WaterObject
# obj = defaultGameObject OBJ_WATER size NoState
# obj = defaultGameObject OBJ_WATER size Void
# obj = { obj
& sprites = [WaterSprite]
, init = (newinit size NoState)
, init = newinit size Void
}
= obj
where
......@@ -648,16 +650,16 @@ where
# objrec = { objrec
& layer = AtLayer LYR_INFRONT
, ownbounds = BND_WATER
, offset = {x = 0, y = ~11}
, offset = {x = 0, y = -11}
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
Splash :: !Point2 (!*GSt gs) -> (!GRESULT, !*GSt gs)
Splash :: !Point2 !*(GSt .gs) -> (!GRESULT, !*GSt .gs)
Splash pos gs
# pos = {pos & y = pos.y - 11}
# (_, gs) = CreateNewGameObject OBJ_SPLASH 1 pos gs
# (_, gs) = CreateNewGameObject OBJ_SPLASH 2 pos gs
# (_, gs) = CreateNewGameObject OBJ_SPLASH 3 pos gs
# (_, gs) = createNewGameObject OBJ_SPLASH 1 pos gs
# (_, gs) = createNewGameObject OBJ_SPLASH 2 pos gs
# (_, gs) = createNewGameObject OBJ_SPLASH 3 pos gs
= (GR_OK, gs)
/*
......@@ -668,10 +670,10 @@ Splash pos gs
*/
SplashObject
# obj = defaultGameObject OBJ_SPLASH size NoState
# obj = defaultGameObject OBJ_SPLASH size Void
# obj = { obj
& sprites = [WaveSprite, WaveSprite, SplashSprite]
, init = (newinit size NoState)
, init = newinit size Void
, animation = killobject
}
= obj
......@@ -684,21 +686,21 @@ where
& layer = AtLayer LYR_INFRONT
, currentsprite = subtype
, offset = case subtype of
1 -> {x = ~20, y = ~12}
2 -> {x = 20, y = ~12}
1 -> {x = -20, y = -12}
2 -> {x = 20, y = -12}
3 -> {x = 0, y = 12}
, displayoptions.mirrorleftright = if (subtype == 1) True False
, displayoptions.mirrorleftright = subtype == 1
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
/* ---------- enemies ---------- */
EnemyObject
# obj = defaultGameObject OBJ_ENEMY size NoState
# obj = defaultGameObject OBJ_ENEMY size Void
# obj = { obj
& sprites = [EnemySprite1, EnemySprite2]
, init = (newinit size NoState)
, init = newinit size Void
, collide = newcollide
}
= obj
......@@ -708,8 +710,8 @@ where
newinit size state subtype pos time gs
# (objrec, gs) = defaultObjectRec subtype pos size time gs
# objrec = { objrec
& offset = {x = ~2, y = ~2}
, speed = {rx = ~0.5, ry = 0.0}
& offset = {x = -2, y = -2}
, speed = {rx = -0.5, ry = 0.0}
, bounce = {fvx = Factor 1.0, fvy = Value 0.0}
, layer = AtLayer LYR_FOREGROUND
, options = { objrec.options
......@@ -718,21 +720,21 @@ where
, ownbounds = BND_ENEMY
, bouncebounds = BND_STATIC_BOUNDS + BND_ENEMY + BND_MAP_CODES
, collidebounds = BND_MAIN_CHARACTER
, currentsprite = (1 + subtype)
, currentsprite = 1 + subtype
, forgetdistance = {x = 6, y = 4}
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
newcollide (st, or) bnds othertype otherobjrec gs
| ((othertype == OBJ_MAIN_CHAR) && (bnds.bottom))
= ((st, kill or), gs)
= ((st, or), gs)
newcollide bnds othertype otherobjrec objst=:{objectstate=st, objectrec=or, gamestate=gs}
| othertype == OBJ_MAIN_CHAR && bnds.bottom
= {objst & objectrec=kill or}
= objst
kill :: ObjectRec -> ObjectRec
kill :: !GameObjectRec -> GameObjectRec
kill or =
{or & displayoptions.mirrorupdown = True
, acceleration = {rx = 0.0, ry = 1.0 / 16.0}
, speed = {rx = ~(or.speed.rx / 2.0), ry = ~3.0}
, speed = {rx = ~(or.speed.rx / 2.0), ry = -3.0}
, ownbounds = 0
, bouncebounds = 0
, collidebounds = 0
......@@ -745,9 +747,9 @@ kill or =
/* ---------- pin ---------- */
PinObject
# obj = defaultGameObject OBJ_PIN size NoState
# obj = defaultGameObject OBJ_PIN size Void
# obj = { obj
& init = (newinit size NoState)
& init = newinit size Void
}
= obj
where
......@@ -758,7 +760,7 @@ where
# objrec = { objrec
& ownbounds = BND_KILL + BND_STATIC_BOUNDS
}
= ((state, objrec), gs)
= {objectstate=state, objectrec=objrec, gamestate=gs}
/* ---------- flying enemies ---------- */
......@@ -766,10 +768,10 @@ where
BeeObject = FlyingObject OBJ_BEE [BeeSprite]
FlyingObject objtype sprlist
# obj = defaultGameObject objtype size NoState
# obj = defaultGameObject objtype size Void
# obj = { obj
& sprites = sprlist
, init = (newinit size NoState)
, init = newinit size Void
, collide = newcollide
, move = newmove
}
...