В топике про новое издание учебника программирования от Столярова появился @bloody_enterprise и сказал, что ему сложно было осваивать паскаль по книге «Паскаль для школьников» Д. М. Ушакова.
Среди заданий там было
Задание 5.7. Ввести значение X и, используя график функции, определить значение Y. Требуется заполнить блок-схему алгоритма.
График функции рисовать не требовалось, но мне захотелось это сделать. Далее рассказывается, как именно я решал эту задачу. Приведен полный исходный код трёх программ, написанных мной, а также их скриншоты. Разрешается включение кода в проекты под любой свободной лицензией без необходимости упоминания автора. Если кому-то эта статья или программы пригодились, мне было бы интересно об этом узнать.
Первый блин комом:
Free Pascal Compiler version 3.2.2 [2021/06/29] for x86_64
Copyright (c) 1993-2021 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling ./ushakov5.7-piece-function-graph.pas
ushakov5.7-piece-function-graph.pas(2,12) Fatal: Can't find unit graph used by piecewise_function
Fatal: Compilation aborted
Error: /usr/bin/ppcx64 returned an error exitcode
Похоже, что модуль graph по умолчанию не включается в пакет с free pascal, хотя где-то его можно найти. Пересобирать fpc я не стал, а начал искать альтернативу. Всё что мне нужно — это доступ к прямоугольнику с пикселями.
Во-первых, посмотрим в каталог с модулями:
$ ls /usr/lib64/fpc/3.2.2/units/x86_64-linux/graph/*.ppu
/usr/lib64/fpc/3.2.2/units/x86_64-linux/graph/ggigraph.ppu /usr/lib64/fpc/3.2.2/units/x86_64-linux/graph/ptcgraph.ppu
/usr/lib64/fpc/3.2.2/units/x86_64-linux/graph/ptccrt.ppu /usr/lib64/fpc/3.2.2/units/x86_64-linux/graph/ptcmouse.ppu
Что такое ggigraph и ptcgraph, я не знал, но попытка взять код для обычного graph и просто поменять строку в Uses сходу не прошла. Хотя позже я разобрался и ptcgraph всё-таки заработал с кодом из сообщения на freepascal.org.
Поэтому я стал искать дальше:
$ (cd /usr/lib64/fpc/3.2.2/units/x86_64-linux/x11/; ls *.ppu)
cursorfont.ppu keysym.ppu xcms.ppu xfixes.ppu xi2.ppu xkb.ppu xrender.ppu xv.ppu
deckeysym.ppu sunkeysym.ppu xf86dga.ppu xft.ppu xinerama.ppu xkblib.ppu xresource.ppu xvlib.ppu
fontconfig.ppu x.ppu xf86keysym.ppu xge.ppu xinput.ppu xlib.ppu xshm.ppu
hpkeysym.ppu xatom.ppu xf86vmode.ppu xi.ppu xinput2.ppu xrandr.ppu xutil.ppu
Как видим, тут много всего, жаль только нет xcb, говорят, xlib очень сложная. И тут мне напомнили про существование SDL. И верно, она тоже прилагается к компилятору:
$ (cd /usr/lib64/fpc/3.2.2/units/x86_64-linux/sdl/; ls *.ppu)
logger.ppu sdl_gfx.ppu sdl_mixer.ppu sdl_net.ppu smpeg.ppu
sdl.ppu sdl_image.ppu sdl_mixer_nosmpeg.ppu sdl_ttf.ppu
Внятной информации, что с этим делать сходу найти не получилось. В wiki freepascal всё очень пусто, только в секции Examples нашелся один пример и в отличие от всего остального, оно даже мигнуло графическим окошком!
Дальше я начал читать Tutorial и там было написано, что в программе обязательно должен быть хотя бы один Window и Renderer. Но в примере-то был только Surface и всё! Странно конечно. Только позже я понял, что туториал по SDL2, а пример по SDL1.x но дальше дело не шло, окошко-то висело, но попытки рисовать путём записи байтов кончались ничем.
Тут пришлось обратиться к документации по подсказке нейронки, хотя я и так догадывался, что нужна какая-то процедура, чтобы нарисованное отобразилось на экране:
SDL_UpdateRect(screen, 0, 0, 0, 0);
То есть, минимальный рабочий пример — это написать что-нибудь по указателю pixels, к которому можно обращаться как к array of bytes и добавить вызов процедуры, чтобы это фактически отобразилось. Для теста мне нужно было что-нибудь, чтобы определить рисуются пиксели или нет, и в голову первой пришла идея с формулой: pixel^ := i * j mod 256;
Получилось неожиданно красиво (см. первый скриншот), но код я не сохранил и продолжил редактирование. Теперь, для статьи я написал его заново, попытавшись сделать его минимальным, но при этом достаточным для понимания сути. Получилось 64 строки. Кто учится писать на паскале с графикой, пишите свои отзывы, где не хватает комментариев, где сходу непонятно и тд.
Program xymod256sdl;
Uses sdl;
Procedure draw(surface: PSDL_Surface);
var
pixel: ^byte;
width: integer;
height: integer;
pitch: integer;
x, y: integer;
begin
pixel := surface^.pixels;
pitch := surface^.pitch;
width := surface^.w;
height := surface^.h;
for y := 0 to height - 1 do begin
for x := 0 to width - 1 do begin
pixel[y*pitch+x] := x * y mod 256
end
end;
SDL_UpdateRect(surface, 0, 0, 0, 0)
end;
Const
default_width = 768;
default_height = 512;
Var
status: longint; {actual return type is cint}
surface: PSDL_Surface;
Event: TSDL_Event;
ExitEventLoop: boolean = false;
Begin
status := SDL_Init(SDL_INIT_VIDEO);
if status < 0 then begin
writeln(ErrOutput, 'Fatal: cannot initialize SDL: ', status);
halt(1)
end;
surface := SDL_SetVideoMode(default_width, default_height, 8, SDL_SWSURFACE);
if surface = nil then begin
writeln(ErrOutput, 'Fatal: cannot create SDL surface');
halt(2)
end;
SDL_WM_SetCaption('x * y mod 256', 'No Icon');
draw(surface); {we might need to redraw later, therefore procedure}
repeat
status := SDL_WaitEvent(@Event);
if status = 0 then begin
writeln(ErrOutput, 'Debug: event status: ', status);
continue
end;
if Event.type_ = SDL_QUITEV then
ExitEventLoop := true;
if (Event.type_ = SDL_KEYUP) and (Event.key.keysym.sym = SDLK_ESCAPE) then
ExitEventLoop := true
until ExitEventLoop;
SDL_FreeSurface(surface);
SDL_Quit
End.
В переписанной программе я учёл нюансы, например вместо SDL_PollEvent взял SDL_WaitEvent, поскольку первая функция асинхронная, то есть с ней программа поедает 100% процессора. А SDL_WaitEvent блокирует процесс до появления событий.
Но теперь нужно как-то нарисовать сам график. Для начала я писал константы в верхнюю секцию Const, а рисование графика засунул прямо в главную процедуру между Begin и End.
Const
width = 800;
height = 600;
origin_j = width div 2;
origin_i = height div 2;
axis_color = 0; {black}
graph_color = 0; {black}
bg_color = 255; {white}
px_per_unit = 100;
epsilon = 0.01; {line width}
bs = 11; {bitmap size}
...
Procedure scale(i, j: integer; var x, y: real);
begin
x := (j - origin_j) / px_per_unit;
y := (origin_i - i) / px_per_unit;
end;
...
for i:=0 to height-1 do begin
for j:=0 to width-1 do begin
pixel := screen^.pixels+i*width+j; {Mistake! width should be pitch}
pixel^ := bg_color;
if (i = origin_i) or (j = origin_j) then
pixel^ := axis_color;
scale(i, j, x, y);
if abs(y - f(x)) < epsilon then
pixel^ := graph_color
end
end;
Но такой подход оказался не совсем верным. Во-первых, мне повезло с одним байтом на пиксель и чётным размером окна и программа рисовала правильно, но на самом деле для индексации строчек нужно было брать не width, а pitch, где width — это ширина картинки в пикселях, а pitch — размер строчки картинки в байтах. Это важное отличие, поскольку в каждой строке может быть несколько неиспользуемых байтов для выравнивания. Для решения этой проблемы нужно было просто заменить width на pitch в индексации массива, но оставить width в параметре цикла for, что я и сделал.
Во-вторых, формула abs(y - f(x)) < epsilon, где epsilon константа, имеет проблему, в этом случае горизонтальная линия получается толстой, а вертикальная ветка параболы утончается. Это выглядит забавно, но это не то, что требуется.
В-третьих, мне захотелось добавить возможность двигать картинку и оказалось, что отрисовывание графика прямо в главной процедуре не позволяет перерисовать его ещё раз по событию без дублирования кода.
Для решения проблемы с толщиной графика было два варианта: первый вариант более быстрый и который обычно и используют — применить Bresenham’s line algorithm или его упрощённую версию — заполнять вертикальную строку пикселей между последовательными точками поделив колонки пополам или пропорционально. Для этого нужно преобразовывать координаты из математических в экранные. P.S. Или ещё более простой вариант — вычислять значения функции на границах пикселей и заполнять вертикальную колонку.
Я выбрал второй вариант — изменить, то что у меня уже было, где я преобразовывал экранные координаты в математические, просто меняя epsilon в зависимости от первой производной функции. Чем быстрее растёт функция, тем при большем вертикальном расстоянии до математического графика функции пиксель должен быть заполнен. При этом применяется формула ε=ε₀·√((y')²+1), основанная на теореме Пифагора. Для этого пришлось ввести функцию df(x) которая представляет собой производную f(x).
А вот в третьем случае оказалось, что нужно было вынести логику отрисовки в отдельную процедуру, чтобы её можно было дёргать как сразу после инициализации графики, так и в качестве реакции на некоторые события. Тут как раз помогли именованные константы. Как только понадобится их изменить, их можно легко переделать в переменные, хотя я их ещё и переименовал, что было уже не очень легко, но в таком коротком коде с поиском и заменой особого труда не составило.
Кроме того, мне захотелось сделать оси координат правильными — со стрелочками, рисками и подписями. Для этого я вначале использовал смешанный подход. X, Y, O (от слова Origin), 1 я нарисовал с помощью констант-массивов, а риски с помощью циклов. Но этот подход оказался неверным, когда я добавил функцию масштабирования. Если риска выходит за пределы экрана, то она вызывает Access violation и падение программы и то же самое делает и картинка. То есть пришлось бы добавлять логику проверки на выход за экран два раза. Вместо этого я просто переделал риски на осях на картинки, а затем в случае, если поступает команда нарисовать картинку вне экрана, процедура просто ничего не рисует. После этого падения программы прекратились.
Само масштабирование было выполнено путём превращения констант в переменные и изменении этих переменных в цикле событий как реакции на нажатия клавиш стрелок и +/-. При этом пришлось передавать данные в процедуры и их заголовки сильно разрослись.
В итоге получилось это:
Program piecewise_function;
Uses math, sdl;
Type
tbitmap = array of array of byte;
Const
axis_color = 0; {black}
graph_color = 0; {black}
bg_color = 255; {white}
bs = 11; {bitmap size}
(* Produced with gimp and cat foo.pbm | tail -n +4 | tr -d \\n | \
fold -bw 11 | sed 's/./&,/g;s/^/\t\t(/;s/,$/),/;$s/,$/\n/' *)
bmp_right_arrow: tbitmap = (
(0,0,0,1,0,0,0,0,0,0,0),
(0,0,0,0,1,1,0,0,0,0,0),
(0,0,0,0,0,1,1,0,0,0,0),
(0,0,0,0,0,0,1,1,0,0,0),
(0,0,0,0,0,0,1,1,1,0,0),
(1,1,1,1,1,1,1,1,1,1,1),
(0,0,0,0,0,0,1,1,1,0,0),
(0,0,0,0,0,0,1,1,0,0,0),
(0,0,0,0,0,1,1,0,0,0,0),
(0,0,0,0,1,1,0,0,0,0,0),
(0,0,0,1,0,0,0,0,0,0,0)
);
bmp_up_arrow: tbitmap = (
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,1,1,1,0,0,0,0),
(0,0,0,1,1,1,1,1,0,0,0),
(0,0,1,1,1,1,1,1,1,0,0),
(0,1,1,0,0,1,0,0,1,1,0),
(0,1,0,0,0,1,0,0,0,1,0),
(1,0,0,0,0,1,0,0,0,0,1),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0)
);
bmp_capital_x: tbitmap = (
(0,0,0,0,0,0,0,0,0,0,0),
(0,0,1,0,0,0,0,0,1,0,0),
(0,0,0,1,0,0,0,1,0,0,0),
(0,0,0,0,1,0,1,0,0,0,0),
(0,0,0,0,1,0,1,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,1,0,1,0,0,0,0),
(0,0,0,0,1,0,1,0,0,0,0),
(0,0,0,1,0,0,0,1,0,0,0),
(0,0,1,0,0,0,0,0,1,0,0),
(0,0,0,0,0,0,0,0,0,0,0)
);
bmp_capital_y: tbitmap = (
(0,0,0,0,0,0,0,0,0,0,0),
(0,1,1,0,0,0,0,0,1,1,0),
(0,0,1,1,0,0,0,1,1,0,0),
(0,0,0,1,1,0,1,1,0,0,0),
(0,0,0,0,1,1,1,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,1,1,1,0,0,0,0),
(0,0,0,0,0,0,0,0,0,0,0)
);
bmp_capital_o: tbitmap = (
(0,0,0,0,0,0,0,0,0,0,0),
(0,0,0,0,1,1,1,0,0,0,0),
(0,0,0,1,0,0,0,1,0,0,0),
(0,0,1,0,0,0,0,0,1,0,0),
(0,0,1,0,0,0,0,0,1,0,0),
(0,0,1,0,0,0,0,0,1,0,0),
(0,0,1,0,0,0,0,0,1,0,0),
(0,0,1,0,0,0,0,0,1,0,0),
(0,0,0,1,0,0,0,1,0,0,0),
(0,0,0,0,1,1,1,0,0,0,0),
(0,0,0,0,0,0,0,0,0,0,0)
);
bmp_digit_1: tbitmap = (
(0,0,0,0,0,0,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,1,1,0,0,0,0,0),
(0,0,0,1,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,1,1,1,1,1,0,0,0),
(0,0,0,0,0,0,0,0,0,0,0)
);
bmp_tick_mark: tbitmap = (
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(1,1,1,1,1,1,1,1,1,1,1),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0,0)
);
Function f(x: real): real;
begin
if x <= -1 then
f := -2
else if x <= 2 then
f := x - 1
else
f := (x - 2)**2 + 1;
end;
{Derivative of f is necessary for epsilon adjustment}
Function df(x: real): real;
begin
if x <= -1 then
df := 0
else if x <= 2 then
df := 1
else
df := 2 * (x - 2)
end;
Function epsilon_scale(x: real): real;
begin
epsilon_scale := sqrt(x * x + 1)
end;
Procedure place_bitmap(
canvas: pbyte;
pitch: integer;
canvas_w, canvas_h: integer;
bmp: tbitmap;
bmp_w, bmp_h: integer;
x, y: integer;
bg_color, fg_color: byte
);
var i, j: integer;
begin
if (x < 0) or (y < 0) or (x + bmp_w > canvas_w) or (y + bmp_h > canvas_h) then
exit; {if user pans too far do not draw the bitmap}
for i:=0 to bmp_h-1 do
for j:=0 to bmp_w-1 do
if bmp[i,j] = 1 then
canvas[(y+i)*pitch+(x+j)] := fg_color
{ else
canvas[(y+i)*pitch+(x+j)] := bg_color
}
end;
Procedure draw_func_g(canvas: pbyte; pitch, canvas_w, canvas_h, ox, oy, scale: integer);
var
i, j: integer;
x, y: real;
epsilon: real;
pixel: ^byte;
begin
for i:=0 to canvas_h-1 do begin
for j:=0 to canvas_w-1 do begin
pixel := canvas+i*pitch+j;
x := (j - ox) / scale;
y := (oy - i) / scale;
{line thickness has to be adjusted depending on derivative}
epsilon := epsilon_scale(df(x)) / scale;
if abs(y - f(x)) < epsilon then
pixel^ := graph_color
else
pixel^ := bg_color;
end
end;
end;
Procedure draw_axis_x(canvas: pbyte; pitch, canvas_w, canvas_h, ox, oy, scale: integer);
var
j: integer;
pixel: ^byte;
begin
if (oy < 0) or (oy > canvas_h) then
exit; {if user pans too far, do not draw axis X}
for j := 0 to canvas_w-1 do begin
pixel := canvas+oy*pitch+j;
pixel^ := axis_color
end;
place_bitmap(
canvas, pitch, canvas_w, canvas_h, bmp_right_arrow,
bs, bs, canvas_w-bs, oy-(bs div 2), bg_color, axis_color
);
place_bitmap(
canvas, pitch, canvas_w, canvas_h, bmp_capital_x,
bs, bs, canvas_w-2*bs, oy+(bs div 2), bg_color, axis_color
);
place_bitmap(
canvas, pitch, canvas_w, canvas_h, bmp_digit_1,
bs, bs, ox+scale-(bs div 2), oy+bs, bg_color, axis_color
);
place_bitmap(
canvas, pitch, canvas_w, canvas_h, bmp_tick_mark,
bs, bs, ox+scale-(bs div 2), oy-(bs div 2), bg_color, axis_color
)
end;
Procedure draw_axis_y(canvas: pbyte; pitch, canvas_w, canvas_h, ox, oy, scale: integer);
var
i: integer;
pixel: ^byte;
begin
if (ox < 0) or (ox > canvas_w) then
exit; {if user pans too far, do not draw axis Y}
for i := 0 to canvas_h-1 do begin
pixel := canvas+i*pitch+ox;
pixel^ := axis_color
end;
place_bitmap(
canvas, pitch, canvas_w, canvas_h, bmp_up_arrow, bs, bs,
ox-(bs div 2), 0, bg_color, axis_color
);
place_bitmap(
canvas, pitch, canvas_w, canvas_h, bmp_capital_y, bs, bs,
ox+(bs div 2), bs, bg_color, axis_color
);
place_bitmap(
canvas, pitch, canvas_w, canvas_h, bmp_digit_1, bs, bs,
ox-(bs * 3 div 2), oy-scale-(bs div 2), bg_color, axis_color
);
place_bitmap(
canvas, pitch, canvas_w, canvas_h, bmp_tick_mark, bs, bs,
ox-(bs div 2), oy-scale-(bs div 2), bg_color, axis_color
)
end;
Procedure draw_everything(screen: PSDL_Surface; ox, oy, scale: integer);
begin
{it has to be first since it also updates background}
draw_func_g(screen^.pixels, screen^.pitch, screen^.w, screen^.h, ox, oy, scale);
draw_axis_x(screen^.pixels, screen^.pitch, screen^.w, screen^.h, ox, oy, scale);
draw_axis_y(screen^.pixels, screen^.pitch, screen^.w, screen^.h, ox, oy, scale);
{label O for origin}
place_bitmap(
screen^.pixels, screen^.pitch, screen^.w, screen^.h, bmp_capital_o, bs, bs,
ox-(bs * 3 div 2), oy+(bs div 2), bg_color, axis_color
);
SDL_UpdateRect(screen, 0, 0, 0, 0);
end;
Const {constants for main procedure}
ospeed = 20;
scalespeed = 20;
Var
status: integer;
screen: PSDL_Surface;
ExitEventLoop: boolean = false;
Event: TSDL_Event;
width: integer = 800;
height: integer = 600;
ox: integer;
oy: integer;
old_width, old_height: integer;
scale: integer = 100;
Begin
{SDL init}
status := SDL_Init(SDL_INIT_VIDEO); {This might be a problem with cint}
if status < 0 then begin
writeln(ErrOutput, 'Fatal: cannot init SDL: ', status);
halt(1)
end;
screen := SDL_SetVideoMode(width, height, 8, SDL_HWSURFACE or SDL_RESIZABLE);
if screen = nil then begin
writeln(ErrOutput, 'Fatal: cannot create SDL surface');
halt(2)
end;
{What is icon name? Is it used anywhere}
SDL_WM_SetCaption('Function plotter 9000', 'Icon name');
{SDL_EnableKeyRepeat(SDL_DEFAULT_REPEAT_DELAY, SDL_DEFAULT_REPEAT_INTERVAL);}
{Default was 500, 30}
SDL_EnableKeyRepeat(100, 5);
{Actual drawing}
ox := width div 2;
oy := height div 2;
draw_everything(screen, ox, oy, scale);
{Event loop for SDL}
while not ExitEventLoop do begin
status := SDL_WaitEvent(@Event);
if status = 0 then
continue;
if Event.type_ = SDL_VIDEORESIZE then begin
old_width := width;
old_height := height;
width := Event.resize.w;
height := Event.resize.h;
screen := SDL_SetVideoMode(width, height, 8, SDL_HWSURFACE or SDL_RESIZABLE);
ox := ox * width div old_width;
oy := oy * height div old_height;
end;
if Event.type_ = SDL_KEYDOWN then begin
case Event.key.keysym.sym of
SDLK_UP : oy := oy - ospeed;
SDLK_DOWN : oy := oy + ospeed;
SDLK_LEFT : ox := ox - ospeed;
SDLK_RIGHT : ox := ox + ospeed;
SDLK_EQUALS : scale := scale + scalespeed;
SDLK_MINUS : scale := scale - scalespeed;
end;
if scale < 1 then
scale := 1;
end;
draw_everything(screen, ox, oy, scale);
{if the event requires quit, you don't need to update the screen}
if Event.type_ = SDL_QUITEV then
ExitEventLoop := true;
if (Event.type_ = SDL_KEYUP) and (Event.key.keysym.sym = SDLK_ESCAPE) then
ExitEventLoop := true
end;
SDL_FreeSurface(screen);
SDL_Quit
End.
Алгоритм отрисовки графика имеет сложность O(n²), хотя можно было обойтись O(n), из-за чего при открытии окна на большой размер может притормаживать. На 800x600 всё гладко. Кроме того, похоже график не успевает обработать отрисовку и иногда клавиши стрелок слегка залипают. Можно увеличить время повтора и ospeed и scalespeed, но тогда точность позиционирования понизится.
Для улучшения читаемости кода стоило бы сделать canvas структурой (record) и то же самое сделать с tbitmap — сделать структурой с размерами по ширине и высоте. Тогда у процедур будет меньше аргументов. Почти десяток — это всё-таки избыточно.
Ещё явно требуется сделать поддержку ускорения, то есть чем дольше жмёшь кнопку со стрелкой, тем быстрее двигается график, чтобы можно было установить положение с точностью до пикселя и при этом не ждать слишком долго, если нужно двинуться далеко.
Не помешает обрабатывать и события мыши, это должно быть не слишком сложно. Тогда можно таскать график по экрану и скроллом увеличивать и уменьшать, например.
Также не помешает сделать вычисление производной функции приближенно, используя саму функцию, а потом, возможно, добавить и интерпретатор выражений, чтобы можно было поменять функцию без перекомпиляции программы.
Нейронная сеть мне сделала замечание, что в событии resize нужно освобождать экран перед присваиванием, но я не заметил никакой утечки памяти, поэтому делать это не стал.
Но делать это всё (пока?) мне не хочется, да и нужно же читателю статьи на чём-то поупражняться, верно?
Вместо этого я написал новую программу, которая, на мой взгляд, интереснее чем график обычной функции:
Program bifdiag_sdl;
Uses sdl;
Procedure draw(surface: PSDL_Surface);
const
rmin = 0.0;
rmax = 4.0;
iter: longint = 11000;
lasti: longint = 10000;
var
pixel: ^byte;
curpx: ^byte;
width: integer;
height: integer;
pitch: integer;
i, j, k: integer;
x, r: extended;
begin
pixel := surface^.pixels;
pitch := surface^.pitch;
width := surface^.w;
height := surface^.h;
for i := 0 to width - 1 do begin
r := rmin + (rmax - rmin) * sqrt(sqrt(sqrt(i/width)));
x := 0.5;
for j := 1 to iter do begin
x := r * x * (1 - x);
if j > (iter - lasti) then begin
curpx := pixel + ((height - 1) - round(x * (height - 1)))*pitch + 3*i;
if (curpx[2] < 254) and (curpx[2] <> 1) then begin
curpx[2] := (curpx[2] + 2)
end else if (curpx[1] < 254) and (curpx[1] <> 1) then begin
curpx[2] := 1;
curpx[1] := (curpx[1] + 2)
end else begin
curpx[1] := 1;
curpx[0] := (curpx[0] + 1);
end;
if curpx[0] >= 255 then begin
for k := 0 to 2 do
curpx[k] := $ff;
{writeln('white: r=', r:0:8, ', x=', x:0:8);}
break
end
end
end;
if i mod 16 = 0 then
SDL_UpdateRect(surface, 0, 0, 0, 0)
end;
SDL_UpdateRect(surface, 0, 0, 0, 0)
end;
Const
default_width = 800;
default_height = 600;
Var
status: longint; {actual return type is cint}
surface: PSDL_Surface;
Event: TSDL_Event;
ExitEventLoop: boolean = false;
Begin
status := SDL_Init(SDL_INIT_VIDEO);
if status < 0 then begin
writeln(ErrOutput, 'Fatal: cannot initialize SDL: ', status);
halt(1)
end;
surface := SDL_SetVideoMode(default_width, default_height, 24, SDL_SWSURFACE);
if surface = nil then begin
writeln(ErrOutput, 'Fatal: cannot create SDL surface');
halt(2)
end;
SDL_WM_SetCaption('Bifurcation diagram of the logistic map', 'No Icon');
draw(surface); {we might need to redraw later, therefore procedure}
repeat
status := SDL_WaitEvent(@Event);
if status = 0 then begin
writeln(ErrOutput, 'Debug: event status: ', status);
continue
end;
if Event.type_ = SDL_QUITEV then
ExitEventLoop := true;
if (Event.type_ = SDL_KEYUP) and (Event.key.keysym.sym = SDLK_ESCAPE) then
ExitEventLoop := true
until ExitEventLoop;
SDL_FreeSurface(surface);
SDL_Quit
End.
Общая логика программы взята из первого примера, который является неплохим шаблоном для программ, где нужно просто что-нибудь делать с пикселями и выводить это всё на экран. Теперь разберём, как это работает.
const
rmin = 0.0;
rmax = 4.0;
iter: longint = 11000;
lasti: longint = 10000;
Константы rmin и rmax указывают, какая часть логистического отображения нам интересна. Я в данном случае беру всё полностью, от 0 до 4. iter и lasti указывают, сколько итераций проводить для конкретного значения r и сколько из них брать, в данном случае первая тысяча итераций отбрасывается, чтобы процесс успел установиться.
r := rmin + (rmax - rmin) * sqrt(sqrt(sqrt(i/width))); — это формула пересчёта r в экранную координату. Три квадратных корня я добавил, чтобы сжать малоинтересную часть графика с одной, двумя и тд бифуркациями и детализировать r близкие к верхнему пределу 4.0. Если же r становится больше четырёх, то некоторые точки вылетают за интервал (0, 1) и происходит переполнение типа extended и программа вылетает.
x := r * x * (1 - x); — это логистическое отображение, одна из самых простых формул, которые позволяют получить бифуркции.
curpx := pixel + (height - round(x * height))*pitch + 3*i;
Поскольку я использовал 24-битный цвет на этот раз, width измеряет строку в пикселях, а pitch в байтах и готового 24-битного целого вроде нет, можно использовать два подхода. Один вариант - int32, где верхние 8 бит игнорируются. Поскольку у нас порядок байт Little Endian почти везде (x86, x86-64, arm, aarch64), следующая итерация будет перезаписывать верхний байт. Изначально я так и сделал, но затем решил поиграть с цветовыми компонентами, поэтому удобнее получилось воспринимать каждый пиксель как массив из трёх байт. Чтобы не повторять громоздкую формулу, я использую промежуточную переменную curpx.
if (curpx[2] < 254) and (curpx[2] <> 1) then begin
curpx[2] := (curpx[2] + 2)
end else if (curpx[1] < 254) and (curpx[1] <> 1) then begin
curpx[2] := 1;
curpx[1] := (curpx[1] + 2)
...
А в этом коде и далее я просто перехожу по цветовым каналам, у SDL они расположены в порядке BGR. Вначале я работаю с красным каналом, если он переполняется, почти обнуляю его (ставлю в 1), используя эту единицу как маркер и работаю уже с зеленым каналом, потом с синим, и наконец, если даже синий канал переполняется, выставляю всё в белый цвет.
Как показала практика, на самом деле, в такой сложной логике толку мало, поскольку почти всё оказывается закрашено красным цветом, так что можно просто увеличивать все три цветовых канала на единицу одновременно и получить красивую серую картинку. Или только один — тогда будет синяя, зеленая или красная.
В остальном код аналогичен первому примеру. Ещё интересный квадратный фрактал получается, если заменить умножение на xor или другую логическую операцию в первом примере.
