Board.KolibriOS.org

Posted: **Wed Apr 03, 2013 9:16 am**

Скачать можно здесь http://www.excelsior-usa.com/xdsdl.html или вот на русском http://www.excelsior.ru/products/xds User's Guide: http://www.excelsior-usa.com/doc/xds/xc00.html

На английском сайте также есть более новая версия 2.6 beta. А я использовал 2.51.

Пример программы "test.mod", которая выводит окно по центру экрана.

Исходный код:

Spoiler:

Code: Select all


<*  OBJFMT='coff' *>
<* +M2EXTENSIONS  *>
<* +M2ADDTYPES    *>
<* +NOOPTIMIZE    *>	
<* -GENDEBUG      *>
<* -GENHISTORY    *>
<* +ONECODESEG    *>
<* -USEDLL        *>
<* -GENPTRINIT    *>
<* -DEFLIBS       *>
<* -IMPLIB        *>
<* -GENDEBUG      *>
<* +M2BASE16      *>
<* -IOVERFLOW     *>
<* -COVERFLOW     *>
<* -CHECKRANGE    *>
<* +SPACE         *>
<* -CHECKINDEX    *>
<* -CHECKDIV      *>
<* -CHECKDINDEX   *>
<* -CHECKNIL      *>
<* -CHECKPROC     *>


MODULE test;

TYPE
  SIZE = RECORD height, width : CARDINAL END;

VAR
  Window_left, Window_top, Window_width, Window_height : LONGCARD;
  Scr : SIZE;

CONST
 (* Window Style Constants *)
  WS_SKINNED_FIXED    =  4000000H;
  WS_SKINNED_SIZABLE  =  3000000H;
  WS_FIXED            =  0000000H;
  WS_SIZABLE          =  2000000H;
  WS_FILL_TRANSPARENT = 40000000H;
  WS_FILL_GRADIENT    = 80000000H;
  WS_COORD_CLIENT     = 20000000H;
  WS_CAPTION          = 10000000H;

 (* Event Constants *)
  REDRAW_EVENT = 1;
  KEY_EVENT    = 2;
  BUTTON_EVENT = 3;

 (* Color Constants *)
  COLOR_BLUE  = 000000FFH;
  COLOR_RED   = 00FF0000H;
  COLOR_GREEN = 0000FF00H;
  COLOR_WHITE = 00FFFFFFH;
  COLOR_BLACK = 00000000H;

  sz_hello = 'Hello, XDS!';

PROCEDURE ["StdCall"] main();FORWARD;
PROCEDURE ["StdCall"] REDRAW_START(); FORWARD;
PROCEDURE ["StdCall"] REDRAW_FINISH();FORWARD;
PROCEDURE ["StdCall"] DRAW_WINDOW(Window_left, Window_top, Window_width, Window_height : LONGCARD;  Caption :  ARRAY OF CHAR; BackColor, Style: LONGCARD); FORWARD;
PROCEDURE ["StdCall"] WAIT_EVENT():LONGCARD;FORWARD;
PROCEDURE ["StdCall"] GET_KEY_CODE():LONGCARD;FORWARD;
PROCEDURE ["StdCall"] GET_BUTTON_NUMBER():LONGCARD;FORWARD;
PROCEDURE ["StdCall"] PROGRAM_TERMINATE();FORWARD;
PROCEDURE ["StdCall"] GET_SCREEN_SIZE():SIZE;FORWARD;
PROCEDURE ["StdCall"] Event_Processor();FORWARD;
PROCEDURE ["StdCall"] On_Redraw(); FORWARD;
PROCEDURE ["StdCall"] On_KeyPress(); FORWARD;
PROCEDURE ["StdCall"] On_ButtonPress(); FORWARD;






PROCEDURE ["StdCall"] main();
BEGIN
  Scr := GET_SCREEN_SIZE();

  Window_width  := Scr.width  >> 2;
  Window_height := Scr.height >> 2;
  Window_left   := (Scr.width  - Window_width)  >> 1;
  Window_top    := (Scr.height - Window_height) >> 1;

  On_Redraw;
  LOOP
    Event_Processor
  END;
END main;

PROCEDURE ["StdCall"] Event_Processor();
BEGIN
  CASE WAIT_EVENT() OF
  |REDRAW_EVENT : On_Redraw;
  |KEY_EVENT    : On_KeyPress;
  |BUTTON_EVENT : On_ButtonPress;
  END;
END Event_Processor;

PROCEDURE ["StdCall"] On_Redraw();
BEGIN
 REDRAW_START;
 DRAW_WINDOW(Window_left, Window_top, Window_width, Window_height, sz_hello, COLOR_WHITE, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION);
 REDRAW_FINISH;
END On_Redraw;

PROCEDURE ["StdCall"] On_KeyPress();
BEGIN
 GET_KEY_CODE;
END On_KeyPress;

PROCEDURE ["StdCall"] On_ButtonPress();
BEGIN
  CASE  GET_BUTTON_NUMBER() OF
  |1 : PROGRAM_TERMINATE;
  END;
END On_ButtonPress;





PROCEDURE ["StdCall"] REDRAW_START();
BEGIN
ASM
    mov eax, 12
    mov ebx, 1
    int 64
END;
END REDRAW_START;

PROCEDURE ["StdCall"] REDRAW_FINISH();
BEGIN
ASM
    mov eax, 12
    mov ebx, 2
    int 64
END;
END REDRAW_FINISH;

PROCEDURE ["StdCall"] DRAW_WINDOW(Window_left, Window_top, Window_width, Window_height : LONGCARD;  Caption :  ARRAY OF CHAR; BackColor, Style: LONGCARD);
BEGIN
ASM
    xor eax, eax
    mov ebx, [Window_left]
    shl ebx, 16
    add ebx, [Window_width]
    mov ecx, [Window_top]
    shl ecx, 16
    add ecx, [Window_height]
    mov edx, [Style]
    or  edx, [BackColor]
    mov edi, dword ptr [Caption]
    int 64
END;
END DRAW_WINDOW;

PROCEDURE ["StdCall"] WAIT_EVENT():LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    mov eax, 10
    int 64
    mov [RESULT], eax
END;
RETURN RESULT;
END WAIT_EVENT;

PROCEDURE ["StdCall"] GET_KEY_CODE():LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    mov eax, 2
    int 64
    mov [RESULT], eax
END;
RETURN RESULT;
END GET_KEY_CODE;

PROCEDURE ["StdCall"] GET_BUTTON_NUMBER():LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    mov eax, 17
    int 64
    shr eax, 8
    mov [RESULT], eax
END;
RETURN RESULT;
END GET_BUTTON_NUMBER;

PROCEDURE ["StdCall"] PROGRAM_TERMINATE();
BEGIN
ASM
    or eax, -1
    int 64
END;
END PROGRAM_TERMINATE;

PROCEDURE ["StdCall"] GET_SCREEN_SIZE():SIZE;
VAR RESULT : SIZE;
BEGIN
ASM
    mov eax, 61
    mov ebx, 1
    int 64
    mov dword ptr [RESULT], eax
END;
RETURN RESULT;
END GET_SCREEN_SIZE;

BEGIN
 main;
END test.

Вот здесь http://www.excelsior-usa.com/forum/topi ... #entry4518 кто-то пишет:

I have made some very preliminary tests and it seems that XDS MODULA 2 can create directly native applications for KOLIBRI OS.

У меня так просто не получилось, пришлось использовать заглушки.

Исходный код для заглушек:

Spoiler:

Code: Select all

section .text
GLOBAL X2C_InitFPP
GLOBAL X2C_BEGIN
GLOBAL X2C_HALT
GLOBAL X2C_TRAP_F
GLOBAL X2C_TRAP_RANGE
GLOBAL X2C_TRAP_NIL

X2C_InitFPP:
X2C_BEGIN:	
X2C_HALT:	
X2C_TRAP_F:
X2C_TRAP_RANGE:
X2C_TRAP_NIL:
ret

Компилировать так:

Code: Select all

nasm -f coff "fake.asm" -o "fake.obj"

Теперь собираем всё вместе.
make.bat:

Code: Select all

Set Name=test

..\..\BIN\xc %name%.mod
ld -T"LScript.x"  "%Name%.obj" "fake.obj" -o "%Name%.bin" 
objcopy -O binary  -j .text -j .data -j .bss "%Name%.bin" "%Name%.kex"

pause

"LScript.x" тот же самый viewtopic.php?p=45337#p45337

И получается вот такое окошко:

Spoiler:

Posted: **Wed Apr 03, 2013 10:32 am**

Здóрово!
Проверил, пример работает.
Makefile для сборки в линуксе:

: Makefile (347 Bytes)
Downloaded 514 times

Компилятор, насколько я понял, closed-source?

Posted: **Sun Apr 07, 2013 8:07 pm**

Пример с Box_lib.
Используются несколько скроллбаров.

Исходный код:

Spoiler:

Code: Select all

<*  OBJFMT='coff' *>
<* +M2EXTENSIONS  *>
<* +M2ADDTYPES    *>
<* -NOOPTIMIZE    *>	
<* -GENDEBUG      *>
<* -GENHISTORY    *>
<* +ONECODESEG    *>
<* -USEDLL        *>
<* -GENPTRINIT    *>
<* -DEFLIBS       *>
<* -IMPLIB        *>
<* -GENDEBUG      *>
<* +M2BASE16      *>
<* -IOVERFLOW     *>
<* -COVERFLOW     *>
<* -CHECKRANGE    *>
<* +SPACE         *>
<* -CHECKINDEX    *>
<* -CHECKDIV      *>
<* -CHECKDINDEX   *>
<* -CHECKNIL      *>
<* -CHECKPROC     *>

MODULE  test;

TYPE

  SIZE = RECORD height, width : CARDINAL END;

  SCROLLBAR =
  RECORD
    size_x     : CARDINAL;
    start_x    : CARDINAL;
    size_y     : CARDINAL;
    start_y    : CARDINAL;
    btn_high   : LONGCARD;
    mode       : LONGCARD;
    max_area   : LONGCARD;
    cur_area   : LONGCARD;
    position   : LONGCARD;
    bckg_col   : LONGCARD;
    frnt_col   : LONGCARD;
    line_col   : LONGCARD;
    redraw     : LONGCARD;
    delta      : CARDINAL;
    delta2     : CARDINAL;
    r_size_x   : CARDINAL;
    r_start_x  : CARDINAL;
    r_size_y   : CARDINAL;
    r_start_y  : CARDINAL;
    m_pos      : LONGCARD;
    m_pos_2    : LONGCARD;
    m_keys     : LONGCARD;
    run_size   : LONGCARD;
    position2  : LONGCARD;
    work_size  : LONGCARD;
    all_redraw : LONGCARD;
    ar_offset  : LONGCARD;
   END;

  scrollbar_proc  =  PROCEDURE ["StdCall"] (SCROLLBAR);

CONST

 (* Event Mask Constants *)
  EM_REDRAW =  1H;
  EM_KEY    =  2H;
  EM_BUTTON =  4H;
  EM_MOUSE  = 20H;

 (* Window Style Constants *)
  WS_SKINNED_FIXED    =  4000000H;
  WS_SKINNED_SIZABLE  =  3000000H;
  WS_FIXED            =  0000000H;
  WS_SIZABLE          =  2000000H;
  WS_FILL_TRANSPARENT = 40000000H;
  WS_FILL_GRADIENT    = 80000000H;
  WS_COORD_CLIENT     = 20000000H;
  WS_CAPTION          = 10000000H;

 (* Button Style Constants  *)
  BS_FILL_TRANSPARENT = 40000000H;
  BS_NO_FRAME         = 20000000H;

 (* Event Constants *)
  REDRAW_EVENT = 1;
  KEY_EVENT    = 2;
  BUTTON_EVENT = 3;
  MOUSE_EVENT  = 6;

 (* Color Constants *)
  COLOR_BLUE  = 000000FFH;
  COLOR_RED   = 00FF0000H;
  COLOR_GREEN = 0000FF00H;
  COLOR_WHITE = 00FFFFFFH;
  COLOR_BLACK = 00000000H;

  BORDER_SIZE = 5;

  SCROLLBARS_COUNT  = 20;
  SCROLLBARS_MARGIN = 10;
  SCROLLBARS_WIDTH  = 16;

  sz_caption = 'Scrollbars';

  sz_box_lib           = '/rd/1/lib/box_lib.obj';
  sz_scrollbar_v_draw  = 'scrollbar_v_draw';
  sz_scrollbar_v_mouse = 'scrollbar_v_mouse';

VAR

  Window_left, Window_top, Window_width, Window_height : LONGCARD;
  Scr : SIZE;

  box_lib : LONGCARD;

  scrollbar_v_draw  : scrollbar_proc;
  scrollbar_v_mouse : scrollbar_proc;

  Scrollbars : ARRAY [1..SCROLLBARS_COUNT] OF SCROLLBAR;


PROCEDURE ["StdCall"] main();FORWARD;
PROCEDURE ["StdCall"] REDRAW_START(); FORWARD;
PROCEDURE ["StdCall"] REDRAW_FINISH();FORWARD;
PROCEDURE ["StdCall"] DRAW_WINDOW(Window_left, Window_top, Window_width, Window_height : LONGCARD;  Caption :  ARRAY OF CHAR; BackColor, Style: LONGCARD); FORWARD;
PROCEDURE ["StdCall"] WAIT_EVENT():LONGCARD;FORWARD;
PROCEDURE ["StdCall"] GET_KEY_CODE():LONGCARD;FORWARD;
PROCEDURE ["StdCall"] GET_BUTTON_NUMBER():LONGCARD;FORWARD;
PROCEDURE ["StdCall"] PROGRAM_TERMINATE();FORWARD;
PROCEDURE ["StdCall"] GET_SCREEN_SIZE():SIZE;FORWARD;
PROCEDURE ["StdCall"] LOAD_LIBRARY(filename : ARRAY OF CHAR): LONGCARD;FORWARD;
PROCEDURE ["StdCall"] SET_EVENT(mask : LONGCARD);FORWARD;
PROCEDURE ["StdCall"] GetProcAddress(hLib : LONGCARD; procname : ARRAY OF CHAR) : LONGCARD;FORWARD;
PROCEDURE ["StdCall"] Event_Processor();FORWARD;
PROCEDURE ["StdCall"] On_Redraw(); FORWARD;
PROCEDURE ["StdCall"] On_KeyPress(); FORWARD;
PROCEDURE ["StdCall"] On_ButtonPress(); FORWARD;
PROCEDURE ["StdCall"] On_MouseEvent(); FORWARD;
PROCEDURE ["StdCall"] RGB(r, g, b : LONGCARD) : LONGCARD;BEGIN RETURN ((r << 16) OR (g << 8) OR b);END RGB;


PROCEDURE ["StdCall"] main();
VAR i : LONGCARD;
BEGIN
  SET_EVENT(EM_REDRAW + EM_KEY + EM_BUTTON + EM_MOUSE);

  Scr := GET_SCREEN_SIZE();

  Window_width  := (SCROLLBARS_WIDTH + SCROLLBARS_MARGIN) * (SCROLLBARS_COUNT  + 1) + SCROLLBARS_WIDTH + BORDER_SIZE << 1;
  Window_height := 300;
  Window_left   := (Scr.width  - Window_width)  >> 1;
  Window_top    := (Scr.height - Window_height) >> 1;

  box_lib           := LOAD_LIBRARY(sz_box_lib);
  scrollbar_v_draw  := scrollbar_proc(GetProcAddress(box_lib, sz_scrollbar_v_draw));
  scrollbar_v_mouse := scrollbar_proc(GetProcAddress(box_lib, sz_scrollbar_v_mouse));

  FOR i := 1 TO SCROLLBARS_COUNT BY 1 DO
    WITH Scrollbars[i] DO
       ar_offset  := 1;
       all_redraw := 1;
       size_x     := SCROLLBARS_WIDTH;
       btn_high   := 16;
       bckg_col   := RGB(16 * i, 32 * i, 64 * i);
       frnt_col   := NOT bckg_col AND 7F7F7F7FH;
       line_col   := COLOR_WHITE;
       start_y    := 40;
       size_y     := 200;
       start_x    := (SCROLLBARS_MARGIN + size_x) * i;
       max_area   := 160;
       cur_area   := 40;
       mode       := 1;
    END;
  END;
			
  On_Redraw;
  LOOP
    Event_Processor
  END;
END main;

PROCEDURE ["StdCall"] Event_Processor();
BEGIN
  CASE WAIT_EVENT() OF
  |REDRAW_EVENT : On_Redraw;
  |KEY_EVENT    : On_KeyPress;
  |BUTTON_EVENT : On_ButtonPress;
  |MOUSE_EVENT  : On_MouseEvent;
  END;
END Event_Processor;

PROCEDURE ["StdCall"] On_Redraw();
VAR i : LONGCARD;
BEGIN
 REDRAW_START;
 DRAW_WINDOW(Window_left, Window_top, Window_width, Window_height, sz_caption, COLOR_BLUE, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION + WS_FILL_GRADIENT);

 FOR i := 1 TO SCROLLBARS_COUNT BY 1 DO
   Scrollbars[i].all_redraw := 1;
   scrollbar_v_draw(Scrollbars[i]);
 END;

 REDRAW_FINISH;
END On_Redraw;

PROCEDURE ["StdCall"] On_KeyPress();
BEGIN
 GET_KEY_CODE;
END On_KeyPress;

PROCEDURE ["StdCall"] On_ButtonPress();
BEGIN
  CASE  GET_BUTTON_NUMBER() OF
  |1   : PROGRAM_TERMINATE;
  END;
END On_ButtonPress;

PROCEDURE ["StdCall"] On_MouseEvent();
VAR i : LONGCARD;
BEGIN
  FOR i := 1 TO SCROLLBARS_COUNT BY 1 DO
    scrollbar_v_mouse(Scrollbars[i]);
  END;
END On_MouseEvent;





PROCEDURE ["StdCall"] REDRAW_START();
BEGIN
ASM
    push ebx

    mov eax, 12
    mov ebx, 1
    int 64

    pop ebx
END;
END REDRAW_START;

PROCEDURE ["StdCall"] REDRAW_FINISH();
BEGIN
ASM
    push ebx

    mov eax, 12
    mov ebx, 2
    int 64

    pop ebx
END;
END REDRAW_FINISH;

PROCEDURE ["StdCall"] DRAW_WINDOW(Window_left, Window_top, Window_width, Window_height : LONGCARD;  Caption :  ARRAY OF CHAR; BackColor, Style: LONGCARD);
BEGIN
ASM
    push ebx
    push esi
    push edi

    xor eax, eax
    mov ebx, [Window_left]
    shl ebx, 16
    add ebx, [Window_width]
    mov ecx, [Window_top]
    shl ecx, 16
    add ecx, [Window_height]
    mov edx, [Style]
    or  edx, [BackColor]
    mov edi, dword ptr [Caption]
    int 64

    pop edi
    pop esi
    pop ebx
END;
END DRAW_WINDOW;

PROCEDURE ["StdCall"] WAIT_EVENT():LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    mov eax, 10
    int 64
    mov [RESULT], eax
END;
RETURN RESULT;
END WAIT_EVENT;

PROCEDURE ["StdCall"] GET_KEY_CODE():LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    mov eax, 2
    int 64
    mov [RESULT], eax
END;
RETURN RESULT;
END GET_KEY_CODE;

PROCEDURE ["StdCall"] GET_BUTTON_NUMBER():LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    mov eax, 17
    int 64
    shr eax, 8
    mov [RESULT], eax
END;
RETURN RESULT;
END GET_BUTTON_NUMBER;

PROCEDURE ["StdCall"] PROGRAM_TERMINATE();
BEGIN
ASM
    or eax, -1
    int 64
END;
END PROGRAM_TERMINATE;

PROCEDURE ["StdCall"] GET_SCREEN_SIZE():SIZE;
VAR RESULT : SIZE;
BEGIN
ASM
    push ebx

    mov eax, 61
    mov ebx, 1
    int 64
    mov dword ptr [RESULT], eax

    pop ebx
END;
RETURN RESULT;
END GET_SCREEN_SIZE;

PROCEDURE ["StdCall"] GetProcAddress(hLib : LONGCARD; procname : ARRAY OF CHAR) : LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    push esi
    push edi

      mov  edx, [hLib]
      xor  eax, eax
      test edx, edx          (* If hlib = 0 then goto .done *)
      jz  done
    -----------------------
    next:
      cmp dword ptr [edx], 0 (* If end of export table then goto .done *)
      jz  done

      xor eax, eax
      mov esi, [edx]
      mov edi, dword ptr [procname]
    -----------------------
    next_:
      lodsb
      scasb
      jne fail
      or  al, al
      jnz next_
      jmp offset ok
    -----------------------
    fail:
      add edx, 8
      jmp offset next
    -----------------------
    ok:
      mov eax, [edx + 4]     (* return address *)
    -----------------------
    done:
      mov [RESULT], eax

    pop edi
    pop esi
END;
RETURN RESULT;
END GetProcAddress;

PROCEDURE ["StdCall"] LOAD_LIBRARY(filename : ARRAY OF CHAR): LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    push ebx

    mov eax, 68
    mov ebx, 19
    mov ecx, dword ptr [filename]
    int 64
    mov [RESULT], eax

    pop ebx
END;
RETURN RESULT;
END LOAD_LIBRARY;

PROCEDURE ["StdCall"] SET_EVENT(mask : LONGCARD);
BEGIN
ASM
    push ebx

    mov eax, 40
    mov ebx, mask
    int 64

    pop ebx
END;
END SET_EVENT;


BEGIN
 main;
END test.

Результат:

Spoiler:

Ползунки я подвинул сам.

Posted: **Fri Apr 12, 2013 12:38 pm**

Пример с ProgressBar-ом(viewtopic.php?p=48024#p48024).

Исходный код:

Spoiler:

Code: Select all

<*  OBJFMT='coff' *>
<* +M2EXTENSIONS  *>
<* +M2ADDTYPES    *>
<* -NOOPTIMIZE    *>	
<* -GENDEBUG      *>
<* -GENHISTORY    *>
<* +ONECODESEG    *>
<* -USEDLL        *>
<* -GENPTRINIT    *>
<* -DEFLIBS       *>
<* -IMPLIB        *>
<* -GENDEBUG      *>
<* +M2BASE16      *>
<* -IOVERFLOW     *>
<* -COVERFLOW     *>
<* -CHECKRANGE    *>
<* +SPACE         *>
<* -CHECKINDEX    *>
<* -CHECKDIV      *>
<* -CHECKDINDEX   *>
<* -CHECKNIL      *>
<* -CHECKPROC     *>
<* +DOREORDER     *>
<* +PROCINLINE    *>

MODULE test;

TYPE
  SIZE = RECORD height, width : CARDINAL END;

  ProgressBar =
  RECORD
    value          : LONGINT;
    left           : LONGCARD;
    top            : LONGCARD;
    width          : LONGCARD;
    height         : LONGCARD;
    style          : LONGCARD;
    min            : LONGINT;
    max            : LONGINT;
    back_color     : LONGCARD;
    progress_color : LONGCARD;
    frame_color    : LONGCARD;
  END;

  ProgressBar_proc =  PROCEDURE ["StdCall"] (ProgressBar);

CONST

 (* Event Mask Constants *)
  EM_REDRAW =  1H;
  EM_KEY    =  2H;
  EM_BUTTON =  4H;
  EM_MOUSE  = 20H;

 (* Window Style Constants *)
  WS_SKINNED_FIXED    = 4000000H;
  WS_SKINNED_SIZABLE  = 3000000H;
  WS_FIXED            = 0000000H;
  WS_SIZABLE          = 2000000H;
  WS_FILL_TRANSPARENT = 40000000H;
  WS_FILL_GRADIENT    = 80000000H;
  WS_COORD_CLIENT     = 20000000H;
  WS_CAPTION          = 10000000H;

 (* Button Style Constants  *)
  BS_FILL_TRANSPARENT = 40000000H;
  BS_NO_FRAME         = 20000000H;

 (* Event Constants *)
  REDRAW_EVENT = 1;
  KEY_EVENT    = 2;
  BUTTON_EVENT = 3;
  MOUSE_EVENT  = 6;

 (* Color Constants *)
  COLOR_BLUE  = 000000FFH;
  COLOR_RED   = 00FF0000H;
  COLOR_GREEN = 0000FF00H;
  COLOR_WHITE = 00FFFFFFH;
  COLOR_BLACK = 00000000H;

  BORDER_SIZE = 5;

  sz_caption = 'ProgressBars';

  PROGRESSBARS_COUNT  = 10;
  PROGRESSBARS_MARGIN = 1;

  sz_pb_lib               = '/sys/lib/pb_lib.obj';
  sz_progressbar_draw     = 'progressbar_draw';
  sz_progressbar_progress = 'progressbar_progress';

VAR
  Scr : SIZE;
  Window_left, Window_top, Window_width, Window_height : LONGCARD;

  pb_lib     : LONGCARD;
  PB : ARRAY [1..PROGRESSBARS_COUNT] OF ProgressBar;
  progressbar_progress : ProgressBar_proc;
  progressbar_draw     : ProgressBar_proc;



PROCEDURE ["StdCall"] main();FORWARD;
PROCEDURE ["StdCall"] REDRAW_START(); FORWARD;
PROCEDURE ["StdCall"] REDRAW_FINISH();FORWARD;
PROCEDURE ["StdCall"] DRAW_WINDOW(Window_left, Window_top, Window_width, Window_height : LONGCARD;  Caption :  ARRAY OF CHAR; BackColor, Style: LONGCARD); FORWARD;
PROCEDURE ["StdCall"] WAIT_EVENT():LONGCARD;FORWARD;
PROCEDURE ["StdCall"] CHECK_EVENT():LONGCARD;FORWARD;
PROCEDURE ["StdCall"] GET_KEY_CODE():LONGCARD;FORWARD;
PROCEDURE ["StdCall"] GET_BUTTON_NUMBER():LONGCARD;FORWARD;
PROCEDURE ["StdCall"] PROGRAM_TERMINATE();FORWARD;
PROCEDURE ["StdCall"] GET_SCREEN_SIZE():SIZE;FORWARD;
PROCEDURE ["StdCall"] SLEEP(time : LONGCARD); FORWARD;
PROCEDURE ["StdCall"] LOAD_LIBRARY(filename : ARRAY OF CHAR): LONGCARD;FORWARD;
PROCEDURE ["StdCall"] GetProcAddress(hLib : LONGCARD; procname : ARRAY OF CHAR) : LONGCARD;FORWARD;
PROCEDURE ["StdCall"] Event_Processor();FORWARD;
PROCEDURE ["StdCall"] On_Redraw(); FORWARD;
PROCEDURE ["StdCall"] On_KeyPress(); FORWARD;
PROCEDURE ["StdCall"] On_ButtonPress(); FORWARD;
PROCEDURE ["StdCall"] RGB(r, g, b : LONGCARD) : LONGCARD;BEGIN RETURN ((r << 16) OR (g << 8) OR b);END RGB;


PROCEDURE ["StdCall"] main();
VAR i : LONGCARD; k : LONGINT;
BEGIN
  Scr := GET_SCREEN_SIZE();

  Window_width  := 460;
  Window_height := 250;
  Window_left   := (Scr.width  - Window_width)  >> 1;
  Window_top    := (Scr.height - Window_height) >> 1;

  pb_lib               := LOAD_LIBRARY(sz_pb_lib);
  progressbar_progress := ProgressBar_proc(GetProcAddress(pb_lib, sz_progressbar_progress));
  progressbar_draw     := ProgressBar_proc(GetProcAddress(pb_lib, sz_progressbar_draw));

  FOR i := 1 TO PROGRESSBARS_COUNT DO		
    WITH PB[i] DO
      value          := -37;
      left           := 19;
      top            := 23 + (13 + PROGRESSBARS_MARGIN) * i;
      width          := 409;
      height         := 13;
      style          := 0;
      min            := -37;
      max            := i * 31;
      back_color     := RGB((i + 1) << 4, (i + 1) << 5, (i + 1) << 6) >> 2 AND 003F3F3FH;
      progress_color := back_color << 2 OR 80000000H;
      frame_color    := back_color << 1;
    END;
  END;		
		
  On_Redraw;

  k := 0;
  WHILE k # PROGRESSBARS_COUNT DO
    FOR i := 1 TO PROGRESSBARS_COUNT DO
		
      SLEEP(1);
      progressbar_progress(PB[i]);
			
      IF PB[k + 1].value = PB[k + 1].max THEN INC(k); END;
			
      CASE CHECK_EVENT() OF
      |REDRAW_EVENT : On_Redraw;
      |KEY_EVENT    : On_KeyPress;
      |BUTTON_EVENT : On_ButtonPress;
      ELSE;
      END;
			
    END;
  END;

  LOOP
    Event_Processor
  END;
END main;
--------------------------------------------------------------------------------
PROCEDURE ["StdCall"] Event_Processor();
BEGIN
  CASE WAIT_EVENT() OF
  |REDRAW_EVENT : On_Redraw;
  |KEY_EVENT    : On_KeyPress;
  |BUTTON_EVENT : On_ButtonPress;
  ELSE;
  END;
END Event_Processor;
--------------------------------------------------------------------------------
PROCEDURE ["StdCall"] On_Redraw();
VAR i : LONGCARD;
BEGIN
  REDRAW_START;
  DRAW_WINDOW(Window_left, Window_top, Window_width, Window_height, sz_caption, RGB(96, 96, 96), WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION);
  FOR i := 1 TO PROGRESSBARS_COUNT DO
    progressbar_draw(PB[i]);
  END;
  REDRAW_FINISH;
END On_Redraw;
--------------------------------------------------------------------------------
PROCEDURE ["StdCall"] On_KeyPress;
BEGIN
 GET_KEY_CODE;
END On_KeyPress;
--------------------------------------------------------------------------------
PROCEDURE ["StdCall"] On_ButtonPress();
BEGIN
  CASE  GET_BUTTON_NUMBER() OF
  |1           : PROGRAM_TERMINATE;
  ELSE;
  END;
END On_ButtonPress;

<* -DOREORDER     *>



PROCEDURE ["StdCall"] REDRAW_START();
BEGIN
ASM
    push ebx

    mov eax, 12
    mov ebx, 1
    int 64

    pop ebx
END;
END REDRAW_START;

PROCEDURE ["StdCall"] REDRAW_FINISH();
BEGIN
ASM
    push ebx

    mov eax, 12
    mov ebx, 2
    int 64

    pop ebx
END;
END REDRAW_FINISH;

PROCEDURE ["StdCall"] DRAW_WINDOW(Window_left, Window_top, Window_width, Window_height : LONGCARD;  Caption :  ARRAY OF CHAR; BackColor, Style: LONGCARD);
BEGIN
ASM
    push ebx
    push esi
    push edi

    xor eax, eax
    mov ebx, [Window_left]
    shl ebx, 16
    add ebx, [Window_width]
    mov ecx, [Window_top]
    shl ecx, 16
    add ecx, [Window_height]
    mov edx, [Style]
    or  edx, [BackColor]
    mov edi, dword ptr [Caption]
    int 64

    pop edi
    pop esi
    pop ebx
END;
END DRAW_WINDOW;

PROCEDURE ["StdCall"] WAIT_EVENT():LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    mov eax, 10
    int 64
    mov [RESULT], eax
END;
RETURN RESULT;
END WAIT_EVENT;

PROCEDURE ["StdCall"] CHECK_EVENT():LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    mov eax, 11
    int 64
    mov [RESULT], eax
END;
RETURN RESULT;
END CHECK_EVENT;

PROCEDURE ["StdCall"] GET_KEY_CODE():LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    mov eax, 2
    int 64
    mov [RESULT], eax
END;
RETURN RESULT;
END GET_KEY_CODE;

PROCEDURE ["StdCall"] GET_BUTTON_NUMBER():LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    mov eax, 17
    int 64
    shr eax, 8
    mov [RESULT], eax
END;
RETURN RESULT;
END GET_BUTTON_NUMBER;

PROCEDURE ["StdCall"] PROGRAM_TERMINATE();
BEGIN
ASM
    or eax, -1
    int 64
END;
END PROGRAM_TERMINATE;

PROCEDURE ["StdCall"] GET_SCREEN_SIZE():SIZE;
VAR RESULT : SIZE;
BEGIN
ASM
    push ebx

    mov eax, 61
    mov ebx, 1
    int 64
    mov dword ptr [RESULT], eax

    pop ebx
END;
RETURN RESULT;
END GET_SCREEN_SIZE;

PROCEDURE ["StdCall"] SLEEP(time : LONGCARD);
BEGIN
ASM
	  push ebx
		
	  mov eax, 5
	  mov ebx, [time]
	  int 64
		
	  pop ebx
END;
END SLEEP;

PROCEDURE ["StdCall"] GetProcAddress(hLib : LONGCARD; procname : ARRAY OF CHAR) : LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    push esi
    push edi

      mov  edx, [hLib]
      xor  eax, eax
      test edx, edx          (* If hlib = 0 then goto .done *)
      jz  done
    -----------------------
    next:
      cmp dword ptr [edx], 0 (* If end of export table then goto .done *)
      jz  done

      xor eax, eax
      mov esi, [edx]
      mov edi, dword ptr [procname]
    -----------------------
    next_:
      lodsb
      scasb
      jne fail
      or  al, al
      jnz next_
      jmp offset ok
    -----------------------
    fail:
      add edx, 8
      jmp offset next
    -----------------------
    ok:
      mov eax, [edx + 4]     (* return address *)
    -----------------------
    done:
      mov [RESULT], eax

    pop edi
    pop esi
END;
RETURN RESULT;
END GetProcAddress;

PROCEDURE ["StdCall"] LOAD_LIBRARY(filename : ARRAY OF CHAR): LONGCARD;
VAR RESULT : LONGCARD;
BEGIN
ASM
    push ebx

    mov eax, 68
    mov ebx, 19
    mov ecx, dword ptr [filename]
    int 64
    mov [RESULT], eax

    pop ebx
END;
RETURN RESULT;
END LOAD_LIBRARY;

BEGIN
 main;
END test.

Результат:

Spoiler:

Posted: **Fri Oct 18, 2013 1:36 am**

Попробовал собрать несколько консольных примеров на Modula-2 под KolibriOS.

Примеры брал из:

XDS\SAMPLES\Modula
ftp://ftp.psg.com/pub/modula-2/AndreaM2 ... from-pim2/
http://www.scovetta.com/archives/walnut ... S/MODULA2/
http://files.chatnfiles.com/Simtel-CDro ... OD2SRC.ZIP (описание к этим примерам есть также тут http://www.nachocabanes.com/tutors/modula2n.htm)
http://github.com/acmeism/RosettaCodeDa ... aster/Task

Некоторые из них чуть-чуть подправил(добавил опцию +M2EXTENSIONS, убрал неиспользуемое).

В архиве есть папки Modules и Examples.
Содержимое папки Modules собирается с помощью NASM-а(в папке есть make.bat). Перед сборкой примеров нужно собрать сначала это.
В папке Examples содержатся папки, в каждой из которых находится пример и 2 скрипта сборки(с помощью JWlink и с помощью LD).

Некоторые скриншоты этих консольных приложений:

Spoiler:

: SRC.zip (55.85 KiB)
Downloaded 462 times

Board.KolibriOS.org

XDS Modula-2/Oberon-2 compiler

XDS Modula-2/Oberon-2 compiler

Re: XDS Modula-2/Oberon-2 compiler

Re: XDS Modula-2/Oberon-2 compiler

Re: XDS Modula-2/Oberon-2 compiler

Re: XDS Modula-2/Oberon-2 compiler