Я нарисовал множества Мандельброта на Delphi а не flat assembler!
Embarcadero Delphi for Win32 compiler version 35.0
А именно:

DCC32.EXE
rlink32.dll
SysInit.dcu
System.dcu

Все!




Вот полная Mandelbrot.pas

{$APPTYPE CONSOLE}

const
horiz:longint=1024; vert:longint=1024;
absc:extended=-1.96680095; ordi:extended=0.00000478; size:extended=0.00000014;
q:array[0..254]of byte=(234,94,198,83,178,216,183,78,41,84,119,63,211,71,123,38,
223,73,197,249,126,227,211,5,36,36,128,5,151,2,198,166,197,181,142,52,174,151,
244,164,255,62,173,75,21,197,126,225,130,146,244,175,86,1,180,253,198,191,50,36,
233,200,150,221,176,73,23,161,71,224,41,69,139,245,44,40,68,45,147,127,73,39,
156,189,191,20,19,15,27,203,206,97,156,111,189,126,87,209,209,36,23,17,15,49,
172,58,146,65,93,214,80,80,168,177,231,81,122,75,196,189,141,185,105,138,152,
225,171,28,120,103,29,13,140,172,20,235,214,174,237,70,179,188,127,169,40,58,
242,93,32,252,78,13,26,221,141,178,25,171,4,79,231,137,83,113,230,88,90,124,18,
217,194,46,236,126,32,228,103,53,206,150,28,159,237,138,83,114,58,47,176,254,
161,177,138,24,191,38,59,225,182,112,250,39,10,47,2,96,101,93,21,116,129,117,
172,209,145,64,95,149,223,155,65,178,142,224,92,93,159,199,116,52,178,214,192,
230,47,198,68,75,179,0,8,220,51,69,171,81,41,95,108,20,121,18,215,15,75);


var
f:file;
a,b,t:longint;
c,d,cc,dd,m,n,step,absc2,ordi2:extended;
s:array[0..61439]of byte;                                                                         
pal:array[0..255]of array[0..3]of byte;
h:array[0..13]of longint=($4D42,0,0,1078,40,0,0,$080001,0,0,2834,2834,0,0);


begin
  h[5]:=horiz; h[6]:=vert;
  a:=horiz; if (a and 3<>0) then a:=(a+4) and $FFFFFFFC; h[9]:=a*vert; h[1]:=h[9]+1078;
  assign(f,'Mandelbrot.bmp'); rewrite(f,1);
  blockwrite(f,h,2); blockwrite(f,h[1],52);
  for a:=0 to 254 do
  begin
    pal[a][0]:=round(127+127*cos(2*pi*(a+16)/255)); pal[a][1]:=round(127+127*sin(2*pi*(a+16)/255)); pal[a][2]:=q[a]; pal[a][3]:=0
  end;
  for a:=0 to 2 do pal[255][a]:=255; pal[255][3]:=0;
  blockwrite(f,pal,1024);
  step:=size/horiz;
  absc2:=absc-step*(horiz-1)/2; ordi2:=ordi-step*(vert-1)/2;
  for b:=0 to vert-1 do
  begin
    n:=ordi2+b*step;
    for a:=0 to horiz-1 do
    begin
      m:=absc2+a*step;
      c:=m; d:=n; t:=4081;
      repeat cc:=c*c; dd:=d*d; d:=(c+c)*d+n; c:=cc-dd+m; dec(t) until (t=0) or (cc+dd>1000000.0);
      if (t=0) then s[a]:=255 else s[a]:=t mod 255;
    end;
    blockwrite(f,s,h[9] div vert);
    write('Done: ',b+1,chr(13))
  end;
  close(f)
end.


Компилируем!



Mandelbrot.exe готова.
И мы ее пустим!



Появилось Mandelbrot.bmp — вот этой


А если другие

absc:extended=-0.121182862923836;
ordi:extended=0.982857218328743;
size:extended=0.000000000000079;


то вот


а третий

absc:extended=-0.163419888457472295;
ordi:extended=1.0978411602700539;
size:extended=0.0000000000000034;


то вот



а четвертый

absc:extended=-0.7419938603738353;
ordi:extended=0.143187148318039;
size:extended=0.000000000000005;


то вот



Фрактал можно увеличивать бесконечно, и будут видны все более мелкие детали его строения.

Вот не я

Комментарии (16)


  1. a-tk
    29.07.2024 08:43
    +2

    Чему меня в своё время научила IDE Pascal 5.5, так это стилю кодирования.

    Там, к слову, ещё не было подсветки синтаксиса. Зато был энтузиазм автора в написании формул.

    Я долго пытался понять, почему компилятор мне говорит Unexpected end of file без каких-либо полезных подробностей. Через несколько часов отладки и расстановки пробелов я обнаружил, что вместо )*( в коде написал )(*.

    Надеюсь, код в статье не повторяет стилистически production и вообще от прода на расстоянии пушечного выстрела.


  1. wataru
    29.07.2024 08:43
    +3

    Раз уж вы не побоялись выложить свой код, не побоюсь его покритиковать.

    Фрактал можно увеличивать бесконечно, и будут видны все более мелкие детали его строения.

    Вы уверены? Не будет ли у вас проблем с точностью?

    Соглашусь с автором выше, код у вас оформлен не то, чтобы читабельно. Что за массив q? Почему 4081 итерация?

    Еще в глаза бросилось, зачем вы выводите chr(13) вместо использования writeln?

    Использование Longint для формирования загловка bmp, серьезно? Как-то костыльно уж слишком.

    ordi? ordi2? Менее понятные имена было бы сложно придумать.

    Основной цикл по t не стоит писать весь на одной строке. У вас какое-то жесткое ограничение по строчкам в ТЗ прописано?

    переменные c, d, cc - это можно еще использовать в олимпиадных задачах, где ваш код только компилируется и никто кроме компилятора на него скорее всего больше никогда не посмотрит. Но выкладывать такой код на общественное обозрение должно быть стыдно.

    Еще, в паскале, по-моему, был тип compex. Так что можно было бы использовать его в ваших вычислениях.


    1. HemulGM
      29.07.2024 08:43

      chr(13) тут переводит каретку в начало, что позволяет затирать строку без очистки всего вывода


    1. HemulGM
      29.07.2024 08:43
      +2

      program Project53;
      
      {$APPTYPE CONSOLE}
      
      const
        Width = 1024;
        Height = 1024;
        LineSize = Width * (4 * 15);
        absc: Extended = -1.96680095;
        ordi: Extended = 0.00000478;
        size: Extended = 0.00000014;
        q: array[0..254] of Byte = (234, 94, 198, 83, 178, 216, 183, 78, 41, 84, 119, 63, 211, 71, 123, 38,
          223, 73, 197, 249, 126, 227, 211, 5, 36, 36, 128, 5, 151, 2, 198, 166, 197, 181, 142, 52, 174, 151,
          244, 164, 255, 62, 173, 75, 21, 197, 126, 225, 130, 146, 244, 175, 86, 1, 180, 253, 198, 191, 50, 36,
          233, 200, 150, 221, 176, 73, 23, 161, 71, 224, 41, 69, 139, 245, 44, 40, 68, 45, 147, 127, 73, 39,
          156, 189, 191, 20, 19, 15, 27, 203, 206, 97, 156, 111, 189, 126, 87, 209, 209, 36, 23, 17, 15, 49,
          172, 58, 146, 65, 93, 214, 80, 80, 168, 177, 231, 81, 122, 75, 196, 189, 141, 185, 105, 138, 152,
          225, 171, 28, 120, 103, 29, 13, 140, 172, 20, 235, 214, 174, 237, 70, 179, 188, 127, 169, 40, 58,
          242, 93, 32, 252, 78, 13, 26, 221, 141, 178, 25, 171, 4, 79, 231, 137, 83, 113, 230, 88, 90, 124, 18,
          217, 194, 46, 236, 126, 32, 228, 103, 53, 206, 150, 28, 159, 237, 138, 83, 114, 58, 47, 176, 254,
          161, 177, 138, 24, 191, 38, 59, 225, 182, 112, 250, 39, 10, 47, 2, 96, 101, 93, 21, 116, 129, 117,
          172, 209, 145, 64, 95, 149, 223, 155, 65, 178, 142, 224, 92, 93, 159, 199, 116, 52, 178, 214, 192,
          230, 47, 198, 68, 75, 179, 0, 8, 220, 51, 69, 171, 81, 41, 95, 108, 20, 121, 18, 215, 15, 75);
      
      var
        BMP: file;
        ScanLine: array[0..LineSize - 1] of Byte;
        Pallete: array[0..255] of array[0..3] of Byte;
        Header: array[0..13] of Longint = ($4D42, 0, 0, 1078, 40, 0, 0, $080001, 0, 0, 2834, 2834, 0, 0);
      
      begin
        // Prepare bitmap
        Header[5] := Width;
        Header[6] := Height;
        var Pitch := Width;
        if Pitch and 3 <> 0 then
          Pitch := (Pitch + 4) and $FFFFFFFC;
        Pitch := Pitch * Height;
        Header[9] := Pitch;
        Header[1] := Header[9] + 1078;
      
        Assign(BMP, 'Mandelbrot.bmp');
        Rewrite(BMP, 1);
        BlockWrite(BMP, Header, 2);
        BlockWrite(BMP, Header[1], 52);
        for var i := 0 to 254 do
        begin
          Pallete[i][0] := Round(127 + 127 * Cos(2 * Pi * (i + 16) / 255));
          Pallete[i][1] := Round(127 + 127 * Sin(2 * Pi * (i + 16) / 255));
          Pallete[i][2] := q[i];
          Pallete[i][3] := 0
        end;
        for var i := 0 to 2 do
          Pallete[255][i] := 255;
        Pallete[255][3] := 0;
        BlockWrite(BMP, Pallete, 256 * 4);
        //
        var step: Extended := size / Width;
        for var Y := 0 to Height - 1 do
        begin
          var n: Extended := (ordi - step * (Height - 1) / 2) + Y * step;
          for var X := 0 to Width - 1 do
          begin
            var m: Extended := (absc - step * (Width - 1) / 2) + X * step;
            var c: Extended := m;
            var d: Extended := n;
            var t: LongInt := 4081;
            var cc: Extended;
            var dd: Extended;
            repeat
              cc := c * c;
              dd := d * d;
              d := (c + c) * d + n;
              c := cc - dd + m;
              Dec(t)
            until (t = 0) or (cc + dd > 1000000.0);
            if t = 0 then
              ScanLine[X] := 255
            else
              ScanLine[X] := t mod 255;
          end;
          BlockWrite(BMP, ScanLine, Pitch div Height);
          Write('Process: ', Y + 1, Chr(13));
        end;
        Close(BMP);
        Writeln('');
        Writeln('Done');
        Readln;
      end.
      

      Пролил чуть света, но все равно ничего не понятно)


  1. kryvichh
    29.07.2024 08:43

    Код, конечно, праздник математики: количество непонятных магических констант зашкаливает. Но да, всё работает и картинка рисуется. Правда, в бесплатной Delphi Community Edition не работает консольный компилятор. Придётся создать новый проект Console Application, и вставить туда код из статьи.


  1. dpbm
    29.07.2024 08:43

    Посмотрел код и вспомнил как в школе программировал. Даже стиль тот же. Тогда был важен только результат. И чтобы работало быстро...

    Репозиторий на github не завели? Ну и сделайте GUI-приложение. Раз у вас получается сформировать файл BMP- пишите его в память и загружайте в TImage. А по клику на изображение делайте масштабирование. Или по таймеру.

    И будет у вас видео как на YouTube.
    Удачи!


    1. HemulGM
      29.07.2024 08:43
      +1

      Вообще, я думаю, что целью была программа, которая ничего не тянет. Даже графику. Здесь нет ни канваса, ни енкодера для битмапа. Ничего вообще не подключено, кроме модуля, который подключен автоматически (System.pas).


      1. dpbm
        29.07.2024 08:43
        +1

        
        procedure TForm1.DisplayButtonClick(Sender: TObject);
        var
          MS: TMemoryStream;
        begin
        
        MS:=TMemoryStream.Create;
        try
        
         h[5]:=horiz; h[6]:=vert;
          a:=horiz; if (a and 3<>0) then a:=(a+4) and $FFFFFFFC; h[9]:=a*vert; h[1]:=h[9]+1078;
          //assign(f,'Mandelbrot.bmp'); rewrite(f,1);
          MS.Write(h, 2);
          MS.Write(h[1], 52);
          //blockwrite(f,h,2); blockwrite(f,h[1],52);
          for a:=0 to 254 do
          begin
            pal[a][0]:=round(127+127*cos(2*pi*(a+16)/255)); pal[a][1]:=round(127+127*sin(2*pi*(a+16)/255)); pal[a][2]:=q[a]; pal[a][3]:=0
          end;
          for a:=0 to 2 do pal[255][a]:=255; pal[255][3]:=0;
        
          //blockwrite(f,pal,1024);
          MS.Write(pal, 1024);
          step:=size/horiz;
          absc2:=absc-step*(horiz-1)/2; ordi2:=ordi-step*(vert-1)/2;
          for b:=0 to vert-1 do
          begin
            n:=ordi2+b*step;
            for a:=0 to horiz-1 do
            begin
              m:=absc2+a*step;
              c:=m; d:=n; t:=4081;
              repeat cc:=c*c; dd:=d*d; d:=(c+c)*d+n; c:=cc-dd+m; dec(t) until (t=0) or (cc+dd>1000000.0);
              if (t=0) then s[a]:=255 else s[a]:=t mod 255;
            end;
            MS.Write(s, h[9] div vert);
            //blockwrite(f,s,h[9] div vert);
            //write('Done: ',b+1,chr(13))
          end;
        
          MS.Position:=0;
          Image1.Picture.LoadFromStream(MS);
        finally
          MS.Free;
        end;
          //close(f)
        end;
        
        procedure TForm1.ZoomInButtonClick(Sender: TObject);
        begin
         size := size-size*0.2;
         DisplayButtonClick(Sender);
        end;

        Всё же так удобнее оценивать ваши труды. Бросил на форму две кнопки и контейнер для изображений, по клику наблюдаем результат, а не появившийся в папке файл :-)


  1. ALLIGATOR
    29.07.2024 08:43

    Если тут:

    repeat
      cc:=c*c;
      dd:=d*d;
      d:=(c+c)*d+n;
      c:=cc-dd+m;
      dec(t);
    until (t=0) or (cc+dd>1000000.0);

    Сделать так:

    repeat
      dd:=d*d;
      d:=(c+c)*d+n;
      cc:=c*c;
      c:=cc-dd+m;
      dec(t);
    until (t=0) or (cc+dd>1000000.0);

    Это даст ускорение ~ 10-13% (FPC 3.3.1)
    (правда это при компиляции под x64, при компиляции под x32 разницы нет)


    1. greenfork
      29.07.2024 08:43

      Это что-то специфичное для Паскаля?


      1. ALLIGATOR
        29.07.2024 08:43
        +1

        В каком смысле? Просто конкретно эта перестановка позволила оптимизатору FPC выкинуть одну ассемблерную инструкцию и это дало такое ускорение, там в цикле было около 12 инструкций, одну выкинули, примитивный расчет дает надежду в 8%
        Но это примитивный расчет, всё зависит от микроархитектуры процессора, конкретно как инструкции перераспределились и т.п.
        К примеру, можно сделать ещё одну перестановку, которая даст ещё меньше ассемблерных инструкций (-1), но конкретно на моём процессоре - это наоборот увеличивает время выполнения.
        Кстати, анализатор llvm-mca - это предсказывает

        В общем отвечая на вопрос - и да и нет.
        Специфично - потому-что у FPC/Delphi оптимизатор не такой мощный, конечно как у LLVM/GCC/MSVC/Intel/etc.
        Не специфично - потому-что в любом языке я думаю можно найти такой вариант, когда перестановка действий местами - даёт ускорение.

        В общем вопрос встречный остается в силе - что вы имеете ввиду под "специфичное для паскаля?"


        1. greenfork
          29.07.2024 08:43

          Это очень интересно. Для меня открытие, что перестановка математических выражений местами может повысить производительность на 10%. Обычно инструкции хотя бы связаны, это же перестановка независимых выражений. Мне все еще непонятно, почему здесь играет роль разрядность системы, 32 или 64 бита, я так полагаю, что просто так оно работает без общего правила. Я посмотрю, что такое llvm-mca, спасибо за наводку.


          1. ALLIGATOR
            29.07.2024 08:43

            Ну так тут всё просто - это самый горячий цикл
            в нём условно 10 команд, которые процессору нужно исполнить
            убираем одну - остаётся 9, соотв.скорость увеличили на 10%
            (но это всё условно т.к. современные процессоры не так просты)

            и для языков, где бэкенд GCC/LLVM - там такие перестановки редко могут что-то дать, т.к. они сами переставляют как нужно чаще всего (но не всегда)


          1. ALLIGATOR
            29.07.2024 08:43

            И кстати напрямую понять, что вот эта перестановка удаляет одну ассемблерную инструкцию конечно же нельзя, я просто протестировал и получилось


          1. HemulGM
            29.07.2024 08:43

            Здесь скорее дело не в том, что тут математические операции поменялись местами, а в том, что у нас есть ограниченный набор регистров.

            1. cc:=c*c; dd:=d*d; d:=(c+c)*d+n; c:=cc-dd+m;

            2. dd:=d*d; d:=(c+c)*d+n; cc:=c*c; c:=cc-dd+m;

            В первом варианте ты работаешь с "c" и "cc", а потом с "d" и "dd", а во втором, ты работаешь c "cc"/"c", потом с "c" и "d", потом c "d"/"dd". Т.е. у тебя лишний раз не перекладывается c/d при операциях и компилятор может оставить "c" в том же регистре для след. операции.


        1. dpbm
          29.07.2024 08:43
          +2

          Занимался переписыванием кода с Delphi на ассемблер для ускорения вычислений. Получал где-то двухкратное ускорение. И наблюдал ускорение вычислений по мере появления новых версий компилятора. Потом был долгий перерыв с Delphi. И теперь поставил Community Edition - скорость работы кода стала примерно равна моим примитивным оптимизациям на ассемблере. Т.е. в новом коде я уже этого делать не буду)