SPS_Emulator/usps.pas

unit uSPS;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, MCSTools;

const

  CMD_NULL = $00;
  PORT = $10;
  DELAY = $20;
  JUMP_BACK = $30;
  SET_A = $40;
  IS_A = $50;
  A_IS = $60;
  CALC = $70;
  PAGE = $80;
  JUMP = $90;
  C_COUNT = $A0;
  D_COUNT = $B0;
  SKIP_IF = $C0;
  CALL = $D0;
  CALL_SUB = $E0;
  CMD_BYTE = $F0;

const

  COMMANDS: array[0..15] of string =
    ('0', 'Dout', 'Delay', 'Jump -', 'A=#', '=A', 'A=',
    'A=Calculation', 'Page', 'Jump', 'C*', 'D*', 'Skip if', 'Call', 'Ret', 'Byte');

  O_LIST_H: array[0..15] of string =
    ('', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '');
  O_LIST_AT: array[0..15] of string =
    ('NOP', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '');

  DOUT_LIST: array[0..15] of string = ('Output 0000', 'Output 0001',
    'Output 0010', 'Output 0011', 'Output 0100', 'Output 0101', 'Output 0110',
    'Output 0111', 'Output 1000', 'Output 1001', 'Output 1010', 'Output 1011',
    'Output 1100', 'Output 1101', 'Output 1110', 'Output 1111');
  DELAY_LIST: array[0..15] of string = ('Delay 1ms', 'Delay 2ms',
    'Delay 5ms', 'Delay 10ms', 'Delay 20ms', 'Delay 50ms', 'Delay 100ms',
    'Delay 200ms', 'Delay 500ms', 'Delay 1s', 'Delay 2s', 'Delay 5s',
    'Delay 10s', 'Delay 20s', 'Delay 30s', 'Delay 60s');
  JUMP_B_LIST: array[0..15] of string = ('jump -0', 'jump -1',
    'jump -2', 'jump -3', 'jump -4', 'jump -5', 'jump -6',
    'jump -7', 'jump -8', 'jump -9', 'jump -10', 'jump -11',
    'jump -12', 'jump -13', 'jump -14', 'jump -15');
  A_LIST: array[0..15] of string = ('A=0', 'A=1',
    'A=2', 'A=3', 'A=4', 'A=5', 'A=6',
    'A=7', 'A=8', 'A=9', 'A=10', 'A=11',
    'A=12', 'A=13', 'A=14', 'A=15');
  IS_A_LIST_H: array[0..15] of string = ('', 'B=A',
    'C=A', 'D=A', 'Dout=A', 'Dout.1=A.0', 'Dout.2=A.0',
    'Dout.3=A.0', 'Dout.4=A.0', 'PWM.1=A', '', '',
    '', '', '', '');
  IS_A_LIST_A8: array[0..15] of string = ('', 'B=A',
    'C=A', 'D=A', 'Dout=A', 'Dout.1=A.0', 'Dout.2=A.0',
    'Dout.3=A.0', 'Dout.4=A.0', 'PWM.1=A', 'PWM.2=A', '',
    '', '', '', '');
  IS_A_LIST_AT: array[0..15] of string = ('A<->B', 'B=A',
    'C=A', 'D=A', 'Dout=A', 'Dout.1=A.0', 'Dout.2=A.0',
    'Dout.3=A.0', 'Dout.4=A.0', 'PWM.1=A', 'PWM.2=A', 'Servo.1=A',
    'Servo.2=A', 'E=A', 'F=A', 'Push A');
  A_IS_LIST_H: array[0..15] of string = ('', 'A=B',
    'A=C', 'A=D', 'A=Din', 'A=Din.1', 'A=Din.2',
    'A=Din.3', 'A=Din.4', 'A=ADC.1', 'A=ADC.2', '',
    '', '', '', '');
  A_IS_LIST_A8: array[0..15] of string = ('', 'A=B',
    'A=C', 'A=D', 'A=Din', 'A=Din.1', 'A=Din.2',
    'A=Din.3', 'A=Din.4', 'A=ADC.1', 'A=ADC.2', '',
    '', '', '', '');
  A_IS_LIST_AT: array[0..15] of string = ('', 'A=B',
    'A=C', 'A=D', 'A=Din', 'A=Din.1', 'A=Din.2',
    'A=Din.3', 'A=Din.4', 'A=ADC.1', 'A=ADC.2', 'A=RC.1',
    'A=RC.2', 'A=E', 'A=F', 'Pop A');
  A_CALC_LIST_H: array[0..15] of string = ('', 'A=A+1',
    'A=A-1', 'A=A+B', 'A=A-B', 'A=A*B', 'A=A/B',
    'A=A And B', 'A=A Or B', 'A=A Xor B', 'A=Not A', '',
    '', '', '', '');
  A_CALC_LIST_AT: array[0..15] of string = ('', 'A=A+1',
    'A=A-1', 'A=A+B', 'A=A-B', 'A=A*B', 'A=A/B',
    'A=A And B', 'A=A Or B', 'A=A Xor B', 'A=Not A', 'A=A % B',
    'A=A+16*B', 'A = B - A', 'A=A SHR 1', 'A=A SHL 1');
  PAGE_LIST_H: array[0..15] of string = ('Page 0', 'Page 1',
    'Page 2', 'Page 3', 'Page 4', 'Page 5', 'Page 6',
    'Page 7', '', '', '', '', '', '', '', '');
  PAGE_LIST_AT: array[0..15] of string = ('Page 0', 'Page 1',
    'Page 2', 'Page 3', 'Page 4', 'Page 5', 'Page 6',
    'Page 7', 'Page 8', 'Page 9', 'Page A', 'Page B',
    'Page C', 'Page D', 'Page E', 'Page F');
  JUMP_LIST: array[0..15] of string = ('Jump 0', 'Jump 1',
    'Jump 2', 'Jump 3', 'Jump 4', 'Jump 5', 'Jump 6',
    'Jump 7', 'Jump 8', 'Jump 9', 'Jump A', 'Jump B',
    'Jump C', 'Jump D', 'Jump E', 'Jump F');
  C_LIST: array[0..15] of string = ('C 0', 'C 1',
    'C 2', 'C 3', 'C 4', 'C 5', 'C 6',
    'C 7', 'C 8', 'C 9', 'C A', 'C B',
    'C C', 'C D', 'C E', 'C F');
  D_LIST: array[0..15] of string = ('D 0', 'D 1',
    'D 2', 'D 3', 'D 4', 'D 5', 'D 6',
    'D 7', 'D 8', 'D 9', 'D A', 'D B',
    'D C', 'D D', 'D E', 'D F');
  SKIP_LIST_H: array[0..15] of string = ('', 'A>B',
    'A<B', 'A=B', 'Din.1=1', 'Din.2=1', 'Din.3=1',
    'Din.4=1', 'Din.1=0', 'Din.2=0', 'Din.3=0', 'Din.4=0',
    'S_SEL=0', 'S_PRG=0', 'S_SEL=1', 'S_PRG=1');
  SKIP_LIST_A8: array[0..15] of string = ('', 'A>B',
    'A<B', 'A=B', 'Din.1=1', 'Din.2=1', 'Din.3=1',
    'Din.4=1', 'Din.1=0', 'Din.2=0', 'Din.3=0', 'Din.4=0',
    'S_SEL=0', 'S_PRG=0', 'S_SEL=1', 'S_PRG=1');
  SKIP_LIST_AT: array[0..15] of string = ('A=0', 'A>B',
    'A<B', 'A=B', 'Din.1=1', 'Din.2=1', 'Din.3=1',
    'Din.4=1', 'Din.1=0', 'Din.2=0', 'Din.3=0', 'Din.4=0',
    'S_SEL=0', 'S_PRG=0', 'S_SEL=1', 'S_PRG=1');
  CALL_LIST: array[0..15] of string = ('Jump 0', 'Jump 1',
    'Jump 2', 'Jump 3', 'Jump 4', 'Jump 5', 'Jump 6',
    'Jump 7', 'Jump 8', 'Jump 9', 'Jump A', 'Jump B',
    'Jump C', 'Jump D', 'Jump E', 'Jump F');
  RET_LIST_H: array[0..15] of string = ('Return', '',
    '', '', '', '', '', '', '', '', '', '', '', '', '', '');
  RET_LIST_AT: array[0..15] of string = ('Return', 'Call 1',
    'Call 2', 'Call 3', 'Call 4', 'Call 5', 'Call 6',
    '', 'Def 1', 'Def 2', 'Def 3', 'Def 4', 'Def 5',
    'Def 6', '', 'Restart');
  F_LIST_H: array[0..15] of string =
    ('', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '');
  F_LIST_AT: array[0..15] of string = ('A=ADC.1', 'A=ADC.2', 'A=RCin.1', 'A=RCin.2',
    'PWM.1=A', 'PWM.2=A', 'Servo.1=A', 'Servo.2=A', 'Tone=A', '', '', '',
    '', 'LED off', 'LED on', 'PrgEnd');

type
  {TPSVersion}

  TTPSVersion = (Holtek, ATMega8, ATTiny84, Arduino);

  { TServo }

  TServo = class(TObject)
  private
    pinno: integer;
    myValue: byte;
  public
    constructor Create();
    procedure attach(pin: byte);
    function attached: boolean;
    function getValue: byte;
    procedure Write(Value: byte);
  end;

  { TDelayCallback }

  TDelayCallback = procedure(Value: integer);

  { TSPS }

  TSPS = class(TObject)
  private
    { private declarations }
    version: TTPSVersion;

    dout1, dout2, dout3, dout4: boolean;
    din1, din2, din3, din4: boolean;
    sw_prg, sw_sel: boolean;

    adc1, adc2: byte;
    pwm1, pwm2: byte;
    rc1, rc2: byte;

    subs: array[1..6] of word;

    saveaddr: array[0..15] of word;
    saveCnt: byte;
    eeprom: array[0..255] of byte;
    adrPage: byte;
    addr: word;
    jumpAddr: word;
    a, b, c, d, e, f: byte;

    servo1, servo2: TServo;
    tone: integer;

    active: boolean;
    stop: boolean;

    stack: TByteStack;
    delayCallback: TDelayCallback;
    delayActive: boolean;

    procedure doNull(Data: byte);
    procedure doPort(Data: byte);
    procedure doDelay(Data: byte);
    procedure doJumpBack(Data: byte);
    procedure doSetA(Data: byte);
    procedure doAIs(Data: byte);
    procedure doIsA(Data: byte);
    procedure doCalc(Data: byte);
    procedure doPage(Data: byte);
    procedure doJump(Data: byte);
    procedure doCCount(Data: byte);
    procedure doDCount(Data: byte);
    procedure doSkipIf(Data: byte);
    procedure doCall(Data: byte);
    procedure doCallSub(Data: byte);
    procedure doByte(Data: byte);
    procedure doTone(Data: byte);

    procedure push(Data: byte);
    function pop(): byte;
  public
    { public declarations }
    constructor Create;
    destructor Destroy; override;
    procedure setDelayCallback(callback: TDelayCallback);
    function isDout1(): boolean;
    function isDout2(): boolean;
    function isDout3(): boolean;
    function isDout4(): boolean;
    function getPWM1(): byte;
    function getPWM2(): byte;
    function getServo1(): byte;
    function getServo2(): byte;
    function getTone(): integer;

    procedure setDin1(Data: boolean);
    procedure setDin2(Data: boolean);
    procedure setDin3(Data: boolean);
    procedure setDin4(Data: boolean);

    procedure setSPrg(Data: boolean);
    procedure setSSel(Data: boolean);

    procedure setADC1(Data: byte);
    procedure setADC2(Data: byte);
    procedure setRC1(Data: byte);
    procedure setRC2(Data: byte);

    procedure nextStep();
    procedure doReset();
    procedure start();
    procedure break();
    procedure doSingleCommand(command: byte);
    procedure preFetch();

    procedure writeEEProm(adr: byte; Data: byte);

    function isActive(): boolean;
    function isDelayActive(): boolean;
    function getAddress(): word;
    function getPage(): word;
    function getRAdr(): word;
    procedure getStack(List: TStrings);

    function getARegister(): byte;
    function getBRegister(): byte;
    function getCRegister(): byte;
    function getDRegister(): byte;
    function getERegister(): byte;
    function getFRegister(): byte;

    procedure setTPSVersion(tpsversion: TTPSVersion);

    procedure getCommands(list: TStrings);
    procedure getDatas(cmd: byte; list: TStrings);

    function getCommandText(cmd, Data: byte): string;

    function getJump(): byte;

  end;



implementation


uses Math, MCSStrings;

{ TServo }

constructor TServo.Create;
begin
  pinno := -1;
end;

procedure TServo.attach(pin: byte);
begin
  pinno := pin;
end;

function TServo.attached: boolean;
begin
  Result := pinno > -1;
end;

function TServo.getValue: byte;
begin
  Result := myValue;
end;

procedure TServo.Write(Value: byte);
begin
  myValue := Value;
end;

{ TSPS }

function TSPS.isDout1(): boolean;
begin
  Result := dout1;
end;

function TSPS.isDout2(): boolean;
begin
  Result := dout2;
end;

function TSPS.isDout3(): boolean;
begin
  Result := dout3;
end;

function TSPS.isDout4(): boolean;
begin
  Result := dout4;
end;

function TSPS.getPWM1(): byte;
begin
  Result := pwm1;
end;

function TSPS.getPWM2(): byte;
begin
  Result := pwm2;
end;

function TSPS.getServo1(): byte;
begin
  Result := servo1.getValue;
end;

function TSPS.getServo2(): byte;
begin
  Result := servo2.getValue;
end;

function TSPS.getTone(): integer;
begin
  Result := tone;
end;

procedure TSPS.setDin1(Data: boolean);
begin
  din1 := Data;
end;

procedure TSPS.setDin2(Data: boolean);
begin
  din2 := Data;
end;

procedure TSPS.setDin3(Data: boolean);
begin
  din3 := Data;
end;

procedure TSPS.setDin4(Data: boolean);
begin
  din4 := Data;
end;

procedure TSPS.setSPrg(Data: boolean);
begin
  sw_prg := Data;
end;

procedure TSPS.setSSel(Data: boolean);
begin
  sw_sel := Data;
end;

procedure TSPS.setADC1(Data: byte);
begin
  adc1 := Data;
end;

procedure TSPS.setADC2(Data: byte);
begin
  adc2 := Data;
end;

procedure TSPS.setRC1(Data: byte);
begin
  rc1 := Data;
end;

procedure TSPS.setRC2(Data: byte);
begin
  rc2 := Data;
end;

procedure TSPS.nextStep();
var
  Value: byte;
begin
  Value := eeprom[addr];
  addr := addr + 1;

  doSingleCommand(Value);

  if (addr > SizeOf(eeprom)) then
  begin
    doReset();
  end;
  preFetch();
end;

procedure TSPS.doReset();
begin
  a := 0;
  b := 0;
  c := 0;
  d := 0;
  e := 0;
  f := 0;
  stack.Reset();
  active := False;
  din1 := False;
  din2 := False;
  din3 := False;
  din4 := False;
  dout1 := False;
  dout2 := False;
  dout3 := False;
  dout4 := False;
  addr := 0;
  adrPage := 0;
  pwm2 := 0;
  pwm1 := 0;
  adc1 := 0;
  adc2 := 0;
  saveCnt := 0;
  servo2.Write(0);
  servo1.Write(0);
  stop := False;
end;

procedure TSPS.start();
var
  Value, cmd, Data: byte;
  x: integer;
begin
  doReset();
  for x := 0 to SizeOf(eeprom) do
  begin
    Value := eeprom[x];
    cmd := (Value and $F0);
    Data := (Value and $0F);
    if (cmd = CALL_SUB) then
    begin
      if (Data >= 8) then
      begin
        Data := Data - 7;
        subs[Data] := x + 1;
      end;
    end;
    if ((cmd = IS_A) and (Data = $0B)) then
    begin
      servo1.attach(0);
    end;
    if ((cmd = IS_A) and (Data = $0C)) then
    begin
      servo2.attach(1);
    end;
    if ((cmd = CMD_BYTE) and (Data = $06)) then
    begin
      servo1.attach(0);
    end;
    if ((cmd = CMD_BYTE) and (Data = $07)) then
    begin
      servo2.attach(1);
    end;
  end;
  active := True;
end;

procedure TSPS.break();
begin
  stop := True;
end;

procedure TSPS.doSingleCommand(command: byte);
var
  cmd, Data: byte;
begin
  cmd := (command and $F0);
  Data := (command and $0F);

  case cmd of
    CMD_NULL: doNull(Data);
    PORT: doPort(Data);
    DELAY: doDelay(Data);
    JUMP_BACK: doJumpBack(Data);
    SET_A: doSetA(Data);
    A_IS: doAIs(Data);
    IS_A: doIsA(Data);
    CALC: doCalc(Data);
    PAGE: doPage(Data);
    JUMP: doJump(Data);
    C_COUNT: doCCount(Data);
    D_COUNT: doDCount(Data);
    SKIP_IF: doSkipIf(Data);
    CALL: doCall(Data);
    CALL_SUB: doCallSub(Data);
    CMD_BYTE: doByte(Data);
  end;
end;

procedure TSPS.preFetch();
var
  cmd, Data: byte;
  skip: boolean;
begin
  jumpAddr := 0;
  skip := False;
  cmd := eeprom[addr];
  Data := (cmd and $0F);
  cmd := (cmd and $F0);
  case cmd of
    C_COUNT:
    begin
      if (c > 0) then
        jumpAddr := Data + 16 * Page;
    end;
    D_COUNT:
    begin
      if (d > 0) then
        jumpAddr := Data + 16 * Page;
    end;
    JUMP_BACK: jumpAddr := addr - Data;
    JUMP: jumpAddr := Data + 16 * Page;
    SKIP_IF:
    begin
      case Data of
        0: if (a = 0) then
            case version of
              ATTiny84, Arduino: skip := True;
            end;
        1: if (a > b) then
            skip := True;
        2: if (a < b) then
            skip := True;
        3: if (a = b) then
            skip := True;
        4: if (din1) then
            skip := True;
        5: if (din2) then
            skip := True;
        6: if (din3) then
            skip := True;
        7: if (din4) then
            skip := True;
        8: if (not din1) then
            skip := True;
        9: if (not din2) then
            skip := True;
        10: if (not din3) then
            skip := True;
        11: if (not din4) then
            skip := True;
        12: if (sw_sel) then
            skip := True;
        13: if (sw_prg) then
            skip := True;
        14: if (not sw_sel) then
            skip := True;
        15: if (not sw_prg) then
            skip := True;
      end;
      if (skip = True) then
        jumpAddr := addr + 2;
    end;
  end;
end;

procedure TSPS.writeEEProm(adr: byte; Data: byte);
begin
  eeprom[adr] := Data;
end;

function TSPS.isActive(): boolean;
begin
  Result := active;
end;

function TSPS.isDelayActive(): boolean;
begin
  Result := delayActive;
end;

function TSPS.getAddress(): word;
begin
  Result := addr;
end;

function TSPS.getPage(): word;
begin
  Result := adrPage div 16;
end;

function TSPS.getRAdr(): word;
begin
  if (saveCnt = 0) then
  begin
    Result := 0;
  end;
  Result := saveaddr[saveCnt - 1];
end;

procedure TSPS.getStack(List: TStrings);
var
  i: integer;
begin
  for i := 0 to stack.Count - 1 do
  begin
    List.Add(IntToHex(stack.peek(i), 2));
  end;
end;

function TSPS.getARegister(): byte;
begin
  Result := a;
end;

function TSPS.getBRegister(): byte;
begin
  Result := b;
end;

function TSPS.getCRegister(): byte;
begin
  Result := c;
end;

function TSPS.getDRegister(): byte;
begin
  Result := d;
end;

function TSPS.getERegister(): byte;
begin
  Result := e;
end;

function TSPS.getFRegister(): byte;
begin
  Result := f;
end;

procedure TSPS.setTPSVersion(tpsversion: TTPSVersion);
begin
  version := tpsversion;
end;

procedure TSPS.getCommands(list: TStrings);
begin
  MCSStrings.copyArray2List(COMMANDS, list);
end;

procedure TSPS.getDatas(cmd: byte; list: TStrings);
begin
  if (cmd = 0) then
  begin
    case version of
      Holtek, ATMega8: MCSStrings.copyArray2List(O_LIST_H, list);
      ATTiny84, Arduino: MCSStrings.copyArray2List(O_LIST_AT, list);
    end;
  end;
  if (cmd = 1) then
  begin
    MCSStrings.copyArray2List(DOUT_LIST, list);
  end;
  if (cmd = 2) then
    MCSStrings.copyArray2List(DELAY_LIST, list);
  if (cmd = 3) then
    MCSStrings.copyArray2List(JUMP_B_LIST, list);
  if (cmd = 4) then
    MCSStrings.copyArray2List(A_LIST, list);
  if (cmd = 5) then
  begin
    case version of
      Holtek: MCSStrings.copyArray2List(IS_A_LIST_H, list);
      ATMega8: MCSStrings.copyArray2List(IS_A_LIST_A8, list);
      ATTiny84, Arduino: MCSStrings.copyArray2List(IS_A_LIST_AT, list);
    end;
  end;
  if (cmd = 6) then
  begin
    case version of
      Holtek: MCSStrings.copyArray2List(A_IS_LIST_H, list);
      ATMega8: MCSStrings.copyArray2List(A_IS_LIST_A8, list);
      ATTiny84, Arduino: MCSStrings.copyArray2List(A_IS_LIST_AT, list);
    end;
  end;
  if (cmd = 7) then
  begin
    case version of
      Holtek, ATMega8: MCSStrings.copyArray2List(A_CALC_LIST_H, list);
      ATTiny84, Arduino: MCSStrings.copyArray2List(A_CALC_LIST_AT, list);
    end;
  end;
  if (cmd = 8) then
  begin
    case version of
      Holtek, ATMega8: MCSStrings.copyArray2List(PAGE_LIST_H, list);
      ATTiny84, Arduino: MCSStrings.copyArray2List(PAGE_LIST_AT, list);
    end;
  end;
  if (cmd = 9) then
    MCSStrings.copyArray2List(JUMP_LIST, list);
  if (cmd = 10) then
    MCSStrings.copyArray2List(C_LIST, list);
  if (cmd = 11) then
    MCSStrings.copyArray2List(D_LIST, list);
  if (cmd = 12) then
  begin
    case version of
      Holtek: MCSStrings.copyArray2List(SKIP_LIST_H, list);
      ATMega8: MCSStrings.copyArray2List(SKIP_LIST_A8, list);
      ATTiny84, Arduino: MCSStrings.copyArray2List(SKIP_LIST_AT, list);
    end;
  end;
  if (cmd = 13) then
    MCSStrings.copyArray2List(CALL_LIST, list);
  if (cmd = 14) then
  begin
    case version of
      Holtek, ATMega8: MCSStrings.copyArray2List(RET_LIST_H, list);
      ATTiny84, Arduino: MCSStrings.copyArray2List(RET_LIST_AT, list);
    end;
  end;
  if (cmd = 15) then
  begin
    case version of
      Holtek, ATMega8: MCSStrings.copyArray2List(F_LIST_H, list);
      ATTiny84, Arduino: MCSStrings.copyArray2List(F_LIST_AT, list);
    end;
  end;
end;

function TSPS.getCommandText(cmd, Data: byte): string;
var
  list: TStrings;
  line: string;
begin
  if ((cmd >= 0) and (cmd < 16)) then
  begin
    list := TStringList.Create;
    getDatas(cmd, list);
    if ((Data >= 0) and (Data < 16)) then
      line := COMMANDS[cmd] + ':' + list[Data];
    list.Free;
  end;
  Result := line;
end;

function TSPS.getJump(): byte;
begin
  Result := jumpAddr;
end;

procedure TSPS.doNull(Data: byte);
begin
  // Do nothing
end;

// output to port
procedure TSPS.doPort(Data: byte);
begin
  dout1 := (Data and $01) > 0;
  dout2 := (Data and $02) > 0;
  dout3 := (Data and $04) > 0;
  dout4 := (Data and $08) > 0;
end;

// delay in ms
procedure TSPS.doDelay(Data: byte);
var
  delayValue: integer;
  x: integer;
begin
  case Data of
    0: delayValue := 1;
    1: delayValue := 2;
    2: delayValue := 5;
    3: delayValue := 10;
    4: delayValue := 20;
    5: delayValue := 50;
    6: delayValue := 100;
    7: delayValue := 200;
    8: delayValue := 500;
    9: delayValue := 1000;
    10: delayValue := 2000;
    11: delayValue := 5000;
    12: delayValue := 10000;
    13: delayValue := 20000;
    14: delayValue := 30000;
    15: delayValue := 60000;
  end;
  delayActive := True;
  repeat
    if (delayValue >= 100) then
    begin
      Dec(delayValue, 100);
      Sleep(100);
      delayCallback(delayValue);
    end;
  until ((delayValue <= 100) or stop);
  delayCallback(0);
  delayActive := False;
end;

// jump relative back
procedure TSPS.doJumpBack(Data: byte);
begin
  addr := addr - Data - 1;
end;

// a = data
procedure TSPS.doSetA(Data: byte);
begin
  a := Data;
end;

// a = somthing;
procedure TSPS.doAIs(Data: byte);
begin
  case Data of
    1: a := b;
    2: a := c;
    3: a := d;
    4:
    begin
      a := 0;
      if (din1) then
        a := a + 1;
      if (din2) then
        a := a + 2;
      if (din3) then
        a := a + 4;
      if (din4) then
        a := a + 8;
    end;
    5: if (din1) then
        a := 1
      else
        a := 0;
    6: if (din2) then
        a := 1
      else
        a := 0;
    7: if (din3) then
        a := 1
      else
        a := 0;
    8: if (din4) then
        a := 1
      else
        a := 0;
    9: a := adc1 and $0f; //(Umrechnen auf 4 bit)
    10: a := adc2 and $0f; //(Umrechnen auf 4 bit)
    11: a := rc1 and $0f; //(Umrechnen auf 4 bit)
    12: a := rc2 and $0f; //(Umrechnen auf 4 bit)
    13: a := e;
    14: a := f;
    15: a := pop();
  end;
end;

// somthing = a;
procedure TSPS.doIsA(Data: byte);
var
  tmpValue: byte;
begin
  case Data of
    0: case version of
        ATTiny84, Arduino:
        begin
          tmpValue := b;
          b := a;
          a := tmpValue;
        end;
      end;
    1: b := a;
    2: c := a;
    3: d := a;
    4: doPort(a);
    5: dout1 := (a and $01) > 0;
    6: dout2 := (a and $01) > 0;
    7: dout3 := (a and $01) > 0;
    8: dout4 := (a and $01) > 0;
    9:
    begin
      pwm1 := a * 16;
      case version of
        Holtek:
        begin
          pwm1 := a;
        end;
      end;
    end;
    10: pwm2 := a * 16;
    11:
    begin
      if (servo1.attached()) then
        servo1.Write((a * 10) + 10);
    end;
    12:
    begin
      if (servo2.attached()) then
        servo2.Write((a * 10) + 10);
    end;
    13: e := a;
    14: f := a;
    15: push(a);
  end;
end;

// calculations
procedure TSPS.doCalc(Data: byte);
begin
  case Data of
    1: a := a + 1;
    2: a := a - 1;
    3: a := a + b;
    4: a := a - b;
    5: a := a * b;
    6: a := a div b;
    7: a := a and b;
    8: a := a or b;
    9: a := a xor b;
    10: a := not a;
    11: case version of
        ATTiny84, Arduino: a := a mod b;
      end;
    12: case version of
        ATTiny84, Arduino: a := a + 16 * b;
      end;
    13: case version of
        ATTiny84, Arduino: a := b - a;
      end;
    14: case version of
        ATTiny84, Arduino: a := a SHR 1;
      end;
    15: case version of
        ATTiny84, Arduino: a := a SHL 1;
      end;
  end;
  case version of
    Holtek, ATMega8: a := a and 15;
  end;
end;

// setting page
procedure TSPS.doPage(Data: byte);
begin
  adrPage := Data * 16;
end;

// jump absolute
procedure TSPS.doJump(Data: byte);
begin
  addr := adrPage + Data;
end;

// counting with c register
procedure TSPS.doCCount(Data: byte);
begin
  if (c > 0) then
  begin
    c := c - 1;
    c := c and $0F;
    doJump(Data);
  end;
end;

// counting with d register
procedure TSPS.doDCount(Data: byte);
begin
  if (d > 0) then
  begin
    d := d - 1;
    d := d and $0F;
    doJump(Data);
  end;
end;

// simple comdition = true skip next command
procedure TSPS.doSkipIf(Data: byte);
begin
  case (Data) of
    0: if (a = 0) then
        case version of
          ATTiny84, Arduino: addr := addr + 1;
        end;
    1: if (a > b) then
        addr := addr + 1;
    2: if (a < b) then
        addr := addr + 1;
    3: if (a = b) then
        addr := addr + 1;
    4: if (din1) then
        addr := addr + 1;
    5: if (din2) then
        addr := addr + 1;
    6: if (din3) then
        addr := addr + 1;
    7: if (din4) then
        addr := addr + 1;
    8: if (not din1) then
        addr := addr + 1;
    9: if (not din2) then
        addr := addr + 1;
    10: if (not din3) then
        addr := addr + 1;
    11: if (not din4) then
        addr := addr + 1;
    12: if (sw_sel) then
        addr := addr + 1;
    13: if (sw_prg) then
        addr := addr + 1;
    14: if (not sw_sel) then
        addr := addr + 1;
    15: if (not sw_prg) then
        addr := addr + 1;
  end;
end;

// calling a subroutine
procedure TSPS.doCall(Data: byte);
begin
  saveaddr[saveCnt] := addr;
  case version of
    ATTiny84, Arduino: saveCnt := saveCnt + 1;
  end;
  addr := adrpage + Data;
end;

// calling a subroutine, calling return and restart
procedure TSPS.doCallSub(Data: byte);
begin
  if (Data = 0) then
  begin
    case version of
      ATTiny84, Arduino:
      begin
        if (saveCnt = 0) then
        begin
          doReset();
          exit;
        end;
        saveCnt := saveCnt - 1;
      end;
    end;
    addr := saveaddr[saveCnt];
    exit;
  end;
  if ((Data <= 6) and ((version = ATTiny84) or (version = Arduino))) then
  begin
    // call subroutine number
    saveaddr[saveCnt] := addr;
    saveCnt := saveCnt + 1;
    addr := subs[Data];
    exit;
  end;
  if ((Data = $0f) and ((version = ATTiny84) or (version = Arduino))) then
  begin
    doReset();
    exit;
  end;
end;

procedure TSPS.doByte(Data: byte);
var
  Value: integer;
begin
  // Some byte commands
  case (Data) of
    0: case version of
        ATTiny84, Arduino: a := adc1;
      end;
    1: case version of
        ATTiny84, Arduino: a := adc2;
      end;
    2: case version of
        ATTiny84, Arduino: a := rc1;
      end;
    3: case version of
        ATTiny84, Arduino: a := rc2;
      end;
    4: pwm1 := a;
    5: pwm2 := a;
    6:
    begin
      if (servo1.attached()) then
      begin
        Value := (180 * a) div 255;
        servo1.Write(Value);
      end;
    end;
    7:
    begin
      if (servo2.attached()) then
      begin
        Value := (180 * a) div 255;
        servo2.Write(Value);
      end;
    end;
    8:
      case version of
        ATTiny84, Arduino: doTone(Data);
      end;
  end;
end;

procedure TSPS.doTone(Data: byte);
begin
  if (a in [36..109]) then
    tone := a
  else
    tone := 0;
end;

procedure TSPS.push(Data: byte);
begin
  stack.Push(Data);
end;

function TSPS.pop(): byte;
begin
  Result := stack.pop;
end;

constructor TSPS.Create;
begin
  servo1 := TServo.Create();
  servo2 := TServo.Create();
  stack := TByteStack.Create;
  stop := False;
  delayActive := False;
end;

destructor TSPS.Destroy;
begin
  inherited Destroy;
  servo1.Free;
  servo2.Free;
  stack.Free;
end;

procedure TSPS.setDelayCallback(callback: TDelayCallback);
begin
  delayCallback := callback;
end;

end.