Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.03.2023, 14:31   #1
Student_Dead1nS1de
Пользователь
 
Регистрация: 12.01.2023
Сообщений: 19
По умолчанию Фрактал во FreePascal

Помогите переделать в данной программе из фрактала Леви во фрактал Минковского.
Код:
uses winCRT,
     CRT,
     Graph;

var
    gd, gm, i, j, n, m, k: Integer;
   xn,yn, a, p, x, y, scale: Real;
    grend:string;
    ch: char;


 procedure write_text;
  begin
   setcolor(15);
   outtextxy(20,40,'- <+>/<-> - Scaling');
   outtextxy(20,55,'- <ARROWS> - Movement on the x and y axes');
   outtextxy(20,70,'- <ENTER> - changing the drawing depth of the curve ');
   outtextxy(20,85,'- <ESC> - exit the graphics mode.');
  end;

 procedure draw;
     begin
    cleardevice;
    write_text;
    setcolor(yellow);
    MoveTo(Round(x), Round(y));
    for i:=0 to Round(exp(p*ln(2))) -1 do
    begin
     a := 0;
     n := i;
     m := 0;
     k := 0;
     repeat
      m := n mod 2;
      n := n div 2;
       case m of
        0: a := a + pi/4;
        1: a := a-pi/4
       end;
       inc(k);
        until k>=p;
       x := x + scale*cos(a);
       y := y + scale*sin(a);
       LineTo(Round(x), Round(y));
    end;
   end;
    //

begin
 grend:='\';
 gd := Detect;
 InitGraph(gd, gm, '');
 p := 15;
 x := 300;
 y := 200;
 scale := 3;
 repeat;
 draw;
 ch:=wincrt.readkey;
  case ch of
   #8:
    begin
     x:=300;
     y:=200;
     p:=15;
     scale:=3;
     draw;
    end;
   #61:
    begin
     if scale=15 then scale:=1
     else begin
       scale:=scale+1;
       draw;
      end;
    end;
   #45:
    begin
     if scale=1 then  scale:=15
     else begin
       scale:=scale-1;
       draw;
      end;
    end;
   #75:
    begin
     if x=0 then x:=1000
     else begin
       x:=x-10;
       draw;
      end;
    end;
   #72:
    begin
     if y=1000 then y:=0
     else begin
       y:=y+10;
       draw;
      end;
    end;
   #77:
    begin
     if x=1000 then x:=0
     else begin
       x:=x+10;
       draw;
      end;
    end;
   #80:
    begin
     if y=0 then y:=500
     else begin
       y:=y-10;
       draw;
      end;
    end;
   #13:
    begin
     if p=15 then p:=3
     else begin
       p:=p+1;
       draw;
      end;
    end;
   #27:
    begin
     grend:='stop';
     closegraph;
     exit;
    end;
   end;
 until grend='stop';
  readkey();
end.
Student_Dead1nS1de вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Фрактал. marklar Помощь студентам 2 02.06.2017 00:48
Фрактал Firgat13 Помощь студентам 1 10.05.2016 11:54
Т-фрактал в С++ Дж.Лондон Помощь студентам 8 17.03.2016 20:29
Фрактал на PHP Alter PHP 5 29.10.2008 15:24