{*******************************************************************************
  1.0 (29/04/2011) - Versão inicial Linux
  1.1 (13/07/2011) - Liga Log da sk_access
  1.2 (15/05/2012) - Executa Free_Sk_Access em form_destroy
  1.3 (26/04/2013) - Acrescentado Unlock da controladora
  1.4 (12/12/2013) - usa sk_access.inc
*******************************************************************************}

unit U_use;

{$mode objfpc}{$H+}
{$asmmode ATT}
//{$DEFINE LOCAL_LIB}

interface

uses
  Classes,
  Process,
  SysUtils,
  Forms,
  Controls,
  Graphics,
  Dialogs,
  unix,
  LCLIntf,
  {$IFDEF LOCAL_LIB}
  U_sk_accessst,
  {$ENDIF}
  StdCtrls, Menus;

const
  versao = 'Teste libsk_access.so V1.4';

type
  TF_Test = class(TForm)
    B_Get_Interface: TButton;
    B_Psw_Off: TButton;
    B_BinData: TButton;
    B_Unlock: TButton;
    B_dll_ver: TButton;
    B_R_Interface: TButton;
    B_Send_Data: TButton;
    B_Line_Feed: TButton;
    B_Car_Ret: TButton;
    B_Disp_Char: TButton;
    B_Gotoxy: TButton;
    B_Disp: TButton;
    B_Set_Page0: TButton;
    B_Set_Page1: TButton;
    B_Udg: TButton;
    B_Reset: TButton;
    B_Enable: TButton;
    B_Disp_Ctrl: TButton;
    B_Disable: TButton;
    B_Set_Interf: TButton;
    B_Get_Cursor: TButton;
    B_Get_Status: TButton;
    B_Psw_On: TButton;
    B_Redirect: TButton;
    B_Eco_On: TButton;
    B_Eco_Off: TButton;
    B_Get_Data: TButton;
    B_Get_Firm: TButton;
    B_Clear_Disp: TButton;
    B_Get_SN: TButton;
    B_Clear_L1: TButton;
    B_Clear_L2: TButton;
    B_Cursor_Off: TButton;
    B_Cursor_On: TButton;
    B_Cursor_Blink: TButton;
    B_Back_Space: TButton;
    E_Char: TEdit;
    E_X: TEdit;
    E_Y: TEdit;
    E_Display: TEdit;
    E_Status: TEdit;
    E_Info: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    L_Si: TLabel;
    procedure Button5Click(Sender: TObject);
    procedure B_BinDataClick(Sender: TObject);
    procedure B_Psw_OffClick(Sender: TObject);
    procedure B_Get_InterfaceClick(Sender: TObject);
    procedure B_R_InterfaceExit(Sender: TObject);
    procedure B_UnlockClick(Sender: TObject);
    procedure B_dll_verClick(Sender: TObject);
    procedure B_Line_FeedClick(Sender: TObject);
    procedure B_Car_RetClick(Sender: TObject);
    procedure B_Disp_CharClick(Sender: TObject);
    procedure B_GotoxyClick(Sender: TObject);
    procedure B_DispClick(Sender: TObject);
    procedure B_R_InterfaceClick(Sender: TObject);
    procedure B_Set_Page0Click(Sender: TObject);
    procedure B_Set_Page1Click(Sender: TObject);
    procedure B_UdgClick(Sender: TObject);
    procedure B_ResetClick(Sender: TObject);
    procedure B_EnableClick(Sender: TObject);
    procedure B_Send_DataClick(Sender: TObject);
    procedure B_DisableClick(Sender: TObject);
    procedure B_Set_InterfClick(Sender: TObject);
    procedure B_Get_CursorClick(Sender: TObject);
    procedure B_Get_StatusClick(Sender: TObject);
    procedure B_Psw_OnClick(Sender: TObject);
    procedure B_RedirectClick(Sender: TObject);
    procedure B_Eco_OnClick(Sender: TObject);
    procedure B_Eco_OffClick(Sender: TObject);
    procedure B_Get_DataClick(Sender: TObject);
    procedure B_Get_FirmClick(Sender: TObject);
    procedure B_Disp_CtrlClick(Sender: TObject);
    procedure B_Get_SNClick(Sender: TObject);
    procedure B_Clear_DispClick(Sender: TObject);
    procedure B_Clear_L1Click(Sender: TObject);
    procedure B_Clear_L2Click(Sender: TObject);
    procedure B_Cursor_OffClick(Sender: TObject);
    procedure B_Cursor_OnClick(Sender: TObject);
    procedure B_Cursor_BlinkClick(Sender: TObject);
    procedure B_Back_SpaceClick(Sender: TObject);
    procedure E_StatusChange(Sender: TObject);
    procedure E_InfoEnter(Sender: TObject);
    procedure E_InfoExit(Sender: TObject);
    procedure E_InfoKeyPress(Sender: TObject; var Key: char);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  F_Test: TF_Test;
  Sstr, dll_ver:array[0..20] of char;
  counter:integer;


implementation
{$R *.lfm}

{$IFNDEF LOCAL_LIB}
{$I sk_access.inc}
{$ENDIF}

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
procedure TF_Test.FormCreate(Sender: TObject);
begin
//  Log_On(8);             //Liga Log "por dentro" da libsk_access.so
  S_Mode_Off;              //Força modo serial = Smak prog
  {$IFDEF LOCAL_LIB}
     caption := '*** TESTE LOCAL ***';
     Color:=clFuchsia;
  {$ELSE}
     caption:=versao;
  {$ENDIF}
end;
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
procedure TF_Test.FormDestroy(Sender: TObject);
begin
  Free_Sk_access;
end;
{-------------------------------------------------------------------------------
                  Envia 'A' para o display do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Send_DataClick(Sender: TObject);
begin
  Send_Data($a5);
  Send_Data($41);
  B_Send_Data.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                          Desabilita teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_DisableClick(Sender: TObject);
begin
  Disable_Keyboard;
  B_Disable.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
               Força usa da interface descrita em E_Status
-------------------------------------------------------------------------------}
procedure TF_Test.B_Set_InterfClick(Sender: TObject);
var
   result:integer;
begin
  result:=Set_Interface(Pchar(E_Status.Text));
  if result=-1 then L_Si.Caption:='Nack';     //Se interfase indisponível
  if result>=0 then L_Si.Caption:='Ok';       //Se SKO conectado
  B_Set_Interf.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                Le a posição do cursor do display do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Get_CursorClick(Sender: TObject);
var
   x,y,pos:byte;
begin
   Screen.Cursor := crHourGlass;
   pos:=Get_Cursor(@x,@y);
   E_X.Text:=IntToStr(x);
   E_Y.Text:=IntToStr(y);
   E_Status.Text:=IntToStr(pos);
   Screen.Cursor := crDefault;
   B_Get_Cursor.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
        Botão Get Status:
        A função Get_Status retorna 0  se teclado OK
                                    1  se tecaldo em FALHA
                                  $ff  se teclado não responde
-------------------------------------------------------------------------------}

procedure TF_Test.B_Get_StatusClick(Sender: TObject);
var
   status:byte;
begin
  Screen.Cursor := crHourGlass;
  E_Display.SetFocus;
  status:=Get_Status;

  case status of
     $00:E_Status.text:='OK';
     $01:E_Status.text:='FALHA';
     $ff:E_Status.text:='TIME-OUT';
  else
     E_Status.text:='REC'+IntToStr(status);   //Mostra byte recebido<>00,01,ff
  end;
  Screen.Cursor := crDefault;
  B_Get_Status.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                       Desliga eco de Password = '*'
-------------------------------------------------------------------------------}
procedure TF_Test.B_Psw_OffClick(Sender: TObject);
begin
   Set_Psw_Off;
  B_Psw_Off.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                        Liga eco de Password = '*'
-------------------------------------------------------------------------------}
procedure TF_Test.B_Psw_OnClick(Sender: TObject);
begin
  Set_Psw_On;
  B_Psw_On.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
               Ativa redirecionamento de teclado serial/VCP
  A lib monitora o teclado serial e gera eventos de teclado no Linux
-------------------------------------------------------------------------------}
procedure TF_Test.B_RedirectClick(Sender: TObject);
begin
  Redirect;
  B_Redirect.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                           Liga Eco de teclas
-------------------------------------------------------------------------------}
procedure TF_Test.B_Eco_OnClick(Sender: TObject);
begin
  Set_Eco_On;
  B_Eco_On.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                          Desliga eco de teclas
-------------------------------------------------------------------------------}
procedure TF_Test.B_Eco_OffClick(Sender: TObject);
begin
  Set_Eco_Off;
  Set_Psw_Off;
  B_Eco_Off.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
        Botão Get Rs:
        Le dados recebidos do teclado RS-232/USB VCP.
-------------------------------------------------------------------------------}
procedure TF_Test.B_Get_DataClick(Sender: TObject);
var
   buffer:array[0..41] of char;
   c,d:byte;
begin
   c:=Get_Data(@buffer,3);    //Le no maximo 3 dados e coloca no buffer
   if c>0 then                //Se tinha dados a serem lidos
      for d:=0 to c-1 do      //Coloca em E_Display
//        E_Display.text:=E_Display.text+buffer[d];                          //Mostra ASCII
         E_Display.text:=E_Display.text + IntToHex(byte(buffer[d]),2)+'.'; //Mostra Hex
   B_Get_Data.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                   Le a versão do Firmware do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Get_FirmClick(Sender: TObject);
begin
   Screen.Cursor := crHourGlass;
   Get_Firmware_Version(dll_ver);
   E_Display.Text:=dll_ver;
   Screen.Cursor := crDefault;
   B_Get_Firm.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                    Envia Line-Feed para o teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Line_FeedClick(Sender: TObject);
begin
  Line_Feed;
  B_Line_Feed.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                         Le versão da lib
-------------------------------------------------------------------------------}
procedure TF_Test.B_dll_verClick(Sender: TObject);

begin
  Get_Dll_Version(dll_ver);
  E_Display.Text:=dll_ver;
  B_dll_ver.Font.Style:=[];
end;
{===============================================================================
                           Le arquivo de Clock
===============================================================================}
const
  Available_Clk = 0;
  currente_Clk = 1;

Function ClockSource(arq:integer):string;
var
   arqu,texto:string;
   Clock:textfile;
begin
   arqu:='/sys/devices/system/clocksource/clocksource0/';
   if arq = Available_Clk then arqu := arqu+'available_clocksource';
   if arq = currente_Clk then arqu := arqu+'current_clocksource';
   if FileExists(Arqu) then begin
      AssignFile (Clock,arqu);
      Reset(Clock);
      Readln(Clock,texto);
      CloseFile(Clock);
   end;
   result:=texto;
end;
{-------------------------------------------------------------------------------
    Le Registro da Controladora 8042, foi observado que isso destrava a
controladora.
-------------------------------------------------------------------------------}
procedure TF_Test.B_UnlockClick(Sender: TObject);
begin
   Unlock_Interface;
   B_Unlock.Font.Style:=[];
end;

procedure TF_Test.B_BinDataClick(Sender: TObject);
begin
  E_Status.Text := IntToStr(Buffer_In_Data);
  B_BinData.Font.Style:=[];
end;

procedure TF_Test.Button5Click(Sender: TObject);
var
  buffer:array[0..41] of char;
  c,d:integer;
begin
  Screen.Cursor := crHourGlass;
  c:=0;
  repeat
     Delay;
     E_Status.Text:=IntTostr(c);
     E_Status.Update;
     F_Test.Update;
     inc(c);
  until false;

//  d:=0;
//  repeat
//     hit_counter:=0;
//     for c:=1 to 10 do Wait_PS2_HID(1);
//     inc(d);
//     E_Status.Text:=IntToStr(d);
//     E_Status.Update;
//     Update;
//  until false;

  repeat
	  repeat
	     Disp(PChar(E_Display.Text));
	     sleep(250);
	     Line_Feed;
        gotoxy(15,2);
	  until Get_Data(@buffer,3)>0;
     Clear_Disp;
	  Disp(PChar('Tecla->'+IntToHEx(byte(buffer[0]),2)));
     Line_Feed;
     sleep(500);
  until false;
  Screen.Cursor := crDefault;
  B_Disp.Font.Style:=[];
end;

procedure TF_Test.B_Get_InterfaceClick(Sender: TObject);
begin
  E_Status.Text := IntToStr(Get_Current_Interface);
  B_Get_Interface.Font.Style:=[];
end;

procedure TF_Test.B_R_InterfaceExit(Sender: TObject);
begin

end;
{-------------------------------------------------------------------------------
               Envia Carriage Return para o display do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Car_RetClick(Sender: TObject);
begin
  Carriage_Return;
  B_Car_Ret.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                Envia um caracter para o display do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Disp_CharClick(Sender: TObject);
begin
  Disp_Char(E_Char.Text[1]);
  B_Disp_Char.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                  Posiciona o cursor do display do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_GotoxyClick(Sender: TObject);
var
   x,y,code:integer;
begin
   val(E_X.text,x,code);
   if code<>0 then begin
      E_X.text:='1';
      x:=1;
   end;

   val(E_Y.text,y,code);
   if code<>0 then begin
      E_Y.text:='1';
      y:=1;
   end;
   Gotoxy(x,y);
   B_Gotoxy.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                 Mostra uma string no display do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_DispClick(Sender: TObject);
//var
//   strbuf:array[0..81] of char;
//   counter:longint;
//   x,y,pos:byte;
begin
   Screen.Cursor := crHourGlass;
   Disp(PChar(E_Display.Text));
(*
   counter:=0;
   repeat
     pos:=Get_Cursor(@x,@y);
     Get_Firmware_Version(dll_ver);
     Get_Serial_Number(dll_ver);
     gotoxy(1,1);
     Disp(PChar(IntToStr(counter)));
     if Get_Status<>0 then begin
        E_Display.Text:='Erro';
        break;
     end else if E_Display.Text='Erro' then begin
        E_Display.Text:='OK';
        E_Display.Update;
     end;
     inc(counter);
   until FALSE;
*)
   Screen.Cursor := crDefault;
   B_Disp.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                  Desconecta a lib do teclado em uso
-------------------------------------------------------------------------------}
procedure TF_Test.B_R_InterfaceClick(Sender: TObject);
begin
  Reset_Interface;
  B_R_Interface.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
       Seleciona pagina0 = primeira página de scan code do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Set_Page0Click(Sender: TObject);
begin
  Set_Page0;
  B_Set_Page0.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
        Seleciona pagina1 = segunda página de scan code do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Set_Page1Click(Sender: TObject);
begin
  Set_Page1;
  B_Set_Page1.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
              Redefine o desenho de um caractere especial
-------------------------------------------------------------------------------}
procedure TF_Test.B_UdgClick(Sender: TObject);
var
   car:byte;
begin
  Screen.Cursor := crHourGlass;
  cursor_off;
  disp_char(char($0));                         //Mostra o caracter #0
//  Set_Udg(0,$04,$0c,$04,$04,$04,$04,$0e,$00);  //='1'
//  Set_Udg(0,$14,$1c,$14,$14,$14,$14,$1e,$10);  //='1' + bargraph 1
//  Set_Udg(0,$1c,$14,$1c,$1c,$1c,$1c,$16,$18);  //='1' + bargraph 2
//  Set_Udg(0,$1c,$14,$1c,$1c,$1c,$1c,$16,$18);  //='1' + bargraph 3

  for car:=0 to 1 do begin
    Set_Udg(0,$3F,$11,$11,$3F,$11,$11,$11,$00);//Redesenha o caracter #0
    sleep(100);
    Set_Udg(0,$11,$11,$3F,$11,$11,$11,$00,$3F);
    sleep(100);
    Set_Udg(0,$11,$3F,$11,$11,$11,$00,$3F,$11);
    sleep(100);
    Set_Udg(0,$3F,$11,$11,$11,$00,$3F,$11,$11);
    sleep(100);
    Set_Udg(0,$11,$11,$11,$00,$3F,$11,$11,$3F);
    sleep(100);
    Set_Udg(0,$11,$11,$00,$3F,$11,$11,$3F,$11);
    sleep(100);
    Set_Udg(0,$11,$00,$3F,$11,$11,$3F,$11,$11);
    sleep(100);
    Set_Udg(0,$00,$3F,$11,$11,$3F,$11,$11,$11);
    sleep(100);
  end;

  cursor_blink;
  Screen.Cursor := crDefault;
  B_Udg.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                           Reseta teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_ResetClick(Sender: TObject);
begin
  Keyb_Reset;
  B_Reset.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                           Habilita teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_EnableClick(Sender: TObject);
begin
  Enable_Keyboard;
  B_Enable.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
         Envia um caractere de controle diretamente para o display
-------------------------------------------------------------------------------}
procedure TF_Test.B_Disp_CtrlClick(Sender: TObject);
begin
  Send_Disp_Ctrl($01);
  B_Disp_Ctrl.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                   Le numero de serie do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Get_SNClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  Get_Serial_Number(dll_ver);
  E_Display.Text:=dll_ver;
  Screen.Cursor := crDefault;
  B_Get_SN.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                   Apaga o display do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Clear_DispClick(Sender: TObject);
begin
  Clear_Disp;
  B_Clear_Disp.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
            Apaga primeira linha do display do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Clear_L1Click(Sender: TObject);
begin
   Clear_L1;
   B_Clear_L1.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
            Apaga segunda linha do display do teclado
-------------------------------------------------------------------------------}
procedure TF_Test.B_Clear_L2Click(Sender: TObject);
begin
   Clear_L2;
   B_Clear_L2.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                      Desliga cursor do display
-------------------------------------------------------------------------------}
procedure TF_Test.B_Cursor_OffClick(Sender: TObject);
begin
   Cursor_Off;
   B_Cursor_Off.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                      Liga cursor do display
-------------------------------------------------------------------------------}
procedure TF_Test.B_Cursor_OnClick(Sender: TObject);
begin
   Cursor_On;
   B_Cursor_On.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
                 Liga cursor piscante do display
-------------------------------------------------------------------------------}
procedure TF_Test.B_Cursor_BlinkClick(Sender: TObject);
begin
   Cursor_Blink;
   B_Cursor_Blink.Font.Style:=[];
end;
{-------------------------------------------------------------------------------
           Executa um Back Space no display, apagando a esquerda
-------------------------------------------------------------------------------}
procedure TF_Test.B_Back_SpaceClick(Sender: TObject);
begin
  Back_Space;
  B_Back_Space.Font.Style:=[];
end;

procedure TF_Test.E_StatusChange(Sender: TObject);
begin
  L_Si.Caption:='???';
end;
{-------------------------------------------------------------------------------
             Executa entrada de texto 'rolante' pela direita
-------------------------------------------------------------------------------}
procedure TF_Test.E_InfoEnter(Sender: TObject);
begin
  cursor_off;
  Redirect;
  Clear_Disp;
  Sstr:='12345678901234567890';
end;

procedure TF_Test.E_InfoExit(Sender: TObject);
begin
  Reset_Interface;
  E_Info.Text:='';
  cursor_blink;
end;

procedure TF_Test.E_InfoKeyPress(Sender: TObject; var Key: char);
const
   Str_size = 15;
begin
  Sstr := Sstr + key;
  Sstr := copy(Sstr,2,Str_size);
  Sstr[Str_size-1]:=key;
  gotoxy(1,2);
  Disp(Pchar(Sstr));
  E_Info.Text:=Sstr;
end;

end.

