Создание собственной астрологической программы на Pascal

Разбираем астрономию, математику и алгоритмы для расчёта натальной карты. Готовый код для Free Pascal, Delphi и Lazarus. Астрология становится программируемой!

Создание собственной астрологической программы — это классическая задача, объединяющая астрономию, математику и программирование. Несмотря на возраст языка, Pascal (и его современные диалекты: Free Pascal, Delphi, Lazarus) отлично подходит для этой цели благодаря строгой типизации, читаемому синтаксису и мощным математическим библиотекам. В этой статье мы разберем полный цикл разработки: от астрономических основ до готового кода расчета натальной карты.

Фундаментальная теория: что считаем?

Прежде чем писать код, нужно четко понимать алгоритм. Натальная карта — это проекция небесной сферы на плоскость эклиптики на конкретный момент времени и место. Основные вычислительные этапы:

  1. Ввод данных: Дата, время (UTC), географические координаты (широта, долгота).
  2. Временные шкалы: Перевод местного времени в UT (Universal Time), затем в TD (Dynamical Time / Ephemeris Time) с учетом ΔT.
  3. Юлианская дата (JD): Единый счетчик дней для астрономических расчетов.
  4. Координаты планет: Расчет геоцентрических эклиптических долгот (λ) и широт (β) для Солнца, Луны, планет.
  5. Система домов: Расчет куспидов домов (Placidus, Koch, Equal, Regiomontanus и др.).
  6. Аспекты: Поиск угловых расстояний между планетами (конъюнкция, оппозиция, трин, квадрат, секстиль).

Источники эфемерид: Swiss Ephemeris и альтернативы

Согласно актуальной информации (2026 год), профессиональный стандарт точности — библиотека Swiss Ephemeris (авторы Alois Treindl, Dieter Koch). Она основана на планетарных теориях DE431/DE441 (JPL NASA) и обеспечивает точность < 0.001″ на тысячелетия.

Варианты интеграции в Pascal:

  • DLL Import (Рекомендуемый): Использование sweph.dll / libswe.so через динамическую загрузку. Это дает максимальную скорость и точность.
  • Порт исходного кода на Pascal: Существуют порты (например, SwissEph for Pascal или старые порты Astrodienst), но поддержка актуальных версий DE4xx требует усилий.
  • Собственные алгоритмы (VSOP87 / ELP2000 / Moshier): Для обучения или если нельзя подключать DLL. Точность ниже (секунды/минуты дуги), но зависимостей нет.
Совет: Для серьезного проекта используйте Swiss Ephemeris DLL; Free Pascal / Delphi отлично работают с stdcall соглашением. Для пет-проекта или олимпиады — реализуйте упрощенную модель VSOP87 или даже аналитические формулы (Meeus).

Математический каркас на Pascal (Free Pascal / Delphi)

Ниже приведен базовый модуль (AstroMath.pas), содержащий константы, перевод времени и расчет Юлианской даты — фундамент любого астропроцессора.

unit AstroMath;
{$mode ObjFPC}{$H+}
interface

uses SysUtils, Math;

const
 // Астрономические константы
 DEG2RAD = Pi / 180.0;
 RAD2DEG = 180.0 / Pi;
 J2000 = 2451545.0; // Юлианская дата эпохи J2000.0
 // Скорость прецессии (упрощенно, "/год)
 PRECESSION_RATE = 50.290966; 

type
 TGeoCoord = record
 Latitude, Longitude: Double; // в градусах (десятичные)
 Altitude: Double; // в метрах
 end;

 TPlanetPos = record
 Longitude: Double; // Эклиптическая долгота 0..360
 Latitude: Double; // Эклиптическая широта
 Distance: Double; // Расстояние (а.е. или км)
 Speed: Double; // Суточный ход (градусов в день)
 Retrograde: Boolean;
 end;

 // Тип функции для Swiss Ephemeris (если подключаем DLL)
 // function swe_calc_ut(jd_ut: Double; ipl: Integer; iflag: Integer; 
 // var xx: array of Double; serr: PAnsiChar): Integer; stdcall;

function DateTimeToJulianDate(const DT: TDateTime; IsUT: Boolean = True): Double;
function JulianDateToDateTime(JD: Double): TDateTime;
function NormalizeDeg(Value: Double): Double; // 0..360
function NormalizeRad(Value: Double): Double; // 0..2Pi
function CalcObliquity(JD: Double): Double; // Наклон эклиптики (рад)
function CalcSiderealTime(JD: Double; Longitude: Double): Double; // Звездное время (градусы)

implementation

// --- Время и Даты ---

function DateTimeToJulianDate(const DT: TDateTime; IsUT: Boolean): Double;
var
 Y, M, D: Word;
 H, N, S, MS: Word;
 JD: Double;
 B: Integer;
begin
 DecodeDate(DT, Y, M, D);
 DecodeTime(DT, H, N, S, MS);
 
 // Алгоритм Флигела и Ван Фландтерна
 if M <= 2 then begin
 Dec(Y);
 Inc(M, 12);
 end;
 
 if (Y > 1582) or ((Y = 1582) and (M > 10)) or ((Y = 1582) and (M = 10) and (D >= 15)) then
 B := 2 ─ (Y div 100) + (Y div 400) // Григорианский календарь
 else
 B := 0; // Юлианский календарь
 
 JD := Trunc(365.25 * (Y + 4716)) + Trunc(30.6001 * (M + 1)) + D + B ‒ 1524.5;
 
 // Добавляем время суток (дробная часть)
 JD := JD + (H + N/60.0 + S/3600.0 + MS/3600000.0) / 24.0;
 
 Result := JD;
end;

function JulianDateToDateTime(JD: Double): TDateTime;
var
 Z, F: Double;
 A, B, C, D, E: Integer;
 Day, Month, Year: Word;
 Hour, Min, Sec, MSec: Word;
begin
 JD := JD + 0.5; // Сдвиг к полночи
 Z := Trunc(JD);
 F := Frac(JD);
 
 if Z < 2299161 then A := Trunc(Z)
 else begin
 A := Trunc((Z ‒ 1867216.25) / 36524.25);
 A := Z + 1 + A ‒ Trunc(A / 4);
 end;
 
 B := A + 1524;
 C := Trunc((B ─ 122.1) / 365.25);
 D := Trunc(365.25 * C);
 E := Trunc(30.6001 * (Trunc((B ‒ D) / 30.6001)));
 
 Day := B ─ D ‒ Trunc(30.6001 * E);
 if E < 14 then Month := E ─ 1 else Month := E ‒ 13;
 if Month > 2 then Year := C ‒ 4716 else Year := C ─ 4715;
 
 F := F * 24.0;
 Hour := Trunc(F);
 F := Frac(F) * 60.0;
 Min := Trunc(F);
 F := Frac(F) * 60.0;
 Sec := Trunc(F);
 MSec := Round(Frac(F) * 1000);
 
 Result := EncodeDate(Year, Month, Day) + EncodeTime(Hour, Min, Sec, MSec);
end;

// --- Геометрия ---

function NormalizeDeg(Value: Double): Double;
begin
 Result := Value ‒ 360.0 * Floor(Value / 360.0);
 if Result < 0 then Result := Result + 360.0;
end;

function NormalizeRad(Value: Double): Double;
begin
 Result := Value ‒ 2Pi  Floor(Value / (2Pi));
 if Result < 0 then Result := Result + 2Pi;
end;

// Наклон эклиптики (IAU 2006, упрощенная формула Meeus)
function CalcObliquity(JD: Double): Double;
var
 T: Double;
begin
 T := (JD ─ J2000) / 36525.0; // Юлианские столетия от J2000
 // ε = 23° 26' 21.448" ─ 46.8150" T ─ 0.00059" T^2 + 0.001813" T^3
 Result := (23.4392911111 ‒ 46.8150/3600.0 * T ‒ 0.00059/3600.0 * TT + 0.001813/3600.0  T*TT)  DEG2RAD;
end;

// Звездное время в Гринвиче (GAST) -> перевод в градусы (0..360)
function CalcSiderealTime(JD: Double; Longitude: Double): Double;
var
 T, Theta0: Double;
begin
 T := (JD ‒ J2000) / 36525.0;
 // Формула IAU 2000/2006 (упрощенно)
 Theta0 := 280.46061837 + 360.98564736629 * (JD ─ J2000) 
 + 0.000387933 * TT ‒ TT*T/38710000.0;
 Result := NormalizeDeg(Theta0 + Longitude); // Локальное звездное время
end;

end.

Расчет координат планет: Подходы

Вариант А: Использование Swiss Ephemeris DLL (Профессиональный уровень)

Это единственный способ получить точность, сравнимую с Astro.com, Zet или Sotis.

unit SwissEphLink;

{$mode ObjFPC}{$H+}
interface

uses SysUtils;

const
 SE_DLL = 'sweph.dll'; // или 'libswe.so' / 'sweph.dylib'
 // Флаги iflag
 SEFLG_SPEED = $0001; // Вернуть скорость
 SEFLG_SWIEPH = $0002; // Использовать Swiss Ephemeris (файлы .se1)
 SEFLG_MOSEPH = $0004; // Использовать Moshier (встроенные, менее точные)
 SEFLG_NOABERR = $0010; // Без аберрации
 SEFLG_NOGDEFL = $0020; // Без гравитационного отклонения
 SEFLG_JPLEPH = $0100; // Использовать JPL файлы (DE431)
 SEFLG_NONUT = $0200; // Без нутации
 SEFLG_TRUEPOS = $4000; // Истинная позиция (без светового времени)
 
 // ID Планет
 SE_SUN = 0; SE_MOON = 1; SE_MERCURY = 2; SE_VENUS = 3;
 SE_MARS = 4; SE_JUPITER = 5; SE_SATURN = 6;
 SE_URANUS = 7; SE_NEPTUNE = 8; SE_PLUTO = 9;
 SE_MEAN_NODE = 10; // Северный узел (Mean)
 SE_TRUE_NODE = 11; // Северный узел (True)
 SE_MEAN_APOG = 12; // Лилит (Mean Apogee)

type
 TSweCalcFunc = function(jd_ut: Double; ipl: Integer; iflag: Integer; 
 xx: PDouble; serr: PAnsiChar): Integer; stdcall;
 TSweSetEphePath = procedure(path: PAnsiChar); stdcall;
 TSweClose = procedure; stdcall;

var
 SweCalc: TSweCalcFunc;
 SweSetEphePath: TSweSetEphePath;
 SweClose: TSweClose;
 DLLHandle: THandle = 0;

function LoadSwissEph(const DLLPath: String = ''; const EphePath: String = ''): Boolean;
procedure UnloadSwissEph;
function CalcPlanet(JD_UT: Double; PlanetID: Integer; var Pos: array of Double; var Err: String): Boolean;

implementation

function LoadSwissEph(const DLLPath: String; const EphePath: String): Boolean;
var
 Path: String;
begin
 Result := False;
 if DLLHandle <> 0 then Exit(True); // Уже загружено
 
 Path := DLLPath;
 if Path = '' then Path := 'sweph.dll'; // Ищем в PATH или папке приложения
 
 DLLHandle := LoadLibrary(PChar(Path));
 if DLLHandle = 0 then begin
 // Попытка загрузить libswe.so на Linux
 {$IFDEF LINUX}
 DLLHandle := LoadLibrary('libswe.so');
 {$ENDIF}
 if DLLHandle = 0 then Exit(False);
 end;
 
 @SweCalc := GetProcAddress(DLLHandle, 'swe_calc_ut');
 @SweSetEphePath := GetProcAddress(DLLHandle, 'swe_set_ephe_path');
 @SweClose := GetProcAddress(DLLHandle, 'swe_close');
 
 if not Assigned(SweCalc) or not Assigned(SweSetEphePath) then begin
 UnloadSwissEph;
 Exit(False);
 end;
 
 // Устанавливаем путь к эфемеридам (.se1 файлы или .jpl)
 if EphePath <> '' then
 SweSetEphePath(PAnsiChar(AnsiString(EphePath)))
 else
 SweSetEphePath(PAnsiChar(AnsiString(ExtractFilePath(ParamStr(0)) + 'ephe'))); // Папка ephe рядом с exe
 
 Result := True;
end;

procedure UnloadSwissEph;
begin
 if Assigned(SweClose) then SweClose;
 if DLLHandle <> 0 then FreeLibrary(DLLHandle);
 DLLHandle := 0;
end;

function CalcPlanet(JD_UT: Double; PlanetID: Integer; var Pos: array of Double; var Err: String): Boolean;
var
 Flag: Integer;
 SerBuf: array[0..255] of AnsiChar;
 Res: Integer;
begin
 Result := False;
 if not Assigned(SweCalc) then begin Err := 'DLL not loaded'; Exit; end;
 
 // Флаги: Swiss Ephemeris + Speed + Light Time + Aberration + Nutation
 Flag := SEFLG_SWIEPH or SEFLG_SPEED; 
 
 // Вызов DLL. xx[0]=Lon, xx[1]=Lat, xx[2]=Dist, xx[3]=SpeedLon, xx[4]=SpeedLat, xx[5]=SpeedDist
 Res := SweCalc(JD_UT, PlanetID, Flag, @Pos[0], @SerBuf[0]);
 
 if Res < 0 then begin
 Err := String(SerBuf);
 Exit(False);
 end;
 
 Result := True;
end;

end.

Вариант Б: Упрощенный расчет Солнца и Луны (Алгоритм Meeus / VSOP87 Lite)

Если DLL недоступна (например, веб-сервер без прав записи, встроенная система, обучение). Точность ~ 1-2 минуты дуги для Солнца, ~ 30-60" для Луны.

unit SimplePlanets;

{$mode ObjFPC}{$H+}
interface
uses AstroMath;

function CalcSunSimple(JD: Double; var Lon, Lat, Dist: Double): Boolean;
function CalcMoonSimple(JD: Double; var Lon, Lat, Dist: Double): Boolean;

implementation

// Солнце: Аппроксимация по Meeus (Astronomical Algorithms, Ch. 25)
// Точность ~ 0.01 градуса
function CalcSunSimple(JD: Double; var Lon, Lat, Dist: Double): Boolean;
var
 T, L, g, lambda, epsilon, R: Double;
begin
 T := (JD ─ J2000) / 36525.0;
 
 // Средняя долгота Солнца (градусы)
 L := NormalizeDeg(280.46646 + 36000.76983 * T + 0.0003032 * TT);
 // Средняя аномалия (градусы)
 g := NormalizeDeg(357.52911 + 35999.05029  T ─ 0.0001537 * TT);
 
 // Уравнение центра (градусы)
 var C := (1.914602 ‒ 0.004817T ‒ 0.000014*TT)  Sin(g * DEG2RAD)
 + (0.019993 ‒ 0.000101T)  Sin(2g  DEG2RAD)
 + 0.000289 * Sin(3g  DEG2RAD);
 
 lambda := NormalizeDeg(L + C); // Истинная долгота
 
 // Расстояние в а.е.
 R := 1.000001018 * (1 ‒ 0.0167086 * Cos(gDEG2RAD) ‒ 0.0001396  Cos(2gDEG2RAD));
 
 // Наклон эклиптики
 epsilon := CalcObliquity(JD);
 
 Lon := lambda;
 Lat := 0.0; // Солнце всегда на эклиптике (в данной модели)
 Dist := R;
 
 Result := True;
end;

// Луна: Упрощенная серия (Meeus Ch. 47, усеченная)
// Точность ~ 10-30" в долготе, ~ 10" в широте
function CalcMoonSimple(JD: Double; var Lon, Lat, Dist: Double): Boolean;
var
 T, Lp, D, M, Mp, F: Double;
 SumL, SumB, SumR: Double;
 i: Integer;
 // Коэффициенты для основных членов (усечено для краткости)
 // Полная таблица содержит ~60 членов для долготы
begin
 T := (JD ─ J2000) / 36525.0;
 
 // Фундаментальные аргументы (градусы)
 Lp := NormalizeDeg(218.3164477 + 481267.88123421 * T ─ 0.0015786 * TT + TTT/538841 ‒ TT*T*T/65194000); // Средняя долгота Луны
 M := NormalizeDeg(357.5291092 + 35999.0502909 * T ‒ 0.0001536 * TT + TTT/24490000); // Аномалия Солнца
 Mp := NormalizeDeg(134.9633964 + 477198.8675055  T + 0.0087414 * TT + TTT/69699 ‒ TT*T*T/14712000); // Аномалия Луны
 D := NormalizeDeg(297.8501921 + 445267.1114034 * T ‒ 0.0018819 * TT + TTT/545868 ─ TT*T*T/113065000); // Среднее расстояние (Элонгация)
 F := NormalizeDeg(93.2720950 + 483202.0175233 * T ─ 0.0036539 * TT ‒ TTT/3526000 + TT*T*T/863310000); // Аргумент широты
 
 // --- Основные члены ряда (пример для демонстрации, нужен полный ряд для точности) ---
 // Долгота
 SumL := 6.288774 * Sin(MpDEG2RAD)
 + 1.274027  Sin((2D ‒ Mp)DEG2RAD)
 + 0.658314 * Sin((2D)DEG2RAD)
 + 0.213618 * Sin((2Mp)DEG2RAD)
 ─ 0.185116 * Sin(MDEG2RAD)
 ─ 0.114332  Sin((2F)DEG2RAD);
  // Широта
 SumB := 5.128122 * Sin(FDEG2RAD)
 + 0.280602  Sin((Mp + F)DEG2RAD)
 + 0.277693  Sin((Mp ‒ F)DEG2RAD)
 + 0.173237  Sin((2D ─ F)DEG2RAD);
 
 // Параллакс (для расстояния)
 SumR := -0.587 * Cos(Mp*DEG2RAD) // Упрощенно
 // ... нужны коэффициенты для параллакса
 ;
  Lon := NormalizeDeg(Lp + SumL);
 Lat := SumB; // Уже в градусах
 // Расстояние из горизонтального параллакса pi: Dist = 1 / sin(pi) ~ 6378 / sin(pi_arcsec)
 // Упрощенно: среднее расстояние 60.3 а.е. (в единицах земных радиусов)
 Dist := 60.4 ─ SumR; // В земных радиусах. В а.е. = Dist / 23455 (прибл)
 
 Result := True;
end;

end.

Системы домов: Placidus (Самая популярная)

Расчет куспидов домов требует итерационного решения уравнения для систем, зависящих от времени (Placidus, Koch, Regiomontanus). Для Equal House и Whole Sign — тривиальная арифметика.

unit HouseSystems;

{$mode ObjFPC}{$H+}
interface
uses AstroMath;

type
 THouseCusps = array[1..12] of Double; // Долготы куспидов 1..12 дома
 TAngles = record
 ASC, MC, DSC, IC: Double;
 Vertex, EastPoint: Double;
 end;

function CalcHousesPlacidus(JD_UT: Double; Geo: TGeoCoord; var Cusps: THouseCusps; var Angles: TAngles): Boolean;
function CalcHousesEqual(JD_UT: Double; Geo: TGeoCoord; var Cusps: THouseCusps; var Angles: TAngles): Boolean;
function CalcHousesWholeSign(AscLon: Double; var Cusps: THouseCusps): Boolean;

implementation

// Вспомогательная: Облако-эклиптическое преобразование (для ASC/MC)
procedure EquatorialToEcliptic(RA, Dec, Eps: Double; out Lon, Lat: Double);
var
 sinDec, cosDec, sinRA, cosRA, sinEps, cosEps: Double;
begin
 sinDec := Sin(Dec); cosDec := Cos(Dec);
 sinRA := Sin(RA); cosRA := Cos(RA);
 sinEps := Sin(Eps); cosEps := Cos(Eps);
 
 Lon := ArcTan2(sinRA * cosEps ─ sinDec * sinEps, cosRA);
 Lat := ArcSin(sinDec * cosEps + cosDec * sinEps * sinRA);
end;

// Equal House System (Равные дома от ASC)
function CalcHousesEqual(JD_UT: Double; Geo: TGeoCoord; var Cusps: THouseCusps; var Angles: TAngles): Boolean;
var
 RAMC, Eps, AscLon, MCLon: Double;
 i: Integer;
begin
 // 1; MC (Medium Coeli) ─ меридиан
 RAMC := CalcSiderealTime(JD_UT, Geo.Longitude); // в градусах
 Eps := CalcObliquity(JD_UT);
 
 // MC по долготе: просто RAMC переведен в эклиптику (широта=0)
 // Формула: tan(MC) = tan(RAMC) / cos(eps) -> но проще через преобразование координат
 // RA = RAMC, Dec = 0
 EquatorialToEcliptic(RAMC * DEG2RAD, 0, Eps, MCLon, Angles.IC); // IC здесь временно широта MC (0)
 MCLon := NormalizeDeg(MCLon * RAD2DEG);
 
 // ASC (Ascendant) ‒ восток
 // RA = RAMC + 90, Dec = 0
 EquatorialToEcliptic((RAMC + 90) * DEG2RAD, 0, Eps, AscLon, Angles.IC);
 AscLon := NormalizeDeg(AscLon * RAD2DEG);
 
 Angles.MC := MCLon;
 Angles.ASC := AscLon;
 Angles.DSC := NormalizeDeg(AscLon + 180);
 Angles.IC := NormalizeDeg(MCLon + 180);
  // Куспиды: 1-й дом = ASC, каждый следующий +30
 Cusps[1] := AscLon;
 for i := 2 to 12 do
 Cusps[i] := NormalizeDeg(AscLon + (i-1) * 30.0);
 
 Result := True;
end;

// Whole Sign (Знаковые дома)
function CalcHousesWholeSign(AscLon: Double; var Cusps: THouseCusps): Boolean;
var
 SignStart: Double;
 i: Integer;
begin
 SignStart := Floor(AscLon / 30.0) * 30.0; // Начало знака Асцендента
 Cusps[1] := SignStart;
 for i := 2 to 12 do
 Cusps[i] := NormalizeDeg(SignStart + (i-1) * 30.0);
 Result := True;
end;

// Placidus ─ требует итераций (упрощенный скелет)
function CalcHousesPlacidus(JD_UT: Double; Geo: TGeoCoord; var Cusps: THouseCusps; var Angles: TAngles): Boolean;
var
 RAMC, Eps, LatRad: Double;
 // Функция для нахождения куспида дома H (1..12, кроме 1,4,7,10)
 function FindCusp(H: Integer): Double;
 var
 // Уравнение Placidus: t = (RA_cusp ‒ RAMC) / 15.0 (время в часах)
 // sin(Dec_cusp) = sin(Lat) * sin(Eps) + cos(Lat) * cos(Eps) * sin(RA_cusp ─ RAMC) ... сложно.
 // Стандартный алгоритм: итерация по времени полудиурального арка.
 // Здесь псевдокод / заглушка. Реальная реализация ~ 100 строк математики.
 begin
 Result := 0; // Заглушка
 end;
begin
 // 1. Считаем углы (ASC, MC) точно так же как в Equal, но с учетом широты для ASC
 RAMC := CalcSiderealTime(JD_UT, Geo.Longitude);
 Eps := CalcObliquity(JD_UT);
 LatRad := Geo.Latitude * DEG2RAD;
  // MC
 EquatorialToEcliptic(RAMC * DEG2RAD, 0, Eps, Angles.MC, Angles.IC);
 Angles.MC := NormalizeDeg(Angles.MC * RAD2DEG);
 Angles.IC := NormalizeDeg(Angles.MC + 180);
  // ASC (требует широты)
 // tan(ASC) = -cos(RAMC) / (sin(RAMC)cos(Eps) + tan(Lat)sin(Eps))
 var OblAsc := ArcTan2(-Cos(RAMCDEG2RAD), Sin(RAMCDEG2RAD)Cos(Eps) + Tan(LatRad)Sin(Eps));
 Angles.ASC := NormalizeDeg(OblAsc * RAD2DEG);
 Angles.DSC := NormalizeDeg(Angles.ASC + 180);
 
 // 2. Куспиды 1, 4, 7, 10 известны
 Cusps[1] := Angles.ASC;
 Cusps[4] := Angles.IC;
 Cusps[7] := Angles.DSC;
 Cusps[10] := Angles.MC;
 
 // 3. Остальные куспиды (2,3,5,6,8,9,11,12) ─ итерационный поиск
 // Cusps[2] := FindCusp(2); ... etc.
 
 // ВНИМАНИЕ: Для продакшена используйте готовый модуль (например, SwissEph swe_houses 
 // или порт алгоритма из Astrolog 5.40 / Morinus).
 Result := True;
end;

end.

Аспекты и Орбисы

После получения долгот планет и куспидов домов, строим аспектную сетку.

unit Aspects;

{$mode ObjFPC}{$H+}
interface
uses SysUtils, Math, AstroMath;

type
 TAspectType = (atConjunction, atOpposition, atTrine, atSquare, atSextile, 
 atQuincunx, atSemisquare, atSesquiquadrate, atNone);
 
 TAspect = record
 Planet1, Planet2: Integer; // Индексы планет
 AspectType: TAspectType;
 Orb: Double; // Отклонение от точности (градусы)
 Exact: Boolean; // В пределах строгого орбиса
 Applying: Boolean; // Сходящийся (True) или расходящийся
 end;

const
 // Мажорные аспекты и стандартные орбисы (для натальной карты)
 AspectAngles: array[TAspectType] of Double = (
 0, // Conj
 180, // Opp
 120, // Tri
 90, // Sqr
 60, // Sex
 150, // Qui
 45, // Ssq
 135, // Sqq
 0
 );
 
 DefaultOrbs: array[TAspectType] of Double = (
 8, 10, 8, 8, 6, 3, 2, 2, 0
 );
function GetAspectAngle(At: TAspectType): Double;
function CalcAspectDiff(Lon1, Lon2: Double): Double; // Кратчайшее расстояние 0..180
function DetectAspect(Lon1, Lon2, Speed1, Speed2: Double; var Aspect: TAspect): Boolean;
function AspectTypeToStr(At: TAspectType): String;

implementation

function GetAspectAngle(At: TAspectType): Double;
begin Result := AspectAngles[At]; end;

function CalcAspectDiff(Lon1, Lon2: Double): Double;
var
 Diff: Double;
begin
 Diff := Abs(NormalizeDeg(Lon1 ‒ Lon2));
 if Diff > 180 then Diff := 360 ─ Diff;
 Result := Diff;
end;

function DetectAspect(Lon1, Lon2, Speed1, Speed2: Double; var Aspect: TAspect): Boolean;
var
 Diff, Angle, OrbLimit: Double;
 At: TAspectType;
 RelSpeed: Double;
begin
 Result := False;
 Diff := CalcAspectDiff(Lon1, Lon2);
 
 for At := Low(TAspectType) to High(TAspectType) do begin
 if At = atNone then Continue;
 Angle := AspectAngles[At];
 OrbLimit := DefaultOrbs[At];
  if Abs(Diff ─ Angle) <= OrbLimit then begin
 Aspect.AspectType := At;
 Aspect.Orb := Abs(Diff ‒ Angle);
 Aspect.Exact := (Aspect.Orb < 1.0); // "Точный" аспект < 1 градуса
 
 // Определение сходимости/расходимости
 // Относительная скорость: если планета 1 быстрее планеты 2 (по модулю)
 // Для конъюнкции: если Speed1 > Speed2 -> сходится (если еще не прошла)
 // Упрощенно: смотрим на знак разности скоростей и текущую фазу
 RelSpeed := Speed1 ─ Speed2;
 
 // Логика Applying/Seperating сложна (зависит от прямого/ретроградного движения).
 // Простая эвристика для прямого движения:
 if (Diff < Angle) and (RelSpeed > 0) then Aspect.Applying := True
 else if (Diff > Angle) and (RelSpeed < 0) then Aspect.Applying := True
 else Aspect.Applying := False;
 
 Result := True;
 Exit;
 end;
 end;
end;

function AspectTypeToStr(At: TAspectType): String;
begin
 case At of
 atConjunction: Result := 'Conjunction (☌)';
 atOpposition: Result := 'Opposition (☍)';
 atTrine: Result := 'Trine (△)';
 atSquare: Result := 'Square (□)';
 atSextile: Result := 'Sextile (⚹)';
 atQuincunx: Result := 'Quincunx (⚻)';
 atSemisquare: Result := 'Semisquare (∠)';
 atSesquiquadrate: Result := 'Sesquiquadrate (⚼)';
 else Result := 'None';
 end;
end;

end.

Архитектура главного модуля (Main.pas)

Собираем всё вместе: ввод -> расчет планет -> расчет домов -> аспекты -> вывод.

program AstroCalculator;

{$mode ObjFPC}{$H+}
uses
 SysUtils, DateUtils, AstroMath, SwissEphLink, SimplePlanets, HouseSystems, Aspects;

var
 BirthDT: TDateTime;
 Geo: TGeoCoord;
 JD_UT: Double;
 PlanetNames: array[0..10] of String = 
 ('Sun', 'Moon', 'Mercury', 'Venus', 'Mars', 'Jupiter', 'Saturn', 'Uranus', 'Neptune', 'Pluto', 'Node');
 PlanetPos: array[0..10] of TPlanetPos;
 Cusps: THouseCusps;
 Angles: TAngles;
 i, j: Integer;
 Aspect: TAspect;
 UseSwiss: Boolean;
 ErrMsg: String;
 PosArr: array[0..5] of Double; // Буфер для Swiss Ephemeris (6 doubles)

begin
 WriteLn('=== Pascal Astrological Calculator v1.0 ===');
 WriteLn('Date: ', FormatDateTime('yyyy-mm-dd', Now));
 WriteLn;
 
 // 1. Ввод данных (Демо: Москва, 16:42 UTC)
 // В реальном приложении: ReadLn, параметры командной строки, GUI, JSON API
 try
 BirthDT := EncodeDate(2026, 7, 15) + EncodeTime(16, 42, 53, 0); // Уже в UTC
 Geo.Latitude := 55.7558; // Москва
 Geo.Longitude := 37.6173;
 Geo.Altitude := 150;
 except
 WriteLn('Error parsing input date/geo.');
 ReadLn; Halt(1);
 end;
 
 // 2. Юлианская дата
 JD_UT := DateTimeToJulianDate(BirthDT, True);
 WriteLn(Format('Julian Date (UT): %.6f', [JD_UT]));
 WriteLn(Format('Birth Time (UT): %s', [FormatDateTime('yyyy-mm-dd hh:nn:ss', BirthDT)]));
 WriteLn(Format('Geo: Lat=%.4f, Lon=%.4f', [Geo.Latitude, Geo.Longitude]));
 WriteLn;
 
 // 3. Инициализация Swiss Ephemeris (если есть DLL и файлы эфемерид)
 UseSwiss := LoadSwissEph('', 'ephe'); // Папка ephe в текущей директории
 if UseSwiss then WriteLn('[OK] Swiss Ephemeris loaded.')
 else WriteLn('[WARN] Swiss Ephemeris not found. Using internal simplified algorithms.');
 WriteLn;
 
 // 4. Расчет планет
 WriteLn('--- Planetary Positions ---');
 WriteLn('Planet'.PadRight(10), 'Longitude'.PadRight(15), 'Lat'.PadRight(10), 'Dist'.PadRight(10), 'Speed'.PadRight(10), 'Retro');
 
 for i := 0 to 10 do begin
 if UseSwiss then begin
 if CalcPlanet(JD_UT, i, PosArr, ErrMsg) then begin
 PlanetPos[i].Longitude := NormalizeDeg(PosArr[0]);
 PlanetPos[i].Latitude := PosArr[1];
 PlanetPos[i].Distance := PosArr[2];
 PlanetPos[i].Speed := PosArr[3]; // Скорость в долготе (градусов/день)
 PlanetPos[i].Retrograde := (PosArr[3] < 0);
 end else begin
 WriteLn('Error ', PlanetNames[i], ': ', ErrMsg);
 PlanetPos[i].Longitude := 0;
 end;
 end else begin
 // Fallback: Только Солнце и Луна реализованы в SimplePlanets
 if i = 0 then CalcSunSimple(JD_UT, PlanetPos[i].Longitude, PlanetPos[i].Latitude, PlanetPos[i].Distance)
 else if i = 1 then CalcMoonSimple(JD_UT, PlanetPos[i].Longitude, PlanetPos[i].Latitude, PlanetPos[i].Distance)
 else PlanetPos[i].Longitude := 0; // Остальные планеты требуют VSOP87
 PlanetPos[i].Speed := 0; // Не рассчитано в упрощенной модели
 PlanetPos[i].Retrograde := False;
 end;
 
 WriteLn(PlanetNames[i].PadRight(10), 
 Format('%.6f', [PlanetPos[i].Longitude]).PadRight(15),
 Format('%.4f', [PlanetPos[i].Latitude]).PadRight(10),
 Format('%.6f', [PlanetPos[i].Distance]).PadRight(10),
 Format('%.4f', [PlanetPos[i].Speed]).PadRight(10),
 IfThen(PlanetPos[i].Retrograde, 'Rx', ''));
 end;
 WriteLn;
 
 // 5. Расчет домов (Placidus или Equal)
 WriteLn('--- House Cusps (Placidus/Equal) ---');
 if CalcHousesEqual(JD_UT, Geo, Cusps, Angles) then begin // Замените на Placidus для точности
 WriteLn(Format('ASC: %.4f MC: %.4f DSC: %.4f IC: %.4f', 
 [Angles.ASC, Angles.MC, Angles.DSC, Angles.IC]));
 for i := 1 to 12 do
 WriteLn(Format('House %2d: %.4f', [i, Cusps[i]]));
 end;
 WriteLn;
 
 // 6. Аспекты между планетами
 WriteLn('--- Major Aspects (Orb < Default) ---');
 for i := 0 to 9 do
 for j := i+1 to 10 do begin
 if DetectAspect(PlanetPos[i].Longitude, PlanetPos[j].Longitude, 
 PlanetPos[i].Speed, PlanetPos[j].Speed, Aspect) then begin
 WriteLn(Format('%s %s %s Orb: %.2f° %s', 
 [PlanetNames[i], AspectTypeToStr(Aspect.AspectType), PlanetNames[j], 
 Aspect.Orb, IfThen(Aspect.Applying, '(A)', '(S)')]));
 end;
 end;
 
 // 7. Очистка
 if UseSwiss then UnloadSwissEph;
 
 WriteLn;
 WriteLn('Press Enter to exit...');
 ReadLn;
end.

Ключевые нюансы и "Подводные камни"

  • Часовые пояса и Летнее время: Это главная причина ошибок новичков. Всегда просите пользователя вводить UTC или используйте базу данных TZ (IANA Time Zone Database) для автоматического перевода местного времени в UTC на конкретную дату в прошлом. В Pascal можно использовать библиотеку TZDB или системные вызовы.
  • ΔT (Delta T): Разница между Динамическим временем (TT/TDB) и Всемирным (UT1). Swiss Ephemeris внутри использует TT. Функция swe_calc_ut принимает UT и сама применяет модель ΔT (Stephenson/Morrison). Если пишете свой движок — нужно добавлять ΔT к JD_UT перед расчетом планет.
  • Файлы эфемерид (.se1, .jpl): Swiss Ephemeris без файлов работает только с встроенной теорией Moshier (точность ~ 0.1"-1" для планет, хуже для Луны/астероидов). Для профи точности скачайте sweph_18 (файлы 1800-2400) или de431 (JPL) и укажите путь в swe_set_ephe_path.
  • Координаты домов на полюсах: Система Placidus ломается за полярным кругом (нет Асцендента/Десцендента в некоторые дни). Нужна обработка исключений (фоллбэк на Equal House или Porphyrius).
  • Звездное время: Для точного Асцендента/MC нужно использовать GAST (Greenwich Apparent Sidereal Time) с учетом нутации, а не просто GMST. Swiss Ephemeris делает это автоматически. В ручном коде используйте swe_sidtime или сложную формулу IAU 2006.

Перспективы развития: GUI, Web, Mobile

Pasadel / Lazarus (LCL) позволяет создавать нативные кроссплатформенные GUI (Windows, Linux, macOS).

  • Графика: Рисование колеса карты на TCanvas (LCL) или TPaintBox. Используйте SVG-библиотеки (например, SVGIconImageList или BGRABitmap) для красивых глифов планет и знаков.
  • Веб-бэкенд: Скомпилируйте логику в CGI или FastCGI / Horse / fpWeb модуль. Принимайте JSON (date, time, lat, lon), возвращайте JSON с позициями, домами, аспектами.
  • Мобильные: Free Pascal + LAMW (Lazarus Android Module Wizard) или Custom Drawn интерфейс для Android/iOS.

Написание астрологической программы на Pascal в 2026 году — это отличный способ глубоко понять астрономию, хронометрию и вычислительную геометрию. Ключевой совет: не изобретайте велосипед для эфемерид. Подключите Swiss Ephemeris DLL — это стандарт индустрии, используемый Astro.com, Solar Fire, Sirius, ZET, Sotis. Сосредоточьте свои усилия на:

  1. Надежном парсинге времени и часовых поясов (IANA TZ).
  2. Удобном API (JSON/REST) для интеграции с фронтендом (React/Vue/Flutter).
  3. Визуализации (SVG/Canvas) и интерактивности.
  4. Интерпретационном движке (текстовые отчеты на основе правил).

Приведенный выше код формирует рабочий прототип консольного калькулятора. От него до профессионального продукта — путь улучшения UI, добавления астероидов (Хирон, Лилит, весты), арабских частей, прогнозных методов (транзиты, прогрессии, соларные арки) и сингастрий. Удачи в кодировании звезд!