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 = [ GameObjectLS AutoInitObject
                 , GameObjectLS MainCharObject
                 , GameObjectLS StaticCoinObject
                 , GameObjectLS FallingCoinObject
                 , GameObjectLS StaticDiamondObject
                 , GameObjectLS FallingDiamondObject
                 , GameObjectLS HeartObject
                 , GameObjectLS LifeObject
                 , GameObjectLS CrateObject
                 , GameObjectLS InvisibleCrateObject
                 , GameObjectLS CratePartObject
                 , GameObjectLS EnemyObject
                 , GameObjectLS BeeObject
                 , GameObjectLS FrogObject
                 , GameObjectLS CloudObject
                 , GameObjectLS PalmFrontObject
                 , GameObjectLS WaterObject
                 , GameObjectLS SplashObject
                 , GameObjectLS BounceBlockObject
                 , GameObjectLS FlashObject
                 , GameObjectLS EndingObject
                 , GameObjectLS StatHeartObject
                 , GameObjectLS (BlockInFrontObject OBJ_GROUND1 (InFrontSprite1))
                 , GameObjectLS (BlockInFrontObject OBJ_GROUND2 (InFrontSprite2))
                 , GameObjectLS (BlockInFrontObject OBJ_GROUND3 (InFrontSprite3))
                 , GameObjectLS 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                     = {fvx = Factor 1.0, fvy = Value 0.0}
                   , forgetdistance             = {x = 5 + 15 * subcode, y = 5}
                   , ownbounds                  = BND_STATIC_BOUNDS + BND_BLOCKS
                   , collidebounds              = BND_MAIN_CHARACTER
                   , bouncebounds               = BND_STATIC_BOUNDS
                   }
        = {st=state, or=objrec, gs=gs}

    newcollide bnds othertype otherobjrec objst=:{st=st, or=or, gs=gs}
        | othertype == OBJ_MAIN_CHAR
            | bnds.top || bnds.bottom
                = {objst & or={or & offset.y = if bnds.top 4 (-4)
                                         , currentsprite = 2}}
            = objst
        = objst

    newanimation objst=:{st=st, or=or, gs=gs}
        | or.offset.y == 0
            = {objst & or={or & currentsprite = 1}}
        # or = {or & offset.y = 0-decr or.offset.y}
        = {objst & or=or}
    where
    	decr :: !Int -> Int
        decr x
            | x < 0     = x + 1
            | otherwise = x - 1


/* ---------- water ---------- */

WaterObject
    # obj = defaultGameObject OBJ_WATER size Void
    # obj = { obj
            & sprites = [WaterSprite1]
            , init    = newinit size Void
            }
    = obj
where
    size    = {w = 20, h = 8}

    newinit size state subcode pos time gs
        # (objrec, gs) = defaultObjectRec subcode pos size time gs
        # objrec = { objrec
                   & layer         = AtLayer LYR_INFRONT
                   , ownbounds     = BND_WATER
                   , offset        = {x = 0, y = -11}
                   }
        = {st=state, or=objrec, gs=gs}

Splash :: !Point2 !*(GSt .gs) -> (!GRESULT, !*GSt .gs)
Splash pos gs
    # pos = {pos & y = pos.y - 11}
    # (_, gs) = createNewGameObject OBJ_SPLASH 1 pos gs
    # (_, gs) = createNewGameObject OBJ_SPLASH 2 pos gs
    # (_, gs) = createNewGameObject OBJ_SPLASH 3 pos gs
    = (GR_OK, gs)

/*
    Splash subcode:
       1: left wave
       2: right wave
       3: splash
*/

SplashObject
    # obj = defaultGameObject OBJ_SPLASH size Void
    # obj = { obj
            & sprites   = [WaterAnimation2, WaterAnimation2, WaterAnimation3]
            , init      = newinit size Void
            , 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
                   & layer = AtLayer LYR_INFRONT
                   , currentsprite = subcode
                   , offset = case subcode of
                                1 -> {x = -20, y = -12}
                                2 -> {x =  20, y = -12}
                                3 -> {x =   0, y =  12}
                   , displayoptions.mirrorleftright = subcode == 1
                   }
        = {st=state, or=objrec, gs=gs}


/* ---------- enemies ---------- */

EnemyObject
    # obj = defaultGameObject OBJ_ENEMY size Void
    # obj = { obj
            & sprites = [EnemySprite1, EnemySprite2]
            , init    = newinit size Void
            , collide = newcollide
            }
    = obj
where
    size    = {w = 20, h = 18}

    newinit size state subcode pos time gs
        # (objrec, gs) = defaultObjectRec subcode pos size time gs
        # objrec = { objrec
                   & offset         = {x = -2, y = -2}
                   , speed          = {rx = -0.5, ry = 0.0}
                   , bounce         = {fvx = Factor 1.0, fvy = Value 0.0}
                   , layer          = AtLayer LYR_FOREGROUND
                   , 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}
                   }
        = {st=state, or=objrec, gs=gs}

    newcollide bnds othertype otherobjrec objst=:{st=st, or=or, gs=gs}
        | othertype == OBJ_MAIN_CHAR && bnds.bottom
            = {objst & or=kill or}
        = objst

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
        }


/* ---------- pin ---------- */

PinObject
    # obj = defaultGameObject OBJ_PIN 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_KILL + BND_STATIC_BOUNDS
                   }
        = {st=state, or=objrec, gs=gs}


/* ---------- flying enemies ---------- */

BeeObject = FlyingObject OBJ_BEE [BeeSprite1]

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
                   , 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 objst=:{st=st, or=or, gs=gs}
        | othertype == OBJ_MAIN_CHAR && bnds.bottom
            # (_, gs) = playSoundSample SND_BEE DefaultVolume PAN_CENTER DEFAULT_FREQUENCY 0 gs
            = {objst & gs=gs,or=kill or}
        = objst

    newmove objst=:{st=st, or=or, gs=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}}
        = {objst & or=or,gs=gs}


/* ---------- frog ---------- */

FrogObject
    # obj = defaultGameObject OBJ_FROG size Void
    # obj = { obj
            & sprites    = [FrogAnimation1, FrogAnimation2]
            , init       = newinit size Void
            , collide    = newcollide
            , animation  = newanimation
            }
    = obj
where
    size    = {w = 20, h = 20}

    newinit size state subcode pos time gs
        # (objrec, gs) = defaultObjectRec subcode pos size time gs
        # objrec = { objrec
                   & speed          = {rx = -1.0, ry = 0.0}
                   , acceleration   = {rx = 0.0, ry = 1.0 / 16.0}
                   , bounce         = {fvx = Factor 1.0, fvy = Value 2.0}
                   , layer          = AtLayer LYR_FOREGROUND
                   , options        = { objrec.options
                                      & automirrorleftright = True
                                      }
                   , ownbounds      = BND_ENEMY
                   , bouncebounds   = BND_STATIC_BOUNDS + BND_ENEMY
                   , collidebounds  = BND_MAIN_CHARACTER + BND_WATER
                   , forgetdistance = {x = 8, y = 4}
                   }
        = {st=state, or=objrec, gs=gs}

    newanimation objst=:{st=st, or=or, gs=gs}
        # or = {or & currentsprite = if (or.speed.ry < (-0.5)) 2 1}
        = {objst & or=or}

    newcollide bnds othertype otherobjrec objst=:{st=st, or=or, gs=gs}
        | othertype == OBJ_WATER && bnds.top
            # (_, gs) = Splash {x = or.pos.x, y = or.pos.y + H} gs
            = {objst & gs=gs}
        | othertype == OBJ_MAIN_CHAR && bnds.bottom
            # (_, gs) = playSoundSample SND_FROG HighVolume PAN_CENTER DEFAULT_FREQUENCY 0 gs
            = {objst & or=kill or,gs=gs}
        = objst


/* ---------- ending of the level ---------- */

EndingObject
    # obj = defaultGameObject OBJ_ENDING size Void
    # obj = { obj
            & sprites   = [ EndingSprite1, EndingSprite2, EndingSprite3
                          , EndingSprite4, EndingSprite5, EndingSprite6
                          , EndingSprite7, EndingSprite8]
            , init      = newinit size Void
            , collide   = newcollide
            , move      = newmove
            }
    = obj
where
    size    = {w = 32, h = 26}

    newinit size state subcode pos time gs
        # (objrec, gs) = defaultObjectRec subcode pos size time gs
        # objrec = { objrec
                   & layer           = AtLayer LYR_FOREGROUND
                   , ownbounds       = BND_ENDING
                   , collidebounds   = BND_MAIN_CHARACTER
                   , offset          = {x = 4, y = 7}
                   }
        = {st=state, or=objrec, gs=gs}

    newcollide bnds othertype otherobjrec objst=:{st=st, or=or, gs=gs}
        # instr = SND_FLUTE
        # vol   = HighVolume
        # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 107)  0 gs
        # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 109) 10 gs
        # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 104) 20 gs
        # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 107) 30 gs
        # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 109) 40 gs
        # (_, gs) = playSoundSample instr LowVolume PAN_LEFT  (getnotefreq 104) 49 gs
        # (_, gs) = playSoundSample instr LowVolume PAN_RIGHT (getnotefreq 107) 50 gs
        # (_, gs) = playSoundSample instr vol PAN_CENTER (getnotefreq 112) 51 gs
        = {objst & or={or & skipmove = 0
                                 , framecounter = 0
                                 , collidebounds= 0},
                   gs=gs}

    newmove objst=:{st=st, or=or, gs=gs}
        | or.framecounter > 196
             = {objst & or={or & skipmove = -1, collidebounds = BND_MAIN_CHARACTER}}
        # or = {or & currentsprite = ((or.currentsprite +
                                         (add or.framecounter)) rem 8) + 1
                   , skipmove = or.framecounter / 50}
        = {objst & or=or}
    where
        add :: !Int -> Int
        add x
            | x < 50 = 50 - x
            | otherwise = 0


/* ---------- text items ---------- */

ST_X        :==  10
ST_COLON    :==  11
ST_DIAM     :==  12
ST_COIN     :==  13

StatHeartObject
    # obj = defaultGameObject OBJ_STAT size Void
    # obj = { obj
            & sprites   = [StatusSprite1, StatusSprite2, StatusSprite3,
                           StatusSprite4, StatusSprite5, StatusSprite6]
            , init      = newinit size Void
            , userevent = newuserevent
            }
    = obj
where
    size    = {w = 12, h = 12}

    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
                   }
        = {st=state, or=objrec, gs=gs}

    newuserevent ev evpar1 evpar2 objst=:{st=st, or=or, gs=gs}
        | ev == EV_HEALTH && or.subcode < 10
            # or = {or & currentsprite = if (evpar1 < or.subcode) 1 2}
            = {objst & or=or}
        = objst


/* ---------- autoinit object ---------- */

/* this object is automatically initialized when the level starts */

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_QUIT gs   /* for esc key */
        # (_, gs) = createNewGameObject OBJ_STAT  1       {x = 181, y = STY} gs
        # (_, gs) = createNewGameObject OBJ_STAT  2       {x = 193, y = STY} gs
        # (_, gs) = createNewGameObject OBJ_STAT  3       {x = 205, y = STY} gs
        # (_, gs) = createNewGameObject OBJ_STAT ST_X     {x =  46, y = STY} gs
        # (_, gs) = createNewGameObject OBJ_STAT ST_COLON {x = 257, y = STY} gs
        # (_, gs) = createNewGameObject OBJ_STAT ST_DIAM  {x =  85, y = STY} gs
        # (_, gs) = createNewGameObject OBJ_STAT ST_X     {x =  94, y = STY} gs
        # (_, gs) = createNewGameObject OBJ_STAT ST_COIN  {x = 133, y = STY} gs
        # (_, gs) = createNewGameObject OBJ_STAT ST_X     {x = 142, y = STY} gs

        # (_, gs) = createNewGameObject OBJ_CLOUD 1 pos gs
        # (_, gs) = createNewGameObject OBJ_CLOUD 2 pos gs
        # (_, gs) = createNewGameObject OBJ_CLOUD 3 pos gs

        # (objrec, gs) = defaultObjectRec subcode pos size time gs
        # objrec = {objrec & active = False}
        = {st=state, or=objrec, gs=gs}


/* ---------- main character ---------- */

MC_IDLE  :==  1
MC_WALK  :==  2
MC_JUMP  :==  3
MC_FALL  :==  4
MC_SWIM  :==  5
MC_DEAD  :==  6

:: MainCharState
   = { action     :: !Int
     , lastspeed1 :: !RealXY
     , lastspeed2 :: !RealXY
     , enemynote  :: !Int
     , health     :: !Int
     }

MainCharObject
    # obj = defaultGameObject OBJ_MAIN_CHAR size newstate
    # obj = { obj
            & sprites    = [ CharlieAnimation1, CharlieAnimation2, CharlieAnimation3
                           , CharlieAnimation4, CharlieAnimation5, CharlieSprite6
                           ]
            , init       = newinit size newstate
            , keydown    = newkeydown
            , keyup      = newkeyup
            , animation  = newanimation
            , collide    = newcollide
            , userevent  = newuserevent
            }
    = obj
where
    size     = {w = 20, h = 32}
    newstate = { action = MC_IDLE
               , lastspeed1 = zero
               , lastspeed2 = zero
               , enemynote = 0
               , health = 3
               }

    ac = 1.0 / 5.0
    maxwalkspeed = {rx = 2.0, ry = 6.0}
    maxswimspeed = {maxwalkspeed & rx = 0.5}
    normaloffset = {x = -2, y = -2}

    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         = normaloffset
                   , acceleration   = {rx = 0.0, ry = 1.0 / 8.0}
                   , bounce         = {fvx = Value 0.0, fvy = Factor (1.0 / 16.0)}
                   , maxspeed       = maxwalkspeed
                   , 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_WATER + BND_ENDING +
                                         BND_POWER_UP + BND_BLOCKS + BND_KILL
                   , forgetdistance = {x = 10000, y = 10000}
                   }
        # (_, gs) = createObjectFocus
                         { scrollleft      = 132
                         , scrollup        =  50
                         , scrollright     = 132
                         , scrolldown      =  52
                         , maxxscrollspeed =   2
                         , maxyscrollspeed =   3
                         } gs
        = {st=state,or=objrec,gs=gs}

    newanimation objstate=:{st=st=:{action = act}, or=or=:{offset = ofs}, gs=gs}
        # xstuck = ((or.speed.rx == st.lastspeed1.rx) &&
                    (or.speed.rx == st.lastspeed2.rx) &&
                    ((toInt or.speed.rx) == 0)
                   )
        # ystuck = ((or.speed.ry == st.lastspeed1.ry) &&
                    (or.speed.ry == st.lastspeed2.ry) &&
                    ((toInt or.speed.ry) == 0)
                   )
        # oldact = act
        # (act, ofs) = case act of
            MC_WALK   -> if xstuck
                             ((if (or.speed.ry > sp) MC_FALL MC_IDLE), ofs)
                             ((if (or.speed.ry > sp) MC_FALL MC_WALK), ofs)
            MC_JUMP   -> (if (or.speed.ry > sp) MC_FALL
                              (if (xstuck && ystuck)
                                  MC_IDLE
                                  MC_JUMP), ofs)
            MC_FALL   -> (if (or.speed.ry > sp) MC_FALL MC_WALK, ofs)
            MC_SWIM   -> (MC_SWIM, {ofs & y = if (ofs.y == 4) 3 (ofs.y + 1)})
            otherwise -> (MC_IDLE, ofs)
        # st = {st & lastspeed2 = st.lastspeed1}
        # st = {st & lastspeed1 = or.speed}
        | act == MC_WALK && oldact == MC_FALL
            # (_, gs) = playSoundSample SND_PLOF LowVolume PAN_CENTER DEFAULT_FREQUENCY 0 gs
            # st = {st & enemynote = 0}
            = {objstate & st={st & action = act}, or={or & currentsprite = act, offset = ofs}, gs=gs}
        = {objstate & st={st & action = act}, or={or & currentsprite = act, offset = ofs}, gs=gs}
    where
        sp = 1.0 / 4.0

    newkeydown key objst=:{st=st=:{action}, or=or, gs=gs}
        | key == GK_LEFT
            # newaction = if (action == MC_IDLE) MC_WALK action
            = {objst & st = {st & action = newaction},
                       or   = {or & acceleration.rx = or.acceleration.rx - ac, currentsprite = newaction}
              }
        | key == GK_RIGHT
            # newaction = if (action == MC_IDLE) MC_WALK action
            = {objst & st = {st & action = newaction},
                       or   = {or & acceleration.rx = or.acceleration.rx + ac, currentsprite = newaction}
              }
        | key == GK_SPACE
            | isMember action [MC_IDLE, MC_WALK, MC_SWIM]
                # act = action
                # (_, gs) = playSoundSample SND_JUMP DefaultVolume
                                PAN_CENTER DEFAULT_FREQUENCY 0 gs
                # (st, or) = ({st & action = MC_JUMP},
                              {or & speed = (jumpspeed or.speed)
                                  , currentsprite = MC_JUMP
                                  , offset = normaloffset
                                  , maxspeed = maxwalkspeed
                              })
                | act == MC_SWIM
                    # (_, gs) = playSoundSample SND_WATER_JUMP DefaultVolume
                                     PAN_CENTER DEFAULT_FREQUENCY 0 gs
                    # (_, gs) = Splash {x = or.pos.x, y = or.pos.y + 32} gs
                    = {st=st, or=or, gs=gs}
                = {st=st, or=or, gs=gs}
            = {st=st, or=or, gs=gs}
        | otherwise = {st=st, or=or, gs=gs}
    where
        jumpspeed :: !RealXY -> RealXY
        jumpspeed sp=:{rx, ry} = {rx = rx, ry = ry - 4.35 - abs (rx) / 3.0}
      /*
        setaction :: !Int Int -> Int
        setaction cur new = if ((cur == MC_WALK) ||
                                (cur == MC_IDLE))
                                   new
                                   cur
      */

    newkeyup key objst=:{st=st, or=or, gs=gs}
        | key == GK_LEFT   = {objst & or={or & acceleration.rx = or.acceleration.rx + ac}}
        | key == GK_RIGHT  = {objst & or={or & acceleration.rx = or.acceleration.rx - ac}}
        | otherwise        = objst

    newuserevent ev evpar1 evpar2 objst=:{st=st, or=or, gs=gs}
        | ev == EV_QUIT_LEVEL
            # gs = setexitcode evpar1 gs
            # gs = quitlevel gs
            = {objst & gs=gs}
        | ev == EV_GAME_OVER
            = {objst & gs=setgameover gs}
        | ev == EV_STOP_BLINKING
            = {objst & or={or & displayoptions.blink = False}}
        | ev == EV_STOP_MOVING
            = {objst & or={or & speed = zero, acceleration = zero}}
        = objst

    newcollide bnds othertype otherobjrec objst=:{st=st, or=or, gs=gs}
        | othertype == OBJ_WATER
            | st.action == MC_SWIM
                = objst
            # pos = {x = or.pos.x, y = otherobjrec.pos.y}
            # (_, gs) = Splash pos gs
            # (_, gs) = playSoundSample SND_SPLASH DefaultVolume PAN_CENTER DEFAULT_FREQUENCY 0 gs
            = {objst & st={st & action = MC_SWIM}, 
                       or  ={or & currentsprite = MC_SWIM
                                       , maxspeed = maxswimspeed
                                       , offset = {normaloffset & y = 2} },
                       gs  =gs}
        | othertype == OBJ_PIN
            # st = {st & health = 0}
            = hurt {objst & st=st}
        | othertype == OBJ_BOUNCEBLOCK
            | bnds.top
                # (_, gs) = playSoundSample SND_WATER_JUMP DefaultVolume PAN_CENTER 70000 0 gs
                = {objst & st={st & action = MC_JUMP},
                           or  ={or & speed.ry = ~(abs or.speed.ry) * 2.0 - 5.25,
                                             currentsprite = MC_JUMP},
                           gs  =gs}
            | bnds.bottom
                # (_, gs) = playSoundSample SND_WATER_JUMP DefaultVolume PAN_CENTER 60000 0 gs
                = {objst & st={st & action = MC_FALL},
                           or  ={or & speed.ry = or.speed.ry + 3.0,
                                             currentsprite = MC_FALL},
                           gs  =gs}
            = objst
        | othertype == OBJ_ENDING
            # 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) = createUserGameEvent EV_QUIT_LEVEL EC_SUCCESS 0 Self ANY_SUBTYPE 800 gs
            = {objst & or=or, gs=gs}
        | othertype == OBJ_HEART
            | not (st.health < 3)
                = objst
            # st = {st & health = st.health + 1}
            # (_, gs) = createUserGameEvent EV_HEALTH st.health 0 (BoundType BND_STAT) ANY_SUBTYPE 1 gs
            = {objst & st=st, gs=gs}
        | bnds.top
            | not (otherobjrec.ownbounds bitand BND_BLOCKS == 0)
                # (freq, gs) = IRRnd 4000 gs
                # (_, gs) = playSoundSample SND_CRATE VeryLowVolume PAN_CENTER (12000 + freq) 0 gs
                = {objst & st = {st & action = MC_JUMP},
                           or   = {or & speed.ry = -4.25,
                                               currentsprite = MC_JUMP},
                           gs   = gs}
            | not (otherobjrec.ownbounds bitand BND_ENEMY == 0)
                # gs = addscore (100 * (2 << st.enemynote) / 2) 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_FLASH 0 pos gs
                = {objst & st={st & action = MC_JUMP},
                           or  ={or & speed.ry = -4.35, 
                                             currentsprite = MC_JUMP},
                           gs  =gs}
            = objst
        | not (otherobjrec.ownbounds bitand BND_ENEMY == 0)
            | or.displayoptions.blink
                = objst
            = hurt objst
        = objst

    hurt objst=:{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 48000  0 gs
            # (_, gs) = playSoundSample SND_AU HighVolume PAN_CENTER 46000  4 gs
            # (_, gs) = playSoundSample SND_AU HighVolume PAN_CENTER 42000  7 gs
            # (_, gs) = playSoundSample SND_AU HighVolume PAN_CENTER 38000  9 gs
            # (_, gs) = playSoundSample SND_AU HighVolume PAN_CENTER 30000 10 gs
            | st.health == (-1)
                # st = {st & action = MC_DEAD}
                # or = {or & currentsprite = MC_DEAD
                           , speed = {rx = 0.0, ry = -3.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
                # (_, gs) = createUserGameEvent EV_QUIT_LEVEL EC_FAILURE
                                        0 Self ANY_SUBTYPE 600 gs
                # (l, gs) = getlives gs
                | l == 0
                    # (_, gs) = createUserGameEvent EV_GAME_OVER 0 0 Self ANY_SUBTYPE 350 gs
                    = {objst & st=st, or=or, gs=gs}
                = {objst & st=st, or=or, gs=gs}
            # (_, gs) = createUserGameEvent EV_STOP_BLINKING 0 0 Self ANY_SUBTYPE 225 gs
            # or = {or & displayoptions.blink = True}
            = {objst & st=st, or=or, gs=gs}

/* ---------- Menu object ---------- */

:: MenuState
   = { selected :: Int   /* menu options: 1, 2, ... max */
     , max      :: Int
     }

AutoMenuObject
    # obj = defaultGameObject OBJ_AUTOINIT size newstate
    # obj = { obj
            & sprites = [ItemSprite8]
            , init = newinit size newstate
            , keydown = newkeydown
            }
    = obj
where
    size = DEFAULT_SIZE
    newstate = {selected = 1, max = 2}

    newinit size state subcode pos time gs
        # gs = setexitcode EC_QUIT gs   /* for esc key */
        # (objrec, gs) = defaultObjectRec subcode pos size time gs
        # objrec = {objrec & pos = {x = 126, y = 110}
                           , options = {objrec.options & static = True
                                                       , checkkeyboard = True}
                   }
        = {st=state, or=objrec, gs=gs}

    newkeydown k objst=:{st=st, or=or, gs=gs}
        | k == GK_DOWN
            | st.selected >= st.max
                = objst
            # st = {st & selected = st.selected + 1}
            = {objst & st=st, or={or & offset = {x = 0, y = 12 * (st.selected - 1)}}}
        | k == GK_UP
            | st.selected <= 1
                = objst
            # st = {st & selected = st.selected - 1}
            = {objst & st=st, or={or & offset = {x = 0, y = 12 * (st.selected - 1)}}}
        | k == GK_SPACE || k == GK_RETURN
            | st.selected == 1
                # gs = setexitcode EC_SUCCESS gs
                = {objst & gs=quitlevel gs}
            = {objst & gs=quitlevel gs}
        = objst

/* ---------- Title screen ---------- */

TitleScreen
  = { boundmap     = ChTitleBoundMap
    , initpos      = {x = 0, y = 13 * H + H / 2}
    , layers       = [BackGr3Map1Layer, ChTitleLayer]
    , objects      = [GameObjectLS {MainCharObject & keydown = nop, keyup = nop}, GameObjectLS AutoMenuObject]
    , music        = Just BackgroundMusic
    , soundsamples = []
    , leveloptions = { fillbackground = Nothing
                     , escquit        = True
                     , debugscroll    = False
                     , fadein         = False
                     , fadeout        = False
                     }
    }
where
    nop = \k st -> st

/* ---------- level 1 ---------- */

GameLevel1
  = { boundmap     = { ChLevel1BoundMap & startobjx = 4, startobjy = 4 }
    , initpos      = {x = 0, y = 13 * H + H / 2}
    , layers       = [BackGr1Map1Layer, ChLevel1Layer]
    , objects      = GameObjectList
    , music        = Nothing // Just BackgroundMusic
    , soundsamples = GameSoundSampleList
    , leveloptions = { fillbackground = Nothing
                     , escquit        = True
                     , debugscroll    = False
                     , fadein         = True
                     , fadeout        = True
                     }
    }

/* ---------- level 2 ---------- */

GameLevel2
  = { boundmap     = { ChLevel2BoundMap & startobjx = 4, startobjy = 4 }
    , initpos      = {x = 0, y = 13 * H + H / 2}
    , layers       = [BackGr2Map1Layer, ChLevel2Layer]
    , objects      = GameObjectList
    , music        = Nothing // Just BackgroundMusic
    , soundsamples = GameSoundSampleList
    , leveloptions = { fillbackground = Nothing
                     , escquit        = True
                     , debugscroll    = False
                     , fadein         = True
                     , fadeout        = True
                     }
    }

/* ---------- 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}

/* 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)

/* increment the number of diamonds */
incdiamonds gs = appGSt incgstdiamonds gs
where
    incgstdiamonds :: GameState -> GameState
    incgstdiamonds gst = {gst & diamonds = gst.diamonds + 1}

/* increment the number of coins */
inccoins gs = appGSt incgstcoins gs
where
    incgstcoins :: GameState -> GameState
    incgstcoins gst = {gst & coins = gst.coins + 1}

/* add a value to the score */
addscore points gs = appGSt (addgstscore points) gs
where
    addgstscore :: Int GameState -> GameState
    addgstscore points gst = {gst & score = gst.score + points}

/* gameover functions */
setgameover gs = appGSt setgstgameover gs
setgstgameover :: GameState -> GameState
setgstgameover gst = {gst & gameover = True}


/* ---------- 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

/* ---------- music and sounds ---------- */

BackgroundMusic
  = { musicfile = "music\\Charlie.mid"
    , restart   = True
    , continue  = False
    }

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) gs


SND_JUMP            :==   1
SND_WATER_JUMP      :==   2
SND_SPLASH          :==   3
SND_COIN            :==   4
SND_CRATE           :==   5
SND_ENEMY           :==   6
SND_PLOF            :==   7
SND_HIT             :==   8
SND_FROG            :==   9
SND_BEE             :==  10
SND_XYLOFOON        :==  11
SND_FLUTE           :==  12
SND_CLARINET        :==  13
SND_AU              :==  14

GameSoundSampleList =
  [ { soundid = SND_JUMP        , soundfile = "sounds\\JUMP.WAV"     , soundbuffers =  1 }
  , { soundid = SND_SPLASH      , soundfile = "sounds\\WATER.WAV"    , soundbuffers =  3 }
  , { soundid = SND_WATER_JUMP  , soundfile = "sounds\\WATERJMP.WAV" , soundbuffers =  8 }
  , { soundid = SND_COIN        , soundfile = "sounds\\COIN.WAV"     , soundbuffers = 20 }
  , { soundid = SND_CRATE       , soundfile = "sounds\\CRATE.WAV"    , soundbuffers =  2 }
  , { soundid = SND_ENEMY       , soundfile = "sounds\\ENEMY.WAV"    , soundbuffers =  3 }
  , { soundid = SND_PLOF        , soundfile = "sounds\\PLOF.WAV"     , soundbuffers =  1 }
  , { soundid = SND_HIT         , soundfile = "sounds\\HIT.WAV"      , soundbuffers =  3 }
  , { soundid = SND_FROG        , soundfile = "sounds\\FROG.WAV"     , soundbuffers =  2 }
  , { soundid = SND_BEE         , soundfile = "sounds\\BEE.WAV"      , soundbuffers =  2 }
  , { soundid = SND_XYLOFOON    , soundfile = "sounds\\XYLOFOON.WAV" , soundbuffers =  8 }
  , { soundid = SND_FLUTE       , soundfile = "sounds\\FLUTE.WAV"    , soundbuffers =  8 }
  , { soundid = SND_CLARINET    , soundfile = "sounds\\CLARINET.WAV" , soundbuffers =  8 }
  , { soundid = SND_AU          , soundfile = "sounds\\AU.WAV"       , soundbuffers =  5 }
  ]


/* ---------- text items ---------- */

TitleText :: GameText
TitleText
  = { format    = "CHARLIE THE DUCK"
    , value     = Nothing
    , position  = {x = -1, y = 24}
    , style     = BigStyle
    , color     = RGB {r = 255, g = 240, b = 180}
    , shadow    = Nothing
    , alignment = {xyfromscreencenter = (True, False), xycentered = (True, False)}
    }

TitleTextShadow :: GameText
TitleTextShadow = {TitleText & position = {x = 0, y = 25}
                             , color = RGB {r = 180, g = 128, b = 32}
                             , shadow = Just TitleShadow}

BigStyle :: Style
BigStyle
  = { fontname = "Arial"
    , fontsize = 31
    , bold     = True
    , italic   = True
    }

TitleShadow :: Shadow
TitleShadow
  = { shadowpos   = {x = 1, y = 1}
    , shadowcolor = Black
    }

DemoText :: GameText
DemoText
  = { format    = "Concurrent Clean Game Library demo"
    , value     = Nothing
    , position  = {x = 0, y = 60}
    , style     = StatStyle
    , color     = White
    , shadow    = Just StatShadow
    , alignment = {xyfromscreencenter = (True, False), xycentered = (True, False)}
    }

Copyright :: GameText
Copyright
  = { format    = "(C) Copyright 1999, Mike Wiering"
    , value     = Nothing
    , position  = {x = 0, y = 72}
    , style     = StatStyle
    , color     = White
    , shadow    = Just StatShadow
    , alignment = {xyfromscreencenter = (True, False), xycentered = (True, False)}
    }

MenuText :: Int String -> GameText
MenuText i s
  = { format    = s
    , value     = Nothing
    , position  = {x = 150, y = 112 + 12 * i}
    , style     = StatStyle
    , color     = White
    , shadow    = Just StatShadow
    , alignment = zero
    }

GameOver :: GameText
GameOver
  = { format    = "GAME OVER"
    , value     = Nothing
    , position  = {x = 0, y = 0}
    , style     = BigStyle
    , color     = White
    , shadow    = Just StatShadow
    , alignment = {xyfromscreencenter = (True, True), xycentered = (True, True)}
    }


STY :== 7 // 221
STS :== 5 // (-7)

Lives :: Int -> GameText
Lives n
  = { format    = "Charlie   %2d"
    , value     = Just n
    , position  = {x = 10, y = STS}
    , style     = StatStyle
    , color     = White
    , shadow    = Just StatShadow
    , alignment = zero
    }

Diamonds :: Int -> GameText
Diamonds n
  = { format    = "%d"
    , value     = Just n
    , position  = {x = 113, y = STS}
    , style     = StatStyle
    , color     = White
    , shadow    = Just StatShadow
    , alignment = {zero & xycentered = (True, False)}
    }

Coins :: Int -> GameText
Coins n
  = { format    = "%d"
    , value     = Just n
    , position  = {x = 161, 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
    }
