unit ApilarCrt;

interface
uses
{$IFDEF LINUX}
  cthreads,
  crt,
{$ENDIF}
  Classes,
  SysUtils;

procedure EscrituraDirecta(valor: boolean);

procedure ApilarWrite(cadena: string);
procedure ApilarWriteLn(cadena: string); overload;
procedure ApilarWriteLn; overload;
procedure ApilarClrScr;
procedure ApilarClrEol;
procedure ApilarGotoXY(x: byte; y: byte);

function LeerTeclado: char;



implementation
uses
{$IFDEF LINUX}
//  Crt,
{$ELSE}
  Win32Crt,
  ShareMem,
{$ENDIF}
  SyncObjs, Contnrs,
  Utilidades;

const MAXIMOS_MSGS_APILAR = 1000;

type
  TipoDatosApilarCrt = (APILAR_CRT_WRITE, APILAR_CRT_WRITELN,
    APILAR_CRT_WRITELN_STR, APILAR_CRT_CLRSCR,
    APILAR_CRT_CLREOL, APILAR_CRT_GOTOXY);

  TipoApilarCrt = record
    tipo: TipoDatosApilarCrt;
    x: byte;
    y: byte;
    cadena: string;
  end;

  p_TipoApilarCrt = ^TipoApilarCrt;

  TApilarCrtFifo = class
  private
    ColaApilarCrt: TQueue;
    FCritSect: TCriticalSection;
    function intNumApilarCrtMsg: integer;
    function intPeekApilarCrtMsg(var msg: TipoApilarCrt; borrar: boolean): boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure PushApilarCrtMsg(msg: TipoApilarCrt);
    function PopApilarCrtMsg(var msg: TipoApilarCrt): boolean;
    function PeekApilarCrtMsg(var msg: TipoApilarCrt): boolean;
  published
    property NumApilarCrtMsg: integer read intNumApilarCrtMsg;
  end;

  TThreadApilarCrt = class(TThread)
  private
    intCola: TApilarCrtFifo;
  public
    constructor Create(cola: TApilarCrtFifo);
    destructor Destroy;

    procedure Execute; override;
  end;


var
  intEscrituraDirecta: boolean;
  ApilarCrtFifo: TApilarCrtFifo;
  ThreadCrtFifo: TThreadApilarCrt;

// ------------------------------------------------------
// **** TApilarCrtFifo ****
// ------------------------------------------------------

constructor TApilarCrtFifo.Create;
begin
  inherited;
  ColaApilarCrt := TQueue.Create;
  FCritSect := TCriticalSection.Create;
end;

destructor TApilarCrtFifo.Destroy;
var
  I: Integer;
  intmsg: p_TipoApilarCrt;

begin
  FCritSect.Enter;
  (*
    for I := 0 to ColaCan.count - 1 do
    begin
      Dispose(p_can_msg_t(ColaCan[I]));
    end;
  *)
  while (ColaApilarCrt.Count > 0) do
  begin
    intmsg := ColaApilarCrt.Pop;
  end;
  ColaApilarCrt.Free;
  FCritSect.Leave;

  FCritSect.Free;
  inherited;
end;

function TApilarCrtFifo.intNumApilarCrtMsg: integer;
begin
  FCritSect.Enter;
  intNumApilarCrtMsg := ColaApilarCrt.Count;
  FCritSect.Leave;
end;

procedure TApilarCrtFifo.PushApilarCrtMsg(msg: TipoApilarCrt);
var
  intmsg: p_TipoApilarCrt;
begin
  FCritSect.Enter;
  if ColaApilarCrt.Count < MAXIMOS_MSGS_APILAR then
  begin

    new(intmsg);
    intmsg^ := msg;

    ColaApilarCrt.Push(intmsg);
  end;
  FCritSect.Leave;
end;

function TApilarCrtFifo.intPeekApilarCrtMsg(var msg: TipoApilarCrt; borrar: boolean): boolean;
var
  intmsg: p_TipoApilarCrt;
begin
  intPeekApilarCrtMsg := false;
  if ColaApilarCrt.Count = 0 then
  begin
    exit;
  end;
  intmsg := ColaApilarCrt.Peek;
  if intmsg <> nil then
  begin
    msg := intmsg^;
    if borrar then
    begin
      intmsg := ColaApilarCrt.Pop; // eliminar el registro
      dispose(intmsg);
    end;
    intPeekApilarCrtMsg := true;
  end;
end;

function TApilarCrtFifo.PeekApilarCrtMsg(var msg: TipoApilarCrt): boolean;
var
  intmsg: p_TipoApilarCrt;
begin
  FCritSect.Enter;
  PeekApilarCrtMsg := intPeekApilarCrtMsg(msg, false);
  FCritSect.Leave;
end;

function TApilarCrtFifo.PopApilarCrtMsg(var msg: TipoApilarCrt): boolean;
var
  intmsg: p_TipoApilarCrt;
begin
  FCritSect.Enter;
  PopApilarCrtMsg := intPeekApilarCrtMsg(msg, true);
  FCritSect.Leave;
end;

// ------------------------------------------------------
// **** TThreadApilarCrt ****
// ------------------------------------------------------


constructor TThreadApilarCrt.Create(cola: TApilarCrtFifo);
begin
  intCola := cola;
  inherited create(true);
end;

destructor TThreadApilarCrt.Destroy;
begin
  inherited Destroy;
end;

procedure TThreadApilarCrt.execute;
var
  msg: TipoApilarCrt;
  x1,y1 : byte;
begin
  while not Terminated do
  begin
    sleep(100);

    while intCola.NumApilarCrtMsg > 0 do
//    if intCola.NumApilarCrtMsg > 0 then
    begin
      intCola.PopApilarCrtMsg(msg);
      case msg.tipo of
        APILAR_CRT_WRITE:
        begin
          Write(msg.cadena);
        end;  
        APILAR_CRT_WRITELN:
        begin
          Writeln;
        end;
        APILAR_CRT_WRITELN_STR:
        begin
          Writeln(msg.cadena);
        end;
        APILAR_CRT_CLRSCR:
        begin
          ClrScr;
        end;
        APILAR_CRT_CLREOL:
        begin
          ClrEol;
        end;  
        APILAR_CRT_GOTOXY:
        begin
          GotoXY(msg.x, msg.y);
//          sleep(100);
        end;  
      end;
    end;

  end;
end;

// *************** FUNCIONES DE CONSOLA *************************************

procedure EscrituraDirecta(valor: boolean);
begin
  intEscrituraDirecta := valor;
  if not intEscrituraDirecta then
  begin
    Window(1,1,80,25);  
    if not assigned(ApilarCrtFifo) then
    begin
      ApilarCrtFifo := TApilarCrtFifo.Create;
      if assigned(ApilarCrtFifo) then
        ThreadCrtFifo := TThreadApilarCrt.Create(ApilarCrtFifo);
      if assigned(ThreadCrtFifo) then
        ThreadCrtFifo.Resume;
    end;
  end;
end;

procedure ApilarWrite(cadena: string);
var
  msg: TipoApilarCrt;
begin
  if intEscrituraDirecta then
    Write(cadena)
  else
  begin
    msg.tipo := APILAR_CRT_WRITE;
    msg.cadena := cadena;
    ApilarCrtFifo.PushApilarCrtMsg(msg);
  end;
end;

procedure ApilarWriteLn(cadena: string); overload;
var
  msg: TipoApilarCrt;
begin
  if intEscrituraDirecta then
    WriteLn(cadena)
  else
  begin
    msg.tipo := APILAR_CRT_WRITELN_STR;
    msg.cadena := cadena;
    ApilarCrtFifo.PushApilarCrtMsg(msg);
  end;
end;

procedure ApilarWriteLn; overload;
var
  msg: TipoApilarCrt;
begin
  if intEscrituraDirecta then
    WriteLn
  else
  begin
    msg.tipo := APILAR_CRT_WRITELN;
    ApilarCrtFifo.PushApilarCrtMsg(msg);
  end;
end;

procedure ApilarClrScr;
var
  msg: TipoApilarCrt;
begin
  if intEscrituraDirecta then
    ClrScr
  else
  begin
    msg.tipo := APILAR_CRT_CLRSCR;
    ApilarCrtFifo.PushApilarCrtMsg(msg);
  end;
end;

procedure ApilarClrEol;
var
  msg: TipoApilarCrt;
begin
  if intEscrituraDirecta then
    ClrEol
  else
  begin
    msg.tipo := APILAR_CRT_CLREOL;
    ApilarCrtFifo.PushApilarCrtMsg(msg);
  end;
end;

procedure ApilarGotoXY(x: byte; y: byte);
var
  msg: TipoApilarCrt;
begin
  if intEscrituraDirecta then
    GotoXY(x, y)
  else
  begin
    msg.tipo := APILAR_CRT_GOTOXY;
    msg.x := x;
    msg.y := y;
    ApilarCrtFifo.PushApilarCrtMsg(msg);
  end;
end;

{$IFDEF LINUX}

function LeerTeclado_int: char;
var
  ch: char;
begin
  ch := #0;
  if KeyPressed then
  begin
    ch := ReadKey;
    case ch of
      #0:
        begin
          ch := ReadKey; {Read ScanCode}
        end;
    end;
  end;
  LeerTeclado_int := ch;
end;

function LeerTeclado: char;
var
  ch: char;
begin
  ch := LeerTeclado_int;
  if ch <> #0 then
  begin
    while (LeerTeclado_int <> #0) do
    begin
    end;
  end;
  LeerTeclado := ch;
end;

{$ELSE}

function LeerTeclado: char;
begin
  //  LeerTeclado := chr(byte(readKey_int(10)));
  LeerTeclado := char(readKey_int(10));
end;
{$ENDIF}

initialization
  intEscrituraDirecta := false;
end.

