[Lazarus(freepascal),linux] Přerušení nekonečného vyklu

C++, C#, Visual Basic, Delphi, Perl a ostatní

Moderátor: Moderátoři Živě.cz

Odeslat příspěvekod marun1 29. 12. 2012 13:37

Dobrý den

mám program s GUI a chci aby mi program po kliknutí na tlačítko stále dokola prováděl určitou věc dokud bych mu meřěkl aby sončil ale nevím jak něco takového udělat

a jěště jsem si všiml že GUI překreslí až skončí celá událost nešlo by nějak aby to vykreslovalo i v průběhu?
marun1
Junior

Odeslat příspěvekod PiranhaGreg 29. 12. 2012 21:57

Nevím jak na lazarusu, ale u ostatních jazyků můžeš každý cyklus kontrolovat jestli nějaká vnější proměnná je true a když jí změníš na false, cyklus se přeruší. V C# například můžeš kdykoliv přepnout proměnou ok z true na false a cyklus se přeruší

Kód: Vybrat vše
bool ok = true;

while(ok)
{
// vnitřek cyklu
}


Už ne u všech jazyků můžeš použít metodu, že si vytvoříš nové vlákno, na kterém spustíš cyklus a v příhodný okamžik ho ukončíš.
PiranhaGreg
Mírně pokročilý
Uživatelský avatar

Odeslat příspěvekod JanFiala 29. 12. 2012 22:04

Pokud chces, aby reagovalo GUI v prubehu cyklu, musis zpracovavat zpravy.
To znamena vynucene volat zpracovani zprav, pak si muzes reagovat treba na stisknuti tlacitka.

V cyklu zavolej (obcas, napr. kazdou 1000-ci iteraci)
Kód: Vybrat vše
Application.ProcessMessages
Co můžeš udělat dnes, odlož na včerejšek
JanFiala
Expert
Uživatelský avatar

Odeslat příspěvekod marun1 30. 12. 2012 09:04

Problém je totiž v tom že ten cyklus je v události po kliknutí na tlačítko (nevím kam jinam bych ho dal) a dokud běží tak aplikace nereaguje
možná by pomohlo udělat nějakou "nadřazenou" událost která změní hodnotu té kontrolní proměnné

ten Application.ProcessMessages vyzkouším

a taky sem zapoměl napsat že ten linux běží na 700MHz ARM
marun1
Junior

Odeslat příspěvekod hnusak 30. 12. 2012 09:29

nauč se vlákna, application.processmessages je slepá ulička, se kterou budeš mít spoustu problémů.
hnusak
Junior

Odeslat příspěvekod marun1 31. 12. 2012 11:42

application.processmessages funguje tak jak sem si představoval ale prořád sem nevyřešil tu smyčku

potřebuju to co nejvíce optimalizovat pro rychlost

tady je zdroják abyste měli představu jak to vypadá označil sem tam místo kde má být ta smyčka
Kód: Vybrat vše
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, ActnList, hwiringpi;

type
  zaznam = record
    cas,ad:integer;
    ch:real;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    CheckGroup1: TCheckGroup;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Memo1: TMemo;
    d011: TRadioButton;
    d1010: TRadioButton;
    d10200: TRadioButton;
    RadioGroup1: TRadioGroup;
    uloz: TSaveDialog;
    se2: TCheckBox;
    se3: TCheckBox;
    se4: TCheckBox;
    se5: TCheckBox;
    Preddelicka: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  admux,adcsra,pkan,prac,i,a:integer;
  adc,fd:integer;
  ad:array [0..6] of boolean;
  b: array [0..6] of byte;
  c: array [0..3] of integer;
  osc:zaznam;
  z,x:file of zaznam;
  uvst:real;

implementation

procedure posli(pr:byte;reg:byte);
begin
  pr:=64 or pr;
  repeat
    serialflush(fd);
    serialputchar(fd,chr(pr));
    a:=serialgetchar(fd);
  until a=6;
  repeat
    serialflush(fd);
    serialputchar(fd,chr(reg));
    a:=serialgetchar(fd);
  until a=6;

end;



{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  adcsra:=0;
  pkan:=0;
  prac:=0;
  ad[0]:=se2.checked;
  ad[1]:=se3.checked;
  ad[2]:=se4.checked;
  ad[3]:=se5.checked;
  ad[4]:=d011.checked;
  ad[5]:=d1010.checked;
  ad[6]:=d10200.checked;
  if preddelicka.itemindex=0 then adcsra:=6;
  if preddelicka.itemindex=1 then adcsra:=7;
  posli(0,adcsra);
  memo1.lines.add(timetostr(now)+' nastavuju předděličku na '+inttostr(adcsra));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin                              //odtud-------------------------------
  for i:=0 to 3 do
  begin
    if ad[i] then
    begin
      admux:=b[i];
      posli(1,admux);
      posli(2,0);
      c[0]:=serialgetchar(fd);
      c[1]:=serialgetchar(fd);
      c[2]:=serialgetchar(fd);
      c[3]:=serialgetchar(fd);
      c[2]:=c[2]+(c[3]*256);
      uvst:=(5*c[2])/1024;
      c[1]:=c[1] and 31;
      if c[1]=b[0] then label1.caption:=floattostr(uvst);
      if c[1]=b[1] then label2.caption:=floattostr(uvst);
      if c[1]=b[2] then label3.caption:=floattostr(uvst);
      if c[1]=b[3] then label4.caption:=floattostr(uvst);
      application.processmessages;
    end;
  end;
end;               //po sem to potřebuju ve smyčce---------------------------

procedure TForm1.Button3Click(Sender: TObject);
begin
  if uloz.Execute then
  begin
    assignfile(x,uloz.filename);
    rewrite(x);
    seek(z,0);
    seek(x,0);
    while not eof(z) do
    begin
      read(z,osc);
      write(x,osc);
    end;
    closefile(x);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fd:=serialopen('/dev/ttyAMA0',2400);
  if fd=-1 then memo1.lines.add(timetostr(now)+' chyba otevírání UART')
  else memo1.lines.add(timetostr(now)+' UART otevřen');
  b[0]:=2;
  b[1]:=3;
  b[2]:=4;
  b[3]:=5;
  b[4]:=16;
  b[5]:=9;
  b[6]:=11;
  assignfile(z,'zaznam.tmp');
  rewrite(z);
  memo1.lines.add(timetostr(now)+' Dočasný soubor vytvořen');
end;

end.


tady dávám celý projekt i s knihovnamu co sem si musel stáhnout
http://leteckaposta.cz/817891493
marun1
Junior

Odeslat příspěvekod JanFiala 3. 1. 2013 10:27

Optimalizovat na vykon? Jak rychle probehne ten cyklus se 3 iteracemi?
3x posles neco na seriovy port a cekas na odpoved.
Tam vcelku neni co optimalizovat, pokud je tam nejake zpozdeni, tak je to v komunikaci se seriovym portem. Nevim, s cim komunikujes, jak dlouho ta komunikace trva, jestli muzes ovlivnit komunikaci na druhe strane... Mozna by stacilo zvysit rychlost komunikace (bity/s)

Prenosem do vlakna bys ziskal pouze to, ze aplkikace by v okamziku komunikace standardne reagovala, ale vlastni komunikace by se tim nezrychlila.
Co můžeš udělat dnes, odlož na včerejšek
JanFiala
Expert
Uživatelský avatar

Odeslat příspěvekod marun1 3. 1. 2013 14:15

program je pro RaspberryPi a komunikuju přes UART s ATmega16 rychlost je prozatím nastavena na 2400 baudů protože při vyšší rychlosti už nejde předdělička nastavit tak přesně ale koupím si krystal a pak to rozjedu na co nejvyšší

ta komunikace trvá necelou vteřinu podle mě je pomalá komunikace s portem buď proto že nevím jak se komunikuje s portem tak jsem využil jednoho unitu který vkládá C program který byl přímo pro RPi určený nebo je to tak pomalé stále

ta smyčka vlastně čte hodnoty z ATmega16 a každou je potřeba vypsat zvlášť

tou optimalizací jsem myslel jestli nejde něco nějakýma vychytávkama zrychlit nebo co by se dalo napsat lépe

takže bez vlákna se u té nekonečné smyčky neobejdu? skusím se na to na internetu podívat ale z některých popisů sem toho moc nepochopil

edit: zkusil jsem si tu komunikaci "simulovat" přes minicon a tam to nevypadá že by ta komunikace přes ten port byla tak pomalá
marun1
Junior

Odeslat příspěvekod marun1 5. 1. 2013 19:56

skusil jsem použít jinou knihovnu pro komunikaci s portem ale mám takový zvláštní problém nečte to ty data v jednom případě správně (označil jsem to v kódě)

Kód: Vybrat vše
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, ActnList, synaser;

type
  zaznam = record
    cas,ad:integer;
    ch:real;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    CheckGroup1: TCheckGroup;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Memo1: TMemo;
    d011: TRadioButton;
    d1010: TRadioButton;
    d10200: TRadioButton;
    RadioGroup1: TRadioGroup;
    uloz: TSaveDialog;
    se2: TCheckBox;
    se3: TCheckBox;
    se4: TCheckBox;
    se5: TCheckBox;
    Preddelicka: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  admux,adcsra,pkan,prac,i:integer;
  adc,fd:integer;
  ad:array [0..6] of boolean;
  b: array [0..6] of byte;
  c: array [0..3] of integer;
  osc:zaznam;
  z,x:file of zaznam;
  uvst:real;
  ser:tblockserial;

implementation

procedure posli(pr:byte;reg:byte);
var
  a:integer;
begin
  pr:=64 or pr;
  repeat
    ser.purge;
    ser.SendByte(pr);
    a:=ser.RecvByte(10000);
  until a=6;
  repeat
    ser.purge;
    ser.SendByte(reg);
    a:=ser.RecvByte(10000);
  until a=6;

end;

function prijem:byte;  //tato fce to čte špatně---------------------------------------------
begin
prijem:=ser.recvbyte(10000);
end;


{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  adcsra:=0;
  pkan:=0;
  prac:=0;
  ad[0]:=se2.checked;
  ad[1]:=se3.checked;
  ad[2]:=se4.checked;
  ad[3]:=se5.checked;
  ad[4]:=d011.checked;
  ad[5]:=d1010.checked;
  ad[6]:=d10200.checked;
  if preddelicka.itemindex=0 then adcsra:=6;
  if preddelicka.itemindex=1 then adcsra:=7;
  posli(0,adcsra);
  memo1.lines.add(timetostr(now)+' nastavuju pĹ™eddÄ›liÄŤku na '+inttostr(adcsra));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  for i:=0 to 3 do
  begin
    if ad[i] then
    begin
      admux:=b[i];
      posli(1,admux);
      posli(2,0);
      c[0]:=prijem;
      memo1.lines.add(inttostr(c[0]));
      c[1]:=prijem;
      memo1.lines.add(inttostr(c[1]));
      c[2]:=prijem;
      memo1.lines.add(inttostr(c[2]));
      c[3]:=prijem;
      memo1.lines.add(inttostr(c[3]));
      c[2]:=c[2]+(c[3]*256);
      uvst:=(5*c[2])/1024;
      c[1]:=c[1] and 31;
      if c[1]=b[0] then label1.caption:=floattostr(uvst);
      if c[1]=b[1] then label2.caption:=floattostr(uvst);
      if c[1]=b[2] then label3.caption:=floattostr(uvst);
      if c[1]=b[3] then label4.caption:=floattostr(uvst);
      application.processmessages;
    end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if uloz.Execute then
  begin
    assignfile(x,uloz.filename);
    rewrite(x);
    seek(z,0);
    seek(x,0);
    while not eof(z) do
    begin
      read(z,osc);
      write(x,osc);
    end;
    closefile(x);
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  ser.free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ser:=tblockserial.create;
  ser.connect('/dev/ttyUSB0');
  ser.config(2400,8,'N',1,false,false);
  b[0]:=2;
  b[1]:=3;
  b[2]:=4;
  b[3]:=5;
  b[4]:=16;
  b[5]:=9;
  b[6]:=11;
  {assignfile(z,'zaznam.tmp');
  rewrite(z);
  memo1.lines.add(timetostr(now)+' DoÄŤasnĂ˝ soubor vytvoĹ™en');}
end;

end.


tuto knihovnu vkládám (ja tam toho víc ale toto je ta hlavní)
http://leteckaposta.cz/699359392

edit:

skusil jsem si to překompilovat na ubuntu na pc a komunikaci jsem skusil převodníkem do usb a tam to přes cutecom funguje pěkně (stejně jak na RPi) a ta aplikace taky přijímá blbiny a tak zamrzává už opravdu nevím kde je chyba
marun1
Junior

Odeslat příspěvekod JanFiala 6. 1. 2013 14:43

Tezko ti nekdo, kdo nema k dispozici zarizene, se kterym by komunikaci vyzkousel poradi, proc to "necte"
Co můžeš udělat dnes, odlož na včerejšek
JanFiala
Expert
Uživatelský avatar

Odeslat příspěvekod marun1 6. 1. 2013 14:47

chyba je 100%v programu protože přes cutecom to komunikuje normálně tak jsem myslel že by mi někdo řekl kde je ta chyba
marun1
Junior

Odeslat příspěvekod Vebloud 7. 1. 2013 14:19

Pak už jedině debugovat a podívat se na čem to mrzne. A pokud to při debugu chodí a přo ostrém čtení ne, tak potom logovat a z logu si zjistit na čem to padá.
Žít a nechat žít, ty máš svůj názor, já mám svůj názor, já ti nebudu nutit svůj, nemusím souhlasit s tvým, ale udělám vše, abys ho mohl svobodně vyjádřit.
Vebloud
VIP uživatel
Uživatelský avatar

Odeslat příspěvekod marun1 7. 1. 2013 17:43

já si to vždy spouštím v IDE abych mohl kdyby to zamrzlo to prostě zabít nikde se to nehroutí nebo tak
když to spustím normálně tak to dělá stejný problém
nevím jak se loguje v lazarusu
marun1
Junior

Odeslat příspěvekod Vebloud 8. 1. 2013 10:35

Asi stejně jako všude jinde prostě si do souboru zapisuješ kam jsi se dostal, co se stalo špatně apod.
Žít a nechat žít, ty máš svůj názor, já mám svůj názor, já ti nebudu nutit svůj, nemusím souhlasit s tvým, ale udělám vše, abys ho mohl svobodně vyjádřit.
Vebloud
VIP uživatel
Uživatelský avatar

Odeslat příspěvekod xixo 8. 1. 2013 10:46

Mimochodem, bez vlákna se to dá řešit vytvořením časovače, který periodicky vyvolává událost, a v její obsluze se data z portu přečtou.
xixo
Junior

Další stránka

Kdo je online

Uživatelé procházející toto fórum: Žádní registrovaní uživatelé a 0 návštevníků