Posts: 2,710
Threads: 328
Joined: Apr 2022
Reputation:
219
10-24-2023, 08:33 AM
(This post was last modified: 10-24-2023, 02:44 PM by SMcNeill.)
Two of the simplest little routines in the world, though I think they'll both end up becoming something I rely on more often in the future:
Code: (Select All)
Sub SaveScreen (Image As Long, SaveTo As _MEM)
Dim m As _MEM
m = _MemImage(Image)
SaveTo = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo, SaveTo.OFFSET
_MemFree m
End Sub
Sub RestoreScreen (FromWhich As _MEM, Image As Long)
Dim m As _MEM
m = _MemImage(Image)
_MemCopy FromWhich, FromWhich.OFFSET, FromWhich.SIZE To m, m.OFFSET
_MemFree m
End Sub
So what's these brilliant little pieces of code do for us? The just let us save a screen and then restore that screen.
That's it. Nothing special. No great bells or whistles here, to see folks!
There's already about 9000 different ways to do this, so why do we need THIS particular way, you ask??
Let's take a moment and look at this scenario:
Code: (Select All) SUB foo
PCOPY 0, 1
.... do stuff
PCOPY 1, 0
END SUB
Now the above is a simple enough way to grab a copy of the screen, do stuff (like place a pop up box on it), and then restore it and get rid of whatever temporary changes we made to it (such as when we close that pop up box).
But here's a question for you: What happens if your main program already had a PCOPY 0, 1 to save a screen?? Didn't you just overwrite that page with the new PCOPY 0, 1 that your SUB did? How's that gonna screw up stuff when the main routine now does a call back to the old PCOPY 1, 0 when it needs it?
So PCOPY isn't particularly a great command to make use of for SUBs or Library code...
But then there's always the old _COPYIMAGE trick!
Code: (Select All) SUB foo
tempImage = _COPYIMAGE(0)
... do stuff
_PUTIMAGE ,tempImage
_FREEIMAGE tempImage
Which works all fine and dandy.... BUT.... What if the _DISPLAY is a SCREEN 0 text screen? Can't _PUTIMAGE that image back then, now can you?
So we try and get tricky:
Code: (Select All) SUB foo
tempImage = _COPYIMAGE(0)
...do stuff
D = _DISPLAY
SCREEN tempImage
_FREEIMAGE D
Which works all fine and dandy.... BUT.... What if someone writes their code in the following manner:
Code: (Select All) WorkScreen = _NEWIMAGE(1280, 720, 32)
When you did the tempImage, QB64 had to create a new image handle for that screen... Since the main routine already had a reserved handle for the screen -- that you just freed with the _FREEIMAGE D -- none of the routines in the main program are going to work anymore as the handles don't match.
One glitch after another after another!!
Which is why I give you the two little routines above:
SaveScreen (Image As Long, SaveTo As _MEM) <-- This takes any image handle (even _DISPLAY) and saves it to a designated memblock.
RestoreScreen (FromWhich As _MEM, Image As Long) <-- And this does the reverse, taking a memblock and using it to restore the desired image.
Should work on ALL screen modes -- text, legacy graphics, 256 color screens, and 32-bit color screens. Shouldn't have any problems with using _DISPLAY or 0 as imagehandles. They're quick. They're simple. And they solve a lot of the issues which all the other various methods of saving and restoring a screen can have.
A simple working example is below, which shows that it works in both text screens and graphic screen modes.
Code: (Select All)
Screen _NewImage(640, 480, 32)
$Color:32
Cls , Pink
Print "An original Pink screen"
Sleep
GreenFoo
Sleep
Screen 0
Cls , 4 'redscreen
Print "A Red TEXT Screen 0"
Sleep
WhiteFoo
Sub GreenFoo
Dim Saver As _MEM
SaveScreen _Display, Saver
Cls , Green
Print "A happy Green screen"
Sleep
RestoreScreen Saver, _Display
_MemFree Saver
End Sub
Sub WhiteFoo
Dim Saver As _MEM
SaveScreen _Display, Saver
Cls , 15
Print "Replaced with white"
Sleep
RestoreScreen Saver, _Display
_MemFree Saver
End Sub
Sub SaveScreen (Image As Long, SaveTo As _MEM)
Dim m As _MEM
m = _MemImage(Image)
SaveTo = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo, SaveTo.OFFSET
_MemFree m
End Sub
Sub RestoreScreen (FromWhich As _MEM, Image As Long)
Dim m As _MEM
m = _MemImage(Image)
_MemCopy FromWhich, FromWhich.OFFSET, FromWhich.SIZE To m, m.OFFSET
_MemFree m
End Sub
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
That's clever. I like it.
Posts: 656
Threads: 96
Joined: Apr 2022
Reputation:
22
(10-24-2023, 08:33 AM)SMcNeill Wrote: Two of the simplest little routines in the world, though I think they'll both end up becoming something I rely on more often in the future:
Code: (Select All)
Sub SaveScreen (Image As Long, SaveTo As _MEM)
Dim m As _MEM
m = _MemImage(Image)
SaveTo = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo, SaveTo.OFFSET
_MemFree m
End Sub
Sub RestoreScreen (FromWhich As _MEM, Image As Long)
Dim m As _MEM
m = _MemImage(Image)
_MemCopy FromWhich, FromWhich.OFFSET, FromWhich.SIZE To m, m.OFFSET
_MemFree m
End Sub
So what's these brilliant little pieces of code do for us? The just let us save a screen and then restore that screen.
That's it. Nothing special. No great bells or whistles here, to see folks!
There's already about 9000 different ways to do this, so why do we need THIS particular way, you ask??
Let's take a moment and look at this scenario:
Code: (Select All) SUB foo
PCOPY 0, 1
.... do stuff
PCOPY 1, 0
END SUB
Now the above is a simple enough way to grab a copy of the screen, do stuff (like place a pop up box on it), and then restore it and get rid of whatever temporary changes we made to it (such as when we close that pop up box).
But here's a question for you: What happens if your main program already had a PCOPY 0, 1 to save a screen?? Didn't you just overwrite that page with the new PCOPY 0, 1 that your SUB did? How's that gonna screw up stuff when the main routine now does a call back to the old PCOPY 1, 0 when it needs it?
So PCOPY isn't particularly a great command to make use of for SUBs or Library code...
But then there's always the old _COPYIMAGE trick!
Code: (Select All) SUB foo
tempImage = _COPYIMAGE(0)
... do stuff
_PUTIMAGE ,tempImage
_FREEIMAGE tempImage
Which works all fine and dandy.... BUT.... What if the _DISPLAY is a SCREEN 0 text screen? Can't _PUTIMAGE that image back then, now can you?
So we try and get tricky:
Code: (Select All) SUB foo
tempImage = _COPYIMAGE(0)
...do stuff
D = _DISPLAY
SCREEN tempImage
_FREEIMAGE D
Which works all fine and dandy.... BUT.... What if someone writes their code in the following manner:
Code: (Select All) WorkScreen = _NEWIMAGE(1280, 720, 32)
When you did the tempImage, QB64 had to create a new image handle for that screen... Since the main routine already had a reserved handle for the screen -- that you just freed with the _FREEIMAGE D -- none of the routines in the main program are going to work anymore as the handles don't match.
One glitch after another after another!!
Which is why I give you the two little routines above:
SaveScreen (Image As Long, SaveTo As _MEM) <-- This takes any image handle (even _DISPLAY) and saves it to a designated memblock.
RestoreScreen (FromWhich As _MEM, Image As Long) <-- And this does the reverse, taking a memblock and using it to restore the desired image.
Should work on ALL screen modes -- text, legacy graphics, 256 color screens, and 32-bit color screens. Shouldn't have any problems with using _DISPLAY or 0 as imagehandles. They're quick. They're simple. And they solve a lot of the issues which all the other various methods of saving and restoring a screen can have.
A simple working example is below, which shows that it works in both text screens and graphic screen modes.
Code: (Select All)
Screen _NewImage(640, 480, 32)
$Color:32
Cls , Pink
Print "An original Pink screen"
Sleep
GreenFoo
Sleep
Screen 0
Cls , 4 'redscreen
Print "A Red TEXT Screen 0"
Sleep
WhiteFoo
Sub GreenFoo
Dim Saver As _MEM
SaveScreen _Display, Saver
Cls , Green
Print "A happy Green screen"
Sleep
RestoreScreen Saver, _Display
_MemFree Saver
End Sub
Sub WhiteFoo
Dim Saver As _MEM
SaveScreen _Display, Saver
Cls , 15
Print "Replaced with white"
Sleep
RestoreScreen Saver, _Display
_MemFree Saver
End Sub
Sub SaveScreen (Image As Long, SaveTo As _MEM)
Dim m As _MEM
m = _MemImage(Image)
SaveTo = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo, SaveTo.OFFSET
_MemFree m
End Sub
Sub RestoreScreen (FromWhich As _MEM, Image As Long)
Dim m As _MEM
m = _MemImage(Image)
_MemCopy FromWhich, FromWhich.OFFSET, FromWhich.SIZE To m, m.OFFSET
_MemFree m
End Sub
Nice work. Even simple enough for ME to understand, and that's not easy!
Well done Steve!
Posts: 4,001
Threads: 180
Joined: Apr 2022
Reputation:
222
I am not clear what the problem would be taking a snapshot of screen before doing stuff then using it to restore screen when done, say with dialog. This method always seemed to work for me.
b = b + ...
Posts: 2,710
Threads: 328
Joined: Apr 2022
Reputation:
219
(10-26-2023, 01:59 PM)bplus Wrote: I am not clear what the problem would be taking a snapshot of screen before doing stuff then using it to restore screen when done, say with dialog. This method always seemed to work for me.
There's a lot more to track and restore than just a "snapshot of screen", if you want to make certain that your subs and functions all clean up neatly after themselves. For example, take a look at my little expanded function (in progress):
Code: (Select All)
Const All_Settings~& = -1~&
Const General_Settings~& = 1 Or 2 Or 4 Or 8
Const AutoDisplay_Setting~& = 1
Const Blend_Setting~& = 2
Const Dest_Setting~& = 4
Const Source_Setting~& = 8
Const Font_Settings~& = 16 Or 32 Or 64 Or 128 Or 256
Const CursorX_Setting~& = 16
Const CursorY_Setting~& = 32
Const Font_Setting~& = 64
Const ForegroundColor_Setting~& = 128
Const BackgroundColor_Setting~& = 256
Const Image_Settings~& = 512 Or 2048
Const ColorPalette_Setting~& = 512
Const ScreenData_Setting~& = 2048
Type Settings_Type
ControlCode As _Unsigned Long
'General Screen Settings '15
AutoDisplay As Long '1
Blend As Long '2
Dest As Long '4
Source As Long '8
'Font Settings '496
CursorX As Long '16
CursorY As Long '32
Font As Long '64
FgColor As _Unsigned Long '128
BgColor As _Unsigned Long '256
'Image Settings ' 15872
ColorPalette As _MEM '512
PixelSize As Long '1024
ScreenData As _MEM '2048
End Type
Dim Saver As Settings_Type
'Screen _NewImage(640, 480, 32)
'$Color:32
Randomize Timer
_Blink Off
For i = 0 To 15
Color i, 15 - i
Print "Hello World in Color"; i
Next
Sleep 'so we can view the original screen
GetSettings 0, Saver, All_Settings 'We should now be able to screw with all sorts of stuff and then reset the changes after
_Font 17 'double wide font!
For i = 1 To 10
Color 4, 0: Print "BLAH BLAH BLAH! Look at this junk!" 'just crap to print to the screen!
Next
For i = 0 To 15
_PaletteColor i, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256) 'even the palette changes!
Next
Sleep 'so we can view our drastic changes
RestoreSettings Saver, Image 'put everything back to where it was originally
Sleep 'and let's look at it
System 'before we quit
Sub GetSettings (Image As Long, SaveTo As Settings_Type, Control_Code As _Unsigned Long)
Dim m As _MEM: m = _MemImage(0)
If Control_Code = 0 Then Exit Sub
SaveTo.ControlCode = Control_Code
SaveTo.PixelSize = _PixelSize(Image)
If Control_Code And 1 Then SaveTo.AutoDisplay = _AutoDisplay
If Control_Code And 2 Then SaveTo.Blend = _Blend
If Control_Code And 4 Then SaveTo.Dest = _Dest
If Control_Code And 8 Then SaveTo.Source = _Source
If Control_Code And 16 Then SaveTo.CursorX = Pos(0)
If Control_Code And 32 Then SaveTo.CursorY = CsrLin
If Control_Code And 64 Then SaveTo.Font = _Font(Image)
If Control_Code And 128 Then SaveTo.FgColor = _DefaultColor(Image)
If Control_Code And 256 Then SaveTo.BgColor = _BackgroundColor(Image)
If Control_Code And 512 Then
Select Case SaveTo.PixelSize
Case 0, 256 '16 color palette and 256 color palette
If SaveTo.PixelSize = 0 Then '16 colors for text screen
Limit = 15
Else
Limit = 255
End If
Dim Pal(0 To Limit) As _Unsigned Long
For i = 0 To Limit
Pal(i) = _RGBA32(_Red(i, Image), _Green(i, Image), _Blue(i, Image), _Alpha(i, Image))
Next
m = _Mem(Pal())
SaveTo.ColorPalette = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo.ColorPalette, SaveTo.ColorPalette.OFFSET
_MemFree m
End Select
End If
'1024 got made mandatory for all blocks, so it's no longer a control code variable
If Control_Code And 2048 Then
m = _MemImage(Image)
SaveTo.ScreenData = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo.ScreenData, SaveTo.ScreenData.OFFSET
_MemFree m
End If
End Sub
Sub RestoreSettings (FromWhat As Settings_Type, Image As Long)
Dim m As _MEM: m = _MemImage(0)
Dim As _Unsigned Long CC, PS 'save me some typing
CC = FromWhat.ControlCode
PS = FromWhat.PixelSize
If CC = 0 Then Exit Sub
If CC And 1 Then If FromWhat.AutoDisplay Then _AutoDisplay
If CC And 2 Then If FromWhat.Blend Then _Blend
If CC And 4 Then _Dest FromWhat.Dest
If CC And 8 Then _Source FromWhat.Source
If CC And 16 Then Locate , FromWhat.CursorX
If CC And 32 Then Locate FromWhat.CursorY
If CC And 64 Then _Font FromWhat.Font, Image
If CC And 128 Then Color FromWhat.FgColor
If CC And 256 Then Color , FromWhat.BgColor
If CC And 512 Then
Select Case PS
Case 0, 256 '16 color palette and 256 color palette
If PS = 0 Then '16 colors for text screen
Limit = 15
Else
Limit = 255
End If
Dim Pal(0 To Limit) As _Unsigned Long
m = _Mem(Pal())
_MemCopy FromWhat.ColorPalette, FromWhat.ColorPalette.OFFSET, FromWhat.ColorPalette.SIZE To m, m.OFFSET
_MemFree m
For i = 0 To Limit
_PaletteColor i, Pal(i), Image
Next
End Select
End If
'1024 Placeholder now
If CC And 2048 Then
m = _MemImage(Image)
_MemCopy FromWhat.ScreenData, FromWhat.ScreenData.OFFSET, FromWhat.ScreenData.SIZE To m, m.OFFSET
_MemFree m
End If
End Sub
Sub SaveScreen (Image As Long, SaveTo As _MEM)
Dim m As _MEM
m = _MemImage(Image)
SaveTo = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo, SaveTo.OFFSET
_MemFree m
End Sub
Sub RestoreScreen (FromWhich As _MEM, Image As Long)
Dim m As _MEM
m = _MemImage(Image)
_MemCopy FromWhich, FromWhich.OFFSET, FromWhich.SIZE To m, m.OFFSET
_MemFree m
End Sub
And how you get that "snapshot" can cause problems elsewhere in your code, as I pointed out before.
IF you use PCOPY inside a SUB at the beginning and end, that PCOPY will corrupt any other use of the same handle with the new image.
_COPYIMAGE can't work with a _PUTIMAGE in SCREEN 0 modes.
_NEWIMAGE will change image handles, which can make any existing variables which reference the old handle invalid.
Show me an example of how you'd grab your "snapshot", and chances are, I can show you code where it'll glitch out on you, if you're not careful or lucky. 
Posts: 4,001
Threads: 180
Joined: Apr 2022
Reputation:
222
(10-26-2023, 02:09 PM)SMcNeill Wrote: (10-26-2023, 01:59 PM)bplus Wrote: I am not clear what the problem would be taking a snapshot of screen before doing stuff then using it to restore screen when done, say with dialog. This method always seemed to work for me.
There's a lot more to track and restore than just a "snapshot of screen", if you want to make certain that your subs and functions all clean up neatly after themselves. For example, take a look at my little expanded function (in progress):
Code: (Select All)
Const All_Settings~& = -1~&
Const General_Settings~& = 1 Or 2 Or 4 Or 8
Const AutoDisplay_Setting~& = 1
Const Blend_Setting~& = 2
Const Dest_Setting~& = 4
Const Source_Setting~& = 8
Const Font_Settings~& = 16 Or 32 Or 64 Or 128 Or 256
Const CursorX_Setting~& = 16
Const CursorY_Setting~& = 32
Const Font_Setting~& = 64
Const ForegroundColor_Setting~& = 128
Const BackgroundColor_Setting~& = 256
Const Image_Settings~& = 512 Or 2048
Const ColorPalette_Setting~& = 512
Const ScreenData_Setting~& = 2048
Type Settings_Type
ControlCode As _Unsigned Long
'General Screen Settings '15
AutoDisplay As Long '1
Blend As Long '2
Dest As Long '4
Source As Long '8
'Font Settings '496
CursorX As Long '16
CursorY As Long '32
Font As Long '64
FgColor As _Unsigned Long '128
BgColor As _Unsigned Long '256
'Image Settings ' 15872
ColorPalette As _MEM '512
PixelSize As Long '1024
ScreenData As _MEM '2048
End Type
Dim Saver As Settings_Type
'Screen _NewImage(640, 480, 32)
'$Color:32
Randomize Timer
_Blink Off
For i = 0 To 15
Color i, 15 - i
Print "Hello World in Color"; i
Next
Sleep 'so we can view the original screen
GetSettings 0, Saver, All_Settings 'We should now be able to screw with all sorts of stuff and then reset the changes after
_Font 17 'double wide font!
For i = 1 To 10
Color 4, 0: Print "BLAH BLAH BLAH! Look at this junk!" 'just crap to print to the screen!
Next
For i = 0 To 15
_PaletteColor i, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256) 'even the palette changes!
Next
Sleep 'so we can view our drastic changes
RestoreSettings Saver, Image 'put everything back to where it was originally
Sleep 'and let's look at it
System 'before we quit
Sub GetSettings (Image As Long, SaveTo As Settings_Type, Control_Code As _Unsigned Long)
Dim m As _MEM: m = _MemImage(0)
If Control_Code = 0 Then Exit Sub
SaveTo.ControlCode = Control_Code
SaveTo.PixelSize = _PixelSize(Image)
If Control_Code And 1 Then SaveTo.AutoDisplay = _AutoDisplay
If Control_Code And 2 Then SaveTo.Blend = _Blend
If Control_Code And 4 Then SaveTo.Dest = _Dest
If Control_Code And 8 Then SaveTo.Source = _Source
If Control_Code And 16 Then SaveTo.CursorX = Pos(0)
If Control_Code And 32 Then SaveTo.CursorY = CsrLin
If Control_Code And 64 Then SaveTo.Font = _Font(Image)
If Control_Code And 128 Then SaveTo.FgColor = _DefaultColor(Image)
If Control_Code And 256 Then SaveTo.BgColor = _BackgroundColor(Image)
If Control_Code And 512 Then
Select Case SaveTo.PixelSize
Case 0, 256 '16 color palette and 256 color palette
If SaveTo.PixelSize = 0 Then '16 colors for text screen
Limit = 15
Else
Limit = 255
End If
Dim Pal(0 To Limit) As _Unsigned Long
For i = 0 To Limit
Pal(i) = _RGBA32(_Red(i, Image), _Green(i, Image), _Blue(i, Image), _Alpha(i, Image))
Next
m = _Mem(Pal())
SaveTo.ColorPalette = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo.ColorPalette, SaveTo.ColorPalette.OFFSET
_MemFree m
End Select
End If
'1024 got made mandatory for all blocks, so it's no longer a control code variable
If Control_Code And 2048 Then
m = _MemImage(Image)
SaveTo.ScreenData = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo.ScreenData, SaveTo.ScreenData.OFFSET
_MemFree m
End If
End Sub
Sub RestoreSettings (FromWhat As Settings_Type, Image As Long)
Dim m As _MEM: m = _MemImage(0)
Dim As _Unsigned Long CC, PS 'save me some typing
CC = FromWhat.ControlCode
PS = FromWhat.PixelSize
If CC = 0 Then Exit Sub
If CC And 1 Then If FromWhat.AutoDisplay Then _AutoDisplay
If CC And 2 Then If FromWhat.Blend Then _Blend
If CC And 4 Then _Dest FromWhat.Dest
If CC And 8 Then _Source FromWhat.Source
If CC And 16 Then Locate , FromWhat.CursorX
If CC And 32 Then Locate FromWhat.CursorY
If CC And 64 Then _Font FromWhat.Font, Image
If CC And 128 Then Color FromWhat.FgColor
If CC And 256 Then Color , FromWhat.BgColor
If CC And 512 Then
Select Case PS
Case 0, 256 '16 color palette and 256 color palette
If PS = 0 Then '16 colors for text screen
Limit = 15
Else
Limit = 255
End If
Dim Pal(0 To Limit) As _Unsigned Long
m = _Mem(Pal())
_MemCopy FromWhat.ColorPalette, FromWhat.ColorPalette.OFFSET, FromWhat.ColorPalette.SIZE To m, m.OFFSET
_MemFree m
For i = 0 To Limit
_PaletteColor i, Pal(i), Image
Next
End Select
End If
'1024 Placeholder now
If CC And 2048 Then
m = _MemImage(Image)
_MemCopy FromWhat.ScreenData, FromWhat.ScreenData.OFFSET, FromWhat.ScreenData.SIZE To m, m.OFFSET
_MemFree m
End If
End Sub
Sub SaveScreen (Image As Long, SaveTo As _MEM)
Dim m As _MEM
m = _MemImage(Image)
SaveTo = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo, SaveTo.OFFSET
_MemFree m
End Sub
Sub RestoreScreen (FromWhich As _MEM, Image As Long)
Dim m As _MEM
m = _MemImage(Image)
_MemCopy FromWhich, FromWhich.OFFSET, FromWhich.SIZE To m, m.OFFSET
_MemFree m
End Sub
And how you get that "snapshot" can cause problems elsewhere in your code, as I pointed out before.
IF you use PCOPY inside a SUB at the beginning and end, that PCOPY will corrupt any other use of the same handle with the new image.
_COPYIMAGE can't work with a _PUTIMAGE in SCREEN 0 modes.
_NEWIMAGE will change image handles, which can make any existing variables which reference the old handle invalid.
Show me an example of how you'd grab your "snapshot", and chances are, I can show you code where it'll glitch out on you, if you're not careful or lucky.
I haven't looked at this for awhile, might be due for update?
Code: (Select All) ' ============================================================= This is old version dev for mBox or InputBox new version dev with new GetArrayItem$
' for saving and restoring screen settins
Sub ScnState (restoreTF As Long) 'Thanks Steve McNeill
Static defaultColor~&, backGroundColor~&
Static font&, dest&, source&, row&, col&, autodisplay&, mb&
If restoreTF Then
_Font font&
Color defaultColor~&, backGroundColor~&
_Dest dest&
_Source source&
Locate row&, col&
If autodisplay& Then _AutoDisplay Else _Display
_KeyClear
While _MouseInput: Wend 'clear mouse clicks
mb& = _MouseButton(1)
If mb& Then
Do
While _MouseInput: Wend
mb& = _MouseButton(1)
_Limit 100
Loop Until mb& = 0
End If
Else
font& = _Font: defaultColor~& = _DefaultColor: backGroundColor~& = _BackgroundColor
dest& = _Dest: source& = _Source
row& = CsrLin: col& = Pos(0): autodisplay& = _AutoDisplay
_KeyClear
End If
End Sub
As I recall it worked pretty good returning screen back to a previous condition. Good for dialog boxes like Message or Input.
b = b + ...
Posts: 2,710
Threads: 328
Joined: Apr 2022
Reputation:
219
Aye. What you have is an old version. GetSettings and RestoreSettings are the updated versions of what you have.
Posts: 2,710
Threads: 328
Joined: Apr 2022
Reputation:
219
@bplus Try out the upgraded version here and see what you think:
Code: (Select All)
Const All_Settings~& = -1~&
Const General_Settings~& = 1 Or 2 Or 4 Or 8
Const AutoDisplay_Setting~& = 1
Const Blend_Setting~& = 2
Const Dest_Setting~& = 4
Const Source_Setting~& = 8
Const Font_Settings~& = 16 Or 32 Or 64 Or 128 Or 256
Const CursorX_Setting~& = 16
Const CursorY_Setting~& = 32
Const Font_Setting~& = 64
Const ForegroundColor_Setting~& = 128
Const BackgroundColor_Setting~& = 256
Const Image_Settings~& = 512 Or 1024 Or 2048
Const ColorPalette_Setting~& = 512
Const Blink_Setting~& = 1024
Const ScreenData_Setting~& = 2048
Type Settings_Type
ControlCode As _Unsigned Long
PixelSize As Long
'General Screen Settings '15
AutoDisplay As Long '1
Blend As Long '2
Dest As Long '4
Source As Long '8
'Font Settings '496
CursorX As Long '16
CursorY As Long '32
Font As Long '64
FgColor As _Unsigned Long '128
BgColor As _Unsigned Long '256
'Image Settings ' 2560
ColorPalette As _MEM '512
Blink As Long '1024
ScreenData As _MEM '2048
End Type
Dim Saver As Settings_Type
'Screen _NewImage(640, 480, 32)
'$Color:32
Randomize Timer
_Blink Off
For i = 0 To 15
Color i, 15 - i
Print "Hello World in Color"; i
Next
Sleep 'so we can view the original screen
GetSettings 0, Saver, All_Settings 'We should now be able to screw with all sorts of stuff and then reset the changes after
_Font 17 'double wide font!
For i = 1 To 10
Color 4, 0: Print "BLAH BLAH BLAH! Look at this junk!" 'just crap to print to the screen!
Next
For i = 0 To 15
_PaletteColor i, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256) 'even the palette changes!
Next
Sleep 'so we can view our drastic changes
RestoreSettings Saver, Image 'put everything back to where it was originally
Sleep 'and let's look at it
System 'before we quit
Sub GetSettings (Image As Long, SaveTo As Settings_Type, Control_Code As _Unsigned Long)
Dim m As _MEM: m = _MemImage(0)
If Control_Code = 0 Then Exit Sub
SaveTo.ControlCode = Control_Code
SaveTo.PixelSize = _PixelSize(Image)
If Control_Code And 1 Then SaveTo.AutoDisplay = _AutoDisplay
If Control_Code And 2 Then SaveTo.Blend = _Blend
If Control_Code And 4 Then SaveTo.Dest = _Dest
If Control_Code And 8 Then SaveTo.Source = _Source
If Control_Code And 16 Then SaveTo.CursorX = Pos(0)
If Control_Code And 32 Then SaveTo.CursorY = CsrLin
If Control_Code And 64 Then SaveTo.Font = _Font(Image)
If Control_Code And 128 Then SaveTo.FgColor = _DefaultColor(Image)
If Control_Code And 256 Then SaveTo.BgColor = _BackgroundColor(Image)
If Control_Code And 512 Then
Select Case SaveTo.PixelSize
Case 0, 256 '16 color palette and 256 color palette
If SaveTo.PixelSize = 0 Then '16 colors for text screen
Limit = 15
Else
Limit = 255
End If
Dim Pal(0 To Limit) As _Unsigned Long
For i = 0 To Limit
Pal(i) = _RGBA32(_Red(i, Image), _Green(i, Image), _Blue(i, Image), _Alpha(i, Image))
Next
m = _Mem(Pal())
SaveTo.ColorPalette = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo.ColorPalette, SaveTo.ColorPalette.OFFSET
_MemFree m
End Select
End If
If Control_Code And 1024 Then SaveTo.Blink = _Blink
If Control_Code And 2048 Then
m = _MemImage(Image)
SaveTo.ScreenData = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo.ScreenData, SaveTo.ScreenData.OFFSET
_MemFree m
End If
End Sub
Sub RestoreSettings (FromWhat As Settings_Type, Image As Long)
Dim m As _MEM: m = _MemImage(0)
Dim As _Unsigned Long CC, PS 'save me some typing
CC = FromWhat.ControlCode
PS = FromWhat.PixelSize
If CC = 0 Then Exit Sub
If CC And 1 Then If FromWhat.AutoDisplay Then _AutoDisplay Else _Display
If CC And 2 Then If FromWhat.Blend Then _Blend Else _DontBlend
If CC And 4 Then _Dest FromWhat.Dest
If CC And 8 Then _Source FromWhat.Source
If CC And 16 Then Locate , FromWhat.CursorX
If CC And 32 Then Locate FromWhat.CursorY
If CC And 64 Then _Font FromWhat.Font, Image
If CC And 128 Then Color FromWhat.FgColor
If CC And 256 Then Color , FromWhat.BgColor
If CC And 512 Then
Select Case PS
Case 0, 256 '16 color palette and 256 color palette
If PS = 0 Then '16 colors for text screen
Limit = 15
Else
Limit = 255
End If
Dim Pal(0 To Limit) As _Unsigned Long
m = _Mem(Pal())
_MemCopy FromWhat.ColorPalette, FromWhat.ColorPalette.OFFSET, FromWhat.ColorPalette.SIZE To m, m.OFFSET
_MemFree m
For i = 0 To Limit
_PaletteColor i, Pal(i), Image
Next
End Select
End If
If CC And 1024 Then If FromWhat.Blink Then _Blink On Else _Blink Off
If CC And 2048 Then
m = _MemImage(Image)
_MemCopy FromWhat.ScreenData, FromWhat.ScreenData.OFFSET, FromWhat.ScreenData.SIZE To m, m.OFFSET
_MemFree m
End If
End Sub
Differences in these routines and what you currently have:
Yours only tracks: Static font&, dest&, source&, row&, col&, autodisplay&, mb&
This tracks:
'General Screen Settings '15
AutoDisplay As Long '1
Blend As Long '2
Dest As Long '4
Source As Long '8
'Font Settings '496
CursorX As Long '16
CursorY As Long '32
Font As Long '64
FgColor As _Unsigned Long '128
BgColor As _Unsigned Long '256
'Image Settings ' 2560
ColorPalette As _MEM '512
Blink As Long '1024
ScreenData As _MEM '2048
End Type
So that's all the screen data (the image itself can be restored), as well as its palette (in case that changes), with _blink, _blend, color, and background color all added to the mix.
Change 2: Yours holds the data in a STATIC variable, which means it has to be restored in the same routine, and the same pass, as the sub/function that uses it.
The new version uses a settings_type variable to track the changes, so it could be used inside a recursive sub/function -- or called in multiple subs/functions -- and unravel back out in the same order to get you back to your original screen in a FILO method.
Change 3: Yours requires you to get and store all the data that it holds, without choice in case you want any of the changes to actually remain.
The new version lets you specify *exactly* what you want to store and restore. (That's where all the nice CONST come in to help make things more intuitive for users.)
Only want to store the General Settings (AutoDisplay, Blend, Dest, Source) then simply call the sub with: GetSettings 0, Saver, General_Settings
Decide that you actually want your sub/function to be able to change the blend setting, but not those other three? GetSettings 0, Saver, General_Settings - AutoDisplay_Setting
Want to store it all? That's All_Settings
Just the image data, color palette, and blink status? That's Image_Settings
Recursive possible. More settings. Optional and customizable settings...
I'd call it a nice upgrade from the old version which you currently have saved and for use.
Posts: 4,001
Threads: 180
Joined: Apr 2022
Reputation:
222
Honestly i was happy to have something simple to use for Dialogues.
But if I were ever to attempt a Windows like system with multiple open windows/screens this would likely be very handy!
b = b + ...
|
