Skip to content

GitLab

Commit f04c671d authored by Mike Wiering's avatar Mike Wiering
Browse files

Now works with Tile Studio

parent 3459a50a
Hide whitespace changes
Inline Side-by-side
ObjectIO/Game Examples/Charlie/Charlie.icl 0 → 100644
View file @ f04c671d
module Charlie
/*
CHARLIE THE DUCK - (C) COPYRIGHT 1996-2000, BY MIKE WIERING, ALL RIGHTS RESERVED.
This material may be used for educational purposes only.
Mike Wiering (mike.wiering@cs.kun.nl)
*/
import StdGameDef, StdGame, StdGSt, GameFunctions, StdProcess, Random, notes
import CharlieGfx /* generated by Tile Studio */
:: GameState
= { curlevel :: !Int
, maxlevel :: !Int
, titlescreen :: !Bool
, statusline :: !Bool
, exitcode :: !Int
, lives :: !Int
, coins :: !Int
, diamonds :: !Int
, score :: !Int
, quit :: !Bool
, gameover :: !Bool
, randseed :: !RandomSeed
}
DEFAULT_LIVES :== 3
initialGameState = { curlevel = 0
, maxlevel = 3
, titlescreen = False
, statusline = False
, exitcode = EC_NONE
, lives = DEFAULT_LIVES
, coins = 0
, diamonds = 0
, score = 0
, quit = False
, gameover = False
, randseed = nullRandomSeed
}
EC_NONE :== 0
EC_SUCCESS :== 1
EC_FAILURE :== 2
EC_QUIT :== 3
/* ---------- main ---------- */
Start :: *World -> *World
Start world
# (randomSeed, world) = getNewRandomSeed world
# initialGameState = {initialGameState & randseed = randomSeed}
= startGame DuckGame initialGameState [ScreenSize {w = 320, h = 240}, ColorDepth 16] world
/* ---------- the complete game definition ---------- */
DuckGame :: Game GameState
DuckGame =
{ levels = [ TitleScreen
, GameLevel1
, GameLevel2
]
, quitlevel = accGSt QuitFunction
, nextlevel = accGSt NextLevelFunction
, textitems = accGSt TextItems
}
/* if the quit function returns true, the game engine quit the level */
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 gst =: {curlevel, maxlevel, titlescreen, exitcode, lives, gameover}
| exitcode == EC_QUIT
= (0, gst)
| titlescreen
= (next, {gst & titlescreen = False
, statusline = True
, lives = DEFAULT_LIVES
, coins = 0
, diamonds = 0
, score = 0
, curlevel = next})
| exitcode == EC_FAILURE
| lives > 0
= (curlevel, {gst & lives = lives - 1})
= title
| exitcode == EC_SUCCESS
= nextlevel
= title
where
title = (1, {gst & titlescreen = True
, statusline = False
, gameover = False
, coins = 0
, diamonds = 0
, score = 0
, curlevel = 1})
nextlevel = if (curlevel + 1 > maxlevel)
title
(next, {gst & curlevel = next})
next = curlevel + 1
/* function that returns text to be displayed */
TextItems :: GameState -> ([GameText], GameState)
TextItems gst
| gst.titlescreen
= ([ TitleTextShadow, TitleText
, DemoText
, Copyright
, MenuText 0 "Start"
, MenuText 1 "Exit"
], gst)
| gst.statusline
= ([ Lives gst.lives
, Diamonds gst.diamonds
, Coins gst.coins
, Score gst.score
] ++ (if gst.gameover [GameOver] []), gst)
= ([], gst)
/* ---------- definitions of the levels ---------- */
/* default block size */
W :== 20
H :== 16
DEFAULT_SIZE :== {w = W, h = H}
/* layers */
LYR_BACKGROUND :== 1
LYR_FOREGROUND :== 2
LYR_PLAYER :== 3
LYR_INFRONT :== 4
LYR_STATUS :== 10
/* user events */
EV_QUIT_LEVEL :== 1
EV_GAME_OVER :== 2
EV_STOP_BLINKING :== 10
EV_STOP_MOVING :== 11
EV_HEALTH :== 20
/* ---------- objects ---------- */
/* bounds */
BND_MAIN_CHARACTER :== (1 << 0)
BND_POWER_UP :== (1 << 1) /* coins, diamonds, hearts, etc */
BND_BLOCKS :== (1 << 2) /* crates and bounce blocks */
BND_ENEMY :== (1 << 3)
BND_KILL :== (1 << 4)
BND_WATER :== (1 << 5)
BND_ENDING :== (1 << 6)
BND_STAT :== (1 << 7)
/* predefined bounds:
BND_MAP_CODES :== (1 << 30)
BND_STATIC_BOUNDS :== (1 << 31)
*/
/* object codes (initialized by code in the bound map) */
OBJ_AUTOINIT :== 0
/*
OBJ_START :== 0x10 // lower map values are subtypes
*/
OBJ_STATIC_COIN :== 0x10
OBJ_FALLING_COIN :== 0x11
OBJ_STATIC_DIAMOND :== 0x12
OBJ_FALLING_DIAMOND :== 0x13
OBJ_HEART :== 0x14
OBJ_LIFE :== 0x15
OBJ_CLOUD :== 0x1A
OBJ_PALM :== 0x1B
OBJ_GROUND1 :== 0x1C
OBJ_GROUND2 :== 0x1D
OBJ_GROUND3 :== 0x1E
OBJ_WATER :== 0x1F
OBJ_BOUNCEBLOCK :== 0x20
OBJ_PIN :== 0x22
OBJ_ENEMY :== 0x80
OBJ_BEE :== 0x81
OBJ_FROG :== 0x82
OBJ_INVISIBLE_CRATE :== 0xB0
OBJ_CRATE :== 0xC0
OBJ_MAIN_CHAR :== 0xF0
OBJ_ENDING :== 0xFE
/* objects created during the game */
OBJ_CRATE_PART :== 0x100
OBJ_SPLASH :== 0x101
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
]
/* ---------- background cloud ---------- */
/* Because we only have a few little clouds, we will use
objects instead of a complete layer here. */
CloudObject
# obj = defaultGameObject OBJ_CLOUD size Void
# obj = { obj
& sprites = [CloudSprite2]
, init = newinit size Void
}
= obj
where
size = {w = 40, h = 24}
newinit size state subcode _ time gs
# pos = case subcode of
1 -> { x = 36, y = 50 }
2 -> { x = 88, y = 28 }
3 -> { x = 240, y = 43 }
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# objrec = { objrec
& options.static = True
, options.ignorelevelbounds = True
, layer = AtLayer LYR_BACKGROUND
}
= {st=state, or=objrec, gs=gs}
/* ---------- palm front object ---------- */
/* This object is the part of a palm tree that is shown in front
of Charlie. This could also be done with a complete layer, but
again for speed we will use objects. */
PalmFrontObject
# obj = defaultGameObject OBJ_PALM size Void
# obj = { obj
& sprites = [PalmSprite2, PalmSprite1, PalmSprite3]
, init = newinit size Void
}
= obj
where
size = {w = 20, h = 32}
newinit size state subcode pos time gs
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# objrec = { objrec
& layer = AtLayer LYR_INFRONT
, offset = {x = 0, y = ~H}
, currentsprite = (subcode + 1)
}
= {st=state, or=objrec, gs=gs}
BlockInFrontObject objtype spr
# obj = defaultGameObject objtype size Void
# obj = { obj
& sprites = [spr]
, init = newinit size Void
}
= obj
where
size = DEFAULT_SIZE
newinit size state subcode pos time gs
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# objrec = { objrec
& layer = AtLayer LYR_INFRONT
}
= {st=state, or=objrec, gs=gs}
/* ---------- coins and diamonds ---------- */
SPR_ITEM :== 1
SPR_GLITTER :== 2
StaticCoinObject = StaticGameItem OBJ_STATIC_COIN ItemSprite3
FallingCoinObject = FallingGameItem OBJ_FALLING_COIN ItemSprite3
StaticDiamondObject = StaticGameItem OBJ_STATIC_DIAMOND ItemSprite2
FallingDiamondObject = FallingGameItem OBJ_FALLING_DIAMOND ItemSprite2
HeartObject = FallingGameItem OBJ_HEART ItemSprite6
LifeObject = FallingGameItem OBJ_LIFE ItemSprite5
FallingGameItem objectcode sprite
# obj = StaticGameItem objectcode sprite
# obj = { obj
& init = newinit size Void
}
= obj
where
size = DEFAULT_SIZE
newinit size state subcode pos time gs
# pos = {pos & x = if (subcode == 1) (pos.x + W / 2) (pos.x)}
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# xv = case subcode of
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)}
, 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
, ownbounds = BND_POWER_UP
, bouncebounds = BND_STATIC_BOUNDS
, collidebounds = BND_MAIN_CHARACTER
, forgetdistance = {x = 8, y = 8}
}
= {st=state, or=objrec, gs=gs}
StaticGameItem objectcode sprite
# obj = defaultGameObject objectcode size Void
# obj = { obj
& sprites = [sprite, ItemAnimation4]
, init = newinit size Void
, collide = newcollide
, animation = killobject
}
= obj
where
size = DEFAULT_SIZE
newinit size state subcode pos time gs
# pos = {pos & x = if (subcode == 1) (pos.x + W / 2) (pos.x)}
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# objrec = { objrec
& options.ignorelevelbounds = True
, ownbounds = BND_POWER_UP
, bouncebounds = BND_STATIC_BOUNDS
, collidebounds = BND_MAIN_CHARACTER
, layer = AtLayer LYR_FOREGROUND
}
= {st=state, or=objrec, gs=gs}
newcollide bnds objtype objrec objst=:{st=st, or=or, gs=gs}
| objtype == OBJ_MAIN_CHAR
# (points, gs) = ItemScoreAndSound objectcode gs
# gs = addscore points gs
= {objst & or={or & currentsprite = SPR_GLITTER
, options.removemapcode = True
, layer = AtLayer LYR_INFRONT
, ownbounds = 0
, collidebounds = 0
},
gs=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
= (50, inccoins gs)
| 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
= (150, incdiamonds gs)
| 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
= if (ot == OBJ_LIFE) (500, inclives gs) (100, gs)
= (100, gs)
killobject objst=:{or=or}
= {objst & or={or & active = False}}
/* ---------- crates ---------- */
/* crates contain items which appear when Charlie opens these crates by
jumping on top of them */
CrateObject = Crate True
InvisibleCrateObject = Crate False
Crate visible
# obj = defaultGameObject (if visible OBJ_CRATE OBJ_INVISIBLE_CRATE) size Void
# obj = { obj
& sprites = [ItemSprite1]
, init = newinit size Void
, collide = newcollide
}
= obj
where
size = DEFAULT_SIZE
newinit size state subcode pos time gs
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# objrec = { objrec
& layer = AtLayer LYR_FOREGROUND
, ownbounds = if visible
(BND_STATIC_BOUNDS + BND_BLOCKS)
(BND_BLOCKS)
, collidebounds = BND_MAIN_CHARACTER
, currentsprite = if visible 1 0
}
= {st=state, or=objrec, gs=gs}
newcollide bnds othertype otherobjrec objst=:{st=st, or=or, gs=gs}
| othertype == OBJ_MAIN_CHAR && bnds.bottom
# pos1 = or.pos
# pos2 = {pos1 & y = pos1.y + 8}
# (_, gs) = createNewGameObject OBJ_CRATE_PART 1 pos1 gs
# pos1 = {pos1 & x = pos1.x + 4}
# (_, 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
# pos2 = {pos2 & x = pos2.x + 4}
# (_, gs) = createNewGameObject OBJ_CRATE_PART 5 pos2 gs
# pos2 = {pos2 & x = pos2.x + 4}
# (_, gs) = createNewGameObject OBJ_CRATE_PART 6 pos2 gs
# or = {or & options.removemapcode = True, active = False}
# obj = case or.subcode of
0 -> if visible OBJ_FALLING_COIN OBJ_STATIC_COIN
1 -> if visible OBJ_FALLING_DIAMOND OBJ_STATIC_DIAMOND
2 -> OBJ_HEART
3 -> OBJ_LIFE
4 -> OBJ_FALLING_COIN
5 -> OBJ_FALLING_DIAMOND
# (_, gs) = createNewGameObject obj 0 or.pos gs
| or.subcode == 4 || or.subcode == 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 & or=or, gs=gs}
= {objst & or=or, gs=gs}
= objst
CratePartObject
# obj = defaultGameObject OBJ_CRATE_PART size Void
# obj = { obj
& sprites = [PartSprite1]
, init = newinit size Void
}
= obj
where
size = {w = 12, h = 8}
newinit size state subcode pos time gs
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# ((xv, yv), gs) = case subcode 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
# objrec = { objrec & acceleration = {rx = 0.0, ry = 1.0 / 12.0}
, speed = {rx = xv, ry = yv}
, forgetdistance = {x = 1, y = 1}
}
= {st=state, or=objrec, gs=gs}
where
rnd (x, y) 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 Void
# obj = { obj
& sprites = [FlashAnimation1]
, init = newinit size Void
, animation = killobject
}
= obj
where
size = {w = 24, h = 20}
newinit size state subcode pos time gs
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# objrec = { objrec
& layer = AtLayer LYR_INFRONT
}
= {st=state, or=objrec, gs=gs}
/* ---------- bounce block ---------- */
BounceBlockObject
# obj = defaultGameObject OBJ_BOUNCEBLOCK size Void
# obj = { obj
& sprites = [ItemSprite7, ItemAnimation7]
, init = newinit size Void
, collide = newcollide
, animation = newanimation
}
= obj
where
size = DEFAULT_SIZE
newinit size state subcode pos time gs
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# objrec = { objrec
& layer = AtLayer LYR_FOREGROUND
, speed = {rx = 0.0-toReal subcode, ry = 0.0}
, bounce