Commit 0adcf9f5 authored by Mike Wiering's avatar Mike Wiering
Browse files

several names changed: ObjectType -> ObjectCode, SubType -> SubCode, etc.

parent 138d6baf
...@@ -37,7 +37,7 @@ MoveScreenTo :: !Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox) ...@@ -37,7 +37,7 @@ MoveScreenTo :: !Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitSpriteAnimation :: !BID ![(Int,Int)] !Bool !*OSToolbox -> (!GRESULT, !*OSToolbox) InitSpriteAnimation :: !BID ![(Int,Int)] !Bool !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitGameObject :: !ObjectType !SubType !Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox) InitGameObject :: !ObjectCode !SubCode !Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox)
SetObjectFocus :: !Int !Int !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox) SetObjectFocus :: !Int !Int !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
......
...@@ -85,7 +85,7 @@ InitSpriteAnimation :: !BID ![(Int,Int)] !Bool !*OSToolbox -> (!GRESULT, !*OSToo ...@@ -85,7 +85,7 @@ InitSpriteAnimation :: !BID ![(Int,Int)] !Bool !*OSToolbox -> (!GRESULT, !*OSToo
InitSpriteAnimation bid seq loop tb InitSpriteAnimation bid seq loop tb
= OSInitSpriteAnimation bid (TupleListStr seq) loop tb = OSInitSpriteAnimation bid (TupleListStr seq) loop tb
InitGameObject :: !ObjectType !SubType !Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox) InitGameObject :: !ObjectCode !SubCode !Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitGameObject ot st p tb InitGameObject ot st p tb
= OSInitGameObject ot st p tb = OSInitGameObject ot st p tb
......
definition module Random
// **************************************************************************************************
//
// General utility for random number generation.
//
// This module has been written in Clean 1.3.2 and uses the Clean Standard Object I/O library 1.2
//
// **************************************************************************************************
import StdTime
:: RandomSeed
nullRandomSeed :: RandomSeed
// nullRandomSeed generates a useless RandomSeed (random nullRandomSeed = (0,nullRandomSeed)).
getNewRandomSeed:: !*env -> (!RandomSeed, !*env) | TimeEnv env
// GetNewRandomSeed generates a useful RandomSeed, using the current time.
random :: !RandomSeed -> (!Int, !RandomSeed)
// Given a RandomSeed, Random generates a random number and a new RandomSeed.
implementation module Random
import StdInt, StdClass
from StdTime import getCurrentTime, Time
:: RandomSeed :== Int
nullRandomSeed :: RandomSeed
nullRandomSeed
= 0
getNewRandomSeed :: !*env -> (!RandomSeed, !*env) | TimeEnv env
getNewRandomSeed env
# ({hours,minutes,seconds}, env) = getCurrentTime env
= (1+(hours+minutes+seconds) bitand 65535, env)
random :: !RandomSeed -> (!Int,!RandomSeed)
random seed
= (newSeed,newSeed)
where
newSeed = if (nextSeed>=0) nextSeed (nextSeed+65537)
nextSeed = (seed75 bitand 65535)-(seed75>>16)
seed75 = seed*75
...@@ -25,14 +25,16 @@ BND_STATIC_BOUNDS :== 1 << 31 ...@@ -25,14 +25,16 @@ BND_STATIC_BOUNDS :== 1 << 31
SK_FOREVER :== -1 SK_FOREVER :== -1
startGame :: .(Game a) a [.GameAttribute a] !*World -> .World
openGame :: .gs !(Game .gs) ![GameAttribute .gs] !(PSt .l) openGame :: .gs !(Game .gs) ![GameAttribute .gs] !(PSt .l)
-> (!ErrorReport,!PSt .l) -> (.gs, !ErrorReport,!PSt .l)
createGameBitmap :: !GameBitmap !(GSt .gs) -> (!GRESULT, !GSt .gs) createGameBitmap :: !GameBitmap !(GSt .gs) -> (!GRESULT, !GSt .gs)
createAnimation :: !Sprite !(GSt .gs) -> (!GRESULT, !GSt .gs) createAnimation :: !Sprite !(GSt .gs) -> (!GRESULT, !GSt .gs)
createNewGameObject :: !ObjectType !SubType !Point2 !(GSt .gs) createNewGameObject :: !ObjectCode !SubCode !Point2 !(GSt .gs)
-> (!GRESULT, !GSt .gs) -> (!GRESULT, !GSt .gs)
:: ObjectFocus :: ObjectFocus
...@@ -52,11 +54,11 @@ createObjectFocus :: !ObjectFocus !(GSt .gs) -> (!GRESULT, !GSt .gs) ...@@ -52,11 +54,11 @@ createObjectFocus :: !ObjectFocus !(GSt .gs) -> (!GRESULT, !GSt .gs)
= Self | AllObjects | BoundType Bounds = Self | AllObjects | BoundType Bounds
// modified 01/11/99 // modified 01/11/99
createUserGameEvent :: !EventType createUserGameEvent :: !EventCode
!EventPar !EventPar
!EventPar !EventPar
!EventTarget !EventTarget
!SubType !SubCode
!GameTime !GameTime
!(GSt .gs) -> (!GRESULT, !GSt .gs) !(GSt .gs) -> (!GRESULT, !GSt .gs)
...@@ -94,10 +96,10 @@ setBoundMap :: !Int !Int !(!Int, !DirectionSet) !(GSt .gs) ...@@ -94,10 +96,10 @@ setBoundMap :: !Int !Int !(!Int, !DirectionSet) !(GSt .gs)
-> (!GRESULT, !GSt .gs) -> (!GRESULT, !GSt .gs)
defaultInitObject :: Size state SubType Point2 GameTime defaultInitObject :: Size state SubCode Point2 GameTime
!*(GSt .gs) -> GameObjectState state *(GSt .gs) !*(GSt .gs) -> GameObjectState state *(GSt .gs)
defaultGameObject :: !ObjectType !Size state -> GameObject *(GSt .gs) defaultGameObject :: !ObjectCode !Size state -> GameObject *(GSt .gs)
defaultObjectRec :: SubType Point2 Size GameTime defaultObjectRec :: SubCode Point2 Size GameTime
!*(GSt .gs) -> (!GameObjectRec,!*GSt .gs) !*(GSt .gs) -> (!GameObjectRec,!*GSt .gs)
blankScreen :: Level (GSt .gs) blankScreen :: Level (GSt .gs)
......
implementation module StdGame implementation module StdGame
import StdProcess
import StdArray, StdBool, StdClass, StdFunc, StdInt, StdList, StdMisc import StdArray, StdBool, StdClass, StdFunc, StdInt, StdList, StdMisc
import StdId import StdId
import fixed, GameFunctions, gamehandle, gameutils, gst import fixed, GameFunctions, gamehandle, gameutils, gst
...@@ -20,7 +21,16 @@ BND_STATIC_BOUNDS :== 1 << 31 ...@@ -20,7 +21,16 @@ BND_STATIC_BOUNDS :== 1 << 31
SK_FOREVER :== -1 SK_FOREVER :== -1
openGame :: .gs !(Game .gs) ![GameAttribute .gs] !(PSt .l) -> (!ErrorReport, !PSt .l) startGame :: .(Game a) a [.GameAttribute a] !*World -> .World
startGame gamedef initialstate options world
= startIO SDI 0 init [ProcessClose closeProcess] world
where
init ps
# (finalstate, _, ps) = openGame initialstate gamedef options ps
= closeProcess ps
openGame :: .gs !(Game .gs) ![GameAttribute .gs] !(PSt .l) -> (.gs, !ErrorReport, !PSt .l)
openGame gs gdef attr ps openGame gs gdef attr ps
# (wId, ps) = accPIO openId ps # (wId, ps) = accPIO openId ps
# size = findSize attr {w=320,h=240} # size = findSize attr {w=320,h=240}
...@@ -30,9 +40,9 @@ openGame gs gdef attr ps ...@@ -30,9 +40,9 @@ openGame gs gdef attr ps
# gst = toGSt gs tb # gst = toGSt gs tb
# (initLevel,gst) = gdef.nextlevel gst # (initLevel,gst) = gdef.nextlevel gst
# (gs,tb) = fromGSt gst # (gs,tb) = fromGSt gst
# (_, tb) = PlayLevels initLevel gs gdef tb # (gs, _, tb) = PlayLevels initLevel gs gdef tb
# ps = appPIO (setIOToolbox tb) ps # ps = appPIO (setIOToolbox tb) ps
= (NoError, ps) = (gs, NoError, ps)
where where
findSize :: ![GameAttribute .gs] !Size -> Size findSize :: ![GameAttribute .gs] !Size -> Size
findSize [] s = s findSize [] s = s
...@@ -67,10 +77,10 @@ where ...@@ -67,10 +77,10 @@ where
# pState = appPIO decreaseWindowBound pState # pState = appPIO decreaseWindowBound pState
= (NoError,pState) = (NoError,pState)
PlayLevels :: !Int .gs !(Game .gs) !*OSToolbox -> (!ErrorReport, !*OSToolbox) PlayLevels :: !Int .gs !(Game .gs) !*OSToolbox -> (.gs, !ErrorReport, !*OSToolbox)
PlayLevels level gs gdef tb PlayLevels level gs gdef tb
| level == 0 | level == 0
= (NoError, tb) = (gs, NoError, tb)
# ghnd = createGameHandle gdef # ghnd = createGameHandle gdef
# (_, gs, tb) = PlayLevel level gs ghnd tb # (_, gs, tb) = PlayLevel level gs ghnd tb
# gst = toGSt gs tb # gst = toGSt gs tb
...@@ -227,7 +237,7 @@ createAnimation sprite=:{bitmap, sequence, loop} gst ...@@ -227,7 +237,7 @@ createAnimation sprite=:{bitmap, sequence, loop} gst
# (sprid, gst) = accGStTb (InitSpriteAnimation bid sequence loop) gst # (sprid, gst) = accGStTb (InitSpriteAnimation bid sequence loop) gst
= (0-sprid, gst) = (0-sprid, gst)
createNewGameObject :: !ObjectType !SubType !Point2 !(GSt .gs) -> (!GRESULT, !GSt .gs) createNewGameObject :: !ObjectCode !SubCode !Point2 !(GSt .gs) -> (!GRESULT, !GSt .gs)
createNewGameObject ot st p gst createNewGameObject ot st p gst
= accGStTb (InitGameObject ot st p) gst = accGStTb (InitGameObject ot st p) gst
...@@ -286,7 +296,7 @@ EventTargetToInt AllObjects = -1 ...@@ -286,7 +296,7 @@ EventTargetToInt AllObjects = -1
EventTargetToInt (BoundType b) = b EventTargetToInt (BoundType b) = b
// modified 01/11/99 // modified 01/11/99
createUserGameEvent :: !EventType !EventPar !EventPar !EventTarget !SubType !GameTime !(GSt .gs) -> (!GRESULT, !GSt .gs) createUserGameEvent :: !EventCode !EventPar !EventPar !EventTarget !SubCode !GameTime !(GSt .gs) -> (!GRESULT, !GSt .gs)
createUserGameEvent ev evpar1 evpar2 dest subdest time gst createUserGameEvent ev evpar1 evpar2 dest subdest time gst
= accGStTb (CreateUserEvent ev evpar1 evpar2 (EventTargetToInt dest) subdest time) gst = accGStTb (CreateUserEvent ev evpar1 evpar2 (EventTargetToInt dest) subdest time) gst
...@@ -324,10 +334,10 @@ defaultObjectOptions ...@@ -324,10 +334,10 @@ defaultObjectOptions
, removemapcode = False , removemapcode = False
} }
defaultObjectRec :: SubType Point2 Size GameTime !*(GSt .gs) -> (!GameObjectRec,!*GSt .gs) defaultObjectRec :: SubCode Point2 Size GameTime !*(GSt .gs) -> (!GameObjectRec,!*GSt .gs)
defaultObjectRec objsubtype position size time gs defaultObjectRec objsubcode position size time gs
= ( { active = True = ( { active = True
, subtype = objsubtype , subcode = objsubcode
, size = size , size = size
, pos = position , pos = position
, offset = zero , offset = zero
...@@ -353,17 +363,17 @@ defaultObjectRec objsubtype position size time gs ...@@ -353,17 +363,17 @@ defaultObjectRec objsubtype position size time gs
} }
, gs) , gs)
defaultInitObject :: Size state SubType Point2 GameTime !*(GSt .gs) -> GameObjectState state *(GSt .gs) defaultInitObject :: Size state SubCode Point2 GameTime !*(GSt .gs) -> GameObjectState state *(GSt .gs)
defaultInitObject size state subtype pos time gs defaultInitObject size state subtype pos time gs
# (newobjrec, gs) = defaultObjectRec subtype pos size time gs # (newobjrec, gs) = defaultObjectRec subtype pos size time gs
= {objectstate=state,gamestate=gs,objectrec=newobjrec} = {st=state,gs=gs,or=newobjrec}
defaultGameObject :: !ObjectType !Size state -> GameObject *(GSt .gs) defaultGameObject :: !ObjectCode !Size state -> GameObject *(GSt .gs)
defaultGameObject objtype size state defaultGameObject objcode size state
= { objecttype = objtype = { objectcode = objcode
, sprites = [] , sprites = []
, init = defaultInitObject size state , init = defaultInitObject size state
, done = \{gamestate} -> gamestate , done = \{gs} -> gs
, move = id , move = id
, animation = id , animation = id
, touchbound = \_ _ -> id , touchbound = \_ _ -> id
......
definition module StdGameDef definition module StdGameDef
// ******************************************************************************** // ********************************************************************************
// Clean Standard Game library, version 1.2 // Clean Standard Game library, version 1.2
// //
...@@ -13,11 +12,9 @@ from StdOverloaded import zero ...@@ -13,11 +12,9 @@ from StdOverloaded import zero
from StdString import String from StdString import String
from StdIOBasic import Point2, Size, IdFun from StdIOBasic import Point2, Size, IdFun
from StdMaybe import Maybe, Just, Nothing from StdMaybe import Maybe, Just, Nothing
from StdPictureDef import Colour, from StdPictureDef import Colour, RGB, RGBColour, Black, White,
RGB, RGBColour, Black, White, DarkGrey, Grey, LightGrey, Red, Green,
DarkGrey, Grey, LightGrey, Blue, Cyan, Magenta, Yellow
Red, Green, Blue,
Cyan, Magenta, Yellow
import StdGSt import StdGSt
...@@ -29,7 +26,7 @@ import StdGSt ...@@ -29,7 +26,7 @@ import StdGSt
= { levels :: [Level (GSt gs)] // levels = { levels :: [Level (GSt gs)] // levels
, quitlevel :: St (GSt gs) Bool // True quits the game , quitlevel :: St (GSt gs) Bool // True quits the game
, nextlevel :: St (GSt gs) Int // new level if >0 (0 quits) , nextlevel :: St (GSt gs) Int // new level if >0 (0 quits)
, statistics :: St (GSt gs) [GameText] // all game text items , textitems :: St (GSt gs) [GameText] // all game text items
} }
:: Level state :: Level state
...@@ -111,10 +108,10 @@ import StdGSt ...@@ -111,10 +108,10 @@ import StdGSt
// (n = # blocks in gamebitmap; m = # sequences) // (n = # blocks in gamebitmap; m = # sequences)
:: TileSequence :: TileSequence
:== (!Int, Sequence) :== (!Int, Sequence) // block sequence number, Sequence
:: Sequence :: Sequence
:== [(Int, Int)] :== [(Int, Int)] // tile number, duration
:: Movement :: Movement
:== Point2 GameTime -> Point2 // calculate layer's position from game position :== Point2 GameTime -> Point2 // calculate layer's position from game position
...@@ -127,33 +124,36 @@ import StdGSt ...@@ -127,33 +124,36 @@ import StdGSt
, sequence :: !Sequence // seqence of blocks , sequence :: !Sequence // seqence of blocks
, loop :: !Bool // if FALSE, callback animation function , loop :: !Bool // if FALSE, callback animation function
} }
:: GameObject gs :: GameObject gs
= E. state: = E. state:
{ objecttype :: !ObjectType // identifier for object type (0 AutoInitObject) { objectcode :: !ObjectCode // code for object type (0 AutoInitObject)
, sprites :: ![Sprite] // sprite 1..n , sprites :: ![Sprite] // sprite 1..n
, init :: !SubType !Point2 !GameTime !gs -> GameObjectState state gs , init :: !SubCode !Point2 !GameTime !gs -> GameObjectState state gs
, done :: !(GameObjectState state gs) -> gs , done :: !(GameObjectState state gs) -> gs
, move :: ! ObjectFun state gs , move :: ! ObjectFun state gs
, animation :: ! ObjectFun state gs , animation :: ! ObjectFun state gs
, touchbound :: !DirectionSet MapCode -> ObjectFun state gs , touchbound :: !DirectionSet MapCode -> ObjectFun state gs
, collide :: !DirectionSet ObjectType GameObjectRec -> ObjectFun state gs , collide :: !DirectionSet ObjectCode GameObjectRec -> ObjectFun state gs
, frametimer :: ! ObjectFun state gs , frametimer :: ! ObjectFun state gs
, keydown :: !KeyCode -> ObjectFun state gs , keydown :: !KeyCode -> ObjectFun state gs
, keyup :: !KeyCode -> ObjectFun state gs , keyup :: !KeyCode -> ObjectFun state gs
, userevent :: !EventType !EventPar !EventPar -> ObjectFun state gs , userevent :: !EventCode !EventPar !EventPar -> ObjectFun state gs
} }
:: *GameObjectState state gs :: *GameObjectState state gs
= { objectstate:: state = { st :: state // object state
, gamestate :: gs , or :: GameObjectRec // object record
, objectrec :: GameObjectRec , gs :: gs // game state
} }
:: ObjectFun state gs :: ObjectFun state gs
:== IdFun (GameObjectState state gs) :== IdFun (GameObjectState state gs)
:: ObjectType :: ObjectCode
:== Int :== Int
:: SubType :: SubCode
:== Int :== Int
:: MapCode :: MapCode
...@@ -162,7 +162,7 @@ import StdGSt ...@@ -162,7 +162,7 @@ import StdGSt
:: KeyCode :: KeyCode
:== Int :== Int
:: EventType :: EventCode
:== Int :== Int
:: EventPar :: EventPar
...@@ -184,7 +184,7 @@ import StdGSt ...@@ -184,7 +184,7 @@ import StdGSt
:: GameObjectRec :: GameObjectRec
= { active :: !Bool // move and check collisions? = { active :: !Bool // move and check collisions?
, subtype :: !SubType // object's sub type , subcode :: !SubCode // object's sub-code
, size :: !Size // the actual size , size :: !Size // the actual size
, pos :: !Point2 // current position , pos :: !Point2 // current position
, offset :: !Point2 // relative offset for sprite , offset :: !Point2 // relative offset for sprite
......
...@@ -7,17 +7,14 @@ implementation module StdGameDef ...@@ -7,17 +7,14 @@ implementation module StdGameDef
// StdGameDef contains all the type definitions needed to specify a game. // StdGameDef contains all the type definitions needed to specify a game.
// ******************************************************************************** // ********************************************************************************
from StdFunc import St from StdFunc import St
from StdOverloaded import zero from StdOverloaded import zero
from StdString import String from StdString import String
from StdIOBasic import Point2, Size, IdFun from StdIOBasic import Point2, Size, IdFun
from StdMaybe import Maybe, Just, Nothing from StdMaybe import Maybe, Just, Nothing
from StdPictureDef import Colour, from StdPictureDef import Colour, RGB, RGBColour, Black, White,
RGB, RGBColour, Black, White, DarkGrey, Grey, LightGrey, Red, Green,
DarkGrey, Grey, LightGrey, Blue, Cyan, Magenta, Yellow
Red, Green, Blue,
Cyan, Magenta, Yellow
import StdGSt import StdGSt
:: GameAttribute gs :: GameAttribute gs
...@@ -28,7 +25,7 @@ import StdGSt ...@@ -28,7 +25,7 @@ import StdGSt
= { levels :: [Level (GSt gs)] // levels = { levels :: [Level (GSt gs)] // levels
, quitlevel :: St (GSt gs) Bool // True quits the game , quitlevel :: St (GSt gs) Bool // True quits the game
, nextlevel :: St (GSt gs) Int // new level if >0 (0 quits) , nextlevel :: St (GSt gs) Int // new level if >0 (0 quits)
, statistics :: St (GSt gs) [GameText] // all text items , textitems :: St (GSt gs) [GameText] // all text items
} }
:: Level state :: Level state
...@@ -110,10 +107,10 @@ import StdGSt ...@@ -110,10 +107,10 @@ import StdGSt
// (n = # blocks in gamebitmap; m = # sequences) // (n = # blocks in gamebitmap; m = # sequences)
:: TileSequence :: TileSequence
:== (!Int, Sequence) :== (!Int, Sequence) // block sequence number, Sequence
:: Sequence :: Sequence
:== [(Int, Int)] :== [(Int, Int)] // tile number, duration
:: Movement :: Movement
:== Point2 GameTime -> Point2 // calculate layer's position from game position :== Point2 GameTime -> Point2 // calculate layer's position from game position
...@@ -129,31 +126,33 @@ import StdGSt ...@@ -129,31 +126,33 @@ import StdGSt
:: GameObject gs :: GameObject gs
= E. state: = E. state:
{ objecttype :: !ObjectType // identifier for object type (0 AutoInitObject) { objectcode :: !ObjectCode // code for object type (0 AutoInitObject)
, sprites :: ![Sprite] // sprite 1..n , sprites :: ![Sprite] // sprite 1..n
, init :: !SubType !Point2 !GameTime !gs -> GameObjectState state gs , init :: !SubCode !Point2 !GameTime !gs -> GameObjectState state gs
, done :: !(GameObjectState state gs) -> gs , done :: !(GameObjectState state gs) -> gs
, move :: ! ObjectFun state gs , move :: ! ObjectFun state gs
, animation :: ! ObjectFun state gs , animation :: ! ObjectFun state gs
, touchbound :: !DirectionSet MapCode -> ObjectFun state gs , touchbound :: !DirectionSet MapCode -> ObjectFun state gs
, collide :: !DirectionSet ObjectType GameObjectRec -> ObjectFun state gs , collide :: !DirectionSet ObjectCode GameObjectRec -> ObjectFun state gs
, frametimer :: ! ObjectFun state gs , frametimer :: ! ObjectFun state gs
, keydown :: !KeyCode -> ObjectFun state gs , keydown :: !KeyCode -> ObjectFun state gs
, keyup :: !KeyCode -> ObjectFun state gs , keyup :: !KeyCode -> ObjectFun state gs
, userevent :: !EventType !EventPar !EventPar -> ObjectFun state gs , userevent :: !EventCode !EventPar !EventPar -> ObjectFun state gs
} }
:: *GameObjectState state gs :: *GameObjectState state gs
= { objectstate:: state = { st :: state // object state
, gamestate :: gs , or :: GameObjectRec // object record
, objectrec :: GameObjectRec , gs :: gs // game state
} }
:: ObjectFun state gs :: ObjectFun state gs
:== IdFun (GameObjectState state gs) :== IdFun (GameObjectState state gs)
:: ObjectType :: ObjectCode
:== Int :== Int