{$mode objfpc} unit test_crt; interface Const { CRT modes } BW40 = 0; { 40x25 B/W on Color Adapter } CO40 = 1; { 40x25 Color on Color Adapter } BW80 = 2; { 80x25 B/W on Color Adapter } CO80 = 3; { 80x25 Color on Color Adapter } Mono = 7; { 80x25 on Monochrome Adapter } Font8x8 = 256; { Add-in for ROM font } { Mode constants for 3.0 compatibility } C40 = CO40; C80 = CO80; { Foreground and background color constants } Black = 0; Blue = 1; Green = 2; Cyan = 3; Red = 4; Magenta = 5; Brown = 6; LightGray = 7; { Foreground color constants } DarkGray = 8; LightBlue = 9; LightGreen = 10; LightCyan = 11; LightRed = 12; LightMagenta = 13; Yellow = 14; White = 15; { Add-in for blinking } Blink = 128; const lib_name:string = '/rd/1/lib/console.obj'#0; var addr_table:pointer; {http://wiki.kolibrios.org/wiki/Console START +4 version +12 =0х0С con_init +20 =0х1 con_write_asciiz +28 con_write_string +36 con_printf +44 con_exit +52 con_get_flags +60 con_set_flags +68 con_kbhit +76 con_getch +84 con_getch2 +92 con_gets +100 con_gets2 +108 con_get_font_height +116 con_get_cursor_height +124 con_set_cursor_height +132 con_cls +140 con_get_cursor_pos +148 con_set_cursor_pos +156 con_set_title +164 } function load_console(lib:pointer):byte; procedure start(); stdcall; procedure version(); stdcall; procedure con_init(wnd_width:Dword; wnd_heigth:Dword; scr_width:Dword; scr_heigth:Dword;const title:Pchar);stdcall; procedure con_write_asciiz(const str:Pchar); stdcall; procedure con_write_string(const str:Pchar; len:Dword);stdcall; function con_printf(str:Pchar):longint; stdcall; procedure exit_console( bCloseWindow:boolean = true); stdcall; function con_get_flags():Dword; stdcall; function con_set_flags(new_flags:Dword):Dword; stdcall; function con_kbhit():longint; stdcall; function con_getch():longint; stdcall; function con_getch2():word; stdcall; function con_gets(str:Pchar; n:longint):Pchar; stdcall; function con_gets2_callback():Pchar; stdcall; function con_get_font_height():longint; stdcall; function con_get_cursor_height():longint; stdcall; function con_set_cursor_height(new_height:longint):longint; stdcall; procedure con_cls(); stdcall; procedure con_get_cursor_pos(var px:Plongint; var py:Plongint); stdcall; procedure con_set_cursor_pos(x:longint; y:longint); stdcall; procedure con_set_title(const title:Pchar); stdcall; procedure delay(ms:Dword); register; procedure write(str:string); procedure writeln(str:string); procedure start_console(title:string); implementation function load_console(lib:pointer):byte;assembler;register; asm pushl %eax movl $68,%eax movl $19,%ebx popl %ecx int $0x40 movl %eax,addr_table { //movl %eax,%ecx//для хранения исконного указателя xor %ecx,%ecx inc %ecx addl $4,%eax movl eax,%ebx movl %ebx,(addr_function+ecx*4) cycle: test 0,eax jn exit_func inc %ecx addl $8,%eax movl eax,%ebx movl %ebx,(addr_function+ecx*4) jmp cycle lib_name: db '/rd/1/lib/console.obj',0} end; procedure start(); assembler; stdcall; asm movl $addr_table,%eax addl $4,%eax call (%eax) end; procedure version(); assembler; stdcall; asm movl $addr_table,%eax addl $12,%eax call (%eax) end; procedure con_init(wnd_width:Dword; wnd_heigth:Dword; scr_width:Dword; scr_heigth:Dword;const title:Pchar); assembler; stdcall; asm movl $addr_table,%eax addl $20,%eax call (%eax) end; procedure con_write_asciiz(const str:Pchar); assembler; stdcall; asm movl $addr_table,%eax addl $28,%eax call (%eax) end; procedure con_write_string(const str:Pchar; len:Dword);assembler; stdcall; asm movl $addr_table,%eax addl $36,%eax call (%eax) end; function con_printf(str:Pchar):longint; assembler; stdcall; asm movl $addr_table,%eax addl $44,%eax call (%eax) end; procedure exit_console( bCloseWindow:boolean = true); assembler; stdcall; asm movl $addr_table,%eax addl $52,%eax//прибавляем call (%eax) end; function con_get_flags():Dword; assembler; stdcall; asm movl $addr_table,%eax addl $60,%eax call (%eax) end; function con_set_flags(new_flags:Dword):Dword; assembler; stdcall; asm movl $addr_table,%eax addl $68,%eax call (%eax) end; function con_kbhit():longint; assembler; stdcall; asm movl $addr_table,%eax addl $76,%eax call (%eax) end; function con_getch():longint; assembler; stdcall; asm movl $addr_table,%eax addl $84,%eax call (%eax) end; function con_getch2():word; assembler; stdcall; asm movl $addr_table,%eax addl $92,%eax call (%eax) end; function con_gets(str:Pchar; n:longint):Pchar; assembler; stdcall; asm movl $addr_table,%eax addl $100,%eax call (%eax) end; function con_gets2_callback():Pchar;assembler; stdcall; asm movl $addr_table,%eax addl $108,%eax call (%eax) end; function con_get_font_height():longint;assembler; stdcall; asm movl $addr_table,%eax addl $116,%eax call (%eax) end; function con_get_cursor_height():longint; assembler; stdcall; asm movl $addr_table,%eax addl $124,%eax call (%eax) end; function con_set_cursor_height(new_height:longint):longint; assembler; stdcall; asm movl $addr_table,%eax addl $132,%eax call (%eax) end; procedure con_cls(); assembler; stdcall; asm movl $addr_table,%eax addl $140,%eax call (%eax) end; procedure con_get_cursor_pos(var px:Plongint; var py:Plongint); assembler; stdcall; asm movl $addr_table,%eax addl $148,%eax call (%eax) end; procedure con_set_cursor_pos(x:longint; y:longint); assembler; stdcall; asm movl $addr_table,%eax addl $156,%eax call (%eax) end; procedure con_set_title(const title:Pchar); assembler; stdcall; asm movl $addr_table,%eax addl $164,%eax call (%eax) end; //Pascal function procedure write(str:string); var tmp:pointer; begin tmp:=@str; inc(tmp); con_write_string(tmp,length(str)); end; procedure writeln(str:string); const tmp:string=#13#10; var pt:pointer; begin pt:=@str; inc(pt); con_write_string(pt,length(str)); pt:=@tmp; inc(pt); con_write_string(pt,2); end; procedure clrscr(); begin con_cls(); end; procedure delay(ms:Dword); assembler; register; asm pushl %ebx movl %eax, %ebx movl $5, %eax int $0x40 popl %ebx end; procedure start_console(title:string); begin con_init($FFFFFFFF,$FFFFFFFF,$FFFFFFFF,$FFFFFFFF,@title); end; end.