CRT unit made more compatible with Turbo/FreePascal one

This commit is contained in:
2020-06-09 00:44:44 +03:00
parent f59ec2420a
commit 9868828cc2
4 changed files with 72 additions and 35 deletions

View File

@@ -39,7 +39,7 @@ begin
TextBackground(White); TextBackground(White);
WriteLn('White'); WriteLn('White');
ResetAttributes; NormVideo;
TextColor(Black); TextColor(Black);
WriteLn('Black'); WriteLn('Black');

View File

@@ -4,29 +4,25 @@ uses
KolibriOS, CRT; KolibriOS, CRT;
var var
SystemDate: TSystemDate; CursorXY: TCursorXY;
SystemTime: TSystemTime;
CursorPos: TConsolePoint;
begin begin
InitConsole('Date/Time'); InitConsole('Date/Time');
SetCursorHeight(0); CursorOff;
SetCursorPos(27, 11); GotoXY(27, 11);
Write( Write(
'System Date and System Time'#10 + 'System Date and System Time'#10 +
' ' ' '
); );
CursorPos := GetCursorPos; CursorXY := WhereXY;
repeat repeat
SystemDate := GetSystemDate; with GetSystemDate, GetSystemTime do
SystemTime := GetSystemTime;
with SystemDate, SystemTime do
begin begin
Write('%02x.%02x.%02x', Day, Month, Year); Write('%02x.%02x.%02x', Day, Month, Year);
Write(' - %02x:%02x:%02x', Hours, Minutes, Seconds); Write(' - %02x:%02x:%02x', Hours, Minutes, Seconds);
end; end;
SetCursorPos(CursorPos); GotoXY(CursorXY);
Sleep(50); Delay(500);
until KeyPressed; until KeyPressed;
end. end.

View File

@@ -9,7 +9,6 @@ var
begin begin
InitConsole('Load File', False); InitConsole('Load File', False);
Buffer := LoadFile('/sys/example.asm', FileSize); Buffer := LoadFile('/sys/example.asm', FileSize);
WriteText(Buffer, FileSize); WriteText(Buffer, FileSize);
end. end.

View File

@@ -1,3 +1,7 @@
(*
KolibriOS CRT unit
*)
unit CRT; unit CRT;
interface interface
@@ -6,8 +10,8 @@ uses
KolibriOS; KolibriOS;
type type
TConsolePoint = record TCursorXY = record
X, Y: Integer; X, Y: LongWord;
end; end;
const const
@@ -31,11 +35,13 @@ const
procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean = True; procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean = True;
WndWidth: LongWord = $FFFFFFFF; WndHeight: LongWord = $FFFFFFFF; ScrWidth: LongWord = $FFFFFFFF; ScrHeight: LongWord = $FFFFFFFF); WndWidth: LongWord = $FFFFFFFF; WndHeight: LongWord = $FFFFFFFF; ScrWidth: LongWord = $FFFFFFFF; ScrHeight: LongWord = $FFFFFFFF);
function GetCursorPos: TConsolePoint; procedure GotoXY(X, Y: Integer); overload;
procedure SetCursorPos(X, Y: Integer); overload; procedure GotoXY(const Point: TCursorXY); overload;
procedure SetCursorPos(const Point: TConsolePoint); overload; function WhereX: Integer;
function WhereY: Integer;
function WhereXY: TCursorXY;
procedure ResetAttributes; procedure NormVideo; // reset text attributes
procedure TextAttribute(Color, Background: Integer); procedure TextAttribute(Color, Background: Integer);
procedure TextBackground(Color: Integer); procedure TextBackground(Color: Integer);
procedure TextColor(Color: Integer); procedure TextColor(Color: Integer);
@@ -43,10 +49,16 @@ procedure TextColor(Color: Integer);
function WriteLn(LineBreaks: Integer = 1): LongInt; overload; function WriteLn(LineBreaks: Integer = 1): LongInt; overload;
function WriteLn(Text: PKolibriChar; LineBreaks: Integer = 1): LongInt; overload; function WriteLn(Text: PKolibriChar; LineBreaks: Integer = 1): LongInt; overload;
function CursorBig: LongWord;
function CursorOff: LongWord;
function CursorOn: LongWord;
procedure Delay(Milliseconds: LongWord); // absolute Sleep(Milliseconds);
var var
CursorHeight: function(Height: LongWord): LongWord; stdcall;
KeyPressed: function: Boolean; KeyPressed: function: Boolean;
ReadKey: function: KolibriChar; stdcall; ReadKey: function: KolibriChar; stdcall;
SetCursorHeight: function(Height: Integer): Integer; stdcall;
Write: function(const Text: PKolibriChar): LongInt; cdecl varargs; Write: function(const Text: PKolibriChar): LongInt; cdecl varargs;
WriteText: procedure(Text: PKolibriChar; Length: LongWord); stdcall; WriteText: procedure(Text: PKolibriChar; Length: LongWord); stdcall;
@@ -55,7 +67,7 @@ implementation
var var
CloseWindow: Boolean; CloseWindow: Boolean;
procedure ResetAttributes; procedure NormVideo;
begin begin
Write(#27'[0m'); Write(#27'[0m');
end; end;
@@ -130,12 +142,17 @@ begin
Result := Write(Text) + WriteLn(LineBreaks); Result := Write(Text) + WriteLn(LineBreaks);
end; end;
procedure Delay(Milliseconds: LongWord);
begin
Sleep(Milliseconds div 10);
end;
var var
hConsole: Pointer; hConsole: Pointer;
ConsoleExit: procedure(CloseWindow: Boolean); stdcall; ConsoleExit: procedure(CloseWindow: Boolean); stdcall;
ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Caption: PKolibriChar); stdcall; ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Caption: PKolibriChar); stdcall;
GetCursorPosProc: procedure(var X, Y: Integer); stdcall; GotoXYProc: procedure(X, Y: LongWord); stdcall;
SetCursorPosProc: procedure(X, Y: Integer); stdcall; WhereXYProc: procedure(var X, Y: LongWord); stdcall;
procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean; procedure InitConsole(Caption: PKolibriChar; CloseWindowOnExit: Boolean;
WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord); WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord);
@@ -143,11 +160,11 @@ begin
hConsole := LoadLibrary('/sys/lib/console.obj'); hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleExit := GetProcAddress(hConsole, 'con_exit'); ConsoleExit := GetProcAddress(hConsole, 'con_exit');
ConsoleInit := GetProcAddress(hConsole, 'con_init'); ConsoleInit := GetProcAddress(hConsole, 'con_init');
GetCursorPosProc := GetProcAddress(hConsole, 'con_get_cursor_pos'); CursorHeight := GetProcAddress(hConsole, 'con_set_cursor_height');
KeyPressed := GetProcAddress(hConsole, 'con_kbhit'); KeyPressed := GetProcAddress(hConsole, 'con_kbhit');
ReadKey := GetProcAddress(hConsole, 'con_getch'); ReadKey := GetProcAddress(hConsole, 'con_getch');
SetCursorHeight := GetProcAddress(hConsole, 'con_set_cursor_height'); GotoXYProc := GetProcAddress(hConsole, 'con_set_cursor_pos');
SetCursorPosProc := GetProcAddress(hConsole, 'con_set_cursor_pos'); WhereXYProc := GetProcAddress(hConsole, 'con_get_cursor_pos');
Write := GetProcAddress(hConsole, 'con_printf'); Write := GetProcAddress(hConsole, 'con_printf');
WriteText := GetProcAddress(hConsole, 'con_write_string'); WriteText := GetProcAddress(hConsole, 'con_write_string');
@@ -155,20 +172,45 @@ begin
CloseWindow := CloseWindowOnExit; CloseWindow := CloseWindowOnExit;
end; end;
function GetCursorPos: TConsolePoint; procedure GotoXY(X, Y: Integer);
begin begin
GetCursorPosProc(Result.X, Result.Y); GotoXYProc(X, Y);
end; end;
procedure SetCursorPos(X, Y: Integer); procedure GotoXY(const Point: TCursorXY);
begin
SetCursorPosProc(X, Y);
end;
procedure SetCursorPos(const Point: TConsolePoint);
begin begin
with Point do with Point do
SetCursorPosProc(X, Y); GotoXYProc(X, Y);
end;
function WhereX: Integer;
begin
Result := WhereXY.X;
end;
function WhereY: Integer;
begin
Result := WhereXY.Y;
end;
function WhereXY: TCursorXY;
begin
WhereXYProc(Result.X, Result.Y);
end;
function CursorBig: LongWord;
begin
Result := CursorHeight(15);
end;
function CursorOff: LongWord;
begin
Result := CursorHeight(0);
end;
function CursorOn: LongWord;
begin
Result := CursorHeight(2);
end; end;
initialization initialization