Тема: Tesseract By The Trick
Четырёхмерный гиперкуб(тессеракт), который можно покрутить, двигая ползунки.
Кнопки "Z" — обнулить скорость, кнопки "R" — сброс трансформаций.
Оригинальная версия была написана на Visual Basic 6, её можно найти здесь.
Автор оригинала — Кривоус Анатолий Анатольевич (The Trick).
Я решил, используя эти исходники, переписать приложение на Delphi и таким образом перенести его на KolibriOS.
program TesseractByTheTrick;
uses
KolibriOS;
function MemoryAllocate(Bytes: LongWord): Pointer; stdcall;
asm
push ecx
push ebx
mov eax, 68
mov ebx, 12
mov ecx, Bytes
int 64
pop ebx
pop ecx
end;
function MemoryReallocate(MemPtr: Pointer; Bytes: LongWord): Pointer; stdcall;
asm
push ebx
push ecx
push edx
mov eax, 68
mov ebx, 20
mov ecx, Bytes
mov edx, MemPtr
int 64
pop edx
pop ecx
pop ebx
end;
function MemoryFree(MemPtr: Pointer): LongWord; stdcall;
asm
push ecx
push ebx
mov eax, 68
mov ebx, 13
mov ecx, MemPtr
int 64
pop ebx
pop ecx
end;
type
Proc = procedure;
procedure InitLibrary(LibInit: Proc); stdcall;
const
LIB_PATH = '/sys/lib/';
type
PNameAddr = ^TNameAddr;
TNameAddr = packed record
Name: PAnsiChar;
Addr: Pointer;
end;
PAddrName = ^TAddrName;
TAddrName = packed record
Addr: Pointer;
Name: PAnsiChar;
end;
function StrEqual(Str1, Str2: PAnsiChar): Boolean;
begin
while (Str1^ = Str2^) and (Str1^ <> #0) do
begin
Inc(Str1);
Inc(Str2);
end;
Result := Str1^ = Str2^;
end;
procedure StrCopy(StrFrom, StrTo: PAnsiChar);
begin
while (StrFrom^ <> #0) do
begin
StrTo^ := StrFrom^;
Inc(StrFrom);
Inc(StrTo);
end;
end;
function DLLLoad(ImportTable: PAddrName): LongInt; stdcall;
var
ExportTable: PNameAddr;
ProcAddr: Pointer;
Name: PPAnsiChar;
LibPath: array [0..32] of AnsiChar;
begin
Result := 1;
StrCopy(LIB_PATH, LibPath);
while ImportTable.Addr <> nil do
begin
StrCopy(ImportTable.Name, Pointer(LongInt(@LibPath) + Length(LIB_PATH)));
ExportTable := LoadLibrary(LibPath);
if ExportTable = nil then
Exit;
Name := PPAnsiChar(ImportTable.Addr);
while Name^ <> nil do
begin
ProcAddr := GetProcAddress(ExportTable, Name^);
if ProcAddr <> nil then
Pointer(Name^) := ProcAddr
else
Exit;
Inc(Name);
end;
if StrEqual(ExportTable.Name, 'lib_init') then
InitLibrary(ExportTable.Addr);
Inc(ImportTable);
end;
Result := 0;
end;
asm
pushad
mov eax, offset MemoryAllocate
mov ebx, offset MemoryFree
mov ecx, offset MemoryReallocate
mov edx, offset DLLLoad
call LibInit
popad
end;
const
WINDOW_BORDER_SIZE = 5;
BACK_COLOR = $00000000;
FORE_COLOR = $0000C000;
BUTTON_RESET_ALL = 555;
BUTTON_ZERO0 = 1000;
BUTTON_ZERO1 = 1001;
BUTTON_ZERO2 = 1002;
BUTTON_ZERO3 = 1003;
BUTTON_ZERO4 = 1004;
BUTTON_ZERO5 = 1005;
BUTTON_RESET0 = 2000;
BUTTON_RESET1 = 2001;
BUTTON_RESET2 = 2002;
BUTTON_RESET3 = 2003;
BUTTON_RESET4 = 2004;
BUTTON_RESET5 = 2005;
type
PBuf2DBuffer = ^TBuf2DBuffer;
TBuf2DBuffer = packed record
Img: Pointer;
Left: SmallInt;
Top: SmallInt;
Width: LongWord;
Height: LongWord;
Color: LongWord;
BPP: Byte;
end;
PScrollbar = ^TScrollbar;
TScrollbar = packed record
size_x : SmallInt;
start_x : SmallInt;
size_y : SmallInt;
start_y : SmallInt;
btn_high : LongInt; // высота боковых кнопок (левая и правая для гориз. и верхняя и нижняя для верт.)
type_ : LongInt;
max_area : LongInt; // область максимальная, актуально когда не влазит в отображаемую область, т.е. случай активности компонента. (весь максимальный размер документа)
cur_area : LongInt; // область отображаемая (какая часть документа влазит в экран)
position : LongInt; // позиция бегунка изменяемая от 0 до значения x=(max_area-cur_area)
bckg_col : LongInt; // цвет внутренний, применяется для областей между бегунком и кноками
frnt_col : LongInt; // цвет наружный, применяется для областей отличных от применяемых в bckg_col
line_col : LongInt; // цвет линий и стрелок на кнопках
redraw : LongInt; // индикатор необходимости перерисовки управляемой области учитывая изменение position и cur_area
delta : SmallInt;
delta2 : SmallInt; // индикатор захвата фокуса скроллбаром (удержание бегунка)
r_size_x : SmallInt;
r_start_x : SmallInt;
r_size_y : SmallInt;
r_start_y : SmallInt;
m_pos : LongInt;
m_pos_2 : LongInt;
m_keys : LongInt;
run_size : LongInt;
position2 : LongInt;
work_size : LongInt;
all_redraw : LongInt; // флаг устанавливаемый в 1 для перерисовки всего компонента, если поставить 0, то перерисовка происходит только для области бегунка
ar_offset : LongInt; // величина смещения при однократном нажатии боковой кнопки
end;
PPOptionBox = ^POptionBox;
POptionBox = ^TOptionBox;
TOptionBox = packed record
option_group: PPOptionBox;
left: SmallInt; // положение по х
top: SmallInt; // положение по у
ch_text_margin: LongWord; // расстояние от прямоугольника чекбокса до надписи
ch_size: LongWord; // размер квадрата чекбокса
color: LongWord; // цвет внутри чекбокса
border_color: LongWord; // цвет рамки
text_color: LongWord; // цвет надписи
text: PAnsiChar; // адрес в коде программы, где расположен текст
ch_text_length: LongWord; // длина строки с символами
flags: LongWord; // флаги
end;
var
Buf2D: Pointer;
Buf2DLibInit: procedure;
buf2d_create: procedure(var Buffer: TBuf2DBuffer); stdcall;
buf2d_draw: procedure(var Buffer: TBuf2DBuffer); stdcall;
buf2d_clear: procedure(var Buffer: TBuf2DBuffer; Color: LongWord); stdcall;
buf2d_set_pixel: procedure(var Buffer: TBuf2DBuffer; X, Y: LongInt; Color: LongWord); stdcall;
buf2d_line: procedure(var Buffer: TBuf2DBuffer; X1, Y1, X2, Y2: LongInt; Color: LongWord); stdcall;
BoxLib: Pointer;
scrollbar_h_draw: procedure(var Scrollbar: TScrollbar); stdcall;
scrollbar_h_mouse: procedure(var Scrollbar: TScrollbar); stdcall;
option_box_draw: procedure(var OptionBox: POptionBox); stdcall;
option_box_mouse: procedure(var OptionBox: POptionBox); stdcall;
OptionGroup1: POptionBox;
Option1: TOptionBox = (
option_group: @OptionGroup1;
left: 416;
top: 236;
ch_text_margin: 4;
ch_size: 16;
color: $00FFFFFF;
border_color: $00000000;
text: 'Perspective 4D';
ch_text_length: Length('Perspective 4D');
flags: 0);
Option2: TOptionBox = (
option_group: @OptionGroup1;
left: 416;
top: 260;
ch_text_margin: 4;
ch_size: 16;
color: $00FFFFFF;
border_color: $00000000;
text: 'Parallel 4D';
ch_text_length: Length('Parallel 4D');
flags: 0);
OptionBoxes1: array [0..2{count}] of POptionBox = (@Option1, @Option2, nil);
sldDist: TScrollbar = (
size_x: 120;
start_x: 480;
size_y: 17;
start_y: 180;
btn_high: 17;
type_: 1;
max_area: 300;
cur_area: 10;
position: 120;
ar_offset: 1);
sldFOV: TScrollbar = (
size_x: 120;
start_x: 480;
size_y: 17;
start_y: 210;
btn_high: 17;
type_: 1;
max_area: 250;
cur_area: 10;
position: 90;
ar_offset: 1);
sldRotateSpd0: TScrollbar = (
size_x: 120;
start_x: 480;
size_y: 17;
start_y: 18;
btn_high: 17;
type_: 1;
max_area: 200;
cur_area: 0;
position: 100;
ar_offset: 1);
sldRotateSpd1: TScrollbar = (
size_x: 120;
start_x: 480;
size_y: 17;
start_y: 45;
btn_high: 17;
type_: 1;
max_area: 200;
cur_area: 0;
position: 100;
ar_offset: 1);
sldRotateSpd2: TScrollbar = (
size_x: 120;
start_x: 480;
size_y: 17;
start_y: 72;
btn_high: 17;
type_: 1;
max_area: 200;
cur_area: 0;
position: 100;
ar_offset: 1);
sldRotateSpd3: TScrollbar = (
size_x: 120;
start_x: 480;
size_y: 17;
start_y: 99;
btn_high: 17;
type_: 1;
max_area: 200;
cur_area: 0;
position: 100;
ar_offset: 1);
sldRotateSpd4: TScrollbar = (
size_x: 120;
start_x: 480;
size_y: 17;
start_y: 126;
btn_high: 17;
type_: 1;
max_area: 200;
cur_area: 0;
position: 100;
ar_offset: 1);
sldRotateSpd5: TScrollbar = (
size_x: 120;
start_x: 480;
size_y: 17;
start_y: 153;
btn_high: 17;
type_: 1;
max_area: 200;
cur_area: 0;
position: 100;
ar_offset: 1);
sldRotateSpd: array [0..5] of PScrollbar = (
@sldRotateSpd0, @sldRotateSpd1, @sldRotateSpd2, @sldRotateSpd3, @sldRotateSpd4, @sldRotateSpd5);
WndLeft, WndTop: LongInt;
WndWidth: LongWord;
WndHeight: LongWord;
Buf2DBuffer: TBuf2DBuffer = (Left: 6; Top: 9; Color: BACK_COLOR; BPP: 24); // определяем 24-битный буфер с цветом фона BACK_COLOR
SC: TStandardColors;
ButtonID: LongWord;
ThreadInfo: TThreadInfo;
function Sin(Value: Extended): Extended;
asm
FLD Value
FSIN
end;
function Cos(Value: Extended): Extended;
asm
FLD Value
FCOS
end;
function Tan(Value: Extended): Extended;
asm
FLD Value
FPTAN
FSTP ST(0)
end;
function Round(Value: Extended): Int64;
asm
FLD Value
SUB ESP, 8
FISTP qword ptr [ESP]
POP EAX
POP EDX
end;
function IntToStr(Number: LongInt; Buffer: PAnsiChar): LongWord;
asm
push edi
push ebx
xor ebx, ebx
mov edi, Buffer
test eax, eax
jns @L1
mov ebx, '-'
neg eax
@L1:
push 0
mov ecx, 10
@L0:
xor edx, edx
div ecx
add edx, 48
push edx
test eax, eax
jnz @L0
or edx, -1
test ebx, ebx
jz @L2
mov al, bl
stosb
inc edx
@L2:
inc edx
pop eax
stosb
test eax, eax
jnz @L2
mov eax, edx // return count
pop ebx
pop edi
end;
procedure FillChar(var Dest; Count: LongInt; Value: AnsiChar);
var
i: LongInt;
begin
for i := 0 to Count - 1 do
PAnsiChar(@Dest)[i] := Value;
end;
function Sgn(Value: Extended): LongInt;
begin
if Value > 0 then
Result := +1
else
if Value < 0 then
Result := -1
else
Result := 0;
end;
function RGB(R, G, B: LongWord): LongWord;
type
TRGB = packed record
case Boolean of
True: (Blue, Green, Red: Byte);
False: (Value: LongWord);
end;
begin
if R > 255 then R := 255;
if G > 255 then G := 255;
if B > 255 then B := 255;
with TRGB(Result) do
begin
Red := R;
Green := G;
Blue := B;
end;
end;
// -------------------------------------------------------------------------- //
// Гиперкуб (тессеракт), просмотр проекции 4-хмерного гиперкуба на 2-х мерное пространство экрана.
// Автор: Кривоус Анатолий Анатольевич (The trick) 2013
// Возможность вращения по 6-ти осям (в 6-ти плоскостях), 3-х обычных трехмерных и 3-комбинированных (XT,YT,ZT) (T-ось четвертого измерения)
// Регулировка дистанции по оси Z (по оси T фиксированно 2), угла обзора для 3D
// Гиперкуб имеет размеры (0.5,0.5,0.5,0.5), центр в точке (0,0,0,2)
// Для проекции 4D->3D, имеется возможность переключать тип проекции с параллельной в перспективную
// Темные и малые вершины, находяться "глубже" по оси T, чем светлые
// Кнопками Z-зануляется скорость вращения по оси, кнопкам R сбрасывается поворот на 0 грудусов.
type
Vector4D = record // Четырехмерный вектор
X: Single;
Y: Single;
Z: Single;
t: Single;
w: Single;
end;
Quad = record
P: array [0..3] of Vector4D; // Квадрат
end;
Cube = record
P: array [0..3] of Quad; // Куб
end;
TMatrix = array [0..4, 0..4] of Single;
const
PI2 = PI * 2;
var
XY, ZX, ZY, ZT, XT, YT: Single; // Углы поворота
Tesseract: array [0..3] of Cube; // 4 куба граней тессеракта
function Vec4(X, Y, Z, t: Single): Vector4D; // Создание вектора
begin
Vec4.X := X; Vec4.Y := Y; Vec4.Z := Z; Vec4.t := t; Vec4.w := 1;
end;
function Vec4Add(Vec1, Vec2: Vector4D): Vector4D; // Сложение векторов
begin
with Result do
begin
X := Vec1.X + Vec2.X; Y := Vec1.Y + Vec2.Y; Z := Vec1.Z + Vec2.Z; t := Vec1.t + Vec2.t; w := 1;
end;
end;
function Vec4Sub(Vec1, Vec2: Vector4D): Vector4D; // Разность векторов
begin
with Result do
begin
X := Vec1.X - Vec2.X; Y := Vec1.Y - Vec2.Y; Z := Vec1.Z - Vec2.Z; t := Vec1.t - Vec2.t; w := 1;
end;
end;
procedure Identity4d(var Out: TMatrix); // Единичная матрица 5х5
var
i, j: LongInt;
begin
for i := 0 to 4 do
for j := 0 to 4 do
if i = j then
Out[i, j] := 1
else
Out[i, j] := 0;
end;
procedure Translation4D(X, Y, Z, t: Single; var Out: TMatrix); // Перенос
begin
Identity4d(Out); Out[4, 0] := X; Out[4, 1] := Y; Out[4, 2] := Z; Out[4, 3] := t;
end;
procedure Rotation4DXY(Angle: Double; var Out: TMatrix); // Вращение в плоскости XY
var
C, S: Single;
begin
C := Cos(Angle); S := Sin(Angle); Identity4d(Out);
Out[0, 0] := C; Out[1, 0] := S; Out[0, 1] := -S; Out[1, 1] := C;
end;
procedure Rotation4DZY(Angle: Double; var Out: TMatrix); // Вращение в плоскости ZY
var
C, S: Single;
begin
C := Cos(Angle); S := Sin(Angle); Identity4d(Out);
Out[1, 1] := C; Out[2, 1] := S; Out[1, 2] := -S; Out[2, 2] := C;
end;
procedure Rotation4DZX(Angle: Double; var Out: TMatrix); // Вращение в плоскости ZX
var
C, S: Single;
begin
C := Cos(Angle); S := Sin(Angle); Identity4d(Out);
Out[0, 0] := C; Out[0, 2] := S; Out[2, 0] := -S; Out[2, 2] := C;
end;
procedure Rotation4DXT(Angle: Double; var Out: TMatrix); // Вращение в плоскости XT
var
C, S: Single;
begin
C := Cos(Angle); S := Sin(Angle); Identity4d(Out);
Out[0, 0] := C; Out[0, 3] := S; Out[3, 0] := -S; Out[3, 3] := C;
end;
procedure Rotation4DYT(Angle: Double; var Out: TMatrix); // Вращение в плоскости YT
var
C, S: Single;
begin
C := Cos(Angle); S := Sin(Angle); Identity4d(Out);
Out[1, 1] := C; Out[3, 1] := -S; Out[1, 3] := S; Out[3, 3] := C;
end;
procedure Rotation4DZT(Angle: Double; var Out: TMatrix); // Вращение в плоскости ZT
var
C, S: Single;
begin
C := Cos(Angle); S := Sin(Angle); Identity4d(Out);
Out[2, 2] := C; Out[3, 2] := -S; Out[3, 3] := S; Out[3, 3] := C;
end;
procedure Projection(FOV, w, h, F, N: Single; var Out: TMatrix); // Матрица проекции
var
h_, w_, a_, b_: Single;
i, j: LongInt;
begin
for i := 0 to 4 do
for j := 0 to 4 do
Out[i, j] := 0;
h_ := 1 / Tan(FOV / 2); w_ := h_ / (w / h);
a_ := F / (F - N);
b_ := -N * F / (F - N);
Out[0, 0] := h_; Out[1, 1] := w_; Out[2, 2] := a_; Out[2, 3] := b_; Out[3, 2] := 1;
end;
procedure MultiplyTransform(var Out, Op1, Op2: TMatrix); // Умножение 2-х матриц
var
Tmp: TMatrix; i, j, k: LongInt;
begin
for i := 0 to 4 do
for j := 0 to 4 do
Tmp[i, j] := 0;
for j := 0 to 4 do for i := 0 to 4 do
for k := 0 to 4 do
Tmp[i, j] := Tmp[i, j] + Op1[k, j] * Op2[i, k];
for i := 0 to 4 do
for j := 0 to 4 do
Out[i, j] := Tmp[i, j];
end;
function TransformVec4D(const V: Vector4D; const Transform: TMatrix): Vector4D; // Трансформация вектора
begin
with Result do
begin
X := V.X * Transform[0, 0] + V.Y * Transform[1, 0] + V.Z * Transform[2, 0] + V.t * Transform[3, 0] + V.w * Transform[4, 0];
Y := V.X * Transform[0, 1] + V.Y * Transform[1, 1] + V.Z * Transform[2, 1] + V.t * Transform[3, 1] + V.w * Transform[4, 1];
Z := V.X * Transform[0, 2] + V.Y * Transform[1, 2] + V.Z * Transform[2, 2] + V.t * Transform[3, 2] + V.w * Transform[4, 2];
t := V.X * Transform[0, 3] + V.Y * Transform[1, 3] + V.Z * Transform[2, 3] + V.t * Transform[3, 3] + V.w * Transform[4, 3];
w := V.X * Transform[0, 4] + V.Y * Transform[1, 4] + V.Z * Transform[2, 4] + V.t * Transform[3, 4] + V.w * Transform[4, 4];
end;
end;
// Создание квадрата по трем точкам
function CreateQuad(Pos1, Pos2, Pos3: Vector4D): Quad;
begin
CreateQuad.P[0] := Pos1;
CreateQuad.P[1] := Pos2;
CreateQuad.P[3] := Pos3;
CreateQuad.P[2] := Vec4(Pos2.X + Pos3.X - Pos1.X, Pos2.Y + Pos3.Y - Pos1.Y,
Pos2.Z + Pos3.Z - Pos1.Z, Pos2.t + Pos3.t - Pos1.t);
end;
// Создание куба по 3-м граням верняя левая в глубину точка Pos, Dir - направления от этой точки
function CreateCube(Pos, Dir1, Dir2, Dir3: Vector4D): Cube;
begin
with Result do
begin
P[0] := CreateQuad(Pos, Vec4Add(Pos, Dir1), Vec4Add(Pos, Dir2));
P[1] := CreateQuad(P[0].P[1], Vec4Add(P[0].P[1], Dir3), P[0].P[2]);
P[2] := CreateQuad(P[1].P[1], Vec4Sub(P[1].P[1], Dir1), P[1].P[2]);
P[3] := CreateQuad(P[2].P[1], Pos, Vec4Add(P[2].P[1], Dir2));
end;
end;
procedure cmdReset_Click(Index: LongInt); // Сброс трансформаций
begin
case Index of
0: XY := 0;
1: ZX := 0;
2: ZY := 0;
3: ZT := 0;
4: XT := 0;
5: YT := 0;
end;
end;
procedure cmdResetAll_Click; // Сброс всех трансформаций
begin
XY := 0; ZX := 0; ZY := 0; ZT := 0; XT := 0; YT := 0;
end;
procedure cmdZero_Click(Index: LongInt); // Обнулить скорость
begin
sldRotateSpd[Index].position := 100;
scrollbar_h_draw(sldRotateSpd[Index]^);
end;
procedure Form_Load;
begin
// Создаем тессеракт
Tesseract[0] := CreateCube(Vec4(-0.5, 0.5, 0.5, -0.5), Vec4(1, 0, 0, 0), Vec4(0, 0, -1, 0), Vec4(0, -1, 0, 0));
Tesseract[1] := CreateCube(Vec4(-0.5, 0.5, 0.5, 0.5), Vec4(1, 0, 0, 0), Vec4(0, 0, -1, 0), Vec4(0, -1, 0, 0));
Tesseract[2] := CreateCube(Vec4(-0.5, 0.5, 0.5, -0.5), Vec4(1, 0, 0, 0), Vec4(0, 0, -1, 0), Vec4(0, 0, 0, 1));
Tesseract[3] := CreateCube(Vec4(-0.5, -0.5, 0.5, 0.5), Vec4(1, 0, 0, 0), Vec4(0, 0, -1, 0), Vec4(0, 0, 0, -1));
end;
procedure DrawFilledCircle(CX, CY, R, FillColor: LongInt);
var
X, Y: LongInt;
begin
for Y := -R to R do
for X := -R to R do
if X * X + Y * Y - R * R <= 0 then
buf2d_set_pixel(Buf2DBuffer, CX + X, CY + Y, FillColor)
else
if X * X + Y * Y - R * R <= R then
buf2d_set_pixel(Buf2DBuffer, CX + X, CY + Y, (FillColor shr 1) and $007F7F7F);
end;
procedure Circle(FillColor, X, Y, R: LongInt);
begin
DrawFilledCircle(X + R, Y - R, R, FillColor);
end;
procedure tmrRefresh_Timer;
var
Wrld, Tmp: TMatrix; // Матрицы преобразований
C, Q, V: LongInt; // Кубы, квадраты, векторы
Out4D: Vector4D; // Результирующий вектор
X, Y, Sx, Sy, t: Single;
InfoBuffer: array [0..16] of AnsiChar; // для вывода текущих значений
CurrentX, CurrentY: LongInt; // текущее положение в буфере Buf2D, меняется после проведения линии
begin
XY := XY + (sldRotateSpd[0].position - 100) / 1000; // Прибавляем приращение к каждому углу
ZX := ZX + (sldRotateSpd[1].position - 100) / 1000; // ///
ZY := ZY + (sldRotateSpd[2].position - 100) / 1000; // ///
ZT := ZT + (sldRotateSpd[3].position - 100) / 1000; // ///
XT := XT + (sldRotateSpd[4].position - 100) / 1000; // ///
YT := YT + (sldRotateSpd[5].position - 100) / 1000; // ///
Translation4D(0, 0, (sldDist.position + sldDist.cur_area) / 100, 2, Wrld); // Сдвигаем от камеры на величину Distance
Rotation4DXY(XY, Tmp); // Вычисляем матрицу поворота
MultiplyTransform(Wrld, Wrld, Tmp); // Комбинируем трансформации
Rotation4DZX(ZX, Tmp);
MultiplyTransform(Wrld, Wrld, Tmp);
Rotation4DZY(ZY, Tmp);
MultiplyTransform(Wrld, Wrld, Tmp);
Rotation4DZT(ZT, Tmp);
MultiplyTransform(Wrld, Wrld, Tmp);
Rotation4DXT(XT, Tmp);
MultiplyTransform(Wrld, Wrld, Tmp);
Rotation4DYT(YT, Tmp);
MultiplyTransform(Wrld, Wrld, Tmp);
if Abs(XY) > PI2 then XY := XY - Sgn(XY) * PI2; // Ограничиваем промежутком 0..2Pi
if Abs(ZX) > PI2 then ZX := ZX - Sgn(ZX) * PI2;
if Abs(ZY) > PI2 then ZY := ZY - Sgn(ZY) * PI2;
if Abs(ZT) > PI2 then ZT := ZT - Sgn(ZT) * PI2;
if Abs(XT) > PI2 then XT := XT - Sgn(XT) * PI2;
if Abs(YT) > PI2 then YT := YT - Sgn(YT) * PI2;
Projection((sldFOV.position + sldFOV.cur_area) / 100, 1, 1, 0.1, 3.5, Tmp); // Вычисляем матрицу проекции 3D -> 2D
for C := 0 to High(Tesseract) do
for Q := 0 to 3 do
begin
for V := 0 to 3 do // Проход по всем вершинам
begin
Out4D := TransformVec4D(Tesseract[C].P[Q].P[V], Wrld); // Трансформируем в мировые координаты
t := Out4D.t; // Для цвета сохраняем
if OptionGroup1 = @Option1 then // Перспективная проекция 4D -> 3D
Out4D := Vec4(Out4D.X / (Out4D.t * 15), Out4D.Y / (Out4D.t * 15), Out4D.Z, 1)
else // Параллельная проекция 4D -> 3D
Out4D := Vec4(Out4D.X / 37.5, Out4D.Y / 37.5, Out4D.Z, 1);
Out4D := TransformVec4D(Out4D, Tmp); // Проецируем на плоскость
if (Out4D.Z > 0) And (Out4D.Z < 1) then // Если глубина в пределах 0.1-3.5 то отрисовываем
begin
X := Buf2DBuffer.Width * (1 + Out4D.X / Out4D.t) / 2; // Перевод в координаты PictureBox'а
Y := Buf2DBuffer.Height * (1 - Out4D.Y / Out4D.t) / 2;
if LongBool(V) then // Если не первая точка квадрата то рисуем линиию и круг
begin
buf2d_line(Buf2DBuffer, CurrentX, CurrentY, Round(X), Round(Y), FORE_COLOR);
CurrentX := Round(X);
CurrentY := Round(Y);
// Цвет в зависимости от глубины по координате T
DrawFilledCircle(Round(X), Round(Y), Round((4 - t) * 3), RGB(Round(64 + (3 - t) * 192), 0, 0));
end
else // Иначе переносим текущие координаты, для начала отрисовки
begin
CurrentX := Round(X); Sx := X;
CurrentY := Round(Y); Sy := Y;
end;
end;
end;
// Замыкаем квадрат
buf2d_line(Buf2DBuffer, CurrentX, CurrentY, Round(Sx), Round(Sy), FORE_COLOR);
end;
InfoBuffer[SizeOf(InfoBuffer) - 1] := #0;
FillChar(InfoBuffer, SizeOf(InfoBuffer) - 1, ' ');
InfoBuffer[IntToStr(Round(XY / PI2 * 360), InfoBuffer)] := ' ';
DrawText(417, 293, 'XY: ', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(417 + Length('XY: ') * 8, 293, InfoBuffer, SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
FillChar(InfoBuffer, SizeOf(InfoBuffer) - 1, ' ');
InfoBuffer[IntToStr(Round(ZX / PI2 * 360), InfoBuffer)] := ' ';
DrawText(417, 310, 'ZX: ', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(417 + Length('ZX: ') * 8, 310, InfoBuffer, SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
FillChar(InfoBuffer, SizeOf(InfoBuffer) - 1, ' ');
InfoBuffer[IntToStr(Round(ZY / PI2 * 360), InfoBuffer)] := ' ';
DrawText(417, 327, 'ZY: ', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(417 + Length('ZY: ') * 8, 327, InfoBuffer, SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
FillChar(InfoBuffer, SizeOf(InfoBuffer) - 1, ' ');
InfoBuffer[IntToStr(Round(ZT / PI2 * 360), InfoBuffer)] := ' ';
DrawText(417, 344, 'ZT: ', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(417 + Length('ZT: ') * 8, 344, InfoBuffer, SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
FillChar(InfoBuffer, SizeOf(InfoBuffer) - 1, ' ');
InfoBuffer[IntToStr(Round(XT / PI2 * 360), InfoBuffer)] := ' ';
DrawText(417, 361, 'XT: ', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(417 + Length('XT: ') * 8, 361, InfoBuffer, SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
FillChar(InfoBuffer, SizeOf(InfoBuffer) - 1, ' ');
InfoBuffer[IntToStr(Round(YT / PI2 * 360), InfoBuffer)] := ' ';
DrawText(417, 378, 'YT: ', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(417 + Length('YT: ') * 8, 378, InfoBuffer, SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
end;
// -------------------------------------------------------------------------- //
procedure On_Idle;
begin
tmrRefresh_Timer;
buf2d_draw(Buf2DBuffer); // выводим на экран
buf2d_clear(Buf2DBuffer, BACK_COLOR); // закрашиваем буфер цветом фона
end;
procedure On_Redraw;
begin
BeginDraw;
GetStandardColors(SC, SizeOf(TStandardColors));
GetThreadInfo($FFFFFFFF, ThreadInfo);
DrawWindow(WndLeft, WndTop, WndWidth, WndHeight, 'Tesseract by The Trick', SC.Work,
WS_SKINNED_FIXED + WS_CLIENT_COORDS + WS_CAPTION, CAPTION_MOVABLE);
Option1.text_color := SC.WorkText + DT_CP866_8x16;
Option2.text_color := SC.WorkText + DT_CP866_8x16;
option_box_draw(OptionBoxes1[0]);
DrawText(414, 19, 'XY:', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(414, 46, 'ZX:', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(414, 73, 'ZY:', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(414, 100, 'ZT:', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(414, 127, 'XT:', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(414, 154, 'YT:', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(414, 181, 'Distance:', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
DrawText(414, 211, 'FOV:', SC.WorkText, SC.Work, DT_ZSTRING + DT_CP866_8x16 + DT_FILL_OPAQUE, 0);
with sldDist do
begin
bckg_col := SC.WorkGraph;
frnt_col := SC.Work3DDark;
line_col := SC.Work;
all_redraw := 0;
end;
with sldFOV do
begin
bckg_col := SC.WorkGraph;
frnt_col := SC.Work3DDark;
line_col := SC.Work;
all_redraw := 0;
end;
with sldRotateSpd0 do
begin
bckg_col := SC.WorkGraph;
frnt_col := SC.Work3DDark;
line_col := SC.Work;
all_redraw := 0;
end;
with sldRotateSpd1 do
begin
bckg_col := SC.WorkGraph;
frnt_col := SC.Work3DDark;
line_col := SC.Work;
all_redraw := 0;
end;
with sldRotateSpd2 do
begin
bckg_col := SC.WorkGraph;
frnt_col := SC.Work3DDark;
line_col := SC.Work;
all_redraw := 0;
end;
with sldRotateSpd3 do
begin
bckg_col := SC.WorkGraph;
frnt_col := SC.Work3DDark;
line_col := SC.Work;
all_redraw := 0;
end;
with sldRotateSpd4 do
begin
bckg_col := SC.WorkGraph;
frnt_col := SC.Work3DDark;
line_col := SC.Work;
all_redraw := 0;
end;
with sldRotateSpd5 do
begin
bckg_col := SC.WorkGraph;
frnt_col := SC.Work3DDark;
line_col := SC.Work;
all_redraw := 0;
end;
scrollbar_h_draw(sldDist);
scrollbar_h_draw(sldFOV);
scrollbar_h_draw(sldRotateSpd0);
scrollbar_h_draw(sldRotateSpd1);
scrollbar_h_draw(sldRotateSpd2);
scrollbar_h_draw(sldRotateSpd3);
scrollbar_h_draw(sldRotateSpd4);
scrollbar_h_draw(sldRotateSpd5);
DrawButton(599, 175, 55, 29, SC.WorkButton, 0, BUTTON_RESET_ALL);
DrawText(601, 187, 'Reset all', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(600, 14, 26, 24, SC.WorkButton, 0, BUTTON_ZERO0);
DrawText(611, 24, 'Z', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(627, 14, 26, 24, SC.WorkButton, 0, BUTTON_RESET0);
DrawText(638, 24, 'R', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(600, 41, 26, 24, SC.WorkButton, 0, BUTTON_ZERO1);
DrawText(611, 51, 'Z', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(627, 41, 26, 24, SC.WorkButton, 0, BUTTON_RESET1);
DrawText(638, 51, 'R', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(600, 68, 26, 24, SC.WorkButton, 0, BUTTON_ZERO2);
DrawText(611, 78, 'Z', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(627, 68, 26, 24, SC.WorkButton, 0, BUTTON_RESET2);
DrawText(638, 78, 'R', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(600, 95, 26, 24, SC.WorkButton, 0, BUTTON_ZERO3);
DrawText(611, 105, 'Z', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(627, 95, 26, 24, SC.WorkButton, 0, BUTTON_RESET3);
DrawText(638, 105, 'R', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(600, 122, 26, 24, SC.WorkButton, 0, BUTTON_ZERO4);
DrawText(611, 132, 'Z', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(627, 122, 26, 24, SC.WorkButton, 0, BUTTON_RESET4);
DrawText(638, 132, 'R', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(600, 149, 26, 24, SC.WorkButton, 0, BUTTON_ZERO5);
DrawText(611, 159, 'Z', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
DrawButton(627, 149, 26, 24, SC.WorkButton, 0, BUTTON_RESET5);
DrawText(638, 159, 'R', SC.WorkButtonText, 0, DT_ZSTRING + DT_CP866_6x9 + DT_TRANSPARENT_FILL, 0);
EndDraw;
end;
begin
Buf2D := LoadLibrary('/sys/lib/buf2d.obj');
buf2dLibInit := GetProcAddress(Buf2D, 'lib_init');
buf2d_create := GetProcAddress(Buf2D, 'buf2d_create');
buf2d_draw := GetProcAddress(Buf2D, 'buf2d_draw');
buf2d_set_pixel := GetProcAddress(Buf2D, 'buf2d_set_pixel');
buf2d_line := GetProcAddress(Buf2D, 'buf2d_line');
buf2d_clear := GetProcAddress(Buf2D, 'buf2d_clear');
BoxLib := LoadLibrary('/sys/lib/box_lib.obj');
option_box_draw := GetProcAddress(BoxLib, 'option_box_draw');
option_box_mouse := GetProcAddress(BoxLib, 'option_box_mouse');
scrollbar_h_draw := GetProcAddress(BoxLib, 'scrollbar_h_draw');
scrollbar_h_mouse := GetProcAddress(BoxLib, 'scrollbar_h_mouse');
InitLibrary(Buf2DLibInit);
with GetScreenSize do
begin
WndWidth := 659 + WINDOW_BORDER_SIZE * 2;
WndHeight := 436 + WINDOW_BORDER_SIZE + GetSkinHeight;
WndLeft := (Width - WndWidth) div 2;
WndTop := (Height - WndHeight) div 2;
end;
with Buf2DBuffer do
begin
Width := 401;
Height := 422;
end;
buf2d_create(Buf2DBuffer); // создаём буфер
SetEventMask(EM_REDRAW + EM_BUTTON + EM_MOUSE);
Form_Load;
OptionGroup1 := @Option1; // по умолчанию выбран Option1
while True do
case WaitEventByTime(3) of
REDRAW_EVENT:
On_Redraw;
BUTTON_EVENT:
begin
ButtonID := GetButton.ID;
case ButtonID of
BUTTON_RESET_ALL:
cmdResetAll_Click;
BUTTON_ZERO0..BUTTON_ZERO5:
cmdZero_Click(ButtonID - BUTTON_ZERO0);
BUTTON_RESET0..BUTTON_RESET5:
cmdReset_Click(ButtonID - BUTTON_RESET0);
1:
Exit;
end;
end;
MOUSE_EVENT:
if GetActiveWindow = GetSlotById(ThreadInfo.Identifier) then
begin
option_box_mouse(OptionBoxes1[0]);
scrollbar_h_mouse(sldDist);
scrollbar_h_mouse(sldFOV);
scrollbar_h_mouse(sldRotateSpd0);
scrollbar_h_mouse(sldRotateSpd1);
scrollbar_h_mouse(sldRotateSpd2);
scrollbar_h_mouse(sldRotateSpd3);
scrollbar_h_mouse(sldRotateSpd4);
scrollbar_h_mouse(sldRotateSpd5);
end;
else
On_Idle;
end;
end.Для сборки всё также используется SDK, скачайте его релиз.
Прикладываю скомпилированную программу TesseractByTheTrick.kex.
Post's attachments
TesseractByTheTrick.kex 3.69 Кб, 67 скачиваний с 2021-12-31
TesseractByTheTrick.PNG 21.58 Кб, 67 скачиваний с 2021-12-31