home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 07 / astrodat / astrodat.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-06-10  |  9.4 KB  |  319 lines
  1. (* ---------------------------------------------------------------- *)
  2. (*                        ASTRODAT.PAS                              *)
  3. (*        mit der Astro-Bibliothek die Zeit im Griff:               *)
  4. (* ---------------------------------------------------------------- *)
  5.  
  6. (* ---------------------------------------------------------------- *)
  7. (*   Umrechnung Winkel (Stunden, Minuten, Sekunden) nach dezimal:   *)
  8.  
  9. FUNCTION WinkelToDez (Winkel: Astro_Winkel): REAL;
  10.  
  11. BEGIN
  12.   WITH Winkel DO
  13.     WinkelToDez := Grad + Min/60.0 + Sek/3600.0
  14. END;
  15.  
  16. (* ---------------------------------------------------------------- *)
  17. (*            Winkel < 0.0 oder > 360.0 korrigieren:                *)
  18.  
  19. FUNCTION NormWinkel (Winkel: REAL): REAL;
  20.  
  21. VAR negativ: BOOLEAN;
  22.  
  23. BEGIN
  24.   negativ := (Winkel < 0.0);
  25.   Winkel := Abs(Winkel);
  26.   Winkel := Winkel - Trunc(Winkel / 360.0) * 360.0;
  27.   IF negativ THEN Winkel := 360.0 - Winkel;
  28.   NormWinkel := Winkel;
  29. END;
  30.  
  31. (* ---------------------------------------------------------------- *)
  32. (*   Umrechnung Winkel (Dezimal) nach Stunden, Minuten, Sekunden:   *)
  33. (* Die Turbo-Funktion 'Frac(x)' gibt den Bruchteil von x aus:       *)
  34. (* Frac(x) = x - Int(x); Int(x) liefert ganzzahligen Anteil von x.  *)
  35.  
  36. PROCEDURE DezToWinkel (DezWinkel: REAL; VAR Winkel: Astro_Winkel);
  37.  
  38. BEGIN
  39.   DezWinkel   := NormWinkel(DezWinkel);
  40.   Winkel.Grad := Trunc(DezWinkel);
  41.   Winkel.Min  := Trunc(Frac(DezWinkel)*60.0);
  42.   Winkel.Sek  := Trunc(Frac(Frac(DezWinkel)*60.0)*60.0);
  43. END;
  44.  
  45. (* ---------------------------------------------------------------- *)
  46. (*   Umrechnung Zeit (Stunden, Minuten, Sekunden) nach dezimal:     *)
  47.  
  48. FUNCTION ZeitToDez (Zeit: Astro_Zeit): REAL;
  49.  
  50. BEGIN
  51.   WITH Zeit DO
  52.     ZeitToDez := Stunden + Minuten/60.0 + Sekunden/3600.0
  53. END;
  54.  
  55. (* ---------------------------------------------------------------- *)
  56. (*   Umrechnung Zeit (Dezimal) nach Stunden, Minuten, Sekunden:     *)
  57.  
  58. PROCEDURE DezToZeit (DezZeit: REAL; VAR Zeit: Astro_Zeit);
  59.  
  60. BEGIN
  61.   Zeit.Stunden := Trunc(DezZeit);
  62.   Zeit.Minuten := Trunc(Frac(DezZeit)*60.0);
  63.   Zeit.Sekunden:= Trunc(Frac(Frac(DezZeit)*60.0)*60.0);
  64. END;
  65.  
  66. (* ---------------------------------------------------------------- *)
  67. (*             Umrechnung Sternzeit nach Sonnenzeit:                *)
  68.  
  69. FUNCTION Sonnenzeit (Zeit: REAL): REAL;
  70.  
  71. BEGIN
  72.   Sonnenzeit := 366.2422 / 365.2422 * Zeit;
  73. END ;
  74.  
  75. (* ---------------------------------------------------------------- *)
  76. (*             Umrechnung Sonnenzeit nach Sternzeit:                *)
  77.  
  78. FUNCTION Sternzeit (Zeit: REAL): REAL;
  79.  
  80. BEGIN
  81.   Sternzeit := 365.2422 / 366.2422 * Zeit;
  82. END;
  83.  
  84. (* ---------------------------------------------------------------- *)
  85. (*        Umrechnung Winkel (Dezimal) nach Zeit (Dezimal):          *)
  86.  
  87. FUNCTION WinkelToZeit (DezWinkel: REAL): REAL;
  88.  
  89. BEGIN
  90.   WinkelToZeit := DezWinkel * 24.0 / 360.0;
  91. END;
  92.  
  93. (* ---------------------------------------------------------------- *)
  94. (*        Umrechnung Zeit (Dezimal) nach Winkel (Dezimal):          *)
  95.  
  96. FUNCTION ZeitToWinkel (DezZeit: REAL): REAL;
  97.  
  98. BEGIN
  99.   ZeitToWinkel := 360.0 / 24.0 * DezZeit;
  100. END;
  101.  
  102. (* ---------------------------------------------------------------- *)
  103. (*          Umrechnung Winkel (Dezimal) nach Bogenmass:             *)
  104.  
  105. FUNCTION Bogenmass (Phi: REAL): REAL;
  106.  
  107. BEGIN
  108.   Bogenmass := Pi / 180.0 * Phi;
  109. END;
  110.  
  111. (* ---------------------------------------------------------------- *)
  112. (*          Umrechnung Bogenmass nach Winkel (Dezimal):             *)
  113.  
  114. FUNCTION Winkelmass (Bogen: REAL): REAL;
  115.  
  116. BEGIN
  117.   Winkelmass := Bogen * 180.0 / Pi;
  118. END;
  119.  
  120. (* ---------------------------------------------------------------- *)
  121. (*    Umrechnung Gregorianisches Datum nach Julianisches Datum:     *)
  122.  
  123. FUNCTION Jul_Datum (Greg_Dat: Astro_Datum): REAL;
  124.  
  125. VAR JD, J1, J2: REAL;
  126.  
  127. BEGIN
  128.   J1 := Greg_Dat.Jahr - Jul_Ref_Jahr;
  129.   JD := Jul_Referenz + J1 * 365.0;
  130.   JD := JD + Int(J1 / 4.0) - Int(J1 / 100.0) + Int(J1 / 400.0);
  131.   IF Greg_Dat.Monat >= 3 THEN
  132.     BEGIN
  133.       JD := JD + Int(30.6 * Greg_Dat.Monat - 32.3);
  134.       J2 := Greg_Dat.Jahr;
  135.       IF Trunc(J2) MOD 100 = 0 THEN J2 := Int(J2 / 100.0);
  136.       IF Trunc(J2) MOD 4   = 0 THEN JD := JD + 1.0;
  137.     END
  138.   ELSE
  139.     JD := JD + 31.0 * Greg_Dat.Monat - 31.0;
  140.   JD := JD + Greg_Dat.Tag;
  141.   Jul_Datum := JD;
  142. END;
  143.  
  144. (* ---------------------------------------------------------------- *)
  145. (*    Umrechnung Julianisches Datum nach Gregorianisches Datum:     *)
  146.  
  147. PROCEDURE Greg_Datum (Jul_Dat: REAL; VAR Greg_Dat: Astro_Datum);
  148.  
  149. VAR Jahr, Diff, Monat, Tage, Laenge, Hilfe, J: REAL;
  150.  
  151. BEGIN
  152.   Jahr := Jul_Ref_Jahr;
  153.   Diff := Jul_Dat - Jul_Referenz;
  154.   Tage := Int(Diff);
  155.   IF Tage > 146097.0 THEN
  156.   BEGIN
  157.     Hilfe := Int(Tage / 146097.0);
  158.     Tage  := Tage - 146097.0 * Hilfe;
  159.     Jahr  := Jahr + 400.0 * Hilfe;
  160.   END;
  161.   IF Tage > 36524.0 THEN
  162.   BEGIN
  163.     Hilfe := Int(Tage / 36524.0);
  164.     Tage  := Tage - 36524.0 * Hilfe;
  165.     Jahr  := Jahr + 100.0 * Hilfe;
  166.   END;
  167.   IF Tage > 1461.0 THEN
  168.   BEGIN
  169.     Hilfe := Int(Tage / 1461.0);
  170.     Tage  := Tage - 1461.0 * Hilfe;
  171.     Jahr  := Jahr + 4.0 * Hilfe;
  172.   END;
  173.   IF Tage > 365.0 THEN
  174.   BEGIN
  175.     Hilfe := Int(Tage / 365.0);
  176.     Tage  := Tage - 365.0 * Hilfe;
  177.     Jahr  := Jahr + Hilfe;
  178.   END;
  179.   IF Tage <> 0.0 THEN
  180.     BEGIN
  181.       Hilfe := 0.0; Monat := 0.0; Laenge := 0.0;
  182.       REPEAT
  183.         Tage := Tage - Laenge;
  184.         Monat := Monat + 1.0;
  185.         Hilfe := 1.0 - Hilfe;
  186.         IF Monat = 8.0 THEN Hilfe := 1.0;
  187.         Laenge := 30.0 + Hilfe;
  188.         IF Monat = 2.0 THEN
  189.         BEGIN
  190.           Laenge := Laenge - 2.0;
  191.           J := Jahr;
  192.           IF Trunc(J) MOD 100 = 0 THEN J := J / 100.0;
  193.           IF Trunc(J) MOD   4 = 0 THEN Laenge := Laenge + 1.0;
  194.         END;
  195.       UNTIL Tage <= Laenge;
  196.       Greg_Dat.Tag   := Trunc(Tage);
  197.       Greg_Dat.Jahr  := Trunc(Jahr);
  198.       Greg_Dat.Monat := Trunc(Monat);
  199.     END
  200.   ELSE
  201.     BEGIN
  202.       Greg_Dat.Jahr  := Trunc(Jahr) - 1;
  203.       Greg_Dat.Monat := 12;
  204.       Greg_Dat.Tag   := 31;
  205.     END;
  206. END;
  207.  
  208. (* ---------------------------------------------------------------- *)
  209. (*                Berechnung der Tagesdifferenz:                    *)
  210.  
  211. FUNCTION Tagesdifferenz (Dat_1, Dat_2: Astro_Datum): INTEGER;
  212.  
  213. VAR f1, f2: REAL;
  214.  
  215. BEGIN
  216.   f1 := Jul_Datum(Dat_1);
  217.   f2 := Jul_Datum(Dat_2);
  218.   Tagesdifferenz := Trunc(abs(f2 - f1));
  219. END;
  220.  
  221. (* ---------------------------------------------------------------- *)
  222. (*                 Bestimmung des Wochentages:                      *)
  223.  
  224. FUNCTION Wochentag (Datum: Astro_Datum): Astro_String;
  225.  
  226. VAR Wert: Astro_Tage;
  227.     F   : REAL;
  228.  
  229. BEGIN
  230.   F := Jul_Datum(Datum) ;
  231.   Wert := Trunc (F-7 * Int(F/7));
  232.   CASE Wert OF
  233.     0 : Wochentag := 'Dienstag';
  234.     1 : Wochentag := 'Mittwoch';
  235.     2 : Wochentag := 'Donnerstag';
  236.     3 : Wochentag := 'Freitag';
  237.     4 : Wochentag := 'Samstag';
  238.     5 : Wochentag := 'Sonntag';
  239.     6 : Wochentag := 'Montag';
  240.   END;
  241. END;
  242.  
  243. (* ---------------------------------------------------------------- *)
  244. (*                      Einlesen der Ortsdatei:                     *)
  245.  
  246. PROCEDURE Lese_Astro_File;
  247.  
  248. VAR Hilfe: STRING [30];
  249.     Error: INTEGER;
  250.     Ort  : Astro_OrtPtr;
  251.  
  252. BEGIN
  253.   Astro_Orte := NIL;
  254.   (* der Dateivariablen 'Astro_File' die physik. Datei 'ASTROORT.DAT'
  255.      zuweisen:                                                      *)
  256.   Assign(Astro_File, 'ASTROORT.DAT');
  257.   {$I-}     (* I/O-Fehlerbehandlung durch Laufzeitsystem abschalten *)
  258.   ReSet(Astro_File);                  (* Datei zu oeffnen versuchen *)
  259.   {$I+}                   (* I/O-Fehlerbehandlung wieder aktivieren *)
  260.   IF IOResult = 0 THEN    (* Operation gelungen, Orte in eine dyna- *)
  261.     WHILE NOT Eof(Astro_File) DO   (* mische Liste einlesen...      *)
  262.     BEGIN
  263.       New(Ort);
  264.       WITH Ort^ DO
  265.       BEGIN
  266.         ReadLn(Astro_File, Ortsname);
  267.         ReadLn(Astro_File, Laengengrad);
  268.         ReadLn(Astro_File, Breitengrad);
  269.       END;
  270.       Ort^.naechster := Astro_Orte;
  271.       Astro_Orte := Ort;
  272.     END
  273.   ELSE
  274.     BEGIN
  275.       WriteLn;  WriteLn;
  276.       WriteLn('Datei ASTROORT.DAT nicht gefunden !');
  277.       WriteLn;  WriteLn('Bitte <CR> eingeben !');
  278.       ReadLn;
  279.     END;
  280. END;
  281.  
  282. (* ---------------------------------------------------------------- *)
  283. (*                 Durchsuchen der Ortsliste:                       *)
  284.  
  285. PROCEDURE Suche_Ort (Name: Astro_String;
  286.                      VAR Ort: Astro_Ort; VAR Gefunden: BOOLEAN);
  287.  
  288. VAR OrtPtr: Astro_OrtPtr;
  289.  
  290. BEGIN
  291.   OrtPtr := Astro_Orte;
  292.   Gefunden := FALSE;
  293.   WHILE (OrtPtr <> NIL) AND NOT Gefunden DO
  294.   BEGIN
  295.     Gefunden := (Name = OrtPtr^.Ortsname);
  296.     IF NOT Gefunden THEN OrtPtr := OrtPtr^.naechster;
  297.   END;
  298.   IF Gefunden THEN Ort := OrtPtr^;
  299. END;
  300.  
  301. (* ---------------------------------------------------------------- *)
  302. (*            Bestimmung der aktuellen Ortszeit:                    *)
  303.  
  304. FUNCTION Ortszeit (Ort1, Ort2: Astro_Ort; Referenzzeit: REAL): REAL;
  305.  
  306. VAR Delta, Zeitdifferenz: REAL;
  307.  
  308. BEGIN
  309.   Delta := NormWinkel(Ort2.Laengengrad - Ort1.Laengengrad);
  310.   Zeitdifferenz := ZeitToWinkel(Delta * 4.0 / 60.0);
  311.   Referenzzeit  := ZeitToWinkel(Referenzzeit);
  312.   IF Ort1.Laengengrad <> Ort2.Laengengrad THEN
  313.     Referenzzeit := NormWinkel(Referenzzeit + Zeitdifferenz);
  314.   Ortszeit := WinkelToZeit(Referenzzeit);
  315. END;
  316.  
  317. (* ---------------------------------------------------------------- *)
  318. (*                        Ende von ASTRODAT.PAS                     *)
  319.