Skip to content

GitLab

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

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

parent 68297802
Hide whitespace changes
Inline Side-by-side
ObjectIO/Game Examples/Charlie/Charlie.icl
View file @ 679155a4
...@@ -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]