|
интерпретатор языка программирования паскаль
| |
| programmer | Дата: Среда, 15.04.2009, 11:45 | Сообщение # 1 |
|
Умный
Группа: Проверенные
Сообщений: 599
| почемуто неработает 
посмотрите ктонибудь пожалуйста
program pascal;
{-----------------------------------------------------------------}
var
tm:array[1..40] of string; // максимальное к-во пунктов
lines:integer;
{-----------------------------------------------------------------}
procedure massivizstroki(stroka:string);{процедура создает массив из строки,писал ее не я,а 12121}
var
n,tmend:integer;//tmend - количество получившихся строк
t:string;
begin
tmend:=1;
t:=stroka;
for n:=1 to length(t) do begin //разбивка на пункты
if copy(t,n-1,n)=';' then begin tmend:=tmend+1;n:=n+1; end;
tm[tmend]:=tm[tmend]+copy(t,n-1,n);
end;
lines:=tmend;
end;
{-----------------------------------------------}
procedure write(what:string;del:integer);
begin
drawText(what, 0, 0);
repaint;
delay(del);
end;
{------------------------------------------------}
procedure main;
var h:integer;
hel,lel:string;
hellen:integer;
begin
hellen:=Length(hel);
for h:=1 to lines do
begin
hel:=tm[h];
if hel='begin' then break;
else if hel='end' then break;
else if Copy(hel,0,6)='program' then break;
else if copy(hel,0,4)='write' then lel:=copy(hel,7,hellen-2) write(lel,5000);
end;
end;
{------------------------------------------------}
begin
massivizstroki('program;begin;write("helloworld");end');
main;
end.
|
| |
| |
| 121212 | Дата: Среда, 15.04.2009, 11:57 | Сообщение # 2 |
|
Программист
Группа: Проверенные
Сообщений: 268
Награды: 7
Репутация:
« 14 »
Статус: Offline
| вот исходник басика посмотри может поможет)
|
| |
| |
| programmer | Дата: Среда, 15.04.2009, 17:14 | Сообщение # 3 |
|
Умный
Группа: Проверенные
Сообщений: 599
| непоможет! там все подругому реализовано!
|
| |
| |
| 121212 | Дата: Среда, 15.04.2009, 17:50 | Сообщение # 4 |
|
Программист
Группа: Проверенные
Сообщений: 268
Награды: 7
Репутация:
« 14 »
Статус: Offline
| тогда я не знаю
всё комплитса а нет отрисовки
|
| |
| |
| 12121 | Дата: Четверг, 16.04.2009, 14:05 | Сообщение # 5 |
|
Программист
Группа: Проверенные
Сообщений: 357
| program pascal;
{-----------------------------------------------------------------}
var
tm:array[1..40] of string; // максимальное к-во пунктов
lines:integer;
{-----------------------------------------------------------------} procedure soob(t: string);{ вывод сообщения. также удобно искать ошибки}
var n,m,r,n1: integer;
begin
n:= getStringWidth(t);m:= getStringHeight(t);{ n - ширина m - высота строки текста }
setColor(145,135,255);fillrect((getWidth - n) / 2-5,(getHeight - m) / 2-5,n+10,m+10);{ очищаем прямоугольник под текст }
setColor(140,10,35); if n<=getWidth then drawText(t, (getWidth - n) / 2,(getHeight - m) / 2); { центруем и печатаем если целикомпомещается на экране }
else begin r:=n-getWidth; for n1:=0 to r do begin { вычисляем сколько пикселей не влезло }
setColor(145,135,255);fillrect((getWidth - n) / 2-3,(getHeight - m) / 2-3,n+6,m+6); { если не очистить просто смажется }
setColor(140,10,35);drawText(t,0-n1,(getHeight - m) / 2);repaint; delay(10);{ центруем и печатаем }
if n1=0 then delay(2000);end;end; { задержка что б прочесть начало строки }
repaint;delay(1000);setColor(145,135,255);fillrect((getWidth - n) / 2-5,(getHeight - m) / 2-5,n+10,m+10);
end; procedure massivizstroki(stroka:string);{процедура создает массив из строки,писал ее не я,а 12121}
var
n:integer; // убрал лишние переменные
begin
lines:=1;// - будет количество получившихся строк
tm[1]:=''; // что бы с прошлого вызова ничего не осталось
for n:=1 to length(stroka) do begin //разбивка на пункты
if copy(stroka,n-1,n)=';' then begin lines:=lines+1;tm[lines]:='';n:=n+1; end;
if copy(stroka,n-1,n)<>' ' then tm[lines]:=tm[lines]+copy(stroka,n-1,n); // вырезаем пробелы каторые могут быть
// иначе могут быть неувязки при проверке ведь 'end'<>' end'
end; end;
{-----------------------------------------------}
procedure write(what:string;del:integer);
begin
drawText(what, 0, 0);
repaint;
delay(del);
end;
{------------------------------------------------}
procedure main;
var h:integer;
hel,lel:string;
hellen:integer;
begin for h:=1 to lines do
begin
hel:=tm[h];// soob(hel);
hellen:=Length(hel);
//if hel='begin' then break; // после обработки 'program' выход из цикла и ничего больше не проверяется !!
if hel='end' then break; // короткие команы нужно проверить раньше длинных: если hel='end' то copy(hel,0,5) приведет к зависанию !!
//if Copy(hel,0,7)='program' then break;
//soob('|'+copy(hel,0,5)+'|'); // это я так искал ошибку 
if copy(hel,0,5)='write' then begin lel:=copy(hel,7,hellen-2); write(lel,5000); end;
end;
end;
{------------------------------------------------}
begin
massivizstroki('program;begin;write("helloworld");end');
main;
end. в чем были проблемы смотри в комментах
|
| |
| |
| programmer | Дата: Четверг, 16.04.2009, 15:19 | Сообщение # 6 |
|
Умный
Группа: Проверенные
Сообщений: 599
| спасибо! теперь реализую переменные 
|
| |
| |
| programmer | Дата: Четверг, 16.04.2009, 15:29 | Сообщение # 7 |
|
Умный
Группа: Проверенные
Сообщений: 599
| у меня получается много лишнего проверялось... 
потому что если строка бегин то можно ниче не делать и не проверять и т.д спасибо понял 
|
| |
| |
| 12121 | Дата: Четверг, 16.04.2009, 15:31 | Сообщение # 8 |
|
Программист
Группа: Проверенные
Сообщений: 357
| С пробелами я немного поспешил. Их надо убирать только перед операторами. Потом по ходу видно будет как лучше сделать.
|
| |
| |
| 12121 | Дата: Четверг, 16.04.2009, 15:35 | Сообщение # 9 |
|
Программист
Группа: Проверенные
Сообщений: 357
| Бегин это на будущее. Он нужен например в if a то будет непонятно где if кончается.
|
| |
| |
| programmer | Дата: Четверг, 16.04.2009, 15:39 | Сообщение # 10 |
|
Умный
Группа: Проверенные
Сообщений: 599
| program pascal;
{-----------------------------------------------------------------}
var
tm:array[1..40] of string; // максимальное к-во пунктов
lines:integer;
varvalues:array[1..40] of string;
varnames:array[1..40] of string;
allvars:integer;
{-----------------------------------------------------------------} procedure soob(t: string);{ вывод сообщения. также удобно искать ошибки}
var n,m,r,n1: integer;
begin
n:= getStringWidth(t);m:= getStringHeight(t);{ n - ширина m - высота строки текста }
setColor(145,135,255);fillrect((getWidth - n) / 2-5,(getHeight - m) / 2-5,n+10,m+10);{ очищаем прямоугольник под текст }
setColor(140,10,35); if n<=getWidth then drawText(t, (getWidth - n) / 2,(getHeight - m) / 2); { центруем и печатаем если целикомпомещается на экране }
else begin r:=n-getWidth; for n1:=0 to r do begin { вычисляем сколько пикселей не влезло }
setColor(145,135,255);fillrect((getWidth - n) / 2-3,(getHeight - m) / 2-3,n+6,m+6); { если не очистить просто смажется }
setColor(140,10,35);drawText(t,0-n1,(getHeight - m) / 2);repaint; delay(10);{ центруем и печатаем }
if n1=0 then delay(2000);end;end; { задержка что б прочесть начало строки }
repaint;delay(1000);setColor(145,135,255);fillrect((getWidth - n) / 2-5,(getHeight - m) / 2-5,n+10,m+10);
end; procedure massivizstroki(stroka:string);{процедура создает массив из строки,писал ее не я,а 12121}
var
n:integer; // убрал лишние переменные
begin
lines:=1;// - будет количество получившихся строк
tm[1]:=''; // что бы с прошлого вызова ничего не осталось
for n:=1 to length(stroka) do begin //разбивка на пункты
if copy(stroka,n-1,n)=';' then begin lines:=lines+1;tm[lines]:='';n:=n+1; end;
if copy(stroka,n-1,n)<>' ' then tm[lines]:=tm[lines]+copy(stroka,n-1,n); // вырезаем пробелы каторые могут быть
// иначе могут быть неувязки при проверке ведь 'end'<>' end'
end; end;
{-----------------------------------------------}
procedure write(what:string;del:integer);
begin
drawText(what, 0, 0);
repaint;
delay(del);
end;
{------------------------------------------------}
procedure main;
var h:integer;
hel,lel:string;
hellen:integer;
begin
allvars:=1;
for h:=1 to lines do
begin
hel:=tm[h];// soob(hel);
hellen:=Length(hel);
if hel='end' then break; // короткие команы нужно проверить раньше длинных: если hel='end' то copy(hel,0,5) приведет к зависанию !!
//soob('|'+copy(hel,0,5)+'|'); // это я так искал ошибку
if copy(hel,0,5)='write' then begin lel:=copy(hel,7,hellen-2); write(lel,5000); end;
if copy(hel,0,6)='varinit' then begin varnames[allvars]:=Copy(hel,8,hellen);allvars:=allvars+1 end;
end;
end;
{------------------------------------------------}
begin
massivizstroki('program;begin;write("helloworl");end');
main;
end.
а теперь что не так? 
|
| |
| |
| programmer | Дата: Четверг, 16.04.2009, 15:42 | Сообщение # 11 |
|
Умный
Группа: Проверенные
Сообщений: 599
| всмыслк при инициализации переменной прога неработает
|
| |
| |
| 12121 | Дата: Четверг, 16.04.2009, 15:54 | Сообщение # 12 |
|
Программист
Группа: Проверенные
Сообщений: 357
| сначала надо создать массив из переменных которые обьявляются в программе. и с ним потом сравнивать. или что ты этой строкой хотел сделать?
|
| |
| |
| programmer | Дата: Четверг, 16.04.2009, 15:59 | Сообщение # 13 |
|
Умный
Группа: Проверенные
Сообщений: 599
| я хотел сначало добавить два массива по 40 элементов и переменная содержащяя их размер.
переменная объяв так:
1)в массив записывается ее название
2)во второй массив ее значение.
3)значение переменной allvars увелич на 1.
строка записывает то что после варинт в массив
|
| |
| |
| 12121 | Дата: Четверг, 16.04.2009, 16:00 | Сообщение # 14 |
|
Программист
Группа: Проверенные
Сообщений: 357
| if copy(hel,0,6)='varinit'
ты пытаешься отрезать от строки то чего там нет ведь сначала попадает под проверку begin
а это максимум copy(hel,0,5) !!
|
| |
| |
| 12121 | Дата: Четверг, 16.04.2009, 16:01 | Сообщение # 15 |
|
Программист
Группа: Проверенные
Сообщений: 357
| programm проходит конечно проверку нормально
а вообще сначала надо все продумать
|
| |
| |
|
