Posts: 522
Threads: 55
Joined: Jul 2022
Reputation:
48
Hi friends
I'm in learning mode. Please can give me suggestions about gathering the mouse input without affecting the speed of reaction of the whole application?
Here the code to be clearer:
also if I use loops for waiting until mouse input stops, I get too speedy responses from the application to the mouse input.
Moreover I must use different mouse buttons to do opposite actions like do/stop because in the way I structure the code I get an uncontrolled flip of the action (originally I used the same middle button of mouse to run the selected SCREEN mode and in the loop of demonstration to stop that demo for coming back to main menu. Well the result was to flip in and out of running demo of selected SCREEN).
moreover in the main screen you can change the SCREEN to be tested, but the action is so fast that I get a spin at random of the selected screen mode .
Please what idea or workaround or tip can you gimme?
Code: (Select All)
_Title "Lubuntu window's cohordinates bug"
''Screen Text Graphics Colors Video Text Default
'' Mode Rows Columns Width Height Attrib. BPP Pages Block QB64 Font
'' 0 25/43/50 80/40 No graphics 16/16 DAC 4 0-7 ----- _FONT 16
'' 1 25 40 320 200 16/4 BG 4 none 8 X 8 _FONT 8
'' 2 25 80 640 200 2/mono 1 none 8 X 8 _FONT 8
'' .................................................................................
'' 7 25 40 320 200 16/16 DAC 4 0-7 8 X 8 _FONT 8
'' 8 25 80 640 200 16/16 4 0-3 8 X 8 _FONT 8
'' 9 25 80 640 350 16/64 DAC 4 0-1 8 X 14 _FONT 14
'' 10 25 80 640 350 4/2 GScale 2 none 8 X 14 _FONT 14
'' 11 30/60 80 640 480 2/mono 1 none 8 X 16 _FONT 16
'' 12 30/60 80 640 480 16/262K 4 none 8 X 16 _FONT 16
'' 13 25 40 320 200 256/65K 8 none 8 X 8 _FONT 8
'' _NEWIMAGE width. height, 32
Randomize Timer
Dim ScrM As Integer, ScrMod As String, FeaT As String, Action As Integer
Dim Shared As Integer M1, M2, M3
ScrM = 0: ScrMod = "0": FeaT = "80/40 width * 25/43/50 height": Action = 0
M1 = 0: M2 = 0: M3 = 0
Do While Action <> 99
WaitStopMouseInput
Mainscreen
Mainloop ScrM, ScrMod, FeaT, Action
WaitStopMouseInput
If Action = 3 Then
If ScrM = 10 Then
Screen _NewImage(1000, 800, 32)
Else
Screen Val(ScrMod)
End If
test ScrMod, FeaT
End If
Loop
End
Sub test (Sm As String, F As String)
Cls
r = 1
Do
M1 = 0: M2 = 0: M3 = 0
WaitStopMouseInput
mx = _MouseX
my = _MouseY
For row = 1 To 10
Select Case Sm
Case "32bit"
Color _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
Case "2", "11"
Color 1
Case "10"
Color Int(Rnd * 3) + 1
Case Else
Color row
End Select
If Sm = "0" Then r = 1 Else r = _FontHeight
Locate row, 1
Print mx; " "; Int(my / r); " "; row
Next row
Locate 22
Print "Screen mode " + Sm + " " + F
Print "Press RIGHT mouse button or Escape key to exit";
Select Case Sm
Case "0"
' do not do graphic lines
Case Else
' it draws 2 lines to show vertexes and center of the screen, more a box on the edge of screen
Line (1, 1)-(_Width(0), _Height(0))
Line (_Width(0), 1)-(1, _Height(0))
Line (1, 1)-(_Width(0) - 1, _Height(0) - 1), , B
End Select
_Limit 20
Loop Until M2 = -1 Or InKey$ = Chr$(27)
WaitStopMouseInput
Screen 0
Cls
End Sub
Sub WaitStopMouseInput
Do While _MouseInput
M1 = _MouseButton(1): M2 = _MouseButton(2): M3 = _MouseButton(3)
Loop ' loop to clean mouse input buffer
End Sub
Sub Mainscreen
Screen 0
Print "Tool for testing the setting of screen viewport on the window application"
Locate 3
Color 5
Print "press U for Previous Screen Mode and D for Following Screen Mode"
Print " Enter for testing selected Screen mode"
Color 4
Print "press Left button of mouse for Previous Screen Mode and Right button of "
Print " mouse for following Screen Mode"
Print " Middle button of mouse for testing selected Screen Mode"
Color 14
Print " press Escape key or together Left and Right mouse buttons for quitting"
Color 1
Locate 13
Print "SCREEN " + Space$(15) + " Features"
End Sub
Sub Mainloop (S As Integer, Sm As String, F As String, A As Integer)
Do
Locate 14, 1
Print Space$(80);
Locate 14, 1
Print " " + Sm + Space$(15 - (Len(Sm))) + F
While TakeInput(A) = 0
_Limit 20
Wend
Select Case A
Case 1
'up action
S = S + 1
If S > 10 Then S = 0
Case 2
' down action
S = S - 1
If S < 0 Then S = 10
Case 3, 99
' execute action or exit
Exit Sub
End Select
A = 0 ' it restores neutral value of A
Select Case S
Case 0
Sm = "0"
F = "80/40 width * 25/43/50 height"
Case 1
Sm = "1"
F = " 320 200"
Case 2
Sm = "2"
F = "640 200"
Case 3
Sm = "7"
F = "320 200"
Case 4
Sm = "8"
F = "640 200"
Case 5
Sm = "9"
F = "640 200"
Case 6
Sm = "10"
F = "640 350"
Case 7
Sm = "11"
F = "640 480"
Case 8
Sm = "12"
F = "640 480"
Case 9
Sm = "13"
F = "320 200"
Case 10
Sm = "32bit"
F = "variable W & H "
End Select
Loop
End Sub
Function TakeInput (Action As Integer)
Action = 0
WaitStopMouseInput
C$ = InKey$
If (C$ = Chr$(27) Or (M1 = -1 And M2 = -1)) Then Action = 99
If (C$ = "U" Or M1 = -1) Then Action = 1
If (C$ = "D" Or M2 = -1) Then Action = 2
If (C$ = Chr$(13) Or M3 = -1) Then Action = 3
TakeInput = Action
End Function
Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
Code: (Select All)
_Title "Lubuntu window's cohordinates bug"
Dim Shared GMouse As GMouse
Type GMouse
mx As Integer
my As Integer
lb As Integer
rb As Integer
Lclick As Integer
Rclick As Integer
LclickEvent As _Byte
RclickEvent As _Byte
wheel As Integer
state As Integer
End Type
''Screen Text Graphics Colors Video Text Default
'' Mode Rows Columns Width Height Attrib. BPP Pages Block QB64 Font
'' 0 25/43/50 80/40 No graphics 16/16 DAC 4 0-7 ----- _FONT 16
'' 1 25 40 320 200 16/4 BG 4 none 8 X 8 _FONT 8
'' 2 25 80 640 200 2/mono 1 none 8 X 8 _FONT 8
'' .................................................................................
'' 7 25 40 320 200 16/16 DAC 4 0-7 8 X 8 _FONT 8
'' 8 25 80 640 200 16/16 4 0-3 8 X 8 _FONT 8
'' 9 25 80 640 350 16/64 DAC 4 0-1 8 X 14 _FONT 14
'' 10 25 80 640 350 4/2 GScale 2 none 8 X 14 _FONT 14
'' 11 30/60 80 640 480 2/mono 1 none 8 X 16 _FONT 16
'' 12 30/60 80 640 480 16/262K 4 none 8 X 16 _FONT 16
'' 13 25 40 320 200 256/65K 8 none 8 X 8 _FONT 8
'' _NEWIMAGE width. height, 32
Randomize Timer
Dim ScrM As Integer, ScrMod As String, FeaT As String, Action As Integer
Dim Shared As Integer M1, M2, M3
ScrM = 0: ScrMod = "0": FeaT = "80/40 width * 25/43/50 height": Action = 0
M1 = 0: M2 = 0: M3 = 0
Do While Action <> 99
' WaitStopMouseInput
Mainscreen
Mainloop ScrM, ScrMod, FeaT, Action
GmouseA
' WaitStopMouseInput
If Action = 3 Then
If ScrM = 10 Then
Screen _NewImage(1000, 800, 32)
Else
Screen Val(ScrMod)
End If
test ScrMod, FeaT
End If
Loop
End
Sub test (Sm As String, F As String)
Cls
r = 1
Do
M1 = 0: M2 = 0: M3 = 0
' WaitStopMouseInput
' mx = _MouseX
' my = _MouseY
GmouseA
Dim As Integer Mx, My, Lb, Wheel, State, LcE, RcE
Mouse Mx, My, Lb, Wheel, State, LcE, RcE
For row = 1 To 10
Select Case Sm
Case "32bit"
Color _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
Case "2", "11"
Color 1
Case "10"
Color Int(Rnd * 3) + 1
Case Else
Color row
End Select
If Sm = "0" Then r = 1 Else r = _FontHeight
Locate row, 1
Print Mx; " "; Int(My / r); " "; row
Next row
Locate 22
Print "Screen mode " + Sm + " " + F
Print "Press RIGHT mouse button or Escape key to exit";
Select Case Sm
Case "0"
' do not do graphic lines
Case Else
' it draws 2 lines to show vertexes and center of the screen, more a box on the edge of screen
Line (1, 1)-(_Width(0), _Height(0))
Line (_Width(0), 1)-(1, _Height(0))
Line (1, 1)-(_Width(0) - 1, _Height(0) - 1), , B
End Select
_Limit 20
'Loop Until M2 = -1 Or InKey$ = Chr$(27)
Loop Until RcE Or InKey$ = Chr$(27)
'WaitStopMouseInput
Screen 0
Cls
End Sub
Sub WaitStopMouseInput
Exit Sub
Do While _MouseInput
M1 = _MouseButton(1): M2 = _MouseButton(2): M3 = _MouseButton(3)
Loop ' loop to clean mouse input buffer
End Sub
Sub Mainscreen
Screen 0
Print "Tool for testing the setting of screen viewport on the window application"
Locate 3
Color 5
Print "press U for Previous Screen Mode and D for Following Screen Mode"
Print " Enter for testing selected Screen mode"
Color 4
Print "press Left button of mouse for Previous Screen Mode and Right button of "
Print " mouse for following Screen Mode"
Print " Middle button of mouse for testing selected Screen Mode"
Color 14
Print " press Escape key or together Left and Right mouse buttons for quitting"
Color 1
Locate 13
Print "SCREEN " + Space$(15) + " Features"
End Sub
Sub Mainloop (S As Integer, Sm As String, F As String, A As Integer)
Do
Locate 14, 1
Print Space$(80);
Locate 14, 1
Print " " + Sm + Space$(15 - (Len(Sm))) + F
While TakeInput(A) = 0
_Limit 20
Wend
Select Case A
Case 1
'up action
S = S + 1
If S > 10 Then S = 0
Case 2
' down action
S = S - 1
If S < 0 Then S = 10
Case 3, 99
' execute action or exit
Exit Sub
End Select
A = 0 ' it restores neutral value of A
Select Case S
Case 0
Sm = "0"
F = "80/40 width * 25/43/50 height"
Case 1
Sm = "1"
F = " 320 200"
Case 2
Sm = "2"
F = "640 200"
Case 3
Sm = "7"
F = "320 200"
Case 4
Sm = "8"
F = "640 200"
Case 5
Sm = "9"
F = "640 200"
Case 6
Sm = "10"
F = "640 350"
Case 7
Sm = "11"
F = "640 480"
Case 8
Sm = "12"
F = "640 480"
Case 9
Sm = "13"
F = "320 200"
Case 10
Sm = "32bit"
F = "variable W & H "
End Select
Loop
End Sub
Function TakeInput (Action As Integer)
Action = 0
' WaitStopMouseInput
C$ = InKey$
If (C$ = Chr$(27) Or (M1 = -1 And M2 = -1)) Then Action = 99
GmouseA
Dim As Integer Mx, My, Lb, Wheel, State, LcE, RcE
Mouse Mx, My, Lb, Wheel, State, LcE, RcE
If LcE Then Action = 1
If RcE Then Action = 2
' If (C$ = "U" Or M1 = -1) Then Action = 1
' If (C$ = "D" Or M2 = -1) Then Action = 2
If (C$ = Chr$(13) Or M3 = -1) Then Action = 3
TakeInput = Action
End Function
Sub GmouseA 'this sub is running 1x per 1 my loop. Best solution if mouse is needed in more places at once.
Do While _MouseInput
MoX = MoX + _MouseMovementX
MoY = MoY + _MouseMovementY
If MoX Or MoY Then active = 1
mwh = mwh + _MouseWheel
Loop
GMouse.wheel = mwh
GMouse.mx = _MouseX
GMouse.my = _MouseY
GMouse.lb = _MouseButton(1)
GMouse.rb = _MouseButton(2)
If GMouse.lb Or GMouse.rb Or mwh Then active = 1
GMouse.state = active
If GMouse.lb = -1 Then GMouse.LclickEvent = 0
If GMouse.lb = -1 And GMouse.Lclick = 0 Then
GMouse.LclickEvent = 1
GMouse.Lclick = 1
End If
GMouse.Lclick = GMouse.lb
If GMouse.rb = -1 Then GMouse.RclickEvent = 0
If GMouse.rb = -1 And GMouse.Rclick = 0 Then
GMouse.RclickEvent = 1
GMouse.Rclick = 1
End If
GMouse.Rclick = GMouse.rb
End Sub
Sub Mouse (mx As Integer, my As Integer, lb As Integer, wheel As Integer, state As Integer, LcE As Integer, RcE As Integer)
wheel = GMouse.wheel
state = GMouse.state
mx = GMouse.mx
my = GMouse.my
lb = GMouse.lb
LcE = GMouse.LclickEvent
RcE = GMouse.RclickEvent
'rb = gmouse.rb is not used
'
End Sub
Just lock the last mouse button event until you release the button. Watch what the output does for the Left button event and for the Right button event in my program.
Code: (Select All)
Type GMouse
mx As Integer
my As Integer
lb As Integer
rb As Integer
Lclick As Integer
Rclick As Integer
LclickEvent As Integer
RclickEvent As Integer
wheel As Integer
state As Integer
End Type
Dim Shared GMouse As GMouse
Dim As Integer Mx, My, MouseLB, MouseWH, MouseState, MouseLeftEvent, MouseRightEvent
Do
GmouseA ' call once in my loop or in closed loops
Mouse Mx, My, MouseLB, MouseWH, MouseState, MouseLeftEvent, MouseRightEvent ' call always for reading last mouse events
Locate 1
Print "_MouseX:"; Mx
Print "_MouseY:"; My
Print "Mouse wheel: "; MouseWH
Print "Mouse State: "; MouseState
Print "Mouse Left button: "; MouseLB
Print "Mouse left button event (press and hold left mouse button): "; MouseLeftEvent
Print "Mouse right button event (press and hold right mouse button): "; MouseRightEvent
_Display
_Limit 50
Loop
Sub GmouseA 'this sub is running 1x per 1 my loop. Best solution if mouse is needed in more places at once.
Do While _MouseInput
MoX = MoX + _MouseMovementX
MoY = MoY + _MouseMovementY
If MoX Or MoY Then active = 1
mwh = mwh + _MouseWheel
Loop
GMouse.wheel = mwh
GMouse.mx = _MouseX
GMouse.my = _MouseY
GMouse.lb = _MouseButton(1)
GMouse.rb = _MouseButton(2)
If GMouse.lb Or GMouse.rb Or mwh Then active = 1
GMouse.state = active
If GMouse.lb = -1 Then GMouse.LclickEvent = 0
If GMouse.lb = -1 And GMouse.Lclick = 0 Then
GMouse.LclickEvent = 1
GMouse.Lclick = 1
End If
GMouse.Lclick = GMouse.lb
If GMouse.rb = -1 Then GMouse.RclickEvent = 0
If GMouse.rb = -1 And GMouse.Rclick = 0 Then
GMouse.RclickEvent = 1
GMouse.Rclick = 1
End If
GMouse.Rclick = GMouse.rb
End Sub
Sub Mouse (mx As Integer, my As Integer, lb As Integer, wheel As Integer, state As Integer, LcE As Integer, RcE As Integer)
wheel = GMouse.wheel
state = GMouse.state
mx = GMouse.mx
my = GMouse.my
lb = GMouse.lb
LcE = GMouse.LclickEvent
RcE = GMouse.RclickEvent
'rb = gmouse.rb is not used
'
End Sub
Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
I fixed your program. You used button states (immediate), but I use events. That's why I had to rewrite it. This version works correctly, the previous one only in some places.
Code: (Select All)
_Title "Lubuntu window's coordinates bug"
Type GMouseType
mx As Integer
my As Integer
lb As Integer
rb As Integer
wheel As Integer
state As Integer
LclickEvent As _Byte
RclickEvent As _Byte
End Type
Dim Shared GMouse As GMouseType
Randomize Timer
Dim ScrM As Integer, ScrMod As String, FeaT As String, Action As Integer
ScrM = 0
ScrMod = "0"
FeaT = "80/40 width * 25/43/50 height"
Action = 0
Do While Action <> 99
WaitStopMouseInput
Mainscreen
Mainloop ScrM, ScrMod, FeaT, Action
WaitStopMouseInput
If Action = 3 Then
If ScrM = 10 Then
Screen _NewImage(1000, 800, 32)
Else
Screen Val(ScrMod)
End If
test ScrMod, FeaT
End If
Loop
Sub GmouseA
Static prevLB As Integer, prevRB As Integer
While _MouseInput: Wend
GMouse.mx = _MouseX
GMouse.my = _MouseY
GMouse.lb = _MouseButton(1)
GMouse.rb = _MouseButton(2)
GMouse.wheel = _MouseWheel
GMouse.state = (GMouse.lb Or GMouse.rb Or GMouse.wheel)
' Jednorázové události
If GMouse.lb = -1 And prevLB = 0 Then
GMouse.LclickEvent = 1
Else
GMouse.LclickEvent = 0
End If
If GMouse.rb = -1 And prevRB = 0 Then
GMouse.RclickEvent = 1
Else
GMouse.RclickEvent = 0
End If
prevLB = GMouse.lb
prevRB = GMouse.rb
End Sub
Sub Mouse (mx As Integer, my As Integer, lb As Integer, rb As Integer, wheel As Integer, state As Integer, LcE As Integer, RcE As Integer)
mx = GMouse.mx
my = GMouse.my
lb = GMouse.lb
rb = GMouse.rb
wheel = GMouse.wheel
state = GMouse.state
LcE = GMouse.LclickEvent
RcE = GMouse.RclickEvent
End Sub
Sub WaitStopMouseInput
While _MouseInput: Wend
End Sub
Sub Mainscreen
Screen 0
Print "Tool for testing the setting of screen viewport on the window application"
Locate 3
Color 5
Print "press U for Previous Screen Mode and D for Following Screen Mode"
Print " Enter for testing selected Screen mode"
Color 4
Print "press Left button of mouse for Previous Screen Mode and Right button of"
Print " mouse for following Screen Mode"
Print " Middle button of mouse for testing selected Screen Mode"
Color 14
Print " press Escape key or together Left and Right mouse buttons for quitting"
Color 1
Locate 13
Print "SCREEN " + Space$(15) + " Features"
End Sub
Sub Mainloop (S As Integer, Sm As String, F As String, A As Integer)
Do
Locate 14, 1
Print Space$(80);
Locate 14, 1
Print " " + Sm + Space$(15 - (Len(Sm))) + F
While TakeInput(A) = 0
_Limit 20
Wend
Select Case A
Case 1
S = S + 1
If S > 10 Then S = 0
Case 2
S = S - 1
If S < 0 Then S = 10
Case 3, 99
Exit Sub
End Select
A = 0
Select Case S
Case 0: Sm = "0": F = "80/40 width * 25/43/50 height"
Case 1: Sm = "1": F = " 320 200"
Case 2: Sm = "2": F = "640 200"
Case 3: Sm = "7": F = "320 200"
Case 4: Sm = "8": F = "640 200"
Case 5: Sm = "9": F = "640 200"
Case 6: Sm = "10": F = "640 350"
Case 7: Sm = "11": F = "640 480"
Case 8: Sm = "12": F = "640 480"
Case 9: Sm = "13": F = "320 200"
Case 10: Sm = "32bit": F = "variable W & H"
End Select
Loop
End Sub
Function TakeInput% (Action As Integer)
Action = 0
WaitStopMouseInput
C$ = InKey$
If C$ = Chr$(27) Then Action = 99
GmouseA
Dim mx As Integer, my As Integer
Dim lb As Integer, rb As Integer, wheel As Integer, state As Integer
Dim LcE As Integer, RcE As Integer
Mouse mx, my, lb, rb, wheel, state, LcE, RcE
If LcE Then Action = 1
If RcE Then Action = 2
If lb And rb Then Action = 3
If C$ = Chr$(13) Then Action = 3
TakeInput = Action
End Function
' =====================================================================
Sub test (Sm As String, F As String)
Cls
r = 1
Do
WaitStopMouseInput
GmouseA
Dim mx As Integer, my As Integer
Dim lb As Integer, rb As Integer, wheel As Integer, state As Integer
Dim LcE As Integer, RcE As Integer
Mouse mx, my, lb, rb, wheel, state, LcE, RcE
For row = 1 To 10
Select Case Sm
Case "32bit"
Color _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
Case "2", "11"
Color 1
Case "10"
Color Int(Rnd * 3) + 1
Case Else
Color row
End Select
If Sm = "0" Then r = 1 Else r = _FontHeight
Locate row, 1
Print mx; " "; Int(my / r); " "; row
Next row
Locate 22
Print "Screen mode " + Sm + " " + F
Print "Press RIGHT mouse button or Escape key to exit"
If Sm <> "0" Then
Line (1, 1)-(_Width(0), _Height(0))
Line (_Width(0), 1)-(1, _Height(0))
Line (1, 1)-(_Width(0) - 1, _Height(0) - 1), , B
End If
_Limit 20
Loop Until RcE Or InKey$ = Chr$(27)
WaitStopMouseInput
Screen 0
Cls
End Sub
Posts: 3,447
Threads: 376
Joined: Apr 2022
Reputation:
345
Let me point out some bad logic that you have here.
But, before I do that, let me send you a stream of mouse button information from the mouseinput buffer. Are you ready? My stream of data is going to be the following for mousebutton #1 (the left mouse button):
down
down
down
up
up
down
down
up
down
I have a mouse that's shorting out so it sends these little micropulses all the time....
So you have a DO LOOP:
Code: (Select All)
Sub WaitStopMouseInput
Do While _MouseInput
M1 = _MouseButton(1): M2 = _MouseButton(2): M3 = _MouseButton(3)
Loop ' loop to clean mouse input buffer
End Sub
So this starts running and it DO run WHILE there is MOUSEINPUT in that buffer.
So the loop starts and M1 is....
down
down
down
up
up
down
down
up
down
And then we EXIT the loop.
So at this point M1 reads as being DOWN. It did a whole bunch of assignments and moving memory values back and forth, but at the end of the loop, it tells us the mouse was DOWN.
But let's compare that loop to another one:
WHILE _MOUSEINPUT: WEND
M1 = _MOUSEBUTTON(1)
Well this now runs the buffer and clears it, and then reports the last value of the mouse button to us.
M1 is now... DOWN.
And.... we didn't do a dozen assignments of values back and forth into those variables.
The larger the buffer, the longer your loop processing time is going to be as you're reading those values and then assigning them over and over and over and over and over and over and.... just rewriting the hell out of that one variable.
Why not just run the routine and clear the buffer and then take the value afterwards??
As a logic exercise, *YOU* explain to all the rest of us how the original code would be *any* better than just taking the value at the end of that loop. Run it through your mind however you want. View it from every angle. And then explain WHY you think that you need to get those values *inside* that WHILE loop and not after it's ran and did its thing?
Posts: 3,447
Threads: 376
Joined: Apr 2022
Reputation:
345
and my go at cleaning up the code and fixing the locations and all so things display properly and such for us:
Code: (Select All)
_Title "Lubuntu window's cohordinates bug"
''Screen Text Graphics Colors Video Text Default
'' Mode Rows Columns Width Height Attrib. BPP Pages Block QB64 Font
'' 0 25/43/50 80/40 No graphics 16/16 DAC 4 0-7 ----- _FONT 16
'' 1 25 40 320 200 16/4 BG 4 none 8 X 8 _FONT 8
'' 2 25 80 640 200 2/mono 1 none 8 X 8 _FONT 8
'' .................................................................................
'' 7 25 40 320 200 16/16 DAC 4 0-7 8 X 8 _FONT 8
'' 8 25 80 640 200 16/16 4 0-3 8 X 8 _FONT 8
'' 9 25 80 640 350 16/64 DAC 4 0-1 8 X 14 _FONT 14
'' 10 25 80 640 350 4/2 GScale 2 none 8 X 14 _FONT 14
'' 11 30/60 80 640 480 2/mono 1 none 8 X 16 _FONT 16
'' 12 30/60 80 640 480 16/262K 4 none 8 X 16 _FONT 16
'' 13 25 40 320 200 256/65K 8 none 8 X 8 _FONT 8
'' _NEWIMAGE width. height, 32
Randomize Timer
Dim ScrM As Integer, ScrMod As String, FeaT As String, Action As Integer
Dim Shared As Integer M1, M2, M3
ScrM = 0: ScrMod = "0": FeaT = "80/40 width * 25/43/50 height": Action = 0
M1 = 0: M2 = 0: M3 = 0
_Delay .2
_FullScreen
Do While Action <> 99
Mainscreen
Mainloop ScrM, ScrMod, FeaT, Action
If Action = 3 Then
If ScrM = 10 Then
Screen _NewImage(1000, 800, 32)
Else
Screen Val(ScrMod)
End If
test ScrMod, FeaT
End If
_Display
Loop
System
Sub test (Sm As String, F As String)
Cls
Do
foo = TakeInput 'update the mouse button status for below
mx = _MouseX: my = _MouseY
For row = 1 To 10
Select Case Sm
Case "32bit"
Color -1 'random colors make the screen flicker batshit crazy! 
Case "2", "11": Color 1
Case "10": Color Int(Rnd * 3) + 1
Case Else: Color row
End Select
Locate row, 1: Print mx; " "; my; " ";
If Sm <> "0" Then Print _Ceil((my + 1) / _FontHeight)
Next row
Locate 22: Print "Screen mode " + Sm + " " + F
Print "Press RIGHT mouse button or Escape key to exit";
If Sm <> "0" Then ' it draws 2 lines to show vertexes and center of the screen, more a box on the edge of screen
Line (1, 1)-(_Width(0), _Height(0))
Line (_Width(0), 1)-(1, _Height(0))
Line (1, 1)-(_Width(0) - 1, _Height(0) - 1), , B
End If
_Limit 20
_Display
Loop Until M2 = -1 Or InKey$ = Chr$(27)
Screen 0
Cls
End Sub
Sub Mainscreen
Screen 0
Print "Tool for testing the setting of screen viewport on the window application"
Locate 3
Color 5
Print "press U for Previous Screen Mode and D for Following Screen Mode"
Print " Enter for testing selected Screen mode"
Color 4
Print "press Left button of mouse for Previous Screen Mode and Right button of "
Print " mouse for following Screen Mode"
Print " Middle button of mouse for testing selected Screen Mode"
Color 14
Print " press Escape key or together Left and Right mouse buttons for quitting"
Color 1
Locate 13: Print "SCREEN " + Space$(15) + " Features"
End Sub
Sub Mainloop (S As Integer, Sm As String, F As String, A As Integer)
Do
Locate 14, 1
Print Space$(80);
Locate 14, 1
Print " " + Sm + Space$(15 - (Len(Sm))) + F
A = TakeInput
Select Case A
Case 1 'up action
S = S + 1: If S > 10 Then S = 0
Case 2 ' down action
S = S - 1: If S < 0 Then S = 10
Case 3, 99 ' execute action or exit
Exit Sub
End Select
Select Case S
Case 0: Sm = "0": F = "80/40 width * 25/43/50 height"
Case 1: Sm = "1": F = " 320 200"
Case 2: Sm = "2": F = "640 200"
Case 3: Sm = "7": F = "320 200"
Case 4: Sm = "8": F = "640 200"
Case 5: Sm = "9": F = "640 200"
Case 6: Sm = "10": F = "640 350"
Case 7: Sm = "11": F = "640 480"
Case 8: Sm = "12": F = "640 480"
Case 9: Sm = "13": F = "320 200"
Case 10: Sm = "32bit": F = "variable W & H "
End Select
_Display
Loop
End Sub
Function TakeInput
Static OldM1, OldM2
While _MouseInput: Wend ' loop to clean mouse input buffer
M1 = _MouseButton(1): M2 = _MouseButton(2): M3 = _MouseButton(3)
C$ = UCase$(InKey$) 'in case caps lock isn't on.
If (C$ = Chr$(27) _OrElse (M1 And M2)) Then Action = 99
If (C$ = "U" _OrElse (M1 And Not OldM1)) Then Action = 1
If (C$ = "D" _OrElse (M2 And Not OldM2)) Then Action = 2
If (C$ = Chr$(13) Or M3 = -1) Then Action = 3
TakeInput = Action
OldM1 = M1: OldM2 = M2
End Function
Posts: 522
Threads: 55
Joined: Jul 2022
Reputation:
48
Hi friends
thanks a lot for your answers !
Yeah I love sitting on school chair and starting learning.
I find interesting the different solutions which you brought me.
They point out that it useful to memorize the status of mouse buttons so then it can be related to the following status of mouse buttons and after this comparison it is useful to activate the action when it is necessary.
The two way are different because Petr build up an event status system to trigger the action after gathering the mouse input. In the while Steve memorizes the previous status of mouse buttons for comparing with the actual current status of mouse buttons and activating the action when it is useful.
Thanks again for solving my mind short circuit !
Posts: 522
Threads: 55
Joined: Jul 2022
Reputation:
48
@Steve
I must answer to your question
Quote:As a logic exercise, *YOU* explain to all the rest of us how the original code would be *any* better than just taking the value at the end of that loop. Run it through your mind however you want. View it from every angle. And then explain WHY you think that you need to get those values *inside* that WHILE loop and not after it's ran and did its thing?
at the first round I coded only the keyboard input, but the demo seemed me too plain
so I decided to add mouse input, while I was typing the code I choose to make a sub for clearing the mouse buffer.
When I was developing the mouse input into test SUB I need to get back the mouse input and boring to add other code (some few lines) I thought that in clearing mouse buffer loop I can get the input...it is already there, yeah it is in a loop, but no optimization of resources and time were in my mind and project.
So I apologize for my bad coding habit (no optimization of resource, no time optimization, no global and clear starting project) but I was stunned by the so fast flow of actions leading to a stucking mouse input .
WHY is better inner input loop than input at the end of the loop?
No reason except lazyness that brought me to the arising issue.
My learning here are
1 set better the project and then code
2 also if it seems increasing the time of coding, make it as better as you can, and avoid confounding code.
Posts: 3,447
Threads: 376
Joined: Apr 2022
Reputation:
345
11-18-2025, 01:35 AM
(This post was last modified: 11-18-2025, 01:36 AM by SMcNeill.)
(11-18-2025, 12:03 AM)TempodiBasic Wrote: The two way are different because Petr build up an event status system to trigger the action after gathering the mouse input. In the while Steve memorizes the previous status of mouse buttons for comparing with the actual current status of mouse buttons and activating the action when it is useful.
Note that I mainly just used the MB1 variable and such as your code was already set to use those. All my real mouse handling is in the WHILE _MOUSEINPUT: WEND loop. I just used MB1 because it's less typing than _MOUSEBUTTON(1), but the status of _MOUSEBUTTON(1) never changes to be different than the status of MB1.
My trick is to make certain to only count a NEW down event as a click, and not to check to see if the mouse is simply held down.
IF _MOUSEBUTTON(1) THEN... <-- This is *just* a down event. You hold the button down, it's going to trigger repeatedly and constantly.
IF _MOUSEBUTTON(1) AND NOT OLD_MOUSEBUTTON(1) THEN... <--- This says "If the mouse is now down, and it wasn't down on the previous loop", then it's a NEW mousedown event.
Code: (Select All)
FUNCTION Click
STATIC Old_MouseButton
WHILE _MOUSEINPUT: WEND 'update mouse button status
IF _MOUSEBUTTON(1) AND NOT Old_MouseButton THEN Click = _TRUE
Old_MouseButton = _MOUSEBUTTON(1)
END FUNCTION
See the log in the above?
Track the old mousebutton.
It's only a NEW click if the mouse *was* up, and then becomes *down*.
If the old button state was down... It's not a click, it's a hold. Only process the new clicks to do whatever you want.
It really is that simple of a logic at play.
Mouse has to have been up, and then go down, for it to be a new click to process.
Posts: 522
Threads: 55
Joined: Jul 2022
Reputation:
48
yeah and cause my lazyness I follow the short typing way: memorize the values in variables and put them in comparison with actual machine state got by keyword _Mousebutton()
Code: (Select All)
_Title "Lubuntu window's cohordinates bug: MOD after lessons on forum"
''Screen Text Graphics Colors Video Text Default
'' Mode Rows Columns Width Height Attrib. BPP Pages Block QB64 Font
'' 0 25/43/50 80/40 No graphics 16/16 DAC 4 0-7 ----- _FONT 16
'' 1 25 40 320 200 16/4 BG 4 none 8 X 8 _FONT 8
'' 2 25 80 640 200 2/mono 1 none 8 X 8 _FONT 8
'' .................................................................................
'' 7 25 40 320 200 16/16 DAC 4 0-7 8 X 8 _FONT 8
'' 8 25 80 640 200 16/16 4 0-3 8 X 8 _FONT 8
'' 9 25 80 640 350 16/64 DAC 4 0-1 8 X 14 _FONT 14
'' 10 25 80 640 350 4/2 GScale 2 none 8 X 14 _FONT 14
'' 11 30/60 80 640 480 2/mono 1 none 8 X 16 _FONT 16
'' 12 30/60 80 640 480 16/262K 4 none 8 X 16 _FONT 16
'' 13 25 40 320 200 256/65K 8 none 8 X 8 _FONT 8
'' _NEWIMAGE width. height, 32
Randomize Timer
Dim ScrM As Integer, ScrMod As String, FeaT As String, Action As Integer
Dim Shared As Integer M1, M2, M3
ScrM = 0: ScrMod = "0": FeaT = "80/40 width * 25/43/50 height": Action = 0
M1 = 0: M2 = 0: M3 = 0
Do While Action <> 99
WaitStopMouseInput
Mainscreen
Mainloop ScrM, ScrMod, FeaT, Action
WaitStopMouseInput
If Action = 3 Then
If ScrM = 10 Then
Screen _NewImage(1000, 800, 32)
Else
Screen Val(ScrMod)
End If
test ScrMod, FeaT
End If
Loop
End
Sub test (Sm As String, F As String)
Cls
r = 1
Do
M1 = 0: M2 = 0: M3 = 0
WaitStopMouseInput
mx = _MouseX
my = _MouseY
For row = 1 To 10
Select Case Sm
Case "32bit"
Color _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
Case "2", "11"
Color 1
Case "10"
Color Int(Rnd * 3) + 1
Case Else
Color row
End Select
If Sm = "0" Then r = 1 Else r = _FontHeight
Locate row, 1
Print mx; " "; Int(my / r); " "; row
Next row
Locate 22
Print "Screen mode " + Sm + " " + F
Print "Press RIGHT mouse button or Escape key to exit";
Select Case Sm
Case "0"
' do not do graphic lines
Case Else
' it draws 2 lines to show vertexes and center of the screen, more a box on the edge of screen
Line (1, 1)-(_Width(0), _Height(0))
Line (_Width(0), 1)-(1, _Height(0))
Line (1, 1)-(_Width(0) - 1, _Height(0) - 1), , B
End Select
_Limit 20
Loop Until _MouseButton(2) = -1 Or InKey$ = Chr$(27) ' here it was M2
WaitStopMouseInput
Screen 0
Cls
End Sub
Sub WaitStopMouseInput
Do While _MouseInput
' before it was here wasting resources
Loop ' loop to clean mouse input buffer
'M1 = _MouseButton(1): M2 = _MouseButton(2): M3 = _MouseButton(3)
End Sub
Sub Mainscreen
Screen 0
Print "Tool for testing the setting of screen viewport on the window application"
Locate 3
Color 5
Print "press U for Previous Screen Mode and D for Following Screen Mode"
Print " Enter for testing selected Screen mode"
Color 4
Print "press Left button of mouse for Previous Screen Mode and Right button of "
Print " mouse for following Screen Mode"
Print " Middle button of mouse for testing selected Screen Mode"
Color 14
Print " press Escape key or together Left and Right mouse buttons for quitting"
Color 1
Locate 13
Print "SCREEN " + Space$(15) + " Features"
End Sub
Sub Mainloop (S As Integer, Sm As String, F As String, A As Integer)
Do
Locate 14, 1
Print Space$(80);
Locate 14, 1
Print " " + Sm + Space$(15 - (Len(Sm))) + F
While TakeInput(A) = 0
_Limit 20
Wend
Select Case A
Case 1
'up action
S = S + 1
If S > 10 Then S = 0
Case 2
' down action
S = S - 1
If S < 0 Then S = 10
Case 3, 99
' execute action or exit
Exit Sub
End Select
A = 0 ' it restores neutral value of A
Select Case S
Case 0
Sm = "0"
F = "80/40 width * 25/43/50 height"
Case 1
Sm = "1"
F = " 320 200"
Case 2
Sm = "2"
F = "640 200"
Case 3
Sm = "7"
F = "320 200"
Case 4
Sm = "8"
F = "640 200"
Case 5
Sm = "9"
F = "640 200"
Case 6
Sm = "10"
F = "640 350"
Case 7
Sm = "11"
F = "640 480"
Case 8
Sm = "12"
F = "640 480"
Case 9
Sm = "13"
F = "320 200"
Case 10
Sm = "32bit"
F = "variable W & H "
End Select
Loop
End Sub
Function TakeInput (Action As Integer)
Action = 0
M1 = _MouseButton(1): M2 = _MouseButton(2): M3 = _MouseButton(3)
WaitStopMouseInput
C$ = InKey$
If (C$ = Chr$(27) Or ((_MouseButton(1) And Not (M1 = -1)) And (_MouseButton(2) And Not (M2 = -1)))) Then Action = 99
If (C$ = "U" Or (_MouseButton(1) And Not (M1 = -1))) Then Action = 1
If (C$ = "D" Or (_MouseButton(2) And Not (M2 = -1))) Then Action = 2
If (C$ = Chr$(13) Or (_MouseButton(3) And Not (M3 = -1))) Then Action = 3
M1 = _MouseButton(1): M2 = _MouseButton(2): M3 = _MouseButton(3)
TakeInput = Action
End Function
1. Modding WaitStopMouseInput for not adjourning too quickly mouse button status variables
2. Comparing that hardware status to variables memoring the mouse button status
Tonight I'll code the event driven mode posted by Petr.
Doing is learning
Thanks all you!
Posts: 522
Threads: 55
Joined: Jul 2022
Reputation:
48
Hi
as I said you, just the night after #9 post my tool for testing SCREEN mode in your favourite OS using the event driven method suggested by Petr.
While in the #9 post there is the same tool using the memorizing method suggested by Steve.
Code: (Select All)
_Title "Lubuntu window's cohordinates bug"
''Screen Text Graphics Colors Video Text Default
'' Mode Rows Columns Width Height Attrib. BPP Pages Block QB64 Font
'' 0 25/43/50 80/40 No graphics 16/16 DAC 4 0-7 ----- _FONT 16
'' 1 25 40 320 200 16/4 BG 4 none 8 X 8 _FONT 8
'' 2 25 80 640 200 2/mono 1 none 8 X 8 _FONT 8
'' .................................................................................
'' 7 25 40 320 200 16/16 DAC 4 0-7 8 X 8 _FONT 8
'' 8 25 80 640 200 16/16 4 0-3 8 X 8 _FONT 8
'' 9 25 80 640 350 16/64 DAC 4 0-1 8 X 14 _FONT 14
'' 10 25 80 640 350 4/2 GScale 2 none 8 X 14 _FONT 14
'' 11 30/60 80 640 480 2/mono 1 none 8 X 16 _FONT 16
'' 12 30/60 80 640 480 16/262K 4 none 8 X 16 _FONT 16
'' 13 25 40 320 200 256/65K 8 none 8 X 8 _FONT 8
'' _NEWIMAGE width. height, 32
Randomize Timer
Dim ScrM As Integer, ScrMod As String, FeaT As String, Action As Integer
Dim Shared As Integer M(1 To 3)
ScrM = 0: ScrMod = "0": FeaT = "80/40 width * 25/43/50 height": Action = 0
M(1) = 0: M(2) = 0: M(3) = 0 ' 0 = no event 1 = inclicking 2 = click
Do While Action <> 99
WaitStopMouseInput
Mainscreen
Mainloop ScrM, ScrMod, FeaT, Action
WaitStopMouseInput
If Action = 3 Then
If ScrM = 10 Then
Screen _NewImage(1000, 800, 32)
Else
Screen Val(ScrMod)
End If
test ScrMod, FeaT
End If
Loop
End
Sub test (Sm As String, F As String)
Cls
r = 1
Do
M1 = 0: M2 = 0: M3 = 0
WaitStopMouseInput
mx = _MouseX
my = _MouseY
For row = 1 To 10
Select Case Sm
Case "32bit"
Color _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
Case "2", "11"
Color 1
Case "10"
Color Int(Rnd * 3) + 1
Case Else
Color row
End Select
If Sm = "0" Then r = 1 Else r = _FontHeight
Locate row, 1
Print mx; " "; Int(my / r); " "; row
Next row
Locate 22
Print "Screen mode " + Sm + " " + F
Print "Press RIGHT mouse button or Escape key to exit";
Select Case Sm
Case "0"
' do not do graphic lines
Case Else
' it draws 2 lines to show vertexes and center of the screen, more a box on the edge of screen
Line (1, 1)-(_Width(0), _Height(0))
Line (_Width(0), 1)-(1, _Height(0))
Line (1, 1)-(_Width(0) - 1, _Height(0) - 1), , B
End Select
_Limit 20
Loop Until M(2) = 2 Or InKey$ = Chr$(27)
WaitStopMouseInput
Screen 0
Cls
End Sub
Sub WaitStopMouseInput
Do While _MouseInput
Loop ' loop to clean mouse input buffer
'here mousevent must be translated into program events
For i = 1 To 3
Select Case M(i)
Case 0
' no event status
If _MouseButton(i) = -1 Then M(i) = 1
Case 1
' inclicking status
If _MouseButton(i) = 0 Then M(i) = 2
Case 2
'click status
Rem nothing to do here for the program goal
End Select
Next
End Sub
Sub Mainscreen
Screen 0
Print "Tool for testing the setting of screen viewport on the window application"
Locate 3
Color 5
Print "press U for Previous Screen Mode and D for Following Screen Mode"
Print " Enter for testing selected Screen mode"
Color 4
Print "press Left button of mouse for Previous Screen Mode and Right button of "
Print " mouse for following Screen Mode"
Print " Middle button of mouse for testing selected Screen Mode"
Color 14
Print " press Escape key or together Left and Right mouse buttons for quitting"
Color 1
Locate 13
Print "SCREEN " + Space$(15) + " Features"
End Sub
Sub Mainloop (S As Integer, Sm As String, F As String, A As Integer)
Do
Locate 14, 1
Print Space$(80);
Locate 14, 1
Print " " + Sm + Space$(15 - (Len(Sm))) + F
While TakeInput(A) = 0
_Limit 20
Wend
Select Case A
Case 1
'up action
S = S + 1
If S > 10 Then S = 0
Case 2
' down action
S = S - 1
If S < 0 Then S = 10
Case 3, 99
' execute action or exit
Exit Sub
End Select
A = 0 ' it restores neutral value of A
Select Case S
Case 0
Sm = "0"
F = "80/40 width * 25/43/50 height"
Case 1
Sm = "1"
F = " 320 200"
Case 2
Sm = "2"
F = "640 200"
Case 3
Sm = "7"
F = "320 200"
Case 4
Sm = "8"
F = "640 200"
Case 5
Sm = "9"
F = "640 200"
Case 6
Sm = "10"
F = "640 350"
Case 7
Sm = "11"
F = "640 480"
Case 8
Sm = "12"
F = "640 480"
Case 9
Sm = "13"
F = "320 200"
Case 10
Sm = "32bit"
F = "variable W & H "
End Select
Loop
End Sub
Function TakeInput (Action As Integer)
Action = 0
WaitStopMouseInput
C$ = InKey$
If (C$ = Chr$(27) Or (M(1) = 1 And M(2) = 1)) Then Action = 99 'quitting
If (C$ = "U" Or M(1) = 2) Then Action = 1: M(1) = 0 'rolling up options
If (C$ = "D" Or M(2) = 2) Then Action = 2: M(2) = 0 ' rolling down options
If (C$ = Chr$(13) Or M(3) = 2) Then Action = 3: M(3) = 0 'executing selected options
TakeInput = Action
End Function
|
