Here's the modified tilttest.bas:
Code: Select all
' /*----------------------------------------------------------------------------
'
' NAME
' TiltTest.c
'
' PURPOSE
' Tests pressure, eraser and tilt output
'
' AUTHORS
' Based on prstest from LCS Telegraphics RICO 4/1/92
' Modified by Ken Loftus @ WACOM Technology Corp 2/15/95
' Project file created by Kim Ritchie @ WACOM Technology Corp 8/2004
' Modified by Robert Cohn @ WACOM Technology Corp 2/26/2010
'
' COPYRIGHT
' Copyright (C) 1998 LCS/Telegraphics
' Copyright (c) Wacom Company, Ltd. 2010 All Rights Reserved
' All rights reserved.
'
'---------------------------------------------------------------------------- */
#Include Once "fbgfx.bi"
#Include Once "windows.bi"
'#include <math.h>
'#include <string.h>
#Include Once "wintab.bi"
#define PACKETDATA (PK_X or PK_Y or PK_BUTTONS or PK_NORMAL_PRESSURE or PK_ORIENTATION or PK_CURSOR)
#define PACKETMODE 0
'#include "pktdef.bi" '// NOTE: get from wactab header package
Type tagPACKET
As UINT pkCursor
As DWORD pkButtons
As Integer pkX
As Integer pkY
As UINT pkNormalPressure
As ORIENTATION pkOrientation
End Type: Type As tagPACKET PACKET
Type As tagPACKET Ptr PPACKET, NPPACKET, LPPACKET
Type tagPACKETEXT
As EXTENSIONBASE pkBase
End Type: Type As tagPACKETEXT PACKETEXT
Type As tagPACKETEXT Ptr PPACKETEXT, NPPACKETEXT, LPPACKETEXT
'' Tablet data event queue
Type TabletData
As Point pt
As UINT cur
As UINT prs
As ORIENTATION ort
As TabletData Ptr nxt
End Type
Dim Shared As TabletData Ptr tdFront = 0, tdBack = 0
Extern fb_hWin32ExtWinProc Alias "fb_hWin32ExtWinProc" As Sub (Byval hWnd As HWND, Byval message As Uinteger, Byval wParam As WPARAM, Byval lParam As LPARAM)
Declare Sub FBWndProc (Byval hWnd As HWND, Byval message As Uinteger, Byval wParam As WPARAM, Byval lParam As LPARAM)
#define WACOM_DEBUG
#include Once "msgpack.bi"
#Include Once "Utils.bi"
#include Once "TiltTest.bi"
' /* converts FIX32 to double */
'#define FIX_DOUBLE(x) ((double)(FIX32_INT(x))+((double)FIX32_FRAC(x)/65536))
#define FIX_DOUBLE(x) (CDbl(x) / 65536.0)
#define pi 3.14159265359
'#ifdef WIN32
'#define MoveTo(h,x,y) MoveToEx(h,x,y,NULL)
'#endif
Dim Shared As ZString Ptr gpszProgramName = @"TiltTest"
Dim Shared As HANDLE hInst ' /* Handle for instance */
Dim Shared As HCTX hTab = NULL ' /* Handle for Tablet Context */
Dim Shared As Point ptNew ' /* XY value storage */
Dim Shared As UINT prsNew ' /* Pressure value storage */
Dim Shared As UINT curNew ' /* Cursor number storage */
Dim Shared As ORIENTATION ortNew ' /* Tilt value storage */
'Dim Shared As RECT rcClient ' /* Size of current Client */
'Dim Shared As RECT rcInfoTilt ' /* Size of tilt info box */
'Dim Shared As RECT rcInfoName ' /* Size of cursor name box */
'Dim Shared As RECT rcInfoGen ' /* Size of testing box */
'Dim Shared As RECT rcDraw ' /* Size of draw area */
Dim Shared As Double aziFactor = 1 ' /* Azimuth factor */
Dim Shared As Double altFactor = 1 ' /* Altitude factor */
Dim Shared As Double altAdjust = 1 ' /* Altitude zero adjust */
Dim Shared As BOOL tilt_support = TRUE ' /* Is tilt supported */
'FB Entry/Exit Point
End WinMain( GetModuleHandle( NULL ), NULL, Command, SW_NORMAL )
' /* ------------------------------------------------------------------------- */
Function WinMain Pascal (Byval hInstance As HINSTANCE, Byval hPrevInstance As HINSTANCE, Byval lpCmdLine As LPSTR, Byval nCmdShow As Integer) As Integer
Dim msg_ As MSG
'If hPrevInstance = 0 Then If InitApplication(hInstance) = 0 Then Return FALSE
' /* Perform initializations that apply to a specific instance */
If InitInstance(hInstance, nCmdShow) = 0 Then Return FALSE
fb_hWin32ExtWinProc = @FBWndProc
' /* Acquire and dispatch messages until a WM_QUIT message is received. */
'Do While GetMessage(@msg_, NULL, 0, 0)
' TranslateMessage(@msg_)
' DispatchMessage(@msg_)
'Loop
Do
Sleep 1
Loop While Inkey = ""
'// Return Wintab resources.
Cleanup()
Return msg_.wParam
End Function
'* ------------------------------------------------------------------------- */
#if 0
Function InitApplication(Byval hInstance As HANDLE) As BOOL
Dim As WNDCLASS wc
' /* Fill in window class structure with parameters that describe the */
' /* main window. */
wc.style = 0
wc.lpfnWndProc = Procptr(MainWndProc)
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hInstance
wc.hIcon = LoadIcon(NULL, IDI_APPLICATION)
wc.hCursor = LoadCursor(NULL, IDC_ARROW)
wc.hbrBackground = Cast(HBRUSH, COLOR_APPWORKSPACE + 1)
wc.lpszMenuName = @"TiltTestMenu"
wc.lpszClassName = @"TiltTestWClass"
' /* Register the window class and return success/failure code. */
Return RegisterClass(@wc)
End Function
#endif
' /* ------------------------------------------------------------------------- */
Function InitInstance(Byval hInstance As HANDLE, Byval nCmdShow As Integer) As BOOL
Dim As HWND hWnd ' /* Handle for window */
Dim As HDC hDC ' /* Handle for Device Context */
'Dim As TEXTMETRIC textmetric ' /* Structure for font info */
'Dim As INTEGER nLineH ' /* Holds the text height */
'Dim As INTEGER Xinch, Yinch ' /* Holds the number of pixels per inch */
'Dim As INTEGER Hres, Vres ' /* Holds the screen resolution */
Dim As ZString*50 WName ' /* String to hold window name */
Dim As tagAXIS TpOri(3) ' /* The capabilities of tilt */
Dim As Double tpvar ' /* A temp for converting fix to double */
' /* Save the instance handle in static variable, which will be used in */
' /* many subsequence calls from this application to Windows. */
hInst = hInstance
If LoadWintab() = 0 Then
ShowError( "Wintab not available" )
Return FALSE
End If
' /* check if WinTab available. */
If gpWTInfoA(0, 0, NULL) = 0 Then
MessageBox(NULL, "WinTab Services Not Available.", gpszProgramName, _
MB_OK Or MB_ICONHAND)
Return FALSE
End If
' /* check if WACOM available. */
gpWTInfoA(WTI_DEVICES, DVC_NAME, @WName)
If Left(WName, 5) <> "WACOM" Then
MessageBox(NULL, "Wacom Tablet Not Installed.", gpszProgramName, _
MB_OK Or MB_ICONHAND)
'// return FALSE;
End If
' /* get info about tilt */
tilt_support = gpWTInfoA(WTI_DEVICES,DVC_ORIENTATION,@TpOri(0))
If tilt_support Then
' /* does the tablet support azimuth and altitude */
If TpOri(0).axResolution Andalso TpOri(1).axResolution Then
' /* convert azimuth resulution to double */
tpvar = FIX_DOUBLE(TpOri(0).axResolution)
' /* convert from resolution to radians */
aziFactor = tpvar/(2*pi)
' /* convert altitude resolution to double */
tpvar = FIX_DOUBLE(TpOri(1).axResolution)
' /* scale to arbitrary value to get decent line length */
altFactor = tpvar/1000
' /* adjust for maximum value at vertical */
altAdjust = Cdbl(TpOri(1).axMax/altFactor)
Else ' /* no so dont do tilt stuff */
tilt_support = FALSE
End If
End If
' /* Create a main window for this application instance. */
/'
wsprintf(WName, "TiltTest:%x", hInst)
hWnd = CreateWindow( _
"TiltTestWClass", _
WName, _
WS_OVERLAPPEDWINDOW, _
0, _
0, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
NULL, _
NULL, _
hInstance, _
NULL _
)
' /* If window could not be created, return "failure" */
If hWnd = 0 Then Return FALSE
'/
Screenres 640, 480
Screencontrol(FB.GET_WINDOW_HANDLE , *Cast(Integer Ptr, @hWnd))
/'
' /* Get Device Context and setup a rects to write packet info */
hDC = GetDC(hWnd)
If hDC = 0 Then Return FALSE
GetTextMetrics(hDC, @textmetric)
nLineH = textmetric.tmExternalLeading + textmetric.tmHeight
Xinch = GetDeviceCaps(hDC, LOGPIXELSX)
Yinch = GetDeviceCaps(hDC, LOGPIXELSY)
Hres = GetDeviceCaps(hDC, HORZRES)
Vres = GetDeviceCaps(hDC, VERTRES)
ReleaseDC(hWnd, hDC)
GetClientRect(hWnd, @rcClient)
rcInfoTilt = rcClient
rcInfoTilt.left = Xinch / 8
rcInfoTilt.top = Yinch / 8
rcInfoTilt.bottom = rcInfoTilt.top + nLineH
rcInfoName = rcInfoTilt
rcInfoName.top += nLineH
rcInfoName.bottom += nLineH
rcInfoGen = rcInfoName
rcInfoGen.top += nLineH
rcInfoGen.bottom += nLineH
rcDraw = rcInfoGen
rcDraw.left = 0
rcDraw.top += nLineH
rcDraw.bottom = rcClient.bottom
'/
' /* Make the window visible; update its client area; and return "success" */
'ShowWindow(hWnd, nCmdShow)
'UpdateWindow(hWnd)
Return TRUE
End Function
' /* ------------------------------------------------------------------------- */
Function TabletInit(Byval hWnd As HWND) As HCTX
Dim As LOGCONTEXT lcMine ' /* The context of the tablet */
Dim As AXIS TabletX, TabletY ' /* The maximum tablet size */
' /* get default region */
gpWTInfoA(WTI_DEFCONTEXT, 0, @lcMine)
' /* modify the digitizing region */
wsprintf(lcMine.lcName, "TiltTest Digitizing %x", hInst)
lcMine.lcOptions Or= CXO_MESSAGES
lcMine.lcPktData = PACKETDATA
lcMine.lcPktMode = PACKETMODE
lcMine.lcMoveMask = PACKETDATA
lcMine.lcBtnUpMask = lcMine.lcBtnDnMask
' /* Set the entire tablet as active */
gpWTInfoA(WTI_DEVICES,DVC_X,@TabletX)
gpWTInfoA(WTI_DEVICES,DVC_Y,@TabletY)
lcMine.lcInOrgX = 0
lcMine.lcInOrgY = 0
lcMine.lcInExtX = TabletX.axMax
lcMine.lcInExtY = TabletY.axMax
' /* output the data in screen coords */
lcMine.lcOutOrgX = 0
lcMine.lcOutOrgY = 0
lcMine.lcOutExtX = GetSystemMetrics(SM_CXSCREEN)
' /* move origin to upper left */
lcMine.lcOutExtY = -GetSystemMetrics(SM_CYSCREEN)
' /* open the region */
Return gpWTOpenA(hWnd, @lcMine, TRUE)
End Function
' /* ------------------------------------------------------------------------- */
Sub FBWndProc (Byval hWnd As HWND, Byval message As Uinteger, Byval wParam As WPARAM, Byval lParam As LPARAM)
Dim As FARPROC lpProcAbout ' /* pointer to the about function */
Dim As HDC hDC ' /* handle for Device Context */
Dim As PAINTSTRUCT psPaint ' /* the paint structure */
Dim As PACKET pkt ' /* the current packet */
Dim As BOOL fHandled = TRUE ' /* whether the message was handled or not */
Dim As LRESULT lResult = 0 ' /* the result of the message */
Select Case message
Case WT_PACKET ' /* A packet is waiting from WINTAB */
If gpWTPacket(Cast(HCTX,lParam), wParam, @pkt) Then
Dim As TabletData Ptr p = New TabletData
With *p
.pt.x = pkt.pkX
.pt.y = pkt.pkY
.cur = pkt.pkCursor
.prs = pkt.pkNormalPressure
.ort = pkt.pkOrientation
.nxt = 0
End With
'' push new TabletData event to back of queue
If tdBack <> 0 Then tdBack->nxt = p
tdBack = p
If tdFront = 0 Then tdFront = p
End If
Case Else
fHandled = FALSE
End Select
End Sub
'//////////////////////////////////////////////////////////////////////////////
'// Purpose
'// Release resources we used in this example.
'//
Sub Cleanup()
WACOM_TRACE( !"Cleanup()\n" )
UnloadWintab()
End Sub
Sub FBPaint()
'case WM_PAINT ' /* Paint the window */
Dim As Integer ZAngle ' /* Raw Altitude */
Dim As UINT Theta ' /* Raw Azimuth */
Dim As Double ZAngle2 ' /* Adjusted Altitude */
Dim As Double Theta2 ' /* Adjusted Azimuth */
Dim As Point Z1Angle ' /* Rect coords from polar coords */
Dim As ZString*128 szOutput ' /* String for outputs */
'' fetch new TabletData from front of queue
Dim As TabletData Ptr p = tdFront
If p <> 0 Then
With *p
If tilt_support Then
' /*
' wintab.h defines .orAltitude
' as a UINT but documents .orAltitude
' as positive for upward angles
' and negative for downward angles.
' WACOM uses negative altitude values to
' show that the pen is inverted;
' therefore we cast .orAltitude as an
' (int) and then use the absolute value.
'*/
ZAngle = Cint(.ort.orAltitude)
ZAngle2 = altAdjust - Cdbl(Abs(ZAngle)/altFactor)
' /* adjust azimuth */
Theta = .ort.orAzimuth
Theta2 = Cdbl(Theta/aziFactor)
' /* get the length of the diagnal to draw */
Z1Angle.x = Cint(ZAngle2*Sin(Theta2))
Z1Angle.y = Cint(ZAngle2*Cos(Theta2))
Else
Z1Angle.x = 0
Z1Angle.y = 0
End If
'hDC = BeginPaint(hWnd, @psPaint)
'If hDC Then
Screenlock
Locate 1
' /* write raw tilt info */
If tilt_support Then
'wsprintf(Cast(LPSTR,szOutput), !"Tilt: %03i, Theta: %04u\0", ZAngle,Theta)
'szOutput = "Tilt: " & ZAngle & ", Theta: " & Theta
Print Using !"Tilt: ###_, Theta: ####\t"; ZAngle; Theta
Else
'strcpy(szOutput,"Tilt not supported.")
'szOutput = "Tilt not supported."
Print !"Tilt not supported. \t"
End If
'DrawText(hDC,szOutput,len(szOutput),@rcInfoTilt,DT_LEFT)
' /* write current cursor name */
gpWTInfoA(WTI_CURSORS + .cur, CSR_NAME, @szOutput)
'DrawText(hDC,szOutput,len(szOutput),@rcInfoName,DT_LEFT)
Print szOutput & !"\t"
' /* write tablet name */
gpWTInfoA(WTI_DEVICES, DVC_NAME, @szOutput)
'DrawText(hDC,szOutput,len(szOutput),@rcInfoGen,DT_LEFT)
Print szOutput & !"\t"
' /* draw circle based on tablet pressure */
'Ellipse(hDC, ptNew.x - prsNew, ptNew.y - prsNew, _
' ptNew.x + prsNew, ptNew.y + prsNew)
Circle (ptNew.x, ptNew.y), .prs, 1
' /* draw a line based on tablet tilt */
'MoveTo(hDC,ptNew.x,ptNew.y)
'LineTo(hDC,ptNew.x + Z1Angle.x,ptNew.y - Z1Angle.y)
Line (.pt.x, .pt.y) - Step(Z1Angle.x, Z1Angle.y), 4
' /* draw CROSS based on tablet position */
'MoveTo(hDC,ptNew.x - 20,ptNew.y )
'LineTo(hDC,ptNew.x + 20,ptNew.y )
'MoveTo(hDC,ptNew.x ,ptNew.y - 20)
'LineTo(hDC,ptNew.x ,ptNew.y + 20)
Line (.pt.x - 20, .pt.y) - Step(40, 0), 2
Line (.pt.x, .pt.y - 20) - Step(0, 40), 2
'EndPaint(hWnd, @psPaint)
Screenunlock
End With
'' pop/delete TabletData event
tdFront = p->nxt
If tdFront = 0 Then tdBack = 0
Delete p
End If
End SubA simple patch like this one is needed to the gfxlib:
Code: Select all
src/gfxlib2/win32/gfx_win32.c | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/src/gfxlib2/win32/gfx_win32.c b/src/gfxlib2/win32/gfx_win32.c
index 15842f5..91ed9ff 100644
--- a/src/gfxlib2/win32/gfx_win32.c
+++ b/src/gfxlib2/win32/gfx_win32.c
@@ -133,6 +133,11 @@ static BOOL WINAPI fb_hTrackMouseEvent(TRACKMOUSEEVENT *e)
return FALSE;
}
+
+/* callback to be implemented by programmer */
+extern FBCALL void (*fb_hWin32ExtWinProc)(HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam);
+FBCALL void (*fb_hWin32ExtWinProc)(HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam) = 0;
+
LRESULT CALLBACK fb_hWin32WinProc(HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam)
{
BYTE key_state[256];
@@ -144,6 +149,11 @@ LRESULT CALLBACK fb_hWin32WinProc(HWND hWnd, UINT message, WPARAM wParam, LPARAM
BOOL is_minimized;
MINMAXINFO *mmi;
+ if (fb_hWin32ExtWinProc != 0)
+ {
+ fb_hWin32ExtWinProc(hWnd, message, wParam, lParam);
+ }
+
e.type = 0;
GetClientRect(fb_win32.wnd, rect);Note: Everything compiles and links, but I can't test because I don't have a tablet or the DLL.