Program Morsen;
{* Programm:   Morsen  TPascal 7.0                            *}
{* Version:    V0.0                                           *}
{* Datum:      Okt. 2001                                      *}
{* Web.:       www.clinch.ch/clinch/Morsen/Morsen.htm         *}
{* Autor:      Manuel Magnin                                  *}
{* Dateien:    Morsen.exe, Morsen.pas, Morsen.lst, Morsen.txt *}

Uses DOS,CRT;

Var MorsenLst : Array[0..99] of String[12];
    FP        : Text;
    FPEchoFile: Text;
    ST100     : String[100];
    ZeichenNr : Word;
    Ch        : Char;
    Speed     : Word;
    Echo      : Boolean;
    SoundOn   : Boolean;
    EchoFile  : Boolean;

Procedure Delay(T:Word);
{ Delay(milisec); vom Pascal L„uft nicht auf allen PC's !! 1/18-Timer }
Var H,M,S,SS : Word;
    Ti       : LongInt;
Begin;
    {Delay(T);             **** L„uft licht auf allen PC's !! 1/18-Timer }
    GetTime(H,M,S,SS);
    Ti := SS + S*100 + M*6000 + H*360000 + Round(T/10);  { End Wert }
    Repeat;
      GetTime(H,M,S,SS);
    Until Ti<=SS+S*100+M*6000+H*360000;
End;

Procedure Ausgabe(Ch:Char);
{ Ausgabe Ton Ch: "." oder "-" }
Begin;
  If Echo Then Begin;
    If Ch='.' Then Write('.');   { Zuerst Zeichen ausgeben, dann Sound }
    If Ch='-' Then Write('-');
    If Ch='Z' Then Write(' ');
    If Ch='W' Then Write('  ');
  End;
  If EchoFile Then Begin;
    If Ch='.' Then Write(FPEchoFile,'.');   { Zuerst Zeichen ausgeben, dann Sound }
    If Ch='-' Then Write(FPEchoFile,'-');
    If Ch='Z' Then Write(FPEchoFile,' ');
    If Ch='W' Then Write(FPEchoFile,'  ');
  End;
  If SoundOn Then Begin;
    If Ch='.' Then Begin;
      Sound(440);
      Delay(Speed);
      noSound;
      Delay(Speed);
    End;
    If Ch='-' Then Begin;
      Sound(440);
      Delay(3*Speed);
      noSound;
      Delay(Speed);
    End;
    If Ch='Z' Then Begin;               { weitere 100mS sind bereits am Zeichen }
      Delay(2*Speed);
    End;
    If Ch='W' Then Begin;               { weitere 100mS sind bereits am Zeichen }
      Delay(6*Speed);
    End;
  End;
End;

Procedure Compile(St:String);
Var I,II,Po : Integer;                  { Int anst. Word wegen Ende Merker }
    Zei     : String[1];
    St250   : String[250];
Begin;
  For Po:=1 to Length(St) Do Begin;
    Zei := UpCase(St[Po]);
    I:=0;
    Repeat;
      If Zei+'#'=copy(MorsenLst[I],1,2) Then Begin;
        St250 := copy(MorsenLst[I],Pos('#',MorsenLst[I])+1,50)+'Z';
        For II:=1 to Length(St250) Do Begin;
          Ausgabe(St250[II]);
        End;
        I:=-1;                          { Ende Merker }
      End;
      Inc(I);
    Until (MorsenLST[I]='ENDE') Or (I=0);
    If Zei=' ' Then Ausgabe('W');       { Leerzeichen gleich Wort Ende }
  End;
  Ausgabe('W');                         { Satzende sicher auch Wort Ende }
  If Echo and (Po>1) Then WriteLn;      { Po=1 f�r ein Zeichen Handbetrieb }
End;

Begin;
  WriteLn('Morsen V0.0 Programm  Info@Clinch.ch www.clinch.ch/clinch/morsen/morsen.htm');
  {$I-}                                 { Datei Fehler Kontrolle abschalten }
  Assign(FP,'Morsen.lst');
  Reset(FP);
  {$I+}
  If IOResult <> 0 Then Begin;          { Morsen.lst nicht vorhanden }
    WriteLn('Datei Morsen.lst nicht gefunden');
    Halt(IOResult);
  End;
  Echo      := True;                    { Echo auf dem Bildschirm }
  SoundOn   := True;                    { Sound via Speaker }
  EchoFile  := False;                   { Keine ausgabe in Datei }
  Speed     := 100;                     { 100mSek f�r einen Punkt }
  ZeichenNr := 0;                       { Liste der Zeichen enlesen }
  Repeat;                               { Morse Liste einlesen }
    ReadLn(FP,ST100);
    MorsenLst[ZeichenNr]:=St100;
    Inc(ZeichenNr);
  Until EOF(FP);
  Close(FP);
  MorsenLst[ZeichenNr]:='ENDE';         { Ende definieren }
  If ParamCount=0 Then Begin;
    WriteLn('Aufruf: Morsen DateiName [NameAusgabeDatei]');
    WriteLn('oder:   Morsen KEY      (Eingabe via Tastatur)');
    WriteLn('oder:   Morsen KEY [NameAusgabeDatei]  ( " " )');
    WriteLn('Speed:  Ein Punkt dauert: ',Speed,'mSek.');
    WriteLn;
    WriteLn('Kleines Testprogramm zum Morsen f�r alle die es brauchen k”nnen');
    WriteLn('Dieses Programm ist Open Source und f�r alle zur freien Verwendung');
    WriteLn('Info und Anregungen: Info@Clinch.ch');
    WriteLn;
    Halt(20);
  End;
  If ParamCount=2 Then Begin;           { Ausgabe in Datei }
    Echo     := True;
    EchoFile := True;
    SoundOn  := False;
    {$I-} Assign(FPEchoFile,ParamStr(2)); {$I+}  { Datei Fehler Kontrolle abschalten }
    ReWrite(FPEchoFile);
  End;
  If ((ParamStr(1)<>'KEY') And (ParamStr(1)<>'key')) Then Begin;
    {$I-} Assign(FP,ParamStr(1)); Reset(FP); {$I+}  { Datei Fehler Kontrolle abschalten }
    If IOResult <> 0 Then Begin;
      WriteLn('Datei: ',ParamStr(1),' nicht gefunden');
      Halt(IOResult);
    End;
    Repeat;                             { Text einlesen }
      ReadLn(FP,ST100);
      Compile(St100);
    Until EOF(FP);
    Close(FP);
  End Else Begin;                       { Text von Keyboard }
    Repeat;
      Repeat;
      Until KeyPressed;
      Ch := ReadKey;
      Compile(Ch);
    Until Ch=Chr(13);
  End;
  WriteLn('ENDE');
  If ParamCount=2 Then Begin;           { Ausgabe in Datei }
    Close(FPEchoFile);
  End;
End.