Window and full screen switch

Advanced game related topics
BurpyMcFistyGuts
User
User
Posts: 19
Joined: Sun Jul 21, 2013 12:16 am

Window and full screen switch

Post by BurpyMcFistyGuts »

I'm trying to switch between full screen and window, and back again, but have hit a problem.

I can successfully switch between full screen and window, but the switch from window to full screen is a problem - namely OpenScreen fails for some reason, even though it has been closed previously.

The code is :

Code: Select all

Procedure SETSCREEN(w,h,bFullScreen.b)
	If __miscSprite<>0
	  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<>0
	  CloseWindow(__window)
	  __window=0
	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,"",#PB_Screen_SmartSynchronization)=#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<>0
    __DG_RESX=w
    __DG_RESY=h
    __isFullScreen=bFullScreen
    ProcedureReturn #True
  Else
    If __screen
      CloseScreen()
      __screen=#False
    EndIf
    
    If __window<>0
  	  CloseWindow(__window)
  	  __window=#NOT_FOUND
  	EndIf  	
  	
  	ProcedureReturn #False
  EndIf
EndProcedure
Calling ErrorCode hangs the program too...
User avatar
Demivec
Addict
Addict
Posts: 4086
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: Window and full screen switch

Post by Demivec »

Do you have a working snippet that can be ran to demonstrate the problem.

When you open a windowed screen you should include an event loop to handle it.


In any case here is another way of switching between fullscreen and windowed screen. It includes an API call to change whether the title bar is shown (for fullscreen/windowed switch) but other than that it works well and should be cross-platform.
BurpyMcFistyGuts
User
User
Posts: 19
Joined: Sun Jul 21, 2013 12:16 am

Re: Window and full screen switch

Post by BurpyMcFistyGuts »

Some code :

Code: Select all

XIncludeFile "Triority.pb"

If __GLB_Defaults("","")=#False
  Debug "Error initilising"
  _END()
  End
EndIf

SETSCREEN(800,600,#False)
;_LOADSPRITE("block.png",0)
;Debug "Music :" 
;Debug _PLAYMUSIC("music.mp3")

Repeat
  
  DRAWLINE(0,0,100,100,RGB(0,255,0))
  ; DRAWSPRITE(0,10,10)
  ;_PRINT("Hello",10,10)
    SHOWSCREEN()
    
  ForEver

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
User avatar
graph100
Enthusiast
Enthusiast
Posts: 115
Joined: Tue Aug 10, 2010 3:17 pm

Re: Window and full screen switch

Post by graph100 »

I just wanted to point out that this :

Code: Select all

Procedure PI() 
	ProcedureReturn 3.141592653589793 
EndProcedure 

Procedure PI_180() 
	ProcedureReturn 0.017453292519943 
EndProcedure 
is awfully slow.

It should be like this :

Code: Select all

#__PI = 3.141592653589793 
#__PI_180 = 0.017453292519943
Last edited by graph100 on Mon Aug 18, 2014 9:42 am, edited 1 time in total.
_________________________________________________
My Website : CeriseCode (Warning : perpetual changes & not completed ;))
BurpyMcFistyGuts
User
User
Posts: 19
Joined: Sun Jul 21, 2013 12:16 am

Re: Window and full screen switch

Post by BurpyMcFistyGuts »

Quite true! Did you come across the aforementioned problem as well ?
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Window and full screen switch

Post by IdeasVacuum »

Here is a shorter snippet that has the same problem. It could be PB, but since I have never swapped between FullScreen and a Window before, it could be me.

Code: Select all

Enumeration
#WinScrn
#BtnFullScreen
EndEnumeration

ExamineDesktops()

Declare FullScreen()
Declare WindowedScreen()
Declare HandleError(Result.l, Text.s)

Procedure HandleError(Result.l, Text.s)
;--------------------------------------

  If Result = 0
        MessageRequester("Problem", Text, #PB_MessageRequester_Ok)
        End
  EndIf
EndProcedure

HandleError(InitEngine3D(), "Could not initialize 3D Engine")
HandleError(InitKeyboard(), "Could not access keyboard")
HandleError(InitSprite(), "Could not initialize sprite library")
HandleError(InitMouse(), "Could not initialize mouse")

Procedure WindowedScreen()
;-------------------------
Protected iEvent.i, iFullScrn.i = #False, iExit.i = #False

   HandleError(OpenWindow(#WinScrn,0,0,800,640, "Windowed Screen", #PB_Window_SystemMenu | #PB_Window_ScreenCentered), "Could Not open Window")

                ButtonGadget(#BtnFullScreen,0,0,100,26,"Full Screen")
                 HandleError(OpenWindowedScreen(WindowID(#WinScrn), 0, 40, 800, 600), "Could not open Windowed Screen")

                             CreateCamera(#PB_Any, 0, 0, 100, 100)

              Repeat
                            iEvent = WaitWindowEvent()

                            If iEvent = #PB_Event_Gadget

                                   If EventGadget() = #BtnFullScreen

                                          iExit = #True : iFullScrn = #True

                                   EndIf

                            ElseIf iEvent = #PB_Event_CloseWindow : iExit = #True

                            EndIf

              Until iExit = #True

              CloseScreen()
              CloseWindow(#WinScrn)

              If iFullScrn = #True

                           Delay(100)
                      FullScreen()

              EndIf

EndProcedure

Procedure FullScreen()
;---------------------

HandleError(OpenScreen(DesktopWidth(0), DesktopHeight(0), 32, "Full Screen"), "Could not open Full Screen")

              Repeat

                    ExamineKeyboard()

              Until KeyboardPushed(#PB_Key_Escape)

              CloseScreen()
                    Delay(100)
           WindowedScreen()

EndProcedure

;FullScreen()
WindowedScreen()

End
So, FullScreen-to-WindowedScreen works, WindowedScreen-to-FullScreen works, but each only once.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
BurpyMcFistyGuts
User
User
Posts: 19
Joined: Sun Jul 21, 2013 12:16 am

Re: Window and full screen switch

Post by BurpyMcFistyGuts »

It does seem like a PB bug then - there shouldn't be a limit to the number of times you can swap between full screen and a window...
User avatar
Demivec
Addict
Addict
Posts: 4086
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: Window and full screen switch

Post by Demivec »

@IdeasVacuum: Your sample works fine if the InitEngine3D() and the CreateCamera() are removed.

So it isn't just switching between fullscreen and a windowed screen. It may relate to the 3D or Camera functions.

@BurpyMcFistyGuts: Your complete sample works fine switching between fullscreen and a windowed screen buts crashes when I close the window.

All examples ran in Win x64, PureBasic 5.30 x64
BurpyMcFistyGuts
User
User
Posts: 19
Joined: Sun Jul 21, 2013 12:16 am

Re: Window and full screen switch

Post by BurpyMcFistyGuts »

@BurpyMcFistyGuts: Your complete sample works fine switching between fullscreen and a windowed screen buts crashes when I close the window.
That is another side-affect. ErrorCode also causes... "problems"
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Window and full screen switch

Post by IdeasVacuum »

Your sample works fine if the InitEngine3D() and the CreateCamera() are removed
:mrgreen: It was already a perfectly useless snippet, but that enhancement would win the golden dongle
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
graph100
Enthusiast
Enthusiast
Posts: 115
Joined: Tue Aug 10, 2010 3:17 pm

Re: Window and full screen switch

Post by graph100 »

as said, this work : (no 3D function)

Code: Select all

Enumeration
	#WinScrn
	#BtnFullScreen
EndEnumeration

ExamineDesktops()

Declare FullScreen()
Declare WindowedScreen()
Declare HandleError(Result.l, Text.s)

Procedure HandleError(Result.l, Text.s)
	;--------------------------------------
	
	If Result = 0
		MessageRequester("Problem", Text, #PB_MessageRequester_Ok)
		End
	EndIf
EndProcedure

;HandleError(InitEngine3D(), "Could not initialize 3D Engine")
HandleError(InitSprite(), "Could not initialize sprite library")
HandleError(InitKeyboard(), "Could not access keyboard")
HandleError(InitMouse(), "Could not initialize mouse")

Procedure WindowedScreen()
	;-------------------------
	Protected iEvent.i, iFullScrn.i = #False, iExit.i = #False
	
	HandleError(OpenWindow(#WinScrn,0,0,800,600, "Windowed Screen", #PB_Window_SystemMenu | #PB_Window_ScreenCentered), "Could Not open Window")
	
	ButtonGadget(#BtnFullScreen,0,0,100,20,"Full Screen")
	HandleError(OpenWindowedScreen(WindowID(#WinScrn), 0, 20, 800, 580, 0, 0, 0), "Could not open Windowed Screen")
	
	
	Repeat
		Repeat
			iEvent = WindowEvent()
			
			If iEvent = #PB_Event_Gadget
				
				If EventGadget() = #BtnFullScreen
					
					iExit = #True : iFullScrn = #True
					
				EndIf
				
			ElseIf iEvent = #PB_Event_CloseWindow
				
				iExit = #True
				
			EndIf
		Until iExit = #True Or iEvent = 0
	
		ClearScreen(0)
		
		StartDrawing(ScreenOutput())
		For i = 0 To 10
			Circle(Random(OutputWidth()), Random(OutputHeight()), 10, #Red)
		Next
		StopDrawing()
		
		FlipBuffers()
		
	Until iExit = #True
	
	CloseScreen()
	CloseWindow(#WinScrn)
	
	If iFullScrn = #True
		
		Delay(100)
		FullScreen()
		
	EndIf
	
EndProcedure

Procedure FullScreen()
	;---------------------
	
	HandleError(OpenScreen(DesktopWidth(0), DesktopHeight(0), 32, "Full Screen"), "Could not open Full Screen")
	
	Repeat
		
		ExamineKeyboard()
		
		ClearScreen(0)
		
		StartDrawing(ScreenOutput())
		For i = 0 To 10
			Circle(Random(OutputWidth()), Random(OutputHeight()), 10, #Red)
		Next
		
		DrawText(10, 10, "[Escape] to return in windowed mode")
		
		StopDrawing()
		
		FlipBuffers()
		
	Until KeyboardPushed(#PB_Key_Escape)
	
	CloseScreen()
	Delay(100)
	WindowedScreen()
	
EndProcedure

;FullScreen()
WindowedScreen()

End
If even the 3D initialisation is done, there is a problem. Maybe it's the 3D context that get destroyed when the OpenScreen() is closed ?

What is strange, is that if you add the InitEngine3D(), I got ScreenOutput() = 0
Why ?

[edit] : maybe I said something idiot ? Was it possible to draw on the screen with 3D context ? (excluding sprite)
Last edited by graph100 on Mon Aug 18, 2014 11:50 pm, edited 2 times in total.
_________________________________________________
My Website : CeriseCode (Warning : perpetual changes & not completed ;))
BurpyMcFistyGuts
User
User
Posts: 19
Joined: Sun Jul 21, 2013 12:16 am

Re: Window and full screen switch

Post by BurpyMcFistyGuts »

Bit limiting though!
Post Reply