Skip to content
GitLab
Commit 3849087f authored by Peter Achten's avatar Peter Achten
Browse files

Initial import

parent de46ede0
Expand all Hide whitespace changes
Inline Side-by-side
ObjectIO/GameLib/Clean System Files/ddraw_library 0 → 100644
View file @ 3849087f
ddraw.dll
LoadImageA@24
GetModuleHandleA@4
DirectDrawCreate@12
DirectDrawEnumerateA@8
ObjectIO/GameLib/GameFunctions.dcl 0 → 100644
View file @ 3849087f
definition module GameFunctions
// Version 1.0
import gameintrface_12, osgame
from StdIOBasic import Point2
// game result codes (GRESULT)
GR_OK :== 0
GR_FAILED :== -1 // very unlikely errors
GR_OS_ERROR :== -2 // OS specific error
GR_INVALID_BITMAP_ID :== -3 // bitmap ID doesn't exist or already used
GR_INVALID_SPRITE_ID :== -4 // sprite ID not found
GR_INVALID_MAP_ID :== -5 // layer map ID is invalid
GR_NOT_FOUND :== -6 // file or resource not found
InitGameBitmap :: !BID !{#Char} !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
GameBitmapDone :: !BID !*OSToolbox -> (!GRESULT, !*OSToolbox)
ClearAllGameBitmaps :: !*OSToolbox -> (!GRESULT, !*OSToolbox)
SetTransparentColor :: !BID Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitBlockSequence :: !BID (!SEQID, [(Int,Int)]) !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitGameLayerMap :: !MAPID !BID [{#Int}] !Bool !*OSToolbox -> (!GRESULT, !*OSToolbox)
GameLayerMapDone :: !MAPID !*OSToolbox -> (!GRESULT, !*OSToolbox)
// OSGameData gs should only contain the current level here!
RunGameEngine :: (OSGameData gs) !*OSToolbox -> (gs, !*OSToolbox)
SetGameBoundMap :: !Int !Int [{#Int}] !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
MoveScreenTo :: Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitSpriteAnimation :: !BID [(Int,Int)] !Bool !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitGameObject :: !ObjectType !SubType !Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox)
SetObjectFocus :: !Int !Int !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
// modified 01/11/99
CreateUserEvent :: !Int !Int !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
/*
ShowStatistic :: !Int !Int !{#Char} !Int !Colour !{#Char} !Int !Bool !Bool !Bool !Int !Int !Colour !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
*/
PlayMusic :: !{#Char} !Bool !*OSToolbox -> (!GRESULT, !*OSToolbox)
StopMusic :: !*OSToolbox -> (!GRESULT, !*OSToolbox)
ObjectIO/GameLib/GameFunctions.icl 0 → 100644
View file @ 3849087f
implementation module GameFunctions
// Version 1.0
import StdArray, StdList, StdString
import osgame
// game result codes (GRESULT)
GR_OK :== 0
GR_FAILED :== -1 // very unlikely errors
GR_OS_ERROR :== -2 // OS specific error
GR_INVALID_BITMAP_ID :== -3 // bitmap ID doesn't exist or already used
GR_INVALID_SPRITE_ID :== -4 // sprite ID not found
GR_INVALID_MAP_ID :== -5 // layer map ID is invalid
GR_NOT_FOUND :== -6 // file or resource not found
// BinaryIntStr :: !Int -> {#Char}
// BinaryIntStr x = OSBinaryIntStr x
BinaryIntListStr :: [[Int]] -> {#Char}
BinaryIntListStr [] = ""
BinaryIntListStr [x:xs] = IntListStr x +++ BinaryIntListStr xs
IntListStr :: [Int] -> {#Char}
IntListStr [] = ""
IntListStr [x:xs] = OSBinaryIntStr x +++ IntListStr xs
MapWidth :: [{#Int}] -> Int
MapWidth [] = 0
MapWidth [x:xs] = size x
MapHeight :: [a] -> Int
MapHeight x = length x
TupleStr :: (Int,Int) -> {#Char}
TupleStr (x,y) = OSBinaryIntStr x +++ OSBinaryIntStr y
TupleListStr :: [(Int,Int)] -> {#Char}
TupleListStr [] = ""
TupleListStr [t:ts] = TupleStr t +++ TupleListStr ts
InitGameBitmap :: !BID !{#Char} !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitGameBitmap id name width height blockwidth blockheight tb
= OSInitGameBitmap id name width height blockwidth blockheight tb
GameBitmapDone :: !BID !*OSToolbox -> (!GRESULT, !*OSToolbox)
GameBitmapDone id tb
= OSGameBitmapDone id tb
ClearAllGameBitmaps :: !*OSToolbox -> (!GRESULT, !*OSToolbox)
ClearAllGameBitmaps tb
= OSClearAllGameBitmaps tb
SetTransparentColor :: !BID Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox)
SetTransparentColor id p tb
= OSSetTransparentColor id p.x p.y tb
InitBlockSequence :: !BID (!SEQID, [(Int,Int)]) !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitBlockSequence bid (seqid, seq) tb
= OSInitBlockSequence bid seqid (TupleListStr seq) tb
InitGameLayerMap :: !MAPID !BID [{#Int}] !Bool !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitGameLayerMap mapid bid levelmap tile tb
= OSInitGameLayerMap mapid bid (OSIntListArrayToString levelmap)
(MapWidth levelmap) (MapHeight levelmap) tile tb
GameLayerMapDone :: !MAPID !*OSToolbox -> (!GRESULT, !*OSToolbox)
GameLayerMapDone mapid tb
= OSGameLayerMapDone mapid tb
RunGameEngine :: (OSGameData gs) !*OSToolbox -> (gs, !*OSToolbox)
RunGameEngine gd tb
= OSRunGameEngine gd tb
SetGameBoundMap :: !Int !Int [{#Int}] !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
SetGameBoundMap w h boundmap objstart startobjx startobjy tb
= OSSetGameBoundMap w h (OSIntListArrayToString boundmap)
(MapWidth boundmap) (MapHeight boundmap) objstart startobjx startobjy tb
MoveScreenTo :: Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox)
MoveScreenTo p tb
= OSMoveScreenTo p.x p.y tb
InitSpriteAnimation :: !BID [(Int,Int)] !Bool !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitSpriteAnimation bid seq loop tb
= OSInitSpriteAnimation bid (TupleListStr seq) loop tb
InitGameObject :: !ObjectType !SubType !Point2 !*OSToolbox -> (!GRESULT, !*OSToolbox)
InitGameObject ot st p tb
= OSInitGameObject ot st p tb
SetObjectFocus :: !Int !Int !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
SetObjectFocus x1 y1 x2 y2 maxxv maxyv tb
= OSSetObjectFocus x1 y1 x2 y2 maxxv maxyv tb
// modified 01/11/99
CreateUserEvent :: !Int !Int !Int !Int !Int !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
CreateUserEvent ev evpar1 evpar2 dest subdest time tb
= OSCreateUserEvent ev evpar1 evpar2 dest subdest time tb
/*
ShowStatistic :: !Int !Int !{#Char} !Int !Colour !{#Char} !Int !Bool !Bool !Bool !Int !Int !Colour !Int !*OSToolbox -> (!GRESULT, !*OSToolbox)
ShowStatistic x y format value color font size bold italic shadow sx sy scolor options tb
= OSShowStatistic x y format value color font size bold italic shadow sx sy scolor options tb
*/
PlayMusic :: !{#Char} !Bool !*OSToolbox -> (!GRESULT, !*OSToolbox)
PlayMusic midifile restart tb
= OSPlayMusic midifile restart tb
StopMusic :: !*OSToolbox -> (!GRESULT, !*OSToolbox)
StopMusic tb
= OSStopMusic tb
ObjectIO/GameLib/StdGSt.dcl 0 → 100644
View file @ 3849087f
definition module StdGSt
from gst import GSt, appGSt, accGSt
ObjectIO/GameLib/StdGSt.icl 0 → 100644
View file @ 3849087f
implementation module StdGSt
ObjectIO/GameLib/StdGame.dcl 0 → 100644
View file @ 3849087f
definition module StdGame
import StdInt, StdString
from StdIOCommon import ErrorReport,
NoError, ErrorViolateDI, ErrorIdsInUse, ErrorUnknownObject, OtherError
from StdPSt import PSt, IOSt
import StdGameDef
from osgame import GRESULT // PA: this type should be shielded
/* predefined bounds */
BND_MAP_CODES :== (1 << 30)
BND_STATIC_BOUNDS :== (1 << 31)
/* skipmove constant */
SK_FOREVER :== (~1)
:: NoState
= NoState
OpenGame :: gs (Game gs) [GameAttribute gs] !(PSt .l .p) -> (ErrorReport, !PSt .l .p)
CreateGameBitmap :: !GameBitmap !(GSt .gs) -> (!GRESULT, !GSt .gs)
CreateAnimation :: !Sprite !(GSt .gs) -> (!GRESULT, !GSt .gs)
CreateNewGameObject :: !ObjectType !SubType !Point2 !(GSt .gs) -> (!GRESULT, !GSt .gs)
:: ObjectFocus
= { scrollleft :: Int
, scrollup :: Int
, scrollright :: Int
, scrolldown :: Int
, maxxscrollspeed :: Int
, maxyscrollspeed :: Int
}
instance zero ObjectFocus
CreateObjectFocus :: !ObjectFocus !(GSt .gs) -> (!GRESULT, !GSt .gs)
:: EventTarget
= Self | AllObjects | BoundType Bounds
// modified 01/11/99
CreateUserGameEvent :: !EventType !EventPar !EventPar !EventTarget !SubType !GameTime !(GSt .gs) -> (!GRESULT, !GSt .gs)
// added 01/11/99
ANY_SUBTYPE :== (~1)
MAX_VOLUME :== 10000
MIN_VOLUME :== 0
:: Volume
:== Int
PAN_LEFT :== ~10000
PAN_CENTER :== 0
PAN_RIGHT :== 10000
:: Pan
:== Int
DEFAULT_FREQUENCY :== 0
:: Frequency
:== Int
PlaySoundSample :: !SoundID !Volume !Pan !Frequency !GameTime !(GSt .gs) -> (!GRESULT, !GSt .gs)
GetBoundMap :: !Int !Int !(GSt .gs) -> (!GRESULT, !(!Int, !DirectionSet), !GSt .gs)
SetBoundMap :: !Int !Int (!Int, !DirectionSet) !(GSt .gs) -> (!GRESULT, !GSt .gs)
defaultInitObject :: .Size .a .Int .Point2 .GameTime !*(GSt .b) -> (!(.a,!.ObjectRec),!*GSt .b)
defaultGameObject :: .Int .Size b -> .Object *(GSt .c)
defaultObjectRec :: .Int .Point2 .Size .GameTime !*(GSt .a) -> (!.ObjectRec,!*GSt .a)
BlankScreen :: Level (GSt gs)
defaultShadow :: Int -> Shadow
defaultMovement :: Movement
defaultScrollMovement :: Int -> Movement
alignCentered :: Alignment
ObjectIO/GameLib/StdGame.icl 0 → 100644
View file @ 3849087f
implementation module StdGame
import StdArray, StdBool, StdClass, StdInt, StdList, StdMisc
import StdId
import fixed, GameFunctions, gamehandle, gameutils, gst
from gameobjectutils import toBoundMapCode, fromBoundMapCode
from StdPSt import appPIO, accPIO
from iostate import setIOToolbox, getIOToolbox
import windowcreate, windowdevice
from windowaccess import initWindowHandle
from windowvalidate import validateWindowId
from oswindow import OSNoWindowPtr
/* predefined bounds */
BND_MAP_CODES :== (1 << 30)
BND_STATIC_BOUNDS :== (1 << 31)
/* skipmove constant */
SK_FOREVER :== (~1)
:: NoState
= NoState
OpenGame :: gs (Game gs) [GameAttribute gs] !(PSt .l .p) -> (ErrorReport, !(PSt .l .p))
OpenGame gs gdef attr ps
# (wId, ps) = accPIO openId ps
# size = findSize attr {w=320,h=240}
# bpp = findBPP attr 8
# (_, ps) = OpenGameWindow wId size bpp True ps
# (tb,ps) = accPIO getIOToolbox ps
# gst = toGSt gs tb
# (initLevel,gst) = gdef.nextlevel gst
# (gs,tb) = fromGSt gst
# (_, tb) = PlayLevels initLevel gs gdef tb
# ps = appPIO (setIOToolbox tb) ps
= (NoError, ps)
where
findSize :: [GameAttribute gs] Size -> Size
findSize [] s = s
findSize [(ScreenSize x):xs] s = x
findSize [x:xs] s = findSize xs s
findBPP :: [GameAttribute gs] Int -> Int
findBPP [] s = s
findBPP [(ColorDepth x):xs] s = x
findBPP [x:xs] s = findBPP xs s
// always full screen, game in a window not implemented yet
OpenGameWindow :: !Id !Size !Int !Bool !(PSt .l .p) -> (!ErrorReport, !PSt .l .p)
OpenGameWindow id gamewindowsize bitsperpixel fullscreen pState
# pState = WindowFunctions.dOpen pState
# (isZero,pState) = accPIO checkZeroWindowBound pState
| isZero
= (ErrorViolateDI,pState)
# maybe_id = Just id
# (maybe_okId,ioState) = validateWindowId maybe_id pState.io
| isNothing maybe_okId
= (ErrorIdsInUse,{pState & io=ioState})
| otherwise
# pState = {pState & io=ioState}
info = { gamewindowDDPtr = OSNoWindowPtr
, gamewindowCDepth = bitsperpixel
, gamewindowSize = gamewindowsize
, gamewindowFullScreen = fullscreen
}
okId = fromJust maybe_okId
# wH = initWindowHandle "" Modeless IsGameWindow (GameWindowInfo info) [] [WindowId okId]
# pState = openwindow okId {wlsState=undef, wlsHandle=wH} pState
# pState = appPIO decreaseWindowBound pState
= (NoError,pState)
PlayLevels :: Int gs (Game gs) !*OSToolbox -> (ErrorReport, !*OSToolbox)
PlayLevels level gs gdef tb
| level == 0
= (NoError, tb)
# ghnd = createGameHandle gdef
# (_, gs, tb) = PlayLevel level gs ghnd tb
# gst = toGSt gs tb
# (nextlevel, gst) = gdef.nextlevel gst
# (gs,tb) = fromGSt gst
= PlayLevels nextlevel gs gdef tb
FindMaxID :: a [a] -> a | < a
FindMaxID x [] = x
FindMaxID x [y:ys]
| y > x = FindMaxID y ys
| otherwise = FindMaxID x ys
InitLayers :: [Layer] [BID] [MAPID] !*OSToolbox -> ([BID], [MAPID], !*OSToolbox)
InitLayers [] bids mapids tb = (bids, mapids, tb)
InitLayers [l:ls] bids mapids tb
# (bids, mapids, tb) = InitLayer l bids mapids tb
= InitLayers ls bids mapids tb
MaybeSetTransparentColor :: BID (Maybe Point2) !*OSToolbox -> (GRESULT, !*OSToolbox)
MaybeSetTransparentColor _ Nothing tb = (GR_OK, tb)
MaybeSetTransparentColor bid (Just p) tb = SetTransparentColor bid p tb
MovementFunctions :: [Layer] -> [(Movement)]
MovementFunctions [] = []
MovementFunctions [l:ls] = [l.movement] ++ (MovementFunctions ls)
InitLayer :: Layer [BID] [MAPID] !*OSToolbox -> ([BID], [MAPID], !*OSToolbox)
InitLayer l bids mapids tb
# (newbid, tb) = InitGameBitmap 0 b.bitmapname (us.w * nh) (us.h * nv) us.w us.h tb // newbid
# (_, tb) = MaybeSetTransparentColor newbid b.transparent tb
# tb = InitBlockSequences newbid l.sequences tb
# (_, tb) = InitGameLayerMap newmapid newbid l.layermap True tb // l.tile
= (bids++[newbid], mapids++[newmapid], tb)
where
b = l.bmp
us = b.unitsize
(nh, nv) = b.dimensions
newmapid = ((FindMaxID 0 mapids) + 1)
InitBlockSequences :: BID [TileSequence] !*OSToolbox -> !*OSToolbox
InitBlockSequences bid [] tb = tb
InitBlockSequences bid [s:ss] tb
# (_, tb) = InitBlockSequence bid s tb
= InitBlockSequences bid ss tb
LayersDone :: [BID] [MAPID] !*OSToolbox -> !*OSToolbox
LayersDone bids mapids tb
# tb = MapsDone mapids tb
# tb = BitmapsDone bids tb
= tb
MapsDone :: [MAPID] !*OSToolbox -> !*OSToolbox
MapsDone [] tb = tb
MapsDone [m:ms] tb
# (_, tb) = GameLayerMapDone m tb
= MapsDone ms tb
BitmapsDone :: [BID] !*OSToolbox -> !*OSToolbox
BitmapsDone [] tb = tb
BitmapsDone [b:bs] tb
# (_, tb) = GameBitmapDone b tb
= BitmapsDone bs tb
PlayLevel :: Int gs (GameHandle gs) !*OSToolbox -> (ErrorReport, gs,!*OSToolbox)
PlayLevel levelnumber gs gamehnd tb
# (_, tb) = SetGameBoundMap wid ht bm os stx sty tb
# (_, tb) = MoveScreenTo curLevelHnd.initpos` tb
# lyrs = curLevelHnd.layers`
# (bids, mapids, tb) = InitLayers lyrs [] [] tb
# movements = zip2 mapids (MovementFunctions lyrs)
# (_, tb) = initsoundsamples curLevelHnd.soundsamples` tb
# tb = maybePlayMusic curLevelHnd.music` tb
# gst = toGSt gs tb
# firstlevel = curLevelHnd
# (obj, gst) = convertallobjsprites firstlevel.objects` gst
# firstlevel = {firstlevel & objects` = obj}
# curgamehnd = {gamehnd & levels` = [firstlevel]}
# (gs,tb) = fromGSt gst
# (_, tb) = OSGameLevelOptions fill rgb esc dbg fdin fdout tb
# (gs, tb) = RunGameEngine { scroll = movements
, gamestate = gs
, gamehnd = curgamehnd} tb
# tb = maybeStopMusic curLevelHnd.music` tb
# (_, tb) = OSInitSoundSample (~1) "" 0 tb // remove samples
# tb = LayersDone bids mapids tb
# (_, tb) = ClearAllGameBitmaps tb
= (NoError, gs, tb)
where
curLevelHnd = gamehnd.levels`!!(levelnumber-1)
options = curLevelHnd.leveloptions`
{ map = bm,
blocksize = bs,
objstart = os,
startobjx = stx,
startobjy = sty} = curLevelHnd.boundmap`
{ w = wid, h = ht } = bs
maybePlayMusic :: (Maybe Music) !*OSToolbox -> !*OSToolbox
maybePlayMusic Nothing tb = tb
maybePlayMusic (Just m) tb
# (_, tb) = PlayMusic m.musicfile m.restart tb
= tb
maybeStopMusic :: (Maybe Music) !*OSToolbox -> !*OSToolbox
maybeStopMusic Nothing tb = tb
maybeStopMusic (Just m) tb
| m.continue
= tb
# (_, tb) = StopMusic tb
= tb
esc = options.escquit
dbg = options.debugscroll
fdin = options.fadein
fdout = options.fadeout
rgb :: Colour
rgb = if fill
(fromJust options.fillbackground)
(RGB {r= ~1, g= ~1, b= ~1})
fill = (isJust options.fillbackground)
initsoundsamples sndlist gs
= map2 initsoundsample sndlist gs
initsoundsample sample gs
= OSInitSoundSample sample.soundid sample.soundfile sample.soundbuffers gs
convertallobjsprites obj gst = map2 convertobjsprites obj gst
where
convertobjsprites obj gst
# (sprids, gst) = convertsprites obj.sprites` gst
= ({obj & spriteids` = sprids}, gst)
//convertsprites :: ![Sprite] !.(GSt .gs) -> (![SpriteID], !.(GSt .gs))
convertsprites spr gst
# (idlst, gst) = map2 CreateAnimation spr gst
# idlst = map (~) idlst
= (idlst, gst)
CreateGameBitmap :: !GameBitmap !(GSt .gs) -> (!GRESULT, !GSt .gs)
CreateGameBitmap bitmap=:{bitmapname, unitsize, dimensions, transparent} gst
# (bid, gst) = accGStTb (InitGameBitmap 0 bitmapname (w * nh) (h * nv) w h) gst
# (_, gst) = accGStTb (MaybeSetTransparentColor bid transparent) gst
= (bid, gst)
where
w = unitsize.w
h = unitsize.h
(nh,nv) = dimensions
CreateAnimation :: !Sprite !(GSt .gs) -> (!GRESULT, !GSt .gs)
CreateAnimation sprite=:{bitmap, sequence, loop} gst
# (bid, gst) = CreateGameBitmap bitmap gst
# (sprid, gst) = accGStTb (InitSpriteAnimation bid sequence loop) gst
= (~sprid, gst)
CreateNewGameObject :: !ObjectType !SubType !Point2 !(GSt .gs) -> (!GRESULT, !GSt .gs)
CreateNewGameObject ot st p gst
= accGStTb (InitGameObject ot st p) gst
:: ObjectFocus
= { scrollleft :: Int
, scrollup :: Int
, scrollright :: Int
, scrolldown :: Int
, maxxscrollspeed :: Int
, maxyscrollspeed :: Int
}
instance zero ObjectFocus
where
zero = { scrollleft = 0
, scrollup = 0
, scrollright = 0
, scrolldown = 0
, maxxscrollspeed = 0
, maxyscrollspeed = 0
}
CreateObjectFocus :: !ObjectFocus !(GSt .gs) -> (!GRESULT, !GSt .gs)
CreateObjectFocus o gst
= accGStTb (SetObjectFocus o.scrollleft o.scrollup o.scrollright
o.scrolldown o.maxxscrollspeed o.maxyscrollspeed) gst
MAX_VOLUME :== 10000
MIN_VOLUME :== 0
:: Volume
:== Int
PAN_LEFT :== ~10000
PAN_CENTER :== 0
PAN_RIGHT :== 10000
:: Pan
:== Int
DEFAULT_FREQUENCY :== 0
:: Frequency
:== Int
PlaySoundSample :: !SoundID !Volume !Pan !Frequency !GameTime !(GSt .gs) -> (!GRESULT, !GSt .gs)
PlaySoundSample id vol pan freq delay gst
= accGStTb (OSPlaySoundSample id (vol - 10000) pan freq delay) gst
:: EventTarget
= Self | AllObjects | BoundType Bounds
EventTargetToInt :: EventTarget ->