Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
loupedeck.bi
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 24.12.2023 01:06:11 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts LOUPEDECK-Live Linux Treiber, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
'##############################################################################################################################################################
'##############################################################################################################################################################
'### loupedeck.bi - V:1.01.0 - R:0
'##############################################################################################################################################################
'##############################################################################################################################################################
'### Date of Idea: 2023.12.08 - 01:55:12
'### Autor: Wiemann Television Broadcast Service
'### Martin Wiemann
'### Contact: sourcecode@wiemann.tv
'### Licence: DE: Tu was du nicht lassen kannst, solange du hiermit nicht mehr Geld verdienst als ich.
'##############################################################################################################################################################
'##############################################################################################################################################################
'####################################################################################################################################################################################################################################
#Include Once "crt/stdio.bi"
#Include Once "crt.bi"
#Include Once "file.bi"
'####################################################################################################################################################################################################################################
#Define TCGETS2 &H802C542A
#Define TCSETS2 &H402C542B
#define TIOCGSERIAL &H541E
#define TIOCSSERIAL &H541F
#Define BOTHER &H1000
#Define CBAUD &HFFF
#Define ASYNC_LOW_LATENCY &H0040
#Define TIOCM_DTR &H002
#Define TIOCM_RTS &H004
#Define TIOCMBIS &H5416
#Define IGNPAR &H4
#Define CSIZE &H30
#Define CS8 &H30
#Define CRTSCTS &H80000000
#Define IXON &H200
#Define IXOFF &H400
#Define IXANY &H800
#Define CLOCAL &H800
#Define CREAD &H100
#Define TCSANOW &H0
'####################################################################################################################################################################################################################################
Type termios2
c_iflag As ULong
c_oflag As ULong
c_cflag As ULong
c_lflag As ULong
c_line As UByte
c_cc(1 to 19) As UByte
c_ispeed As ULong
c_ospeed As ULong
End Type
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Type termios
c_iflag As ULong
c_oflag As ULong
c_cflag As ULong
c_lflag As ULong
c_cc(0 To 19) As UByte
End Type
'####################################################################################################################################################################################################################################
Type serial_struct
type As Integer
line As Integer
port As UInteger
irq As Integer
flags As Integer
xmit_fifo_size As Integer
custom_divisor As Integer
baud_base As Integer
close_delay As UShort
io_type As UByte
reserved_char(1) As UByte
hub6 As Integer
closing_wait As UShort
closing_wait2 As UShort
iomem_base As UByte Ptr
iomem_reg_shift As UShort
port_high As UInteger
reserved(20) As UByte
End Type
'####################################################################################################################################################################################################################################
Type Loupdeck_TImage
V_Width as UInteger
V_Height as UInteger
V_BPP as UInteger
V_Data as ULong Ptr
V_FontType as TImage_FontType_Enum
V_FontT as UInteger
V_FontH as UInteger
V_FontP as UInteger Ptr
V_FontW as UInteger Ptr
Declare Sub CLS (ByRef V_Color as UInteger = &H00000000)
Declare Sub ReplaceColor (ByRef V_ColorFind as UInteger, ByRef V_ColorReplace as UInteger)
Declare Sub PSET (ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Color as UInteger = &H00000000)
Declare Function Point (ByRef V_X as Integer, ByRef V_Y as Integer) as UInteger
Declare Sub Line (ByRef V_X1 as Integer, ByRef V_Y1 as Integer, ByRef V_X2 as Integer, ByRef V_Y2 as Integer, ByRef V_Color as UInteger = &H00000000, ByRef V_Box as Integer = 0, ByRef V_Filled as Integer = 0, ByRef V_LineStyle as TImage_LineStyle_Enum = LineStyle_Continues)
Declare Sub Circle (ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Radius as Integer, ByRef V_Color as UInteger = &HFFFFFFFF, ByRef V_Filled as Integer = 0, ByRef V_LineStyle as TImage_LineStyle_Enum = LineStyle_Continues)
Declare Sub Put (ByRef V_TargetX as Integer, V_TargetY as Integer, ByRef V_SourceImage as TImage Ptr, ByRef V_SourceX as UInteger = 0, ByRef V_SourceY as UInteger = 0, ByRef V_SourceW as UInteger = 0, ByRef V_SourceH as UInteger = 0, ByRef V_CopyMaskColor as UInteger = &HFF000000, ByRef V_PutColor as UInteger = &HFF000000, V_IgnorCopyMaskColor as Integer = 0, V_TransparencyMaskColor as UInteger = &HFF000000)
Declare Sub DrawString (ByRef V_Font as TImage Ptr = 0, ByRef V_Text as String, ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Color as UInteger = &HFFFFFF, ByRef V_CharSpace as Integer = 0, ByRef V_LineSpace as Integer = 0, ByRef V_NoLinebreak as Integer = 0, ByRef V_CheckAlpha as Integer = 0)
End Type
'####################################################################################################################################################################################################################################
Declare Function xerrno_ CDecl Alias "__errno_location" () As Integer Ptr Ptr
Declare Function xopen_ CDecl Alias "open" (ByVal __file As ZString Ptr, ByVal __oflag As Long, ...) As Long
Declare Function xwrite_ CDecl Alias "write" (ByVal __FN As Long, ByVal __Buffer as any ptr, ByVal __BufferLen as UInteger) As Long
Declare Function xread_ CDecl Alias "read" (ByVal __FN As Long, ByVal __Buffer as any ptr, ByVal __BufferLen as UInteger) As Long
Declare Function xclose_ CDecl Alias "close" (ByVal __FN As Long) As Long
Declare Function xioctl_ CDecl Alias "ioctl" (ByVal __FN As Long, ByVal __cmd as Long, ...) As Long
Declare Function xtcgetattr_ CDecl Alias "tcgetattr" (ByVal __FN As Long, ByVal __termios As termios Ptr) As Long
Declare Function xtcsetattr_ CDecl Alias "tcsetattr" (ByVal __FN As Long, ByVal optional_actions As Long, ByVal __termios As termios Ptr) As Long
'####################################################################################################################################################################################################################################
Enum Loupedeck_GURU
LDG_NoErrorNoData = 2
LDG_NoError = 1
LDG_Unknown = 0
LDG_CantOpenDevice = -1
LDG_CantChangeBaudrate = -2
LDG_CantWriteToDevice = -3
LDG_CantReadFromDevice = -4
LDG_DeviceDontAnswer = -5
LDG_WrongInitAnswer = -6
LDG_LDIDnotFound = -7
LDG_WrongMessage = -8
LDG_UnknownMessage = -9
LDG_CommunicationError = -10
LDG_NoFreeTransID = -11
LDG_TimeoutWhileWaitForAnswer = -12
LDG_WrongImageDimension = -13
End Enum
'####################################################################################################################################################################################################################################
Enum Loupedeck_INT_State_Enum
LDS_Unknown = 0
LDS_Connected
End Enum
'####################################################################################################################################################################################################################################
Enum Loupedeck_INT_Command_Enum
LDC_Unknown = &H00
LDC_Button_Color_Set = &H02
LDC_Serial = &H03
LDC_Reset = &H06
LDC_Version = &H07
LDC_Brightness_Set = &H09
LDC_DrawFramebuffer = &H0F
LDC_SetFramebuffer = &H10
LDC_Vibration_Set = &H1B
End Enum
'####################################################################################################################################################################################################################################
Enum Loupedeck_Event_Type
LDET_Unknown = 0
LDET_Down = 1
LDET_Up = 2
LDET_CW = 3
LDET_CCW = 4
End Enum
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Enum Loupedeck_Element_Type
LDLT_Unknown = 0
LDLT_Button = 1
LDLT_Knob = 2
LDLT_Display = 3
End Enum
'####################################################################################################################################################################################################################################
Enum Loupedeck_INT_Transaction_Enum
LDTE_Free = 0
LDTE_Wait = 1
LDTE_Completed = 2
End Enum
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Type Loupedeck_INT_Transaction_Type
V_State as Loupedeck_INT_Transaction_Enum
V_Timeout as Double
V_TXCmd as Loupedeck_INT_Command_Enum
V_TXMsg as String
V_RXMsg as String
End Type
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Type Loupedeck_INT_Type
V_InUse as Integer
V_FN as Integer
V_State as Loupedeck_INT_State_Enum
V_Callback as Sub (V_LDID as UInteger, V_Event as Loupedeck_Event_Type, V_Element as Loupedeck_Element_Type, V_ElementID as UByte, V_PushForce as UByte, V_X as UShort, V_Y as UShort, V_Section as UByte)
V_Data as String
V_Transaction(0 to 255) as Loupedeck_INT_Transaction_Type
V_TransactionID as Integer
V_Serial as String
V_Version as String
V_DrawSurface(0 to 479, 0 to 270) as UShort
V_SurfaceChange as Integer
End Type
'####################################################################################################################################################################################################################################
Dim Shared G_Loupdeck_INT_D() as Loupedeck_INT_Type
Dim Shared G_Loupdeck_INT_C as UInteger
'####################################################################################################################################################################################################################################
Function Loupedeck_GetGURUDesc(V_GURU as Loupedeck_GURU) as String
Select Case V_GURU
Case LDG_NoError : Return "No Error"
Case LDG_Unknown : Return "Unknown error"
Case LDG_CantOpenDevice : Return "Can not open device"
Case LDG_CantChangeBaudrate : Return "Can not change baudrate"
Case LDG_CantWriteToDevice : Return "Can not write to device"
Case LDG_CantReadFromDevice : Return "Can not read from device"
Case LDG_DeviceDontAnswer : Return "No answer from device"
Case LDG_WrongInitAnswer : Return "Wrong answer from device"
Case LDG_LDIDnotFound : Return "LDID not found"
Case LDG_CommunicationError : Return "Communication error"
Case Else: Return "Unknown GURU-Code"
End Select
End Function
'####################################################################################################################################################################################################################################
Function Loupedeck_INT_Serial_Open(ByRef V_DevicePath as String, ByRef R_FN as Integer) as Integer
R_FN = xopen_(StrPtr(V_DevicePath), O_RDWR OR O_NONBLOCK OR O_NOCTTY OR O_CLOEXEC OR O_SYNC)
If R_FN = -1 Then Return -1
Return 1
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_Serial_Close(ByRef V_FN as Integer) as Integer
xclose_(V_FN)
Return 1
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_Serial_Write(ByRef V_FN as Integer, V_Data as String) as Integer
Dim TLen as Integer = xwrite_(V_FN, StrPtr(V_Data), Len(V_Data))
If TLen <> Len(V_Data) Then Return -1
Return 1
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_Serial_Read(ByRef V_FN as Integer, ByRef R_Data as String) as Integer
R_Data = ""
Dim T as String = String(255, 0)
Dim TRV as Integer
Do
TRV = xread_(V_FN, StrPtr(T), Len(T))
If TRV = -1 Then Exit Do
R_Data &= Left(T, TRV)
Loop
Return 1
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_Serial_Baudrate_Get(ByRef V_FN as Integer, ByRef R_Baudrate as ULong) as Integer
Dim TRV as Integer
Dim TIO2 as termios2
TRV = xioctl_(V_FN, TCGETS2, @TIO2)
If TRV = -1 Then Return -1
R_Baudrate = TIO2.c_ospeed
Return 1
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_Serial_Baudrate_Set(ByRef V_FN as Integer, V_Baudrate as ULong) as Integer
Dim TRV as Integer
Dim TIO2 as termios2
TRV = xioctl_(V_FN, TCGETS2, @TIO2)
If TRV = -1 Then Return -1
TIO2.c_cflag AND= (NOT CBAUD)
TIO2.c_cflag OR= BOTHER
TIO2.c_ospeed = V_Baudrate
TIO2.c_ispeed = V_Baudrate
TRV = xioctl_(V_FN, TCSETS2, @TIO2)
If TRV = -1 Then Return -1
Return 1
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_Serial_LowLatency_Get(ByRef V_FN as Integer, ByRef R_Enabled as Integer) as Integer
Dim TRV as Integer
Dim TSS as serial_struct
TRV = xioctl_(V_FN, TIOCGSERIAL, @TSS)
If TRV = -1 Then Return -1
R_Enabled = 0
If (TSS.flags AND ASYNC_LOW_LATENCY) <> 0 Then R_Enabled = 1
Return 1
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_Serial_LowLatency_Set(ByRef V_FN as Integer, V_Enabled as Integer) as Integer
Dim TRV as Integer
Dim TSS as serial_struct
TRV = xioctl_(V_FN, TIOCGSERIAL, @TSS)
If TRV = -1 Then Return -1
Dim TE as Integer = 0
If (TSS.flags AND ASYNC_LOW_LATENCY) <> 0 Then TE = 1
If (V_Enabled = 0) AND (TE = 0) Then Return 1
If (V_Enabled <> 0) AND (TE <> 0) Then Return 1
If V_Enabled = 0 Then
TSS.flags AND= (NOT ASYNC_LOW_LATENCY)
Else
TSS.flags OR= ASYNC_LOW_LATENCY
End If
TRV = xioctl_(V_FN, TIOCSSERIAL, @TSS)
If TRV = -1 Then Return -1
Return 1
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_Serial_Setup(ByRef V_FN as Integer) as Integer
Dim TRV as Integer
Dim TFlag as Integer = TIOCM_DTR Or TIOCM_RTS
TRV = xioctl_(V_FN, TIOCMBIS, @TFlag)
If TRV = -1 Then Return -1
Dim TIO as termios
TRV = xtcgetattr_(V_FN, @TIO)
If TRV = -1 Then Return -1
TIO.c_iflag = IGNPAR
TIO.c_cflag AND= NOT CSIZE
TIO.c_cflag OR= CS8
TIO.c_cflag AND= NOT CRTSCTS
TIO.c_iflag AND= NOT (IXON OR IXOFF OR IXANY)
TIO.c_cflag OR= CLOCAL
TIO.c_cflag OR= CREAD
TIO.c_oflag = 0
TIO.c_lflag = 0
xtcsetattr_(V_FN, TCSANOW, @TIO)
If TRV = -1 Then Return -1
Return 1
End Function
'####################################################################################################################################################################################################################################
Function Loupedeck_XYtoSection(V_LDID as UInteger, V_X as UShort, V_Y as UShort, ByRef R_Section as UByte) as Loupedeck_GURU
If V_LDID <= 0 Then Return LDG_LDIDnotFound
If V_LDID > G_Loupdeck_INT_C Then Return LDG_LDIDnotFound
If G_Loupdeck_INT_D(V_LDID).V_InUse = 0 Then Return LDG_LDIDnotFound
If V_X >= 480 Then R_Section = 0: Return LDG_NoError
If V_X < 60 Then R_Section = 1: Return LDG_NoError
If V_X >= 420 Then R_Section = 2: Return LDG_NoError
If V_Y >= 270 Then R_Section = 0: Return LDG_NoError
Dim TX as Integer = V_X - 60
If V_Y < 90 Then
If TX < 90 Then R_Section = 3: Return LDG_NoError
If TX < 180 Then R_Section = 4: Return LDG_NoError
If TX < 270 Then R_Section = 5: Return LDG_NoError
R_Section = 6: Return LDG_NoError
End If
If V_Y < 180 Then
If TX < 90 Then R_Section = 7: Return LDG_NoError
If TX < 180 Then R_Section = 8: Return LDG_NoError
If TX < 270 Then R_Section = 9: Return LDG_NoError
R_Section = 10: Return LDG_NoError
End If
If TX < 90 Then R_Section = 11: Return LDG_NoError
If TX < 180 Then R_Section = 12: Return LDG_NoError
If TX < 270 Then R_Section = 13: Return LDG_NoError
R_Section = 14: Return LDG_NoError
End Function
'####################################################################################################################################################################################################################################
Function Loupedeck_INT_ReceiveAndProcess(V_LDID as UInteger) as Loupedeck_GURU
If V_LDID <= 0 Then Return LDG_LDIDnotFound
If V_LDID > G_Loupdeck_INT_C Then Return LDG_LDIDnotFound
With G_Loupdeck_INT_D(V_LDID)
If .V_InUse = 0 Then Return LDG_LDIDnotFound
Dim T as String
Dim TRV as Integer
Dim TEvent as Loupedeck_Event_Type
Dim TElement as Loupedeck_Element_Type
Dim TElementID as UByte
Dim TSectionID as UByte
Dim TPushForce as UByte
Dim TX as UShort
Dim TY as UShort
Do
TRV = Loupedeck_INT_Serial_Read(.V_FN, T)
If TRV <> 1 Then Loupedeck_INT_Serial_Close(.V_FN): Return LDG_CantReadFromDevice
If T = "" Then Exit Do
.V_Data &= T
Loop
Do
If .V_Data = "" Then Return LDG_NoErrorNoData
'Print #1, "BUFF: ";
'For X as Integer = 0 to Len(.V_Data) - 1
' Print #1, Hex(.V_Data[X], 2) & " ";
'Next
'Print #1, ""
If Len(.V_Data) > &HFFFF Then Return LDG_CommunicationError
If Len(.V_Data) < 2 Then Return LDG_NoErrorNoData
If .V_Data[0] <> &H82 Then Return LDG_WrongMessage
If Len(.V_Data) < .V_Data[1] + 2 Then Return LDG_NoErrorNoData
T = Left(.V_Data, .V_Data[1] + 2)
.V_Data = Mid(.V_Data, .V_Data[1] + 3)
If Len(T) < 5 Then Return LDG_WrongMessage
T = Mid(T, 4)
'Print #1, "LINE: ";
'For X as Integer = 0 to Len(T) - 1
' Print #1, Hex(T[X], 2) & " ";
'Next
'Print #1, ""
'Print #1, "TRNS: " & T[1]
If T[1] <= 0 Then
If .V_Callback <> 0 Then
If Len(T) >= 8 Then
'Display-Size: 480×272
Select Case T[0]
Case &H4D, &H6D
TPushForce = T[7]
TX = (T[3] SHL 8) OR T[4]
TY = (T[5] SHL 8) OR T[6]
Select Case T[0]
Case &H4D: TEvent = LDET_Down
Case &H6D: TEvent = LDET_Up
End Select
Loupedeck_XYtoSection(V_LDID, TX, TY, TSectionID)
.V_Callback(V_LDID, TEvent, TElement, TElementID, TPushForce, TX, TY, TSectionID)
End Select
ElseIf Len(T) >= 4 Then
Select Case T[0]
Case &H0 'Button
Select Case T[3]
Case &H0: TEvent = LDET_Down
Case &H1: TEvent = LDET_Up
End Select
TPushForce = &HFF
TElementID = T[2]
TX = 0: TY = 0
Select Case T[2]
Case &H1 to &H6 'Knob-Buttons
.V_Callback(V_LDID, TEvent, TElement, TElementID, TPushForce, TX, TY, 0)
Case &H7 to &HE 'Push-Buttons
.V_Callback(V_LDID, TEvent, TElement, TElementID, TPushForce, TX, TY, 0)
End Select
Case &H1 'Knob Rotate
Select Case T[3]
Case &H1: TEvent = LDET_CW
Case &HFF: TEvent = LDET_CCW
End Select
TPushForce = &HFF
TElementID = T[2]
TX = 0: TY = 0
Select Case T[2]
Case &H1 to &H6 'Knob-Buttons
.V_Callback(V_LDID, TEvent, TElement, TElementID, TPushForce, TX, TY, 0)
End Select
End Select
End If
End If
Else
With .V_Transaction(T[1])
.V_RXMsg = Mid(T, 3)
.V_State = LDTE_Completed
If T[0] <> .V_TXCmd Then Return LDG_WrongMessage
End With
End If
Loop
End With
Return LDG_NoError
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_GetFreeTransID(ByRef V_LD as Loupedeck_INT_Type) as Integer
Dim TTransID as Integer
V_LD.V_TransactionID += 1
If V_LD.V_TransactionID = 0 Then V_LD.V_TransactionID += 1
For X as Integer = V_LD.V_TransactionID to 255
If V_LD.V_Transaction(X).V_State = LDTE_Free Then TTransID = X: Exit For
Next
If TTransID = 0 Then
For X as Integer = 1 to V_LD.V_TransactionID
If V_LD.V_Transaction(X).V_State = LDTE_Free Then TTransID = X: Exit For
Next
End If
If TTransID = 0 Then Return 0
With V_LD.V_Transaction(TTransID)
.V_TXMsg = ""
.V_RXMsg = ""
End With
Return TTransID
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_DataBuild(V_TransactionID as UByte, V_Command as Loupedeck_INT_Command_Enum, V_Data as String = "") as String
Dim TMsgHead as String = String(3, 0)
Dim TDataLen as ULong = Len(V_Data)
If TDataLen < (&HFF - 3) Then
TMsgHead[0] = CUByte(CUByte(3) + CUByte(TDataLen))
Else: TMsgHead[0] = &HFF
End If
TMsgHead[1] = CUByte(V_Command)
TMsgHead[2] = V_TransactionID
Dim TMsg as String = TMsgHead & V_Data
Dim TMsgLen as ULong = Len(TMsg)
Dim THead as String
If TMsgLen > &HFF Then
TDataLen += 3
THead = String(14, 0)
THead[0] = &H82
THead[1] = &HFF
THead[2] = 0 '(TDataLen SHR 56) AND &HFF
THead[3] = 0 '(TDataLen SHR 48) AND &HFF
THead[4] = 0 '(TDataLen SHR 40) AND &HFF
THead[5] = 0 '(TDataLen SHR 32) AND &HFF
THead[6] = (TDataLen SHR 24) AND &HFF
THead[7] = (TDataLen SHR 16) AND &HFF
THead[8] = (TDataLen SHR 8) AND &HFF
THead[9] = TDataLen AND &HFF
Else
THead = String(6, 0)
THead[0] = &H82
THead[1] = &H80 + TMsgLen
End If
Return THead & TMsg
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_SendMSG(V_LDID as UInteger, V_Command as UByte, V_Data as String = "", ByRef R_TransID as Integer = 0) as Loupedeck_GURU
If V_LDID <= 0 Then Return LDG_LDIDnotFound
If V_LDID > G_Loupdeck_INT_C Then Return LDG_LDIDnotFound
With G_Loupdeck_INT_D(V_LDID)
If .V_InUse = 0 Then Return LDG_LDIDnotFound
R_TransID = Loupedeck_INT_GetFreeTransID(G_Loupdeck_INT_D(V_LDID))
If R_TransID = 0 Then Return LDG_NoFreeTransID
With .V_Transaction(R_TransID)
.V_State = LDTE_Wait
.V_Timeout = Timer() + 3
.V_TXCmd = V_Command
.V_TXMsg = Loupedeck_INT_DataBuild(R_TransID, V_Command, V_Data)
End With
Dim TRV as Integer = Loupedeck_INT_Serial_Write(.V_FN, .V_Transaction(R_TransID).V_TXMsg)
If TRV <> 1 Then .V_Transaction(R_TransID).V_State = LDTE_Free: Return LDG_CantWriteToDevice
End With
Return LDG_NoError
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_SendMSGwAnswer(V_LDID as UInteger, V_Command as UByte, V_Data as String = "", ByRef R_Data as String = "") as Loupedeck_GURU
If V_LDID <= 0 Then Return LDG_LDIDnotFound
If V_LDID > G_Loupdeck_INT_C Then Return LDG_LDIDnotFound
With G_Loupdeck_INT_D(V_LDID)
If .V_InUse = 0 Then Return LDG_LDIDnotFound
Dim TTransID as Integer = Loupedeck_INT_GetFreeTransID(G_Loupdeck_INT_D(V_LDID))
If TTransID = 0 Then Return LDG_NoFreeTransID
With .V_Transaction(TTransID)
.V_State = LDTE_Wait
.V_Timeout = Timer() + 3
.V_TXCmd = V_Command
.V_TXMsg = Loupedeck_INT_DataBuild(TTransID, V_Command, V_Data)
End With
Dim TRV as Integer = Loupedeck_INT_Serial_Write(.V_FN, .V_Transaction(TTransID).V_TXMsg)
If TRV <> 1 Then .V_Transaction(TTransID).V_State = LDTE_Free: Return LDG_CantWriteToDevice
Do
TRV = Loupedeck_INT_ReceiveAndProcess(V_LDID)
If (TRV <> LDG_NoError) AND (TRV <> LDG_NoErrorNoData) Then .V_Transaction(TTransID).V_State = LDTE_Free: Return TRV
If .V_Transaction(TTransID).V_State = LDTE_Completed Then
R_Data = .V_Transaction(TTransID).V_RXMsg
.V_Transaction(TTransID).V_State = LDTE_Free
Return LDG_NoError
End If
If .V_Transaction(TTransID).V_Timeout < Timer() Then
.V_Transaction(TTransID).V_State = LDTE_Free
Return LDG_TimeoutWhileWaitForAnswer
End If
Sleep 10, 1
Loop
End With
Return LDG_TimeoutWhileWaitForAnswer
End Function
'####################################################################################################################################################################################################################################
Function Loupedeck_Close(V_LDID as UInteger) as Loupedeck_GURU
If V_LDID <= 0 Then Return LDG_LDIDnotFound
If V_LDID > G_Loupdeck_INT_C Then Return LDG_LDIDnotFound
If G_Loupdeck_INT_D(V_LDID).V_InUse = 0 Then Return LDG_LDIDnotFound
Loupedeck_INT_Serial_Close(G_Loupdeck_INT_D(V_LDID).V_FN)
With G_Loupdeck_INT_D(V_LDID)
.V_InUse = 0
End With
Return LDG_NoError
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_Connect(V_DevicePath as String, ByRef R_LDID as UInteger) as Loupedeck_GURU
R_LDID = 0
'If Dir(V_DevicePath, -1) = "" Then Return LDG_CantOpenDevice
Dim TTry as Integer
Dim TFN as Integer
Dim TRV as Integer
Dim TBaudrate as ULong = 256000
Dim T as String
For TTry = 1 to 4
If TTry = 4 Then Return LDG_DeviceDontAnswer
TRV = Loupedeck_INT_Serial_Open(V_DevicePath, TFN)
If TRV <> 1 Then Return LDG_CantOpenDevice
TRV = Loupedeck_INT_Serial_Baudrate_Get(TFN, TBaudrate)
If TRV <> 1 Then Loupedeck_INT_Serial_Close(TFN): Return LDG_CantChangeBaudrate
TBaudrate = 256000
TRV = Loupedeck_INT_Serial_Baudrate_Set(TFN, TBaudrate)
If TRV <> 1 Then Loupedeck_INT_Serial_Close(TFN): Return LDG_CantChangeBaudrate
TRV = Loupedeck_INT_Serial_Baudrate_Get(TFN, TBaudrate)
If TRV <> 1 Then Loupedeck_INT_Serial_Close(TFN): Return LDG_CantChangeBaudrate
TRV = Loupedeck_INT_Serial_LowLatency_Set(TFN, 1)
If TRV <> 1 Then Loupedeck_INT_Serial_Close(TFN): Return LDG_CantChangeBaudrate
Sleep 100, 1
TRV = Loupedeck_INT_Serial_Setup(TFN)
If TRV <> 1 Then Loupedeck_INT_Serial_Close(TFN): Return LDG_CantChangeBaudrate
T = "GET /index.html HTTP/1.1" & Chr(10) & "Connection: Upgrade" & Chr(10) & "Upgrade: websocket" & Chr(10) & "Sec-WebSocket-Key: 123abc" & Chr(10) & Chr(10)
TRV = Loupedeck_INT_Serial_Write(TFN, T)
If TRV <> 1 Then Loupedeck_INT_Serial_Close(TFN): Return LDG_CantWriteToDevice
Dim TTot as Double = Timer() + 2
Dim S as String = "HTTP/1.1 101 Switching Protocols"
Do
If TTot < Timer() Then Loupedeck_INT_Serial_Close(TFN): Exit Do
TRV = Loupedeck_INT_Serial_Read(TFN, T)
If TRV <> 1 Then Loupedeck_INT_Serial_Close(TFN): Return LDG_CantReadFromDevice
If T <> "" Then
If Left(T, Len(S)) <> S Then
Loupedeck_INT_Serial_Close(TFN)
Return LDG_WrongInitAnswer
Else: Exit For
End If
End If
Sleep 10, 1
Loop
Next
For X as UInteger = 1 to G_Loupdeck_INT_C
If G_Loupdeck_INT_D(X).V_InUse = 0 Then R_LDID = X: Exit For
Next
If R_LDID = 0 Then
G_Loupdeck_INT_C += 1
R_LDID = G_Loupdeck_INT_C
Redim Preserve G_Loupdeck_INT_D(G_Loupdeck_INT_C) as Loupedeck_INT_Type
End If
Dim TRVMsg as String
With G_Loupdeck_INT_D(R_LDID)
.V_InUse = 1
.V_FN = TFN
.V_State = LDS_Connected
.V_Data = ""
.V_SurfaceChange = &B00000000
For X as Integer = 0 to 255
.V_Transaction(X).V_State = LDTE_Free
Next
TRV = Loupedeck_INT_SendMSGwAnswer(R_LDID, LDC_Serial, , TRVMsg)
If TRV = LDG_NoError Then If Len(TRVMsg) >= 3 Then .V_Serial = TRVMsg
TRV = Loupedeck_INT_SendMSGwAnswer(R_LDID, LDC_Version, , TRVMsg)
If TRV = LDG_NoError Then If Len(TRVMsg) >= 3 Then .V_Version = Str(TRVMsg[0]) & "." & Str(TRVMsg[1]) & "." & Str(TRVMsg[2])
End With
Return LDG_NoError
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_SetCallback(V_LDID as UInteger, V_Callback as Any Ptr) as Loupedeck_GURU
If V_LDID <= 0 Then Return LDG_LDIDnotFound
If V_LDID > G_Loupdeck_INT_C Then Return LDG_LDIDnotFound
If G_Loupdeck_INT_D(V_LDID).V_InUse = 0 Then Return LDG_LDIDnotFound
G_Loupdeck_INT_D(V_LDID).V_Callback = V_Callback
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_Checkup(V_LDID as UInteger) as Loupedeck_GURU
Dim TRV as Loupedeck_GURU = Loupedeck_INT_ReceiveAndProcess(V_LDID)
If TRV = LDG_NoErrorNoData Then Return LDG_NoError
Return LDG_NoError
End Function
'####################################################################################################################################################################################################################################
Function Loupedeck_Reset(V_LDID as UInteger) as Loupedeck_GURU
Return Loupedeck_INT_SendMSG(V_LDID, LDC_Reset, "")
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_VibrationSet(V_LDID as UInteger, V_Intensity as UByte) as Loupedeck_GURU
Dim T as String = Space(1)
T[0] = V_Intensity
Dim TRVMsg as String
Return Loupedeck_INT_SendMSGwAnswer(V_LDID, LDC_Vibration_Set, T, TRVMsg)
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_ButtonColorSet(V_LDID as UInteger, V_ElementID as UByte, V_Color as ULong) as Loupedeck_GURU
Dim T as String = Space(4)
T[0] = V_ElementID
T[1] = (V_Color SHR 16) AND &HFF
T[2] = (V_Color SHR 8) AND &HFF
T[3] = V_Color AND &HFF
Return Loupedeck_INT_SendMSGwAnswer(V_LDID, LDC_Button_Color_Set, T)
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_DisplayBrightnessSet(V_LDID as UInteger, V_Brightness as UByte) as Loupedeck_GURU
Dim T as String = Space(1)
T[0] = V_Brightness
If T[0] > 10 Then T[0] = 10
Return Loupedeck_INT_SendMSGwAnswer(V_LDID, LDC_Brightness_Set, T)
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_Flip(V_LDID as UInteger) as Loupedeck_GURU
If V_LDID <= 0 Then Return LDG_LDIDnotFound
If V_LDID > G_Loupdeck_INT_C Then Return LDG_LDIDnotFound
With G_Loupdeck_INT_D(V_LDID)
If .V_InUse = 0 Then Return LDG_LDIDnotFound
Dim TRV as Integer
If (.V_SurfaceChange AND &B00000001) <> 0 Then TRV = Loupedeck_INT_SendMSGwAnswer(V_LDID, LDC_DrawFramebuffer, Chr(0) & "L"): If TRV <> LDG_NoError Then Return TRV '360x270
If (.V_SurfaceChange AND &B00000010) <> 0 Then TRV = Loupedeck_INT_SendMSGwAnswer(V_LDID, LDC_DrawFramebuffer, Chr(0) & "A"): If TRV <> LDG_NoError Then Return TRV '60x270
If (.V_SurfaceChange AND &B00000100) <> 0 Then TRV = Loupedeck_INT_SendMSGwAnswer(V_LDID, LDC_DrawFramebuffer, Chr(0) & "R"): If TRV <> LDG_NoError Then Return TRV '60x270
.V_SurfaceChange = 0
End With
Return LDG_NoError
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function Loupedeck_INT_DrawTImageToFBSection(V_LDID as UInteger, V_Section as UByte, V_Image as TImage Ptr) as Loupedeck_GURU
If V_LDID <= 0 Then Return LDG_LDIDnotFound
If V_LDID > G_Loupdeck_INT_C Then Return LDG_LDIDnotFound
With G_Loupdeck_INT_D(V_LDID)
If .V_InUse = 0 Then Return LDG_LDIDnotFound
Dim TSX as Integer
Dim TSY as Integer
Dim TSW as Integer
Dim TSH as Integer = 270
Select Case V_Section
Case 1: TSW = 60 : TSH = 270 : .V_SurfaceChange OR= &B00000001
Case 2: TSW = 60 : TSH = 270 : .V_SurfaceChange OR= &B00000100
Case 3 to 14
TSX = (V_Section - 3) MOD 4
TSY = ((V_Section - 3) - TSX) / 4
TSX *= 90
TSY *= 90
TSW = 90
TSH = 90
.V_SurfaceChange OR= &B00000010
Case Else: Return LDG_NoError
End Select
If V_Image->V_Width <> TSW Then Return LDG_WrongImageDimension
If V_Image->V_Height <> TSH Then Return LDG_WrongImageDimension
Dim TByteStream as String = String(TSW * TSH * 2, 0)
ImageConvertRow(V_Image->V_Data, 32, @TByteStream[0], 16, TSW * TSH, 0)
Dim TRV as Integer
Dim TDrawHeader as String = String(10, 0)
TDrawHeader[2] = (TSX SHR 8) AND &HFF 'X
TDrawHeader[3] = (TSX AND &HFF) 'X
TDrawHeader[4] = (TSY SHR 8) AND &HFF 'Y
TDrawHeader[5] = (TSY AND &HFF) 'Y
TDrawHeader[6] = (TSW SHR 8) AND &HFF 'W
TDrawHeader[7] = (TSW AND &HFF) 'W
TDrawHeader[8] = (TSH SHR 8) AND &HFF 'H
TDrawHeader[9] = (TSH AND &HFF) 'H
Select Case V_Section
Case 1: TDrawHeader[1] = 76
Case 2: TDrawHeader[1] = 82
Case 3 to 14: TDrawHeader[1] = 65
End Select
TRV = Loupedeck_INT_SendMSGwAnswer(V_LDID, LDC_SetFramebuffer, TDrawHeader & TByteStream)
If TRV <> LDG_NoError Then Return TRV
End With
Return LDG_NoError
End Function