Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Графика в Pascal.doc
Скачиваний:
33
Добавлен:
10.06.2015
Размер:
990.21 Кб
Скачать

Задача 5.

Нарисовать фигуру "Снежинка" по следующему алгоритму: из одной точки – центра вырастают k кристалликов-отрезков длины r, свободный конец каждого из которых служит центром новой снежинки с длиной кристаллика-отрезка, в три раза меньшей r. Указанный процесс продолжается n раз. Ниже изображены снежинки при n=1, 2, 3, и k=6:

Решение.

Введем рекурсивную процедуру Snow, параметрами которой будут координаты центров снежинок x0, y0, радиус-длина r и глубина рекурсии n. Для размещения рисунка в области вывода, найдем начальный радиус по формуле: полагаяdim=240, k=1/3. Получим: r=160/(1-1/3n). Чтобы величины cos(I*t) и sin(I*t) не вычислялись в цикле многократно (цикл содержится в теле рекурсивной процедуры), найдем указанные вещественные значения в процедуре Init и запомним их в массивах C и S. Это значительно ускорит работу программы.

Program Examp_31;

Uses crt, graph;

Const k=6; {Количество кристалликов-отрезков}

Var n:Integer;

C,S:Array[1..k] of real;

Procedure Graphinterface;

Var

driver, mode, error:Integer;

s:String;

Begin

driver:=detect;

s:=' ';

Initgraph(driver,mode,s);

error:=GraphResult;

if error<>GrOk then

begin

writeln(GraphErrorMsg(Error));

Halt(error)

end

end;

Procedure Init;

const t=2*pi/k;

var j:1..k;

begin

Write('Введите глубину рекурсии n

(от 1 до 6)');

Readln(n);

for j:=1 to k do

begin

C[j]:=cos(j*t);

S[j]:=sin(j*t);

end;

end; {Init}

Procedure Snow(x0,y0,r,n:Integer);

var x,y,i:Integer;

begin

for i:=1 to k do

begin {SetColor(16-i);(16-n)}

x:=x0+Round(r*C[i]); {+10}

y:=y0-Round(r*S[i]); {-10}

Line(x0,y0,x,y);

if n>1 then Snow(x,y,r div 3,n-1);

end;

end; {Snow}

begin

Init;Graphinterface;

Snow(320,240,Round(160/(1-1/(Exp(n*Ln(3))))),n);

Readln; CloseGraph;

End.

Занимательная графика

Задача 6.

Игра "Жизнь".

Приведем отрывок из двадцатой главы книги М. Гарднера «Крестики-ноли­ки», которая посвящена игре «Жизнь». Прочитав главу, вы полнее ознакомитесь с игрой, ситуациями, возникающими в ее процессе, а также с целым рядом серьез­ных приложений. Игре посвящено множество публикаций и дальнейшие ее иссле­дования продолжаются.

Настоящая глава посвящена самому знаменитому детищу Конуэя — игре, которую сам Конуэй, известный американский математик, назвал «Жизнь». Для игры «Жизнь» вам не понадобится партнер — в нее можно играть и одному. Воз­никающие в процессе игры ситуации очень похожи на реальные процессы, проис­ходящие при зарождении, развитии и гибели колоний живых организмов. По этой причине «Жизнь» можно отнести к быстро развивающейся категории так называемых «моделирующих игр», т. е. игр, которые в той или иной степени имитируют процессы, происходящие в реальной жизни.

Для игры «Жизнь», если не пользоваться ЭВМ, вам понадобится довольно боль­шая доска, разграфленная на клетки, и много плоских фишек двух цветов... Ос­новная идея игры состоит в том, чтобы, начав с какого-нибудь простого расположения фишек (организмов), расставленных по различным клеткам доски, просле­дить за эволюцией исходной позиции под действием «генетических законов» Ко­нуэя, которые управляют рождением, гибелью и выживанием фишек. Конуэй тща­тельно подбирал свои правила и долго проверял их «на практике», добиваясь, чтобы они, по возможности, удовлетворяли трем условиям:

1) не должно быть ни одной исходной конфигурации, для которой существова­ло бы простое доказательство возможности неограниченного роста популяции;

2) в то же время должны существовать такие начальные конфигурации, кото­рые заведомо обладают способностью беспредельно развиваться;

3) должны существовать простые начальные конфигурации, которые в тече­ние значительного промежутка времени растут, претерпевают разнообразные из­менения и заканчивают свою эволюцию одним из следующих способов: полностью исчезают; переходят в устойчивую комбинацию и перестают изменяться вообще или же, наконец, выходят на некий колебательный режим, при котором они со­вершают некий бесконечный цикл превращений с определенным периодом.

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

«Генетические законы» Конуэя удивительно просты. Прежде чем мы их сфор­мулируем, обратим внимание на то, что каждую клетку доски (которая, вообще говоря, считается бесконечной) окружают восемь соседних клеток: четыре имеют с ней общие стороны, а четыре другие - общие вершины. Правила игры («генети­ческие законы») сводятся к следующему.

1) Выживание. Каждая фишка, у которой имеются две или три соседние фишки, выживает и переходит в следующее поколение.

2) Гибель. Каждая фишка, у которой оказывается больше трех соседей, погибает, т.е. снимается с доски, из-за перенаселенности. Каждая фишка, вокруг которой свободны все соседние клетки или же занята только одна клетка, погибает от одиночества.

3) Рождение. Если число фишек, с которыми граничит какая-нибудь пустая клетка, в точности равно трем (не больше и не меньше), то на этой клетке происходит рождение нового «организма», т. е. следующим ходом на нее ставится одна фишка. ,

Важно понять, что гибель и рождение всех «организмов» происходят одно­временно. Вместе взятые, они образуют одно поколение или, как мы будем гово­рить, один «ход» в эволюции начальной конфигурации. Ходы Конуэй рекомендует делать следующим образом:

1) начать с конфигурации, целиком состоящей из черных фишек;

2) определить, какие фишки должны погибнуть, и положить на каждую из обреченных фишек по одной черной фишке;

3) найти все свободные клетки, на которых должны произойти акты рожде­ния, и на каждую из них положить по одной фишке белого цвета;

4) выполнив все эти указания, еще раз внимательно проверить, не сделано ли каких-либо ошибок, затем снять с доски все погибшие фишки (т. е. столбики из двух фишек), а всех новорожденных (белые фишки) заменить черными фишками. Проделав все эти операции, вы получите первое поколение в эволюции первона­чальной конфигурации. Аналогичным образом получаются все последующие поко­ления.

Рассмотрим теперь, что же происходит с некоторыми простыми конфигураци­ями. Одиночная фишка, а также любая пара фишек, где бы они ни стояли, очевид­но, погибают после первого же хода. Исходная конфигурация из трех фишек, как правило, погибает, а выживает лишь в том случае, если, по крайней мере, одна фишка граничит с двумя занятыми клетками... Любой диагональный ряд фишек, каким бы длинным он ни оказался, с каждым ходом теряет стоящие на его концах фишки и, в конце концов, совсем исчезает. Конфигурация служит простей­шим примером так называемых «флип-флопов» (кувыркающихся конфигураций, возвращающихся в исходное состояние через каждые два хода). При этом она по­переменно превращается то в вертикальный, то в горизонтальный ряд из трех фишек. Конуэй называет этот триплет «мигалкой».

На рисунке ниже (слева) представлены наиболее часто встречающиеся конфи­гурации из числа любителей «спокойной жизни», т. е. устойчивые конфигурации:

Одним из самых замечательных открытий Конуэя следует считать конфигу­рацию из пяти фишек под названием «глайдер» (glider - планер), изображенную на рисунке справа. После второго хода «глайдер» немного сдвигается и отражается относительно диагонали... «Глайдер» воспроизводит сам себя после четырех ходов и при этом опускается на одну клетку по диагонали. |

Требуется написать графическую программу, моделирующую поколения «Жизни».

Решение.

Некоторые колонии сильно разрастаются даже при малых начальных размерах, а некоторые бесконечно перемещаются. Следовательно, программа должна обрабатывать большие колонии с минимальными затратами времени и памяти. Программы должны также иметь небольшой объем, обладать простотой и наглядностью.

Пусть размер поля равен 480х480 пикселей. Количество клеток на нем зависит от размера h в пикселях одной клетки. При минимальном размере 4 поле содержит 120х120 клеток. Свободные и занятые клетки можно кодировать 0 и 1 или false и true. Так как правила игры требуют подсчета числа соседей для каждой из фишек, то остановимся на первом варианте. |

Определим тип

Board=Аггау[1..120,1..120] оf 0..1

и введем две переменные А и В этого типа. Два однотипных двумерных массива будут отображать состояния двух последовательных поколений: первого и второго, второго и третьего и т.д., что соответствует выкладыванию фишек вручную на двух досках! Самой трудоемкой и замедляющей работу программы является операция подсчета числа соседей для каждой фишки, поэтому введем еще одну переменную - массив булевского типа

Mark:Array[1. .120,1. . 120] of Boolean

для маркировки клеток, требующих выполнения указанной операции.

Program Examp_32;

Uses crt, graph;

Const Visual=10; NoVisual=8;

del=#219+#219+#219+#219+#219;

generation:Word=0;

Type Board=Array[1..120,1..120] of 0..1;

Var a,b:Board;

Mark:Array[1..120,1..120] of Boolean;

x,y:Integer;

h,max,i,j:Byte;

Procedure Graphinterface;

Var

driver, mode, error:Integer;

s:String;

NL:Byte Absolute $0000:$0417;

Begin

ClrScr;

Writeln('':20,'Стрелки курсора -

перемещение по доске;');

Writeln('':20,'пробел-обозначить

или стереть клетку.');

Writeln('':180,'Esc-выход;

Enter-новая конфигурация.');

if ReadKey=#27 then Halt;

NL:=NL or $20; {включение NumLock}

driver:=detect;

s:='';

Initgraph(driver,mode,s);

error:=GraphResult;

if error<>GrOk then

begin

writeln(GraphErrorMsg(Error));

Halt(error)

end

end;

Procedure NewBoard;

begin

ClearDevice;

OutTextXY(110,5,'Введите размер

клетки(4,5,6,8,10,16,20,40)');

GotoXY(60,1); Read(h);

max:=480 div h-1;

for i:=1 to max do

for j:=1 to max do

begin

A[i,j]:=0;

Mark[i,j]:=false;

end;

ClearDevice;SetColor(NoVisual);

x:=80;y:=0;

Repeat

Line(x,0,x,479); Inc(x,h);

Until x>560;

Repeat

Line(80,y,560,y); Inc(y,h);

Until y>480;

SetColor(Green);

SetTextStyle(1,1,8);OutTextXY(-25,120,'Life');

SetTextStyle(0,0,1);

end; {NewBoard}

Procedure Surround;

{маркировка окружающих клеток}

begin

Mark[i-1,j]:=true;

Mark[i-1,j+1]:=true;

Mark[i,j+1]:=true;

Mark[i+1,j+1]:=true;

Mark[i+1,j]:=true;Mark[i+1,j-1]:=true;

Mark[i,j-1]:=true; Mark[i-1,j-1]:=true;

end; {Surround}

Procedure Configuration;

{задание начальной конфигурации}

Procedure Frame(c:Integer);

begin

SetColor(c);

x:=80+i*h; y:=j*h;

Rectangle(x,y,x-h,y-h);

end; {Frame}

var Ch:Char;

done:Boolean;

begin

i:=max div 2; j:=i;

done:=false; Frame(Visual);

Repeat

Ch:=ReadKey;

Case Ch Of

#0:begin

Ch:=ReadKey;

Frame(NoVisual);

Case Ch of

#75:if i>2 then Dec(i); {влево}

#77:if i<max then Inc(i); {вправо}

#72:if j>2 then Dec(j); {вверх}

#80:if j<max then Inc(j); {вниз}

end;{Case}

Frame(Visual);

end;

#13:begin {ввод}

Frame(NoVisual);

done:=true;

end;

#32:begin {пробел}

if GetPixel(x-1,y-1)=0 then

begin

A[i,j]:=1;

SetFillStyle(1,Yellow);

Mark[i,j]:=true;

Surround;

end

else

begin

A[i,j]:=0;

SetFillStyle(1,Black);

Sound(50);Delay(25);NoSound;

end;

FloodFill(x-1,y-1,Visual);

end;

end; {Case}

Until done;

end; {Configuration}

Procedure BirthAndDying;

Function Neighbours:Byte;

{подсчет числа соседей}

var n:0..8;

begin

n:=A[i-1,j];Inc(n,A[i-1,j+1]);

Inc(n,A[i,j+1]);Inc(n,A[i+1,j+1]);

Inc(n,A[i+1,j]);Inc(n,A[i+1,j-1]);

Inc(n,A[i,j-1]);Inc(n,A[i-1,j-1]);

Neighbours:=n;

end; {Function}

begin

for j:=2 to max do

for i:=2 to max do

if Mark[i,j] then

begin

Case Neighbours of

3: begin B[i,j]:=1;Surround; end;

0,1,4..8:B[i,j]:=0;

end; {Case}

if A[i,j]<>B[i,j] then

begin

SetFillStyle(1,B[i,j]*(Random(7)+9));

FloodFill(i*h+79,j*h-1,NoVisual);

end; {if}

end; {if}

end;{BirthAndDying}

Procedure NewGeneration;

var z:String[5];

begin

A:=B; {смена поколений}

Inc(generation); Str(generation,z);

{подсчет поколений}

SetColor(Black);OutTextXY(580,220,del);

SetColor(Green);OutTextXY(580,220,z);

end; {NewGeneration}

begin

Graphinterface;

Repeat

NewBoard;

Configuration;

Repeat

BirthAndDying;NewGeneration;

Until KeyPressed;

Until ReadKey=#27;

CloseGraph;

End.

Процедура Graphinterface выводит на экран краткую инструкцию по работе с про­граммой и инициализирует графический режим. Процедура NewBoard запрашива­ет размер клетки, рисует новое поле и инициализирует массивы А и Маrk. Процедура Surround используется как вспомогательная в процедурах Configuration и BirthAndDying для маркировки восьми клеток, окружающих текущую клетку.

Процедура Configuration задает начальную конфигурацию клеток. Перемеще­ние по полю осуществляется при помощи рамки (вложенная процедура Frате) стрелками курсора. Нажатие на пробел обозначает клетку (А[i,j]]:=1), закраши­вает, маркирует ее и окружение. Повторное нажатие на пробел отменяет закраши­вание и присваивание (А[i,j]]:=0). Начальное расположение запоминается ив массиве В (вторая доска) - строка В:=А. В Паскале эта операция применима к двум совместимым массивам и выполняется мгновенно.

В основной процедуре BirthAndDying для маркированных клеток подсчитыва­ется число соседей (функция Neighbour) и осуществляется выбор. Если число сосе­дей равно 3, то выполняется присваивание B[i,j]:=1, обращение к процедуре маркировки окружающих клеток и закрашивание клетки при условии, что А[i,j]=0 (рождение). Если число соседей равно 0, 1, 4, 5, 6, 7 или 8, то выполня­ется присваивание В[i,j]:=0 и стирание цвета клетки (гибель); если же число соседей равно 2, то ничего изменять не нужно. Цвета для раскрашивания выбира­ются случайным образом.

В процедуре NewGeneration происходит смена поколений (присваивание А:=В) и подсчитывается их число (переменная generation). Последние две процедуры ис­полняются в цикле до нажатия на любую клавишу.