Создание собственной астрологической программы — это классическая задача, объединяющая астрономию, математику и программирование. Несмотря на возраст языка, Pascal (и его современные диалекты: Free Pascal, Delphi, Lazarus) отлично подходит для этой цели благодаря строгой типизации, читаемому синтаксису и мощным математическим библиотекам. В этой статье мы разберем полный цикл разработки: от астрономических основ до готового кода расчета натальной карты.
Фундаментальная теория: что считаем?
Прежде чем писать код, нужно четко понимать алгоритм. Натальная карта — это проекция небесной сферы на плоскость эклиптики на конкретный момент времени и место. Основные вычислительные этапы:
- Ввод данных: Дата, время (UTC), географические координаты (широта, долгота).
- Временные шкалы: Перевод местного времени в UT (Universal Time), затем в TD (Dynamical Time / Ephemeris Time) с учетом ΔT.
- Юлианская дата (JD): Единый счетчик дней для астрономических расчетов.
- Координаты планет: Расчет геоцентрических эклиптических долгот (λ) и широт (β) для Солнца, Луны, планет.
- Система домов: Расчет куспидов домов (Placidus, Koch, Equal, Regiomontanus и др.).
- Аспекты: Поиск угловых расстояний между планетами (конъюнкция, оппозиция, трин, квадрат, секстиль).
Источники эфемерид: 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. Точность ниже (секунды/минуты дуги), но зависимостей нет.
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. Сосредоточьте свои усилия на:
- Надежном парсинге времени и часовых поясов (IANA TZ).
- Удобном API (JSON/REST) для интеграции с фронтендом (React/Vue/Flutter).
- Визуализации (SVG/Canvas) и интерактивности.
- Интерпретационном движке (текстовые отчеты на основе правил).
Приведенный выше код формирует рабочий прототип консольного калькулятора. От него до профессионального продукта — путь улучшения UI, добавления астероидов (Хирон, Лилит, весты), арабских частей, прогнозных методов (транзиты, прогрессии, соларные арки) и сингастрий. Удачи в кодировании звезд!