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