It is currently Sun Oct 13, 2019 9:30 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 12 posts ] 
Author Message
 Post subject: Window and full screen switch
PostPosted: Sat Aug 16, 2014 10:59 am 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
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:
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...


Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Sat Aug 16, 2014 2:45 pm 
Offline
Addict
Addict
User avatar

Joined: Mon Jul 25, 2005 3:51 pm
Posts: 3584
Location: Utah, USA
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.

_________________
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Sat Aug 16, 2014 11:50 pm 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
Some code :

Code:
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:
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Sun Aug 17, 2014 11:51 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Tue Aug 10, 2010 3:17 pm
Posts: 115
I just wanted to point out that this :
Code:
Procedure PI()
   ProcedureReturn 3.141592653589793
EndProcedure

Procedure PI_180()
   ProcedureReturn 0.017453292519943
EndProcedure
is awfully slow.

It should be like this :
Code:
#__PI = 3.141592653589793
#__PI_180 = 0.017453292519943

_________________
_________________________________________________
My Website : CeriseCode (Warning : perpetual changes & not completed ;))


Last edited by graph100 on Mon Aug 18, 2014 9:42 am, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Mon Aug 18, 2014 9:28 am 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
Quite true! Did you come across the aforementioned problem as well ?


Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Mon Aug 18, 2014 9:56 am 
Offline
Always Here
Always Here

Joined: Fri Oct 23, 2009 2:33 am
Posts: 5833
Location: Wales, UK
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:
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Mon Aug 18, 2014 10:11 am 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
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...


Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Mon Aug 18, 2014 11:07 am 
Offline
Addict
Addict
User avatar

Joined: Mon Jul 25, 2005 3:51 pm
Posts: 3584
Location: Utah, USA
@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

_________________
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Mon Aug 18, 2014 11:31 am 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
Quote:
@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"


Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Mon Aug 18, 2014 2:53 pm 
Offline
Always Here
Always Here

Joined: Fri Oct 23, 2009 2:33 am
Posts: 5833
Location: Wales, UK
Quote:
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Mon Aug 18, 2014 11:11 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Tue Aug 10, 2010 3:17 pm
Posts: 115
as said, this work : (no 3D function)

Code:
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)

_________________
_________________________________________________
My Website : CeriseCode (Warning : perpetual changes & not completed ;))


Last edited by graph100 on Mon Aug 18, 2014 11:50 pm, edited 2 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Window and full screen switch
PostPosted: Mon Aug 18, 2014 11:17 pm 
Offline
User
User

Joined: Sun Jul 21, 2013 12:16 am
Posts: 19
Bit limiting though!


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 12 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: Justin and 2 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye