unit PicoBasic;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus,
  LCLType, ExtCtrls, RSCOM;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    Button18: TButton;
    Button19: TButton;
    Button2: TButton;
    Button20: TButton;
    Button21: TButton;
    Button22: TButton;
    Button23: TButton;
    Button24: TButton;
    Button25: TButton;
    Button26: TButton;
    Button27: TButton;
    Button28: TButton;
    Button29: TButton;
    Button3: TButton;
    Button30: TButton;
    Button31: TButton;
    Button32: TButton;
    Button33: TButton;
    Button34: TButton;
    Button35: TButton;
    Button36: TButton;
    Button37: TButton;
    Button38: TButton;
    Button39: TButton;
    Button4: TButton;
    Button40: TButton;
    Button41: TButton;
    Button42: TButton;
    Button43: TButton;
    Button44: TButton;
    Button45: TButton;
    Button46: TButton;
    Button47: TButton;
    Button48: TButton;
    Button49: TButton;
    Button5: TButton;
    Button50: TButton;
    Button51: TButton;
    Button52: TButton;
    Button53: TButton;
    Button54: TButton;
    Button55: TButton;
    Button56: TButton;
    Button57: TButton;
    Button58: TButton;
    Button59: TButton;
    Button6: TButton;
    Button60: TButton;
    Button61: TButton;
    Button62: TButton;
    Button63: TButton;
    Button64: TButton;
    Button65: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    ListBox1: TListBox;
    MainMenu1: TMainMenu;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Timer1: TTimer;
    procedure Button61Click(Sender: TObject);
    procedure Button62Click(Sender: TObject);
    procedure Button63Click(Sender: TObject);
    procedure Button64Click(Sender: TObject);
    procedure Button65Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure Edit9Change(Sender: TObject);
    procedure Edit9KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Button59Click(Sender: TObject);
    procedure Button60Click(Sender: TObject);
    procedure LabelKorrektur();
    procedure Timer1Timer(Sender: TObject);
    procedure ZeileEinfuegen(Zeile: String);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private


  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
var f: TextFile;
   Zeile, COMnr, OpenString, Device: String;
   r, i, p, d: Integer;
   RunStart: Integer;
   SelectedIndex: Integer;
   FileName: String;
   Adresse, LabelNr, n: Integer;
   Labl: Array[0..255] of Byte;
const
  Commands: array[0..57, 0..2] of string = (
  ('0x01', 'A = ', '1'),
  ('0x02', 'B = ', '1'),
  ('0x03', 'C = ', '1'),
  ('0x04', 'D = ', '1'),
  ('0x08', 'Pout = ', '2'),
  ('0x09', 'Pdir = ', '2'),
  ('0x0A', 'Pullup = ', '2'),
  ('0x0B', 'Pulldown = ', '2'),
  ('0x10', 'PWM1 = ', '3'),
  ('0x11', 'PWM2 = ', '3'),
  ('0x12', 'A = A AND = ', '3'),
  ('0x13', 'A = A OR = ', '3'),
  ('0x18', 'Delay µs = ', '4'),
  ('0x19', 'Delay ms = ', '4'),
  ('0x1A', 'Delay s = ', '4'),
  ('0x1B', 'Delay min = ', '4'),
  ('              ', 'Label L', '5'),
  ('0x20', 'Goto L', '5'),
  ('0x21', 'Gosub L', '5'),
  ('0x22', 'If A=B Goto L', '5'),
  ('0x23', 'If A>B Goto L', '6'),
  ('0x24', 'If A<B Goto L', '6'),
  ('0x25', 'C*Goto L', '6'),
  ('0x26', 'D*Goto L', '6'),
  ('0x28', 'A = A + 1', '0'),
  ('0x29', 'A = A - 1', '0'),
  ('0x2A', 'A = A + B', '0'),
  ('0x2B', 'A = A - B', '0'),
  ('0x2C', 'A = A * B', '0'),
  ('0x2D', 'A = A / B', '0'),
  ('0x2E', 'A = A And B', '0'),
  ('0x2F', 'A = A Or B', '0'),
  ('0x30', 'A = A Xor B', '0'),
  ('0x31', 'A = A Shl B', '0'),
  ('0x32', 'A = A Shr B', '0'),
  ('0x33', 'A = Not A', '0'),
  ('0x34', 'B = A', '0'),
  ('0x35', 'A = B', '0'),
  ('0x36', 'C = A', '0'),
  ('0x37', 'A = C', '0'),
  ('0x38', 'D = A', '0'),
  ('0x39', 'A = D', '0'),
  ('0x3A', 'A = [B+]', '0'),
  ('0x3B', '[B+] = A', '0'),
  ('0x3C', 'A = AD0', '0'),
  ('0x3D', 'A = AD1', '0'),
  ('0x3E', 'A = AD2', '0'),
  ('0x3F', 'A = Pin', '0'),
  ('0x40', 'A = Pin0', '0'),
  ('0x41', 'Input A', '0'),
  ('0x42', 'Print A', '0'),
  ('0x43', 'PWM1 = A', '0'),
  ('0x44', 'PWM2 = A', '0'),
  ('0x45', 'Pout = A', '0'),
  ('0x48', 'Return', '0'),
  ('0x49', 'End', '0'),
  ('0x4A', 'Nop', '0'),
  ('              ', 'Rem ', '7')
  );

  function BinStrToInt(BinStr: string): Integer;
  var
    i, Value: Integer;
  begin
    Value := 0;
    for i := 1 to Length(BinStr) do
    begin
      Value := Value shl 1; // Linksschieben (multiplizieren mit 2)
      if BinStr[i] = '1' then
        Inc(Value); // Addiere 1 für jedes gesetzte Bit
    end;
    Result := Value;
  end;

  function ConvertToInteger(Input: string): Integer;
  begin
    Input := upcase(Input);

    if (Length(Input) > 2) and ((Input[1] = '0') and (Input[2] in ['x', 'X'])) then
      Result := StrToInt('$' + Copy(Input, 3, Length(Input) - 2))
    else if (Length(Input) > 2) and ((Input[1] = '0') and (Input[2] in ['b', 'B'])) then
      Result := StrToInt('$' + IntToHex(BinStrToInt(Copy(Input, 3, Length(Input) - 2)), 8)) // Binär (z.B. 0b1010)
    else
      TryStrToInt(Input, Result); // Dezimal
  end;

procedure TForm1.LabelKorrektur();
  var
    Ladr, Lnr, n, p: Integer;
    Ganz, Teil: String;
  begin
    Ladr := 0;
    for n := 1 To Form1.ListBox1.Items.Count -2 do begin
      Teil := copy(Form1.ListBox1.Items[n],1,2);
      If copy(Form1.ListBox1.Items[n],1,2) = '0x' then  begin
        Ladr := Ladr + 1;
      end;
      Teil := copy(Form1.ListBox1.Items[n],1,15);
      if copy(Form1.ListBox1.Items[n],1,15) = '              L' then begin
          Teil :=  copy(Form1.ListBox1.Items[n],16,length(Form1.ListBox1.Items[n])-16);
          Lnr := StrToInt (copy(Form1.ListBox1.Items[n],16,length(Form1.ListBox1.Items[n])-16));
          Labl[Lnr] := Ladr;
      end;
    end;

    Ladr := 0;
    for n := 1 To Form1.ListBox1.Items.Count -2 do begin
        if ConvertToInteger(copy(Form1.ListBox1.Items[n],1,4)) in [32..38] Then  begin
          If copy(ListBox1.Items[n],1,5) <> '0x21F' then  begin
            Ganz := Form1.ListBox1.Items[n];
              p := Pos('L', Ganz);
              Teil := copy(Ganz,p+1,length(Ganz)-p-1);
              Lnr := StrToInt(Teil);
              Ladr :=  Labl[Lnr];
              Teil := intToHex(Ladr);
              Zeile := copy (Ganz,1,4) + copy(Teil,length(Teil)-1,2) +  copy(Ganz,7,length(Ganz)-6);
              Form1.ListBox1.Items[n] := Zeile;
          end;
         end;
       end;
    d:=Ladr;
   end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  n: Integer;
begin
   if RunStart = 1 then begin
     ClearBuffer;
     Delay(1000);
     Edit8.text := '';
     RunStart := 0;
   end;
   for n:= 1 to 4 do begin
     if INBUFFER() > 0 then  begin
       d := ReadByte;
       if d=13 then Edit8.Text := Edit8.Text + ' ';
       Edit8.Text := Edit8.Text + Chr(d);
       Edit8.SelStart := Length(Edit8.Text);
     end;
   end;
end;

procedure  TForm1.ZeileEinfuegen(Zeile: String);
var
  SelectedIndex: Integer;
  LastIndex: Integer;
begin
  SelectedIndex := Form1.ListBox1.ItemIndex;
  LastIndex := Form1.ListBox1.Items.Count;
  if (SelectedIndex > 0) And ((SelectedIndex) < LastIndex) then
  begin
   SelectedIndex := Form1.ListBox1.ItemIndex;
   Form1.ListBox1.Items.Insert(SelectedIndex, Zeile);
   Form1.ListBox1.TopIndex := Form1.ListBox1.Items.Count - 1;
  end;
  Adresse := Adresse + 1;
  LabelKorrektur();
end;

procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  SelectedIndex: Integer;
  LastIndex: Integer;
begin
  SelectedIndex := ListBox1.ItemIndex;
  LastIndex := ListBox1.Items.Count;
  if Key = VK_DELETE then
  begin
    if (SelectedIndex > 0) And ((SelectedIndex+1) < LastIndex) then
    begin
      ListBox1.Items.Delete(ListBox1.ItemIndex);
      ListBox1.ItemIndex := SelectedIndex;
      LabelKorrektur();
    end;
  end;
end;

procedure TForm1.Button61Click(Sender: TObject);
begin
   ListBox1.Clear;
   ListBox1.Items.Insert(0, '        <<<');
   ListBox1.Items.Insert(1, '        >>>');
   ListBox1.ItemIndex := 1;
   Adresse := 0;
   LabelNr := 0;
   Edit5.Text := '0';
   Edit6.Text := '1';
end;

procedure TForm1.Button62Click(Sender: TObject); //Run
var
  Teil: String;
begin
  i:= OPENCOM (pchar(Openstring));
  if i = 0 then Edit8.text := 'COM error';
  if i = 1 then begin
    If Device = 'Pico' then DTR(1) Else DTR(0);
    RTS(0);
    DELAY(200);
    p := 0;
    for n:=1 to ListBox1.Items.Count -2 do begin
     Zeile := ListBox1.Items[n];
     if (copy(Zeile,1,2))> '  ' then p := p + 1;
    end;
    Edit8.text := 'p'+ IntToStr(p) + '  ';
    SENDSTRING (pchar('p'+ (IntToStr(p))+chr(13)));
    Delay(1);
    for n:=1 to ListBox1.Items.Count -2 do begin
      Zeile := ListBox1.Items[n];
      Teil :=(copy(Zeile,1,6));
      if Teil > '      ' then begin
        d := ConvertToInteger(Teil);
        Edit8.text := Edit8.text + IntToStr(d) + ' ';
        DELAY(1);
        SENDSTRING (pchar(IntToStr(d)+chr(13)));
        Delay(1);
      end;
    end;
  end;
  RunStart := 1;
end;

procedure TForm1.Button63Click(Sender: TObject);  //EEprom
 var
   Teil: String;
   begin
     i:= OPENCOM (pchar(Openstring));
     if i = 0 then Edit8.text := 'COM error';
     if i = 1 then begin
       If Device = 'Pico' then DTR(1) Else DTR(0);
       RTS(0);
       DELAY(200);
       p := 0;
       for n:=1 to ListBox1.Items.Count -2 do begin
        Zeile := ListBox1.Items[n];
        if (copy(Zeile,1,2))> '  ' then p := p + 1;
       end;
       Edit8.text := 'e'+ IntToStr(p) + '  ';
       SENDSTRING (pchar('e'+ (IntToStr(p))+chr(13)));
       Delay(20);
       for n:=1 to ListBox1.Items.Count -2 do begin
         Zeile := ListBox1.Items[n];
         Teil :=(copy(Zeile,1,6));
         if Teil > '      ' then begin
           d := ConvertToInteger(Teil);
           Edit8.text := Edit8.text + IntToStr(d) + ' ';
           SENDSTRING (pchar(IntToStr(d)+chr(13)));
           Delay(10);
         end;
       end;
     end;
     RunStart := 1;
   end;

procedure TForm1.Button64Click(Sender: TObject);    //Stop
begin
    SENDSTRING (pchar('I'));
end;

procedure TForm1.Button65Click(Sender: TObject);    //Go
begin
         SENDSTRING (pchar('J'));
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  COMnr :=  ComboBox2.text;
  Device := ComboBox1.text;
  Openstring := ComNr + '1000000,N,8,1';
  i:= OPENCOM (pchar(Openstring));
  if i = 0 then Edit8.text := 'COM error' else Edit8.text := 'COM open';
  If Device = 'Pico' then DTR(1) Else DTR(0);
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
begin
  COMnr :=  ComboBox2.text;
  Device := ComboBox1.text;
  Openstring := ComNr + '1000000,N,8,1';
  i:= OPENCOM (pchar(Openstring));
  if i = 0 then Edit8.text := 'COM error' else Edit8.text := 'COM open';
  If Device = 'Pico' then DTR(1) Else DTR(0);
end;

procedure TForm1.Edit9Change(Sender: TObject);
var
c: String;
begin
  c := Edit9.text;
  if copy(c, length(c),1)= chr(13) then Edit8.text := c;
end;

procedure TForm1.Edit9KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
  );
var
  InputNumber: Integer;
begin
  if Key = VK_RETURN then
  begin
    try
      InputNumber := ConvertToInteger((Sender as TEdit).Text);
      SendString(Pchar(IntToStr(InputNumber)+ Chr(13)));
    except
      on E: EConvertError do;
    end;
  end;
end;





procedure TForm1.Button60Click(Sender: TObject);   //Save
var
  MyFile: TextFile;
  Zeile2: String;
  n : Integer;
begin
  SaveDialog1.FileName := '*.pbas';
  if FileName > '' then  SaveDialog1.FileName := Filename;
     SaveDiaLog1.Execute;
     FileName := SaveDialog1.FileName;
     if FileName > '' then begin
        AssignFile(MyFile,FileName);
        {$I-} Rewrite(MyFile); {$I+}
        //Rewrite(MyFile);
        r:=IOResult;
        if r = 0 then begin
           for n:=1 to ListBox1.Items.Count -2 do begin
            Zeile2 := ListBox1.Items[n];
            //if (copy(Zeile2,1,2))='  ' then Zeile2 :='      '+ Zeile2;
            writeln (MyFile,Zeile2);
           end;
        end;
        CloseFile(MyFile);
     end;
end;

procedure TForm1.Button59Click(Sender: TObject);    //Open
begin
  OpenDialog1.FileName := '*.pbas';
  OpenDiaLog1.Execute;
   if OpenDialog1.FileName > '' then begin
     //form1.caption :=  OpenDialog1.FileName;
     AssignFile(f,OpenDialog1.Filename);
     FileName := OpenDialog1.Filename;
     {$I-} Reset(f); {$I+}
     r:=IOResult;
     if r = 0 then begin
       ListBox1.Clear;
       ListBox1.Items.Insert(0, '        <<<');
       ListBox1.Items.Insert(1, '        >>>');
       ListBox1.ItemIndex := 1;
       Adresse := 0;
       LabelNr := 0;
       repeat
         Readln(f,Zeile);
         if length(Zeile) > 1 then begin
           SelectedIndex := ListBox1.ItemIndex; // Index des markierten Eintrags
           ListBox1.Items.Insert(SelectedIndex, Zeile); // Neuen Eintrag einfügen
         end
       until (EOF(f));
    end;
    CloseFile(f);
    LabelKorrektur();
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
   Nr, EditNr, Zahl, n: Word;
   HexStr: String;
begin
 Nr := (Sender as TButton).Tag;
 if Nr = 16 then begin                //Label
   n := ConvertToInteger(Edit5.text);
   LabelNr := n + 1;
   Edit5.Text := intToStr (LabelNr);
   Edit6.Text := intToStr (LabelNr);
   Zeile := '              L' + Edit5.Text + ':';
   ZeileEinfuegen(Zeile);
   Adresse := Adresse - 1;
   Labl[LabelNr] := Adresse;
 end
 else begin
  if Nr = 57 then begin

      Zeile := Commands[Nr,0];
      Zeile := Zeile + Commands[Nr,1];
      Zeile := Zeile + Edit7.text;
      ZeileEinfuegen(Zeile);
      Adresse := Adresse - 1;
  end
  else begin
      Zeile := Commands[Nr,0];
      EditNr := StrToInt (Commands[Nr,2]);
      if Commands[Nr,2] = '0' then begin
        Zeile := Zeile + '00  ';
      end
      else begin
        if EditNr = 1 then Zahl :=  ConvertToInteger(Edit1.text);
        if EditNr = 2 then Zahl :=  ConvertToInteger(Edit2.text);
        if EditNr = 3 then Zahl :=  ConvertToInteger(Edit3.text);
        if EditNr = 4 then Zahl :=  ConvertToInteger(Edit4.text);
        if EditNr = 5 then Zahl :=  Labl[ConvertToInteger(Edit5.text)];
        if EditNr = 6 then Zahl :=  Labl[ConvertToInteger(Edit6.text)];
        HexStr := intToHex(Zahl);
        if EditNr in [1..6] then  HexStr := copy (HexStr,length(HexStr)-1,2);
        Zeile := Zeile +  HexStr+ '  ';
      end;
      Zeile := Zeile + Commands[Nr,1];
      if EditNr = 1 then Zeile := Zeile + Edit1.text;
      if EditNr = 2 then Zeile := Zeile + Edit2.text;
      if EditNr = 3 then Zeile := Zeile + Edit3.text;
      if EditNr = 4 then Zeile := Zeile + Edit4.text;
      if EditNr = 5 then Zeile := Zeile + Edit5.text + ':';
      if EditNr = 6 then Zeile := Zeile + Edit6.text + ':';
      if EditNr = 7 then Zeile := Zeile + Edit7.text;
      ZeileEinfuegen(Zeile);
  end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  MyFile: TextFile;
begin
  AssignFile(MyFile,'TestLab.ini');
  {$I-} Reset(MyFile); {$I+}
  r:=IOResult;
  if r = 0 then begin
    Readln(MyFile,COMnr);
    Readln(MyFile,Device);
    CloseFile(MyFile);
  end;
  ComboBox2.text := COMnr;
  Combobox1.text := Device;
  ListBox1.Clear;
  ListBox1.Items.Insert(0, '        <<<');
  ListBox1.Items.Insert(1, '        >>>');
  ListBox1.ItemIndex := 1;
  For n := 240 To 255 do Labl[n] := n;
  Adresse := 0;
  LabelNr := 0;
  TIMEINIT();
  Device := ComboBox1.text;
  Openstring := ComNr + '1000000,N,8,1';
  i:= OPENCOM (pchar(Openstring));
  if i = 0 then Edit8.text := 'COM error';
  If Device = 'Pico' then DTR(1) Else DTR(0);
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
  MyFile: TextFile;
begin
  CLOSECOM;
  COMnr := ComboBox2.text;
  Device := Combobox1.text;
  AssignFile(MyFile,'TestLab.ini');
  {$I-} Rewrite(MyFile); {$I+}
  writeln (MyFile,COMnr);
  writeln (MyFile,Device);
  CloseFile(MyFile);
end;
end.

