module Sint /* Sint Nicolaas '99 Written by Mike Wiering (mike.wiering@cs.kun.nl) Katholieke Universiteit Nijmegen For more information, see: http://www.cs.kun.nl/is/sint/ Compile with 4000K heap space (Project, Application options) */ import StdEnv, StdIO, StdGameDef, StdGame, StdGSt, notes import osgame, gst, gameobjectutils, Random /* import ArgEnv */ import SintGfx /* generated by Tile Studio */ VERSION :== "Sint '99 - Versie 1.0" /* layers */ LYR_BACKGROUND :== 1 LYR_MIDGROUND :== 2 LYR_FOREGROUND :== 3 LYR_KADO :== 8 LYR_PLAYER :== 9 LYR_INFRONT :== 10 LYR_GLITTER :== 20 LYR_STATUS :== 30 /* main character defaults */ DEFAULT_LIVES :== 3 DEFAULT_TIME :== 250 BONUS_TIME :== 125 TODO :== (5 * (5 + 1)) BONUS_PPN :== 50 EXTRA_PPN :== 15 /* scrolling text positions */ START_MSG :== 340 STOP_MSG :== -340 /* level result codes */ EC_NONE :== 0 EC_SUCCESS :== 1 EC_FAILURE :== 2 EC_QUIT :== 3 FIRST_TIME :== -1000 SHOW_PERS_HIS :== -2000 SHOW_HIS :== -2001 FPS :== 70 FADE :== True ESC_QUIT :== True CARDWARE :== False /* high scores */ HIGH_SCORES_FILE :== "SINT99.HIS" :: HiS = { name :: !String , hiscore :: !Int } :: CodedHiS = { codedhiscore :: !String /* binary representation of name and score */ } emptyhis = { codedhiscore = "" } MAX_NUMBER_LEN :== 16 MAX_NAME_LEN :== 32 GRONDTAL :== 10 DecodeHiS :: CodedHiS -> [HiS] DecodeHiS chis = decodehis ([c \\ c <-: chis.codedhiscore] ++ ['\n']) "" 0 0 where decodehis :: [Char] !String !Int !Int -> [HiS] decodehis [] _ _ _ = [] decodehis [c:cs] s i n | n < MAX_NUMBER_LEN = decodehis cs s ((i * GRONDTAL) + (toInt c)) (n + 1) | n < MAX_NAME_LEN + MAX_NUMBER_LEN = decodehis cs (s +++ (if (toInt c == 0) "" (toString c))) i (n + 1) | otherwise = [{name = s, hiscore = i}: decodehis [c:cs] "" 0 0] EncodeHiS :: [HiS] -> CodedHiS EncodeHiS his # chis = codehis his = { codedhiscore = {c \\ c <- chis}} where codehis :: [HiS] -> [Char] codehis [] = [] codehis [h:hs] = (codeh h) ++ (codehis hs) codeh h =: {name, hiscore} = (reverse (addzero (codehiscore hiscore) MAX_NUMBER_LEN)) ++ (addzero [c \\ c <-: name] MAX_NAME_LEN) codehiscore :: Int -> [Char] codehiscore 0 = [] codehiscore score = [toChar (score rem GRONDTAL)] ++ codehiscore (score / GRONDTAL) addzero :: [Char] Int -> [Char] addzero c n | length c < n = (addzero c (n - 1)) ++ [toChar 0] | otherwise = c ReadScores :: !String !*Files -> (!(!*File, !CodedHiS), !*Files) ReadScores filename files # (exists, file, files) = fopen fpath FReadText files | exists # (codedhis, file) = ReadHiS file = ((file, codedhis), files) # (_, file, files) = fopen fpath FWriteText files | otherwise = ((file, emptyhis), files) where fpath = filename ReadHiS :: !*File -> (!CodedHiS, !*File) ReadHiS file | sfend file = (emptyhis, file) # (codedhi, file) = freadline file = ({codedhiscore = codedhi}, file) WriteScores :: !*File !CodedHiS !*Files -> *Files WriteScores file codedhis files # (ok, file) = freopen file FWriteText | not ok = snd (fclose file files) # file = WriteHiS codedhis file = snd (fclose file files) where WriteHiS :: !CodedHiS !*File -> *File WriteHiS codedhis file = file <<< codedhis.codedhiscore <<< '\n' FindScore :: String CodedHiS -> Int FindScore s codedhis = findscore s (DecodeHiS codedhis) where findscore :: String [HiS] -> Int findscore _ [] = 0 findscore s [h:hs] | h.name == s = h.hiscore | otherwise = findscore s hs UpdateScore gst # personalscore = FindScore gst.player gst.codedhis | (gst.score == 0) || (gst.player == "") = {gst & pershiscore = personalscore, rank = 10000} # hislist = DecodeHiS gst.codedhis # (hislist, newrank) = addscoretolist hislist {name = gst.player, hiscore = gst.score} 1 # gst = {gst & codedhis = EncodeHiS hislist} = {gst & pershiscore = personalscore, rank = newrank} where addscoretolist :: [HiS] HiS Int -> ([HiS], Int) addscoretolist [] h n = ([h], n) addscoretolist [x:xs] h n | h.hiscore > x.hiscore = ([h:[x:xs]], n) | otherwise # (newxs, newn) = addscoretolist xs h (n + 1) = ([x:newxs], newn) /* the game state definition */ :: GameState = { curlevel :: !Int /* 1 = title, 2 = level1, 3 = bonus1, 4 = level2, etc */ , maxlevel :: !Int , titlescreen :: !Bool , quit :: !Bool , statusline :: !Bool , exitcode :: !Int , lives :: !Int , ppn :: !Int /* pepernoten */ , time :: !Int , score :: !Int , gameover :: !Bool , bonus :: !Bool , bonusmsg :: !Int /* current position of scrolling message */ , morningmsg :: !Int , readymsg :: !Int , notreadymsg :: !Int , player :: !String /* player's name */ , codedhis :: !CodedHiS , pershiscore :: !Int , rank :: !Int , cursor :: !Int , randseed :: !RandomSeed } initialGameState = { curlevel = 0 , maxlevel = 5 , titlescreen = True , quit = False , statusline = True , exitcode = EC_NONE , lives = DEFAULT_LIVES , ppn = 0 , time = FIRST_TIME , score = 0 , gameover = False , bonus = False , bonusmsg = STOP_MSG , morningmsg = STOP_MSG , readymsg = STOP_MSG , notreadymsg = STOP_MSG , player = "" , codedhis = emptyhis , pershiscore = 0 , rank = 0 , cursor = 0 , randseed = nullRandomSeed } /* ---------- main program: load game definition and run the game! ---------- */ Start world # (randomSeed, world) = getNewRandomSeed world # initgs = {initialGameState & randseed = randomSeed} = startIO SDI initgs init [ProcessClose closeProcess] world where init ps=:{ls=initgs} # ((hisfile, codedhis), ps) = accFiles (ReadScores HIGH_SCORES_FILE) ps # gs = {initgs & codedhis = codedhis} # (finalgamestate, _, ps) = openGame gs SintGame [ColorDepth depth, ScreenSize {w=320,h=200}] ps # ps = appFiles (WriteScores hisfile finalgamestate.codedhis) ps = closeProcess ps depth = 16 /* depth = if ((parameter "/8") || (parameter "-8")) 8 16 parameter arg = checkpar arg getCommandLine 0 where checkpar arg cmdline n | n >= (size cmdline) = False | cmdline.[n] == arg = True | otherwise = (checkpar arg cmdline (n + 1)) */ /* ---------- the complete game definition starts here ---------- */ SintGame :: (Game GameState) SintGame = { levels = [ TitleScreen , Level1 , Level1b , Level2 , Level2b ] , quitlevel = accGSt QuitFunction , nextlevel = accGSt NextLevelFunction , textitems = accGSt GameTexts } /* if the quit function returns true, the game engine quits 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, exitcode, lives, gameover, bonus} | exitcode == EC_QUIT = (0, gst) | (curlevel == 0) || gameover = title gst | curlevel == 1 // title screen = (next, resetgame gst) | exitcode == EC_FAILURE | lives > 0 = (curlevel, {(resetlevel gst) & lives = lives - 1}) = title gst | exitcode == EC_SUCCESS | not (normallevel curlevel) # (lev, gst) = nextlevel = (lev, {gst & bonus = False}) = nextlevel = title gst where resetgame gst = { resetlevel gst & titlescreen = False , statusline = True , lives = DEFAULT_LIVES , score = 0 , curlevel = next } resetlevel gst = { gst & ppn = 0 , time = DEFAULT_TIME , gameover = False , bonus = False } title gst # gst = UpdateScore gst # gst = if (gst.time == FIRST_TIME) gst {gst & time = SHOW_PERS_HIS} = (1, gsttitle gst) where gsttitle gst = { gst & titlescreen = True , statusline = False , gameover = False , curlevel = 1 } nextlevel = if (next > maxlevel) (title gst) (next, { gst & curlevel = next , time = if (normallevel next) DEFAULT_TIME BONUS_TIME , bonusmsg = STOP_MSG , morningmsg = STOP_MSG , readymsg = STOP_MSG , notreadymsg = STOP_MSG }) next | (normallevel curlevel) | bonus = curlevel + 1 // play bonus level = curlevel + 2 // next (normal) level = curlevel + 1 // coming from a bonus level, play next level normallevel n = ((n rem 2) == 0) /* function that returns text to be displayed */ GameTexts :: GameState -> *([GameText], GameState) GameTexts gst | gst.statusline # (msg, gst) = if (gst.morningmsg > STOP_MSG) ([Morning gst.morningmsg], {gst & morningmsg = gst.morningmsg - 2}) ([], gst) # (msg, gst) = if (gst.bonusmsg > STOP_MSG) ([Bonus gst.bonusmsg], {gst & bonusmsg = gst.bonusmsg - 2}) (msg, gst) # (msg, gst) = if (gst.readymsg > STOP_MSG) ([Ready gst.readymsg], {gst & readymsg = gst.readymsg - 2}) (msg, gst) # (msg, gst) = if (gst.notreadymsg > STOP_MSG) ([NotReady gst.notreadymsg], {gst & notreadymsg = gst.notreadymsg - 2}) (msg, gst) = ([ Lives gst.lives , TimeLeft (if (gst.time < 0) 0 gst.time) , PPN gst.ppn , Score gst.score ] ++ (if gst.gameover [GameOver] []) ++ (if (gst.time < 0) [TimeUp] []) ++ msg , gst) | gst.time == FIRST_TIME # gst = {gst & cursor = gst.cursor + 1} = ([Version, TypeNaam, Naam (" " +++ gst.player +++ (if ((gst.cursor / 10) rem 2 == 0) " " "|"))], gst) | gst.time == FIRST_TIME - 1 # gst = {gst & cursor = gst.cursor + 1} = ([Version, TypeNaam, Naam gst.player, Pers (FindScore gst.player gst.codedhis)], gst) | gst.time == SHOW_PERS_HIS = ((PersHiScores (DecodeHiS gst.codedhis) gst.score gst.pershiscore gst.player gst.rank), gst) | gst.time == SHOW_HIS = ((HiScores (DecodeHiS gst.codedhis)), gst) = ([], gst) /* ---------- bounds and event codes ---------- */ /* bounds: groups of objects that collide in the same way */ BND_MAIN_CHARACTER :== (1 << 0) BND_POWER_UP :== (1 << 1) BND_KADO :== (1 << 2) BND_ENEMY :== (1 << 3) BND_BLOCKS :== (1 << 4) BND_CHIMNEY :== (1 << 5) BND_ENDING :== (1 << 6) BND_STAT :== (1 << 7) BND_HURT :== (1 << 8) /* predefined bounds BND_MAP_CODES :== (1 << 30) // codes defined in the level editor BND_STATIC_BOUNDS :== (1 << 31) // bounds defined in the level editor */ /* event codes objects can send to each other (use createUserGameEvent) */ EV_QUIT_LEVEL :== 1 EV_GAME_OVER :== 2 EV_TIME_UP :== 3 EV_READY :== 5 EV_KADO_DROPPED :== 6 EV_PEPERNOOT :== 7 EV_ALL_DONE :== 8 EV_STOP_BLINKING :== 10 EV_STOP_MOVING :== 11 EV_COUNT_SCORE :== 14 EV_PPN_SCORE :== 15 EV_ADD_BIRD_SCORE :== 16 EV_SUNRISE :== 18 EV_HEALTH :== 20 EV_TIMER :== 21 EV_POS :== 100 /* ---------- objects ---------- */ /* object codes (must correspond with level map) */ OBJ_AUTOINIT :== 0 /* OBJ_START :== 0x10 */ OBJ_STATIC_PEPERNOOT :== 0x10 OBJ_FALLING_PEPERNOOT :== 0x11 OBJ_LETTER :== 0x12 OBJ_HEART :== 0x13 OBJ_LIFE :== 0x14 OBJ_FALLING_KADO1 :== 0x15 OBJ_FALLING_KADO2 :== 0x16 OBJ_FALLING_KADO3 :== 0x17 OBJ_FALLING_KADO4 :== 0x18 OBJ_FALLING_KADO5 :== 0x19 OBJ_BOUNCEBLOCK :== 0x20 OBJ_TRAMP :== 0x21 OBJ_CHIMNEY1 :== 0x25 OBJ_CHIMNEY2 :== 0x26 OBJ_CHIMNEY3 :== 0x27 OBJ_CHIMNEY4 :== 0x28 OBJ_CHIMNEY5 :== 0x29 OBJ_ANTENNE :== 0x30 OBJ_CAR :== 0x40 OBJ_FRONT :== 0x5F OBJ_FADE :== 0x60 OBJ_BIRD :== 0x81 OBJ_MAIN_CHAR :== 0xF0 OBJ_ENDING :== 0xFE OBJ_KADO1 :== 0x101 OBJ_KADO2 :== 0x102 OBJ_KADO3 :== 0x103 OBJ_KADO4 :== 0x104 OBJ_KADO5 :== 0x105 OBJ_FLITS :== 0x110 OBJ_STAT :== 0x111 OBJ_SUN :== 0x115 // default block size W :== 20 H :== 20 BLOCK_SIZE :== {w = W, h = H} ITEM_SIZE :== {w = W, h = 16} NEVER_FORGET :== {x = 10000, y = 10000} GameObjectList = [ GameObjectLS AutoInitObject , GameObjectLS StatHeartObject , GameObjectLS StaticPepernoot , GameObjectLS FallingPepernoot , GameObjectLS FallingLetter , GameObjectLS HeartObject , GameObjectLS LifeObject , GameObjectLS Kado1, GameObjectLS Kado2, GameObjectLS Kado3, GameObjectLS Kado4, GameObjectLS Kado5 ] ++ [ GameObjectLS (KadoObject i) \\ i<-[1..5] ] ++ [ GameObjectLS (ChimneyObject i) \\ i<-[1..5] ] ++ [ GameObjectLS BounceBlockObject , GameObjectLS TrampObject , GameObjectLS BirdObject ] ++ [ GameObjectLS (FadeObject i) \\ i<-[0..9] ] ++ [ GameObjectLS AntenneObject , GameObjectLS FlitsObject , GameObjectLS SunObject , GameObjectLS EndingObject , GameObjectLS CarObject , GameObjectLS MainCharObject ] /* ---------- autoinit object ---------- */ /* this object is automatically initialized when the level starts */ STY :== 183 STS :== -5 AutoInitObject # obj = defaultGameObject OBJ_AUTOINIT size Void # obj = { obj & init = (newinit size Void) } = obj where size = {w = 1, h = 1} newinit size state subcode pos time gs # gs = setexitcode EC_NONE gs # (_, gs) = createNewGameObject OBJ_STAT 1 {x = 181-4, y = STY} gs # (_, gs) = createNewGameObject OBJ_STAT 2 {x = 193-4, y = STY} gs # (_, gs) = createNewGameObject OBJ_STAT 3 {x = 205-4, y = STY} gs # (_, gs) = createNewGameObject OBJ_STAT ST_X {x = 29, y = STY} gs # (_, gs) = createNewGameObject OBJ_STAT ST_COLON {x = 257, y = STY} gs # (_, gs) = createNewGameObject OBJ_STAT ST_TIME {x = 83, y = STY} gs # (_, gs) = createUserGameEvent EV_TIMER 0 0 (BoundType BND_STAT) ST_TIME (FPS) gs # (_, gs) = createNewGameObject OBJ_STAT ST_COLON {x = 83, y = STY} gs # (_, gs) = createNewGameObject OBJ_STAT ST_PPN {x = 133-4, y = STY} gs # (_, gs) = createNewGameObject OBJ_STAT ST_X {x = 142-4, y = STY} gs # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = {objrec & active = False} # (bonus, gs) = getbonus gs | bonus = {st=state, or=objrec, gs = msgbonus gs} = {st=state, or=objrec, gs=gs} /* ---------- chimney objects ---------- */ ChimneyObject n # obj = defaultGameObject (OBJ_CHIMNEY1 + n - 1) ITEM_SIZE Void # obj = { obj & sprites = [ ChimneySprite 0, ChimneySprite 2, ChimneySprite 3 , ChimneySprite 4, ChimneySprite 5, ChimneySprite 6 , ChimneySprite (m + 1), ChimneySprite (m + 2), ChimneySprite (m + 3) , ChimneySprite (m + 4), ChimneySprite (m + 5), ChimneySprite (m + 6) ] , init = (newinit ITEM_SIZE Void) , userevent = newuserevent } = obj where m = n * 6 newinit size state subcode pos time gs # pos = {x = pos.x + W / 2, y = pos.y + H / 2} # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & layer = AtLayer LYR_FOREGROUND , currentsprite = 12 , ownbounds = BND_CHIMNEY , offset = {x = 0, y = BLOCK_SIZE.h} , forgetdistance = NEVER_FORGET } = {st=state, or=objrec, gs=gs} newuserevent ev evpar1 evpar2 {st, or, gs} | (ev == EV_PEPERNOOT) && (evpar1 == n) = {st=st, or = {or & currentsprite = or.currentsprite - 1}, gs = addscore 100 gs} | (ev == EV_KADO_DROPPED) && (evpar1 == n) = {st=st, or = {or & currentsprite = or.currentsprite - 6}, gs = addscore 500 gs} = {st=st, or=or, gs=gs} /* ---------- Fading block ---------- */ FadeObject n # obj = defaultGameObject (OBJ_FADE + n) size Void # obj = { obj & sprites = [FadeSprite1 n, FadeSprite2 n] , init = (newinit size Void) , collide = newcollide , animation = killobject } = obj where size = {w = 20, h = 14} newinit size state subcode pos time gs # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & ownbounds = BND_STATIC_BOUNDS , collidebounds = BND_MAIN_CHARACTER , forgetdistance = {x = 10, y = 12} , layer = AtLayer LYR_FOREGROUND } = {st=state, or=objrec, gs=gs} newcollide bnds objtype objrec {st, or, gs} # or = {or & collidebounds = 0 , currentsprite = 2 , options.removemapcode = True } = {st=st, or=or, gs = addscore 10 gs} /* ---------- Antenne ---------- */ AntenneObject # obj = defaultGameObject OBJ_ANTENNE size Void # obj = { obj & init = (newinit size Void) } = obj where size = {w = 20, h = 16} newinit size state subcode pos time gs # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & ownbounds = BND_HURT + BND_STATIC_BOUNDS , subcode = fromDirectionSet {left = False, right = False, top = True, bottom = True} } = {st=state, or=objrec, gs=gs} /* ---------- in front ---------- */ Level1FrontObj = [GameObjectLS (L1FrontObject i) \\ i<-[1..4]] L1FrontObject n # obj = defaultGameObject (OBJ_FRONT - n + 1) BLOCK_SIZE Void # obj = { obj & sprites = [L1FrontObjectSprite n] , init = (newinit BLOCK_SIZE Void) } = obj where 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} ChimneyList = [ OBJ_CHIMNEY1 , OBJ_CHIMNEY2 , OBJ_CHIMNEY3 , OBJ_CHIMNEY4 , OBJ_CHIMNEY5 ] KadoList = [ OBJ_FALLING_KADO1 , OBJ_FALLING_KADO2 , OBJ_FALLING_KADO3 , OBJ_FALLING_KADO4 , OBJ_FALLING_KADO5 ] /* ---------- Sun ---------- */ SunObject # obj = defaultGameObject OBJ_SUN size Void # obj = { obj & sprites = [SunSprite1] , init = (newinit size Void) , userevent = newuserevent } = obj where size = {w = 40, h = 32} newinit size state subcode pos time gs # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & layer = AtLayer LYR_BACKGROUND , options = { objrec.options & static = True } , subcode = 1 } // # (rnd, gs) = IRRnd 5 gs // # (_, gs) = playSoundSample SND_COCK DefaultVolume PAN_CENTER // (getnotefreq (90 + rnd)) 0 gs # (_, gs) = createUserGameEvent EV_SUNRISE 0 0 Self ANY_SUBTYPE 3 gs = {st=state, or=objrec, gs=gs} newuserevent ev _ _ {st, or, gs} | ev == EV_SUNRISE # or = {or & pos = {x = or.pos.x, y = or.pos.y - 1}} | or.pos.y > 2 # (_, gs) = createUserGameEvent EV_SUNRISE 0 0 Self ANY_SUBTYPE 1 gs = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} /* ---------- items ---------- */ StaticPepernoot = StaticGameItem OBJ_STATIC_PEPERNOOT PepernootSprite1 {w = 14, h = 12} FallingPepernoot = FallingGameItem OBJ_FALLING_PEPERNOOT PepernootSprite1 {w = 14, h = 12} FallingLetter = FallingGameItem OBJ_LETTER (LetterSprite 0) ITEM_SIZE HeartObject = FallingGameItem OBJ_HEART ItemSprite1 ITEM_SIZE LifeObject = FallingGameItem OBJ_LIFE ItemSprite5 ITEM_SIZE Kado1 = FallingGameItem OBJ_FALLING_KADO1 (KadoSprite 1) ITEM_SIZE Kado2 = FallingGameItem OBJ_FALLING_KADO2 (KadoSprite 2) ITEM_SIZE Kado3 = FallingGameItem OBJ_FALLING_KADO3 (KadoSprite 3) ITEM_SIZE Kado4 = FallingGameItem OBJ_FALLING_KADO4 (KadoSprite 4) ITEM_SIZE Kado5 = FallingGameItem OBJ_FALLING_KADO5 (KadoSprite 5) ITEM_SIZE FallingGameItem objecttype sprite size # obj = StaticGameItem objecttype sprite size # obj = { obj & init = (newinit size Void) } | (objecttype == OBJ_LETTER) = {obj & sprites = [LetterSprite 0, LetterSprite 1, LetterSprite 2, LetterSprite 3, ItemAnimation2]} = obj where newinit size state subcode pos time gs # oldpos = pos # pos = {pos & x = if (subcode == 1) (pos.x + W / 2) (pos.x)} # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & acceleration = {rx = 0.0, ry = 1.0 / 16.0} , slowdown = {fvx = Factor (1.0 / 24.0), fvy = Value 0.0} , bounce = {fvx = Value 0.0, fvy = Factor (3.0 / 5.0)} , ownbounds = BND_POWER_UP , bouncebounds = BND_STATIC_BOUNDS , collidebounds = BND_MAIN_CHARACTER + BND_ENEMY , layer = AtLayer LYR_FOREGROUND , forgetdistance = {x = 8, y = 10} } | (objecttype == OBJ_LETTER) = {st=state, or = {objrec & currentsprite = subcode + 1, pos = oldpos}, gs=gs} | (isMember objecttype [OBJ_FALLING_PEPERNOOT, OBJ_STATIC_PEPERNOOT]) = {st=state, or = {objrec & pos.x = objrec.pos.x + (20 - 14) / 2}, gs=gs} | (objecttype == OBJ_LIFE) # (ppn, gs) = getppn gs | ppn == BONUS_PPN = {st=state, or=objrec, gs=gs} = killobject {st=state, or=objrec, gs=gs} = {st=state, or=objrec, gs=gs} StaticGameItem objecttype sprite size # obj = defaultGameObject objecttype size Void # obj = { obj & sprites = [sprite, ItemAnimation2] , init = (newinit size Void) , animation = killobject , collide = newcollide } = obj where newinit size state subcode pos time gs # (dx, gs) = case subcode of 0 -> (0, gs) 1 -> (W / 2, gs) otherwise -> (IRRnd (W * subcode) gs) # pos = {pos & x = pos.x + dx} # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & pos = { x = pos.x + ((BLOCK_SIZE.w - size.w) / 2) , y = pos.y + (BLOCK_SIZE.h - size.h) } , ownbounds = BND_POWER_UP , bouncebounds = BND_STATIC_BOUNDS , collidebounds = BND_MAIN_CHARACTER , layer = AtLayer LYR_FOREGROUND , forgetdistance = NEVER_FORGET } = {st=state, or=objrec, gs=gs} newcollide bnds objtype objrec {st, or, gs} | objtype == OBJ_BIRD | (isMember objecttype ([OBJ_FALLING_PEPERNOOT, OBJ_LETTER, OBJ_HEART, OBJ_LIFE] ++ KadoList) && (objrec.speed.ry < 0.0)) # or = {or & speed = {objrec.speed & ry = objrec.speed.ry} , pos.x = objrec.pos.x + (objrec.size.w - or.size.w) / 2} = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} | objtype == OBJ_MAIN_CHAR # points = itemscore objecttype # gs = addscore points gs # gs = itemsound objecttype gs # or = { or & currentsprite = if (objecttype == OBJ_LETTER) 5 2 , options.removemapcode = True , layer = AtLayer LYR_GLITTER , ownbounds = 0 , collidebounds = 0 , offset = { x = (size.w - ITEM_SIZE.w) / 2 , y = (size.h - ITEM_SIZE.h) / 2 } } = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} where itemscore tp | isMember tp [OBJ_STATIC_PEPERNOOT, OBJ_FALLING_PEPERNOOT] = 50 | isMember tp KadoList = 250 | isMember tp [OBJ_HEART] = 500 | isMember tp [OBJ_LIFE] = 750 = 150 itemsound tp gs # (pan, gs) = RandomPan gs # vol = HighVolume | isMember tp [OBJ_STATIC_PEPERNOOT, OBJ_FALLING_PEPERNOOT] # instr = SND_PPN # vol = DefaultVolume # (_, gs) = playSoundSample instr vol pan (getnotefreq 69) 0 gs # (_, gs) = playSoundSample instr vol pan (getnotefreq 80) 3 gs = gs | isMember tp KadoList # instr = SND_FLUTE # (_, gs) = playSoundSample instr vol pan (getnotefreq 104) 0 gs # (_, gs) = playSoundSample instr vol pan (getnotefreq 108) 2 gs # (_, gs) = playSoundSample instr vol pan (getnotefreq 111) 4 gs = gs | isMember tp [OBJ_HEART] # ins = SND_XYLOFOON /* Sinterklaas Kapoentje... */ # gs = PlaySong ins vol pan 106 0 [(7,16),(7,8),(9,16),(9,8),(7,24),(4,24)] gs # gs = PlaySong ins vol pan 106 0 [(4,16),(4,8),(5,16),(5,8),(4,24),(0,24)] gs = gs | isMember tp [OBJ_LIFE] = AddLife gs # instr = SND_XYLOFOON # (_, gs) = playSoundSample instr vol pan (getnotefreq 127) 0 gs # (_, gs) = playSoundSample instr vol pan (getnotefreq 130) 3 gs # (_, gs) = playSoundSample instr vol pan (getnotefreq 134) 3 gs = gs killobject {st, or, gs} = {st = st, or = {or & active = False}, gs = gs} AddLife gs # (pan, gs) = RandomPan gs # vol = HighVolume # ins = SND_FLUTE # gs = PlaySong ins vol pan 100 0 [(-4,5),(0,5),(3,5),(8,5),(12,5),(15,5),(20,5)] gs = inclives gs Beep gs # (_, gs) = playSoundSample SND_PPN DefaultVolume PAN_CENTER (getnotefreq 69) 0 gs = gs PlaySong instr vol pan base delay [] gs = gs PlaySong instr vol pan base delay [(note,duration):ls] gs # (_, gs) = playSoundSample instr vol pan (getnotefreq (base + note)) delay gs = PlaySong instr vol pan base (delay + duration) ls gs /* ---------- textitems objects ---------- */ ST_X :== 10 ST_COLON :== 11 ST_PPN :== 12 ST_TIME :== 13 :: StatState = { skyr :: !Int , skyg :: !Int , skyb :: !Int , addr :: !Int , addg :: !Int , addb :: !Int } StatHeartObject # obj = defaultGameObject OBJ_STAT size state # obj = { obj & sprites = [StatusSprite1, StatusSprite2, StatusSprite3, StatusSprite4, StatusSprite5, StatusSprite6] , init = (newinit size state) , userevent = newuserevent } = obj where size = {w = 12, h = 12} state = { skyr = 0 , skyg = 0 , skyb = 0 , addr = 2 , addg = 2 , addb = 2 } newinit size state subcode pos time gs # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & options = {objrec.options & static = True} , layer = AtLayer LYR_STATUS , currentsprite = if (subcode >= ST_X) (subcode - 7) 2 , ownbounds = BND_STAT } # (lev, gs) = getlevel gs # rgb = BackGroundColor lev # state = {state & skyr = (fromRGB rgb).r , skyg = (fromRGB rgb).g , skyb = (fromRGB rgb).b } = {st=state, or=objrec, gs=gs} where fromRGB (RGB rgb) = rgb newuserevent ev evpar1 evpar2 {st, or, gs} | (ev == EV_POS) && (or.subcode == ST_COLON) && (or.pos.x < 160) # or = {or & pos.x = or.pos.x + evpar1} = {st=st, or=or, gs=gs} | (ev == EV_TIMER) && (or.subcode == ST_TIME) # (_, gs) = createUserGameEvent EV_TIMER 0 0 (BoundType BND_STAT) ST_TIME (FPS) gs # (st, gs) = tick st gs = {st=st, or=or, gs=gs} | (ev == EV_HEALTH) && (or.subcode < 10) # or = {or & currentsprite = if (evpar1 < or.subcode) 1 2} = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} /* ---------- ending of the level ---------- */ EndingObject # obj = defaultGameObject OBJ_ENDING size Void # obj = { obj & sprites = [] , init = (newinit size Void) , collide = newcollide , userevent = newuserevent } = obj where size = {w = 6 * 20, h = 40} newinit size state subcode pos time gs # pos = {pos & y = pos.y + 20} # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & layer = AtLayer LYR_FOREGROUND , ownbounds = BND_ENDING , collidebounds = 0 , currentsprite = 0 , forgetdistance = {x = 12, y = 12} } = {st=state, or=objrec, gs=gs} newcollide bnds othertype otherobjrec {st, or, gs} = {st=st, or = {or & collidebounds = 0}, gs=gs} newuserevent ev evpar1 evpar2 {st, or, gs} | ev == EV_ALL_DONE = {st=st, or = {or & collidebounds = BND_MAIN_CHARACTER}, gs=gs} = {st=st, or=or, gs=gs} /* ---------- car ---------- */ :: CarState = { sound :: Int , count :: Int } CarObject # obj = defaultGameObject OBJ_CAR size state # obj = { obj & sprites = [CarSprite1] , init = (newinit size state) , move = newmove } = obj where state = { sound = 0, count = 0 } size = {w = 80 - 8, h = 50 - 20} newinit size state subcode pos time gs # pos = {pos & y = pos.y - size.h + BLOCK_SIZE.h} # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & layer = AtLayer LYR_FOREGROUND , ownbounds = BND_HURT , collidebounds = 0 , options.removemapcode = True , speed = {rx = -4.0, ry = 0.0} , skipmove = 0 , subcode = fromDirectionSet {left = True, right = True, top = True, bottom = True} , offset = {x = -5, y = -20} } # (_, gs) = playSoundSample SND_FLUTE2 HighVolume PAN_RIGHT 56000 0 gs # (_, gs) = playSoundSample SND_FLUTE2 HighVolume PAN_RIGHT 56000 6 gs # (_, gs) = playSoundSample SND_FLUTE2 HighVolume PAN_RIGHT 56000 1 gs # (_, gs) = playSoundSample SND_FLUTE2 HighVolume PAN_RIGHT 56000 7 gs # (_, gs) = playSoundSample SND_FLUTE2 HighVolume PAN_RIGHT 56000 8 gs = {st=state, or=objrec, gs=gs} newmove {st, or, gs} # (freq, gs) = IRRnd 60 gs # st = {st & sound = st.sound + freq + 25, count = st.count + 1} # freq = freq + st.sound # x = ((80 - st.count) - 40) # (rnd, gs) = IRRnd ((abs x) + 10) gs | (abs rnd) < 2 # (_, gs) = playSoundSample SND_PLOF LowVolume (x * PAN_RIGHT / 45) (5500 + freq) 13 gs = {st=st, or=or, gs=gs} | freq > 1000 = {st = {st & sound = 0}, or=or, gs=gs} = {st=st, or=or, gs=gs} /* ---------- flits ---------- */ FlitsObject # obj = defaultGameObject OBJ_FLITS size Void # obj = { obj & sprites = [ItemAnimation3] , 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} /* ---------- flying enemies ---------- */ BirdObject = FlyingObject OBJ_BIRD [ItemSprite6, ItemSprite7] FlyingObject objtype sprlist # obj = defaultGameObject objtype size Void # obj = { obj & sprites = sprlist , init = (newinit size Void) , collide = newcollide , move = newmove } = obj where size = {w = 20, h = 16} newinit size state subcode pos time gs # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & offset = {x = 0, y = -3} , speed = {rx = -0.5, ry = 0.0} , bounce = {fvx = Factor 1.0, fvy = Factor 1.0} , layer = AtLayer (LYR_FOREGROUND + 1) , options = { objrec.options & automirrorleftright = True } , ownbounds = BND_ENEMY , bouncebounds = BND_STATIC_BOUNDS + BND_ENEMY + BND_MAP_CODES , collidebounds = BND_MAIN_CHARACTER , currentsprite = (1 + subcode) , forgetdistance = {x = 6, y = 4} , skipmove = 0 } = {st=state, or=objrec, gs=gs} newcollide bnds othertype otherobjrec {st, or, gs} | ((othertype == OBJ_MAIN_CHAR) && (bnds.bottom)) # (freq, gs) = IRRnd 1000 gs # (_, gs) = playSoundSample SND_BIRD LowVolume PAN_CENTER ((getnotefreq 100) + freq) 0 gs # (_, gs) = playSoundSample SND_FLUTE LowVolume PAN_CENTER (90000 + freq * 2) 1 gs # (_, gs) = playSoundSample SND_FLUTE LowVolume PAN_CENTER (45000 + freq) 0 gs = {st=st, or = kill or, gs=gs} = {st=st, or=or, gs=gs} newmove {st, or, gs} # (turn, gs) = IRnd 30 gs # (xadd, gs) = RRnd 0.05 gs # (yadd, gs) = RRnd 0.085 gs # (skmv, gs) = IRnd 25 gs # rxv = (if (turn == 1) (~or.speed.rx) (or.speed.rx)) + xadd # ryv = or.speed.ry + yadd + 0.005 # or = {or & skipmove = skmv, speed = {rx=rxv, ry=ryv}} = {st=st, or=or, gs=gs} 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} , ownbounds = 0 , bouncebounds = 0 , collidebounds = 0 , forgetdistance = {x = 1, y = 1} , layer = InFront , options.removemapcode = True } /* ---------- tramp / bounce block ---------- */ TrampObject = BounceObject OBJ_TRAMP False 4 (-2) 4 BounceBlockObject = BounceObject OBJ_BOUNCEBLOCK True 1 4 (ITEM_SIZE.h) BounceObject objnr isLamp base rely hght # obj = defaultGameObject objnr size Void # obj = { obj & sprites = [ {(LampSprite 0) & loop = False}, {(LampSprite 1) & loop = False}, LampSprite 2, ItemAnimation4 ] , init = (newinit size Void) , collide = newcollide , animation = newanimation } = obj where size = {w = ITEM_SIZE.w, h = hght} newinit size state subcode pos time gs # pos = {pos & y = pos.y + rely} # (time, gs) = GetTime gs # (bonus, gs) = getbonus gs # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & layer = AtLayer LYR_FOREGROUND , speed = {rx = ~(toReal subcode), ry = 0.0} , bounce = {fvx = Factor 1.0, fvy = Value 0.0} , forgetdistance = {x = 5 + 15 * subcode, y = 5} , ownbounds = BND_BLOCKS , collidebounds = BND_MAIN_CHARACTER , bouncebounds = BND_STATIC_BOUNDS , currentsprite = if (isLamp) (if ((not bonus) && (time < 30)) 3 1) base } = {st=state, or=objrec, gs=gs} newcollide bnds othertype otherobjrec {st, or, gs} | othertype == OBJ_MAIN_CHAR | (bnds.top || bnds.bottom) = {st=st, or = {or & offset.y = (if bnds.top 4 (-4)) , currentsprite = if isLamp 2 base}, gs=gs} = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} newanimation {st, or, gs} | (or.offset.y == 0) = {st=st, or = {or & currentsprite = base}, gs=gs} # or = {or & offset.y = ~(decr or.offset.y)} | not isLamp = {st=st, or=or, gs=gs} # (time, gs) = GetTime gs # (bonus, gs) = getbonus gs | (or.currentsprite == 1) && (time < 30) && (time > 0) && (not bonus) = {st=st, or = {or & currentsprite = 3}, gs=gs} = {st=st, or=or, gs=gs} where decr x | x < 0 = x + 1 | otherwise = x - 1 /* ---------- trail ---------- */ KadoObject n # obj = defaultGameObject (OBJ_KADO1 + n - 1) size Void # obj = { obj & sprites = [KadoSprite n] , init = (newinit size Void) , userevent = newuserevent } = obj where size = ITEM_SIZE newinit size state subcode pos time gs # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & ownbounds = BND_KADO , bouncebounds = 0 , collidebounds = 0 , layer = AtLayer (LYR_KADO - subcode) , forgetdistance = {x = 10, y = 10} } = {st=state, or=objrec, gs=gs} newuserevent ev evpar1 evpar2 {st, or, gs} | ev == (EV_POS + or.subcode) = {st=st, or = {or & pos = {x = evpar1, y = evpar2}}, gs=gs} | ev == EV_KADO_DROPPED | or.subcode == 0 = {st=st, or = {or & active = False}, gs=gs} = {st=st, or = {or & subcode = or.subcode - 1, layer = AtLayer ((getlayer or.layer) + 1)}, gs=gs} = {st=st, or=or, gs=gs} getlayer :: LayerPosition -> Int getlayer InFront = 0 getlayer (AtLayer n) = n /* ---------- main character ---------- */ MC_IDLE :== 1 MC_WALK :== 2 MC_JUMP :== 3 MC_FALL :== 4 MC_FFST :== 5 MC_TURN :== 6 MC_DEAD :== 7 TRAILXMIN :== -20 - 4 TRAILXMAX :== 32 - 4 TRAILTURNSPEED :== 2 :: MainCharState = { action :: !Int , keyLeft :: !Bool , keyRight :: !Bool , lastpos1 :: !Point2 , lastpos2 :: !Point2 , lastspeed1 :: !RealXY , lastspeed2 :: !RealXY , lasthdir :: !HDirection , turning :: !Bool , traildelta :: !Int , trail :: [Int] , lastypos :: !Int , readytodrop :: !Bool , pepernoten :: !Int , letters :: !Int , health :: !Int , enemynote :: !Int , todo :: !Int , extra :: !Int , birdskilled :: !Int } MainCharObject # obj = defaultGameObject OBJ_MAIN_CHAR size newstate # obj = { obj & sprites = [ SintAnimation1 // Idle , SintAnimation2 // Walk , SintAnimation3 // Jump , SintAnimation4 // Fall , SintAnimation5 // FFst , SintAnimation6 // Turn , SintSprite7 // Dead ] , init = (newinit size newstate) , move = newmove , animation = newanimation , keydown = newkeydown , keyup = newkeyup , collide = newcollide , userevent = newuserevent } = obj where size = {w = 24, h = 38} defofs = {x = -4, y = -9} ac = 1.0 / 5.0 defmaxspeed = {rx = 2.0, ry = 6.0} newstate = { action = MC_IDLE , keyLeft = False , keyRight = False , lastpos1 = zero , lastpos2 = zero , lastspeed1 = zero , lastspeed2 = zero , lasthdir = DirLeft , turning = False , traildelta = 0 , trail = [] , lastypos = 0 , readytodrop = True , pepernoten = 0 , letters = 0 , health = 3 , enemynote = 0 , todo = 0 , extra = 0 , birdskilled = 0 } newinit size state subcode pos time gs # pos = {x = pos.x + W / 2, y = pos.y + H - size.h} # (objrec, gs) = defaultObjectRec subcode pos size time gs # objrec = { objrec & offset = defofs , acceleration = {rx = 0.0, ry = 1.0 / 12.0} , bounce = {fvx = Value 0.0, fvy = Factor (1.0 / 16.0)} , maxspeed = defmaxspeed , slowdown = {fvx = Factor (1.0 / 16.0), fvy = Value 0.0} , layer = AtLayer LYR_PLAYER , options = { objrec.options & checkkeyboard = True , allowkeyboardrepeat = False , automirrorleftright = True } , ownbounds = BND_MAIN_CHARACTER , bouncebounds = BND_STATIC_BOUNDS , collidebounds = BND_ENEMY + BND_POWER_UP + BND_BLOCKS + BND_CHIMNEY + BND_ENDING + BND_HURT , forgetdistance = NEVER_FORGET , skipmove = 0 } # (_, gs) = createObjectFocus { scrollleft = 132 , scrollup = 40 , scrollright = 132 , scrolldown = 42 , maxxscrollspeed = 2 , maxyscrollspeed = 3 } gs # (bonus, gs) = getbonus gs # state = { state & todo = if bonus 0 TODO , extra = if bonus (-1) EXTRA_PPN } = {st=state, or=objrec, gs=gs} newmove {st, or, gs} # newy = (st.lastypos + or.pos.y + 1) / 2 # st = {st & traildelta = newdelta st.traildelta or.options.hdirection , lastypos = newy} # trailpos = {x = or.pos.x + st.traildelta, y = newy + or.size.h - ITEM_SIZE.h - 1} # gs = broadcastposition (length st.trail) trailpos.x trailpos.y (st.trail ++ [0]) gs | st.turning | (same st.lasthdir or.options.hdirection) = {st=st, or=or, gs=gs} = {st = {st & turning = False}, or = {or & currentsprite = MC_TURN}, gs=gs} = {st=st, or=or, gs=gs} where broadcastposition :: !Int !Int !Int [Int] !(GSt gs) -> (GSt gs) broadcastposition n x y [] gs = gs broadcastposition n x y [l:ls] gs # (_, gs) = createUserGameEvent (EV_POS + n) x y (BoundType BND_KADO) n (n * 11 + 4) gs = broadcastposition (n - 1) x y ls gs same DirRight DirRight = True same DirLeft DirLeft = True same _ _ = False newdelta x DirLeft | x < TRAILXMAX = x + TRAILTURNSPEED | otherwise = TRAILXMAX newdelta x DirRight | x > TRAILXMIN = x - TRAILTURNSPEED | otherwise = TRAILXMIN newanimation {st, or, gs} # act = st.action # xstuck = ((or.pos.x == st.lastpos1.x) && (or.pos.x == st.lastpos2.x) && ((toInt or.speed.rx) == 0) ) # ystuck = ((or.pos.y == st.lastpos1.y) && (or.pos.y == st.lastpos2.y) && ((toInt or.speed.ry) == 0) ) # oldact = act # act = case act of MC_IDLE -> if (toInt (or.speed.rx / 1.25) == 0) (if (or.speed.ry > sp) MC_FALL MC_IDLE) (if (or.speed.ry > sp) MC_FALL MC_WALK) MC_WALK -> if (toInt (or.speed.rx / 1.25) == 0) (if (or.speed.ry > sp) MC_FALL MC_IDLE) (if (or.speed.ry > sp) MC_FALL MC_WALK) MC_JUMP -> if (or.speed.ry > sp) MC_FALL (if (xstuck && ystuck && (or.speed.ry == st.lastspeed2.ry)) MC_IDLE MC_JUMP) MC_FALL -> if (or.speed.ry > sp) MC_FALL MC_WALK otherwise -> MC_IDLE # st = {st & lastpos2 = st.lastpos1, lastspeed2 = st.lastspeed1} # st = {st & lastpos1 = or.pos, lastspeed1 = or.speed} # newsprite = if (or.speed.ry > 3.0) MC_FFST act # st = {st & action = act} # or = {or & currentsprite = newsprite} | (act == MC_WALK) && (oldact == MC_FALL) # (_, gs) = playSoundSample SND_PLOF LowVolume PAN_CENTER DEFAULT_FREQUENCY 0 gs # st = {st & enemynote = 0} | st.lastspeed2.ry == defmaxspeed.ry = hurt {st=st, or = {or & speed = zero}, gs=gs} = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} where sp = 1.0 / 4.0 newkeydown key {st, or, gs} # action = st.action | key == GK_LEFT # st = {st & keyLeft = True} # newaction = if (action == MC_IDLE) MC_WALK action # st = {st & action = newaction} # or = {or & acceleration.rx = or.acceleration.rx - ac, currentsprite = newaction} | (newaction == MC_WALK) && (or.speed.rx > 0.0) = {st = {st & turning = True, lasthdir = DirRight}, or=or, gs=gs} = {st=st, or=or, gs=gs} | key == GK_RIGHT # st = {st & keyRight = True} # newaction = if (action == MC_IDLE) MC_WALK action # st = {st & action = newaction} # or = {or & acceleration.rx = or.acceleration.rx + ac, currentsprite = newaction} | (newaction == MC_WALK) && (or.speed.rx < 0.0) = {st = {st & turning = True, lasthdir = DirLeft}, or=or, gs=gs} = {st=st, or=or, gs=gs} | key == GK_SPACE | (isMember action [MC_IDLE, MC_WALK, MC_TURN]) # (_, gs) = playSoundSample SND_JUMP DefaultVolume PAN_CENTER DEFAULT_FREQUENCY 0 gs // *** play sound # st = {st & action = MC_JUMP} # or = {or & speed = jumpspeed or.speed , currentsprite = MC_JUMP , maxspeed = defmaxspeed } = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} | otherwise = {st=st, or=or, gs=gs} where jumpspeed sp=:{rx, ry} = {rx = rx, ry = ry - 3.25 - (abs rx) / 3.0} newkeyup key {st, or, gs} | (key == GK_LEFT) && (st.keyLeft) # st = {st & keyLeft = False} = {st=st, or = {or & acceleration.rx = or.acceleration.rx + ac}, gs=gs} | (key == GK_RIGHT) && (st.keyRight) # st = {st & keyRight = False} = {st=st, or = {or & acceleration.rx = or.acceleration.rx - ac}, gs=gs} | (key == GK_SPACE) && (st.action == MC_JUMP) && (or.speed.ry < (-0.5)) = {st=st, or = {or & speed = {or.speed & ry = or.speed.ry * 3.0 / 4.0}}, gs=gs} | otherwise = {st=st, or=or, gs=gs} newcollide bnds othertype otherobjrec {st, or, gs} | (isMember othertype ChimneyList) && (or.speed.ry >= 0.0) && (or.pos.y + or.size.h <= otherobjrec.pos.y + otherobjrec.size.h / 2 + 4) && (st.readytodrop) # chimneytype = othertype - OBJ_CHIMNEY1 + 1 # first = st.trail ++ [(-1)] | (first!!0 == chimneytype) # instr = SND_FLUTE # vol = HighVolume # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 100) 0 gs # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 101) 8 gs # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 100) 16 gs # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 96) 0 gs # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 98) 8 gs # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 96) 16 gs # (_, gs) = createUserGameEvent EV_READY 0 0 Self ANY_SUBTYPE (32) gs # (_, gs) = createUserGameEvent EV_KADO_DROPPED chimneytype 0 (BoundType (BND_KADO + BND_CHIMNEY)) ANY_SUBTYPE 0 gs # st = {st & trail = drop 1 st.trail, readytodrop = False} = checkalldone {st=st, or=or, gs=gs} | (not (isMember otherobjrec.currentsprite [1, 7])) && (st.pepernoten > 0) # instr = SND_FLUTE # vol = HighVolume # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 112) 0 gs # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 113) 8 gs # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 112) 16 gs # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 108) 0 gs # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 110) 8 gs # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 108) 16 gs # (_, gs) = createUserGameEvent EV_READY 0 0 Self ANY_SUBTYPE (32) gs # (_, gs) = createUserGameEvent EV_PEPERNOOT chimneytype 0 (BoundType BND_CHIMNEY) ANY_SUBTYPE 0 gs # st = {st & pepernoten = st.pepernoten - 1, readytodrop = False} # gs = setppn st.pepernoten gs = checkalldone {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} | othertype == OBJ_LETTER # st = {st & letters = st.letters + 1} | st.letters == 4 # (_, gs) = createUserGameEvent EV_HEALTH 3 0 (BoundType BND_STAT) ANY_SUBTYPE 1 gs = {st = {st & health = 3}, or = or, gs = AddLife gs} = {st=st, or=or, gs=gs} | othertype == OBJ_BOUNCEBLOCK | bnds.top # (_, gs) = playSoundSample SND_WJUMP DefaultVolume PAN_CENTER 40000 0 gs = {st = {st & action = MC_JUMP}, or = {or & speed.ry = ~(abs or.speed.ry) * 2.0 - 4.25, currentsprite = MC_JUMP}, gs=gs} | bnds.bottom # (_, gs) = playSoundSample SND_WJUMP DefaultVolume PAN_CENTER 35000 0 gs = {st = {st & action = MC_FALL}, or = {or & speed.ry = or.speed.ry + 2.5, currentsprite = MC_FALL}, gs = gs} = {st=st, or=or, gs=gs} | othertype == OBJ_TRAMP | bnds.top # (_, gs) = playSoundSample SND_WJUMP DefaultVolume PAN_CENTER 70000 0 gs = {st = {st & action = MC_JUMP}, or = {or & speed.ry = ~(abs or.speed.ry) * 1.5 - 2.0, currentsprite = MC_JUMP}, gs = gs} = {st=st, or=or, gs=gs} | othertype == OBJ_HEART | not (st.health < 3) = {st=st, or=or, gs=gs} # st = {st & health = st.health + 1} # (_, gs) = createUserGameEvent EV_HEALTH st.health 0 (BoundType BND_STAT) ANY_SUBTYPE 1 gs = {st=st, or=or, gs=gs} | isMember othertype [OBJ_FALLING_PEPERNOOT, OBJ_STATIC_PEPERNOOT] # st = {st & pepernoten = st.pepernoten + 1} = {st=st, or=or, gs = setppn st.pepernoten gs} | isMember othertype KadoList # kadotype = othertype - OBJ_FALLING_KADO1 + 1 # (_, gs) = createNewGameObject (OBJ_KADO1 + kadotype - 1) (length st.trail) {x = or.pos.x + st.traildelta, y = or.pos.y + or.size.h - ITEM_SIZE.h - 1} gs # st = {st & trail = st.trail ++ [kadotype]} = {st=st, or=or, gs=gs} | othertype == OBJ_ENDING | st.todo == 0 # or = {or & acceleration.rx = ac , collidebounds = BND_POWER_UP , options = {or.options & checkkeyboard = False , ignorelevelbounds = True}} # (_, gs) = createUserGameEvent EV_STOP_MOVING 0 0 Self ANY_SUBTYPE 125 gs # (_, gs) = createObjectFocus {zero & scrollright = 160 , maxxscrollspeed = 1} gs # gs = setexitcode EC_SUCCESS gs # (t, gs) = GetTime gs # t = t * 3 # p = st.pepernoten * 10 # (_, gs) = createUserGameEvent EV_COUNT_SCORE 0 0 Self ANY_SUBTYPE 350 gs # (_, gs) = createUserGameEvent EV_PPN_SCORE 0 0 Self ANY_SUBTYPE (500 + t) gs # (_, gs) = createUserGameEvent EV_ADD_BIRD_SCORE 0 0 Self ANY_SUBTYPE (600 + t + p) gs # (_, gs) = createUserGameEvent EV_QUIT_LEVEL EC_SUCCESS 0 Self ANY_SUBTYPE (850 + t + p) gs # gs = dagsint SND_FLUTE 0 gs = {st=st, or=or, gs=gs} = {st=st, or=or, gs = msgnotready gs} | othertype == OBJ_HEART | not (st.health < 3) = {st=st, or=or, gs=gs} # st = {st & health = st.health + 1} # (_, gs) = createUserGameEvent EV_HEALTH st.health 0 (BoundType BND_STAT) ANY_SUBTYPE 1 gs = {st=st, or=or, gs=gs} | (not (otherobjrec.ownbounds bitand BND_HURT == 0)) | or.displayoptions.blink = {st=st, or=or, gs=gs} | (not (otherobjrec.subcode bitand (fromDirectionSet bnds) == 0)) = hurt {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} | bnds.top | (not (otherobjrec.ownbounds bitand BND_ENEMY == 0)) # st = {st & birdskilled = st.birdskilled + 1} # gs = addscore (-500) gs # (_, gs) = playSoundSample SND_HIT HighVolume PAN_CENTER (getnotefreq (MIDDLE_C + 76 + 2 * st.enemynote)) 0 gs # st = {st & enemynote = st.enemynote + 1} # pos = {x = (or.pos.x + otherobjrec.pos.x) / 2, y = or.pos.y + 20} # (_, gs) = createNewGameObject OBJ_FLITS 0 pos gs # st = {st & action = MC_JUMP} # or = {or & speed.ry = -2.5, currentsprite = MC_JUMP} = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} | (not (otherobjrec.ownbounds bitand BND_ENEMY == 0)) = hurt {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} where checkalldone {st, or, gs} # st = {st & todo = st.todo - 1} | st.todo == 0 # (_, gs) = createUserGameEvent EV_ALL_DONE 0 0 (BoundType BND_ENDING) ANY_SUBTYPE 0 gs # gs = dagsint SND_XYLOFOON 25 gs = {st=st, or=or, gs = msgready gs} = {st=st, or=or, gs=gs} dagsint instr delay gs # vol = HighVolume # pan = PAN_CENTER /* Dag Sinterklaasje... */ # gs = PlaySong instr vol pan 106 delay [(7,24),(4,16),(2,8),(0,24),(7,24),(9,24),(5,24),(7,24),(4,24)] gs # gs = PlaySong instr vol pan 106 delay [(4,24),(0,16),(-5,8),(-8,24),(4,24),(5,24),(2,24),(4,24),(0,24)] gs = gs newuserevent ev evpar1 evpar2 {st, or, gs} | ev == EV_STOP_BLINKING = {st=st, or = {or & displayoptions.blink = False}, gs=gs} | ev == EV_READY = {st = {st & readytodrop = True}, or=or, gs=gs} | ev == EV_QUIT_LEVEL # gs = setexitcode evpar1 gs # gs = quitlevel gs = {st=st, or=or, gs=gs} | ev == EV_GAME_OVER = {st = st, or = or, gs = setgameover gs} | ev == EV_TIME_UP # st = {st & health = 0} = hurt {st=st, or = {or & displayoptions = {or.displayoptions & blink = False}}, gs = gs} | ev == EV_STOP_MOVING = {st=st, or = {or & speed = zero, acceleration = zero}, gs=gs} | ev == EV_ADD_BIRD_SCORE | st.birdskilled == 0 # (_, gs) = playSoundSample SND_PPN DefaultVolume PAN_CENTER (getnotefreq 80) 0 gs # (_, gs) = playSoundSample SND_PPN DefaultVolume PAN_CENTER (getnotefreq 99) 1 gs = {st=st, or=or, gs = addscore 10000 gs} = {st=st, or=or, gs=gs} | ev == EV_COUNT_SCORE # (t, gs) = GetTime gs | t > 0 # (_, gs) = createUserGameEvent EV_COUNT_SCORE 0 0 Self ANY_SUBTYPE 3 gs # (_, gs) = dectime gs | (or.framecounter rem 1) == 0 # (_, gs) = playSoundSample SND_XYLOFOON DefaultVolume PAN_CENTER (getnotefreq 120) 0 gs = {st=st, or=or, gs = addscore 50 gs} = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} | ev == EV_PPN_SCORE # (bonus, gs) = getbonus gs | st.pepernoten > 0 # (_, gs) = createUserGameEvent EV_PPN_SCORE 0 0 Self ANY_SUBTYPE 10 gs # st = {st & pepernoten = st.pepernoten - 1} # gs = setppn st.pepernoten gs # (_, gs) = playSoundSample SND_FLUTE DefaultVolume PAN_CENTER (getnotefreq 122) 0 gs = {st = {st & extra = st.extra - 1}, or = or, gs = addscore (if bonus 50 250) gs} | st.extra == 0 # (_, gs) = playSoundSample SND_PPN DefaultVolume PAN_CENTER (getnotefreq 80) 10 gs # (_, gs) = playSoundSample SND_PPN DefaultVolume PAN_CENTER (getnotefreq 82) 13 gs # (_, gs) = playSoundSample SND_PPN DefaultVolume PAN_CENTER (getnotefreq 84) 16 gs # (_, gs) = playSoundSample SND_PPN DefaultVolume PAN_CENTER (getnotefreq 85) 19 gs # (_, gs) = playSoundSample SND_PPN DefaultVolume PAN_CENTER (getnotefreq 87) 22 gs = {st = st, or = or, gs = setbonus True gs} = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} hurt {st, or, gs} | or.displayoptions.blink = {st=st, or=or, gs=gs} # (ec, gs) = getexitcode gs | isMember ec [EC_SUCCESS, EC_FAILURE] // player not active anymore? = {st=st, or=or, gs=gs} # st = {st & health = st.health - 1} # (_, gs) = createUserGameEvent EV_HEALTH st.health 0 (BoundType BND_STAT) ANY_SUBTYPE 1 gs # (_, gs) = playSoundSample SND_AU HighVolume PAN_CENTER 52000 0 gs # (_, gs) = playSoundSample SND_AU HighVolume PAN_CENTER 50000 4 gs # (_, gs) = playSoundSample SND_AU HighVolume PAN_CENTER 48000 7 gs # (_, gs) = playSoundSample SND_AU HighVolume PAN_CENTER 42000 9 gs # (_, gs) = playSoundSample SND_AU HighVolume PAN_CENTER 33000 10 gs | st.health == (-1) # st = {st & action = MC_DEAD} # or = {or & currentsprite = MC_DEAD , speed = {rx = 0.0, ry = -2.25} , acceleration = {rx = 0.0, ry = 1.0 / 24.0} , ownbounds = 0 , collidebounds = 0 , bouncebounds = 0 , layer = InFront , options = {or.options & checkkeyboard = False , ignorelevelbounds = True}} # (_, gs) = createUserGameEvent EV_STOP_MOVING 0 0 Self ANY_SUBTYPE 500 gs # (_, gs) = createObjectFocus zero gs # (bonus, gs) = getbonus gs # resultcode = if bonus EC_SUCCESS EC_FAILURE // can't die in a bonus level # gs = setexitcode resultcode gs # (_, gs) = createUserGameEvent EV_QUIT_LEVEL resultcode 0 Self ANY_SUBTYPE 600 gs # (rnd, gs) = IRRnd 3 gs # (_, gs) = playSoundSample SND_WATER LowVolume PAN_CENTER (getnotefreq (102 + rnd)) 250 gs # (l, gs) = getlives gs | l == 0 # (_, gs) = createUserGameEvent EV_GAME_OVER 0 0 Self ANY_SUBTYPE 350 gs = {st=st, or=or, gs=gs} = {st=st, or=or, gs=gs} # (_, gs) = createUserGameEvent EV_STOP_BLINKING 0 0 Self ANY_SUBTYPE 225 gs # or = {or & displayoptions.blink = True} = {st=st, or=or, gs=gs} /* ---------- useful functions for objects ---------- */ /* quit the level */ quitlevel gs = appGSt setQuit gs where setQuit :: GameState -> GameState setQuit gst = {gst & quit = True} /* set exit code for the level */ setexitcode newcode gs = appGSt (setgstexitcode newcode) gs where setgstexitcode :: Int GameState -> GameState setgstexitcode c gst = {gst & exitcode = c} /* get exitcode */ getexitcode gs = accGSt getgstexitcode gs where getgstexitcode :: GameState -> *(Int, GameState) getgstexitcode gst = (gst.exitcode, gst) /* bonus functions */ setbonus b gs = appGSt (setgstbonus b) gs setgstbonus :: Bool GameState -> GameState setgstbonus b gst = {gst & bonus = b} /* get bonus */ getbonus gs = accGSt getgstbonus gs where getgstbonus :: GameState -> *(Bool, GameState) getgstbonus gst = (gst.bonus, gst) /* increment the number of lives */ inclives gs = appGSt incgstlives gs where incgstlives :: GameState -> GameState incgstlives gst = {gst & lives = gst.lives + 1} /* get number of lives */ getlives gs = accGSt getgstlives gs where getgstlives :: GameState -> *(Int, GameState) getgstlives gst = (gst.lives, gst) /* get number of lives */ GetTime gs = accGSt getgsttime gs where getgsttime :: GameState -> *(Int, GameState) getgsttime gst = (gst.time, gst) /* get current level number */ getlevel gs = accGSt getgstlevel gs where getgstlevel :: GameState -> *(Int, GameState) getgstlevel gst = (gst.curlevel, gst) /* set background color */ SetBackGroundColor rgb gs = accGStTb (OSGameLevelOptions True rgb ESC_QUIT False FADE FADE) gs /* time tick */ tick st gs # (ec, gs) = getexitcode gs | isMember ec [EC_SUCCESS, EC_FAILURE] // player not active anymore? = (st, gs) # (time, gs) = dectime gs # (bonus, gs) = getbonus gs | bonus | time == 0 # (_, gs) = createUserGameEvent EV_TIME_UP 0 0 (BoundType BND_MAIN_CHARACTER) ANY_SUBTYPE 0 gs # (_, gs) = dectime gs = (st, gs) = (st, gs) | time == 60 // de ochtend breekt aan... # (rnd, gs) = IRRnd 4 gs # (_, gs) = playSoundSample SND_COCK HighVolume PAN_CENTER (getnotefreq (90 + rnd)) (25 + rnd) gs = (st, msgmorning gs) | time > 60 = (st, gs) # light = 60 - time # (_, gs) = SetBackGroundColor (RGB {r = crgb (st.skyr + light * st.addr), g = crgb (st.skyg + light * st.addg), b = crgb (st.skyb + light * st.addb)}) gs | time == 4 # (_, gs) = playSoundSample SND_GRIEG HighVolume PAN_CENTER DEFAULT_FREQUENCY 0 gs = (st, gs) | time == 2 # (_, gs) = createNewGameObject OBJ_SUN 0 {x = 144, y = 112} gs = (st, gs) | time == 0 # (_, gs) = createUserGameEvent EV_TIME_UP 0 0 (BoundType BND_MAIN_CHARACTER) ANY_SUBTYPE 0 gs # (_, gs) = dectime gs = (st, gs) = (st, gs) dectime gs # (time, gs) = accGSt (decgsttime 1) gs | time == 99 // shift position of ":" # (_, gs) = createUserGameEvent EV_POS 2 0 (BoundType BND_STAT) ST_COLON 0 gs = (time, gs) | time == 9 # (_, gs) = createUserGameEvent EV_POS 1 0 (BoundType BND_STAT) ST_COLON 0 gs = (time, gs) = (time, gs) where decgsttime :: Int GameState -> *(Int, GameState) decgsttime n gst # gst = {gst & time = gst.time - n} = (gst.time, gst) setppn n gs = appGSt (setgstppn n) gs where setgstppn :: Int GameState -> GameState setgstppn n gst = {gst & ppn = n} getppn gs = accGSt getgstppn gs where getgstppn :: GameState -> *(Int, GameState) getgstppn gst = (gst.ppn, gst) setplayer s gs = appGSt (setgstplayer s) gs where setgstplayer :: String GameState -> GameState setgstplayer s gst = {gst & player = s} getplayer gs = accGSt getgstplayer gs where getgstplayer :: GameState -> *(String, GameState) getgstplayer gst = (gst.player, gst) /* add a value to the score */ addscore points gs = appGSt (addgstscore points) gs where addgstscore :: Int GameState -> GameState addgstscore points gst | gst.score + points < 0 = {gst & score = 0} = {gst & score = gst.score + points} /* gameover functions */ setgameover gs = appGSt setgstgameover gs setgstgameover :: GameState -> GameState setgstgameover gst = {gst & gameover = True} /* start messages */ msgmorning gs = appGSt gstmsgmorning gs gstmsgmorning :: GameState -> GameState gstmsgmorning gst = {gst & morningmsg = START_MSG} msgbonus gs = appGSt gstmsgbonus gs gstmsgbonus :: GameState -> GameState gstmsgbonus gst = {gst & bonusmsg = START_MSG} msgready gs = appGSt gstmsgready gs gstmsgready :: GameState -> GameState gstmsgready gst = {gst & readymsg = START_MSG} msgnotready gs = appGSt gstmsgnotready gs gstmsgnotready :: GameState -> GameState gstmsgnotready gst | gst.notreadymsg == STOP_MSG = {gst & notreadymsg = START_MSG} = gst /* clip RGB */ crgb :: Int -> Int crgb n | n < 0 = 0 | n > 255 = 255 | otherwise = n /* ---------- definitions of the levels ---------- */ /* ---------- Title screen ---------- */ TitleScreen = { blankScreen & layers = [TitleLayer] , objects = [GameObjectLS AutoMenuObject] , soundsamples = MenuSoundSampleList , leveloptions.escquit = False , leveloptions.fillbackground = Nothing , music = Just TitleMusic } TitleMusic = { musicfile = "music\\sint1.mid" , restart = True , continue = False } TitleLayer = { bmp = TitleBitmap , layermap = [{1}] , sequences = [] , movement = defaultMovement } TitleBitmap = { bitmapname = "bitmaps\\TITEL.BMP" , unitsize = {w = 320, h = 200} , dimensions = (1, 1) , transparent = Nothing } /* ---------- Menu object ---------- */ MAX_INPUT_LEN :== 21 :: MenuState = { selected :: Int /* menu options: min ... max */ , min :: Int , max :: Int , typing :: Bool , story :: Bool , quitting :: Bool , naam :: String , phis :: Bool } AutoMenuObject # obj = defaultGameObject OBJ_AUTOINIT size newstate # obj = { obj & sprites = [Menu1Sprite, Menu2Sprite, Menu3Sprite, Info1Sprite, Info2Sprite, Info3Sprite, Story0Sprite, Story1Sprite, Story2Sprite, Story3Sprite, StoryVSprite, StorySprite] , init = (newinit size newstate) , keydown = newkeydown } = obj where size = { w = 120, h = 100 } newstate = {selected = 1, min = 1, max = 3, story = False, typing = False, quitting = False, naam = "", phis = False} newinit size state subcode pos time gs # (objrec, gs) = defaultObjectRec subcode pos size time gs # (t, gs) = GetTime gs # objrec = {objrec & pos = {x = 100, y = 50} , offset = if (t == FIRST_TIME) bigofs zero , options = {objrec.options & static = True , checkkeyboard = True } } | (t == FIRST_TIME) # gs = selectsound gs # state = {state & story = True, typing = True} # objrec = {objrec & currentsprite = 11} = {st=state, or=objrec, gs=gs} | (t == SHOW_PERS_HIS) # gs = selectsound gs # state = {state & story = True, phis = True} # objrec = {objrec & currentsprite = 12, offset = bigofs} = {st=state, or=objrec, gs=gs} = {st=state, or=objrec, gs=gs} newkeydown k {st, or, gs} | st.story | st.typing && (not (k == GK_RETURN)) # namelist = [c \\ c <-: st.naam] | (k == 8) && (length namelist > 0) /* backspace */ # st = {st & naam = {s \\ s <- (init namelist)}} = {st=st, or=or, gs = setplayer st.naam gs} | (k >= (toInt ' ')) && (k <= (toInt 'Z')) && (length namelist < MAX_INPUT_LEN) # st = {st & naam = st.naam +++ (toString (toChar k))} = {st=st, or=or, gs = setplayer st.naam gs} = {st=st, or=or, gs=gs} # (_, gs) = playSoundSample SND_FLUTE DefaultVolume PAN_CENTER (getnotefreq 103) 0 gs | st.typing && (k == GK_RETURN) | st.naam == "" = {st=st, or=or, gs=gs} # gs = selectsound gs # (_, gs) = dectime gs # st = {st & typing = False} = {st=st, or=or, gs=gs} | st.quitting # or = {or & currentsprite = 0, offset = zero} = {st=st, or=or, gs = quitlevel gs} # (_, gs) = dectime gs | st.phis # st = {st & phis = False} = {st=st, or=or, gs=gs} # (_, gs) = dectime gs # st = {st & story = False} # or = {or & currentsprite = st.selected, offset = zero} = {st=st, or=or, gs=gs} | k == GK_DOWN # (_, gs) = playSoundSample SND_XYLOFOON LowVolume PAN_CENTER (getnotefreq 112) 0 gs | st.selected >= st.max # st = {st & selected = st.min} # or = {or & currentsprite = st.min} = {st=st, or=or, gs=gs} # st = {st & selected = st.selected + 1} # or = {or & currentsprite = st.selected} = {st=st, or=or, gs=gs} | k == GK_UP # (_, gs) = playSoundSample SND_XYLOFOON VeryLowVolume PAN_CENTER (getnotefreq 112) 0 gs | st.selected <= st.min # st = {st & selected = st.max} # or = {or & currentsprite = st.max} = {st=st, or=or, gs=gs} # st = {st & selected = st.selected - 1} # or = {or & currentsprite = st.selected} = {st=st, or=or, gs=gs} | (k == GK_SPACE) || (k == GK_RETURN) # gs = selectsound gs | st.selected == 1 // Start # gs = setexitcode EC_SUCCESS gs = {st=st, or=or, gs=quitlevel gs} | st.selected == 2 // Informatie = {st = {st & selected = 4, min = 4, max = 6}, or = {or & currentsprite = 4}, gs=gs} # st = {st & story = True} # or = {or & offset = bigofs} | st.selected == 3 // Einde # gs = setexitcode EC_QUIT gs | CARDWARE == True = {st = {st & quitting = True}, or = {or & currentsprite = 7}, gs = gs} = {st = {st & quitting = False}, or = {or & currentsprite = 0}, gs = quitlevel gs} | st.selected == 4 // Dit spel... = {st=st, or = {or & currentsprite = 8}, gs=gs} | st.selected == 5 // KUN Informatica = {st=st, or = {or & currentsprite = 9}, gs=gs} | st.selected == 6 // Clean = {st=st, or = {or & currentsprite = 10}, gs=gs} # or = {or & offset = zero} # st = {st & story = False} = {st=st, or=or, gs = quitlevel gs} | (k == GK_ESCAPE) # (_, gs) = playSoundSample SND_FLUTE DefaultVolume PAN_CENTER (getnotefreq 103) 0 gs | isMember st.selected [4,5,6] # st = {st & selected = 2, min = 1, max = 3} # or = {or & currentsprite = 2} = {st=st, or=or, gs=gs} # st = {st & story = True} # or = {or & offset = bigofs} # gs = setexitcode EC_QUIT gs | CARDWARE == True = {st = {st & quitting = True}, or = {or & currentsprite = 7}, gs = gs} = {st = {st & quitting = False}, or = {or & currentsprite = 0}, gs = quitlevel gs} = {st=st, or=or, gs=gs} selectsound gs # (_, gs) = playSoundSample SND_FLUTE DefaultVolume PAN_CENTER (getnotefreq 112) 0 gs # (_, gs) = playSoundSample SND_FLUTE DefaultVolume PAN_CENTER (getnotefreq 115) 1 gs # (_, gs) = playSoundSample SND_FLUTE DefaultVolume PAN_CENTER (getnotefreq 120) 2 gs = gs bigofs = {x = -84, y = 6} Menu1Sprite = { bitmap = Menu1Bitmap, sequence = [(1, 10000)], loop = True } Menu2Sprite = { bitmap = Menu2Bitmap, sequence = [(1, 10000)], loop = True } Menu3Sprite = { bitmap = Menu3Bitmap, sequence = [(1, 10000)], loop = True } Menu1Bitmap = { bitmapname = "bitmaps\\MENU1.BMP", unitsize = {w = 120, h = 100}, dimensions = (1, 1), transparent = Nothing } Menu2Bitmap = { bitmapname = "bitmaps\\MENU2.BMP", unitsize = {w = 120, h = 100}, dimensions = (1, 1), transparent = Nothing } Menu3Bitmap = { bitmapname = "bitmaps\\MENU3.BMP", unitsize = {w = 120, h = 100}, dimensions = (1, 1), transparent = Nothing } Info1Sprite = { bitmap = Info1Bitmap, sequence = [(1, 10000)], loop = True } Info2Sprite = { bitmap = Info2Bitmap, sequence = [(1, 10000)], loop = True } Info3Sprite = { bitmap = Info3Bitmap, sequence = [(1, 10000)], loop = True } Info1Bitmap = { bitmapname = "bitmaps\\INFO1.BMP", unitsize = {w = 120, h = 100}, dimensions = (1, 1), transparent = Nothing } Info2Bitmap = { bitmapname = "bitmaps\\INFO2.BMP", unitsize = {w = 120, h = 100}, dimensions = (1, 1), transparent = Nothing } Info3Bitmap = { bitmapname = "bitmaps\\INFO3.BMP", unitsize = {w = 120, h = 100}, dimensions = (1, 1), transparent = Nothing } StoryVSprite = { bitmap = StoryVBitmap, sequence = [(1, 10000)], loop = True } Story0Sprite = { bitmap = Story0Bitmap, sequence = [(1, 10000)], loop = True } Story1Sprite = { bitmap = Story1Bitmap, sequence = [(1, 10000)], loop = True } Story2Sprite = { bitmap = Story2Bitmap, sequence = [(1, 10000)], loop = True } Story3Sprite = { bitmap = Story3Bitmap, sequence = [(1, 10000)], loop = True } StoryVBitmap = { bitmapname = "bitmaps\\STORYV.BMP", unitsize = {w = 286, h = 130}, dimensions = (1, 1), transparent = Nothing } Story0Bitmap = { bitmapname = "bitmaps\\STORY0.BMP", unitsize = {w = 286, h = 130}, dimensions = (1, 1), transparent = Nothing } Story1Bitmap = { bitmapname = "bitmaps\\STORY1.BMP", unitsize = {w = 286, h = 130}, dimensions = (1, 1), transparent = Nothing } Story2Bitmap = { bitmapname = "bitmaps\\STORY2.BMP", unitsize = {w = 286, h = 130}, dimensions = (1, 1), transparent = Nothing } Story3Bitmap = { bitmapname = "bitmaps\\STORY3.BMP", unitsize = {w = 286, h = 130}, dimensions = (1, 1), transparent = Nothing } StorySprite = { bitmap = StoryBitmap, sequence = [(1, 10000)], loop = True } StoryBitmap = { bitmapname = "bitmaps\\STORY.BMP", unitsize = {w = 286, h = 130}, dimensions = (1, 1), transparent = Nothing } /* ---------- Level1 ---------- */ Level1 = { boundmap = L1LevelBoundMap , initpos = { x = 0, y = 23 * 20 } , layers = [ L1_40x24Sky1Layer , L1BackGrLayer , L1LevelLayer , DummyLayer, DummyLayer, DummyLayer, DummyLayer , DummyLayer, DummyLayer, DummyLayer , { L1_32x32BoatsLayer & movement = WaveMovement } ] , objects = GameObjectList ++ Level1FrontObj , music = Nothing , soundsamples = GameSoundSampleList , leveloptions = { fillbackground = Just (BackGroundColor (1 * 2)) , escquit = ESC_QUIT , debugscroll = False , fadein = FADE , fadeout = FADE } } WaveMovement = \p t -> {x = p.x * 5 / 4, y = p.y * 4 / 3 + (wave t)} where wave :: Int -> Int wave t = case (t / 20) rem 4 of 0 -> 0 1 -> -1 2 -> 0 3 -> 1 DummyLayer = { bmp = DummyBitmap , layermap = [{0}] , sequences = [] , movement = \p t -> zero } DummyBitmap = { bitmapname = "bitmaps\\DUMMY.BMP" , unitsize = {w = 320, h = 200} , dimensions = (1, 1) , transparent = Just {x = 0, y = 0} } /* ---------- Level1b ---------- */ Level1b = { boundmap = L1BonusBoundMap , initpos = { x = 0, y = 23 * 20 } , layers = [ L1_40x24BonusSkyLayer , L1BonusBackGrLayer , L1BonusLayer ] , objects = GameObjectList ++ Level1FrontObj , music = Nothing , soundsamples = GameSoundSampleList , leveloptions = { fillbackground = Just (BackGroundColor (1 * 2 + 1)) , escquit = ESC_QUIT , debugscroll = False , fadein = FADE , fadeout = FADE } } /* ---------- Level2 ---------- */ Level2 = { boundmap = L2LevelBoundMap , initpos = { x = 0, y = 50 * 20 } , layers = [ L2_40x24Sky2Layer , L2BackGrLayer , L2LevelLayer ] , objects = GameObjectList ++ Level1FrontObj , music = Nothing , soundsamples = GameSoundSampleList , leveloptions = { fillbackground = Just (BackGroundColor (2 * 2)) , escquit = ESC_QUIT , debugscroll = False , fadein = FADE , fadeout = FADE } } /* ---------- Level2b ---------- */ Level2b = { boundmap = L2BonusBoundMap , initpos = { x = 10 * 20, y = 8 * 20 } , layers = [ L2_40x24Sky2Layer , L2BackGrLayer , L2BonusLayer ] , objects = GameObjectList ++ Level1FrontObj , music = Nothing , soundsamples = GameSoundSampleList , leveloptions = { fillbackground = Just (BackGroundColor (2 * 2 + 1)) , escquit = ESC_QUIT , debugscroll = False , fadein = FADE , fadeout = FADE } } /* ---------------------------- */ BackGroundColor level = case level of 2 -> RGB {r= 30, g= 60, b=116} 3 -> RGB {r= 60, g= 92, b=100} 4 -> RGB {r=164, g= 32, b= 24} 5 -> RGB {r=172, g= 40, b= 36} otherwise -> RGB {r= 0, g= 0, b= 0} /* ---------- sounds ---------- */ HighVolume = (9 * MAX_VOLUME / 10) DefaultVolume = (8 * MAX_VOLUME / 9) LowVolume = (7 * MAX_VOLUME / 8) VeryLowVolume = (5 * MAX_VOLUME / 6) RandomPan gs = IRRnd (PAN_RIGHT * 2 / 3) gs SND_JUMP :== 1 SND_PPN :== 2 SND_PLOF :== 3 SND_FLUTE :== 4 SND_FLUTE2 :== 5 SND_XYLOFOON :== 6 SND_CLARINET :== 7 SND_AU :== 8 SND_WJUMP :== 9 SND_HIT :== 10 SND_COCK :== 11 SND_BIRD :== 12 SND_WATER :== 13 SND_GRIEG :== 14 GameSoundSampleList = [ { soundid = SND_JUMP , soundfile = "sounds\\JUMP.WAV" , soundbuffers = 2 } , { soundid = SND_PPN , soundfile = "sounds\\COIN.WAV" , soundbuffers = 15 } , { soundid = SND_PLOF , soundfile = "sounds\\PLOF.WAV" , soundbuffers = 6 } , { soundid = SND_FLUTE , soundfile = "sounds\\FLUTE.WAV" , soundbuffers = 15 } , { soundid = SND_FLUTE2 , soundfile = "sounds\\FLUTE2.WAV" , soundbuffers = 12 } , { soundid = SND_XYLOFOON , soundfile = "sounds\\XYLOFOON.WAV" , soundbuffers = 10 } , { soundid = SND_CLARINET , soundfile = "sounds\\CLARINET.WAV" , soundbuffers = 10 } , { soundid = SND_AU , soundfile = "sounds\\AU.WAV" , soundbuffers = 5 } , { soundid = SND_WJUMP , soundfile = "sounds\\WJUMP.WAV" , soundbuffers = 2 } , { soundid = SND_HIT , soundfile = "sounds\\HIT.WAV" , soundbuffers = 5 } , { soundid = SND_COCK , soundfile = "sounds\\COCK.WAV" , soundbuffers = 1 } , { soundid = SND_BIRD , soundfile = "sounds\\BIRD.WAV" , soundbuffers = 2 } , { soundid = SND_WATER , soundfile = "sounds\\WATER.WAV" , soundbuffers = 1 } , { soundid = SND_GRIEG , soundfile = "sounds\\GRIEG.WAV" , soundbuffers = 1 } ] MenuSoundSampleList = [ { soundid = SND_PLOF , soundfile = "sounds\\PLOF.WAV" , soundbuffers = 6 } , { soundid = SND_FLUTE , soundfile = "sounds\\FLUTE.WAV" , soundbuffers = 15 } , { soundid = SND_FLUTE2 , soundfile = "sounds\\FLUTE2.WAV" , soundbuffers = 12 } , { soundid = SND_XYLOFOON , soundfile = "sounds\\XYLOFOON.WAV" , soundbuffers = 10 } , { soundid = SND_CLARINET , soundfile = "sounds\\CLARINET.WAV" , soundbuffers = 10 } ] /* ---------- random functions ---------- */ /* get random integer value 0..n */ IRnd n gs # (rnd, gs) = rand gs = (rnd rem n, gs) /* get random integer value -n..n */ IRRnd n gs # (rnd1, gs) = rand gs # (rnd2, gs) = rand gs = ((rnd1 rem n) - (rnd2 rem n), gs) /* get random Real value -n..n */ RRnd n gs # (rnd1, gs) = rand gs # (rnd2, gs) = rand gs = (n * (((toReal rnd1) / max) - ((toReal rnd2) / max)), gs) where max = (toReal MAX_RAND) gsrand :: GameState -> *(Int, GameState) gsrand gs=:{randseed} # (x, newrandseed) = random randseed = (x, {gs & randseed=newrandseed}) rand gst = accGSt gsrand gst MAX_RAND = 65535 /* ---------- sprites ---------- */ KadoSprite color = ObjectSprite (BitmapSequence (2 * color - 1) 2 (25 + 2 * color)) ChimneySprite n = ObjectSprite [(25 + n, 1000)] LetterSprite letter = ObjectSprite [(11 + letter, 1000)] // 0="S", 1="I", 2="N", 3="T" LampSprite 0 = ObjectSprite [(23, 650)] // 0 = on LampSprite 1 = ObjectSprite [(24, 1), (23, 0), (24,0)] // 1 = blink LampSprite 2 = ObjectSprite [(24, 650)] // 2 = off ObjectSprite seq = { bitmap = ItemsBitmap , sequence = seq , loop = True } FadeSprite1 n = {bitmap = FadeBitmap, sequence = [(n * 13 + 1, 1000)], loop = True} FadeSprite2 n = {bitmap = FadeBitmap, sequence = BitmapSequence (n * 13 + 1) 13 3, loop = False} L1FrontObjectSprite :: Int -> Sprite L1FrontObjectSprite n = case n of 1 -> InFrontSprite2 2 -> InFrontSprite3 4 -> InFrontSprite4 otherwise -> InFrontSprite1 BitmapSequence :: Int Int Int -> [(Int, Int)] BitmapSequence start count speed | count == 0 = [] | otherwise = [(start, speed)] ++ (BitmapSequence (start + 1) (count - 1) speed) /* ---------- textitems ---------- */ Version :: GameText Version = { format = VERSION , value = Nothing , position = {x = 0, y = -26} , style = { fontname = "Arial" , fontsize = 16 , bold = False , italic = False } , color = RGB {r = 200, g = 230, b = 255} , shadow = Just StatShadow , alignment = {xyfromscreencenter = (True, True), xycentered = (True, True)} } TypeNaam = { Version & format = "Type je naam in en druk op [Enter]:" , position = {x = 0, y = -4} , color = RGB {r = 255, g = 255, b = 220} } Naam :: String -> GameText Naam s = { format = s , value = Nothing , position = {x = -2, y = 19} , style = { fontname = "Courier New" , fontsize = 22 , bold = False , italic = False } , color = RGB {r = 255, g = 255, b = 255} , shadow = Just StatShadow , alignment = {xyfromscreencenter = (True, True), xycentered = (True, True)} } Pers :: Int -> GameText Pers score = { format = if (score == 0) "Nieuwe speler, welkom!" "Persoonlijke top-score: %d punten." , value = if (score == 0) Nothing (Just score) , position = {x = 0, y = 40} , style = { fontname = "Arial" , fontsize = 16 , bold = False , italic = False } , color = RGB {r = 200, g = 230, b = 255} , shadow = Just StatShadow , alignment = {xyfromscreencenter = (True, True), xycentered = (True, True)} } PersHiScores :: [HiS] Int Int String Int -> [GameText] PersHiScores his score phis player rank = [{Version & format = player, position = {x = 0, y = -29}, color = RGB {r = 255, g = 255, b = 220}}, {Version & format = "Behaalde score: %d punten.", value = Just score, position = {x = 0, y = -4}}, {Version & format = (if (rank <= HIS_COUNT) "Gefeliciteerd, nieuwe topscore!" (if (score > phis) "Nieuwe persoonlijk record!" "Persoonlijke topscores:")), position = {x = 0, y = 14}}] ++ (hi his 3) where hi [] n | n < HIS_COUNT = [HiName n "Leeg"] ++ [HiSc n 0] ++ (hi [] (n + 1)) | otherwise = [] hi [x:xs] n | (n >= HIS_COUNT) = [] | (x.name == player) = ([HiName n x.name] ++ [HiSc n x.hiscore] ++ (hi xs (n + 1))) | otherwise = (hi xs n) HIS_COUNT :== 6 HiScores :: [HiS] -> [GameText] HiScores his = [{Version & format = "Topscores:", position = {x = 0, y = -29}}] ++ (hi his 0) where hi [] n | n < HIS_COUNT = [HiName n "Leeg"] ++ [HiSc n 0] ++ (hi [] (n + 1)) | otherwise = [] hi [x:xs] n | n < HIS_COUNT = [HiName n x.name] ++ [HiSc n x.hiscore] ++ (hi xs (n + 1)) | otherwise = [] HiName :: Int String -> GameText HiName n name = { format = name , value = Nothing , position = {x = 160 - 130, y = yheight n} , style = { fontname = "Arial" , fontsize = 16 , bold = False , italic = False } , color = RGB {r = 255 - 13 * n, g = 255 - 11 * n, b = 255 - 8 * n} , shadow = Just StatShadow , alignment = zero } HiSc n score = {(HiName n "%d") & value = Just score, position = {x = -160 + 130, y = yheight n}} yheight n = 113 + (n - 2) * 15 BigStyle :: Style BigStyle = { fontname = "Arial" , fontsize = 41 , bold = True , italic = False } Bonus :: Int -> GameText Bonus x = { format = " BONUS LEVEL, VERZAMEL ALLE PEPERNOTEN... " , value = Nothing , position = {x = x, y = 6} , style = StatStyle , color = White , shadow = Just StatShadow , alignment = zero } Morning :: Int -> GameText Morning x = { format = " DE OCHTEND BREEKT AAN... " , value = Nothing , position = {x = x, y = 6} , style = StatStyle , color = White , shadow = Just StatShadow , alignment = zero } Ready :: Int -> GameText Ready x = { format = " KLAAR, ZOEK DE UITGANG... " , value = Nothing , position = {x = x, y = 6} , style = StatStyle , color = White , shadow = Just StatShadow , alignment = zero } NotReady :: Int -> GameText NotReady x = { format = " ER MOETEN NOG PAKJES OF PEPERNOTEN BEZORGD WORDEN... " , value = Nothing , position = {x = x, y = 6} , style = StatStyle , color = White , shadow = Just StatShadow , alignment = zero } GameOver :: GameText GameOver = { format = "HELAAS..." , value = Nothing , position = {x = 0, y = 0} , style = BigStyle , color = White , shadow = Just StatShadow , alignment = {xyfromscreencenter = (True, True), xycentered = (True, True)} } TimeUp :: GameText TimeUp = { format = "TE LAAT!" // tijd op , value = Nothing , position = {x = 0, y = 0} , style = BigStyle , color = White , shadow = Just StatShadow , alignment = {xyfromscreencenter = (True, True), xycentered = (True, True)} } Lives :: Int -> GameText Lives n = { format = "Sint %2d" , value = Just n , position = {x = 10, y = STS} , style = StatStyle , color = White , shadow = Just StatShadow , alignment = zero } TimeLeft :: Int -> GameText TimeLeft n = { format = "Tijd %3d" , value = Just n , position = {x = 90, y = STS} // 113 , style = StatStyle , color = White , shadow = Just StatShadow , alignment = {zero & xycentered = (True, False)} } PPN :: Int -> GameText PPN n = { format = "%d" , value = Just n , position = {x = 161-4, y = STS} , style = StatStyle , color = White , shadow = Just StatShadow , alignment = {zero & xycentered = (True, False)} } Score :: Int -> GameText Score n = { format = "Score %07d" , value = Just n , position = {x = -10, y = STS} , style = StatStyle , color = White , shadow = Just StatShadow , alignment = zero } StatStyle :: Style StatStyle = { fontname = "Arial" , fontsize = 14 , bold = True , italic = False } StatShadow :: Shadow StatShadow = { shadowpos = {x = 1, y = 1} , shadowcolor = Black }