{ 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;

{ Descripcion: 

  tPanel:

    Objeto para manejar paneles (ventanas 2 dimensionales) en la pantalla
    Inicializar el objeto con:
        <pan>.Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer)
            donde tX1, tY1 son las coordenadas de la esquina izq superior
                  tX2, tY2 son las coordenadas de la esquina der inferior
                  tFC es el color del texto
	          tBC es el color para el fondo
    Métodos disponibles:
        <pan>.ClearScreen borra el panel completamente
	<pan>.OutText(X, Y: integer; S: string) muestra S en X, Y
	<pan>.InsertLine(Y: integer; S: string) inserta S en la linea Y
	<pan>.DeleteLine(Y: integer) borra la linea Y
	<pan>.WriteLine(S: string) agrega S al final del panel
	<pan>.GetCommand(S: string) escribe S como prompt, y devuelve
	        el comando tipeado por el usuario.
	<pan>.FlashMessage(Y: integer; S: string; T: integer) muestra el
		mensaje S en la linea Y, por un maximo de T milisegundos.
	<pan>.Height devuelve la altura del panel en lineas.
																					      }
  tSource:
  
    Inicializar el objeto con:
       	<pan>.Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer)
	        (ver tPanel)
    Luego, tSource agrega los siguiente métodos:
        <pan>.FileRead(fn: string) para lectura de un archivo fuente
            	(devuelve true si la lectura fue exitosa)
        <pan>.UpdateView(L: integer) actualiza el panel, asegurando que
           	la linea L esta visible.
        Las demas rutinas son de uso interno
        
  tRegisters:
  
    Inicializar el objeto con:
        <pan>.Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer)
                (ver tPanel)
    Luego, tSource agrega los siguiente métodos:
        <pan>.UpdateView(L: integer) actualiza el panel, asegurando que
                la linea L esta visible.
        <pan>.AddRegister(N, V: string) para agergar un registro nuevo,
        <pan>.DelRegister(N: string) para remover un registro.
                N es el nombre simbólico, V es el valor (numero).
}                            


interface

const
  MaxNrLSrc = 500;
  MaxNrAddr = 300;
  MaxNrReg = 100;

type
  pString = ^string;
  tAddress = record
    A, O, L: word;
  end;
  tReg = record
    Ref: string[10];
    FNr: byte;
  end;

  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 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;

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

  tRegisters = object (tPanel)
    Reg: array [1..MaxNrReg] of tReg;
    NrReg: integer;
    procedure Initialize(tX1, tY1, tX2, tY2, tFC, tBC: integer);
    procedure UpdateView(L: integer);
    procedure AddRegister(N, V: string);
    procedure DelRegister(N: string);
  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(S);
  ExitWindow;
end;

procedure tPanel.InsertLine(Y: integer; S: string);
begin
  EnterWindow;
  gotoXY(1, Y);
  InsLine;
  write(S);
  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(S);
  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(' ', S);
  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);
      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;
end;

procedure tSource.AddAddress(tA, ttO, tL: word);
begin
  if NrAddr >= MaxNrAddr then exit;
  inc(NrAddr);
  with Addr[NrAddr] do begin
    A := tA; O := ttO; L := tL;
  end;
end;

procedure tSource.UpdateView(L: integer);
var
  LNr: integer;
begin
  ClearScreen;
  LNr := 1;
  while (LNr <= Height) and ((LNr+L-1) <= NrL) do begin
    OutText(1, LNr, SrcL[LNr+L-1]^);
    inc(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);
  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
  LNr: integer;
begin
  ClearScreen;
  if NrReg <= Height then
    L := 1;
  LNr := 1;
  while (LNr <= Height) and ((LNr+L-1) <= NrReg) do begin
    OutText(1, LNr, Reg[LNr+L-1].Ref);
    inc(LNr);
  end;
end;

procedure tRegisters.AddRegister(N, V: string);
  var
    Err: integer;
  begin
    if (NrReg >= MaxNrReg) then exit;
    inc(NrReg);
    Reg[NrReg].Ref := N;
    val('$' + V, Reg[NrReg].FNr, Err);
    UpdateView(NrReg);
  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);
    UpdateView(R);
  end;

begin
end.