Извините, ничего не найдено.

abcdef · 31.10.2008, 19:08

Выкладываю свой интерпретатор, который когда-то делал для компьютера, после знакомства с MidletPascal переложил ее для программирования в телефоне. Подобных программ для сотовых всего несколько.

Синтаксис кода для интерпретатора нечто среднее между pascal/c/php/basic. В программе имеются примеры, поясняющие составление и работу программ.

Для просмотра примеров жмите кнопку "DEMO" - появляется следующий пример, для запуска кнопка "RUN" программа запускается в пошаговом режиме отладки, следующий шаг - кнопка "DEBUG" для перевода в нормальный режим кнопка "BREK", также кнопка "BREK"-завершение программы, "DEBUG"-переход в режим отладки.

Текущая версия написана полностью возможностями MIDletPascal, т.к. первые версии делались в среде не позволяющей подключать внешние дополнительные java-библиотеки, а со временем делался упор на совместимость со всеми телефонами, поэтому набор стандартных подпрограмм интерпретатора содержит минимум необходимого, но их нетрудно расширить.

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

___
заходите на мои темы:

www.boolean.name > Программирование игр для мобильных телефонов > MidletPascal > создание MIDletPascal compiler'a

www.boolean.name > Программирование игр для мобильных телефонов > MidletPascal > интересные исходники или идеи реализации в MP

если есть дельные советы - помогайте!

___
да простят меня читатели сего поста, выложу полный исходный текст, помимо упакованного проекта - файл <b.zip>

{BASIC v0.2 by arT                                                }
{Программа распространяется по лицензии GNU General Public License}
{запрещено коммерческое использование.                            }
{по вопросам распространения обращаться к автору                  }
{e-mail: [email protected]                                     }
 const  {таблицы памяти и переменных}
  memMax = 10239;
  tabMax = 2047;
const  {типы данных возвращаемые виртуальной машиной-интерпретатором}
  _void   = 0;  {ничего}
  _newline= 1;  {команда для перехода вывода на новую строку (используется только в операторе вывода)}
  _str    = 2;  {строковая константа}
  _int    = 3;  {константа типа int}
  _arr    = 4;  {обращение к массиву}
  _var    = 5;  {обращение к переменной}
  //_proc   =-1;  {вызов процедцры}
  //_func   =-2;  {вызов функции}

var
  buf : array[0..memMax] of char;
  mem : array[0..memMax] of integer;
  tab : array[0..tabMax] of string;
  ind : array[0..tabMax] of integer;
  bp,mp,tp : integer;
  typ : integer;      {тип данных возврвщаемый виртуальной машиной}
  txt, s : string;
  err : boolean;
  ch  : char;
  {переменные для внутренных функций}
  x,y,rc,gc,bc,rb,gb,bb,w,h,debugN,demoN,n : integer;
  debug : boolean;
  cmd, addCmd, runCmd, demoCmd, exitCmd, breakCmd, debugCmd, nextCmd, negCmd, EnterCmd, bkspCmd : command;{}


procedure error(msg:string);
{вывод сообщения об ошибке и остановка программы}
var
  n : integer;
begin
  if err=false then
  begin
    setColor(0,0,0);
    fillRect(0, 0, getWidth, getHeight);
    setColor(255,0,0);
    {str(p,s);}
    drawText(msg+'>>'+bp{s},0,0);
    msg:='^';
    bp:=bp-1;
    for n:=0 to 20 do
    begin
      if (bp-n-1>0) then msg:=buf[bp-n-1]+msg;
      if (bp+n<memMax) then msg:=msg+buf[bp+n];
    end;
    drawText(msg,0,20);
    repaint;
    delay(500);
    err:=true;   {установить флаг прекращения работы}
  end;
end;


procedure debugOut(msg : string);
{вывод отладочной информации во время выполнения программы}
var
  r,g,b : integer;
begin
  repaint;
  delay(400);
  r := rc; {save color}
  g := gc;
  b := bc;
  setColor(0,0,0);
  fillRect(0,getHeight-20,getWidth,20);
  setColor(0,255,0);
  drawText('['+debugN+']'+msg,0,getHeight-20);
  setColor(r,g,b); {restory color}
  repaint;
  repeat
    delay(10);
    cmd := getClickedCommand;
    if cmd = breakCmd then  debug := false;
  until (cmd = breakCmd) or (cmd = debugCmd);
  repeat until (getClickedCommand=emptyCommand); {fill cmd buffer}
end;


function read : integer;
{прочитать с клавиатуры строку цифр и преобразовать в число}
var
  c : array[0..9] of char;
  s : string;
  i,n,len,ch : integer;
  ng : boolean;
begin
  ng := false;
  len := 0;
  addCommand(enterCmd);
  addCommand(bkspCmd);
  addCommand(negCmd);
  repeat
    if ng then s := '-' else s := '';
    for i := 0 to len-1 do  s := s+c[i];
    repeat
      drawText(s+'_',x,y); repaint; {show number}
      delay(80);
      setColor(rb,gb,bb); {delete number}
      drawText(s+'_',x,y); repaint;
      setColor(rc,gc,bc); {old color}
      delay(20);
      ch := getKeyPressed;
      cmd := getClickedCommand;
    until (ch <> 0) or (cmd <> emptyCommand); {while not press_a_key}
    //repeat until (getKeyPressed=0);  {Fill Key Buf}
    if (ch>=48) and (ch<=57) then
    begin
      if (len<9) then
      begin
        c[len] := chr(ch);
        len := len+1;
      end;
    end;
    if cmd = bkspCmd then   if (len>0) then  len := len-1;
    if cmd = negCmd then ng := not ng;
    if cmd = debugCmd then debug := true;
    if cmd = breakCmd then error('user break');
  until (cmd = enterCmd) or (cmd = breakCmd) or (cmd = debugCmd);
  repeat until (getClickedCommand=emptyCommand); {fill cmd buffer}
  if length(s) > 0 then  n := stringToInteger(s)  {Val(s, num, tmp1)}
    else n := 0;
  drawText(''+n,x,y);
  x:=x+getStringWidth(''+n);
  removeCommand(negCmd);
  removeCommand(bkspCmd);
  removeCommand(enterCmd);
  read:=n;
end;


function varn(ss : string) : integer;
{поиск переменной, если не найдена, то создать}
begin
  n:=-1; repeat n:=n+1; until (tab[n]=ss) or (n=tp);
  {for n := 0 to tp do begin if (tab[n]=ss) then break; end;{}
  if (n>=tp) then begin tab[tp{n}]:=ss; ind[tp{n}]:=mp; mem[mp]:=0; tp:=tp+1; mp:=mp+1; end;
  if debug=true then debugOut('$'+ss+'=['+ind[n] +']='+mem[ind[n]]+'  '+n+'/'+tp+'/'+mp);{}
  varn := ind[n];
end;


procedure get;
{получить символ из буфера скрипта}
begin
  ch:=buf[bp];
  bp:=bp+1;
  if (bp>memMax) then begin error('buffer out!'); bp:=memMax; end;
end;


procedure space;
{пропустить все пробклы и др спец. символы}
begin
  repeat
    while (ch<=chr(32)) and (err=false) do get;
    if ch<>'{' then break;
    repeat get; until (ch='}') or err;
    get;
  until err;
end;


procedure skip(c:char);
{пропустить указанный символ}
begin
  space;
  if ch<>c then error('char '+c);
  get;
end;


procedure block;
{пропустить блок операторов}
var
  n : integer;
begin
  n:=0;
  while (err=false) do
  begin
    if (ch='''') then repeat get; until ch=''''
    else if (ch='{') then  repeat get; until ch='}'
    else if (ch='(') then n:=n+1
    else if (ch=')') then begin n:=n-1; if (n<0) then break; end
    else if (ch=';') then if (n=0) then break;
    get;
  end;
end;


function basic : integer;
{основная подпрограмма синтаксического разбора и выполнения команд}
var
  t,m,b : integer;
  n : integer;
begin
  debugN := debugN+1;
  cmd := getClickedCommand;
  if (cmd=breakCmd) then  error('user break');
  if (cmd=debugCmd) then  debug:=true; {}
  {if keyPressed then begin k:=ord(readKey); if (k=27) then error('user break'); end;{}
  typ:=_void;
  n:=0;
  space;
  if (err=false) then
  if (ch>='a') and (ch<='z') then
  begin
    s:='';
    repeat
      s:=s+ch;
      get;
    until (ch<'a') or (ch>'z') or err;
    if debug=true then debugOut(s);{}
    if (s='if') then
    begin
      t:=tp;    {сохранить указатели таблиц (этим мы создаем область видимости переменной)}
      m:=mp;
      skip('(');
      n:=basic;
      skip(')');
      if (n<>0) then n:=basic
        else block;
      mp:=m;   {восстановить указатели таблиц (переменные созданые в этом блоке будут стерты)}
      tp:=t;
      typ:=_void;
    end
    else if (s='while') then
    begin
      skip('(');
      b:=bp-1;
      t:=tp;
      m:=mp;
      repeat
        bp:=b;
        get;
        n:=basic;
        skip(')');
        if (n=0) then break;
        n:=basic;
      until err;
      block;
      mp:=m;
      tp:=t;
      typ:=_void;
    end
    else if (s='do') then
    begin
      b:=bp-1;
      t:=tp;
      m:=mp;
      repeat
        bp:=b;
        get;
        n:=basic;
        skip('(')
      until (basic{<>}=0) or err;
      skip(')');
      mp:=m;
      tp:=t;
      typ:=_void;
    end
    else if (s='print') then
    begin
      skip('(');
      repeat
        {space;
        if (ch='''') then
        begin
          get;
          s:='';
          while (ch<>'''') and (err=false) do begin s:=s+ch; get; end;
          drawText(s,x,y);
          x:=x+getStringWidth(s);
          get;
        end
        else if (ch='#') then
        begin
          get;
          if ch<>'#' then
          begin
            s:=chr(basic);
            drawText(s,x,y);
            x:=x+getStringWidth(s);
          end
          else begin get; x:=w; end;
        end
        else
        begin
          s:=''+basic;
          drawText(s,x,y);
          x:=x+getStringWidth(s);
        end;}
        n:=basic;
        if (typ>=_int) then  s:=''+n;
        else if (typ=_newline) then  x:=w
        else if (typ<>_str) then error('string format');
        drawText(s,x,y);
        x:=x+getStringWidth(s);
        if (x>=w) then
        begin
          y:=y+getStringHeight(s+'A');
          if (y>=h) then y:=0;
          x:=0;
        end;
        space;
        if (ch<>',') then break;
        get;
      until err;
      skip(')');
      typ:=_void;
    end
    else if (s='read') then
    begin
      n:=read;
      typ:=_int;
    end
      {----------------------------------}
      else if s = 'cls' then {cls;}
      begin
        setColor(rb,gb,bb);
        fillRect(0,0,getWidth,getHeight);
        setColor(rc,gc,bc); {restory color}
        x := 0;
        y := 0;
        typ:=_void;
      end
      else if s = 'draw' then {draw;}
      begin
        rePaint;
        typ:=_void;
      end
      else if s = 'cur' then {cur(x,y);}
      begin
        skip('(');
{}      x := {trunc}(basic);
        skip(',');
{}      y := {trunc}(basic);
        skip(')');
        typ:=_void;
      end
      else if s = 'size' then {size(w,h);}
      begin
        skip('(');
{}      w := {trunc}(basic);
        skip(',');
{}      h := {trunc}(basic);
        skip(')');
        typ:=_void;
      end
      else if s = 'ssize' then {ssize;}
      begin
        w := getWidth;
        h := getHeight;
        typ:=_void;
      end
      else if s = 'key' then {a=key;}
      begin
        n := getKeyPressed;  {getKeyClicked}
        typ:=_int;
      end
      else if s = 'put' then {put;}
      begin
        plot(x,y);
        typ:=_void;
      end
      else if s = 'delay' then {delay(n);}
      begin
        skip('(');
{}      delay({trunc}(basic));
        skip(')');
        typ:=_void;
      end
      {--}
      else if s = 'rand' then {a=rand(max);}
      begin
        skip('(');
{}      n := random({trunc}(basic));
        skip(')');
        typ:=_int;
      end
      else if s = 'abs' then {a=abs(b-10);}
      begin
        skip('(');
{}      n := abs({trunc}(basic));
        skip(')');
        typ:=_int;
      end
      else if s = 'lineto' then {lineto(x2,y2);}
      begin
        skip('(');
{}      b  := {trunc}(basic);
        skip(',');
{}      m := {trunc}(basic);
        drawLine(x,y,b,m);
        x := b;
        y := m;
        skip(')');
        typ:=_void;
      end
      else if s = 'ell' then {ell(w,h);}
      begin
(*        skip('(');
        n := (basic);
        skip(',');
{}      drawEllipse(x,y,{trunc}(n),{trunc}(basic));
        skip(')');*)
        drawEllipse(x,y,w,h);
        typ:=_void;
      end
      else if s = 'fell' then {fell(w,h);}
      begin
(*        skip('(');
        n := (basic);
        skip(',');
{}      fillEllipse(x,y,{trunc}(n),{trunc}(basic));
        Skip(')');*)
        fillEllipse(x,y,w,h);
        typ:=_void;
      end
      else if s = 'rect' then {rect(w,h);}
      begin
(*        skip('(');
        n := basic;
        skip(',');
{}      drawRect(x,y,{trunc}(n),{trunc}(basic));
        skip(')');*)
        drawRect(x,y,w,h);
        typ:=_void;
      end
      else if s = 'frect' then {frect(w,h);}
      begin
(*        skip('(');
        n := basic;
        skip(',');
{}      fillRect(x,y,{trunc}(n),{trunc}(basic));
        skip(')');*)
        fillRect(x,y,w,h);
        typ:=_void;
      end
      else if s = 'setcol' then {setcol(r,g,b);}
      begin
        skip('(');
{}      rc := {trunc}(basic);
        skip(',');
{}      gc := {trunc}(basic);
        skip(',');
{}      bc := {trunc}(basic);
        setColor(rc,gc,bc);
        skip(')');
        typ:=_void;
      end
      else if s = 'getcol' then {a=getcol(num [1=r,2=g,3=b]);}
      begin
        skip('(');
{}      n := {trunc}(basic);
        if n=2 then n := gc
        else if n=3 then n := bc
        else n := rc;
        skip(')');
        typ:=_int;
      end
      else if s = 'swapcol' then {swapcol;}
      begin
        n:=rc; rc:=rb; rb:=n;
        n:=gc; gc:=rb; gb:=n;
        n:=bc; bc:=rb; bb:=n;
        setColor(rc,gc,bc);
        typ:=_void;
      end
      else if s = 'width' then {a=width;}
      begin
        n := w;
        typ:=_int;
      end
      else if s = 'height' then {a=height;}
      begin
        n := h;
        typ:=_int;
      end
      else if s = 'xcur' then {a=xcur;}
      begin
        n := x;
        typ:=_int;
      end
      else if s = 'ycur' then {a=ycur;}
      begin
        n := y;
        typ:=_int;
      end
      {--------------------}

    else error('bad: '+s);
  end
  else if (ch>='0') and (ch<='9') then
  begin    {n:=0;}
    repeat
      n:=n*10+ord(ch)-ord('0');
      get;
    until (ch<'0') or (ch>'9') or err;
    typ:=_int;
  end
  else if (ch='(') then
  begin
    repeat
      get;
      n:=basic;
    until (ch<>';') or err;
    skip(')');
  end
  else if (ch='$') then
  begin
    get;
    {n:=0;{}
    s:='';
    repeat
      s:=s+ch;
      n:=n+1;
      get;
    until (ch<'a') or (ch>'z') or err;
    if n>6 then error('too long name');
    if (ch='(') then  {подпрограммы}
    begin
      t:=varn(s+'(');
      if (mem[t]<>0) then
      begin
        get;
        skip(')');
        b:=bp-1;
        bp:=mem[t];
        get;
        t:=tp;
        m:=mp;
        n:=basic;  {вызов подпрограммы}
        mp:=m;
        tp:=t;
        bp:=b;
        get;
      end
      else
      begin        {инициализация подпрограммы}
        mem[t]:=bp-1;
        block;
      end;
      //if (typ=_int) or (typ=_var) then typ:=_func else  typ:=_proc;
    end
    else if (ch='[') then  {массивы}
    begin
      t:=varn(s+'[');
      get;
      n:=basic;    {полуить индекс элемента}
      skip(']');
      if typ>=_int then
      begin
        if (n<-1) or (n>=mem[t]) then
        begin
          if mem[t]=0 then     {инициализация массива}
          begin
            mem[t]:=n;         {установим размер массива}
            mp:=mp+n;         {выделим память}
          end
          else begin n:=0; error('index off'); end; {выход за границы массива}
        end;
      end
      else if (typ=_str) then  {создание массива из строки текста $a['abcdef']}
      begin
        if (mem[t]<>0) then error('array not is empty');
        mem[t]:=length(s);
        for n:=1 to length(s) do
        begin
          mem[mp]:=ord(getChar(s,n-1));
          mp:=mp+1;
        end;
      end
      else error('INT or VAR');
      t:=t+n+1;  {получить адрес в памити: начало_массива+индекс+пропустить_первый_элемент_размерность}
      n:=mem[t];
      typ:=_arr;
    end
    else             {иначе простая переменная integer}
    begin
      t:=varn(s);
      n:=mem[t];
      typ:=_var;
    end;
  end
  else if (ch='''') then
  begin
    get;
    s:='';
    while (ch<>'''') and (err=false) do
    begin
      s:=s+ch;
      get;
    end;
    get;
    //n:=-2;
    typ:=_str;
  end;
  else
  if (ch='#') then
  begin
    get;
    if (ch<>'#') then
    begin
      s:=chr(basic);
      typ:=_str;
    end
      else
      begin
        get;
        typ:=_newline;
      end;
  end;
  {блок арифметических и логических операций}
  space;
  if {(typ>=_int) and} (err=false) then
  begin
    if (ch='+') then
    begin
      get;
      if (ch='=') then
      begin
        get;
        if (typ>_int) then
        begin
          n:=n+basic;
          if(typ>=_int) then mem[t]:=n
           else error('INT or VAR');
        end
          else error(' VAR or ARRAY');
      end
        else n:=n+basic;
      typ:=_int;
    end
    else if (ch='-') then
    begin
      get;
      if (ch='=') then
      begin
        get;
        if (typ>_int) then
        begin
          n:=n-basic;
          if(typ>=_int) then mem[t]:=n
            else error('INT or VAR');
        end
          else error(' VAR or ARRAY');
      end
        else n:=n-basic;
      typ:=_int;
    end
    else if (ch='*') then
    begin
      get;
      if (ch='=') then
      begin
        get;
        if (typ>_int) then
        begin
          n:=n*basic;
          if(typ>=_int) then mem[t]:=n
            else error('INT or VAR');
        end
          else error(' VAR or ARRAY');
      end
        else n:=n*basic;
      typ:=_int;
    end
    else if (ch='/') then
    begin
      get;
      if (ch='=') then
      begin
        get;
        if (typ>_int) then
        begin
          b:=basic;
          if (b<>0) then n:=n div b;
          if(typ>=_int) then mem[t]:=n
            else error('INT or VAR');
        end
          else error(' VAR or ARRAY');
      end
      else
      begin
        b:=basic;
        if (b<>0) then n:=n div b;
      end;
      typ:=_int;
    end
    else if (ch='\') then
    begin
      get;
      if (ch='=') then
      begin
        get;
        if (typ>_int) then
        begin
          b:=basic;
          if (b<>0) then n:=n div b;
          if(typ>=_int) then mem[t]:=n
            else error('INT or VAR');
        end
          else error(' VAR or ARRAY');
      end
      else
      begin
        b:=basic;
        if (b<>0) then n:=n mod b;
      end;
      typ:=_int;
    end
    else if (ch='=') then
    begin
      get;
      if ch<>'=' then
      begin
        if (typ>_int) then {<-- variable or array_index}
        begin
          n:=basic;
          if(typ>=_int) then mem[t]:=n
            else error('INT or VAR');
        end
          else error(' VAR or ARRAY');
      end
        else
        begin
          get;
          if (n=basic) then n:=1 else n:=0;
        end;
      typ:=_int;
    end
    else if (ch='!') then
    begin
      get;
      if ch<>'=' then
      begin
        if (basic=0) then n:=1 else n:=0;
      end
        else
        begin
          get;
          if (n<>basic) then n:=1 else n:=0;
        end;
      typ:=_int;
    end
    else if (ch='<') then
    begin
      get;
      if ch<>'=' then
      begin
        if (n<basic) then n:=1 else n:=0;
      end
        else
        begin
          get;
          if (n<=basic) then n:=1 else n:=0;
        end;
      typ:=_int;
    end
    else if (ch='>') then
    begin
      get;
      if ch<>'=' then
      begin
        if (n>basic) then n:=1 else n:=0;
      end
        else
        begin
          get;
          if (n>=basic) then n:=1 else n:=0;
        end;
      typ:=_int;
    end;
  end;
  if debug=true then debugOut(''+n+' '+ch); {}
  debugN := debugN-1;
  basic:=n;
end;


procedure runProc;
begin
  for n:=0 to length(txt)-1 do  buf[n]:=getChar(txt,n);
  while (n<memMax-10) do   {заполнить мусором для создания ошибки, если выйдем за границы}
  begin
    buf[n] := '{';   n := n+1;
    buf[n] := '''';  n := n+1;
    buf[n] := '}';   n := n+1;
    buf[n] := '%';   n := n+1;
  end;
  for n:=0 to tabMax do tab[n]:='';
  err:=false;
  debugN:=0;
  debug:=true;
  mp:=0;
  tp:=0;
  bp:=0;
  mem[varn('$[')]:=memMax-1;  {глобальный массив памяти $$[]}
  ch:=';';
  repeat until (getKeyPressed=0);  {Fill Key Buf}
  repeat
    skip(';');
    n:=basic;
  until (ch='.') or err;
  setColor(0,0,0);
  fillRect(0,getHeight-20,getWidth,20);
  setColor(0,255,0);
  drawText('press BREAK',0,getHeight-20);
  repaint;
  repeat delay(10); until (getClickedCommand=breakCmd);
end;


procedure demo;
begin
  if demoN = 0 then
  begin
  txt := '{Скриптовый интерпретатор'+chr(10)+
         '---'+chr(10)+
         'ПАРАМЕТРЫ'+chr(10)+
         '1.ПЕРЕМЕННЫЕ (тип integer)'+chr(10)+
         'имена из символов $[a..z] до 6 букв'+chr(10)+
         '2.ОДНОМЕРНЫЕ МАССИВЫ'+chr(10)+
         'линейка элементов типа integer'+chr(10)+
         'массивы инициализируются при создании и уже не могут менять своего размера,'+chr(10)+
         'единственный способ создания массива с переменной длинной-сделать его локальным'+chr(10)+
         'например создать подпрограмму с обработкой локального массива.'+chr(10)+
         '3.ПОДПРОГРАММЫ БЕЗ ПАРАМЕТРОВ'+chr(10)+
         'П/П это участок кода в операторных скобках,'+chr(10)+
         'который вызывается при объявлении его имени.'+chr(10)+
         'П/П должны объявляться до их использования'+chr(10)+
         'П/П не могут завершаться заранее'+chr(10)+
         '4.ЛОКАЛИЗАЦИЯ ВИДИМОСТИ'+chr(10)+
         '(переменных,массивов,подпрограмм) ограничивается блоками:'+chr(10)+
         '[if,do,while,proc]'+chr(10)+
         'локальные переменные не могут иметь такое же название как и глобальные'+chr(10)+
         'при выходе из блока переменная уничтожается.'+chr(10)+
         '5.ОТЛАДОЧНЫЕ ДАННЫЕ'+chr(10)+
         '[вложенности рекурсии]'+chr(10)+
         '-считанные слова'+chr(10)+
         '-обращения к переменным: $имя=[адрес_в_памяти]=значение  положение_переменной/использовано_в_таблице/использовано_памяти'+chr(10)+
         '-результат рекурсии: число символ_возврата'+chr(10)+
         '---'+chr(10)+
         'КЛАВИШИ'+chr(10)+
         '1.[RUN]-запуск программы.'+chr(10)+
         '2.[BREAK]-аварийное завершение/ выход из режима отладки/ переход в редактор'+chr(10)+
         '3.[DEBUG]-режим отладки/ следующий шаг'+chr(10)+
         '4.[DEMO]-следующий пример'+chr(10)+
         '5.[EXIT]-выход'+chr(10)+
         '6.[ENTER]-закончить ввод'+chr(10)+
         '7.[BKSP]-удалить последний символ'+chr(10)+
         '8.[NEG]-поменять знак (+,-)'+chr(10)+
         '---}'+chr(10)+
         'print('+chr(10)+
         '''BASIC v0.2 by arT'',##,'+chr(10)+
         '''Программа распространяется'',##,'+chr(10)+
         '''по лицензии GNU'',##,'+chr(10)+
         '''General Public License'',##,'+chr(10)+
         '''запрещено коммерческое использование.'',##,'+chr(10)+
         '''по вопросам распространения'',##,'+chr(10)+
         '''обращаться к автору'',##,'+chr(10)+
         '''e-mail: [email protected]'');.';
  end
  else if demoN = 1 then
  begin
  txt := '{ВЫВОД/ВВОД/ВЫЧИСЛЕНИЯ'+chr(10)+
         'вывод текста на экран'+chr(10)+
         'print($переменная, выражение, ''строка'', #выражение_код_символа,... ##<команда_перехода_на_новую_строку>);'+chr(10)+
         'draw; -отобразить на экране'+chr(10)+
         'cls; -очистить экран'+chr(10)+
         '---'+chr(10)+
         'чтение числа с клавиатуры'+chr(10)+
         'read : integer'+chr(10)+
         '---'+chr(10)+
         'арифмет.операции:'+chr(10)+
         '() + - * / \ = += -= *= /= \= == ! != < <= > >='+chr(10)+
         'вычисления выполняются без приоритетов слева-направо'+chr(10)+
         'для расстановки порядка вычисления использовать скобки ()'+chr(10)+
         '---'+chr(10)+
         'ПРИМЕР}'+chr(10)+
         '$a=(3+3)*(((4-2)*(2+1))+2);'+chr(10)+
         '$b=(2+3)*((5-2)-1);'+chr(10)+
         'print(''a='',$a,##,''b='',$b,##,##);'+chr(10)+
         '$b=$a=10;'+chr(10)+
         'print(''a='',$a,''___b='',$b,##);'+chr(10)+
         '$x=1;'+chr(10)+
         'if($x==1) print(''x=true'');'+chr(10)+
         'print(##,''?'');draw;'+chr(10)+
         '$n=read;'+chr(10)+
         'print(##,##,''read='',$n); draw;'+chr(10)+
         'print(##,''input a:'');$a=read;'+chr(10)+
         'print(##,''input b:'');$b=read;'+chr(10)+
         'cls;print(''a+b:'',$a+$b,##,''a-b:'',$a-$b,##,''a*b:'',$a*$b,##,'+
         '''a/b:'',$a/$b,##,''a<b:'',$a<$b,##,''a=b:'',$a==$b,##,''a<>b:'',$a!=$b);.';
  end
  else if demoN = 2 then
  begin
  txt := '{УСЛОВИЕ/ЦИКЛЫ'+chr(10)+
         'if(усл.) body;'+chr(10)+
         'условие это выражение типа integer'+chr(10)+
         'которое либо равно нулю, либо нет'+chr(10)+
         'если условие не равно нулю, то выполняется body'+chr(10)+
         '-это либо единичный оператор, либо операторные скобки ()'+chr(10)+
         'СОСТАВНЫЕ УСЛОВИЯ'+chr(10)+
         'AND if(усл.)if(усл.) ...'+chr(10)+
         {'AND !(!(усл.)+!(усл.)+!(усл.)) ...'+chr(10)+{}
         'AND ((усл.)+(усл.)+(усл.))==3 ...'+chr(10)+
         'OR (усл.)+(усл.)+(усл) ...'+chr(10)+
         'NOT !(усл.) ...'+chr(10)+
         '---'+chr(10)+
         'while(усл.) body;'+chr(10)+
         'цикл с предусловием'+chr(10)+
         'выполняется пока усл. истинно'+chr(10)+
         '---'+chr(10)+
         'do body (усл.);'+chr(10)+
         'цикл с постусловием'+chr(10)+
         'выполняется пока усл. истинно'+chr(10)+
         'ПРИМЕР}'+chr(10)+
         'print(''[0/1]?''); if(!read) print('' -ZERO''); print('' end!'',##); draw;'+chr(10)+
         '$a=0; while($a<10) $a=$a+1; print($a,##);'+chr(10)+
         '$a=0; while($a<3) ($a=$a+1; print($a,##););'+chr(10)+
         '$a=0; do ($a=$a+1; print($a,##);) ($a<2); draw;.';
  end
  else if demoN = 3 then
  begin
  txt := '{МАССИВЫ/ПОДПРОГРАММЫ'+chr(10)+
         '$a[10]; -создать массив из 10 элементов'+chr(10)+
         '$b[$i]; -создать массив размером в $i элементов'+chr(10)+
         '$c[''abcdef'']; -создать массив из строки'+chr(10)+
         '$a[-1]; -получить размер массива'+chr(10)+
         '$a[5];  -обращение к 5-му элементу'+chr(10)+
         '$$[10]  -глобальный массив памяти(вся доступная память приложения), обращение к 10-й ячейке'+chr(10)+
         '---'+chr(10)+
         'создание и вызов подпрограммы'+chr(10)+
         '$sub(body); ...  $sub();'+chr(10)+
         'ПРИМЕР}'+chr(10)+
         '$a[10]; $i=0; do( $a[$i]=$i; $i=$i+1 )($i<10);'+chr(10)+
         'print(''array size='',$a[-1],##,''global='',$$[-1],##);'+chr(10)+chr(10)+
         '$sub( print('' (sub local='', $b=8,'')''); );'+chr(10)+
         'print(''start'');'+chr(10)+
         '$sub();'+chr(10)+
         'print('' end global='',$b);.'+chr(10);
  end
  else if demoN = 4 then
  begin
  txt := '{МАССИВЫ}'+chr(10)+
         '$i=0; $a[''ПрИвЕт! ЭтО пРиМеР СкАнИрОвАнИя ПАМЯТИ''];'+chr(10)+
         'do('+chr(10)+
         ' print(''['',$i,'']='',#$n=$$[$i],''='',$n,##);'+chr(10)+
         ' if(!ycur)(draw;delay(2000);cls);'+chr(10)+
         ' $i=$i+1;'+chr(10)+
         ')((($i<=$$[-1])+(!key))==2); cls;'+chr(10)+chr(10)+
         '{РЕКУРСИЯ}'+chr(10)+
         '$count=10;$sum=0;'+chr(10)+
         '$rec($sum=$sum+10; $count=$count-1; if($count)$rec(););'+chr(10)+
         '$rec(); print(''rec. sum='', $sum);'+chr(10)+chr(10)+
         '{ПРОСЕДУРЫ И ФУНКЦИИ}'+chr(10)+
         '$proc(print(##,''My proc'',##));'+chr(10)+
         '$func($a+$b);'+chr(10)+
         '$funcc(print(''***''); $a+$b);'+chr(10)+chr(10)+
         '$proc(); $a=7;$b=4; print($func(),##,$funcc());.';
  end
  else if demoN = 5 then
  begin
  txt := '{ПЕРЕВОД ЧИСЕЛ ИЗ 10-РИЧНОЙ В ДРУГИЕ}'+chr(10)+
         '$chr[''0123456789abcdef''];'+chr(10)+
         '$str[100];'+chr(10)+
         'print(''[bin=2 oct=8 hex=16]:'');$m=read;'+chr(10)+
         'do('+chr(10)+
         ' print(##,''num='');$n=read;print(##);'+chr(10)+
         ' $i=0;'+chr(10)+
         ' do('+chr(10)+
         '  $str[$i]=$n\$m; $n=$n/$m; $i=$i+1;'+chr(10)+
         ' )($n!=0);'+chr(10)+
         ' while($i>0)('+chr(10)+
         '  $i=$i-1;print(#$chr[$str[$i]]);'+chr(10)+
         ' );'+chr(10)+
         ')(1);.';
  end
  else if demoN = 6 then
  begin
  txt := '{ГРАФИКА И ДР.'+chr(10)+
         'draw; -отобразить на экране'+chr(10)+
         'cls; -очистить экран'+chr(10)+
         'cur(x,y); -установить курсор'+chr(10)+
         'a=xcur; a=ycur; -получить координаты курсора'+chr(10)+
         'size(w,h); -установить размер'+chr(10)+
         'ssize; -получить размер экрана'+chr(10)+
         'a=width; a=height; -узнать размеры'+chr(10)+
         'put; -установить точку'+chr(10)+
         'lineto(x2,y2); -линия от текущего положения к x2,y2'+chr(10)+
         'rect(w,h); -прямоугольник'+chr(10)+
         'frect(w,h); -закрашенный прямоугольник'+chr(10)+
         'ell(w,h); -элипс'+chr(10)+
         'fell(w,h); -закрашенный элипс'+chr(10)+chr(10)+
         'setcol(r,g,b); -установить цвет вывода'+chr(10)+
         'a=getcol(num [1=r,2=g,3=b]); -получить компаненту цвета'+chr(10)+
         'swapcol; -поменять местами цвет вывода с цветом заднего фона'+chr(10)+
         '---'+chr(10)+
         'a=key; -получить код клавиши'+chr(10)+
         'a=abs(b); -получить абсолютное значение'+chr(10)+
         'a=rand(max); -случайное число в диапазоне [0..max-1]'+chr(10)+
         'delay(n); -задержка в миллисекундах'+chr(10)+
         'halt; -преждевременное завершение программы'+chr(10)+chr(10)+
         ''+chr(10)+
         'ПРИМЕР}'+chr(10)+
         'while(key!=49)'+chr(10)+
         'setcol(rand(255),rand(255),rand(255))+'+chr(10)+
         'cur(rand(100),rand(100))+print(''artyom'')+draw;'+chr(10)+chr(10)+
         'do('+chr(10)+
         ' setcol(rand(255),rand(255),rand(255));'+chr(10)+
         ' swapcol;'+chr(10)+
         ' setcol(rand(255),rand(255),rand(255));'+chr(10)+
         ' cur(rand(100),rand(100));print(''Lomakin Artyom'');'+chr(10)+
         ' draw;'+chr(10)+
         ' delay(100);'+chr(10)+
         ' cls;'+chr(10)+
         ')(key!=50);.';
  end
  else if demoN = 7 then
  begin
  txt := '{ПРОСТЫЕ ПРИМЕРЫ'+chr(10)+
         '1.вывести изображения символов'+chr(10)+
         '2.показать код нажатой клавиши'+chr(10)+
         '3.управлять точкой с клавиатуры'+chr(10)+
         '4.выход из программы кнопкой BREAK}'+chr(10)+
         '$x=width/2;'+chr(10)+
         '$y=height/2;'+chr(10)+
         '$i=0;'+chr(10)+
         'do('+chr(10)+
         ' print($i,''='',#$i,##,''k='',$k=key,##,''x='',$x,##,''y='',$y);'+chr(10)+
         ' if($k==50)($x=$x+1;);'+chr(10)+
         ' if($k==51)($x-=1);'+chr(10)+
         ' if($k==52) $y+=1;'+chr(10)+
         ' if($k==53) $y-=1;'+chr(10)+
         ' cur($x,$y);put;'+chr(10)+
         ' draw;delay(50);cls;'+chr(10)+
         ' $i+=1;'+chr(10)+
         ')(1);.';
  end
  else if demoN = 8 then
  begin
  txt := '{ПАЛИТРА}'+chr(10)+
         '{управление кнопками [1,2,3,4,5,6]}'+chr(10)+
         '$r=$g=$b=0;'+chr(10)+
         'do('+chr(10)+
         ' setcol(255,255,255);ssize;cls;'+chr(10)+
         ' print(''RGB='',$r,'','',$g,'','',$b);'+chr(10)+
         ' setcol($r,$g,$b);size(20,20);frect;draw;'+chr(10)+
         ' $k=key;'+chr(10)+
         ' if($k==49)if($r<255)$r+=1;'+chr(10)+
         ' if($k==50)if($g<255)$g+=1;'+chr(10)+
         ' if($k==51)if($b<255)$b+=1;'+chr(10)+
         ' if($k==52)if($r>0)$r-=1;'+chr(10)+
         ' if($k==53)if($g>0)$g-=1;'+chr(10)+
         ' if($k==54)if($b>0)$b-=1;'+chr(10)+
         ')(1);.';{}
  end
  else if demoN = 9 then
  begin
  txt := '{МЯЧИКИ}'+chr(10)+
         '$x=$y=99; $o=$n=0;'+chr(10)+
         'do('+chr(10)+
         ' ssize; $a=width; $b=rand(height);'+chr(10)+
         ' do('+chr(10)+
         '  cls;ssize;print($n,''-'',$k);'+chr(10)+
         '  cur($a,$b);size(5,5);fell;'+chr(10)+
         '  cur($x,$y);size(20,20);rect;'+chr(10)+
         '  draw;delay(10);$k=key;'+chr(10)+
         '  if($k==54)$x=$x+5;'+chr(10)+
         '  if($k==52)$x=$x-5;'+chr(10)+
         '  if($k==56)$y=$y+5;'+chr(10)+
         '  if($k==50)$y=$y-5;'+chr(10)+
         '  $a=$a-5;'+chr(10)+
         '  $b=$b+rand(4)-2;'+chr(10)+
         '  $o=((abs($a-$x)<20)+(abs($b-$y)<20))==2;'+chr(10)+
         ' )((($a>10)+!$o)==2);'+chr(10)+
         ' $n=$n+$o)'+chr(10)+
         '(1).';
  end
  else if demoN = 10 then
  begin
  txt := '{ГОНКИ}'+chr(10)+
         '$w=width;$h=height;$x=$w/2;$y=$h-40;$n=0;'+chr(10)+
         'do('+chr(10)+
         ' $a=rand($w);$b=0;'+chr(10)+
         ' do('+chr(10)+
         '  cls;ssize;print(''='',3-$n);'+chr(10)+
         '  cur($x,$y);print(''-!-'');'+chr(10)+
         '  cur($x,$y+20);print(''_!_'');'+chr(10)+
         '  cur($a-25,$b);size(50,20);frect;'+chr(10)+
         '  draw;delay(10);'+chr(10)+
         '  $k=key;$e=$k==49;'+chr(10)+
         '  if($k==54)$x=$x+5;'+chr(10)+
         '  if($k==52)$x=$x-5;'+chr(10)+
         '  $b=$b+5;'+chr(10)+
         '  $o=((($h-40)<$b)+(abs($a-$x)<25))==2;)'+
         ' ((($h>$b)+(!$e)+(!$o))==3);'+chr(10)+
         ' $n=$n+$o;)'+chr(10)+
         '(((3>$n)+!$e)==2).';
  end
  else if demoN = 11 then
  begin
  txt := '{ТЕНИС}'+chr(10)+
         '$w=width;$h=height;$n=$x=$w/2;$a=$b=$y=5;$m=0;'+chr(10)+
         'do('+chr(10)+
         ' cls;ssize;print($x,''-'',$y,##,$m);'+chr(10)+
         ' cur($x,$y);size(5,5);fell;'+
         ' cur($n,$h-5);size(20,5);frect;'+chr(10)+
         ' draw;delay(10);'+chr(10)+
         ' $k=key;'+chr(10)+
         ' if($k==54)$n=$n+5;'+chr(10)+
         ' if($k==52)$n=$n-5;'+chr(10)+
         ' if(($x<0)+($h<$x))$a=-$a+rand(2);'+chr(10)+
         ' if(($y<0)+($w<$y))$b=-$b;'+chr(10)+
         ' $x=$x+$a;$y=$y+$b;'+
         ' if(($h-10)<$y)if(abs($x-($n+10))<20)$m=$m+1;'+chr(10)+
         ')(1).';
  end
  else if demoN = 12 then
  begin
  txt := '{ТАНК}'+chr(10)+
         '$w=width;$h=height;'+chr(10)+
         '$x=$y=99;$p=$q=$n=$m=$r=$a=$b=0;'+chr(10)+
         'do( ssize;'+chr(10)+
         ' setcol(255,255,255);'+chr(10)+
         ' print($x,'':'',$y,##,($k=key));'+chr(10)+
         ' setcol(10,200,100);'+chr(10)+
         ' cur($x-5,$y-5);size(10,10);rect;'+chr(10)+
         ' cur($x,$y);lineto($x+$a*2,$y+$b*2);'+chr(10)+
         ' if($r)('+chr(10)+
         '  if(($m<0)+($n<0)+($w<$m)+($h<$n))$r=0;'+chr(10)+
         '  cur($m-2,$n-2);size(4,4);frect;'+chr(10)+
         '  $m=$m+$p;$n=$n+$q'+chr(10)+
         ' );'+chr(10)+
         ' draw;delay(2);'+chr(10)+
         ' if($k==54)($a=4;$b=0);'+chr(10)+
         ' if($k==52)($a=-4;$b=0);'+chr(10)+
         ' if($k==56)($b=4;$a=0);'+chr(10)+
         ' if($k==50)($b=-4;$a=0);'+chr(10)+
         ' if($k==53)if(!$r)($r=1;$m=$x;$n=$y;$p=$a*2;$q=$b*2);'+chr(10)+
         ' $x=$x+($a/2); $y=$y+($b/2);'+chr(10)+
         ' if($x<0)$x=0;'+chr(10)+
         ' if($y<0)$y=0;'+chr(10)+
         ' if($w<$x)$x=$w;'+chr(10)+
         ' if($h<$y)$y=$h;'+chr(10)+
         ' cls;'+chr(10)+
         ')(1);.';
  end
  else if demoN = 13 then
  begin
  txt := '{КРЕСТИКИ-НОЛИКИ}'+chr(10)+
         '$pole[3*10]; $find=$x=$y=$kk=$max=0;'+chr(10)+
         ''+chr(10)+
         ''+chr(10)+
         '$out(cls;'+chr(10)+
         ' $i=1; do(cur(0,$i*20);lineto(60,$i*20); cur($i*20,0);lineto($i*20,60);$i+=1)($i<3);'+chr(10)+
         ' $y=0;do($x=0;do( cur(3+$x*20,3+$y*20); print(#$pole[$x+($y*3)]);$x+=1)($x<3); $y+=1)($y<3);'+chr(10)+
         ' cur(0,ycur+20);draw);'+chr(10)+
         ''+chr(10)+
         '$getpos(print(''?'');draw;$ok=0;'+chr(10)+
         'do('+chr(10)+
         ' $k=key;delay(10);'+chr(10)+
         ' if($k==49)($x=0;$y=0;$ok=1);'+chr(10)+
         ' if($k==50)($x=1;$y=0;$ok=1);'+chr(10)+
         ' if($k==51)($x=2;$y=0;$ok=1);'+chr(10)+
         ' if($k==52)($x=0;$y=1;$ok=1);'+chr(10)+
         ' if($k==53)($x=1;$y=1;$ok=1);'+chr(10)+
         ' if($k==54)($x=2;$y=1;$ok=1);'+chr(10)+
         ' if($k==55)($x=0;$y=2;$ok=1);'+chr(10)+
         ' if($k==56)($x=1;$y=2;$ok=1);'+chr(10)+
         ' if($k==57)($x=2;$y=2;$ok=1);'+chr(10)+
         ')(!$ok);'+chr(10)+
         'print('':'');draw);'+chr(10)+
         ''+chr(10)+
         '$fline($chor=$cvrt=$cdga=$cdgb=$n=$max=0;'+chr(10)+
         'do('+chr(10)+
         ' if($pole[$x+($n*3)]==$find) $chor+=1;'+chr(10)+
         ' if($pole[$n+($y*3)]==$find) $cvrt+=1;'+chr(10)+
         ' if($x==$y) if($pole[$n+($n*3)]==$find) $cdga+=1;'+chr(10)+
         ' if($x==2-$y) if($pole[$n+((2-$n)*3)]==$find) $cdgb+=1;'+chr(10)+
         ' $n+=1;'+chr(10)+
         ')($n<3);'+chr(10)+
         '$max=$chor;'+chr(10)+
         'if($cvrt>$max) $max=$cvrt;'+chr(10)+
         'if($cdga>$max) $max=$cdga;'+chr(10)+
         'if($cdgb>$max) $max=$cdgb;'+chr(10)+
         '$max);'+chr(10)+
         ''+chr(10)+
         '$logic($exit=0;'+chr(10)+
         '$i=-1; while(((!$exit)+($i<9))==2)if($pole[$i+=1]==32)($x=$i\3;$y=$i/3;$find=111;$exit=$fline()>1);'+chr(10)+
         '$i=-1; while(((!$exit)+($i<9))==2)if($pole[$i+=1]==32)($x=$i\3;$y=$i/3;$find=120;$exit=$fline()>1);'+chr(10)+
         '$n=-1; while(((!$exit)+($i<9))==2)if($pole[$i+=1]==32)($x=$i\3;$y=$i/3;$find=111;if($fline()>1)($find=32;$exit=$fline()==2));'+chr(10)+
         'if(!$exit)( do($x=rand(3);$y=rand(3);)($pole[$x+$y*3]!=32););'+chr(10)+
         '$pole[$x+($y*3)]=111;'+chr(10)+
         ');'+chr(10)+
         ''+chr(10)+ {120=x; 111=o;}
         'do('+chr(10)+
         ' $i=0;do($pole[$i]=32;$i+=1)($i<9);'+chr(10)+
         ' $kk=0;do('+chr(10)+
         '  $kk+=1;$logic();$out();'+chr(10)+
         '  $j=0; do(if($pole[$j]!=32)($x=$j\3;$y=$j/3;$find=111;if($fline()==3)$kk=10; $find=120;if($fline()==3)$kk=20); $j+=1)(($j<9)+($kk<10)==2);'+chr(10)+{}
         '  if($kk<=4)(do($getpos())($pole[$x+($y*3)]!=32);$pole[$x+($y*3)]=120);'+chr(10)+
         ''+chr(10)+
         ' )($kk<=4);'+chr(10)+
         ' $out();'+chr(10)+
         ' if($kk==10) print(''computer'');'+chr(10)+
         ' if($kk==20) print(''man'');'+chr(10)+
         ' print(''!'');draw;'+chr(10)+
         ' delay(2000);'+chr(10)+
         ')(1);.';
     demoN:=-1;
  end;
  demoN:=demoN+1;
end;


begin
  runCmd   := createCommand('Run',   CM_OK,    1);
  debugCmd := createCommand('Debug', CM_OK,    1);
  breakCmd := createCommand('Break', CM_EXIT,  1);
  demoCmd  := createCommand('Demo',  CM_HELP,  1);
  exitCmd  := createCommand('Exit',  CM_EXIT,  1);
  enterCmd := createCommand('Enter', CM_ITEM,  2);
  bkspCmd  := createCommand('BkSp',  CM_ITEM,  3);
  negCmd   := createCommand('Neg',   CM_ITEM,  4);
  demoN:=0;
  repeat
    demo;
    repeat
      showTextBox('basic',txt,memMax,TF_ANY);
      addCommand(runCmd);
      addCommand(demoCmd);
      addCommand(exitCmd);
      repeat cmd := getClickedCommand; until (cmd<>emptyCommand);
      repeat until (getClickedCommand=emptyCommand); {fill cmd buffer}
      removeCommand(exitCmd);{}
      removeCommand(runCmd);{}
      removeCommand(demoCmd);{}
      if (cmd=runCmd) then
      begin
        txt := getTextBoxString;
        rc := 255;
        gc := 255;
        bc := 255;
        rb := 0;
        gb := 0;
        bb := 0;
        x := 0;
        y := 0;
        w := getWidth;
        h := getHeight;
        showCanvas;
        setColor(rb,gb,bb);
        fillRect(0,0,w,h);
        setColor(rc,gc,bc);
        addCommand(breakCmd);
        addCommand(debugCmd);
        runProc;
        removeCommand(debugCmd);{}
        removeCommand(breakCmd);{}
      end;
    until (cmd=demoCmd) or (cmd=exitCmd);
  until (cmd=exitCmd);
end.

____
p.s. выкладывайте сюда свои версии и доработки этого интерпретатора.

abcdef · 01.11.2008, 19:16

Выкладываю инерпрататор языка brainfuck. Данная тема уже поднималась на этом форуме, вот моя версия реализации этой программы сделанной в MIDletPascal.

_________
www.boolean.name > Программирование игр для мобильных телефонов > MidletPascal > создание MIDletPascal compiler'a

народ давайте подключемся к созданию pascal-java bytecode компилятора... сюда же заглядывают знающие люди..

abcdef · 15.11.2008, 01:21

некоторые телефоны виснут, когда в поле ввода подается большой текст, поэтому при старте первый интерпретатор может зависать, (такое было на moto V3i, хотя на E398 и V3 все нормально) необходимо удалить несколько строчек текста из первого примера, но copyright и соглашения оставьте.

KAK? TAK! · 30.03.2009, 19:51

сейчас пишу учебник к этой проге

KAK? TAK! · 31.03.2009, 13:27

кому надо выложу через пол часа (наверно)