Skip to content

GitLab

Commit 77c5089e authored by Mike Wiering's avatar Mike Wiering
Browse files

Worms.icl added again.

parent 6209d735
Hide whitespace changes
Inline Side-by-side
libraries/ObjectIO/Game Examples/WORMS/Worms.icl 0 → 100644
View file @ 77c5089e
module Worms
/*
Worms Demonstration Game for the Clean Game Library
Version: 3.0 (March 20, 2000)
Author: Mike Wiering (mike.wiering@cs.kun.nl)
Note: To play Worms with background music, copy your favourite MIDI file
to Worms.mid in the music\ subdirectory.
*/
import StdEnv, StdIO, StdGameDef, StdGame, StdGSt, GameFunctions, Random, notes
import WormsGfx /* generated by Tile Studio */
:: GameState
= { curlevel :: !Int
, maxlevel :: !Int
, quit :: !Bool
, wormlist :: ![RealXY]
, gameover :: !Bool
, timecounter :: !Int
, randseed :: !RandomSeed
}
initialGameState = { curlevel = 0
, maxlevel = 7
, quit = False
, wormlist = []
, gameover = False
, timecounter = 0
, randseed = nullRandomSeed
}
/* move with speed V */
V = 3.0 /* 24 rem V must be 0 */
/* ---------- main program: load game definition and start the game! ---------- */
Start :: *World -> *World
Start world
# (seed, world) = getNewRandomSeed world
= startGame WormsDemo {initialGameState & randseed = seed}
[ScreenSize {w = 640, h = 480}, ColorDepth 16] world
/* ---------- the complete game definition ---------- */
WormsDemo :: (Game GameState)
WormsDemo =
{ levels = [ blankScreen
, GameLevel1
, blankScreen
, GameLevel2
, blankScreen
, GameLevel3
, blankScreen
]
, quitlevel = accGSt WormsQuitFunction
, nextlevel = accGSt WormsNextLevelFunction
, textitems = accGSt WormsTextItems
}
/* if the quit function returns true, the game engine quit the level */
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 gst =: {curlevel, maxlevel, gameover}
= (nextLevel, {gst & curlevel = nextLevel
, quit = False
, timecounter = (time nextLevel)
})
where
nextLevel = if (gameover || (curlevel + 1 > maxlevel)) 0 (curlevel + 1)
time l = if (l == maxlevel) 500 (if (l rem 2 == 1) 100 (~1))
/* function that returns text to be displayed */
WormsTextItems :: GameState -> ([GameText], GameState)
WormsTextItems gst =: {curlevel, gameover, timecounter, maxlevel}
# gst = {gst & timecounter = timecounter - 1}
| gst.timecounter == 0
= ([], {gst & quit = True})
| gameover
| timecounter < 0
= ([GameOver], {gst & timecounter = 250})
= ([GameOver], gst)
= if (curlevel == maxlevel)
([Ending1 timecounter, Ending2 timecounter], gst)
(if (curlevel rem 2 == 1)
([LevelStat ((curlevel + 1) / 2)], gst)
([], gst)
)
/* ---------- definitions of the levels ---------- */
/* block size */
W :== 24
H :== 24
DEFAULT_SIZE :== {w = W, h = H}
/* ---------- levels ---------- */
GameLevel1
= { DefaultLevel
& boundmap = Level1Map1BoundMap
, layers = [Level1Map1Layer]
, music = Just BackgroundMusic
}
GameLevel2
= { DefaultLevel
& boundmap = Level2Map1BoundMap
, layers = [Level2Map1Layer]
}
GameLevel3
= { DefaultLevel
& boundmap = Level3Map1BoundMap
, layers = [Level3Map1Layer]
}
DefaultLevel
= { blankScreen
& initpos = {x = W - 8, y = 0}
, objects = ObjectList
, music = Nothing
, soundsamples = SoundSampleList
, leveloptions = { fillbackground = Nothing
, escquit = False
, debugscroll = False
, fadein = False
, fadeout = False
}
}
/* ---------- objects ---------- */
/* object codes (corresponds with level map) */
OBJ_WORMHEAD :== 0x10
OBJ_WORMSEGMENT :== 0x11
OBJ_FOOD :== 0x12
OBJ_WALL :== 0x80
/* user events */
EV_STOP :== 0
EV_DIE :== 1
EV_GAMEOVER :== 2
EV_END_LEVEL :== 3
/* ---------- worm object ---------- */
/* worm head sprites */
SPR_WH_UP :== 1
SPR_WH_LEFT :== 2
SPR_WH_DOWN :== 3
SPR_WH_RIGHT :== 4
ObjectList = [WormHead, WormSegment, Food, Wall]
/* bounds */
BND_WORMHEAD :== 0x0001
BND_WORMSEGMENT :== 0x0002
BND_FOOD :== 0x0004
BND_WALL :== 0x0008
:: WormState
= { xv :: !Real /* next x-speed */
, yv :: !Real /* next y-speed */
, count :: !Int /* current length of the worm */
, add :: !Int /* number of segments to add when worm eats food */
, more :: !Int /* number of segments that still have to be added */
, lastpoint :: !RealXY /* position of last segment */
, next :: !Int /* next sprite */
}
/* layer height, to display some objects in front of others */
NormalLayer = 1
TopLayer = 2
WormHead
# obj = defaultGameObject OBJ_WORMHEAD sz wormstate
# obj = { obj
& sprites = [ WormHeadSprite1
, WormHeadSprite2
, WormHeadSprite3
, WormHeadSprite4
]
, init = (newInit sz wormstate)
, keydown = newKeyDown
, move = newMove
, collide = newCollide
, userevent = newUserEvent
, touchbound = newTouchBound
}
= obj
where
sz = DEFAULT_SIZE
wormstate = { xv = V
, yv = 0.0
, count = 3
, add = 1
, more = 0
, lastpoint = {rx = 0.0, ry = 0.0}
, next = 0
}
newInit size state subcode pos time gs
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# (_, gs) = createObjectFocus zero gs
# state = { state & next = SPR_WH_RIGHT }
# gs = setwormlist [defSpeed, defSpeed, defSpeed] gs
# (_, gs) = createNewGameObject OBJ_WORMSEGMENT 1
{objrec.pos & x = objrec.pos.x - 1 * W} gs
# (_, gs) = createNewGameObject OBJ_WORMSEGMENT 2
{objrec.pos & x = objrec.pos.x - 2 * W} gs
# lastx = objrec.pos.x - 3 * W
lasty = objrec.pos.y
# state = {state & lastpoint = {state.lastpoint & rx = toReal lastx,
ry = toReal lasty}, more = 0}
# (_, gs) = createNewGameObject OBJ_FOOD 0
{x = 0, y = 0} gs
# objrec = { objrec
& ownbounds = BND_WORMHEAD
, collidebounds = BND_WORMSEGMENT + BND_FOOD +
BND_STATIC_BOUNDS
, offset = {x = ~2, y = ~2}
, size = {w = W, h = H}
, options = {objrec.options & checkkeyboard = True}
, skipmove = 0
, layer = AtLayer TopLayer
, currentsprite = SPR_WH_RIGHT
}
= {st=state, or=objrec, gs=gs}
newKeyDown GK_LEFT objst=:{st}
= {objst & st = {st & xv = (~V), yv = 0.0, next = SPR_WH_LEFT}}
newKeyDown GK_RIGHT objst=:{st}
= {objst & st = {st & xv = V, yv = 0.0, next = SPR_WH_RIGHT}}
newKeyDown GK_UP objst=:{st}
= {objst & st = {st & xv = 0.0, yv = (~V), next = SPR_WH_UP}}
newKeyDown GK_DOWN objst=:{st}
= {objst & st = {st & xv = 0.0, yv = V, next = SPR_WH_DOWN}}
newKeyDown GK_ESCAPE objst
= newTouchBound 0 0 objst
newKeyDown _ objst
= objst
newMove objst=:{st, or, gs}
# nextspeed = {rx = st.xv, ry = st.yv}
# (wormlist, gs) = getwormlist gs
# gs = setwormlist (take st.count [nextspeed:wormlist]) gs
# or = {or & speed = nextspeed
, currentsprite = st.next
, skipmove = (24 / (toInt V)) -1
}
| st.more == 0
# last = wormlist!!((length wormlist) - 1)
# newx = last.rx * (24.0 / V) + st.lastpoint.rx
newy = last.ry * (24.0 / V) + st.lastpoint.ry
# st = {st & lastpoint = {rx = newx, ry = newy}}
= {st=st, or=or, gs=gs}
# (_, gs) = createNewGameObject OBJ_WORMSEGMENT
(st.count - st.more)
{x = toInt st.lastpoint.rx, y = toInt st.lastpoint.ry} gs
# st = {st & more = st.more - 1}
= {st=st, or=or, gs=gs}
newCollide bounds othertype _ objst=:{st, or, gs}
| othertype == OBJ_FOOD
# (_, gs) = playSoundSample SND_FOOD (MAX_VOLUME * 7 / 8) PAN_CENTER
(getnotefreq (67 + st.add * 2)) 0 gs
# (_, gs) = playSoundSample SND_FOOD (MAX_VOLUME * 7 / 8) PAN_CENTER
(getnotefreq (71 + st.add * 2)) 2 gs
# st = {st & count = st.count + st.add
, more = st.more + st.add
, add = st.add + 1
}
| st.add == 10
# (_,gs) = createUserGameEvent EV_END_LEVEL 0 0 Self ANY_SUBTYPE 3 gs
= {st=st, or=or, gs=gs}
= {st=st, or=or, gs=gs}
| othertype == OBJ_WORMSEGMENT
# or = {or & ownbounds = 0, collidebounds = 0}
= newTouchBound bounds 0 {st=st, or=or, gs=gs}
= {st=st, or=or, gs=gs}
newTouchBound _ _ objst=:{st, or, gs}
# gs = setgameover True gs
# (_,gs) = createUserGameEvent EV_STOP 0 0 AllObjects ANY_SUBTYPE 0 gs
# (_,gs) = createUserGameEvent EV_GAMEOVER 0 0 Self ANY_SUBTYPE 350 gs
= {st=st, or=or, gs=gs}
defSpeed = {rx = V, ry = 0.0}
newUserEvent ev par1 par2 objst=:{st, or, gs}
| ev == EV_STOP
# (_, gs) = playSoundSample SND_HIT MAX_VOLUME PAN_CENTER
(getnotefreq 85) 0 gs
# (_, gs) = playSoundSample SND_HIT (MAX_VOLUME * 18 / 19) PAN_CENTER
(getnotefreq 81) 3 gs
# (_, gs) = playSoundSample SND_HIT (MAX_VOLUME * 17 / 19) PAN_CENTER
(getnotefreq 77) 6 gs
# (_, gs) = playSoundSample SND_HIT (MAX_VOLUME * 16 / 19) PAN_CENTER
(getnotefreq 73) 10 gs
# (rnd, gs) = Rnd gs
# (_, gs) = createUserGameEvent EV_DIE 0 0 Self ANY_SUBTYPE (rnd rem 150) gs
= {st=st, or={or & speed = {rx = 0.0, ry = 0.0}
, skipmove = ~1
, options = {or.options & checkkeyboard = False}
}, gs=gs}
| ev == EV_DIE
= {st=st, or = {or & currentsprite = SPR_INVISIBLE}, gs=gs}
| ev == EV_GAMEOVER
= {st=st, or=or, gs=gs}
| ev == EV_END_LEVEL
= quitlevel {st=st, or=or, gs=gs}
= {st=st, or=or, gs=gs}
WormSegment
# obj = defaultGameObject OBJ_WORMSEGMENT sz Void
# obj = { obj
& sprites = [WormSegmentSprite1]
, init = (newInit sz Void)
, move = newMove
, userevent = newUserEvent
}
= obj
where
sz = DEFAULT_SIZE
newInit size state subtype pos time gs
# (objrec, gs) = defaultObjectRec subtype pos size time gs
# objrec = { objrec
& ownbounds = if (subtype > 1) BND_WORMSEGMENT 0
, collidebounds = 0
, skipmove = 0 // toInt (2.0 / V) -1
, layer = AtLayer NormalLayer
}
= {st=state, or=objrec, gs=gs}
newMove objst=:{st, or, gs}
# (wormlist, gs) = getwormlist gs
# or = { or & skipmove = (24 / (toInt V)) -1 }
| or.subcode + 1 > length wormlist
= {st=st, or=or, gs=gs}
# or = {or & speed = wormlist!!(or.subcode)}
= {st=st, or=or, gs=gs}
newUserEvent ev par1 par2 objst=:{st, or, gs}
| ev == EV_STOP
# (rnd, gs) = Rnd gs
# (_,gs) = createUserGameEvent EV_DIE 0 0 Self ANY_SUBTYPE (rnd rem 150) gs
# or = {or & speed = {rx = 0.0, ry = 0.0}
, skipmove = ~1
, options = {or.options & checkkeyboard = False}}
= {st=st, or=or, gs=gs}
| ev == EV_DIE
# or = {or & currentsprite = SPR_INVISIBLE}
= {st=st, or=or, gs=gs}
= {st=st, or=or, gs=gs}
/* ---------- wall object ---------- */
Wall
# obj = defaultGameObject OBJ_WALL sz Void
# obj = {obj & init = (newInit sz Void)}
= obj
where
sz = DEFAULT_SIZE
newInit size state subcode pos time gs
# (objrec, gs) = defaultObjectRec subcode pos size time gs
# objrec = { objrec & ownbounds = BND_WALL }
= {st=state, or=objrec, gs=gs}
/* ---------- food object ---------- */
SPR_INVISIBLE = 0
SPR_VISIBLE = 1
Food
# obj = defaultGameObject OBJ_FOOD sz Void
# obj = { obj
& sprites = [FoodSprite1]
, init = (newInit sz Void)
, move = newMove
, touchbound = newTouchBound
, collide = newCollide
, userevent = newUserEvent
}
= obj
where
sz = DEFAULT_SIZE
newInit size state subtype pos time gs
# (objrec, gs) = defaultObjectRec subtype pos size time gs
# (p, gs) = newPos gs
# objrec = { objrec
& ownbounds = 0
, collidebounds = BND_WORMHEAD + BND_WORMSEGMENT +
BND_WALL
, skipmove = 50
, layer = AtLayer NormalLayer
, pos = p
, currentsprite = SPR_INVISIBLE
}
= {st=state, or=objrec, gs=gs}
newPos gs
# (rnd1, gs) = Rnd gs
# (rnd2, gs) = Rnd gs
= ( { x = W * (2 + (rnd1 rem 24))
, y = H * (1 + (rnd2 rem 18))}, gs)
newCollide bnd ot _ objst
= newTouchBound bnd 0 objst
newTouchBound bnd mapcode objst=:{st, or, gs}
# (p, gs) = newPos gs
# or = {or & pos = p
, ownbounds = 0
, skipmove = 50
, currentsprite = SPR_INVISIBLE
}
= {st=st, or=or, gs=gs}
newMove objst=:{or}
# or = {or & currentsprite = SPR_VISIBLE
, ownbounds = BND_FOOD
, skipmove = ~1
}
= {objst & or = or}
newUserEvent ev par1 par2 objst=:{st, or, gs}
| ev == EV_STOP
# (rnd, gs) = Rnd gs
# (_,gs) = createUserGameEvent EV_DIE 0 0 Self ANY_SUBTYPE (rnd rem 150) gs
# or = {or & speed = {rx = 0.0, ry = 0.0}
, skipmove = ~1
, options = {or.options & checkkeyboard = False}}
= {st=st, or=or, gs=gs}
| ev == EV_DIE
# or = {or & currentsprite = SPR_INVISIBLE}
= {st=st, or=or, gs=gs}
= {st=st, or=or, gs=gs}
/* ---------- useful functions for objects ---------- */
/* quit the level */
quitlevel objst=:{st, or, gs}
# gs = appGSt setQuit gs
= {st=st, or=or, gs=gs}
where
setQuit :: GameState -> GameState
setQuit gst = {gst & quit = True}
/* wormlist functions */
setwormlist l gs = appGSt (setgstwormlist l) gs
setgstwormlist :: [RealXY] GameState -> GameState
setgstwormlist l gst = {gst & wormlist = l}
getwormlist gs = accGSt getgstwormlist gs
getgstwormlist :: GameState -> ([RealXY], GameState)
getgstwormlist gst = (gst.wormlist, gst)
/* gameover functions */
setgameover b gs = appGSt (setgstgameover b) gs
setgstgameover :: Bool GameState -> GameState
setgstgameover b gst = {gst & gameover = b}
getgameover gs = accGSt getgstgameover gs
getgstgameover :: GameState -> (Bool, GameState)
getgstgameover gst = (gst.gameover, gst)
/* ---------- music ---------- */
BackgroundMusic
= { musicfile = "music\\Worms.mid"
, restart = True
, continue = True
}
/* ---------- text items ---------- */
BigStyle =
{ fontname = "Arial"
, fontsize = 48
, bold = True
, italic = False
}
GameOver =
{ format = "GAME OVER"
, value = Nothing
, position = {x = 0, y = 0}
, style = BigStyle
, color = White
, shadow = Just (MakeShadow 3 Grey)
, alignment = alignCentered
}
LevelStat n =
{ format = "LEVEL %d"
, value = Just n
, position = {x = 0, y = 0}
, style = {BigStyle & fontsize = 32}
, color = White
, shadow = Just (MakeShadow 2 Grey)
, alignment = alignCentered
}
MakeShadow offset color =
{ shadowpos = {x = offset, y = offset}
, shadowcolor = color
}
Ending1 n
# n = n * 2
= { format = "CONGRATULATIONS!!!"
, value = Nothing
, position = {x = 0, y = ~30}
, style = {BigStyle & fontsize = 34}
, color = RGB { r = 240 + (n rem 32)
, g = 224 + (n rem 32) * 2
, b = 196 + (n rem 32) * 3}
, shadow = Just (MakeShadow 2 Grey)
, alignment = alignCentered
}
Ending2 n
= { format = "You have completed all levels!"
, value = Nothing
, position = {x = 0, y = 30}
, style = {BigStyle & fontsize = 28, italic = True}
, color = RGB { r = 224 + (n rem 32)
, g = 224 + (n rem 32)
, b = 224 + (n rem 32) * 2}
, shadow = Just (MakeSha