{ 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, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

unit Screen;

interface

uses
  Pic;

const
  MaxNrLSrc = 500;
  MaxSizeROM = 4096;
  MaxNrReg = 100;


type
  pString = ^string;
  tROM = array [0..MaxSizeROM-1] of word;
  tReg = record
    Ref: string[10];
    FNr: byte;
  end;

  { Definicion tPanel
      El objeto tPanel describe un area de la pantalla en modo text,
      en el cual es capaz de realizar tareas, como insertar y remover
      lineas, sin influir en el resto de la pantalla.
      El objeto es capaz de administrar colores, y retiene y restituye
      la posicion del cursor al cambiar de panel.
      Del tPanel pueden derivarse nuevos objetos - mas especializados -
      que implementan comportamientos mas complicados.
    Metodos:
      <p>.Initialize(x1, y1, x2, y2, fc, bc: integer);
          Inicializar el objeto, definiendo las coordinadas por esquina
          superior izquierda x1, y1, e inferior derecha x2, y2. Los
          colores son fc (color de caracteres) y bc (color de fondo).
      <p>.ClearScreen;
          Borrar el panel completamente a los colores definidos.
      <p>.OutText(x, y: integer; s: string);
          Muestra el string s en las coordenadas x, y.
      <p>.OutTextInv(x, y: integer; s; string);
          Idem, pero invirtiendo los colors
      <p>.InsertLine(y: integer; s: string);
          Inserta el string S en la linea Y
      <p>.DeleteLine(y: integer);
          Borra la linea Y.
      <p>.WriteLine(s: string);
          Agrega una linea al final del panel.
      <p>.GetCommand(s: string): string;
          En la ultima linea de la pantalla imprime s como 'prompt' y
          espera un comando tipeado por el operador. El comando sale
          cuando de apreta Enter.
      <p>.FlashMessage(y: integer; s: string; t: integer);
          Muestra, en forma transitoria (por t milisegundos), el mensage
          S en la linea Y. El metodo se encarga de restituir el
          contenido anterior.
      <p>.Height: integer;
          Es una funcion que devuelve la altura del panel expresada
          en lineas
    Data
      No se aconseja acceder directamente a los datos internos del objeto,
      ya que pueden modificarse en el futuro.
  }

  pPanel = ^tPanel;
  tPanel = object
    X1, X2, Y1, Y2, FC, BC: integer;
    Line1, OldMin, OldMax: word;
    OldCol: byte;

    procedure Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer);
    procedure ClearScreen;
    procedure OutText(X, Y: integer; S: string);
    procedure OutTextInv(X, Y: integer; S: string);
    procedure InsertLine(Y: integer; S: string);
    procedure DeleteLine(Y: integer);
    procedure WriteLine(S: string);
    function  GetCommand(S: string): string;
    procedure FlashMessage(Y: integer; S: string; T: integer);
    function  Height: integer;

    procedure EnterWindow;
    procedure ExitWindow;
  end;

  { Descripcion tSource

      El objeto tSource hereda las funcionalidades del objeto tPanel,
      y agrega la capacidad de administrar un listado de codigo fuente.
      Es capaz de leer este codigo, y mostrarlo en su panel.

  Metodos
    <p>.Initialize(x1, y1, x2, y2, fc, bc: integer);
        Heredado de tPanel
    <p>.UpdateView(L: integer; pP: pPic);
        Actualizar el contenido del panel. L indica el numero de la
        linea que se desea centrar. Si pP no es nil, se intenta de
        detecta la linea correspondiente al Program Counter actual.
        Si se detecta, esta sera mostrada en forma resaltada.
    <p>.FileRead(fn: string): boolean;
        Metodo para leer el codigo fuente de disco. Devuelve falso
        si no se pudo leer el archivo.
    <p>.AddLine(s: string);
        (Uso interno)
        Agrega una linea de codigo fuente al arreglo.
    <p>.AddAddress(addr, opc, linea: integer);
        Agrega un codigo (opc) de maquina en la direccion addr.
        Tambien administra una tabla con referencias a las lineas
        de codigo fuente (linea).
  }

  tSource = object (tPanel)
    SrcL: array [1..MaxNrLSrc] of pString;
    LAddr: array [1..MaxNrLSrc] of word;
    ROM,
    Cross: tROM;
    NrL,
    NrAddr: integer;
    procedure Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer);
    procedure UpdateView(L: integer; pP: pPic);
    procedure AddLine(S: string);
    procedure AddAddress(tA, ttO, tL: word);
    function  FileRead(fn: string): boolean;
  end;

  { Descripcion tRegisters
      tRegisters maneja una lista de los registros que el usuario
      desea monitorear en el panel.

  Metodos
    <p>.Initialize(x1, y1, x2, y2, fc, bc: integer);
        Metodo reimplementado de tPanel.
    <p>.UpdateView(l: integer; var p: tPic);
        Actualizar el contenido del panel. Utiliza p para acceder
        a los datos del Pic simulado directamente.
    <p>.AddRegister(N, V: string);
        Agrega un registro al panel. N es una referencia textual de
        max 10 caracters, V es el valor del offset.
    <p>.DelRegister(N: string);
        Remover un registro del panel. Se utiliza la referencia para
        especificar el registro a remover.
  }

  tRegisters = object (tPanel)
    Reg: array [1..MaxNrReg] of tReg;
    NrReg: integer;
    procedure Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer);
    procedure UpdateView(L: integer; var p: tPic);
    procedure AddRegister(N, V: string);
    procedure DelRegister(N: string);
  end;

  { Descripcion tMisc
      tMisc es un panel derivado de tPanel que muestra varios registros
      del PIC...

  Metodos
    <p>.Initialize(x1, y1, x2, y2, fc, bc: integer);
        Reimplementado de tPanel.
    <p>.UpdateView(var p: tPic);
        Actualiza el contenido del panel, utilizando p para
        acceder directamente a los datos internos del Pic
  }

  tMisc = object (tPanel)
    procedure Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer);
    procedure UpdateView(var p: tPic);
  end;


implementation

uses CRT, Strings;

var
  RealScr: array [1..25, 1..80] of word absolute $b800:0;

procedure tPanel.EnterWindow;
begin
  OldMin := WindMin;
  OldMax := WindMax;
  OldCol := TextAttr;
  Window(X1, Y1, X2, Y2);
  TextColor(FC);
  TextBackground(BC);
end;

procedure tPanel.ExitWindow;
begin
  Window(lo(OldMin)+1, hi(OldMin)+1,
         lo(OldMax)+1, hi(OldMax)+1);
  TextAttr := OldCol;
end;

procedure tPanel.Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer);
begin
  X1 := tX1; X2 := tX2;
  Y1 := tY1; Y2 := tY2;
  FC := tFC; BC := tBC;
  EnterWindow;
  clrscr;
  ExitWindow;
end;

procedure tPanel.ClearScreen;
begin
  EnterWindow;
  ClrScr;
  ExitWindow;
end;

procedure tPanel.OutText(X, Y: integer; S: string);
begin
  EnterWindow;
  gotoXY(X, Y);
  clreol;
  write(copy(S, 1, x2-x1));
  ExitWindow;
end;

procedure tPanel.OutTextInv(X, Y: integer; S: string);
begin
  EnterWindow;
  gotoXY(X, Y);
  clreol;
  TextColor(BC); TextBackground(FC);
  write(copy(S, 1, x2-x1));
  TextColor(FC); TextBackground(BC);
  ExitWindow;
end;

procedure tPanel.InsertLine(Y: integer; S: string);
begin
  EnterWindow;
  gotoXY(1, Y);
  InsLine;
  write(copy(S, 1, x2-x1));
  ExitWindow;
end;

procedure tPanel.DeleteLine(Y: integer);
begin
  EnterWindow;
  gotoXY(1, Y);
  DelLine;
  ExitWindow;
end;

procedure tPanel.WriteLine(S: string);
begin
  EnterWindow;
  gotoXY(1, 1);
  DelLine;
  gotoXY(1, Y2-Y1+1);
  write(copy(S, 1, x2-x1));
  ExitWindow;
end;

procedure tPanel.FlashMessage(Y: integer; S: string; T: integer);
var
  pSave: pointer;
  Del, Len: integer;
begin
  EnterWindow;
  Len := X2 - X1 + 1;
  getmem(pSave, 2*Len);
  move(RealScr[Y+Y1-1, X1], pSave^, 2*Len);
  gotoXY(1, Y); clreol;
  write(' ', copy(S, 1, x2-x1-1));
  Del := 0;
  while not KeyPressed and (Del < T) do begin
    inc(Del); delay(1);
  end;
  move(pSave^, RealScr[Y+Y1-1, X1], 2*Len);
  freemem(pSave, 2*Len);
  ExitWindow;
end;

function tPanel.GetCommand(S: string): string;
var
  Cmd: string;
  Ch: char;
begin
  EnterWindow;
  gotoXY(1, 1); DelLine;
  gotoXY(1, Height); write(S);
  Cmd := '';
  repeat
    Ch := GetKey;
    case Ch of
      ' '..'~': Cmd := Cmd + Ch;
      BS      : if Cmd <> '' then
                  Cmd := copy(Cmd, 1, length(Cmd)-1);
      F7      : begin Cmd := 'S'; Ch := CR; end;
      F8      : begin Cmd := 'N'; Ch := CR; end;
      F10,
      AltX    : begin Cmd := 'X'; Ch := CR; end;
    end;
    gotoXY(length(S)+1, Height); clreol;
    write(Cmd);
  until Ch = CR;
  ExitWindow;
  GetCommand := Cmd;
end;

function tPanel.Height: integer;
begin
  Height := Y2 - Y1 + 1;
end;

{ ---------------------- tListing -------------------- }

procedure tSource.Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer);
begin
  inherited Initialize(tX1, tY1, tX2, tY2, tFC, tBC);
  NrL := 0;
  NrAddr := 0;
end;

procedure tSource.AddLine(S: string);
begin
  if NrL >= MaxNrLSrc then exit;
  inc(NrL);
  getmem(SrcL[NrL], length(S)+1);
  SrcL[NrL]^ := S;
  LAddr[NrL] := $FFFF;      { Direccion 'invalida' }
end;

procedure tSource.AddAddress(tA, ttO, tL: word);
begin
  if NrAddr >= MaxSizeROM then exit;
  ROM[tA] := ttO;           { Tabla con opcodes para ejecucion }
  Cross[tA] := tL;          { Referencia cruzada direccion -> fuente }
  LAddr[NrL] := tA;         { Referencia fuente -> direcciones }
end;

procedure tSource.UpdateView(L: integer; pP: pPic);
var
  LNr: integer;
begin
  ClearScreen;
  if L <= (Height div 2) then
    Line1 := 1
  else
    Line1 := L - (Height div 2);
  for LNr := 0 to Height-1 do begin
    if (Line1+LNr) > NrL then break;
    if (pP <> nil) and (LAddr[Line1+LNr] = pP^.PC) then
      OutTextInv(1, LNr+1, SrcL[Line1+LNr]^)
    else
      OutText(1, LNr+1, SrcL[Line1+LNr]^);
  end;
end;

function tSource.FileRead(fn: string): boolean;
var
  F: text;
  Line: string;
  L, tNr, Err: integer;
  A, O: word;
begin
  FileRead := false;
          { Antes de todo: controlar si el archivo existe, sino abortamos }
  assign(F, fn);
  {$I-} reset(F); {$I+}
  if IOResult <> 0 then exit;
                          { Primer paso: borrar eventual listado anterior }
  for L := 1 to NrL do
    freemem(SrcL[L], length(SrcL[L]^)+1);
  NrL := 0;
  NrAddr := 0;
                        { Terminado, empezamos a cargar el programa nuevo }
  while not eof(F) do begin
    readln(F, Line);
    if length(Line) >= 25 then begin  { Si la linea es corta, descartamos }
      val(copy(Line, 21, 5), tNr, Err);
      if Err = 0 then begin { Si no contiene numero de linea, descartamos }
        AddLine(copy(Line, 27, length(Line)-26));
                            { Controlar si es una linea con codigo fuente }
        val('$' + copy(Line, 1, 4), A, Err);
        if Err = 0 then begin
          val('$' + copy(Line, 6, 4), O, Err);
          if Err = 0 then begin               { Aplausos... Codigo valido }
            AddAddress(A, O, NrL);
          end;
        end;
      end;
    end;
  end;
  close(F);
  UpdateView(1, nil);
  FileRead := true;
end;

{ --------------------- tRegisters ---------------------------- }

procedure tRegisters.Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer);
begin
  inherited Initialize(tX1, tY1, tX2, tY2, tFC, tBC);
  NrReg := 0;
end;

procedure tRegisters.UpdateView(L: integer; var p: tPic);
var
  LNr, FileNr: integer;
begin
  ClearScreen;
  if NrReg <= Height then
    L := 1;
  LNr := 1;
  while (LNr <= Height) and ((LNr+L-1) <= NrReg) do begin
    FileNr := Reg[LNr+L-1].FNr;
    OutText( 1, LNr,              Reg[LNr+L-1].Ref);
    OutText(12, LNr, '@' +   HexB(Reg[LNr+L-1].FNr));
    OutText(17, LNr, HexB(p.GetFileAbs(FileNr)));
    OutText(20, LNr, BinB(p.GetFileAbs(FileNr)));
    inc(LNr);
  end;
end;

procedure tRegisters.AddRegister(N, V: string);
  var
    Err: integer;
  begin
    DelRegister(N);
    if (NrReg >= MaxNrReg) then exit;
    inc(NrReg);
    Reg[NrReg].Ref := N;
    val('$' + V, Reg[NrReg].FNr, Err);
  end;

  procedure tRegisters.DelRegister(N: string);
  var
    R, R1: integer;
  begin
    R := 1;
    while (R <= NrReg) and (Reg[R].Ref <> N) do
      inc(R);
    if R > NrReg then exit;
    for R1 := R to NrReg-1 do
      Reg[R] := Reg[R+1];
    dec(NrReg);
    if R > 1 then dec(R);
  end;


{ --------------------- tMisc: mostrar varios registros -------------- }

procedure tMisc.Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer);
begin
  inherited Initialize(tX1, tY1, tX2, tY2, tFC, tBC);
end;

procedure tMisc.UpdateView(var p: tPic);
const
  Pfx: array [false..true] of char = (' ', '');
var
  i: integer;
begin
  ClearScreen;
  for i := 0 to 7 do
    OutText(2, 1+i, Pfx[i = p.StkP] + HexW(p.Stack[i]));
  OutText(9, 1, 'PC  ' + HexW(p.PC));
  OutText(9, 2, 'W   ' + HexB(p.W) + '   ' + BinB(p.W));
  OutText(9, 3, 'Flg ' + HexB(p.GetFile(fSTATUS)) + '   '
                       + BinB(p.GetFile(fSTATUS)));
end;


begin
end.