/*--------------------------------------------------------
   KeyView2.o2bas -- Displays Keyboard and Character Messages
   adapted to Unicode and ported to Oxygen Basic
   The code in C is discussed in: Programming Windows, Fifth Edition
                 (c) Charles Petzold, 1998
  --------------------------------------------------------*/
$ filename "KeyView2.exe"
'uses rtl32
'uses rtl64

uses corewinW

% SM_CXMAXIMIZED 61
% SM_CYMAXIMIZED 62
% SYSTEM_FONT 13
% WM_INPUTLANGCHANGE 0x0051
% WM_DISPLAYCHANGE 0x007E

type TEXTMETRICW
  long tmHeight
  long tmAscent
  long tmDescent
  long tmInternalLeading
  long tmExternalLeading
  long tmAveCharWidth
  long tmMaxCharWidth
  long tmWeight
  long tmOverhang
  long tmDigitizedAspectX
  long tmDigitizedAspectY
  wchar tmFirstChar
  wchar tmLastChar
  wchar tmDefaultChar
  wchar tmBreakChar
  byte tmItalic
  byte tmUnderlined
  byte tmStruckOut
  byte tmPitchAndFamily
  byte tmCharSet
end type
typedef TEXTMETRICW TEXTMETRIC


' Helper functions
macro iif int(R, A,B,C)
if A then R=B else R=C
end macro

macro iif$ wstring(R, A,B,C)
if A then R=B else R=C
end macro

function min(int a,b)
   if a<b then return a
   return b
end function

indexbase 0

sys hInstance = GetModuleHandle (NULL)
int iCmdShow = SW_SHOW

function WinMain () as sys
     wstring      szAppName = L"KeyView2"
     sys          hwnd
     MSG          msg
     WNDCLASS     wndclass
     
     wndclass.style         = CS_HREDRAW or CS_VREDRAW
     wndclass.lpfnWndProc   = @WndProc
     wndclass.cbClsExtra    = 0
     wndclass.cbWndExtra    = 0
     wndclass.hInstance     = hInstance
     wndclass.hIcon         = LoadIcon (NULL, IDI_APPLICATION)
     wndclass.hCursor       = LoadCursor (NULL, IDC_ARROW)
     wndclass.hbrBackground = GetStockObject (WHITE_BRUSH)
     wndclass.lpszMenuName  = NULL
     wndclass.lpszClassName = strptr szAppName

     if not RegisterClass (&wndclass) then
          MessageBox (NULL, L"Cannot RegisterClass wndclass",
                      szAppName, MB_ICONERROR)
          return 0
     end if
     
     hwnd = CreateWindowEx (0,
                            szAppName, L"Keyboard Message Viewer #2",
                            WS_OVERLAPPEDWINDOW,
                            CW_USEDEFAULT, CW_USEDEFAULT,
                            CW_USEDEFAULT, CW_USEDEFAULT,
                            NULL, NULL, hInstance, NULL)
     
     if not hwnd then                       
          MessageBox (NULL, L"Cannot Create Main Window",
                      szAppName, MB_ICONERROR)
          return 0
     end if
     
     ShowWindow (hwnd, iCmdShow)
     UpdateWindow (hwnd)
     
     while GetMessage (&msg, NULL, 0, 0)
          TranslateMessage (&msg)
          DispatchMessage (&msg)
     wend
 
end function

function WndProc (sys hwnd, uint message, sys wParam, sys lParam) as sys callback
     static DWORD dwCharSet = DEFAULT_CHARSET             
     static int   cxClientMax, cyClientMax, cxClient, cyClient, cxChar, cyChar
     static int   cLinesMax, cLines
     static MSG   *pmsg
     static sys   pMem
     static RECT  rectScroll
     
     wstring szTop = L"Message        Key       Char         Repeat Scan Ext ALT Prev Tran"
     wstring szUnd = L"_______        ___       ____         ______ ____ ___ ___ ____ ____"

     ' array of two strings!
     wstring szFormat[] = { L"%-13s %3d %-19s%c%6u %4d %3s %3s %4s %4s",
                            L"%-13s            0x%04X%1s%c  %9u %4d %3s %3s %4s %4s" }

     wstring szYes  = L"Yes"
     wstring szNo   = L"No"
     wstring szDown = L"Down"
     wstring szUp   = L"Up"

     ' array of 8 strings
     wstring szMessage [] = {
                         L"WM_KEYDOWN",    L"WM_KEYUP",
                         L"WM_CHAR",       L"WM_DEADCHAR",
                         L"WM_SYSKEYDOWN", L"WM_SYSKEYUP",
                         L"WM_SYSCHAR",    L"WM_SYSDEADCHAR" }
     sys          hdc
     int          i, iType
     PAINTSTRUCT  ps
     wchar        szBuffer[128], szKeyName [32]
     TEXTMETRIC   tm

     switch message {
     case WM_INPUTLANGCHANGE
          dwCharSet = wParam
                                   // fall through
     case WM_CREATE
     case WM_DISPLAYCHANGE
     
               // Get maximum size of client area
          cxClientMax = GetSystemMetrics (SM_CXMAXIMIZED)
          cyClientMax = GetSystemMetrics (SM_CYMAXIMIZED)

              // Get character size for fixed-pitch font
          hdc = GetDC (hwnd)

          SelectObject (hdc, CreateFont (0, 0, 0, 0, 0, 0, 0, 0,
                         dwCharSet, 0, 0, 0, FIXED_PITCH, NULL))                 
          GetTextMetrics (hdc, &tm)
          cxChar = tm.tmAveCharWidth
          cyChar = tm.tmHeight

          DeleteObject (SelectObject (hdc, GetStockObject (SYSTEM_FONT)))
          ReleaseDC (hwnd, hdc)

               // Allocate memory for display lines
          if pMem then freememory pmsg

          cLinesMax = cyClientMax / cyChar

          pMem = getmemory (cLinesMax * sizeof (MSG))
          @pmsg = pMem
          cLines = 0
                                   // fall through
     case WM_SIZE
          if message = WM_SIZE then
               cxClient = LOWORD (lParam)
               cyClient = HIWORD (lParam)
          end if
         
               // Calculate scrolling rectangle
          rectScroll.left   = 0
          rectScroll.right  = cxClient
          rectScroll.top    = cyChar
          rectScroll.bottom = cyChar * (cyClient / cyChar)

          InvalidateRect (hwnd, NULL, TRUE)

          if message = WM_INPUTLANGCHANGE then return TRUE
          return 0
         
     case WM_KEYDOWN
     case WM_KEYUP
     case WM_CHAR
     case WM_DEADCHAR
     case WM_SYSKEYDOWN
     case WM_SYSKEYUP
     case WM_SYSCHAR
     case WM_SYSDEADCHAR

               // Rearrange storage array
          for i = cLinesMax - 1 to > 0 step -1         
               pmsg[i] = pmsg[i - 1]
          next i

               // Store new message
          pmsg[0].hwnd = hwnd
          pmsg[0].message = message
          pmsg[0].wParam = wParam
          pmsg[0].lParam = lParam

          cLines = min (cLines + 1, cLinesMax)

               // Scroll up the display
          ScrollWindow (hwnd, 0, -cyChar, &rectScroll, &rectScroll)

          break         // ie, call DefWindowProc so Sys messages work
         
     case WM_PAINT
          hdc = BeginPaint (hwnd, &ps)

          SelectObject (hdc, CreateFont (0, 0, 0, 0, 0, 0, 0, 0,
                          dwCharSet, 0, 0, 0, FIXED_PITCH, NULL)) 
         
          SetBkMode (hdc, TRANSPARENT)
          TextOut (hdc, 0, 0, szTop, len (szTop))
          TextOut (hdc, 0, 0, szUnd, len (szUnd))

          int limit = min (cLines, cyClient / cyChar - 1)         
          for i = 0 to < limit
               ' Oxygen: true=-1
               iType = abs(pmsg[i].message == WM_CHAR ||
                           pmsg[i].message == WM_SYSCHAR ||
                           pmsg[i].message == WM_DEADCHAR ||
                           pmsg[i].message == WM_SYSDEADCHAR)
                       
               GetKeyNameText (pmsg[i].lParam, @szKeyName, 32)

               TextOut (hdc, 0, (cyClient \ cyChar - 1 - i) * cyChar, szBuffer,
                        wsprintf (szBuffer, szFormat [iType],
                                  szMessage [pmsg[i].message - WM_KEYFIRST],                   
                                  pmsg[i].wParam,
                                  iif$ (iType != 0, L" " , szKeyName),
                                  iif (iType != 0, pmsg[i].wParam , L" "),
                                  LOWORD (pmsg[i].lParam),
                                  HIWORD (pmsg[i].lParam) & 0xFF,
                                  iif$ (0x01000000 & pmsg[i].lParam, szYes , szNo),
                                  iif$ (0x20000000 & pmsg[i].lParam, szYes , szNo),
                                  iif$ (0x40000000 & pmsg[i].lParam, szDown, szUp),
                                  iif$ (0x80000000 & pmsg[i].lParam, szUp  , szDown)
                                  ))
          next i
          DeleteObject (SelectObject (hdc, GetStockObject (SYSTEM_FONT)))
          EndPaint (hwnd, &ps)
          return 0

     case WM_DESTROY
          PostQuitMessage (0)
          return 0
     } 'end switch
     return DefWindowProc (hwnd, message, wParam, lParam)
end function

WinMain ()