Конфликт модулей crt и GraphABC

@Destiner · Регистрация: 15.10.2012

Студворк — интернет-сервис помощи студентам

Всем привет.
Пишу небольшую программку с использованием графического модуля. Понадобилось использовать функцию delay(), поэтому также подключил модуль crt. В итоге, программа не запускается. Удаляю модуль crt и всё работает.
Можно ли исправить? Если да, то как?

@КонецСвета · 12.06.2013, 16:09

Destiner, вы помните, что программы с использованием crt надо запускать, используя Shift+F9?
потому что вот программка с crt и delay у меня работает )

Pascal

uses crt,graphABC;
begin
repeat
setpencolor(clrandom);
rectangle(100,100,200,200);
delay(100);
until keypressed;
end.

2) не подойдет использовать sleep вместо delay?

@BaboshinSD · 12.06.2013, 16:13

Сообщение от Destiner

Можно ли исправить?

Сообщение от Destiner

Удаляю модуль crt и всё работает.

Сам спросил - сам ответил.

Добавлено через 2 минуты
Если всё таки без Crt что-то не работает, то перепишите код без Crt или скиньте код.

@Destiner · 16.06.2013, 00:29 **[ТС]**

Сообщение от КонецСвета

Destiner, вы помните, что программы с использованием crt надо запускать, используя Shift+F9?
потому что вот программка с crt и delay у меня работает )

Pascal

uses crt,graphABC;
begin
repeat
setpencolor(clrandom);
rectangle(100,100,200,200);
delay(100);
until keypressed;
end.

2) не подойдет использовать sleep вместо delay?

Так. Знаю, что надо запускать через Shift+F9, об этом даже сам компилятор пишет.
Ваша программа у меня тоже работает, а вот моя — нет. Точнее она выполняется, и через 5-10 секунд завершается, при этом ни окна GraphABC, ни консоли программа не открывает.
Sleep подходит. Он чем-то отличается от Delay? Я о нём даже и не знал, везде delay используют.

Сообщение от BaboshinSD

Сам спросил - сам ответил.

Добавлено через 2 минуты
Если всё таки без Crt что-то не работает, то перепишите код без Crt или скиньте код.

Я же не просто так crt добавлял, он мне нужен был для delay. Ну, теперь уже не важно.
Но вообще, интересно, конечно, почему не работает. Учитывая, что программа выше работает, дело, видимо, в моих косяках. Надо будет подумать, хотя идей нет.

@КонецСвета · 16.06.2013, 00:40

Destiner, нну, если можете код выложить (хотя бы часть) то и мы охотно поломаем голову )
sleep - процедура из общих; Делает паузу на ms миллисекунд
delay - процедура модуля crt; Осуществляет задержку на ms миллисекунд.
"везде" delay (это турбо и free паскаль), "везде" sleep (это pascalABC и pascalABC.NET)

@BaboshinSD · 16.06.2013, 09:18

Сообщение от КонецСвета

и мы охотно поломаем голову )

Сообщение от КонецСвета

sleep - процедура из общих

Точнее из System.pas, так что использовать её предпочтительнее.

@Destiner · 16.06.2013, 11:06 **[ТС]**

Вот полный код, который у меня компилируется без проблем. Вообще, по-моему мнению, его очень трудно понять, ну если что, могу ответить на вопросы. Некоторые строчки прокомментировал.

Вообще, я делал симулятор вот этого.

Программа требует 2 текстовых файла. Я их прикрепил. Их можно изменять, тоже всё работает.

Pascal

uses GraphABC;
 
type
  field = array[1..600,1..350] of boolean;
  
var
  i,stages:integer;
  xCells,yCells,cellSize:integer;
  config:text;
  presets_answer,torus_answer:string[5];
  torus_run:boolean;  
  oldStage,newStage:field;
  
procedure settingsScan;
begin
  assign(config,'Settings.txt');
  reset(config); readln(config);
  readln(config,xCells); readln(config);
  readln(config,yCells); readln(config);
  readln(config,Cellsize); readln(config);
  readln(config,stages); readln(config);
  readln(config,presets_answer); readln(config);
  readln(config,torus_answer); close(config);
end;
 
procedure Grid;
var
  i:integer;
begin
  For i:=1 to xCells+1 do
  begin
    Line((cellSize+1)*(i-1)+1,1,(cellSize+1)*(i-1)+1,(cellSize+1)*yCells+1)
  end;
    For i:=1 to yCells+1 do
  begin
    Line(1,(cellSize+1)*(i-1)+1,(cellSize+1)*xCells+1,(cellSize+1)*(i-1)+1)
  end;
end;
 
procedure addLife(x,y:integer);
begin
  setbrushcolor(clBlack);
  rectangle((cellSize+1)*(x-1)+1,(cellSize+1)*(y-1)+1,(cellSize+1)*x+2,(cellSize+1)*y+2);
  setbrushcolor(clWhite);
  oldStage[x,y]:=true;
end;
 
procedure removeLife(x,y:integer);
begin
  rectangle((cellSize+1)*(x-1)+1,(cellSize+1)*(y-1)+1,(cellSize+1)*x+2,(cellSize+1)*y+2);
end;
 
function LifeCheck(x,y:integer):boolean;
begin
  If GetPixel((cellSize+1)*(x-1)+2,(cellSize+1)*(y-1)+2)=rgb(255,255,255)
  then LifeCheck:=false
  else LifeCheck:=true;
end;
 
function torus (x,maxCells:integer;torus_run:boolean):integer;
begin
  torus:=x;
  If x<1
  then torus:=maxCells;
  If x>maxCells
  then torus:=1;
  If torus_run=false
  then torus:=x;
end;
 
function LifeCount(x,y:integer;torus_run:boolean):integer;
var
  Counter:integer;
begin
  If oldStage[torus(x-1,xCells,torus_run),y]=true
  then Inc(counter);
  If oldStage[torus(x+1,xCells,torus_run),y]=true
  then Inc(counter);
  If oldStage[x,torus(y-1,yCells,torus_run)]=true
  then Inc(counter);
  If oldStage[x,torus(y+1,yCells,torus_run)]=true
  then Inc(counter);
  If oldStage[torus(x-1,xCells,torus_run),torus(y-1,yCells,torus_run)]=true
  then Inc(counter);
  If oldStage[torus(x+1,xCells,torus_run),torus(y+1,yCells,torus_run)]=true
  then Inc(counter);
  If oldStage[torus(x+1,xCells,torus_run),torus(y-1,yCells,torus_run)]=true
  then Inc(counter);
  If oldStage[torus(x-1,xCells,torus_run),torus(y+1,yCells,torus_run)]=true
  then Inc(counter);
  LifeCount:=counter;
end;
 
procedure StartPosition;
var
  i,j:integer;
  life:integer;
  preset:text;
begin
  assign(preset,'preset.txt');
  reset(preset);
  For i:=1 to xCells do
  begin
    For j:=1 to xCells do
    begin
      read(preset,life);
      If life=1
      then 
      begin
        addLife(j,i);
        oldStage[j,i]:=true;
      end
      else oldStage[j,i]:=false;
    end;
    readln(preset);
  end;
  close(preset);
end;
 
procedure Life; 
var
  i,j:integer;
begin
  For i:=1 to xCells do
  begin
    For j:=1 to yCells do
    begin
      If oldStage[i,j]=false
      then    //если изначально жизни не было
      begin
        If lifeCount(i,j,torus_run)=3
        then newStage[i,j]:=true
        else newStage[i,j]:=false;
      end  
      else    //если изначально жизнь была
      begin
        If (lifeCount(i,j,torus_run)=2) 
        or (lifeCount(i,j,torus_run)=3)
        then newStage[i,j]:=true
        else newStage[i,j]:=false;
      end;
    end;
  end;
  For i:=1 to xCells do
  begin
    For j:=1 to yCells do
    begin
      If oldStage[i,j]=false
      then 
      begin
        If newStage[i,j]=true
        then addLife(i,j);
      end
      else
      begin
        If newStage[i,j]=false
        then removeLife(i,j);
      end;
    end;
  end;
  oldStage:=newStage; //Перед началом нового шага записываем новые результаты в старые
end;
 
begin
  settingsScan; //Считываем настройки из файла
  Grid; //Рисуем сетку n на m
  
  If presets_answer='yes'
  then StartPosition; //Расставляем начальные клетки
  If torus_answer='yes' //Эмуляция поверхности тора
  then torus_run:=true
  else torus_run:=false;
  
  For i:=1 to stages do Life;
end.

@КонецСвета · 16.06.2013, 11:16

Destiner, ваш проект у меня работает и с вариантом sleep и с вариантом delay
(у меня Pabc.NET версия 1.8 сборка 496)

@Destiner · 16.06.2013, 11:47 **[ТС]**

У меня была версия 1.8 сборка 500+ (не помню точнее). Поставил 2.1 (т.е. новейшую версию) программа ведёт себя так же.
Версия 1.8 (515) тоже ничего не изменила.
От администратора запускать не помогает.
Ну, раз проблема только с моей стороны, тут мало чем уже поможешь =)
Спасибо за помощь, буду пользоваться sleep()

@КонецСвета · 16.06.2013, 11:52

...не знаю, имеет ли это значение: у меня Windows XP...
в любом случае, удачи! спасибо за программу )

@xtaz · 16.06.2013, 12:07

Прикольная штука, но вот у меня она заканчивается в один прекрасный момент (всегда один и тот же)

@Destiner · 16.06.2013, 12:28 **[ТС]**

В settings можно изменить число шагов на любое натуральное число. Да и вообще там много чего изменить можно =)

@xtaz · 16.06.2013, 13:04

упс, не подумал)))

Добавлено через 2 минуты
круто))) а чтобы случайное заполнение было в начале, и задержка по-больше??? крутая заставочка получается)))

Добавлено через 8 минут
странно, изменяю пресет и прога останавливается раньше чем должна, а если убираю его, то вовсе все клетки пустые(((

@Destiner · 16.06.2013, 13:20 **[ТС]**

По поводу изменения пресета, там надо аккуратно. Вообще его менять не очень удобно, хочу сделать создание пресетов через GUI, чтобы он рисовал сетку, а ты тыкал на клеточки, где нужно добавить жизнь. И в конце всё это сохранять в txt, который уже будет использовать основная программа.
Ну, это позже.

Добавлено через 24 секунды
А вот версия по твоему запросу.

Pascal

uses GraphABC;
 
type
  field = array[1..600,1..350] of boolean;
  
var
  i,stages:integer;
  xCells,yCells,cellSize:integer;
  time,delay:integer;
  k:real;
  config:text;
  presets_answer,torus_answer:string[5];
  torus_run:boolean;  
  oldStage,newStage:field;
  
procedure settingsScan;
begin
  assign(config,'Settings.txt');
  reset(config); readln(config);
  readln(config,xCells); readln(config);
  readln(config,yCells); readln(config);
  readln(config,Cellsize); readln(config);
  readln(config,stages); readln(config);
  readln(config,delay); readln(config);
  readln(config,k); readln(config);
  readln(config,presets_answer); readln(config);
  readln(config,torus_answer); close(config);
end;
 
procedure Grid;
var
  i:integer;
begin
  For i:=1 to xCells+1 do
  begin
    Line((cellSize+1)*(i-1)+1,1,(cellSize+1)*(i-1)+1,(cellSize+1)*yCells+1)
  end;
    For i:=1 to yCells+1 do
  begin
    Line(1,(cellSize+1)*(i-1)+1,(cellSize+1)*xCells+1,(cellSize+1)*(i-1)+1)
  end;
end;
 
procedure addLife(x,y:integer);
begin
  setbrushcolor(clBlack);
  rectangle((cellSize+1)*(x-1)+1,(cellSize+1)*(y-1)+1,(cellSize+1)*x+2,(cellSize+1)*y+2);
  setbrushcolor(clWhite);
  oldStage[x,y]:=true;
end;
 
procedure removeLife(x,y:integer);
begin
  rectangle((cellSize+1)*(x-1)+1,(cellSize+1)*(y-1)+1,(cellSize+1)*x+2,(cellSize+1)*y+2);
end;
 
function LifeCheck(x,y:integer):boolean;
begin
  If GetPixel((cellSize+1)*(x-1)+2,(cellSize+1)*(y-1)+2)=rgb(255,255,255)
  then LifeCheck:=false
  else LifeCheck:=true;
end;
 
function torus (x,maxCells:integer;torus_run:boolean):integer;
begin
  torus:=x;
  If x<1
  then torus:=maxCells;
  If x>maxCells
  then torus:=1;
  If torus_run=false
  then torus:=x;
end;
 
function LifeCount(x,y:integer;torus_run:boolean):integer;
var
  Counter:integer;
begin
  If oldStage[torus(x-1,xCells,torus_run),y]=true
  then Inc(counter);
  If oldStage[torus(x+1,xCells,torus_run),y]=true
  then Inc(counter);
  If oldStage[x,torus(y-1,yCells,torus_run)]=true
  then Inc(counter);
  If oldStage[x,torus(y+1,yCells,torus_run)]=true
  then Inc(counter);
  If oldStage[torus(x-1,xCells,torus_run),torus(y-1,yCells,torus_run)]=true
  then Inc(counter);
  If oldStage[torus(x+1,xCells,torus_run),torus(y+1,yCells,torus_run)]=true
  then Inc(counter);
  If oldStage[torus(x+1,xCells,torus_run),torus(y-1,yCells,torus_run)]=true
  then Inc(counter);
  If oldStage[torus(x-1,xCells,torus_run),torus(y+1,yCells,torus_run)]=true
  then Inc(counter);
  LifeCount:=counter;
end;
 
procedure StartPosition;
var
  i,j:integer;
  life:integer;
begin
  randomize;
 
  For i:=1 to xCells do
  begin
    For j:=1 to yCells do
    begin
      if random<k
      then addLife(i,j);
    end;
  end;
end;
 
procedure Life; 
var
  i,j:integer;
begin
  For i:=1 to xCells do
  begin
    For j:=1 to yCells do
    begin
      If oldStage[i,j]=false
      then    //если изначально жизни не было
      begin
        If lifeCount(i,j,torus_run)=3
        then newStage[i,j]:=true
        else newStage[i,j]:=false;
      end  
      else    //если изначально жизнь была
      begin
        If (lifeCount(i,j,torus_run)=2) 
        or (lifeCount(i,j,torus_run)=3)
        then newStage[i,j]:=true
        else newStage[i,j]:=false;
      end;
    end;
  end;
  For i:=1 to xCells do
  begin
    For j:=1 to yCells do
    begin
      If oldStage[i,j]=false
      then 
      begin
        If newStage[i,j]=true
        then addLife(i,j);
      end
      else
      begin
        If newStage[i,j]=false
        then removeLife(i,j);
      end;
    end;
  end;
  oldStage:=newStage;
end;
 
begin
  settingsScan;
  Grid;
  
  If presets_answer='yes'
  then StartPosition;
  If torus_answer='yes'
  then torus_run:=true
  else torus_run:=false;
  
  If stages = 0
  then 
  begin
    while true do
    begin
      time := milliseconds;
      Life;
      time := milliseconds - time;
      If delay>time
      then sleep(delay-time);
    end;
  end
  else
  begin
    For i:=1 to stages do 
    begin
      time := milliseconds;
      Life;
      time := milliseconds - time;
      If delay>time
      then sleep(delay-time);
    end;
  end;  
end.

@Destiner · 16.06.2013, 13:21 **[ТС]**

Тут нужен только файл settings. Он изменён, поэтому прилагаю к сообщению.

Вот тут с настройками аккуратно. В той версии у нас был только один глайдер, и даже если рисовать поле 650 на 300, тормозит не сильно. Тут на первых порах создаётся много живых клеток и пока большинство не умрёт (а большинство всегда умирает), будет некрасиво отрисовываться полинейно.

Я отрегулировал настройки, чтобы это торможение было минимальным, но коэффициент можно ставить и 0.8, например, тогда почти все клетки будут живыми. Поле тоже можно расширять, но именно расширение поля порождает лаги. Моя эмуляция пока слабо оптимизирована, т. к. никогда не запускал больше одного глайдера на поле.
Потом возможно сделаю что-нибудь с этим.

@xtaz · 16.06.2013, 13:27

Всё, разобрался (перечитал правила), написал StartPositionRandom и всё покатило + вставил sleep(100), сижу разглядываю))))

@КонецСвета · 16.06.2013, 13:31

Destiner, да, у меня тоже сразу же возникла мысль создать стартовую процедуру, в которой пользователь сам сможет поместить клетки на плоскость )

@xtaz · 16.06.2013, 13:35

И нужно тогда дописать условия окончания игры и желательно сразу с перезапуском)))) Чтобы она НИКОГДА не кончалась))))

@Destiner · 16.06.2013, 15:06 **[ТС]**

Да, но это довольно проблематично. Вы наверное уже заметили, что почти всегда остаётся несколько вращающихся фигурок 3 на 1. То есть, если просто написать

Pascal

1	if (oldStage = newStage) then startPosition

и останется хоть одна фигурка 3 на 1, этот оператор никогда не сработает.
Можно конечно сделать сравнение, например, с двумя предыдущими поколениями.
Но и это поможет не всегда. Во-первых, есть фигурки, у которых цикл повтора 8 (возможно есть и больше).
Во-вторых, ещё проще, если остался хоть один глайдер, он будет вечно двигаться по диагонали и там уже придётся записывать 50+ предыдущих поколений.

P. S. Я конечно, уже давно думал, что программу нужно как минимум останавливать, если поколения повторяются, но сделать это оказалось не так просто.

@КонецСвета Почетный модератор 7966 / 3937 / 2464 Регистрация: 30.10.2011 Сообщений: 5,377
	16.06.2013, 13:31	17
	Destiner, да, у меня тоже сразу же возникла мысль создать стартовую процедуру, в которой пользователь сам сможет поместить клетки на плоскость ) 0

@Destiner 2 / 2 / 0 Регистрация: 15.10.2012 Сообщений: 17
		1
	Конфликт модулей crt и GraphABC 12.06.2013, 15:36. Показов 15314. Ответов 18 Метки нет (Все метки) Всем привет. Пишу небольшую программку с использованием графического модуля. Понадобилось использовать функцию delay(), поэтому также подключил модуль crt. В итоге, программа не запускается. Удаляю модуль crt и всё работает. Можно ли исправить? Если да, то как? 0

@BaboshinSD 349 / 288 / 49 Регистрация: 15.11.2012 Сообщений: 477 Записей в блоге: 1
	12.06.2013, 16:13	3
	Сообщение от Destiner Можно ли исправить? Сообщение от Destiner Удаляю модуль crt и всё работает. Сам спросил - сам ответил. Добавлено через 2 минуты Если всё таки без Crt что-то не работает, то перепишите код без Crt или скиньте код. 0

@КонецСвета Почетный модератор 7966 / 3937 / 2464 Регистрация: 30.10.2011 Сообщений: 5,377
	16.06.2013, 00:40	5
	Destiner, нну, если можете код выложить (хотя бы часть) то и мы охотно поломаем голову ) sleep - процедура из общих; Делает паузу на ms миллисекунд delay - процедура модуля crt; Осуществляет задержку на ms миллисекунд. "везде" delay (это турбо и free паскаль), "везде" sleep (это pascalABC и pascalABC.NET) 1

@BaboshinSD 349 / 288 / 49 Регистрация: 15.11.2012 Сообщений: 477 Записей в блоге: 1
	16.06.2013, 09:18	6
	Сообщение от КонецСвета и мы охотно поломаем голову ) Сообщение от КонецСвета sleep - процедура из общих Точнее из System.pas, так что использовать её предпочтительнее. 2

@КонецСвета Почетный модератор 7966 / 3937 / 2464 Регистрация: 30.10.2011 Сообщений: 5,377
	16.06.2013, 11:16	8
	Destiner, ваш проект у меня работает и с вариантом sleep и с вариантом delay (у меня Pabc.NET версия 1.8 сборка 496) 0

@Destiner 2 / 2 / 0 Регистрация: 15.10.2012 Сообщений: 17
	16.06.2013, 11:47 [ТС]	9
	У меня была версия 1.8 сборка 500+ (не помню точнее). Поставил 2.1 (т.е. новейшую версию) программа ведёт себя так же. Версия 1.8 (515) тоже ничего не изменила. От администратора запускать не помогает. Ну, раз проблема только с моей стороны, тут мало чем уже поможешь =) Спасибо за помощь, буду пользоваться sleep() 0

@КонецСвета Почетный модератор 7966 / 3937 / 2464 Регистрация: 30.10.2011 Сообщений: 5,377
	16.06.2013, 11:52	10
	...не знаю, имеет ли это значение: у меня Windows XP... в любом случае, удачи! спасибо за программу ) 1

@xtaz 1 / 1 / 1 Регистрация: 31.05.2013 Сообщений: 40
	16.06.2013, 12:07	11
	Прикольная штука, но вот у меня она заканчивается в один прекрасный момент (всегда один и тот же) 0

@Destiner 2 / 2 / 0 Регистрация: 15.10.2012 Сообщений: 17
	16.06.2013, 12:28 [ТС]	12
	В settings можно изменить число шагов на любое натуральное число. Да и вообще там много чего изменить можно =) 0

@xtaz 1 / 1 / 1 Регистрация: 31.05.2013 Сообщений: 40
	16.06.2013, 13:04	13
	упс, не подумал))) Добавлено через 2 минуты круто))) а чтобы случайное заполнение было в начале, и задержка по-больше??? крутая заставочка получается))) Добавлено через 8 минут странно, изменяю пресет и прога останавливается раньше чем должна, а если убираю его, то вовсе все клетки пустые((( 0

	16.06.2013, 15:06

@xtaz 1 / 1 / 1 Регистрация: 31.05.2013 Сообщений: 40
	16.06.2013, 13:27	16
	Всё, разобрался (перечитал правила), написал StartPositionRandom и всё покатило + вставил sleep(100), сижу разглядываю)))) 0

@xtaz 1 / 1 / 1 Регистрация: 31.05.2013 Сообщений: 40
	16.06.2013, 13:35	18
	И нужно тогда дописать условия окончания игры и желательно сразу с перезапуском)))) Чтобы она НИКОГДА не кончалась)))) 0