Code: Select all
EnableExplicit
Declare SETSCREEN(w,h,bFullScreen.b)
#MAX_SPRITES = 65535
#MAX_SOUNDS = 65535
#MAX_FONTS = 65535
#NOT_FOUND = -1
#PATH = "Data/"
#SPRITEPATH = #PATH+"Sprites/"
#MUSICPATH = #PATH+"Music/"
#SOUNDPATH = #PATH+"Sounds/"
Enumeration ERROR
#CMP_OK = 0
#CMP_FOR_WITHOUT_NEXT
#CMP_SYNTAX_ERROR
#CMP_NO_FILE
#CMP_WRONG_ARGUMENT
#CMP_STRING_TOO_LONG
#CMP_DIVISION_BY_ZERO
#CMP_OUT_OF_MEMORY
#CMP_WRONG_DIMENSION
#CMP_OUT_OF_DIMENSION
#CMP_NO_MODULE_FILENAME
#CMP_INVALID_INDEX
#CMP_STARTDRAWINGFAILED
#CMP_ALREADY_INITIALISED
#CMP_FILE_ERROR
#CMP_OUT_OF_DATA
#CMP_ASSERTION_FAILED
#CMP_INDEX_EXCEEDED
#CMP_NO_SPRITE
#CMP_NO_FONT
#CMP_NO_LABEL
#CMP_NO_USERCLASS
#CMP_LABEL_NOT_FOUND
#CMP_LABEL_ALREADY_PRESENT
#CMP_INITIALISATION_FAILED
EndEnumeration
Enumeration
#AREA_SPRITES = 1
#AREA_STANDARDFONTS = 2
#AREA_SCREENS = 4
#AREA_SOUNDS = 8
#AREA_VECTORS = 16
#AREA_PROFONTS = 32
#AREA_PARTICLES = 64
#AREA_FILES = 128
#AREA_INI = 256
#AREA_MODULE = 512
#AREA_ALL = #AREA_SPRITES | #AREA_STANDARDFONTS | #AREA_SCREENS | #AREA_SOUNDS | #AREA_VECTORS | #AREA_PROFONTS | #AREA_PARTICLES | #AREA_FILES | #AREA_INI | #AREA_MODULE
EndEnumeration
Structure __RECT
x.l
y.l
w.l
h.l
EndStructure
Structure __RECT2D
x.l
y.l
EndStructure
; Sprite structure
Structure __sprite
id.l
width.l
height.l
cellWidth.l
cellHeight.l
isAnim.b
Array rect.__RECT(0)
EndStructure
Structure __sound
id.l
EndStructure
Structure __font
id.l
EndStructure
Global Dim sprites.__sprite(0)
Global Dim sounds.__sound(0)
Global Dim fonts.__font(0)
Global __autoPause.b = #False
Global __commandLine.s = ""
Global __errorCode = #CMP_OK
Global __isRunning = #False ; Is the system running ?
Global __musicHandle = #NOT_FOUND
Global __miscSprite = 0 ; Sprite for drawing lines etc
Global __window = 0
Global __screen = #NOT_FOUND
Global __isFullScreen.b = #False
Global __keyboardPresent = #True
Global __clearScreenColour = RGB(0,0,0)
Global __numDesktops = 0
Global __DG_RESX = 0
Global __DG_RESY = 0
Global AppTime_UPS.f = 0.0
Global AppTime_Iterator.f = 0.0
Global AppTime_CurrentTime.f = 0.0
Global AppTime_PauseStart.b = #False
Global AppTime_Speed.f = 0.0
Global AppTime_DesiredLoopTime.f = 0.0
Global AppTime_LastUpdateTime.f = 0.0
Global AppTime_LastUPSTime.f = 0.0
Global AppTime_DesiredFrequency = 0.0
Declare UNLOAD(flags1,flags2)
Declare RenderFrame()
; Program end
Procedure __EndProgram()
UNLOAD(#AREA_ALL,#AREA_ALL)
; Shut everything down
CloseScreen()
If __window>0
CloseWindow(WindowID(__window))
__window=#NOT_FOUND
EndIf
End
EndProcedure
; Error
Procedure __Error(errorIndex)
__errorCode=errorIndex
If __errorCode=#CMP_OK
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
; Standard fonts
Procedure ExpandFonts(index)
Define prevSize.l
Define loop.l
prevSize=ArraySize(fonts())
Debug "Prev size : "+prevSize
If index<prevSize
If fonts(index)\id>=0
FreeFont(fonts(index)\id)
fonts(index)\id=#NOT_FOUND
EndIf
Else
Debug "Index : "
Debug index
ReDim fonts(index+1)
For loop=prevSize To ArraySize(fonts())
fonts(loop)\id=#NOT_FOUND
Next
EndIf
ProcedureReturn #True
EndProcedure
; Sprites
Procedure ExpandSprites(index)
Define prevSize.l
Define loop.l
prevSize=ArraySize(sprites())
Debug "Prev size : "+prevSize
If index<prevSize
If sprites(index)\id>=0
FreeSprite(sprites(index)\id)
sprites(index)\id=#NOT_FOUND
sprites(index)\isAnim=#False
sprites(index)\cellWidth=0
sprites(index)\cellHeight=0
Dim sprites(index)\rect(0)
EndIf
Else
Debug "Index : "
Debug index
ReDim sprites(index+1)
For loop=prevSize To ArraySize(sprites())
sprites(loop)\id=#NOT_FOUND
sprites(loop)\width=0;
sprites(loop)\height=0;
sprites(loop)\isAnim=#False
sprites(loop)\cellWidth=0
sprites(loop)\cellHeight=0
Dim sprites(loop)\rect(0)
Next
EndIf
ProcedureReturn #True
EndProcedure
; Sounds
Procedure ExpandSounds(index)
Define prevSize.l
Define loop.l
prevSize=ArraySize(sounds())
If index<prevSize
If sounds(index)\id>=0
FreeSound(sounds(index)\id)
sounds(index)\id=#NOT_FOUND
EndIf
Else
ReDim sounds(index+1)
For loop=prevSize To ArraySize(sounds())
sounds(loop)\id=#NOT_FOUND
Next
EndIf
ProcedureReturn #True
EndProcedure
Procedure AUTOPAUSE(pause)
__autoPause=pause
EndProcedure
Procedure.s GETCOMMANDLINE_Str()
ProcedureReturn __commandLine
EndProcedure
Procedure.i LENF(value.d)
ProcedureReturn Len(StrD(value))
EndProcedure
Procedure.i LENI(value.i)
ProcedureReturn Len(Str(value))
EndProcedure
Procedure.s LTRIM_Str(value.s)
While Left(value,1)=" "
value=Mid(value,2)
Wend
ProcedureReturn value
EndProcedure
Procedure.s RTRIM_Str(value.s)
While Right(value,1)=" "
value=Left(value,Len(value)-1)
Wend
ProcedureReturn value
EndProcedure
Procedure.i SPLITSTR(text.s,Array store.s(1),splitter.s,skipEmpty=#False)
Define start
Define ed
Define temp.s
Define prevSize
Dim store(0)
start=1
ed=FindString(text,splitter)
While ed<>0
temp=Mid(text,start,ed-start)
If (temp<>"") Or (temp="" And skipEmpty=#False)
prevSize=ArraySize(store())
ReDim store(prevSize+1)
store(prevSize)=temp
EndIf
start=ed+1
ed=FindString(text,splitter,start)
Wend
temp=Mid(text,start)
If (temp<>"") Or (temp="" And skipEmpty=#False)
prevSize=ArraySize(store())
ReDim store(prevSize+1)
store(prevSize)=temp
EndIf
ProcedureReturn ArraySize(store())
EndProcedure
Procedure SEEDRND(value)
RandomSeed(value)
EndProcedure
Procedure RND(minv,maxv)
ProcedureReturn Random(minv,maxv)
EndProcedure
Procedure.s GETENV_Str(name.s)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
If ExamineEnvironmentVariables()
While ExamineEnvironmentVariables()
If EnvironmentVariableName()=name
ProcedureReturn EnvironmentVariableValue()
EndIf
Wend
EndIf
CompilerEndIf
ProcedureReturn ""
EndProcedure
Procedure PUTENV(name.s,value.s)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
SetEnvironmentVariable(name,value)
CompilerEndIf
EndProcedure
Procedure CREATEDIR(name.s)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
ProcedureReturn CreateDirectory(name)
CompilerElse
ProcedureReturn #False
CompilerEndIf
EndProcedure
Procedure KILLFILE(name.s)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
ProcedureReturn DeleteFile(name)
CompilerElse
ProcedureReturn #False
CompilerEndIf
EndProcedure
Procedure DOESFILEEXIST(name.s)
Define result
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
result=FileSize(name)
If result<0
result=0
EndIf
CompilerElse
result=#True ; It should exist on a server somewhere...
CompilerEndIf
ProcedureReturn result
EndProcedure
Procedure.s GETCURRENTDIR_Str()
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
ProcedureReturn GetCurrentDirectory()
CompilerElse
ProcedureReturn ""
CompilerEndIf
EndProcedure
Procedure SETCURRENTDIR(dir.s)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
ProcedureReturn SetCurrentDirectory(dir)
CompilerElse
ProcedureReturn #False
CompilerEndIf
EndProcedure
Procedure.s CHR_Str(v)
ProcedureReturn Chr(v)
EndProcedure
Procedure.s DECTOHEX_Str(v)
ProcedureReturn Hex(v)
EndProcedure
Procedure HEXTODEC(hex.s)
ProcedureReturn Val("$"+hex)
EndProcedure
Procedure.s URLDECODE(text.s)
ProcedureReturn URLDecoder(text)
EndProcedure
Procedure.s URLENCODE(text.s)
ProcedureReturn URLEncoder(text)
EndProcedure
Procedure PI()
ProcedureReturn 3.141592653589793
EndProcedure
Procedure PI_180()
ProcedureReturn 0.017453292519943
EndProcedure
Procedure SGN(v)
If v<0
ProcedureReturn -1
ElseIf v=0
ProcedureReturn 0
Else
ProcedureReturn 1
EndIf
EndProcedure
Procedure FLOOR(v)
ProcedureReturn Round(v, #PB_Round_Down)
EndProcedure
Procedure CEIL(v)
ProcedureReturn Round(v, #PB_Round_Up)
EndProcedure
Procedure.s INKEY_Str()
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
ProcedureReturn Inkey()
CompilerElse
ProcedureReturn ""
CompilerEndIf
EndProcedure
Procedure SHELLCMD(cmdLine.s,wait.b,show.b,*retval)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
Define result
Define flags
flags=0
If wait
flags=flags | #PB_Program_Wait
EndIf
If show=#False
flags= flags | #PB_Program_Hide
EndIf
flags=flags | #PB_Program_Open
result=RunProgram(cmdLine,"","",flags)
If result
While ProgramRunning(result)
Delay(1)
Wend
*retval=ProgramExitCode(result)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
CompilerElse
ProcedureReturn #False
CompilerEndIf
EndProcedure
Procedure SHELLEND(cmdLine.s)
Define retval
SHELLCMD(cmdLine,#False,#True,@retval)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
End
CompilerElse
; Do something here
CompilerEndIf
EndProcedure
Procedure.b MOUSESTATE(*x,*y,*b1,*b2)
If ExamineMouse()
*x=MouseX()
*y=MouseY()
*b1=MouseButton(#PB_MouseButton_Left)
*b2=MouseButton(#PB_MouseButton_Right)
ProcedureReturn #True
Else
*x=-1
*y=-1
*b1=0
*b2=0
ProcedureReturn #False
EndIf
EndProcedure
Procedure MOUSEAXIS(which)
Select which
Case 0 ; X Relative
ProcedureReturn MouseDeltaX()
Case 1 ; Y Relative
ProcedureReturn MouseDeltaY()
Case 2 ; Mouse wheel
ProcedureReturn MouseWheel()
Case 3 ; Mouse wheel Y (Not used)
ProcedureReturn 0
Case 4 ; Left button
ProcedureReturn MouseButton(#PB_MouseButton_Left)
Case 5 ; Middle button
ProcedureReturn MouseButton(#PB_MouseButton_Middle)
Case 6 ; Right button
ProcedureReturn MouseButton(#PB_MouseButton_Right)
Default
ProcedureReturn 0
EndSelect
EndProcedure
Procedure SYSTEMPOINTER(show.b)
EndProcedure
Procedure SETTITLE(title.s)
SetWindowTitle(GetActiveWindow(),title)
EndProcedure
Procedure _OPENFILE(channel,fileName.s,mode)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure _CLOSEFILE(channel)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure _WRITEBYTE(channel,value.b)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure WRITEUBYTE(channel,value.c)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure _WRITEWORD(channel,value.b)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure WRITEUWORD(channel,value.c)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure _WRITELONG(channel,value.b)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure WRITEULONG(channel,value.c)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure WRITESHORTIEEE(channel,value.b)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure WRITEIEEE(channel,value.c)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure WRITESTR(channel,value.c)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure WRITELINE(channel,value.s)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure _READBYTE(channel,value.b)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure READUBYTE(channel,value.c)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure _READWORD(channel,value.b)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure READUWORD(channel,value.c)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure _READLONG(channel,value.b)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure READULONG(channel,value.c)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure READSHORTIEEE(channel,value.b)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure READIEEE(channel,value.c)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure READSTR(channel,value.c)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure READLINE(channel,value.s)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure FILEPOSITION(channel,type.b)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure _FILESEEK(channel,pos,direction,reading)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure ENDOFFILE(channel)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure GETFILESIZEHANDLE(channel)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure GETFILESIZ(fileName.s)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure GETFILELIST(wildcard.s,Array files.s(1),*numDir)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure GETFILE(handle,line)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure PUTFILE(handle,line,text.s)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
CompilerEndIf
EndProcedure
Procedure SLEEP(amount)
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
Delay(amount)
CompilerEndIf
EndProcedure
Procedure.s PLATFORMINFO_Str(which.s)
Select which
Case ""
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
Select OSVersion()
EndSelect
CompilerElse
ProcedureReturn "HTML5"
CompilerEndIf
Case "APPDATA"
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
ProcedureReturn GetHomeDirectory()
CompilerElse
CompilerEndIf
Case "BASEPATH"
Case "ID"
Case "DEVICE"
Case "DOCUMENTS"
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
ProcedureReturn GetHomeDirectory()+"/Documents"
CompilerElse
CompilerEndIf
Case "TIME"
ProcedureReturn FormatDate("%yyyy-%mm-%dd %hh:%ii:%ss",Date())
Case "COMPILED"
ProcedureReturn FormatDate("%yyyy-%mm-%dd %hh:%ii:%ss",#PB_Compiler_Date)
Case "VERSION"
Case "BATTERY"
ProcedureReturn "N/A"
Case "TEMP"
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
ProcedureReturn GetTemporaryDirectory()
CompilerElse
ProcedureReturn ""
CompilerEndIf
Case "UTCTIME"
; Do do
Case "DPI"
ProcedureReturn ""
EndSelect
EndProcedure
Procedure INSTR(s1.s,s2.s,start=-1,singleChars.b=#False)
Define value,loop
If Len(s1)=0 Or Len(s2)=0
ProcedureReturn #NOT_FOUND
EndIf
If start<1
start=1
EndIf
If start>Len(s1)
start=Len(s1)
EndIf
If singleChars=#False
value=FindString(s1,s2,start)
If value=0
ProcedureReturn #NOT_FOUND
Else
ProcedureReturn value
EndIf
Else
For loop=0 To Len(s2)-1
value=FindString(s1,Mid(s2,loop+1,1),start+loop)
If value>0
ProcedureReturn value
EndIf
Next
EndIf
EndProcedure
Procedure REVINSTR(s1.s,s2.s,start=-1,singleChars.b=#False)
Define result
result=INSTR(ReverseString(s1),ReverseString(s2),start,singleChars)
If result<>#NOT_FOUND
ProcedureReturn Len(s1)-result-Len(s2)+2
Else
ProcedureReturn result
EndIf
EndProcedure
Procedure CREATESCREEN(iScreen,iSprite,width,height)
EndProcedure
Procedure USESCREEN(which)
EndProcedure
Procedure USEASBMP()
EndProcedure
Procedure LOADBMP(fileName.s)
EndProcedure
Procedure SMOOTHSHADING(level)
EndProcedure
Procedure ALPHAMODE(amount)
EndProcedure
Procedure ALLOWESCAPE(iEscape.b)
EndProcedure
Procedure KEY(index)
If __keyboardPresent
If ExamineKeyboard()
ProcedureReturn KeyboardPushed(index)
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure GENSPRITE()
Define loop,size
size=ArraySize(sprites())
If size>=#MAX_SPRITES
ProcedureReturn #NOT_FOUND
Else
For loop=0 To size-1
If sprites(loop)\id=#NOT_FOUND
ProcedureReturn loop
EndIf
Next
ProcedureReturn size
EndIf
EndProcedure
Procedure GENFONT()
EndProcedure
Procedure GENFILE()
EndProcedure
Procedure GENSOUND()
EndProcedure
Procedure GENSCREEN()
EndProcedure
Procedure GENVECTOR()
EndProcedure
Procedure GENPARTICLE()
EndProcedure
Procedure GENPROFONT()
EndProcedure
Procedure.s REMOVEEXT(fileName.s,dot.s,sep.s)
Define lastdot,lastsep
If Len(fileName)=0
ProcedureReturn ""
EndIf
lastdot=REVINSTR(fileName,dot)
Debug "LD:"+lastdot
If Len(sep)>0
lastsep=REVINSTR(fileName,sep)
Debug "Lastsep : "+lastsep
Else
lastsep=-1
EndIf
If lastdot>=1
If lastsep>=1
If lastsep<lastdot
ProcedureReturn Left(fileName,lastdot-1)
EndIf
Else
ProcedureReturn Left(fileName,lastdot-1)
EndIf
EndIf
ProcedureReturn fileName
EndProcedure
Procedure LOADPROFONT(fileName.s,index)
EndProcedure
Procedure SETPROFONT(index)
EndProcedure
Procedure LOADPARTICLE(fileName.s,index)
EndProcedure
Procedure ADDPARTICLES(index,positionX,positionY)
EndProcedure
Procedure DISPLAYPARTICLES()
EndProcedure
Procedure.f CONSTRAIN(value.f,minV.f,maxV.f)
If value<minV
ProcedureReturn minV
ElseIf value>maxV
ProcedureReturn maxV
Else
ProcedureReturn value
EndIf
EndProcedure
Procedure.f WRAP(value.f,minRange.f,maxRange.f)
Define diff.f
diff=maxRange-minRange
If value>=minRange
If value<maxRange
ProcedureReturn value
ElseIf value<maxRange+diff
ProcedureReturn value-diff
EndIf
ElseIf value>=minRange-diff
ProcedureReturn value+diff
EndIf
ProcedureReturn Mod(value-minRange,diff)+minRange
EndProcedure
Procedure SETPROFONTSPRITE(fontIndex,spriteIndex)
EndProcedure
Procedure PRINTPROFONT(index,one,x,y,angle.f,xScale.f,yScale.f)
EndProcedure
Procedure SETPROFONTCOLOUR(colour.l)
EndProcedure
Procedure PRINTPROFONTTEXT(text.s,x,y,angle.f,xScale.f,yScale.f)
EndProcedure
Procedure GETPROFONTCHARSPACING()
EndProcedure
Procedure GETPROFONTLINESPACING()
EndProcedure
Procedure SETPROFONTCHARSPACING(amount)
EndProcedure
Procedure SETPROFONTLINESPACING(amount)
EndProcedure
Procedure.f PROFONTHEIGHT(index,scale.f,one)
EndProcedure
Procedure.f PROFONTWIDTH(index,scale.f,one)
EndProcedure
Procedure.f PROFONTWIDTHTEXT(index,scale.f,text.s)
EndProcedure
Procedure FONTCOLOUR(colour.l)
EndProcedure
Procedure _PRINT(text.s,x.f,y.f,kernel.b=#True)
If (StartDrawing(SpriteOutput(__miscSprite)))
DrawText(x,y,text)
StopDrawing()
EndIf
EndProcedure
Procedure GETNUMJOYSTICKS()
ProcedureReturn InitJoystick()
EndProcedure
Procedure GETJOYNAME_Str(index)
EndProcedure
Procedure FORCEFEEDBACK(index,duration.f,x_motor.f,y_motor.f)
EndProcedure
Procedure GETDIGIX(index,hatIndex)
EndProcedure
Procedure GETDIGIY(index,hatIndex)
EndProcedure
Procedure.f GETJOYX(index)
EndProcedure
Procedure.f GETJOYY(index)
EndProcedure
Procedure.f GETJOYZ(index)
EndProcedure
Procedure.f GETJOYO(index,which)
EndProcedure
Procedure.f GETJOYBUTTON(index)
EndProcedure
Procedure JOYSTATE(*jx,*jy,*b1,*b2,index)
If GETNUMJOYSTICKS()>0
If ExamineJoystick(index)
*jx=JoystickAxisX(index,0,#PB_Absolute)
*jy=JoystickAxisY(index,0,#PB_Absolute)
*b1=JoystickButton(index,0)
*b2=JoystickButton(index,1)
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure GETNUMBUTTONS(joyIndex)
EndProcedure
Procedure GETNUMHATS(joyIndex)
EndProcedure
Procedure _STOPSOUND(index)
EndProcedure
Procedure SOUNDPLAYING(index)
EndProcedure
Procedure HUSH()
If __musicHandle>0
StopMusic(__musicHandle)
__musicHandle=#NOT_FOUND
EndIf
EndProcedure
Procedure _PLAYSOUND(index,pan.f,volume.f)
Define result
If index>=0 And index<#MAX_SOUNDS
result=PlaySound(sounds(index)\id,volume)
If result>0
SoundPan(result,pan)
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure _LOADSOUND(fileName.s,index)
Define tempFileName.s
If index>=0 And index<#MAX_SOUNDS
ExpandSounds(index)
If Len(fileName)>0
tempFileName=#SOUNDPATH+fileName
sounds(index)\id=LoadSound(#PB_Any,tempFileName)
If sounds(index)\id<=0
ProcedureReturn #False
EndIf
EndIf
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure _LOADFONT(fileName.s,index)
If index>=0 And index<#MAX_FONTS
ExpandFonts(index)
If Len(fileName)>0
fonts(index)\id=LoadFont(#PB_Any,fileName,8)
If fonts(index)\id<=0
ProcedureReturn #False
EndIf
EndIf
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure _LOADSPRITE(fileName.s,index)
Define rect.RECT
If index>=0 And index<#MAX_SPRITES
ExpandSprites(index)
If Len(fileName)>0
Debug #SPRITEPATH+fileName
sprites(index)\id=LoadSprite(#PB_Any,#SPRITEPATH+fileName,#PB_Sprite_AlphaBlending | #PB_Sprite_PixelCollision)
Debug "Sprite ID : "
Debug sprites(index)\id
If sprites(index)\id<=0
ProcedureReturn #False
EndIf
sprites(index)\width=SpriteWidth(sprites(index)\id)
sprites(index)\height=SpriteHeight(sprites(index)\id)
sprites(index)\cellWidth=-1
sprites(index)\cellHeight=-1
sprites(index)\isAnim=#False
Dim sprites(index)\rect(1)
sprites(index)\rect(0)\x=0
sprites(index)\rect(0)\y=0
sprites(index)\rect(0)\w=sprites(index)\width-1
sprites(index)\rect(0)\h=sprites(index)\height-1
EndIf
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure LOADANIM(fileName.s,index,width,height)
Define tempFilename.s
If index>=0 And index<#MAX_SPRITES
ExpandSprites(index)
If Len(fileName)>0
tempFileName=#SPRITEPATH+fileName
sprites(index)\id=LoadSprite(#PB_Any,tempFileName,#PB_Sprite_AlphaBlending | #PB_Sprite_PixelCollision)
If sprites(index)\id>=0
sprites(index)\cellWidth=width
sprites(index)\cellHeight=height
sprites(index)\isAnim=#True
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndIf
EndIf
EndProcedure
Procedure LOADVECTOR(fileName.s,index)
EndProcedure
Procedure DISPLAYVECTOR(index,x,y,scale,angle)
EndProcedure
Procedure GETFONTSIZE(*x,*y)
EndProcedure
Procedure SETMOUSE(x,y)
MouseLocate(x,y)
EndProcedure
Procedure INILOAD(fileName.s)
EndProcedure
Procedure INISAVE(fileName.s)
EndProcedure
Procedure.s INIGET_Str(sectionName.s,key.s,defaultValue.s="")
EndProcedure
Procedure INIUPDATE(sectionName.s,key.s,value.s)
EndProcedure
Procedure INIADD(sectionName.s,key.s,value.s)
EndProcedure
Procedure LIMITFPS(frameRate.f=75.0)
SetFrameRate(frameRate)
AppTime_DesiredLoopTime=1000.0/frameRate
EndProcedure
Procedure SETTRANSPARENCY(colour.l)
EndProcedure
Procedure GETXHANDLE()
EndProcedure
Procedure GETYHANDLE()
EndProcedure
Procedure SPRITEHANDLE(xHandle,yHandle)
EndProcedure
Procedure DRAWANIM(id,index.f,x,y)
If id>=0 And id<#MAX_SPRITES
If index>=0 And index<ArraySize(sprites(id)\rect())
ClipSprite(sprites(id)\id,sprites(id)\rect(Int(index))\x,sprites(id)\rect(Int(index))\y,sprites(id)\rect(Int(index))\w,sprites(id)\rect(Int(index))\h)
DisplayTransparentSprite(sprites(id)\id,x,y)
EndIf
EndIf
EndProcedure
Procedure DRAWSPRITE(id,x,y)
DRAWANIM(id,0,x,y)
EndProcedure
Procedure STRETCHANIM(id,index.f,x,y,width,height,angle.f)
EndProcedure
Procedure STRETCHSPRITE(id,index.f,x,y,width,height,angle.f)
STRETCHANIM(id,0,x,y,width,height,angle)
EndProcedure
Procedure ZOOMANIM(id,index.f,x,y,xSize.f,ySize.f,angle.f)
EndProcedure
Procedure _ZOOMSPRITE(id,x,y,xSize.f,ySize.f,angle.f)
ZOOMANIM(id,0,x,y,xSize,ySize,angle)
EndProcedure
Procedure ROTOZOOMPRITE(id,x,y,angle.f,scale.f)
EndProcedure
Procedure ROTOANIMSPRITE(id,index.f,x,y,angle.f)
EndProcedure
Procedure ROTOSPRITE(id,x,y,angle.f)
ROTOANIMSPRITE(id,0,x,y,angle)
EndProcedure
Procedure GETSPRITESIZE(id,*rect.RECT)
If id>=0 And id<ArraySize(sprites())
; *rect\w=sprites(id)\cellWidth
; *rect\h=sprites(id)\cellHeight
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure BOXCOLL(x1,y1,width1,height1,x2,y2,width2,height2)
If (x1>x2+width2) Or (y1>y2+height2) Or (x2>x1+width1) Or (y2>y1+height1)
ProcedureReturn #False
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure CIRCOLL(x1,y1,r1,x2,y2,r2)
Define distance,distX,distY,totalRadius
totalRadius=r1+r2
distX=x2-x1
distY=y2-y2
distance=(distX*distX)+(distY*distY)
If distance<=totalRadius*totalRadius
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure SETBORDERCOLOUR(c1,c2)
EndProcedure
Procedure SETBORDERSIZE(size)
EndProcedure
Procedure SETBORDERTYPE(type)
EndProcedure
Procedure VIEWPORT(x,y,w,h)
EndProcedure
Procedure GETVIEWPORT(*x,*y,*w,*h)
EndProcedure
Procedure GETVIEWPORTX(*x)
EndProcedure
Procedure GETVIEWPORTY(*y)
EndProcedure
Procedure GETVIEWPORTWIDTH(*w)
EndProcedure
Procedure GETVIEWPORTHEIGHT(*h)
EndProcedure
Procedure CLEARERROR()
__Error(#CMP_OK)
EndProcedure
Procedure.s GETLASTERROR_Str()
Define text.s
Select __errorCode
Case #CMP_OK : text="OK";
Case #CMP_FOR_WITHOUT_NEXT : text="FOR without NEXT";
Case #CMP_SYNTAX_ERROR : text="?Syntax Error";
Case #CMP_NO_FILE : text="No file (perhaps file hasn't been closed)"
Case #CMP_WRONG_ARGUMENT : text="Wrong number of arguments";
Case #CMP_STRING_TOO_LONG : text="String too long";
Case #CMP_DIVISION_BY_ZERO : text="Division by 0";
Case #CMP_OUT_OF_MEMORY : text="Out of memory";
Case #CMP_WRONG_DIMENSION : text="Wrong number of dimensions";
Case #CMP_OUT_OF_DIMENSION : text="Out of dimensions";
Case #CMP_OUT_OF_DATA : text="?Out of data";
Case #CMP_ASSERTION_FAILED : text="Assertion failed";
Case #CMP_STARTDRAWINGFAILED : text="StartDrawing failed"
Case #CMP_INVALID_INDEX : text="Index value is out of range";
Case #CMP_ALREADY_INITIALISED : text="System is already initialised";
Case #CMP_FILE_ERROR : text="Unable to open a file";
Case #CMP_INDEX_EXCEEDED : text="Index value exceeds range for a given area"
Case #CMP_NO_SPRITE : text="No sprites are available";
Case #CMP_NO_FONT : text="Required font is not present";
Case #CMP_NO_LABEL : text="No label given";
Case #CMP_NO_USERCLASS : text="No user class given";
Case #CMP_LABEL_NOT_FOUND : text="Given label has not been found";
Case #CMP_LABEL_ALREADY_PRESENT : text="Given label is already present";
Case #CMP_INITIALISATION_FAILED : text="Initialisation failed"
Default : text="Unknown error" ;
EndSelect
EndProcedure
Procedure UNLOAD(flags1,flags2)
Define loop
If flags1 & #AREA_SPRITES
For loop=0 To ArraySize(sprites())-1
_LOADSPRITE("",loop)
Next
If flags2 & #AREA_SPRITES
FreeArray(sprites())
EndIf
EndIf
EndProcedure
Procedure X_MAKE2D()
EndProcedure
Procedure GETSCREENSIZE(*width,*height)
*width=__DG_RESX
*height=__DG_RESY
EndProcedure
Procedure _END()
__EndProgram()
EndProcedure
Procedure.f GETTIMER()
EndProcedure
Procedure GETTIMERALL()
ProcedureReturn ElapsedMilliseconds()
EndProcedure
Procedure _CLEARSCREEN(colour)
__clearScreenColour=colour
EndProcedure
Procedure _MUSICVOLUME(amount.f)
MusicVolume(__musicHandle,amount)
EndProcedure
Procedure PAUSEMUSIC(pause.b)
If pause=#True
Else
EndIf
EndProcedure
Procedure ISMUSICPLAYING()
EndProcedure
Procedure _STOPMUSIC()
If __musicHandle<>#NOT_FOUND
StopMusic(__musicHandle)
__musicHandle=#NOT_FOUND
EndIf
EndProcedure
Procedure _PLAYMUSIC(fileName.s,bLoop=#False)
Define tempFilename.s
_STOPMUSIC()
tempFilename=#MUSICPATH+fileName
Debug tempFilename
If DOESFILEEXIST(tempFilename)
__musicHandle=LoadMusic(#PB_Any,tempFilename)
If __musicHandle>0
PlayMusic(__musicHandle)
_MUSICVOLUME(100)
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure DRAWLINE(x,y,ex,ey,colour)
If StartDrawing(SpriteOutput(__miscSprite))
LineXY(x,y,ex,ey,colour)
StopDrawing()
Else
__Error(#CMP_STARTDRAWINGFAILED)
EndIf
EndProcedure
Procedure SETPIXEL(x,y,colour)
DRAWLINE(x,y,x,y,colour)
EndProcedure
Procedure DRAWRECT(x,y,ex,ey,colour)
If (StartDrawing(SpriteOutput(__miscSprite)))
Box(x,y,ex,ey,colour)
StopDrawing()
Else
__Error(#CMP_STARTDRAWINGFAILED)
EndIf
EndProcedure
Procedure.b ISFULLSCREEN()
ProcedureReturn __isFullScreen
EndProcedure
Procedure GETDESKTOPNUMBER()
EndProcedure
Procedure GETDESKTOPSIZE(*w,*h)
*w=DesktopWidth(0)
*h=DesktopHeight(0) ; Change later
EndProcedure
Procedure GETMOUSECOUNT()
ProcedureReturn 1
EndProcedure
Procedure _GRABSPRITE(id,x,y,width,height)
If id>=0 And id<#MAX_SPRITES
ExpandSprites(id)
sprites(id)\id=GrabSprite(#PB_Any,x,y,width,height,#PB_Sprite_AlphaBlending | #PB_Sprite_PixelCollision)
If sprites(id)\id>=0
Dim sprites(id)\rect(1)
sprites(id)\width=width
sprites(id)\height=height
; sprites(id)\rect(0)\x=0
; sprites(id)\rect(0)\y=0
; sprites(id)\rect(0)\w=width
; sprites(id)\rect(0)\h=height
ProcedureReturn #True
Else
EndIf
EndIf
EndProcedure
Procedure SAVEBMP(fileName.s)
Define temp
temp=GrabSprite(#PB_Any,0,0,__DG_RESX,__DG_RESY)
If temp>=0
SaveSprite(temp,fileName,#PB_ImagePlugin_BMP)
FreeSprite(temp)
ProcedureReturn #True
Else
__Error(#CMP_NO_SPRITE)
ProcedureReturn #False
EndIf
EndProcedure
Procedure HIBERNATE()
EndProcedure
Procedure SHOWSCREEN()
Define time.f
Define elapsed.f
Define Event
; It's very important to process all the events remaining in the queue at each frame
If IsWindow(__window)
Repeat
Event = WindowEvent()
Select Event
Case #PB_Event_Gadget
If EventGadget() = 0
_END()
EndIf
Case #PB_Event_CloseWindow
_END()
EndSelect
Until Event = 0
EndIf
If ExamineKeyboard()
If KEY(#PB_Key_Escape)
_END()
ElseIf KEY(#PB_Key_LeftAlt) And KEY(#PB_Key_Return)
Define fS.b
If ISFULLSCREEN()
fS=#False
Else
fS=#True
EndIf
; Currently doesn't work
If SETSCREEN(__DG_RESX,__DG_RESY,fS)=#False
Debug "Error!"
End
Else
ProcedureReturn #True
EndIf
EndIf
EndIf
; Screen3DEvents()
RenderWorld()
; Screen3DStats()
DisplayTransparentSprite(__miscSprite,0,0)
FlipBuffers()
ClearScreen(__clearScreenColour)
DRAWRECT(0,0,__DG_RESX,__DG_RESY,__clearScreenColour);
If AppTime_PauseStart=#False
time=GETTIMERALL()
If AppTime_LastUpdateTime=0.0
AppTime_Speed=1.0
AppTime_LastUPSTime=time
Else
elapsed=time-AppTime_LastUpdateTime
If elapsed=0.0
elapsed=1.0
SLEEP(1)
time+1.0
EndIf
AppTime_Speed=elapsed/AppTime_DesiredLoopTime
EndIf
AppTime_LastUpdateTime=time
AppTime_CurrentTime=time
AppTime_Iterator+1.0 ; Its a float As it can go very large...
If AppTime_CurrentTime-AppTime_LastUPSTime>=1000.0
AppTime_UPS=AppTime_Iterator/((AppTime_CurrentTime-AppTime_LastUPSTime)/1000.0)
AppTime_LastUPSTime=AppTime_CurrentTime
AppTime_Iterator=0
EndIf
EndIf
EndProcedure
Procedure.f GETMOVEMENTAMOUNT()
ProcedureReturn AppTime_Speed
EndProcedure
Procedure.f GETFPS()
ProcedureReturn AppTime_UPS
EndProcedure
Procedure.f INPUT_Float(s.s,x,y,bKerning.b)
EndProcedure
Procedure INPUT_Int(s.s,x,y,bKerning.b)
EndProcedure
Procedure.s _INPUT(s.s,x,y,bKerning.b)
EndProcedure
Procedure MOUSEWAIT()
EndProcedure
Procedure KEYWAIT()
EndProcedure
Procedure SETSCREEN(w,h,bFullScreen.b)
If __miscSprite
FreeSprite(__miscSprite)
__miscSprite=0
EndIf
; Close old screen ?
If __screen=#True
CloseScreen()
__screen=#False
Debug "Screen closed"
Else
Debug "Screen not closed"
EndIf
If __window
CloseWindow(__window)
__window=0
Debug "Window closed"
EndIf
Debug "Full screen : "
Debug bFullScreen
Debug "Width : "
Debug w
Debug "Height :"
Debug h
If bFullScreen=#False
__window=OpenWindow(#PB_Any,0,0,w,h,"",#PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_TitleBar | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
Debug "Window created"
If __window=0
ProcedureReturn #False
EndIf
If OpenWindowedScreen(WindowID(__window), 0, 0, w,h)=#False
ProcedureReturn #False
EndIf
Debug "Windowed screen created"
Else
If OpenScreen(w,h,32,"")=#False
Debug "Error creating screen"
; Debug ErrorCode()
;Debug ErrorMessage(ErrorCode())
End
ProcedureReturn #False
EndIf
__window=0
Debug "Full screen window created"
EndIf
__screen=#True
Debug "Window ID : "+__window
__miscSprite=CreateSprite(#PB_Any,w,h,0)
Debug "Misc sprite : "
Debug __miscSprite
Debug "Window : "
Debug __window
If __miscSprite
__DG_RESX=w
__DG_RESY=h
__isFullScreen=bFullScreen
ProcedureReturn #True
Else
If __screen
CloseScreen()
__screen=#False
EndIf
If __window
CloseWindow(__window)
__window=0
EndIf
ProcedureReturn #False
EndIf
EndProcedure
Procedure GadgetEvent()
Select EventGadget()
EndSelect
EndProcedure
Procedure __GLB_Defaults(organisation.s,programName.s)
If __isRunning=#False
__numDesktops=ExamineDesktops()
Debug "Number of desktops : "+__numDesktops
If __numDesktops>0
If InitEngine3D() And InitSprite() And InitSound()
__keyboardPresent=InitKeyboard()
UsePNGImageDecoder() : UsePNGImageEncoder()
UseJPEG2000ImageDecoder() : UseJPEG2000ImageEncoder()
UseJPEGImageDecoder() : UseJPEGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
CLEARERROR()
SEEDRND(GETTIMERALL())
FreeArray(sprites()) : Dim sprites(0)
AppTime_UPS.f = 0.0
AppTime_Iterator.f = 0.0
AppTime_CurrentTime.f = 0.0
AppTime_PauseStart.b = #False
AppTime_Speed.f = 0.0
AppTime_DesiredLoopTime.f = 0.0
AppTime_LastUpdateTime.f = 0.0
AppTime_LastUPSTime.f = 0.0
AppTime_DesiredFrequency = 0.0
__isRunning=#True
__screen=#False
__window=0
__miscSprite=0
__musicHandle=#NOT_FOUND
_CLEARSCREEN(0)
Debug "Finish init"
ProcedureReturn #True
Else
__Error(#CMP_INITIALISATION_FAILED)
ProcedureReturn #False
EndIf
Else
__Error(#CMP_INITIALISATION_FAILED)
ProcedureReturn #False
EndIf
Else
__Error(#CMP_ALREADY_INITIALISED)
ProcedureReturn #True
EndIf
EndProcedure
Procedure CHANGEMODULE(index,dir)
EndProcedure
Procedure SETSUBLOOP()
EndProcedure
Procedure SETMODULELOOP(initialModule.s)
EndProcedure
Procedure get_sprite_texture(index)
EndProcedure
Procedure SOCK_INIT()
CompilerIf #PB_Compiler_OS<>#PB_OS_Web
ProcedureReturn InitNetwork()
CompilerElse
ProcedureReturn #False
CompilerEndIf
EndProcedure
Procedure SOCK_GETIP(addr.s,inPort,*port)
EndProcedure
Procedure.s SOCK_GETIP_Str(ip)
EndProcedure
Procedure.s NETGETLASTERROR_Str()
ProcedureReturn GETLASTERROR_Str()
EndProcedure
Procedure SOCK_TCPCLOSE(socket)
EndProcedure
Procedure SOCK_GETREMOTEIP_TCP(socket)
EndProcedure
Procedure SOCK_GETREMOTEIP_UDP(socket)
EndProcedure
Procedure SOCK_TCPCONNECT(server.s,port,timeout)
EndProcedure
Procedure SOCK_TCPLISTEN(port)
EndProcedure
Procedure SOCK_TCPACCEPT(socket,*ip)
EndProcedure
Procedure SOCK_TCPSEND(socket,msg.s)
EndProcedure
Procedure.s SOCK_RECV_TCP(socket,length)
EndProcedure
Procedure SOCK_UDPOPEN(port)
EndProcedure
Procedure SOCK_UDPCLOSE(port)
EndProcedure
Procedure SOCK_PORT_CONVERTTONBO(port)
EndProcedure
Procedure SOCK_UDPSEND(socket,channel,msg.s,ipAddress,port)
EndProcedure
Procedure.s SOCK_RECV_UDP(socket,length)
EndProcedure
Procedure RenderFrame()
Define rect.RECT
SHOWSCREEN()
GETSPRITESIZE(0,@rect)
Debug "Sprite Width 2 : "
;Debug rect\w
; Debug "Sprite Height : "+y
;_PLAYSOUND(0,0.0,1.0)
; DRAWSPRITE(0,17,17)
; DRAWLINE(0,0,100,100,RGB(255,255,0))
; PRINT("Hello World",0,0)
;DRAWRECT(50,50,200,200,RGB(0,255,0))
DRAWSPRITE(0,17,17)
;Debug "FPS : "+GETFPS()
;Debug "Get movement speed : "+GETMOVEMENTAMOUNT()
EndProcedure