implementation module osgame import StdArray, StdBool, StdChar, StdInt import StdMaybe from ospicture import toRGBtriple from clCCall_12 import winBeep import gameCrossCall_12, gamehandle, gameobjectutils, gst :: OSGameData gs = { scroll :: [(MAPID, Movement)] // The layer movement functions , gamest :: gs // The game state , gamehnd :: GameHandle gs // Complete game definition } OSinitialiseGame :: !*OSToolbox -> *OSToolbox OSinitialiseGame tb = WinInitialiseGame tb OSBinaryIntStr :: !Int -> {#Char} OSBinaryIntStr x = WinBinaryIntStr x OSBinaryBoolStr :: !Bool -> {#Char} OSBinaryBoolStr x = WinBinaryBoolStr x OSIntListArrayToString :: ![{#Int}] -> {#Char} OSIntListArrayToString irs = IntListArrayToString "" irs where IntListArrayToString :: !{#Char} ![{#Int}] -> {#Char} IntListArrayToString cs [] = cs IntListArrayToString cs [ir:irs] = IntListArrayToString (cs+++intarrayToString ir) irs where intarrayToString :: !{#Int} -> {#Char} intarrayToString ir = encode 0 ir zeroChars where zeroChars = createArray (4*(size ir)) zero encode :: !Int !{#Int} !*{#Char} -> *{#Char} encode i ir zeroChars | i Int maskshift nrbits x = (x>>nrbits) bitand 0xFF OScreateGameWindow :: !Bool !(!Int,!Int) !Int !*OSToolbox -> (![DelayActivationInfo],!OSWindowPtr,!*OSToolbox) OScreateGameWindow fullscreen size bpp tb = WinCreateGameWindow fullscreen size bpp tb OSInitGameBitmap :: !BID !{#Char} !Int !Int !Int !Int !*OSToolbox -> (!GRESULT,!*OSToolbox) OSInitGameBitmap id filename w h blockwidth blockheight tb = WinInitGameBitmap id filename w h blockwidth blockheight tb OSGameBitmapDone :: !BID !*OSToolbox -> (!GRESULT,!*OSToolbox) OSGameBitmapDone id tb = WinGameBitmapDone id tb OSClearAllGameBitmaps :: !*OSToolbox -> (!GRESULT,!*OSToolbox) OSClearAllGameBitmaps tb = WinClearAllGameBitmaps tb OSSetTransparentColor :: !BID !Int !Int !*OSToolbox -> (!GRESULT,!*OSToolbox) OSSetTransparentColor id x y tb = WinSetTransparentColor id x y tb OSInitBlockSequence :: !BID !SEQID !{#Char} !*OSToolbox -> (!GRESULT,!*OSToolbox) OSInitBlockSequence bid seqid seq tb = WinInitBlockSequence bid seqid seq tb OSInitGameLayerMap :: !MAPID !BID !{#Char} !Int !Int !Bool !*OSToolbox -> (!GRESULT,!*OSToolbox) OSInitGameLayerMap mapid bid map w h tile tb = WinInitGameLayerMap mapid bid map w h tile tb OSGameLayerMapDone :: !MAPID !*OSToolbox -> (!GRESULT,!*OSToolbox) OSGameLayerMapDone mapid tb = WinGameLayerMapDone mapid tb OSRunGameEngine :: !(OSGameData .gs) !*OSToolbox -> (.gs,!*OSToolbox) OSRunGameEngine gd tb # (gd,tb) = WinRunGameEngine handleGameEvents gd 0 0 0 tb = (gd.gamest,tb) OSSetGameBoundMap :: !Int !Int !{#Char} !Int !Int !Int !Int !Int !*OSToolbox -> (!GRESULT,!*OSToolbox) OSSetGameBoundMap w h map mw mh objstart startobjx startobjy tb = WinSetGameBoundMap w h map mw mh objstart startobjx startobjy tb OSMoveScreenTo :: !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox) OSMoveScreenTo x y tb = WinMoveScreenTo x y tb OSInitSpriteAnimation :: !BID !{#Char} !Bool !*OSToolbox -> (!GRESULT,!*OSToolbox) OSInitSpriteAnimation bid seq loop tb = WinInitSpriteAnimation bid seq loop tb OSInitGameObject :: !ObjectCode !SubCode !Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox) OSInitGameObject ot st p tb = WinInitGameObject ot st p.x p.y tb OSSetObjectFocus :: !Int !Int !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox) OSSetObjectFocus x1 y1 x2 y2 maxxv maxyv tb = WinSetObjectFocus x1 y1 x2 y2 maxxv maxyv tb // modified 01/11/99 OSCreateUserEvent :: !Int !Int !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox) OSCreateUserEvent ev evpar1 evpar2 dest subdest time tb = WinCreateUserEvent ev evpar1 evpar2 dest subdest time tb OSShowStatistic :: !Int !Int !{#Char} !Int !Colour !{#Char} !Int !Bool !Bool !Bool !Int !Int !Colour !Int !*OSToolbox -> (!GRESULT, !*OSToolbox) OSShowStatistic x y format value color font size bold italic shadow sx sy scolor options tb = WinShowStatistic x y format value colorRGB font size bold italic shadow sx sy scolorRGB options tb where colorRGB = toRGBtriple color scolorRGB = toRGBtriple scolor OSPlayMusic :: !{#Char} !Bool !*OSToolbox -> (!GRESULT, !*OSToolbox) OSPlayMusic midifile restart tb = WinPlayMusic midifile restart tb OSStopMusic :: !*OSToolbox -> (!GRESULT, !*OSToolbox) OSStopMusic tb = WinStopMusic tb OSGameLevelOptions :: !Bool !Colour !Bool !Bool !Bool !Bool !*OSToolbox -> (!GRESULT, !*OSToolbox) OSGameLevelOptions fill rgb esc debug fadein fadeout tb = WinGameLevelOptions (if fill (toRGBtriple rgb) (~1,~1,~1)) esc debug fadein fadeout tb OSInitSoundSample :: !Int !{#Char} !Int !*OSToolbox -> (!GRESULT, !*OSToolbox) OSInitSoundSample id name buffers tb = WinInitSoundSample id name buffers tb OSPlaySoundSample :: !Int !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox) OSPlaySoundSample id vol pan freq delay tb = WinPlaySoundSample id vol pan freq delay tb OSGetBoundMap :: !Int !Int !*OSToolbox -> (!(!Int, !GRESULT), !*OSToolbox) OSGetBoundMap x y tb # (value, gresult, tb) = WinGetBoundMap x y tb = ((value, gresult), tb) OSSetBoundMap :: !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox) OSSetBoundMap x y newvalue tb = WinSetBoundMap x y newvalue tb handleGameEvents :: !CrossCallInfo !v:(OSGameData u:gs) !*OSToolbox -> (!CrossCallInfo,!v:OSGameData u:gs,!*OSToolbox), [v<=u] handleGameEvents fromOSCci=:{ccMsg=CcWmGAMEKEYBOARD,p1=key,p2=x,p3=y} state tb = (return2Cci x` y`,state,tb) where (x`,y`) = case key of GK_LEFT -> (x-1, y) GK_RIGHT -> (x+1, y) GK_UP -> (x, y-1) GK_DOWN -> (x, y+1) otherwise -> (x, y) handleGameEvents fromOSCci=:{ccMsg=CcWmCHECKQUIT} state=:{gamest,gamehnd={quitlevel`=quitfunction}} tb # gst = toGSt gamest tb # (quit, gst) = quitfunction gst # (newstate, tb) = fromGSt gst = (return1Cci (toInt quit), {state & gamest = newstate}, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmSCROLL,p1=id,p2=x,p3=y,p4=t} state=:{scroll} tb = (return2Cci x` y`, state, tb) where {x = x`, y = y`} = f (MakePoint x y) t f = FindMovement (id, scroll) FindMovement :: !(!MAPID, ![(MAPID, Movement)]) -> Movement FindMovement (mapid, [(id, mv): rest]) | id == mapid = mv | otherwise = FindMovement (mapid, rest) handleGameEvents fromOSCci=:{ccMsg=CcWmINITOBJECT, p1=objtype, p2=subtype, p3=id, p4=x, p5=y, p6=time} state tb # (state,tb) = initialiseGameObject objtype subtype id {x=x,y=y} time state tb = (return0Cci, state, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmOBJECTDONE, p1=objtype, p2=id} state tb # (state, tb) = doneGameObject objtype id state tb = (return0Cci, state, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmMOVEOBJECT, p1=objtype, p2=id} state tb # (state,tb) = moveGameObject objtype id state tb = (return0Cci, state, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmTOUCHBOUND, p1=objtype, p2=id, p3=dir, p4=mapcode} state tb # (state,tb) = touchBound objtype id dir mapcode state tb = (return0Cci, state, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmCOLLISION, p1=ot1, p2=id1, p3=ot2, p4=id2, p5=dir} state tb # (state,tb) = handleCollision ot1 id1 ot2 id2 dir state tb = (return0Cci, state, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmANIMATION, p1=objtype, p2=id} state tb # (state,tb) = handleAnimationEvent objtype id state tb = (return0Cci, state, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmUSEREVENT, p1=objtype, p2=id, p3=ev, p4=par1, p5=par2} state tb # (state,tb) = handleUserEvent objtype id ev par1 par2 state tb = (return0Cci, state, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmOBJECTTIMER, p1=objtype, p2=id} state tb # (state,tb) = handleTimerEvent objtype id state tb = (return0Cci, state, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmOBJECTKEYDOWN, p1=objtype, p2=id, p3=key} state tb # (state,tb) = handleKeyDown objtype id key state tb = (return0Cci, state, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmOBJECTKEYUP, p1=objtype, p2=id, p3=key} state tb # (state,tb) = handleKeyUp objtype id key state tb = (return0Cci, state, tb) handleGameEvents fromOSCci=:{ccMsg=CcWmSTATISTICS} state=:{gamest,gamehnd={textitems`=stats}} tb # gst = toGSt gamest tb # (statlist, gst) = stats gst # (newstate, tb) = fromGSt gst # tb = showall statlist tb = (return0Cci, {state & gamest = newstate}, tb) where showall :: ![GameText] !*OSToolbox -> *OSToolbox showall [] tb = tb showall [x:xs] tb # tb = showstat x tb = showall xs tb where showstat :: !GameText !*OSToolbox -> *OSToolbox showstat s tb | isJust s.shadow # (_,tb) = OSShowStatistic s.position.x s.position.y s.format (mi s.value) s.color s.style.fontname s.style.fontsize s.style.bold s.style.italic True sh.shadowpos.x sh.shadowpos.y sh.shadowcolor (alint s.alignment) tb = tb # (_,tb) = OSShowStatistic s.position.x s.position.y s.format (mi s.value) s.color s.style.fontname s.style.fontsize s.style.bold s.style.italic False 0 0 Black (alint s.alignment) tb = tb where mi :: (Maybe Int) -> Int mi Nothing = NOTHING mi (Just x) = x sh = fromJust s.shadow alint :: TextAlignment -> Int alint al = CompressBools (False, False, False, False, sy, sx, cy, cx) where (cx,cy) = al.xycentered (sx,sy) = al.xyfromscreencenter handleGameEvents fromOSCci state tb = (return0Cci,state,winBeep tb) MakePoint :: !Int !Int -> Point2 MakePoint a b = {x = a, y = b} handleUserEvent :: !Int !InstanceID !Int !Int !Int !v:(OSGameData u:gs) !*OSToolbox -> (!v:(OSGameData u:gs), !*OSToolbox), [v<=u] handleUserEvent objtype id ev par1 par2 data=:{gamest,gamehnd} tb # maybefound = getobject objtype gamehnd | isJust maybefound # obj = fromJust maybefound # (_, _, objrec, tb) = GetObjectRec id tb # gst = toGSt gamest tb # (obj,objrec,gst) = doUserEvent id obj objrec ev par1 par2 gst # (newstate, tb) = fromGSt gst # data = {data & gamehnd = putobject obj gamehnd,gamest=newstate} # (_, tb) = SetObjectRec id objtype objrec (getGameObjectHandleLS_spriteids` obj) tb = (data, tb) | otherwise = (data, tb) where doUserEvent :: !InstanceID !(GameObjectHandleLS .gs) !GameObjectRec !Int !Int !Int !.gs -> (!GameObjectHandleLS .gs,!GameObjectRec,.gs) doUserEvent id (GameObjectHandleLS obj=:{instances`,userevent`}) objrec ev par1 par2 gst # maybestate = findinstance instances` id | isNothing maybestate = (GameObjectHandleLS obj,objrec,gst) # state = fromJust maybestate # {st=s,or=objrec,gs=gst} = userevent` ev par1 par2 {st=state,or=objrec,gs=gst} # newinstances = updateinstance id s instances` # obj = {obj & instances`=newinstances} = (GameObjectHandleLS obj,objrec,gst) // = ({obj & instances`=newinstances},objrec,gst) handleAnimationEvent :: !Int !InstanceID !v:(OSGameData u:gs) !*OSToolbox -> (!v:(OSGameData u:gs), !*OSToolbox), [v<=u] handleAnimationEvent objtype id data=:{gamest,gamehnd} tb # maybefound = getobject objtype gamehnd | isJust maybefound # obj = fromJust maybefound # (_, _, objrec, tb) = GetObjectRec id tb # gst = toGSt gamest tb # (obj,objrec,gst) = doAnimation id obj objrec gst # (newstate, tb) = fromGSt gst # data = {data & gamehnd = putobject obj data.gamehnd, gamest=newstate} # (_, tb) = SetObjectRec id objtype objrec (getGameObjectHandleLS_spriteids` obj) tb = (data, tb) | otherwise = (data, tb) where doAnimation :: !InstanceID !(GameObjectHandleLS .gs) !GameObjectRec !.gs -> (!GameObjectHandleLS .gs,!GameObjectRec,.gs) doAnimation id (GameObjectHandleLS obj=:{instances`,animation`}) objrec gst # maybestate = findinstance instances` id | isNothing maybestate = (GameObjectHandleLS obj,objrec,gst) # state = fromJust maybestate # {st=s,or=objrec,gs=gst} = animation` {st=state,or=objrec,gs=gst} # newinstances = updateinstance id s instances` # obj = {obj & instances`=newinstances} = (GameObjectHandleLS obj,objrec,gst) // = ({obj & instances`=newinstances},objrec,gst) handleTimerEvent :: !Int !InstanceID !v:(OSGameData u:gs) !*OSToolbox -> (!v:OSGameData u:gs, !*OSToolbox), [v<=u] handleTimerEvent objtype id data=:{gamest,gamehnd} tb # maybefound = getobject objtype gamehnd | isJust maybefound # obj = fromJust maybefound # (_, _, objrec, tb) = GetObjectRec id tb # gst = toGSt gamest tb # (obj,objrec,gst) = doTimer id obj objrec gst # (newstate, tb) = fromGSt gst # data = {data & gamehnd = putobject obj data.gamehnd, gamest=newstate} # (_, tb) = SetObjectRec id objtype objrec (getGameObjectHandleLS_spriteids` obj) tb = (data, tb) | otherwise = (data, tb) where doTimer :: !InstanceID !(GameObjectHandleLS .gs) !GameObjectRec !.gs -> (!GameObjectHandleLS .gs,!GameObjectRec,.gs) doTimer id (GameObjectHandleLS obj=:{instances`,frametimer`}) objrec gst # maybestate = findinstance instances` id | isNothing maybestate = (GameObjectHandleLS obj,objrec,gst) # state = fromJust maybestate # {st=s,or=objrec,gs=gst} = frametimer` {st=state,or=objrec,gs=gst} # newinstances = updateinstance id s instances` # obj = {obj & instances`=newinstances} = (GameObjectHandleLS obj,objrec,gst) // = ({obj & instances`=newinstances},objrec,gst) moveGameObject :: !Int !InstanceID !v:(OSGameData u:gs) !*OSToolbox -> (!v:OSGameData u:gs, !*OSToolbox) moveGameObject objtype id data=:{gamest,gamehnd} tb # maybefound = getobject objtype gamehnd | isJust maybefound # obj = fromJust maybefound # (_, _, objrec, tb) = GetObjectRec id tb # gst = toGSt gamest tb # (obj,objrec,gst) = doMove id obj objrec gst # (newstate, tb) = fromGSt gst # data = {data & gamehnd = putobject obj gamehnd,gamest=newstate} # (_, tb) = SetObjectRec id objtype objrec (getGameObjectHandleLS_spriteids` obj) tb = (data, tb) | otherwise = (data, tb) where doMove :: !InstanceID !(GameObjectHandleLS .gs) !GameObjectRec !.gs -> (!GameObjectHandleLS .gs,!GameObjectRec,.gs) doMove id (GameObjectHandleLS obj=:{instances`,move`}) objrec gst # maybestate = findinstance instances` id | isNothing maybestate = (GameObjectHandleLS obj,objrec,gst) # state = fromJust maybestate # {st=s,or=objrec,gs=gst} = move` {st=state,or=objrec,gs=gst} # newinstances = updateinstance id s instances` # obj = {obj & instances`=newinstances} = (GameObjectHandleLS obj,objrec,gst) // = ({obj & instances`=newinstances},objrec,gst) touchBound :: !Int !InstanceID !Int !Int !v:(OSGameData u:gs) !*OSToolbox -> (!v:OSGameData u:gs, !*OSToolbox) touchBound objtype id dir mapcode data=:{gamest,gamehnd} tb # directions = makeDirectionSet dir # maybefound = getobject objtype gamehnd | isJust maybefound # obj = fromJust maybefound # (_, _, objrec, tb) = GetObjectRec id tb # gst = toGSt gamest tb # (obj,objrec,gst) = doTouchBound id obj objrec directions mapcode gst # (newstate, tb) = fromGSt gst # data = {data & gamehnd = putobject obj data.gamehnd,gamest=newstate} # (_, tb) = SetObjectRec id objtype objrec (getGameObjectHandleLS_spriteids` obj) tb = (data, tb) | otherwise = (data, tb) where doTouchBound :: !InstanceID !(GameObjectHandleLS .gs) !GameObjectRec !DirectionSet !Int !.gs -> (!GameObjectHandleLS .gs,!GameObjectRec,.gs) doTouchBound id (GameObjectHandleLS obj=:{instances`,touchbound`}) objrec bounds mapcode gst # maybestate = findinstance instances` id | isNothing maybestate = (GameObjectHandleLS obj,objrec,gst) # state = fromJust maybestate # {st=s,or=objrec,gs=gst} = touchbound` bounds mapcode {st=state,or=objrec,gs=gst} # newinstances = updateinstance id s instances` # obj = {obj & instances`=newinstances} = (GameObjectHandleLS obj,objrec,gst) initialiseGameObject :: !Int !Int !InstanceID !Point2 !Int !v:(OSGameData u:gs) !*OSToolbox -> (!v:OSGameData u:gs, !*OSToolbox) initialiseGameObject objtype subtype id p time data=:{scroll,gamest,gamehnd} tb # maybefound = getobject objtype gamehnd | isJust maybefound # obj = fromJust maybefound # gst = toGSt gamest tb # (obj,objrec,gst) = doInit id subtype p time obj gst # (newstate, tb) = fromGSt gst # data = {data & gamehnd = putobject obj gamehnd, gamest=newstate} # (_, tb) = SetObjectRec id objtype objrec (getGameObjectHandleLS_spriteids` obj) tb = (data, tb) | otherwise = (data, tb) where doInit :: !InstanceID !Int !Point2 !GameTime !(GameObjectHandleLS .gs) !.gs -> (!GameObjectHandleLS .gs,!GameObjectRec,.gs) doInit id subtype p time (GameObjectHandleLS obj=:{instances`,init`}) gst // # ((state,objrec), gst) = init` subtype p time gst # {st=state,or=objrec,gs=gst} = init` subtype p time gst # newinstances = [(id,state):instances`] = (GameObjectHandleLS {obj & instances`=newinstances},objrec,gst) doneGameObject :: !Int !InstanceID !v:(OSGameData u:gs) !*OSToolbox -> (!v:OSGameData u:gs, !*OSToolbox) doneGameObject objtype id data=:{gamest,gamehnd} tb # maybefound = getobject objtype gamehnd | isJust maybefound # obj = fromJust maybefound # (_, _, objrec, tb) = GetObjectRec id tb # gst = toGSt gamest tb # (obj,gst) = doDone id obj objrec gst # (newstate, tb) = fromGSt gst # data = {data & gamehnd = putobject obj gamehnd, gamest=newstate} # (_, tb) = SetObjectRec id objtype objrec (getGameObjectHandleLS_spriteids` obj) tb = (data, tb) | otherwise = (data, tb) where doDone :: !InstanceID !(GameObjectHandleLS .gs) !GameObjectRec !.gs -> (!GameObjectHandleLS .gs,.gs) doDone id (GameObjectHandleLS obj=:{instances`,done`}) objrec gst # maybestate = findinstance instances` id | isNothing maybestate = (GameObjectHandleLS obj, gst) # state = fromJust maybestate # gst = done` {st=state,or=objrec,gs=gst} # newinstances = removeinstance id instances` # obj = {obj & instances`=newinstances} = (GameObjectHandleLS obj, gst) // = ({obj & instances`=newinstances}, gst) handleCollision :: !Int !InstanceID !Int !InstanceID !Int !v:(OSGameData u:gs) !*OSToolbox -> (!v:OSGameData u:gs, !*OSToolbox), [v<=u] handleCollision ot1 id1 ot2 id2 dir data=:{gamest,gamehnd} tb # directions = makeDirectionSet dir # maybefound = getobject ot1 gamehnd | isJust maybefound # obj = fromJust maybefound # (_, _, objrec2, tb) = GetObjectRec id2 tb # (_, _, objrec1, tb) = GetObjectRec id1 tb # gst = toGSt gamest tb # (obj,objrec1,gst) = doCollision id1 obj objrec1 directions ot2 objrec2 gst # (newstate, tb) = fromGSt gst # data = {data & gamehnd = putobject obj data.gamehnd, gamest=newstate} # (_, tb) = SetObjectRec id1 ot1 objrec1 (getGameObjectHandleLS_spriteids` obj) tb = (data, tb) | otherwise = (data, tb) where doCollision :: !InstanceID !(GameObjectHandleLS .gs) !GameObjectRec !DirectionSet !Int !GameObjectRec !.gs -> (!GameObjectHandleLS .gs,!GameObjectRec,.gs) doCollision id (GameObjectHandleLS obj=:{instances`,collide`}) objrec1 bounds ot2 objrec2 gst # maybestate = findinstance instances` id | isNothing maybestate = (GameObjectHandleLS obj,objrec1,gst) # state = fromJust maybestate # {st=s,or=objrec1,gs=gst} = collide` bounds ot2 objrec2 {st=state,or=objrec1,gs=gst} # newinstances = updateinstance id s instances` # obj = {obj & instances`=newinstances} = (GameObjectHandleLS obj,objrec1,gst) // = ({obj & instances`=newinstances},objrec1,gst) handleKeyDown :: !Int !InstanceID !Int !v:(OSGameData u:gs) !*OSToolbox -> (!v:OSGameData u:gs, !*OSToolbox), [v<=u] handleKeyDown objtype id key data=:{gamest,gamehnd} tb # maybefound = getobject objtype gamehnd | isJust maybefound # obj = fromJust maybefound # (_, _, objrec, tb) = GetObjectRec id tb # gst = toGSt gamest tb # (obj,objrec,gst) = doKeyDown id obj objrec key gst # (newstate, tb) = fromGSt gst # data = {data & gamehnd = putobject obj gamehnd,gamest=newstate} # (_, tb) = SetObjectRec id objtype objrec (getGameObjectHandleLS_spriteids` obj) tb = (data, tb) | otherwise = (data, tb) where doKeyDown :: !InstanceID !(GameObjectHandleLS .gs) !GameObjectRec !Int !.gs -> (!GameObjectHandleLS .gs,!GameObjectRec,.gs) doKeyDown id (GameObjectHandleLS obj=:{instances`,keydown`}) objrec key gst # maybestate = findinstance instances` id | isNothing maybestate = (GameObjectHandleLS obj,objrec,gst) # state = fromJust maybestate # {st=s,or=objrec,gs=gst} = keydown` key {st=state,or=objrec,gs=gst} # newinstances = updateinstance id s instances` # obj = {obj & instances`=newinstances} = (GameObjectHandleLS obj,objrec,gst) // = ({obj & instances`=newinstances},objrec,gst) handleKeyUp :: !Int !InstanceID !Int !v:(OSGameData u:gs) !*OSToolbox -> (!v:OSGameData u:gs, !*OSToolbox), [v<=u] handleKeyUp objtype id key data=:{gamest,gamehnd} tb # maybefound = getobject objtype gamehnd | isJust maybefound # obj = fromJust maybefound # (_, _, objrec, tb) = GetObjectRec id tb # gst = toGSt gamest tb # (obj,objrec,gst) = doKeyUp id obj objrec key gst # (newstate, tb) = fromGSt gst # data = {data & gamehnd = putobject obj data.gamehnd,gamest=newstate} # (_, tb) = SetObjectRec id objtype objrec (getGameObjectHandleLS_spriteids` obj) tb = (data, tb) | otherwise = (data, tb) where doKeyUp :: !InstanceID !(GameObjectHandleLS .gs) !GameObjectRec !Int !.gs -> (!GameObjectHandleLS .gs,!GameObjectRec,.gs) doKeyUp id (GameObjectHandleLS obj=:{instances`,keyup`}) objrec key gst # maybestate = findinstance instances` id | isNothing maybestate = (GameObjectHandleLS obj,objrec,gst) # state = fromJust maybestate # {st=s,or=objrec,gs=gst} = keyup` key {st=state,or=objrec,gs=gst} # newinstances = updateinstance id s instances` # obj = {obj & instances`=newinstances} = (GameObjectHandleLS obj,objrec,gst) // = ({obj & instances`=newinstances},objrec,gst)