unit Logic interface uses SysUtils StdCtrls Classes Math type byteWord

unit Logic; 
interface
uses
  SysUtils,StdCtrls,Classes,Math;
type
  byteWord = class
    private
      value:LongWord;
      function getText():string;
      procedure setText(input:string);
      function getDec():LongWord;
      procedure setHex(input:LongWord);
    public
      property Text:string read getText write setText;
      property Hex:LongWord read getDec write setHex;
      constructor Create(); overload;
      constructor Create(input:string); overload;
      constructor Create(input:LongWord); overload;
  end;
  ByteProc = function(number:byteWord):Boolean of object;
  flag = class
    private
      value:Boolean;
      flagLabel:TLabel;
      checkProc:ByteProc;
      function getState():Boolean;
      procedure setState(state:Boolean);
      procedure setLabel();
      function checkOverflow(number:byteWord):Boolean;
      function checkZero(number:byteWord):Boolean;
      function checkHighOne(number:byteWord):Boolean;
      function checkParity(number:byteWord):Boolean;
    public
      property State:Boolean read getState write setState;
      property Check:ByteProc read checkProc write checkProc;
      constructor Create(flagLabel:TLabel);
      procedure refresh(number:byteWord);
  end;
  flagV = class(flag)
      constructor Create(flagLabel:TLabel);
  end;
  flagZ = class(flag)
      constructor Create(flagLabel:TLabel);
  end;
  flagN = class(flag)
      constructor Create(flagLabel:TLabel);
  end;
  flagP = class(flag)
      constructor Create(flagLabel:TLabel);
  end;
  TAbstractRegister = class
    private
      value:byteWord;
      regFlag:array of flag;
      procedure refreshFlags();
      procedure refreshInterface();virtual;abstract;
      function getValue():byteWord;
      procedure setValue(value:byteWord);
    public
      property Number:byteWord read getValue write setValue;
      procedure setDecValue(decValue:LongWord);
      //procedure setTextValue(textValue:ShortString);
      procedure setHexValue(hexValue:ShortString);
  end;
  TRegister = class (TAbstractRegister)
    private
      ID:Integer;
      procedure refreshInterface();override;
    public
      function getID():Integer;
      constructor Create(ID:Integer);
  end;
  TAbstractCommand = class
    public
      name: string;
      class function calculation(n1,n2:byteWord):byteWord;virtual;abstract;
      constructor Create(name:string);
  end;

  TCommandAdd = class(TAbstractCommand)
    class function calculation(n1,n2:byteWord):byteWord;override;
    constructor Create();
  end;
  TCommandSubst = class(TAbstractCommand)
    class function calculation(n1,n2:byteWord):byteWord;override;
    constructor Create();
  end;
  TCommandAnd = class(TAbstractCommand)
    class function calculation(n1,n2:byteWord):byteWord;override;
    constructor Create();
  end;
  TCommandOr = class(TAbstractCommand)
    class function calculation(n1,n2:byteWord):byteWord;override;
    constructor Create();
  end;
  TCommandXor = class(TAbstractCommand)
    class function calculation(n1,n2:byteWord):byteWord;override;
    constructor Create();
  end;
  TCalculator = class
    private
      N1:TRegister;
      N2:TRegister;
      Command:TAbstractCommand;
    public
      procedure Add(N1:TRegister;N2:TRegister;Command:TAbstractCommand);
      procedure process();
      constructor Create();
  end;
  TAbstractProcessor = class
    private
      regs:array of TRegister;
      commands:array of TAbstractCommand;
    public
      function getRegister(Index: Integer):TRegister;
      function getCommand(Index: Integer):TAbstractCommand;
      procedure initState();virtual;abstract;
      procedure calculate();virtual;abstract;
  end;
  TProcessor = class(TAbstractProcessor)
    private
      calc:TCalculator;
    public
      property REG1: TRegister index 0 read getRegister;
      property REG2: TRegister index 1 read getRegister;
      property REG3: TRegister index 2 read getRegister;
      property REG4: TRegister index 3 read getRegister;
      procedure calculate();override;
      procedure initState();override;
      function getRegisterIDs():TStrings;
      constructor Create();
  end;
  TFind = class(TComponent)
    public
      function findFlag(regID:Integer;flagID:Integer):TLabel;
      function findValueLabel(regID:Integer;labelType:ShortString):TLabel;
      function findHeader(regID:Integer):TLabel;
  end;
  function convertDecToBin(number:LongWord):ShortString;
  function convertBinToDec(number:ShortString):LongWord;
implementation
uses
  Unit1;

function convertDecToBin(number:LongWord):ShortString;
var
  md:LongWord;
begin
  Result:='';
  repeat
    md:=number mod 2;
    number:=number div 2;
    Result:=IntToStr(md)+Result;
  until number<1
end;
function convertBinToDec(number:ShortString):LongWord;
var i:Integer;
begin
  Result:=0;
  for i:=Length(number) downto 1 do
     Result:=Result+StrToInt(number[i])*Trunc(Power(2,Length(number)-i));
end;
function byteWord.getText():string;
begin
  getText:=IntToHex(getDec,4);
end;
procedure byteWord.setText(input:string);
begin
  setHex(StrToInt('$'+input));
end;
function byteWord.getDec():LongWord;
begin
  getDec:=value;
end;
procedure byteWord.setHex(input:LongWord);
begin
  value:=input;
end;
constructor byteWord.Create();
begin
  setText('FFFF');
end;
constructor byteWord.Create(input:string);
begin
  if input<>'' then
    setText(input)
  else
    Create;
end;
constructor byteWord.Create(input:LongWord);
begin
  setHex(Input);
end;
constructor flag.Create(flagLabel:TLabel);
begin
  Self.flagLabel:=flagLabel;
  setState(false);
end;
procedure flag.setState(state:Boolean);
begin
  value:=state;
  setLabel;
end;
function flag.getState():Boolean;
begin
  getState:=value;
end;
procedure flag.setLabel();
begin
  flagLabel.Enabled:=getState;
end;
procedure flag.refresh(number:byteWord);
begin
  State:=check(number);
end;
function flag.checkOverflow(number:byteWord):Boolean;
begin
  if number.Hex>$FFFF then
    checkOverflow:=True
  else
    checkOverflow:=false;
end;
function flag.checkZero(number:byteWord):Boolean;
begin
  if number.Hex=$0 then
    checkZero:=True
  else
    checkZero:=false;
end;
function flag.checkHighOne(number:byteWord):Boolean;
begin
  if number.Hex>$7FFF then
    checkHighOne:=True
  else
    checkHighOne:=false;
end;
function flag.checkParity(number:byteWord):Boolean;
var
  binStr:ShortString;
  i,count:integer;
begin
  count:=0;
  binStr:=convertDecToBin(number.Hex);
  for i:=0 to Length(binStr) do
    if binStr[i]='1' then
      Inc(count);
  if (count mod 2)=0 then
    checkParity:=True
  else
    checkParity:=false;
end;
constructor flagV.Create(flagLabel:TLabel);
begin
  inherited Create(flagLabel);
  flagLabel.Caption:='V';
  Check:=checkOverflow;
end;

constructor flagZ.Create(flagLabel:TLabel);
begin
  inherited Create(flagLabel);
  flagLabel.Caption:='Z';
  Check:=checkZero;
end;

constructor flagN.Create(flagLabel:TLabel);
begin
  inherited Create(flagLabel);
  flagLabel.Caption:='N';
  Check:=checkHighOne;
end;

constructor flagP.Create(flagLabel:TLabel);
begin
  inherited Create(flagLabel);
  flagLabel.Caption:='P';
  Check:=checkParity;
end;


function TAbstractRegister.getValue():byteWord;
begin
  getValue:=value;
end;
procedure TAbstractRegister.setDecValue(decValue:LongWord);
begin
  Number:=byteWord.Create(decValue);
end;
procedure TAbstractRegister.setHexValue(hexValue:ShortString);
begin
  Number:=byteWord.Create(hexValue);
end;
procedure TAbstractRegister.refreshFlags();
var i:integer;
begin
  for i:=0 to High(regFlag) do
    regFlag[i].refresh(Number);
end;
procedure TAbstractRegister.setValue(value:byteWord);
begin
  Self.value:=value;
  refreshFlags();
  refreshInterface();
end;

constructor TRegister.Create(ID:Integer);
var
  finder:TFind;
begin
  Self.ID:=ID;
  finder:=TFind.Create(Unit1.Form1);
  SetLength(regFlag,4);
  regFlag[0]:=flagN.Create(finder.findFlag(ID,1));
  regFlag[1]:=flagP.Create(finder.findFlag(ID,2));
  regFlag[2]:=flagV.Create(finder.findFlag(ID,3));
  regFlag[3]:=flagZ.Create(finder.findFlag(ID,4));
  setValue(byteWord.Create());
  finder.findHeader(ID).Caption:='REGISTER '+IntToStr(ID);
end;

procedure TRegister.refreshInterface();
var
  finder:TFind;
begin
  if regFlag[2].State then
    value.Text:='FFFF';
  finder:=TFind.Create(Unit1.Form1);
  finder.findValueLabel(ID,'Bin').Caption:=convertDecToBin(Number.Hex);
  finder.findValueLabel(ID,'Dec').Caption:=IntToStr(Number.Hex);
  finder.findValueLabel(ID,'Hex').Caption:=Number.Text;
end;
function TRegister.getID():Integer;
begin
  getID:=ID;
end;

function TAbstractProcessor.getRegister(Index: Integer):TRegister;
begin
  getRegister:=regs[index];
end;
function TAbstractProcessor.getCommand(Index: Integer):TAbstractCommand;
begin
  getCommand:=commands[index];
end;

constructor TProcessor.Create();
var i:Integer;
begin
  SetLength(regs,4);
  for i:=0 to High(regs) do
    regs[i]:=TRegister.Create(i+1);
  SetLength(commands,5);
  commands[0]:=TCommandAdd.Create;
  commands[1]:=TCommandSubst.Create;
  commands[2]:=TCommandAnd.Create;
  commands[3]:=TCommandOr.Create;
  commands[4]:=TCommandXor.Create;
  calc:=TCalculator.Create();
  initState;
end;

procedure TProcessor.initState();
var i:Integer;
begin
  REG1.setDecValue(1);
  REG2.setHexValue('8001');
  REG3.setHexValue('FFFF');
  REG4.setDecValue(256);

  with Unit1.Form1 do
  begin
    cbbRegList1.Items:=getRegisterIDs;
    cbbRegList1.ItemIndex:=0;
    cbbRegList1.Enabled:=True;
    cbbRegList2.Items:=getRegisterIDs;
    cbbRegList2.ItemIndex:=1;
    cbbRegList2.Enabled:=True;
    btnSetReg.Enabled:=True;
    btnSelectReg.Enabled:=True;

    cbbSetReg.Items:=getRegisterIDs;
    cbbSetReg.ItemIndex:=0;
    cbbSetReg.Enabled:=True;
    cbbOperList.Items.Clear;
    for i:=0 to High(commands) do
      cbbOperList.Items.Add(getCommand(i).name);
    cbbOperList.ItemIndex:=0;
    cbbOperList.Enabled:=True;
  end;
end;

function TProcessor.getRegisterIDs():TStrings;
var list:TStrings;i:integer; finder:TFind;
begin
  finder:=TFind.Create(Unit1.Form1);
  list:=TStringList.Create;
  for i:=0 to High(regs) do
    list.Add(finder.findHeader(regs[i].getID).Caption);
    Result:=list;
end;

procedure TProcessor.calculate();
begin
  with Unit1.Form1 do
    if (cbbRegList1.ItemIndex<>-1) and
       (cbbRegList2.ItemIndex<>-1) and
       (cbbOperList.ItemIndex<>-1) then
      calc.Add(getRegister(cbbRegList1.ItemIndex),
               getRegister(cbbRegList2.ItemIndex),
               getCommand(cbbOperList.ItemIndex));
  calc.process;
end;

constructor TAbstractCommand.Create(name:string);
begin
  Self.name:=name;
end;

constructor TCommandAdd.Create();
begin
  inherited Create('ADD');
end;

class function TCommandAdd.calculation(n1,n2:byteWord):byteWord;
begin
  Result:=byteWord.Create(n1.Hex+n2.Hex);
end;

constructor TCommandSubst.Create();
begin
  inherited Create('SUB');
end;

class function TCommandSubst.calculation(n1,n2:byteWord):byteWord;
var temp:byteWord;
begin
  temp:=byteWord.Create;
  if  n1.Hex>n2.Hex then
    temp.Hex:=n1.Hex-n2.Hex
  else
    temp.Hex:=$0;
  Result:=temp;
end;

constructor TCommandAnd.Create();
begin
  inherited Create('AND');
end;

class function TCommandAnd.calculation(n1,n2:byteWord):byteWord;
begin
  Result:=byteWord.Create(n1.Hex and n2.Hex);
end;

constructor TCommandOr.Create();
begin
  inherited Create('OR');
end;

class function TCommandOr.calculation(n1,n2:byteWord):byteWord;
begin
  Result:=byteWord.Create(n1.Hex or n2.Hex);
end;

constructor TCommandXor.Create();
begin
  inherited Create('XOR');
end;

class function TCommandXor.calculation(n1,n2:byteWord):byteWord;
begin
  Result:=byteWord.Create(n1.Hex xor n2.Hex);
end;

constructor TCalculator.Create();
begin

end;

procedure TCalculator.Add(N1:TRegister;N2:TRegister;Command:TAbstractCommand);
begin
  Self.N1:=N1;
  Self.N2:=N2;
  Self.Command:=Command;
end;

procedure TCalculator.process();
begin
  Unit1.Form1.TStringGridOut.Cells[0,0]:=N1.Number.Text;
  Unit1.Form1.TStringGridOut.Cells[1,0]:=Command.name;
  Unit1.Form1.TStringGridOut.Cells[2,0]:=N2.Number.Text;

  Unit1.Form1.TStringGridOut.Cells[0,1]:='REG'+IntToStr(N1.getID);
  Unit1.Form1.TStringGridOut.Cells[1,1]:=Command.name;
  Unit1.Form1.TStringGridOut.Cells[2,1]:='REG'+IntToStr(N2.getID);

  N2.Number:=Command.calculation(N1.Number,N2.Number);
  
  Unit1.Form1.TStringGridOut.Cells[3,0]:=':'+N2.Number.Text;
  Unit1.Form1.TStringGridOut.Cells[3,1]:=':REG'+IntToStr(N2.getID);
end;

function TFind.findFlag(regID:Integer;flagID:Integer):TLabel;
begin
  findFlag:=TLabel(
      Unit1.Form1.FindComponent('lblFlag'+IntToStr(flagID)+'_'+IntToStr(regID))
  );
end;

function TFind.findValueLabel(regID:Integer;labelType:ShortString):TLabel;
begin
  findValueLabel:=TLabel(
      Unit1.Form1.FindComponent('lbl'+labelType+'REG'+IntToStr(regID))
  );
end;
function TFind.findHeader(regID:Integer):TLabel;
begin
  findHeader:=TLabel(
      Unit1.Form1.FindComponent('lblNameREG'+IntToStr(regID))
  );
end;

end.