Recent

Author Topic: What is wrong with this code  (Read 2056 times)

Ten_Mile_Hike

  • Full Member
  • ***
  • Posts: 104
What is wrong with this code
« on: March 10, 2024, 11:03:28 pm »
Win 11  Lazarus 3.0

Why do I get only a single "chirp" with the code below???
I have tried adding a multitude of Sleep() and application.processmessages
throughout without any change in the chirp only outcome.


 
Code: Pascal  [Select][+][-]
  1. Procedure L();
  2. Begin
  3.   beep(1000,400);
  4.   end;
  5.  
  6. Procedure S();
  7. Begin
  8.    beep(1000,100);
  9.    end;
  10.  
  11. procedure morse(ch:char);
  12. begin
  13.   Case ch of
  14.   'A': Begin S;L;     End;
  15.   'B': Begin L;S;S;S; End;
  16.   'C': Begin L;S;L;S; End;
  17.   'D': Begin L;S;S;   End;
  18.   'E': Begin S;       End;
  19.   'F': Begin S;S;L;S; End;
  20.   'G': Begin L;L;S;   End;
  21.   'H': Begin S;S;S;S; End;
  22.   'I': Begin S;S;     End;
  23.   'J': Begin S;L;L;L; End;
  24.   'K': Begin L;S;L;   End;
  25.   'L': Begin S;L;S;S; End;
  26.   'M': Begin L;L;     End;
  27.   'N': Begin L;S;     End;
  28.   'O': Begin L;L;L;   End;
  29.   'P': Begin S;L;L;S; End;
  30.   'Q': Begin L;L;S;L; End;
  31.   'R': Begin S;L;S;   End;
  32.   'S': Begin S;S;S;   End;
  33.   'T': Begin L;       End;
  34.   'U': Begin S;S;L;   End;
  35.   'V': Begin S;S;S;L; End;
  36.   'W': Begin S;L;L;   End;
  37.   'X': Begin L;S;S;L; End;
  38.   'Y': Begin L;S;L;L; End;
  39.   'Z': Begin L;L;S;S; End;
  40.   end;
  41. end;
  42.  
  43. procedure TF1.Button1Click(Sender: TObject);
  44. var x:integer;
  45. Begin
  46.   For x:= 1 to Length(Edit1.Text) Do Morse(Edit1.text[x]);
  47. end;
  48. end.                                              
« Last Edit: March 10, 2024, 11:05:53 pm by Ten_Mile_Hike »
When any government, or any church for that matter, undertakes to say to its subjects, This you may not read, this you
must not see, this you are forbidden to know, the end result is tyranny and oppression no matter how holy the motives.

Robert A. Heinlein

RayoGlauco

  • Full Member
  • ***
  • Posts: 197
  • Beers: 1567
Re: What is wrong with this code
« Reply #1 on: March 10, 2024, 11:17:07 pm »
This code works ok for me:

Code: Pascal  [Select][+][-]
  1. program Project1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   {$IFDEF UNIX}
  7.   cthreads,
  8.   {$ENDIF}
  9.   Classes
  10.   ,sysutils
  11.   ,windows
  12.   { you can add units after this };
  13.  
  14. Procedure L();
  15. Begin
  16.   windows.beep(1000,400);
  17.   sysutils.sleep(100);
  18.   end;
  19.  
  20. Procedure S();
  21. Begin
  22.    windows.beep(1000,100);
  23.    sysutils.sleep(100);
  24. end;
  25.  
  26. procedure morse(ch:char);
  27. begin
  28.   Case ch of
  29.   'A': Begin S;L;     End;
  30.   'B': Begin L;S;S;S; End;
  31.   'C': Begin L;S;L;S; End;
  32.   'D': Begin L;S;S;   End;
  33.   'E': Begin S;       End;
  34.   'F': Begin S;S;L;S; End;
  35.   'G': Begin L;L;S;   End;
  36.   'H': Begin S;S;S;S; End;
  37.   'I': Begin S;S;     End;
  38.   'J': Begin S;L;L;L; End;
  39.   'K': Begin L;S;L;   End;
  40.   'L': Begin S;L;S;S; End;
  41.   'M': Begin L;L;     End;
  42.   'N': Begin L;S;     End;
  43.   'O': Begin L;L;L;   End;
  44.   'P': Begin S;L;L;S; End;
  45.   'Q': Begin L;L;S;L; End;
  46.   'R': Begin S;L;S;   End;
  47.   'S': Begin S;S;S;   End;
  48.   'T': Begin L;       End;
  49.   'U': Begin S;S;L;   End;
  50.   'V': Begin S;S;S;L; End;
  51.   'W': Begin S;L;L;   End;
  52.   'X': Begin L;S;S;L; End;
  53.   'Y': Begin L;S;L;L; End;
  54.   'Z': Begin L;L;S;S; End;
  55.   end;
  56. end;
  57.  
  58. var x:integer;
  59. Begin
  60.   For x:= 1 to Length('HOLA KE ASE GUAPO') Do Morse('HOLA KE ASE GUAPO'[x]);
  61. end.
  62.  
To err is human, but to really mess things up, you need a computer.

Thaddy

  • Hero Member
  • *****
  • Posts: 16994
  • Ceterum censeo Trump esse delendam
Re: What is wrong with this code
« Reply #2 on: March 11, 2024, 11:27:37 am »
You only have to use sysutils.beep. This also works on many unixes, but e.g. KDE plays dirty. Works for Ubuntu and windows and Debian.
Code: Pascal  [Select][+][-]
  1. program morsetest;
  2. {$mode objfpc}{$H-}
  3. uses windows;
  4.  
  5. Procedure L();
  6. Begin
  7.   beep(1000,400);
  8.   end;
  9.  
  10. Procedure S();
  11. Begin
  12.    beep(1000,100);
  13.    end;
  14.  
  15. procedure morse(const ch:char);
  16. begin
  17.   Case upcase(ch)of
  18.   'A': Begin S;L;     End;
  19.   'B': Begin L;S;S;S; End;
  20.   'C': Begin L;S;L;S; End;
  21.   'D': Begin L;S;S;   End;
  22.   'E': Begin S;       End;
  23.   'F': Begin S;S;L;S; End;
  24.   'G': Begin L;L;S;   End;
  25.   'H': Begin S;S;S;S; End;
  26.   'I': Begin S;S;     End;
  27.   'J': Begin S;L;L;L; End;
  28.   'K': Begin L;S;L;   End;
  29.   'L': Begin S;L;S;S; End;
  30.   'M': Begin L;L;     End;
  31.   'N': Begin L;S;     End;
  32.   'O': Begin L;L;L;   End;
  33.   'P': Begin S;L;L;S; End;
  34.   'Q': Begin L;L;S;L; End;
  35.   'R': Begin S;L;S;   End;
  36.   'S': Begin S;S;S;   End;
  37.   'T': Begin L;       End;
  38.   'U': Begin S;S;L;   End;
  39.   'V': Begin S;S;S;L; End;
  40.   'W': Begin S;L;L;   End;
  41.   'X': Begin L;S;S;L; End;
  42.   'Y': Begin L;S;L;L; End;
  43.   'Z': Begin L;L;S;S; End;
  44.   else
  45.     sleep(200)
  46.   end;
  47. end;
  48.  
  49. var
  50.   x:integer;
  51.   ss:string ='I am in distress';
  52. Begin
  53.   For x := 1 to length(ss) do Morse(ss[x]);
  54.   readln;
  55. end.
« Last Edit: March 11, 2024, 12:02:26 pm by Thaddy »
Due to censorship, I changed this to "Nelly the Elephant". Keeps the message clear.

Thaddy

  • Hero Member
  • *****
  • Posts: 16994
  • Ceterum censeo Trump esse delendam
Re: What is wrong with this code
« Reply #3 on: March 11, 2024, 08:15:39 pm »
@RayoGlauco
Don't edit your post after I gave an answer. Post your solution in a new post.
Due to censorship, I changed this to "Nelly the Elephant". Keeps the message clear.

RayoGlauco

  • Full Member
  • ***
  • Posts: 197
  • Beers: 1567
Re: What is wrong with this code
« Reply #4 on: March 11, 2024, 10:58:27 pm »
@Thaddy
I think I didn't edit my previous post. When a post is edited, this fact is displayed at the end of the message.
In any case, I think both your proposal and mine work as intended.

edit: edited just to check if edit time is shown
« Last Edit: March 11, 2024, 11:00:16 pm by RayoGlauco »
To err is human, but to really mess things up, you need a computer.

Ten_Mile_Hike

  • Full Member
  • ***
  • Posts: 104
Re: What is wrong with this code
« Reply #5 on: March 14, 2024, 07:35:32 pm »
I was unable to get the Beep command to play correctly CONSISTENTLY on this Core I3
laptop. Sometimes it worked perfectly, other times it did not. Often beeps would be dropped.
I can only GUESS that this was from conflict with other processes going on with my system
perhaps some kind of "Race Condition"? I am only a hobbyist programmer so all this is just
uneducated speculation. In any event I rewrote my code to use MMsystem and sndplaysound
using wav files that I created using "Audacity". Everything now works fine and the morse code
executes flawlessly every time. I can only guess that (at least on my laptop) sndplaysound
has a higher execution priority and more perfect timing then the beep command.

Thank You Everyone for your input

SNIPPET OF WORKING CODE

Procedure TForm1.Playit_Click(Sender: TObject);
var z:integer; s2:string;
Begin
   S2:=Edit1.text;
   For z:=1 to Length(S2) Do
  Begin
     Case S2[z] of
       '.': sndplaysound('.\dot.wav' ,snd_sync);
       '-': sndplaysound('.\dash.wav',snd_sync);
       Pause_Sound;
   end;
When any government, or any church for that matter, undertakes to say to its subjects, This you may not read, this you
must not see, this you are forbidden to know, the end result is tyranny and oppression no matter how holy the motives.

Robert A. Heinlein

 

TinyPortal © 2005-2018