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;{не хватало end;}

procedure vabr(strok:string);
var
i:integer; // убрал лишние переменные
begin
vas:=1;// - будет количество получившихся строк
vars[1]:=''; // что бы с прошлого вызова ничего не осталось
for i:=1 to length(strok) do begin //разбивка на пункты
if copy(strok,i-1,i)=',' then begin vas:=lines+1;vars[vas]:='';i:=i+1; end;
if copy(strok,i-1,i)<>' ' then vars[vas]:=vars[vas]+copy(strok,i-1,i); // вырезаем пробелы каторые могут быть
// иначе могут быть неувязки при проверке ведь 'end'<>' end'
end;
{---------------------Cоздание переменных-------------------------------------------}

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 copy(hel,0,5)='write' then begin lel:=copy(hel,7,hellen-2); write(lel,5000); end;
if copy(hel,0,2)='var' then begin lel:=copy(hel,4,hellen); vabr(lel); end;
end;
end;
{------------------------------------------------}
begin
massivizstroki('program beg;var a,b,c;begin;write("helloworld");end');
main;
end.
спасибо всем кто мне помогает

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;{не хватало end;}

procedure vabr(strok:string);
var
i:integer; // убрал лишние переменные
begin
vas:=1;// - будет количество получившихся строк
vars[1]:=''; // что бы с прошлого вызова ничего не осталось
for i:=1 to length(strok) do begin //разбивка на пункты
if copy(strok,i-1,i)=',' then begin vas:=lines+1;vars[vas]:='';i:=i+1; end;
if copy(strok,i-1,i)<>' ' then vars[vas]:=vars[vas]+copy(strok,i-1,i); // вырезаем пробелы каторые могут быть
// иначе могут быть неувязки при проверке ведь 'end'<>' end'
end;
{---------------------Cоздание переменных-------------------------------------------}

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 copy(hel,0,5)='write' then begin lel:=copy(hel,7,hellen-2); write(lel,5000); end;
if copy(hel,0,2)='var' then begin lel:=copy(hel,4,hellen); vabr(lel); end;
end;
end;
{------------------------------------------------}
begin
massivizstroki('program beg;var a,b,c;begin;write("helloworld");end');
main;
end.

Регистрация: 09.01.2009
Сообщений: 6
Написано 0 полезных сообщений
(для 0 пользователей) Ответ: Интерпретатор в телефоне
кто нибудь пробовал делать интерпретатор паскаля? я попробовал и вот что пока получилось
program pascal;
{-----------------------------------------------------------------}
var
tm:array[1..40] of string; // максимальное к-во пунктов
vars:array[1..40] of string; {имена переменных}
values:array[1..40] of string;{значения переменных, каждая переменная имеет свой ид номер в 2 массивах одинаков}
lines:integer;
vas:integer;
{---------------------------------------------------------------}
function getidforname(name:string):integer;
var ad:integer;
begin
for ad:=1 to 40 do
begin
if vars[ad] = name then getidforname:=ad break;
end;
end;
{-----------------------------------------------------------------}
function getnameforid(id:string):string;
var ads:integer;
begin
for ads:=1 to 40 do
begin
if vars[ads]=id then getnameforid:=vars[ads] break;
end;
end;
{---------------------------------------------------------------------}
procedure setvalue(variable,value:string);
var temp:integer;
begin
temp:=getidforname(variable);
values[temp]:=value;
end;
{---------------------------------------------------------------------}
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;{не хватало end;}

procedure vabr(strok:string);
var
i:integer; // убрал лишние переменные
begin
vas:=1;// - будет количество получившихся строк
vars[1]:=''; // что бы с прошлого вызова ничего не осталось
for i:=1 to length(strok) do begin //разбивка на пункты
if copy(strok,i-1,i)=',' then begin vas:=lines+1;vars[vas]:='';i:=i+1; end;
if copy(strok,i-1,i)<>' ' then vars[vas]:=vars[vas]+copy(strok,i-1,i); // вырезаем пробелы каторые могут быть
// иначе могут быть неувязки при проверке ведь 'end'<>' end'
end;
{---------------------Cоздание переменных-------------------------------------------}

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 copy(hel,0,5)='write' then begin lel:=copy(hel,7,hellen-2); write(lel,5000); end;
if copy(hel,0,2)='var' then begin lel:=copy(hel,4,hellen); vabr(lel); end;
end;
end;
{------------------------------------------------}
begin
massivizstroki('program beg;var a,b,c;begin;write("helloworld");end');
main;
end.
(Offline)