From 599a330b4236adfa26048da8a768f341c1481681 Mon Sep 17 00:00:00 2001 From: Vitaliy Burlakov Date: Thu, 1 Sep 2016 23:52:02 +0300 Subject: [PATCH 1/6] add burlakov folder --- burlakov/11.1.YolkaNewFile.pas | 18 +++++++++++++ burlakov/11.2.YolkaInOldFile.pas | 18 +++++++++++++ burlakov/11.3.CountLetter.pas | 26 ++++++++++++++++++ burlakov/11.4.CountWords.pas | 46 ++++++++++++++++++++++++++++++++ 4 files changed, 108 insertions(+) create mode 100644 burlakov/11.1.YolkaNewFile.pas create mode 100644 burlakov/11.2.YolkaInOldFile.pas create mode 100644 burlakov/11.3.CountLetter.pas create mode 100644 burlakov/11.4.CountWords.pas diff --git a/burlakov/11.1.YolkaNewFile.pas b/burlakov/11.1.YolkaNewFile.pas new file mode 100644 index 0000000..50a403b --- /dev/null +++ b/burlakov/11.1.YolkaNewFile.pas @@ -0,0 +1,18 @@ +program Yolka;{Елка в новом файле} +uses sysutils; +var + f: textfile; + i,j: Integer; +begin + assign (f,'Yolka.txt'); + rewrite (f); + for i := 1 to 10 do + begin + for j := 1 to 10-i do + write(f,' '); + for j := 1 to i*2-1 do + write(f,'^'); + writeln(f); + end; + close(f); +end. \ No newline at end of file diff --git a/burlakov/11.2.YolkaInOldFile.pas b/burlakov/11.2.YolkaInOldFile.pas new file mode 100644 index 0000000..a328953 --- /dev/null +++ b/burlakov/11.2.YolkaInOldFile.pas @@ -0,0 +1,18 @@ +program Yolka2;{Дорисовывание еще одной елочки в файл} +uses sysutils; +var + f: textfile; + i,j: Integer; +begin + assign (f,'Yolka.txt'); + append (f); + for i := 1 to 10 do + begin + for j := 1 to 10-i do + write(f,' '); + for j := 1 to i*2-1 do + write(f,'^'); + writeln(f); + end; + close(f); +end. \ No newline at end of file diff --git a/burlakov/11.3.CountLetter.pas b/burlakov/11.3.CountLetter.pas new file mode 100644 index 0000000..3793719 --- /dev/null +++ b/burlakov/11.3.CountLetter.pas @@ -0,0 +1,26 @@ +program reading; {Подсчет печатных знаков} +uses sysutils; +var + f: textfile; + n: String; + l,j,i: integer; + count: Longint; +begin + //assign(f,'273read.txt'); + assign(f,'STARTHAK.TXT'); + reset(f); + count := 0; + while not eof(f) do + begin + readln(f,n); + l := Length(n); + for i := 1 to l do + begin + j := ord(n[i]); + if ((j >= 65) and (j <= 90)) or ((j >= 97) and (j <= 122)) then + count := count + 1; + end; + end; + close(f); + writeln(count); +end. \ No newline at end of file diff --git a/burlakov/11.4.CountWords.pas b/burlakov/11.4.CountWords.pas new file mode 100644 index 0000000..2d7847c --- /dev/null +++ b/burlakov/11.4.CountWords.pas @@ -0,0 +1,46 @@ +program reading; {Подсчет слов в файле} +uses sysutils; +var + f: textfile; + n: String; + l,j,i,wrd,count: integer; +begin + //assign(f,'273read.txt'); + assign(f,'slacktest.txt'); + reset(f); + wrd := 0; + while not eof(f) do + begin + readln(f,n); + l := Length(n); + count := 1; + for i := 1 to l do + begin + j := ord(n[i]); + if i = l then + begin + if ((j >= 65) and (j <= 90)) or ((j >= 97) and (j <= 122)) then + wrd := wrd + 1 + else + wrd := wrd; + end; + if ((j >= 65) and (j <= 90)) or ((j >= 97) and (j <= 122)) then + begin + wrd := wrd; + count := 0; + end + else + begin + if count = 0 then + begin + wrd := wrd + 1; + count := count + 1; + end + else + wrd := wrd; + end; + end; + end; + close(f); + writeln(wrd); +end. \ No newline at end of file From b0c3348409f465513000208cb8a92c5d517215d9 Mon Sep 17 00:00:00 2001 From: Vitaliy Burlakov Date: Fri, 2 Sep 2016 19:19:05 +0300 Subject: [PATCH 2/6] add burlakov folder --- burlakov/11.5.ReadMassiv.pas | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 burlakov/11.5.ReadMassiv.pas diff --git a/burlakov/11.5.ReadMassiv.pas b/burlakov/11.5.ReadMassiv.pas new file mode 100644 index 0000000..3e2a725 --- /dev/null +++ b/burlakov/11.5.ReadMassiv.pas @@ -0,0 +1,35 @@ +program read; {Вычитать файл в массив, проверить есть ли число} +uses sysutils; +const n = 99; +var + f: textfile; + m: array [1..n] of Longint; + j,k: Longint; + i: integer; +begin + assign(f,'numbers.txt'); + reset(f); + for i :=1 to n do + begin + readln(f,j); + m[i] := j; + end; + close(f); + writeln('Enter number from 31300 to 57800'); + readln(k); + for i := 1 to n do + begin + if m[i] = k then + begin + writeln('Yes, there is'); + break; + end + else + begin + if i = n then + writeln('Not found') + else + continue; + end; + end; +end. \ No newline at end of file From ca89233b330703890cfd126047c2ebb7be6b2b69 Mon Sep 17 00:00:00 2001 From: Vitaliy Burlakov Date: Fri, 2 Sep 2016 20:37:01 +0300 Subject: [PATCH 3/6] add burlakov folder --- burlakov/11.6.ReadingFinding.pas | 52 ++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 burlakov/11.6.ReadingFinding.pas diff --git a/burlakov/11.6.ReadingFinding.pas b/burlakov/11.6.ReadingFinding.pas new file mode 100644 index 0000000..2425953 --- /dev/null +++ b/burlakov/11.6.ReadingFinding.pas @@ -0,0 +1,52 @@ +program read; {Вычитать файл в массив (процедура), проверить, есть ли число (функция) - 5 раз} +uses sysutils; +const n = 99; +var + f: textfile; + m: array [1..n] of Longint; + k: Longint; + i: Integer; +procedure reading; +var + i: Integer; + j: Longint; +begin + for i :=1 to n do + begin + readln(f,j); + m[i] := j; + end; +end; +function finding (fnd: Longint): String; +var + i: Integer; +begin + for i := 1 to n do + begin + if m[i] = k then + begin + finding := 'Yes, there is!'; + break; + end + else + begin + if i = n then + finding := 'Not found.' + else + continue; + end; + end; +end; +begin + assign(f,'numbers.txt'); + reset(f); + reading; + close(f); + for i := 1 to 5 do + begin + writeln('Enter number from 31300 to 57800'); + readln(k); + writeln(finding(k)); + writeln; + end; +end. \ No newline at end of file From 166be7589c9dfe8baa26cd11477da58c3243d300 Mon Sep 17 00:00:00 2001 From: Vitaliy Burlakov Date: Wed, 7 Sep 2016 16:13:45 +0300 Subject: [PATCH 4/6] add burlakov folder --- burlakov/11.4.CountWords.pas | 23 +++++---------- burlakov/11.6.ReadingFinding.pas | 50 +++++++++++++++++++------------- 2 files changed, 37 insertions(+), 36 deletions(-) diff --git a/burlakov/11.4.CountWords.pas b/burlakov/11.4.CountWords.pas index 2d7847c..0f6a09e 100644 --- a/burlakov/11.4.CountWords.pas +++ b/burlakov/11.4.CountWords.pas @@ -1,4 +1,4 @@ -program reading; {Подсчет слов в файле} +program CountWords; {Подсчет слов в файле} uses sysutils; var f: textfile; @@ -17,29 +17,20 @@ for i := 1 to l do begin j := ord(n[i]); - if i = l then - begin - if ((j >= 65) and (j <= 90)) or ((j >= 97) and (j <= 122)) then - wrd := wrd + 1 - else - wrd := wrd; - end; if ((j >= 65) and (j <= 90)) or ((j >= 97) and (j <= 122)) then - begin - wrd := wrd; - count := 0; - end + count := 0 else begin if count = 0 then begin wrd := wrd + 1; - count := count + 1; - end - else - wrd := wrd; + count := 1; + end; end; end; + if i = l then + if ((j >= 65) and (j <= 90)) or ((j >= 97) and (j <= 122)) then + wrd := wrd + 1; end; close(f); writeln(wrd); diff --git a/burlakov/11.6.ReadingFinding.pas b/burlakov/11.6.ReadingFinding.pas index 2425953..a8e378d 100644 --- a/burlakov/11.6.ReadingFinding.pas +++ b/burlakov/11.6.ReadingFinding.pas @@ -2,46 +2,56 @@ uses sysutils; const n = 99; var - f: textfile; + //f: textfile; m: array [1..n] of Longint; k: Longint; i: Integer; -procedure reading; +procedure reading(fname: string); var + f: textfile; i: Integer; j: Longint; begin + assign(f,'numbers.txt'); + reset(f); for i :=1 to n do begin readln(f,j); m[i] := j; - end; + end; + close(f); end; -function finding (fnd: Longint): String; +function finding (fnd: Longint): Integer; var - i: Integer; + j,low,high: Integer; begin - for i := 1 to n do - begin - if m[i] = k then + low := 1; + high := length(m); + j := 0; + repeat + j := (high + low) div 2; + + if (m[j] = k) then break; + + if k < m[j] then begin - finding := 'Yes, there is!'; - break; + low := low; + high := j-1; end else begin - if i = n then - finding := 'Not found.' - else - continue; + low := j+1; + high := high; end; - end; -end; + until (high < low); + + if (high < low) then + finding := -1 + else + finding := j; +end; begin - assign(f,'numbers.txt'); - reset(f); - reading; - close(f); + reading('numbers.txt'); for i := 1 to 5 do begin writeln('Enter number from 31300 to 57800'); From 731284fb78f471a6434fadf794b2c39707addbf8 Mon Sep 17 00:00:00 2001 From: Vitaliy Burlakov Date: Fri, 9 Sep 2016 22:22:42 +0300 Subject: [PATCH 5/6] add burlakov folder --- burlakov/12.1.Picture.pas | 84 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 84 insertions(+) create mode 100644 burlakov/12.1.Picture.pas diff --git a/burlakov/12.1.Picture.pas b/burlakov/12.1.Picture.pas new file mode 100644 index 0000000..bd9f4de --- /dev/null +++ b/burlakov/12.1.Picture.pas @@ -0,0 +1,84 @@ +program picture; {Картинка с грибом} +uses graph, crt; +var + gd,gm,x,y: Integer; + +procedure bush; {Процедура Куст} +var + i,dx: Integer; +begin + SetColor(2); + dx := -25; + for i :=1 to 6 do + begin + Line(x,y,x-dx,y-30); + dx := dx +10; + end; +end; + +begin + gm := detect; + initgraph(gd, gm,''); + SetFillStyle(SolidFill,9); {Небо} + Bar(0,0,GetMaxX,300); + + SetFillStyle(SolidFill,10); {Земля} + Bar(0,300,GetMaxX,GetMaxY); + + SetColor(14); {Солнце} + SetFillStyle(SolidFill,14); + FillEllipse(100,100,50,50); + + SetColor(1); {Озеро} + SetFillStyle(SolidFill,1); + FillEllipse(1000,600,250,50); + + SetFillStyle(SolidFill,6); {Ствол} + Bar(800,320,820,500); + + SetColor(2); {Крона} + SetFillStyle(SolidFill,2); + FillEllipse(790,270,80,80); + FillEllipse(755,210,80,80); + FillEllipse(820,190,80,80); + FillEllipse(780,120,70,70); + + SetColor(4); {Плоды} + SetFillStyle(SolidFill,4); + FillEllipse(800,300,10,10); + FillEllipse(770,250,10,10); + FillEllipse(730,200,10,10); + FillEllipse(780,150,10,10); + FillEllipse(810,110,10,10); + FillEllipse(840,210,10,10); + + SetColor(6); {гриб} + SetFillStyle(SolidFill,6); + PieSlice(650,500,0,180,30); + SetColor(15); + SetFillStyle(SolidFill,15); + Bar(640,500,660,530); + + x := 100; {Кусты} + y := 600; + bush; + x := 300; + y := 500; + bush; + x := 400; + y := 400; + bush; + x := 150; + y := 400; + bush; + x := 600; + y := 700; + bush; + x := 400; + y := 600; + bush; + + readln(); + CloseGraph(); + readln(); +end. \ No newline at end of file From 8f94efd00c2c085f515720d8608a159ddaddc877 Mon Sep 17 00:00:00 2001 From: Vitaliy Burlakov Date: Thu, 29 Sep 2016 19:26:08 +0300 Subject: [PATCH 6/6] add burlakov folder --- burlakov/snake.pas | 276 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 276 insertions(+) create mode 100644 burlakov/snake.pas diff --git a/burlakov/snake.pas b/burlakov/snake.pas new file mode 100644 index 0000000..fa3ccd9 --- /dev/null +++ b/burlakov/snake.pas @@ -0,0 +1,276 @@ +program SnakeNew; + +uses + sysutils, graph, wincrt; + +type + TPoint = record + x : integer; + y : integer; + end; + +const + N = 50; {Высота игрового поля Y} //N должно быть >= M и меньше 70 + M = 50; {Ширина игрового поля X} + StartPointX = 15; {Старт X} + StartPointY = 15; {Старт Y} + +var + GameField: array [1..N,1..M] of Char; {Массив игрового поля} + SnakeCells: array[1 .. 200] of TPoint; {Массив змейки} + i,j,x,y,dx,dy,turnLR, L, time: integer; + key: Char; + gm,gd: smallint; + intersect : Boolean; + +procedure StartWindow(); //Начальная страница +begin + SetColor(15); + SetTextStyle(0, 0, 4); + OutTextXY(75,200,'Samurai Snake'); + SetTextStyle(0, 0, 1); + OutTextXY(170,400,'Press any key to continue'); + readkey(); + clearDevice; + + SetColor(15); + SetTextStyle(0, 0, 2); + OutTextXY(200,100,'Rules'); + SetTextStyle(0, 0, 1); + OutTextXY(150,200,'O - turn left'); + OutTextXY(150,220,'P - turn right'); + setfillstyle(solidfill, 14); + bar(150, 240, 160, 250); + OutTextXY(170,242,'- eat them for growth'); + setfillstyle(solidfill, 13); + bar(150, 260, 160, 270); + OutTextXY(170,265,'- do not eat them!'); + OutTextXY(150,285,'Do not cross the border or yourself!'); + OutTextXY(170,400,'Press any key to start'); + + readkey(); + clearDevice; +end; + + +procedure Direction(var dx,dy,turnLR:integer); //Изменение направления +begin + if (turnLR mod 4 = 0) or (turnLR = 0) then + begin + turnLR := 0; //Направо + dx := 1; + dy := 0; + end + else + begin + if (turnLR = 1) or (turnLR = -3) then + begin + dx := 0; //Вниз + dy := 1; + end + else + begin + if (turnLR mod 2) = 0 then + begin + dx := -1; //Налево + dy := 0; + end + else + begin + dx := 0; //Вверх + dy := -1; + end; + end; + end; +end; + +procedure Soldier(); //Рандомно помещаются на поле съедобные квадраты +var + mx,my,i,sum: integer; + +begin + sum := random(5) + 1; + for i := 1 to sum do + begin + mx := random(M) + 1; + my := random(N) + 1; + if GameField[mx,my] <> '*' then + GameField[mx,my] := 'm' + else + continue; + + SetColor(14); + setfillstyle(solidfill, 14); + bar(mx * 10, my * 10, mx * 10 + 5, my * 10 + 5); + + end; +end; + +procedure General(); //Рандомно помещаются на поле несъедобные квадраты +var + gx,gy: integer; + +begin + gx := random(M) + 1; + gy := random(N) + 1; + if GameField[gx,gy] <> '*' then + GameField[gx,gy] := 'g'; + + SetColor(13); + setfillstyle(solidfill, 13); + bar(gx * 10, gy * 10, gx * 10 + 10, gy * 10 + 10); + +end; + + +procedure GameOver(); +var + j,i,y: Integer; +begin + for i := 1 to N do + begin + for j := 1 to M do + begin + y := random(10) + 1; + SetColor(12); + setfillstyle(solidfill, 12); + bar(j*10,i*10,(j + 1)*10,(i + y)*10); + end; + delay(20); + end; + SetColor(16); + SetTextStyle(0, 0, 5); + OutTextXY(75,200,'Game Over'); + SetTextStyle(0, 0, 2); + OutTextXY(120,300,'Snake length:' + inttostr(L)); +end; + +procedure RemoveSnake(var x,y: integer); //Смещение массива змейки +begin +for i := L downto 2 do +begin + SnakeCells[i].x := SnakeCells[i-1].x; + SnakeCells[i].y := SnakeCells[i-1].y; +end; +SnakeCells[1].x := x; //Присвоение новых координат первого звена в массиве змейки +SnakeCells[1].y := y; +end; + + +begin //Начало основной программы + DetectGraph(gd,gm); + InitGraph(gd,gm,''); + + StartWindow(); + + randomize; + L := 3; {длина змейки на старте} //Установка начальных значений + x := StartPointX; + y := StartPointY; + key := 'a'; + turnLR := 0; + dx := 1; + dy := 0; + intersect := false; + time := 200; + + for i := 1 to N do {Запись массива игрового поля} + for j := 1 to M do + GameField[j,i] := ' '; + + for i := 1 to L do {Запись массива змейки} + begin + GameField[StartPointX - i, StartPointY ] := '*'; + SnakeCells[i].x := StartPointX - i; + SnakeCells[i].y := StartPointY; + end; + + //clearDevice; + + SetColor(12); //Отрисовка границ поля + line(9, 9, M*10 + 6, 9); + line(M*10 + 6, 9, M*10 + 6, N*10 + 6); + line(M*10 + 6, N*10 + 6, 9, N*10 + 6); + line(9, N*10 + 6, 9, 9); + + Soldier(); + + while (x > 0) and (x <= M) and (y > 0) and (y <= N) do //Начало игрового процесса + begin + + SetColor(12); + setfillstyle(solidfill, 12); //Красный круг для придания японского колорита + FillEllipse(100,100,50,50); + + if GameField[x,y] = 'm' then //Увеличение змейки при съедении солдата + увеличение скорости + новые солдаты + begin + L := L + 1; + GameField[x, y] := '*'; + + RemoveSnake(x,y); + + Soldier(); + + if (L mod 5 = 0) and (time > 50) then + time := time - 10; + + if (L mod 5) = 0 then + General(); + + continue; + end; + + if GameField[x,y] = 'g' then //Проверка на столкновение с препятствием + intersect := true; + + for i := 4 to L do //Проверка на пересечение + begin + if (SnakeCells[1].x = SnakeCells[i].x) and (SnakeCells[1].y = SnakeCells[i].y) then + intersect := true; + end; + + if intersect = true then + break; + + GameField[x , y] := '*'; //Запись нового звена + GameField[SnakeCells[L].x, SnakeCells[L].y] := ' '; //Стирание последнего + + setfillstyle(solidfill, 16); //Стирание на экране + bar(SnakeCells[L].x *10, + SnakeCells[L].y *10, + SnakeCells[L].x *10 + 5, + SnakeCells[L].y *10 + 5); + + RemoveSnake(x,y); + + setfillstyle(solidfill, 15); //Рисование первого звена + bar(SnakeCells[1].x *10, + SnakeCells[1].y *10, + SnakeCells[1].x *10 + 5, + SnakeCells[1].y *10 + 5); + + + x := x + dx; + y := y + dy; + + delay(time); + + if keypressed then //Проверка на изменение направления + begin + key := readkey; + case key of + 'o': turnLR := turnLR - 1; + 'p': turnLR := turnLR + 1; + end; + end + else + continue; + + Direction(dx,dy,turnLR); //Изменение направления через процедуру + + end; + GameOver(); + readkey(); + + CloseGraph(); +end. \ No newline at end of file