{
    This file is part of Chentrah,
    Copyright (C) 2004-2010 Anton Rzheshevski (chebmaster@mail.ru).

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/

 **********************************************************************}
{$longstrings on}
{$codepage utf-8}

unit cl_wintab;  //Pen tablet suport for Windows

interface

uses SysUtils, Windows;

var
  WinTabError: WideString;
  WinTabLoaded: boolean = false;

type
  TPenEvent = record x, y, pressure, reserved1, reserved2, reserved3: single end;
  TWinTabManager = class
  protected
    Tablet: THandle;
    Initialized: boolean;
    PressureRange, AzimuthRange, Altituderange, TwistRange: integer;
    dll: THandle;
  public
    MyrangeX,
    MyRangeY,
    PenTabletXOrigin,
    PenTabletYOrigin,
    PenTabletXResolution,
    PenTabletYResolution: integer;

    ErrorMessage: WideString;
    DeviceName: WideString;
    Events: array of TPenEvent;
    constructor Create;
    destructor Destroy;
    procedure Pulse;
  end;

var
  WinTabManager: TWinTabManager = nil;


implementation
  uses cge;


const
  CTX_NAME = 1;
  WTI_DEFSYSCTX = 4;
  WTI_DEVICES	  = 100;
  DVC_X           = 12;
  DVC_Y           = 13;
  DVC_NAME        = 1;
  DVC_NPRESSURE	  = 15;
  DVC_ORIENTATION = 17;
  NAMELEN = 40;
  CXO_SYSTEM = $0001;
  WT_DEFBASE = $7FF0;
  PK_X               = $80;
  PK_Y               = $100;
  PK_NORMAL_PRESSURE = $400;
  PK_ORIENTATION     = $1000;

type
  TPacket = record
    pkX: LongInt;
    pkY: LongInt;
    pkNormalPressure: integer;
    orAzimuth: integer;
    orAltitude: integer;
    orTwist: integer;
  end;

  TAxis = record
    axMin: LongInt;
    axMax: LongInt;
    axUnits: Cardinal;
    axResolution: dword;
  end;

  TLogoContext = record
    lcName: array[0..NAMELEN-1] of char;
    lcOptions,
    lcStatus,
    lcLocks,
    lcMsgBase,
    lcDevice,
    lcPktRate,
    lcPktData,
    lcPktMode,
    lcMoveMask,
    lcBtnDnMask,
    lcBtnUpMask: dword;
    lcInOrgX,
    lcInOrgY,
    lcInOrgZ,
    lcInExtX,
    lcInExtY,
    lcInExtZ,
    lcOutOrgX,
    lcOutOrgY,
    lcOutOrgZ,
    lcOutExtX,
    lcOutExtY,
    lcOutExtZ: LongInt;
    lcSensX,
    lcSensY,
    lcSensZ: dword;
    lcSysMode: LongBool;
    lcSysOrgX,
    lcSysOrgY,
    lcSysExtX,
    lcSysExtY: LongInt;
    lcSysSensX,
    lcSysSensY: dword;
  end;

var
  WTInfo: function (wCategory, nIndex: Cardinal; lpOutput: Pointer): Cardinal; stdcall;
 // WTInfoW: function (wCategory, nIndex: Cardinal; lpOutput: Pointer): Cardinal; stdcall;
  WTOpen: function (hw: HWnd; var lc: TLogoContext; fEnable: LongBool): THandle; stdcall;
  WTClose: function (hc: THandle): LongBool; stdcall;
  WTPacketsGet: function (hc: THandle; cMaxPackets: Integer; lpPkts: Pointer): Integer; stdcall;

constructor TWinTabManager.Create;
var
  lc: TLogoContext;
  npAxis: TAxis;
  orAxes: array[0..2] of TAxis;
  name_string: AnsiString;
  dnl: integer;
  ass, dss: string[NAMELEN + 1];
  DrvName: AnsiString = '';
  DevName: AnsiString = '';
  pss: WideString = '';
begin
  DeviceName:= RuEn('не найден','not found');
  try
    dll := LoadLibrary('wintab32.dll');
    if dll = 0 then
      ErrorMessage:= RuEn(
        'не удалось загрузить wintab32.dll - вероятно, драйвер планшета не установлен',
        'failed to load wintab32.dll, most probably no tablet driver is installed')
    else begin
      pointer(WTInfo) := GetProcAddress(dll, 'WTInfoA');
   //   WTInfoW := GetProcAddress(dll, 'WTInfoW');
      pointer(WTOpen) := GetProcAddress(dll, 'WTOpenA');
      pointer(WTClose) := GetProcAddress(dll, 'WTClose');
      pointer(WTPacketsGet) := GetProcAddress(dll, 'WTPacketsGet');

      name_string:=  'chentrah_' + IntToStr(WindowManager.Handle) + #0;

      WTInfo(WTI_DEFSYSCTX, 0, @lc);
      Move(name_string[1], lc.lcName[0], length(name_string));
      lc.lcOptions:= lc.lcOptions or CXO_SYSTEM;
      lc.lcMsgBase:= WT_DEFBASE;
      lc.lcPktData:= PK_X or PK_Y or PK_NORMAL_PRESSURE or PK_ORIENTATION;
      lc.lcPktMode:= 0;
      lc.lcMoveMask:= PK_X or PK_Y or PK_NORMAL_PRESSURE or PK_ORIENTATION;
      lc.lcBtnUpMask:= lc.lcBtnDnMask;
      {Одна из причин почему GIMP не может работать с Genius G-Pen 4500 -
        глючный драйвер херит установку по оси X. И возвращает значение в родных координатах.
        Я применяю хак здесь, устанавливаю лимиты в размер экрана. Это решает проблему,
        но за счёт потери теряется субпиксельной точности!
        }
      if Config.Bool['pentablet', 'wintab-allow-subpixel-precision'] then begin
        MyRangeX:= 30000;
        MyRangeY:= 30000;
      end else begin
        MyRangeX:= MotherState.ScreenWidth;
        MyRangeY:= MotherState.ScreenHeight;
      end;
      lc.lcOutExtX:= MyRangeX;
      lc.lcOutExtY:= MyRangeY;

      Tablet := WTOpen(WindowManager.Handle, lc, TRUE);
      if Tablet = 0 then begin
        ErrorMessage:= RuEn(
          'драйвер, похоже, установлен, но планшета нет',
          'the driver seems to be installed but there is no tablet');
      end
      else begin
        WTInfo(WTI_DEVICES + lc.lcDevice, DVC_NPRESSURE, @npAxis);
        PressureRange := npAxis.axMax;
        if PressureRange = 0 then ErrorMessage:= RuEn(
          'нельзя использовать, т.к. отсутствует чувствительность к нажатию',
          'cannot use it as it has no pressure sensitivity')
        else begin
          WTInfo(WTI_DEVICES + lc.lcDevice, DVC_X, @npAxis);
          PenTabletXOrigin := npAxis.axMin;
          PenTabletXResolution := max(1, npAxis.axMax - npAxis.axMin);
          WTInfo(WTI_DEVICES + lc.lcDevice, DVC_X, @npAxis);
          PenTabletYOrigin := npAxis.axMin;
          PenTabletYResolution := max(1, npAxis.axMax - npAxis.axMin);

          pss:= PervertedFormat(RuEn(
                     '%1x%2, %0 градаций чувствительности к нажатию',
                     '%1x%2, pressure sensitivity range %0'), [PressureRange + 1, PenTabletXResolution, PenTabletYResolution]);
          MotherState.PenTabletPressureResolution:= PressureRange + 1;

          //Get the orientation (tilt&twist) ranges:
          WTInfo(WTI_DEVICES + lc.lcDevice, DVC_ORIENTATION, @orAxes[0]);
          AzimuthRange:= orAxes[0].axMax - orAxes[0].axMin;
          AltitudeRange:= orAxes[1].axMax - orAxes[1].axMin;
          TwistRange:= orAxes[2].axMax - orAxes[2].axMin;
          if (AzimuthRange = 0) or (AltitudeRange = 0) then pss+= RuEn(
            ', нет чувствительности к наклону',
            ', no tilt sensitivity');
        end;
        SetLength(ass, NAMELEN);


        //Get the driver name (in Wine it's "Wine Tablet Context", in a real Windows it's usually an empty string)
        FillChar(ass[1], length(ass), 0);
        WTInfo(WTI_DEFSYSCTX, CTX_NAME, @ass[1]);
        dnl:= 1;
        while (ass[dnl] <> #0) and (dnl < length(ass)) do begin DrvName+= ass[dnl]; inc(dnl) end;

        //Get the device name
        FillChar(ass[1], length(ass), 0);
        WTInfo(WTI_DEVICES + lc.lcDevice, DVC_NAME, @ass[1]);
        dnl:= 1;
        while (ass[dnl] <> #0) and (dnl < length(ass)) do begin DevName+= ass[dnl]; inc(dnl) end;

        if trim(DevName) <> ''
          then DeviceName:= '"' + DevName + '"'
          else DeviceName:= RuEn('<НЕИЗВЕСТНЫЙ>','<UNKNOWN>');
        if DrvName <> ''
          then DeviceName+= RuEn(' на ',' on ') + DrvName;

        Initialized:= (PressureRange > 0);
        MotherState.PenTabletPresent:= Initialized;
      end;
    end;
  except
    ErrorMessage:= StopDying();
  end;
  if ErrorMessage <> '' then pss:= ErrorMessage;
  AddLog(RuEn('Графический планшет: %0 (%1)','Pen tablet: %0 (%1)'), [DeviceName, pss]);
  if not Initialized then MotherState.PenTabletAbsenceReason:= ErrorMessage
                     else MotherState.PenTabletName:= DeviceName;
end;

procedure TWinTabManager.Pulse;
var
  buf: array[0..39] of TPacket;
  org: TPoint;
  n, scrH: integer;

  procedure ProcessMessages;
  var
    i: integer;
    azimuth, altitude: single;
  begin
    SetLength(Events, n);
    for i := 0 to n-1 do
      with Events[i] do begin
        if buf[i].pkNormalPressure > 0 then
          if i=0 then;
        x := buf[i].pkX / WinTabManager.MyRangeX;
        y := buf[i].pkY / WinTabManager.MyRangeY;
        if PressureRange = 0 then pressure := 1
        else begin
          pressure := buf[i].pkNormalPressure / PressureRange;
        end;
        Reserved1:= 0;
        Reserved2:= 0;
        if (AzimuthRange > 0) and (AltitudeRange > 0) then begin
          azimuth:= buf[i].orAzimuth / AzimuthRange;
          altitude:= buf[i].orAltitude / AltitudeRange;
          Reserved1:= sin(altitude * Pi / 2) * sin(azimuth * 2 * Pi);
          Reserved2:= sin(altitude * Pi / 2) * cos(azimuth * 2 * Pi);
        end;
        Reserved3:= 0;
        if TwistRange > 0 then Reserved3:= buf[i].orTwist / TwistRange;
      end;
  end;

begin
  if not Initialized or (Tablet = 0) then exit;
  try
    n := WTPacketsGet(Tablet, 40, @buf);
    if n > 0 then begin
      repeat
        ProcessMessages;
        n := WTPacketsGet(Tablet, 40, @buf);
      until n = 0;
    end
    else
      SetLength(Events, 0);
  except
    Die(RuEn('Крах при обращении к графическому планшету',
             'Crashed trying to access the pen tablet'));
  end;
end;

destructor TWinTabManager.Destroy;
begin
  try
    if Initialized then begin
      if Tablet <> 0 then WTClose(Tablet);
    end;
    if dll <> 0 then FreeLibrary(dll);
  except
    AddLog(Self.ClassName + ': error unloading the API dll: ' + StopDying());
  end;
  inherited Destroy;
end;

end.
