xcore - внедряемая Форт-система

Раздел в разработке.

Проект основан на http://rx-core.org.

Ядро форт-машины компилируется ассемблером fasm в obj-файл размером 5кБ, который линкуется в программу на Delphi. При загрузке программы, она достраивает компилятор форт-машины, интерпретируя стартовый скрипт размером 5кБ.

xcore не поддерживает какие-либо стандарты на язык Форт.

xcore компилирует код «на лету» в машинный код, что даёт возможность через скрипт использовать все доступные ресурсы процессора/сопроцессора (скорость исполнения, дополнительные инструкции) без перекомпиляции программы.

Пример скрипта:

variable x
variable y
variable c

| Render event
: render
  mouse.x 150 - !x
  mouse.y 50 - !y

  | rectangles
  $4010ff80 !c
  10 for
    @c @x @y + + color
    @x @y 200 100 rect
    10 +x
  next
  $ff00ffff color
  
  16 font.size
  @x 15 - @y 25 + s" Text from script" text

  | lines
  $40000020 color
  100 !x
  48 for
    @x 100 mouse.x mouse.y line
    @x 400 mouse.x mouse.y line
    10 +x
  next
  
  32 font.size
  
  mouse.left if
    $ff0080ff color
    32 100 s" Left mouse button" text
  then
  mouse.right if
    $ff00ff80 color
    32 140 s" Right mouse button" text
  then
  mouse.mid if
    $ffff0080 color
    32 180 s" Mid mouse button" text
  then
;

Пример программы на Delphi с интеграцией скрипта:

var
  xx_render: Integer;

procedure Render;
begin
  x_call_xt(xx_render);
end;

function xp_getmem(Size: Integer): Pointer; stdcall;
begin
  Result := GetMemory(Size);
end;

procedure xp_freemem(Value: Pointer); stdcall;
begin
  FreeMemory(Value);
end;

procedure xp_rect(x, y, w, h: Integer); stdcall;
begin
  EnableTexture(False);
  DrawRects;
    yok_rectangle(x, y, w, h);
  EndDraw;
end;

procedure xp_line(x, y, x2, y2: Integer); stdcall;
begin
  EnableTexture(False);
  DrawLines;
    Line(x, y, x2, y2);
  EndDraw;
end;

procedure xp_color(color: Integer); stdcall;
begin
  glColor4ubv(@color);
end;

procedure xp_text(x, y: Integer; value: PChar; value_length: Integer); stdcall;
begin
  EnableTexture;
  yok_set_texture(tx_font.ID);
  yok_text_out(x, y, Copy(value, 1, value_length));
end;

procedure xp_font_size(Value: Integer); stdcall;
begin
  Txt.FontSize := Value;
end;

function xp_mouse_x: Integer; stdcall;
begin
  Result := Mouse.X;
end;

function xp_mouse_y: Integer; stdcall;
begin
  Result := Mouse.Y;
end;

function xp_mouse_left: Integer; stdcall;
begin
  Result := IfThen(Mouse.LeftButton, -1);
end;

function xp_mouse_right: Integer; stdcall;
begin
  Result := IfThen(Mouse.RightButton, -1);
end;

function xp_mouse_mid: Integer; stdcall;
begin
  Result := IfThen(Mouse.MidButton, -1);
end;

procedure Main;
begin
  WindowTitle := APP_TITLE;
  YokRenderProc := Render;
  YokProcessProc := Process;
  YokInit;
  YokOpenWindow(config_screen_width, config_screen_height, config_screen_bpp, 0,
    config_screen_fullscreen);
  tx_font := YokLoadTexture(yok_app_path + 'pic\font.tga');
  yok_set_texture_filter(stfMipMapNearest);
  x_setup;
  x_use(yok_app_path + 'system.xcore');
  x_define('getmem', @xp_getmem, 1);
  x_define('freemem', @xp_freemem, 1);
  x_define_void('rect', @xp_rect, 4);
  x_define_void('line', @xp_line, 4);
  x_define_void('color', @xp_color, 1);
  x_define_void('text', @xp_text, 4);
  x_define_void('font.size', @xp_font_size, 1);
  x_define('mouse.x', @xp_mouse_x, 0);
  x_define('mouse.y', @xp_mouse_y, 0);
  x_define('mouse.left', @xp_mouse_left, 0);
  x_define('mouse.right', @xp_mouse_right, 0);
  x_define('mouse.mid', @xp_mouse_mid, 0);
  x_use(yok_app_path + 'main.xcore');
  xx_render := x_get_xt('render');
  YokRun;
  YokTerminate;
end;