home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 07 / astrodat / astrodem.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-06-10  |  6.1 KB  |  217 lines

  1. {--------------------------------------------------------------------}
  2. {               Testprogramm zum Modul ASTRODAT.PAS                  }
  3. {     demonstriert den Einsatz der in ASTRODAT.PAS vorhandenen       }
  4. {                    Funktionen und Prozeduren                       }
  5. {--------------------------------------------------------------------}
  6.  
  7. PROGRAM Astro_Test;
  8.  
  9. CONST
  10.   (*$I ASTROCON.PAS *)
  11.  
  12. TYPE
  13.   (*$I ASTROTYP.PAS *)
  14.  
  15. VAR
  16.   (*$I ASTROVAR.PAS *)
  17.   Ende : BOOLEAN;
  18.  
  19. (*$I ASTRODAT.PAS *)
  20.  
  21. (* ---------------------------------------------------------------- *)
  22.  
  23. PROCEDURE Berechne_Ortszeit;
  24.  
  25. VAR Referenz_Zeit, Akt_Zeit : Astro_Zeit;
  26.     Referenz_Ort , Akt_Ort  : Astro_Ort;
  27.     Dez_Zeit_1, Dez_Zeit_2  : REAL;
  28.  
  29.  
  30.     PROCEDURE Einlesen (VAR Ort: Astro_Ort);
  31.  
  32.     VAR Auswahl  : CHAR;
  33.         Name     : Astro_String;
  34.         Vorhanden: BOOLEAN;
  35.  
  36.     BEGIN
  37.       Vorhanden := FALSE;
  38.       REPEAT
  39.         Write('N)ame oder L)aengengrad des Ortes ? ');
  40.         ReadLn(Auswahl);  WriteLn;
  41.         CASE Auswahl OF
  42.           'n','N' : BEGIN
  43.                       Write('Name des Ortes : ');  ReadLn(Name);
  44.                       Suche_Ort(Name, Ort, Vorhanden);
  45.                       IF NOT Vorhanden THEN
  46.                         WriteLn('Ort ',Name,' ist nicht tabelliert !');
  47.                     END;
  48.           'l','L' : BEGIN
  49.                       Write('Laengengrad eingeben : ');
  50.                       ReadLn(Ort.Laengengrad);
  51.                       Ort.Ortsname := '*****';
  52.                       Ort.Breitengrad := 0.0;
  53.                       Vorhanden := TRUE;
  54.                     END;
  55.         END;
  56.       UNTIL Vorhanden;
  57.     END;
  58.  
  59.  
  60. BEGIN
  61.   ClrScr;                                     (* Bildschirm loeschen *)
  62.   WriteLn('Berechnung der aktuellen Ortszeit');
  63.   WriteLn('=================================');
  64.   WriteLn;
  65.   WriteLn('Die Zeit eines Referenzortes wird benoetigt.');
  66.   WriteLn;
  67.   WriteLn('Referenzort   :');  Einlesen(Referenz_Ort);
  68.   Write('Zeit eingeben (Stunden  Minuten  Sekunden) : ');
  69.   WITH Referenz_Zeit DO
  70.     ReadLn(Stunden, Minuten, Sekunden);
  71.   Dez_Zeit_1 := ZeitToDez(Referenz_Zeit);
  72.   WriteLn;
  73.   Write('Dies entspricht', Sternzeit(Dez_Zeit_1):7:3);
  74.   WriteLn(' mittlerer Sternzeit');
  75.   WriteLn;
  76.   WriteLn('Ort, fuer den die aktuelle Zeit berechnet werden soll:');
  77.   Einlesen(Akt_Ort);
  78.   Dez_Zeit_2 := Ortszeit(Akt_Ort, Referenz_Ort, Dez_Zeit_1);
  79.   Write('Die augenblickliche Ortszeit ist  ');
  80.   DezToZeit(Dez_Zeit_2, Akt_Zeit);
  81.   WITH Akt_Zeit DO
  82.     WriteLn(Stunden:2, ':', Minuten:2, ':', Sekunden:2);
  83.   ReadLn;
  84. END;
  85.  
  86. (* ---------------------------------------------------------------- *)
  87.  
  88. PROCEDURE Winkel_Rechnen;
  89.  
  90. VAR DW: REAL;
  91.     W : Astro_Winkel;
  92.  
  93. BEGIN
  94.   ClrScr;
  95.   WriteLn(' Winkelumrechnungen ');  WriteLn(' ================== ');
  96.   WriteLn;
  97.   Write('Grad  Minuten  Sekunden: ');  ReadLn(W.Grad, W.Min, W.Sek);
  98.   WriteLn;  WriteLn;
  99.   DW := WinkelToDez(W);
  100.   WriteLn('Dies entspricht : ', DW:7:3, ' Grad');
  101.   WriteLn('   oder         : ', WinkelToZeit(DW):7:3, ' Stunden');
  102.   WriteLn('   oder         : ', Bogenmass(DW):7:3, ' Radiant');
  103.   ReadLn;
  104. END;
  105.  
  106. (* ---------------------------------------------------------------- *)
  107.  
  108. PROCEDURE Greg_in_Jul;
  109.  
  110. VAR Dat : Astro_Datum;
  111.  
  112. BEGIN
  113.   ClrScr;
  114.   WriteLn(' Gregorianisches Datum in Julianische Zaehlung ');
  115.   WriteLn(' ============================================= ');
  116.   WriteLn;  Write(' Bitte das Datum eingeben (Tag  Monat  Jahr):');
  117.   ReadLn(Dat.Tag, Dat.Monat, Dat.Jahr);  WriteLn;
  118.   WriteLn(' Das Julianische Datum ist : ', Jul_Datum(Dat):7:0);
  119.   ReadLn;
  120. END;
  121.  
  122. (* ---------------------------------------------------------------- *)
  123.  
  124. PROCEDURE Jul_in_Greg;
  125.  
  126. VAR JDat : REAL;
  127.     GDat : Astro_Datum;
  128.  
  129. BEGIN
  130.   ClrScr;
  131.   WriteLn(' Julianische Zaehlung in Gregorianisches Datum ');
  132.   WriteLn(' ============================================= ');
  133.   WriteLn;  Write(' Bitte das Julianische Datum eingeben : ');
  134.   ReadLn(JDat);  WriteLn;
  135.   Greg_Datum (JDat, GDat);
  136.   Write(' Das Gregorianische Datum ist : ');
  137.   WriteLn(GDat.Tag, '.', GDat.Monat, '.', GDat.Jahr);
  138.   ReadLn;
  139. END;
  140.  
  141. (* ---------------------------------------------------------------- *)
  142.  
  143. PROCEDURE Tagesdiff;
  144.  
  145. VAR Dat_1, Dat_2 : Astro_Datum;
  146.     Diff         : REAL;
  147.  
  148. BEGIN
  149.   ClrScr;
  150.   WriteLn(' Berechnung der Tagesdifferenz ');
  151.   WriteLn(' ============================= ');
  152.   Write(' Bitte das 1. Datum eingeben (Tag  Monat  Jahr):');
  153.   ReadLn(Dat_1.Tag, Dat_1.Monat, Dat_1.Jahr);
  154.   Write(' Bitte das 2. Datum eingeben (Tag  Monat  Jahr):');
  155.   ReadLn(Dat_2.Tag, Dat_2.Monat, Dat_2.Jahr);
  156.   WriteLn;
  157.   Diff := Tagesdifferenz(Dat_1, Dat_2);
  158.   WriteLn(' Die Differenz ist : ', Trunc(Diff), ' Tage');
  159.   ReadLn;
  160. END;
  161.  
  162. (* ---------------------------------------------------------------- *)
  163.  
  164. PROCEDURE Tag;
  165.  
  166. VAR Dat  : Astro_Datum;
  167.  
  168. BEGIN
  169.   ClrScr;
  170.   WriteLn(' Wochentagsberechnung '); WriteLn(' ==================== ');
  171.   Write(' Bitte das Datum eingeben (Tag  Monat  Jahr):');
  172.   ReadLn(Dat.Tag, Dat.Monat, Dat.Jahr);
  173.   WriteLn; Write(' Dieser Tag ist ein ',Wochentag(Dat));
  174.   ReadLn;
  175. END;
  176.  
  177. (* ---------------------------------------------------------------- *)
  178.  
  179. PROCEDURE Auswahl;
  180.  
  181. VAR Wahl : INTEGER;
  182.     Spc  : STRING[10];
  183.  
  184. BEGIN
  185.   ClrScr;
  186.   Spc := '          ' ;  WriteLn;  WriteLn;
  187.   WriteLn(Spc, '1 ... Ortszeit berechnen');  WriteLn;
  188.   WriteLn(Spc, '2 ... Winkelumrechnungen');  WriteLn;
  189.   WriteLn(Spc, '3 ... Gregorianisches Datum in Julianische Zaehlung');
  190.   WriteLn;
  191.   WriteLn(Spc, '4 ... Julianische Zaehlung in Gregorianisches Datum');
  192.   WriteLn;
  193.   WriteLn(Spc, '5 ... Tage zwischen Daten');  WriteLn;
  194.   WriteLn(Spc, '6 ... Wochentagsberechnug');  WriteLn;
  195.   WriteLn;
  196.   WriteLn(Spc, '0 ... Ende');
  197.   WriteLn;
  198.   WriteLn;
  199.   Write(Spc, 'Auswahl : ');  Read(Wahl);
  200.   CASE Wahl OF
  201.     0 : Ende := TRUE;
  202.     1 : Berechne_Ortszeit;
  203.     2 : Winkel_Rechnen;
  204.     3 : Greg_in_Jul;
  205.     4 : Jul_in_Greg;
  206.     5 : Tagesdiff;
  207.     6 : Tag;
  208.   END;
  209. END;
  210.  
  211. (* ---------------------------------------------------------------- *)
  212.  
  213. BEGIN
  214.   Ende := FALSE;
  215.   Lese_Astro_File;
  216.   REPEAT Auswahl UNTIL Ende;
  217. END.