[Ada 95] Czyszczenie bufora klawiatury

0

Witam ,
Mam nastepujacy problem z Adą. Nie moge wyczyścić bufora klawiatury. Mianowicie chce w petli pobierać string ja wystapia pewne ewentualnosci zglosic wyjatek obsluzyc go i wrocic do petli ale Ada nie chce dobrze obsluzyc wyjatku. Dla lepszegop zobrazowania problemu zmieszczam kod programu

with Ada.Text_Io, Ada.Strings.Unbounded.Text_Io, Ada.Characters.Handling; 
use Ada.Text_Io, Ada.Strings.Unbounded, Ada.Strings.Unbounded.Text_Io, Ada.Characters.Handling;

procedure Palindromy is 
   Slowo                                : Unbounded_String;  
   Liczba_znakow                        : Natural;  
   Jest_Palindromem1, Jest_Palindromem2 : Boolean := True;
   koniec                               : Boolean := False;
   JEDEN_ZNAK: exception;   
   ZERO_ZNAKOW: exception;
   ZlY_ZNAK: exception;
   SAME_LICZBY: exception;

   function Is_Numeric(slowo: in Unbounded_String; liczba_znakow: in Natural) return Boolean is
   wynik: Boolean;
   begin 
      for j in 1 .. liczba_znakow loop
         if not Is_Digit(Element(slowo,j)) then  
            wynik := False;
            exit;
         end if;
         wynik := True;
      end loop;
     return wynik;    
   end Is_Numeric;
     
   procedure Koniec_prog(koniec: out Boolean) is
      odp : Character;
      begin
         New_line;
         Put(Item => "(K)ontynuuj lub (Z)akoncz: ");
         Get_Immediate(odp);
         New_line(1);           
      case odp is
         when 'K'|'k' => Koniec:=False;
         when 'Z'|'z' => Koniec:=True;   
         when others => Koniec_prog(koniec);
      end case;
   end koniec_prog;

   procedure Pobierz_Palindrom(Slowo: in out Unbounded_String; Liczba_Znakow: out Natural) is
   begin  
      Put("Podaj slowo do sprawdzenia:  ");
      slowo := Get_Line;
      Liczba_Znakow := Length(Slowo);
      New_Line(1); 
         if liczba_znakow = 1 Then 
            raise JEDEN_ZNAK;
         elsif liczba_znakow = 0 then
            raise Zero_Znakow;   
         else
           If not Is_Numeric(slowo, liczba_znakow) Then 
               For i in 1 .. liczba_znakow loop
                   if not Is_letter(Element(slowo, i)) then
                      raise ZLY_ZNAK;
                   end if;
               end loop;        
           else
             raise SAME_LICZBY;  
           end if; 
         end if;
   end pobierz_palindrom;
   
   procedure z_male_duze(slowo: in Unbounded_String; liczba_znakow: in Natural) is
   begin   
      New_Line(1);
      Put_Line("Sprawdzanie z uwzglednieniem malych i duzych liter");
      
      Jest_Palindromem1 := True;

      for i in Integer range 1..(liczba_znakow / 2) loop 
         if Element(slowo, i) = Element(slowo, (liczba_znakow - i + 1)) then  
            put_Line( "Literka '" & Element(slowo, i) & "' to jest ta sama literka co '"
            & Element(Slowo, (Liczba_Znakow - I + 1)) & "'");     
         else                                             
            Put_Line("Literka '"& Element(slowo, i) & "' to nie jest ta sama literka co '"
               & Element(slowo, (liczba_znakow - i + 1)) & "'");
            Jest_Palindromem1 := False;
         end if;
      end loop;
   end z_male_duze;

   procedure bez_male_duze(slowo: in Unbounded_String; liczba_znakow: in Natural) is
   begin 
      New_Line(2);
      Put_Line("Sprawdzanie bez uwzglednienia malych i duzych liter");
      
      Jest_Palindromem2 := True; 

      for i in Integer range 1..(liczba_znakow / 2) loop
         if abs(Character'Pos(Element(slowo, i)) - Character'Pos(Element(slowo, (liczba_znakow - i + 1)))) = 0
               or abs(Character'Pos(Element(slowo, i)) - Character'Pos(Element(slowo, (liczba_znakow - i + 1)))) = 32 then
            Put_Line("Literka '" & Element(slowo, i) & "' jest ta sama literka co '"
            & Element(Slowo, (Liczba_Znakow - I + 1)) & "'");     
         else
            Put_Line("Literka '" & Element(slowo, i) & "' nie jest ta sama literka co '"
               & Element(slowo, (liczba_znakow - i + 1)) & "'");
            Jest_Palindromem2 := False;
         end if;
      end loop;
   end bez_male_duze;
   
   procedure dodatkowe_info(slowo: in Unbounded_String; liczba_znakow: in Natural) is
   begin 
      New_Line(2);
      if (liczba_znakow/2)*2 /= liczba_znakow then
         put_Line("To slowo ma nieparzysta ilosc liter.: " & Natural'Image(liczba_znakow)); 
         put_line("Dlatego tez literka, ktora jest w srodku tj '"
         & Element(slowo, ((liczba_znakow/ 2) + 1)) & "' nie ma do czego byc porownana.");
      else
         put_Line("To slowo ma parzysta ilosc liter.: " & Natural'Image(liczba_znakow)); 
      end if;
   end dodatkowe_info;
   
   procedure werdykt(jest_palindromem1, jest_palindromem2: in Boolean) is
   begin
      New_Line;
      if jest_palindromem1 = True then
         Put_Line("To slowo jest palindromem uwzgledniajac male i duze litery.");
      else
         Put_Line("To slowo nie jest palindromem przy uwzglednieniu badania malych i duzych liter.");
      end if;
      if Jest_Palindromem2 = True then
         Put_Line("To slowo jest palindromem nieuwzgledniajac wielkosci liter.");
      else
         Put_Line("To slowo nie jest palindromem bez uwzglednienia badania wielkosci liter.");
      end if;
   end werdykt;    
   
   procedure petla_programu is
   begin
      while koniec = False 
      loop 
         pobierz_palindrom(slowo, liczba_znakow);  
         z_male_duze(slowo, liczba_znakow);
         bez_male_duze(slowo, liczba_znakow);
         dodatkowe_info(slowo, liczba_znakow);
         werdykt(jest_palindromem1, jest_palindromem2); 
         koniec_prog(koniec);
      end loop;
   end Petla_Programu;

begin
   Petla_Programu;
   
   exception
      when JEDEN_ZNAK => 
         New_Line(2);      
         Put("UWAGA BLAD!: Podales tylko jeden znak!");
         new_Line(2);
         Petla_Programu;
      when ZERO_ZNAKOW =>
         New_Line(2);      
         Put("UWAGA BLAD!: Nie podales zadnego znaku!");
         New_line(2);
         Petla_Programu;
      when ZlY_ZNAK =>
         New_Line(2);      
         Put("UWAGA BLAD!: Podales zly znak, prawdopodobnie liczbe lub znak specjalny!");
         New_line(2);
         Petla_Programu;
      when SAME_LICZBY =>
         New_Line(2);      
         Put("UWAGA BLAD!: Podales same liczby a to mialo byc slowo!");
         New_line(2);
         Petla_Programu;
      when others =>
         New_Line(2);      
         Put("Nie okreslony blad!");
         New_line(2);
         Petla_Programu;

end Palindromy;

Ogolnie dwa razy wywolujac blad nie mozna doczekac sie obslugi drugie razu ;-(

Pozdrawiam
Andrzej

0

Matko święta, ty weź może przeczytaj jeszcze raz tutoriala, twój kod jest oględnie mówiąc do d**y. Nie wiem też co ma to wspólnego z buforem klawiatury.
Powinno to wyglądać tak: (pomijając paskudny styl, tego poprawiać nie będę)


```delphi
with Ada.Text_Io, Ada.Strings.Unbounded.Text_Io, Ada.Characters.Handling;
use Ada.Text_Io, Ada.Strings.Unbounded, Ada.Strings.Unbounded.Text_Io, Ada.Characters.Handling;

procedure Palindromy is
   Slowo                                : Unbounded_String;  
   Liczba_znakow                        : Natural;  
   Jest_Palindromem1, Jest_Palindromem2 : Boolean := True;
   koniec                               : Boolean := False;
   JEDEN_ZNAK: exception;  
   ZERO_ZNAKOW: exception;
   ZlY_ZNAK: exception;
   SAME_LICZBY: exception;

   function Is_Numeric(slowo: in Unbounded_String; liczba_znakow: in Natural) return Boolean is
   wynik: Boolean;
   begin
      for j in 1 .. liczba_znakow loop
         if not Is_Digit(Element(slowo,j)) then  
            wynik := False;
            exit;
         end if;
         wynik := True;
      end loop;
     return wynik;    
   end Is_Numeric;
    
   procedure Koniec_prog(koniec: out Boolean) is
      odp : Character;
      begin
         New_line;
         Put(Item => "(K)ontynuuj lub (Z)akoncz: ");
         Get_Immediate(odp);
         New_line(1);          
      case odp is
         when 'K'|'k' => Koniec:=False;
         when 'Z'|'z' => Koniec:=True;  
         when others => Koniec_prog(koniec);
      end case;
   end koniec_prog;

   procedure Pobierz_Palindrom(Slowo: in out Unbounded_String; Liczba_Znakow: out Natural) is
   begin  
      Put("Podaj slowo do sprawdzenia:  ");
      slowo := Get_Line;
      Liczba_Znakow := Length(Slowo);
      New_Line(1);
         if liczba_znakow = 1 Then
            raise JEDEN_ZNAK;
         elsif liczba_znakow = 0 then
            raise Zero_Znakow;  
         else
           If not Is_Numeric(slowo, liczba_znakow) Then
               For i in 1 .. liczba_znakow loop
                   if not Is_letter(Element(slowo, i)) then
                      raise ZLY_ZNAK;
                   end if;
               end loop;        
           else
             raise SAME_LICZBY;  
           end if;
         end if;
   end pobierz_palindrom;
  
   procedure z_male_duze(slowo: in Unbounded_String; liczba_znakow: in Natural) is
   begin  
      New_Line(1);
      Put_Line("Sprawdzanie z uwzglednieniem malych i duzych liter");
      
      Jest_Palindromem1 := True;

      for i in Integer range 1..(liczba_znakow / 2) loop
         if Element(slowo, i) = Element(slowo, (liczba_znakow - i + 1)) then  
            put_Line( "Literka '" & Element(slowo, i) & "' to jest ta sama literka co '"
            & Element(Slowo, (Liczba_Znakow - I + 1)) & "'");    
         else                                            
            Put_Line("Literka '"& Element(slowo, i) & "' to nie jest ta sama literka co '"
               & Element(slowo, (liczba_znakow - i + 1)) & "'");
            Jest_Palindromem1 := False;
         end if;
      end loop;
   end z_male_duze;

   procedure bez_male_duze(slowo: in Unbounded_String; liczba_znakow: in Natural) is
   begin
      New_Line(2);
      Put_Line("Sprawdzanie bez uwzglednienia malych i duzych liter");
      
      Jest_Palindromem2 := True;

      for i in Integer range 1..(liczba_znakow / 2) loop
         if abs(Character'Pos(Element(slowo, i)) - Character'Pos(Element(slowo, (liczba_znakow - i + 1)))) = 0
               or abs(Character'Pos(Element(slowo, i)) - Character'Pos(Element(slowo, (liczba_znakow - i + 1)))) = 32 then
            Put_Line("Literka '" & Element(slowo, i) & "' jest ta sama literka co '"
            & Element(Slowo, (Liczba_Znakow - I + 1)) & "'");    
         else
            Put_Line("Literka '" & Element(slowo, i) & "' nie jest ta sama literka co '"
               & Element(slowo, (liczba_znakow - i + 1)) & "'");
            Jest_Palindromem2 := False;
         end if;
      end loop;
   end bez_male_duze;
  
   procedure dodatkowe_info(slowo: in Unbounded_String; liczba_znakow: in Natural) is
   begin
      New_Line(2);
      if (liczba_znakow/2)*2 /= liczba_znakow then
         put_Line("To slowo ma nieparzysta ilosc liter.: " & Natural'Image(liczba_znakow));
         put_line("Dlatego tez literka, ktora jest w srodku tj '"
         & Element(slowo, ((liczba_znakow/ 2) + 1)) & "' nie ma do czego byc porownana.");
      else
         put_Line("To slowo ma parzysta ilosc liter.: " & Natural'Image(liczba_znakow));
      end if;
   end dodatkowe_info;
  
   procedure werdykt(jest_palindromem1, jest_palindromem2: in Boolean) is
   begin
      New_Line;
      if jest_palindromem1 = True then
         Put_Line("To slowo jest palindromem uwzgledniajac male i duze litery.");
      else
         Put_Line("To slowo nie jest palindromem przy uwzglednieniu badania malych i duzych liter.");
      end if;
      if Jest_Palindromem2 = True then
         Put_Line("To slowo jest palindromem nieuwzgledniajac wielkosci liter.");
      else
         Put_Line("To slowo nie jest palindromem bez uwzglednienia badania wielkosci liter.");
      end if;
   end werdykt;    
  
   procedure petla_programu is
   begin
      while koniec = False
      loop
         begin
            pobierz_palindrom(slowo, liczba_znakow);  
            z_male_duze(slowo, liczba_znakow);
            bez_male_duze(slowo, liczba_znakow);
            dodatkowe_info(slowo, liczba_znakow);
            werdykt(jest_palindromem1, jest_palindromem2);
            koniec_prog(koniec);
         exception
   		   when JEDEN_ZNAK =>
   		      New_Line(2);      
	   	      Put("UWAGA BLAD!: Podales tylko jeden znak!");
         		new_Line(2);
   		   when ZERO_ZNAKOW =>
		         New_Line(2);      
      	   	Put("UWAGA BLAD!: Nie podales zadnego znaku!");
      		   New_line(2);
		      when ZlY_ZNAK =>
   		      New_Line(2);      
	   	      Put("UWAGA BLAD!: Podales zly znak, prawdopodobnie liczbe lub znak specjalny!");
         		New_line(2);
	   	   when SAME_LICZBY =>
		         New_Line(2);      
      	   	Put("UWAGA BLAD!: Podales same liczby a to mialo byc slowo!");
      		   New_line(2);
		      when others =>
   		      New_Line(2);      
	   	      Put("Nie okreslony blad!");
   	   	   New_line(2);
          end;
      end loop;
   end Petla_Programu;

begin
   Petla_Programu;
end Palindromy;

0

Witam,
Dziękuję za odpowiedź wszystko działało. Co do konstruktywnej krytyki przyjmuje ja z godnością i proszę może o kilka wskazówek jak powinienem prowadzić swój kod w Ada 95?
Jeszcze raz dziękuję za pomoc
Pozdrawiam
Andrzej

0

Proponuję uważać co się wrzuca do exception handlerów - one nie służą do robienia obliczeń tylko do obsługi błedu i nie wracają tam gdzie wystąpił błąd. Jeśli chcesz złapać błąd wewnątrz pętli to dajesz w środku handler przy pomocy bloku begin...exception...end. Nie ma obaw jeśli chodzi o szybkość ponieważ nowe wersje GNATa używają "zero cost exception mechanisms" które nie opierają się na setjmp/longjmp jak w G++ i nie jest wywoływane kosztowne zapamiętanie miejsca skoku za każdym wejściem w obszar chroniony. Nie ma sensu używać typu Unbounded_String tam gdzie jest niepotrzebny. Zmienne tego typu są mało wydajne, ponieważ jest to typ kontrolowany i dokonuje realokacji przy przypisaniach. Nic nie stoi na przeszkodzie żeby jako parametr podać String o niezdefiniowanym rozmiarze np. procedure A ( S: in String );. Unbounded_String jest potrzebne naprawdę tylko wtedy gdy chcemy mieć tablicę lub rekord zawierający stringi. Jeśli chodzi o styl to konwencja mówi, że w Adzie identyfikatory piszemy zaczynając od wielkiej litery, a już na pewno za każdym razem tak samo, po i/lub przed nawiasami powinny być przerwy. Identyfikatory po polsku to inna bajka :P Czepiam się ale skoro już Ada to warto dbać o styl.

0

Może trochę stary temat ale tak mi się przypomniało, gdyby ktoś jeszcze miał problemy z pisaniem poprawnego pod względem stylistycznym kodu w Adzie:
http://www.iste.uni-stuttgart.de/ps/ada-doc/style_guide/contents.html

Przede wszystkim: nie zmieniajcie swojego stylu co kilka linii, utrzymujcie ten sam styl w całym pliku, albo lepiej - w projekcie. Albo jeszcze lepiej - zawsze.

W najbardziej streszczonej formie jaką udało mi się wymyślić: piszcie z zachowaniem takich zasad, jak przy normalnym pisaniu (np. wypracowania), z małymi wyjątkami, czyli:

  1. Z zachowaniem odstępów przed i po operatorach, po przecinkach, przed nawiasami etc.
  2. Pisząc nazwy pełnymi słowami, w razie pot<ort>żeby</ort> oddzielając słowa podkreślnikiem ('_'); nazwy powinny dawać jak najwięcej informacji o zmiennej/procedurze/funkcji itp. przy jak najmniejszej długości
  3. Najlepiej nazywać wszystko po angielsku, wtedy nie kłóci się to tak ze słowami kluczowymi języka
  4. Gdyby ktoś nie wiedział, robiąc oczywiście wcięcia ukazujące zagnieżdżenie bloków kodu

Przykład:

Default_String : constant String :=
      "This is the long string returned by" &
      " default. It is broken into multiple" &
      " Ada source lines for convenience.";
type Signed_Whole_16 is range -2**15 .. 2**15 - 1;
type Address_Area  is array (Natural range <>) of Signed_Whole_16;

Register : Address_Area (16#7FF0# .. 16#7FFF#);
Memory   : Address_Area (       0 .. 16#7FEC#);

Register(Pc) := Register(A);

X := Signed_Whole_16(Radius * Sin(Angle));

Register(Index) := Memory(Base_Address + Index * Element_Length);

Get(Value => Sensor);

Error_Term := 1.0 - (Cos(Theta)**2 + Sin(Theta)**2);

Z      := X**3;
Y      := C * X + B;
Volume := Length * Width * Height;

albo:

    with Basic_Types;

    package body SPC_Numeric_Types is

       function Max
             (Left  : in     Basic_Types.Tiny_Integer;
              Right : in     Basic_Types.Tiny_Integer)
             return Basic_Types.Tiny_Integer is
       begin
          if Right < Left then
             return Left;
          else
             return Right;
          end if;
       end Max;

       function Min
             (Left  : in     Basic_Types.Tiny_Integer;
              Right : in     Basic_Types.Tiny_Integer)
             return Basic_Types.Tiny_Integer is
       begin
          if Left < Right then
             return Left;
          else
             return Right;
          end if;
       end Min;

       use Basic_Types;

    begin  -- SPC_Numeric_Types
       Max_Tiny_Integer := Min (System_Max, Local_Max);
       Min_Tiny_Integer := Max (System_Min, Local_Min);
       -- ...
    end SPC_Numeric_Types;

(przykłady pochodzą z http://www.iste.uni-stuttgart.de/ps/ada-doc/style_guide/sec_2.html, zostały tylko lekko zmodyfikowane by lepiej odpowiadały mojemu gustowi ;))

1 użytkowników online, w tym zalogowanych: 0, gości: 1