UDT Screen_Event_Thread (methods and event pointers)

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
fxm
Posts: 8965
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

UDT Screen_Event_Thread (methods and event pointers)

Postby fxm » Jul 21, 2011 18:48

ScreenEvent function (+ programmable timer) processed by UDT, including thread subroutine, methods, and pointers to user events subroutines

This UDT provides to user methods and events to intercept system events (using ScreenEvent function) as mouse or keyboard activity plus a programmable timer.
Consequently, it is not necessary to code a continuously sequenced main loop calling the function ScreenEvent.
All user tasks are activated by the different events.


The thread subroutine is integrated (as private member subroutine + private member function + private member data) in the UDT, and 3 public methods allow to control it:
- Thread_Start_Order
- Thread_Stop_Order
- Thread_End_Wait

A timer is programmable by means of one public property:
- Thread_Timer_Period (0 = ni timer)

14 public pointers to user events subroutines are available to process (or not if pointer = 0) each system event among mouse or keyboard activity plus programmable timer top:
- Event_Key_Press_Sub
- Event_Key_Release_Sub
- Event_Key_Repeat_Sub
- Event_Mouse_Move_Sub
- Event_Mouse_Button_Press_Sub
- Event_Mouse_Button_Release_Sub
- Event_Mouse_Double_Click_Sub
- Event_Mouse_Wheel_Sub
- Event_Mouse_Enter_Sub
- Event_Mouse_Exit_Sub
- Event_Window_Got_Focus_Sub
- Event_Window_Lost_Focus_Sub
- Event_Window_Close_Sub
- Event_Top_Timer_Sub

A single thread is authorized to run at the same time, because of ScreenEvent processing from system events.

Don't call the Thread_End_Wait method from any user event subroutine, otherwise there is locking because any user event is call from the thread subroutine.


File "screen_event_thread.bi" to be included (UDT definition):

Code: Select all

' UDT "Screen_Event_Thread" (methods and event pointers)

' ScreenEvent (+ timer) processed by UDT, including thread subroutine, methods, and pointers to user events subroutines

' File "screen_event_thread.bi" to be included

'-------------------------------------------------------------------------------

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
Using fb ' constants and structures are stored in the FB namespace in lang fb
#endif

'-------------------------------------------------------------------------------

  Type Screen_Event_Thread
    Public: ' declaration of thread member procedures
      Declare Sub Thread_Start_Order () ' a single thread is authorized to run at the same time, because of ScreenEvent processing from system events
      Declare Sub Thread_Stop_Order ()
      Declare Sub Thread_End_Wait () ' do not put inside any user event procedure, otherwise locking because event is call from thread
      Declare Property Thread_Timer_Period () As Double
      Declare Property Thread_Timer_Period (Byval period As Double)
    Public: ' declaration of pointers to user events subroutines
      Dim Event_Key_Press_Sub AS Sub (Byval scancode As Integer, Byval ascii As Integer)
      Dim Event_Key_Release_Sub As Sub (Byval scancode As Integer, Byval ascii As Integer)
      Dim Event_Key_Repeat_Sub As Sub(Byval scancode As Integer, Byval ascii As Integer)
      Dim Event_Mouse_Move_Sub As Sub (Byval x As Integer, Byval y As Integer, Byval dx As Integer, Byval dy As Integer, Byval button As Integer)
      Dim Event_Mouse_Button_Press_Sub As Sub (Byval button As Integer, Byval x As Integer, Byval y As Integer)
      Dim Event_Mouse_Button_Release_Sub As Sub (Byval button As Integer, Byval x As Integer, Byval y As Integer)
      Dim Event_Mouse_Double_Click_Sub As Sub (Byval button As Integer, Byval x As Integer, Byval y As Integer)
      Dim Event_Mouse_Wheel_Sub As Sub (Byval wheel As Integer, Byval x As Integer, Byval y As Integer)
      Dim Event_Mouse_Enter_Sub As Sub ()
      Dim Event_Mouse_Exit_Sub As Sub ()
      Dim Event_Window_Got_Focus_Sub As Sub ()
      Dim Event_Window_Lost_Focus_Sub As Sub ()
      Dim Event_Window_Close_Sub As Sub ()
      Dim Event_Top_Timer_Sub As Sub ()
    Private: ' internal thread procedures and data
      Declare Static Sub Thread (Byval param As Any Ptr)
      Declare Static Function Thread_Run_Status (Byval value As Byte) As Byte
      Dim Thread_Exit As Byte
      Dim Thread_Ptr As Any Ptr
      Dim Thread_Period As Double
      Const False As Byte = 0
      Const True As Byte = Not False
  End Type

  Sub Screen_Event_Thread.Thread_Start_Order ()
    If Not Screen_Event_Thread.Thread_Run_Status(True) Then ' a single thread is authorized to run at the same time, because of Screenevent process from system events
      This.Thread_Exit = False
      This.Thread_Ptr = Threadcreate(@Screen_Event_Thread.Thread, @This)
    End If
  End Sub

  Sub Screen_Event_Thread.Thread_Stop_Order ()
    This.Thread_Exit = True
  End Sub

  Sub Screen_Event_Thread.Thread_End_Wait ()
    Threadwait(This.Thread_Ptr)
  End Sub

  Property Screen_Event_Thread.Thread_Timer_Period () As Double
    Property = This.Thread_Period
  End Property

  Property Screen_Event_Thread.Thread_Timer_Period (Byval period As Double)
    IF period > 0 Then
      This.Thread_Period = period
    Else
      This.Thread_Period = 0
    End If
  End Property

  Static Sub Screen_Event_Thread.Thread (Byval param As Any Ptr)
    Dim e As .EVENT
    Dim x As Integer
    Dim y As Integer
    Dim button As Integer
    Dim Time_Old As Double
    Dim Time_New As Double
    Dim Tempo As Ubyte
    With *Cast(Screen_Event_Thread Ptr, param)
      Do
        If Screenevent(@e) Then
          Select Case As Const e.type
          Case EVENT_KEY_PRESS
            If .Event_Key_Press_Sub > 0 Then
              .Event_Key_Press_Sub(e.scancode, e.ascii)
            End If
          Case EVENT_KEY_RELEASE
            If .Event_Key_Release_Sub > 0 Then
              .Event_Key_Release_Sub(e.scancode, e.ascii)
            End If
          Case EVENT_KEY_REPEAT
            If .Event_Key_Repeat_Sub > 0 Then
              .Event_Key_Repeat_Sub(e.scancode, e.ascii)
            End If
          Case EVENT_MOUSE_MOVE
            x = e.x
            y = e.y
            If .Event_Mouse_Move_Sub > 0 Then
              .Event_Mouse_Move_Sub(e.x, e.y, e.dx, e.dy, button)
            End If
          Case EVENT_MOUSE_BUTTON_PRESS
            button = button Or e.button
            If .Event_Mouse_Button_Press_Sub > 0 Then
              .Event_Mouse_Button_Press_Sub(e.button, x, y)
            End If
          Case EVENT_MOUSE_BUTTON_RELEASE
            button = button Xor e.button
            If .Event_Mouse_Button_Release_Sub > 0 Then
              .Event_Mouse_Button_Release_Sub(e.button, x, y)
            End If
          Case EVENT_MOUSE_DOUBLE_CLICK
            button = button Or e.button
            If .Event_Mouse_Double_Click_Sub > 0 Then
              .Event_Mouse_Double_Click_Sub(e.button, x, y)
            End If
          Case EVENT_MOUSE_WHEEL
            If .Event_Mouse_Wheel_Sub > 0 Then
              .Event_Mouse_Wheel_Sub(e.z, x, y)
            End If
          Case EVENT_MOUSE_ENTER
            If .Event_Mouse_Enter_Sub > 0 Then
              .Event_Mouse_Enter_Sub()
            End If
          Case EVENT_MOUSE_EXIT
            If .Event_Mouse_Exit_Sub > 0 Then
              .Event_Mouse_Exit_Sub()
            End If
          Case EVENT_WINDOW_GOT_FOCUS
            If .Event_Window_Got_Focus_Sub > 0 Then
              .Event_Window_Got_Focus_Sub()
            End If
          Case EVENT_WINDOW_LOST_FOCUS
            If .Event_Window_Lost_Focus_Sub > 0 Then
              .Event_Window_Lost_Focus_Sub()
            End If
          Case EVENT_WINDOW_CLOSE
            If .Event_Window_Close_Sub > 0 Then
              .Event_Window_Close_Sub()
            End If
          End Select
        End If
        Tempo = 10
        If .Event_Top_Timer_Sub > 0 And .Thread_Timer_Period > 0 Then
          Time_New = Timer
          If Time_New > Time_Old + .Thread_Timer_Period Or Time_New < Time_Old Then ' Time_New < Time_Old : value of Timer (Time_New) reset
            Time_old = Time_New
            .Event_Top_Timer_Sub()
          End If
          If (Time_Old + .Thread_Timer_Period - Time_New) * 128 < Tempo Then ' tempo (for sleep) not negligible relating to remaining time
            Tempo = 0
          End If
        End If
        If tempo > 0 Then
          Sleep Tempo, 1
        End If
      Loop Until .Thread_Exit
    End With
    Screen_Event_Thread.Thread_Run_Status(False) ' a single thread is authorized to run at the same time, because of Screenevent process from system events
  End Sub

  Static Function Screen_Event_Thread.Thread_Run_Status (Byval value As Byte) As Byte
    Static Thread_Status As Byte
    Function = Thread_Status ' output last status value
    Thread_Status = value ' then memorize new status value
  End Function


File "screen_event_main.bas" as a test program (UDT usage test):

Code: Select all

' UDT "Screen_Event_Thread" (methods and event pointers)

' ScreenEvent (+ timer) processed by UDT, including thread subroutine, methods, and pointers to user events subroutines

' File "screen_event_main.bas" as test program

'-------------------------------------------------------------------------------

#Include "screen_event_thread.bi"

' declaration of user events subroutines
Declare Sub Key_Press (Byval scancode As Integer, Byval ascii As Integer)
Declare Sub Key_Release (Byval scancode As Integer, Byval ascii As Integer)
Declare Sub Key_Repeat (Byval scancode As Integer, Byval ascii As Integer)
Declare Sub Mouse_Move (Byval x As Integer, Byval y As Integer, Byval dx As Integer, Byval dy As Integer, Byval button As Integer)
Declare Sub Mouse_Button_Press (Byval button As Integer, Byval x As Integer, Byval y As Integer)
Declare Sub Mouse_Button_Release (Byval button As Integer, Byval x As Integer, Byval y As Integer)
Declare Sub Mouse_Double_Click (Byval button As Integer, Byval x As Integer, Byval y As Integer)
Declare Sub Mouse_Wheel (Byval wheel As Integer, Byval x As Integer, Byval y As Integer)
Declare Sub Mouse_Enter ()
Declare Sub Mouse_Exit ()
Declare Sub Window_Got_Focus ()
Declare Sub Window_Lost_Focus ()
Declare Sub Window_Close ()
Declare Sub Top_Timer ()

' instancing (one only) of UDT and assignation of events pointers
Dim Shared param As Screen_Event_Thread Ptr
param = New Screen_Event_Thread
  param->Event_Key_Press_Sub = @Key_Press
  param->Event_Key_Release_Sub = @Key_Release
  param->Event_Key_Repeat_Sub = @Key_Repeat
  param->Event_Mouse_Move_Sub = @Mouse_Move
  param->Event_Mouse_Button_Press_Sub = @Mouse_Button_Press
  param->Event_Mouse_Button_Release_Sub = @Mouse_Button_Release
  param->Event_Mouse_Double_Click_Sub = @Mouse_Double_Click
  param->Event_Mouse_Wheel_Sub = @Mouse_Wheel
  param->Event_Mouse_Enter_Sub = @Mouse_Enter
  param->Event_Mouse_Exit_Sub = @Mouse_Exit
  param->Event_Window_Got_Focus_Sub = @Window_Got_Focus
  param->Event_Window_Lost_Focus_Sub = @Window_Lost_Focus
  param->Event_Window_Close_Sub = @Window_Close
  param->Event_Top_Timer_Sub = @Top_Timer
  param->Thread_Timer_Period = 1

'-------------------------------------------------------------------------------

' main program
ScreenRes 640, 480
param->Thread_Start_Order
param->Thread_End_Wait ' do not put inside any user event procedure, otherwise locking because event is call from thread
Delete Param
End

'-------------------------------------------------------------------------------

' definition of user events subroutines

Sub Key_Press (Byval scancode As Integer, Byval ascii As Integer)
  Print "Key press:"; "   cancode="; scancode; " / ascii="; ascii
End Sub

Sub Key_Release (Byval scancode As Integer, Byval ascii As Integer)
  Print "Key release:"; "   scancode="; scancode; " / ascii="; ascii
  If scancode = 1 Then
    Sleep 500, 1
    Param->Thread_Stop_Order
  End If
End Sub

Sub Key_Repeat (Byval scancode As Integer, Byval ascii As Integer)
  Print "Key repeat:"; "   scancode="; scancode; " / ascii="; ascii
End Sub

Sub Mouse_Move (Byval x As Integer, Byval y As Integer, Byval dx As Integer, Byval dy As Integer, Byval button As Integer)
  Print "Mouse move:"; "   x="; x; " / y="; y; "   dx="; dx; " / dy="; dy; "   button="; button
End Sub

Sub Mouse_Button_Press (Byval button As Integer, Byval x As Integer, Byval y As Integer)
  Print "Mouse button press:"; "   button ="; button; "   x="; x; " / y="; y
End Sub

Sub Mouse_Button_Release (Byval button As Integer, Byval x As Integer, Byval y As Integer)
  Print "Mouse button release:"; "   button ="; button; "   x="; x; " / y="; y
End Sub

Sub Mouse_Double_Click (Byval button As Integer, Byval x As Integer, Byval y As Integer)
  Print "Mouse button double click:"; "   button ="; button; "   x="; x; " / y="; y
End Sub

Sub Mouse_Wheel (Byval wheel As Integer, Byval x As Integer, Byval y As Integer)
  Print "Mouse wheel:"; "   wheel="; wheel; "   x="; x; " / y="; y
End Sub

Sub Mouse_Enter ()
  Print "Mouse enter"
End Sub

Sub Mouse_Exit ()
  Print "Mouse exit"
End Sub

Sub Window_Got_Focus ()
  Print "Window got focus"
End Sub

Sub Window_Lost_Focus ()
  Print "Window lost focus"
End Sub

Sub Window_Close ()
  Print "Window close"
  Sleep 500, 1
  Param->Thread_Stop_Order
End Sub

Sub Top_Timer ()
  Print "Top timer:"; "   time="; Time
End Sub
BasicScience
Posts: 474
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Postby BasicScience » Jul 21, 2011 21:07

Excellent. This will be very useful.
bcohio2001
Posts: 509
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Re: UDT Screen_Event_Thread (methods and event pointers)

Postby bcohio2001 » Nov 18, 2013 21:18

I like this!
Yes, an OLD THREAD revived.

There is an event not listed. Unsure if it was added in the past two plus years since posting.

According to wiki:
EVENT_MOUSE_HWHEEL (14) The horizontal mouse wheel was used; the new horizontal wheel position is returned into the .w field.


Is this referring to a wheel that rolls horizontal, or when you "tilt" the wheel to left or right?
If it is referring to a wheel that rolls, is there any way to test for user "tilting" the wheel?
Merick
Posts: 1038
Joined: May 28, 2007 1:52

Re: UDT Screen_Event_Thread (methods and event pointers)

Postby Merick » Nov 19, 2013 6:40

Unless you are using some kind of profiler (i.e "setpoint" for logitech mice), the "tilt" should show up as a button press.
dodicat
Posts: 5758
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: UDT Screen_Event_Thread (methods and event pointers)

Postby dodicat » Nov 20, 2013 2:51

Another aspect of screenevents, Freebasic could do with a built in routine to reset the mouse wheel to zero if and when required.
Renewing the screen is a bit crude and results in a flash, A workaround is easy enough but a proper routine would be preferable IMO.
Also using fbgfx screenevent is pretty slow at times.
But thanks anyway fxm

Workaround for resetting mousewheel:

Code: Select all

Sub resetwheel(mw As Integer,Byref f As Integer)
    f=mw
End Sub

Function wheel(Byref mw As Integer,flag As Integer) As Integer
    Function= mw-flag
End Function

Function incircle(x As Integer,y As Integer,rad As Integer,mx As Integer,my As Integer) As Integer
    Return ((x-mx)*(x-mx)+(y-my)*(y-my))<rad*rad
End Function

Screenres 500,500
windowtitle "Click circle to reset the wheel"
Dim As Integer mx,my,mw,mb,flag
Do
    Getmouse mx,my,mw,mb
   
    Screenlock
    Cls
    If incircle(100,100,10,mx,my) Then
        Circle(100,100),10,2,,,,f
        If mb=1 Then resetwheel(mw,flag)
    End If
    Circle(100,100),10
     Draw String(120,100),"MouseWheel = " & wheel(mw,flag)
    Screenunlock
    Sleep 1,1
Loop Until Len(Inkey)
 

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest