Console API made closest to original one

Extended I/O procedures (CoreLite-like) removed, initial Read/ReadLn procedures added to System unit.
This commit is contained in:
Владислав Джавадов 2020-12-27 00:39:15 +03:00
parent fb0f58f0d5
commit 9888dd9095
6 changed files with 167 additions and 229 deletions

View File

@ -7,20 +7,20 @@ var
CursorXY: TCursorXY;
begin
InitConsole('Date/Time', True);
InitConsole('Date/Time');
CursorOff;
GotoXY(27, 11);
WriteEx(
Write(
'System Date and System Time'#10 +
' '
);
CursorXY := WhereXY;
repeat
with GetSystemDate do
WriteEx('%02x.%02x.%02x', [Day, Month, Year]);
con_printf('%02x.%02x.%02x', Day, Month, Year);
with GetSystemTime do
WriteEx(' - %02x:%02x:%02x', [Hours, Minutes, Seconds]);
con_printf(' - %02x:%02x:%02x', Hours, Minutes, Seconds);
GotoXY(CursorXY);
Delay(500);
until KeyPressed;

View File

@ -17,7 +17,7 @@ begin
GetCurrentDirectory(Buffer, BUFFER_SIZE);
WriteLnEx('AppPath is "%s"', [AppPath^]);
WriteLnEx('CmdLine is "%s"', [CmdLine^]);
WriteLnEx('Current Directory is "%s"', [Buffer]);
con_printf('AppPath is "%s"'#10, AppPath^);
con_printf('CmdLine is "%s"'#10, CmdLine^);
con_printf('Current Directory is "%s"'#10, Buffer);
end.

View File

@ -10,5 +10,5 @@ var
begin
InitConsole('Load File');
Buffer := LoadFile('/sys/example.asm', FileSize);
WriteLnEx(Buffer, FileSize);
con_write_string(Buffer, FileSize);
end.

View File

@ -16,36 +16,35 @@ begin
if ReadFolder(FolderPath, FolderInformation, 0, 0, 0, BlocksRead) = 0 then
with FolderInformation do
WriteLnEx('Folder "%s" contains %u files and/or folders.', [FolderPath, FileCount], 2)
con_printf('Folder "%s" contains %u files and/or folders.'#10#10, FolderPath, FileCount)
else
WriteLnEx('Folder "%s" can not be read.', [FolderPath]);
con_printf('Folder "%s" can not be read.'#10, FolderPath);
Pos := 0;
while ReadFolder(FolderPath, FolderInformation, 1, Pos, 0, BlocksRead) = 0 do
begin
with FolderInformation, FileInformation[0] do
begin
WriteLnEx('FileName = %s', [Name]);
con_printf( 'File Name = %s'#10, Name);
with Attributes do
begin
WriteLnEx( 'SizeLo = %u', [Int64Rec(Size).Lo]);
WriteLnEx( 'SizeHi = %u', [Int64Rec(Size).Hi]);
con_printf( 'SizeLo = %u'#10, Int64Rec(Size).Lo);
con_printf( 'SizeHi = %u'#10, Int64Rec(Size).Hi);
with Modify.Date do
WriteLnEx('Modify Date = %02d.%02d.%02d', [Day, Month, Year]);
con_printf('Modify Date = %02d.%02d.%02d'#10, Day, Month, Year);
with Modify.Time do
WriteLnEx('Modify Time = %02d:%02d:%02d', [Hours, Minutes, Seconds]);
con_printf('Modify Time = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
with Access.Date do
WriteLnEx('Access Date = %02d.%02d.%02d', [Day, Month, Year]);
con_printf('Access Date = %02d.%02d.%02d'#10, Day, Month, Year);
with Access.Time do
WriteLnEx('Access Time = %02d:%02d:%02d', [Hours, Minutes, Seconds]);
con_printf('Access Time = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
with Creation.Date do
WriteLnEx('Creation Date = %02d.%02d.%02d', [Day, Month, Year]);
con_printf('Creation Date = %02d.%02d.%02d'#10, Day, Month, Year);
with Creation.Time do
WriteLnEx('Creation Time = %02d:%02d:%02d', [Hours, Minutes, Seconds]);
WriteLnEx( 'Attributes = 0x%08x', [Attributes]);
con_printf('Creation Time = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
con_printf( 'Attributes = 0x%08x'#10#10, Attributes);
end;
end;
WriteLnEx;
Inc(Pos);
end;
end.

View File

@ -6,15 +6,12 @@ unit CRT;
interface
uses
KolibriOS;
type
TCursorXY = record
X, Y: Integer;
end;
TKey = record
TKey = packed record
CharCode, ScanCode: KolibriChar;
end;
@ -57,21 +54,6 @@ function TextColor(Color: Byte): LongWord; overload;
procedure ClrScr;
procedure WriteEx(Str: PKolibriChar); overload;
procedure WriteEx(Str: PKolibriChar; Length: LongWord); overload;
procedure WriteEx(const Str: ShortString); overload;
function WriteEx(Format: PKolibriChar; const Args: array of const): Integer; overload;
procedure WriteLnEx(LineBreaks: Integer = 1); overload;
procedure WriteLnEx(Str: PKolibriChar; LineBreaks: Integer = 1); overload;
procedure WriteLnEx(Str: PKolibriChar; Length: LongWord; LineBreaks: Integer = 1); overload;
procedure WriteLnEx(const Str: ShortString; LineBreaks: Integer = 1); overload;
function WriteLnEx(Format: PKolibriChar; const Args: array of const; LineBreaks: Integer = 1): Integer; overload;
procedure Read(var Result: KolibriChar); overload;
procedure Read(var Result: TKey); overload;
procedure ReadLn(var Result: ShortString);
function CursorBig: Integer;
function CursorHeight: Integer; overload;
function CursorHeight(Height: Integer): Integer; overload;
@ -80,6 +62,7 @@ function CursorOn: Integer;
function KeyPressed: Boolean;
function ReadKey: KolibriChar;
function ReadKeyEx: TKey;
function FontHeight: Integer;
@ -88,7 +71,7 @@ procedure Delay(Milliseconds: LongWord);
implementation
uses
SysUtils;
KolibriOS;
var
CloseWindow: Boolean;
@ -96,229 +79,132 @@ var
procedure InitConsole(Title: PKolibriChar; CloseWindowOnExit: Boolean;
WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord);
begin
ConsoleInterface.ConsoleInit(WndWidth, WndHeight, ScrWidth, ScrHeight, Title);
con_init(WndWidth, WndHeight, ScrWidth, ScrHeight, Title);
CloseWindow := CloseWindowOnExit;
end;
procedure SetTitle(Title: PKolibriChar);
begin
ConsoleInterface.SetTitle(Title);
con_set_title(Title);
end;
function NormVideo: LongWord;
begin
with ConsoleInterface do
Result := SetFlags(GetFlags and $300 or $07);
Result := con_set_flags(con_get_flags and $300 or $07);
end;
function TextAttr: Byte;
begin
Result := ConsoleInterface.GetFlags and $FF;
Result := con_get_flags and $FF;
end;
function TextAttr(Attr: Byte): LongWord;
begin
with ConsoleInterface do
Result := SetFlags(GetFlags and $300 or Attr);
Result := con_set_flags(con_get_flags and $300 or Attr);
end;
function TextAttr(Color, Background: Byte): LongWord;
begin
with ConsoleInterface do
Result := SetFlags(GetFlags and $300 or Color and $0F or Background and $0F shl 4);
Result := con_set_flags(con_get_flags and $300 or Color and $0F or Background and $0F shl 4);
end;
function TextBackground: Byte;
begin
Result := ConsoleInterface.GetFlags and $F0 shr 4;
Result := con_get_flags and $F0 shr 4;
end;
function TextBackground(Color: Byte): LongWord;
begin
with ConsoleInterface do
Result := SetFlags(GetFlags and $30F or Color and $0F shl 4);
Result := con_set_flags(con_get_flags and $30F or Color and $0F shl 4);
end;
function TextColor: Byte;
begin
Result := ConsoleInterface.GetFlags and $0F;
Result := con_get_flags and $0F;
end;
function TextColor(Color: Byte): LongWord;
begin
with ConsoleInterface do
Result := SetFlags(GetFlags and $3F0 or Color and $0F);
Result := con_set_flags(con_get_flags and $3F0 or Color and $0F);
end;
procedure GotoXY(X, Y: Integer);
begin
ConsoleInterface.SetCursorPos(X, Y);
con_set_cursor_pos(X, Y);
end;
procedure GotoXY(const Point: TCursorXY);
begin
with Point do
ConsoleInterface.SetCursorPos(X, Y);
con_set_cursor_pos(Point.X, Point.Y);
end;
function WhereX: Integer;
var
Y: Integer;
begin
ConsoleInterface.GetCursorPos(Result, Y);
con_get_cursor_pos(Result, Y);
end;
function WhereY: Integer;
var
X: Integer;
begin
ConsoleInterface.GetCursorPos(X, Result);
con_get_cursor_pos(X, Result);
end;
function WhereXY: TCursorXY;
begin
ConsoleInterface.GetCursorPos(Result.X, Result.Y);
con_get_cursor_pos(Result.X, Result.Y);
end;
function CursorBig: Integer;
begin
Result := ConsoleInterface.SetCursorHeight(15);
Result := con_set_cursor_height(15);
end;
function CursorHeight: Integer;
begin
Result := ConsoleInterface.GetCursorHeight;
Result := con_get_cursor_height;
end;
function CursorHeight(Height: Integer): Integer;
begin
Result := ConsoleInterface.SetCursorHeight(Height);
Result := con_set_cursor_height(Height);
end;
function CursorOff: Integer;
begin
Result := ConsoleInterface.SetCursorHeight(0);
Result := con_set_cursor_height(0);
end;
function CursorOn: Integer;
begin
Result := ConsoleInterface.SetCursorHeight(2);
Result := con_set_cursor_height(2);
end;
procedure ClrScr;
begin
ConsoleInterface.Cls;
end;
procedure WriteEx(Str: PKolibriChar);
begin
ConsoleInterface.WriteASCIIZ(Str);
end;
procedure WriteEx(Str: PKolibriChar; Length: LongWord);
begin
ConsoleInterface.WriteString(Str, Length);
end;
procedure WriteEx(const Str: ShortString);
begin
ConsoleInterface.WriteString(@Str[1], Length(Str));
end;
function WriteEx(Format: PKolibriChar; const Args: array of const): Integer;
const
VarArgSize = SizeOf(TVarRec);
asm
PUSH EBX
MOV EBX, ESP
INC ECX
JZ @@call
@@arg:
PUSH dword [EDX + ECX * VarArgSize - VarArgSize]
LOOP @@arg
@@call:
PUSH EAX
CALL ConsoleInterface.PrintF
MOV ESP, EBX
POP EBX
end;
procedure WriteLnEx(LineBreaks: Integer);
var
I: Integer;
begin
for I := 0 to LineBreaks - 1 do
ConsoleInterface.WriteString(#10, 1);
end;
procedure WriteLnEx(Str: PKolibriChar; LineBreaks: Integer);
begin
ConsoleInterface.WriteASCIIZ(Str);
WriteLnEx(LineBreaks);
end;
procedure WriteLnEx(Str: PKolibriChar; Length: LongWord; LineBreaks: Integer);
begin
ConsoleInterface.WriteString(Str, Length);
WriteLnEx(LineBreaks);
end;
procedure WriteLnEx(const Str: ShortString; LineBreaks: Integer);
begin
ConsoleInterface.WriteString(@Str[1], Length(Str));
WriteLnEx(LineBreaks);
end;
function WriteLnEx(Format: PKolibriChar; const Args: array of const; LineBreaks: Integer = 1): Integer;
begin
Result := WriteEx(Format, Args);
WriteLnEx(LineBreaks);
end;
procedure Read(var Result: KolibriChar);
begin
Result := Chr(ConsoleInterface.GetCh);
end;
procedure Read(var Result: TKey);
var
K: Word;
begin
K := ConsoleInterface.GetCh2;
with WordRec(K), Result do
begin
CharCode := Chr(Lo);
ScanCode := Chr(Hi);
end;
end;
procedure ReadLn(var Result: ShortString);
var
P, Limit: PKolibriChar;
begin
P := PKolibriChar(@Result[1]);
ConsoleInterface.GetS(P, High(Byte));
Limit := P + High(Byte);
while (P < Limit) and not (P^ in [#0, #10]) do
Inc(P);
PByte(@Result)^ := P - PKolibriChar(@Result[1]);
con_cls;
end;
function KeyPressed: Boolean;
begin
Result := ConsoleInterface.KbdHit;
Result := con_kbhit;
end;
function ReadKey: KolibriChar;
begin
Result := Chr(ConsoleInterface.GetCh);
Result := Chr(con_getch);
end;
function ReadKeyEx: TKey;
begin
Word(Result) := con_getch2;
end;
function FontHeight: Integer;
begin
Result := ConsoleInterface.GetFontHeight;
Result := con_get_font_height;
end;
procedure Delay(Milliseconds: LongWord);
@ -331,31 +217,28 @@ var
initialization
hConsole := LoadLibrary('/sys/lib/console.obj');
with ConsoleInterface do
begin
Cls := GetProcAddress(hConsole, 'con_cls');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
GetCh := GetProcAddress(hConsole, 'con_getch');
GetCh2 := GetProcAddress(hConsole, 'con_getch2');
GetCursorPos := GetProcAddress(hConsole, 'con_get_cursor_pos');
GetCursorHeight := GetProcAddress(hConsole, 'con_get_cursor_height');
GetFlags := GetProcAddress(hConsole, 'con_get_flags');
GetFontHeight := GetProcAddress(hConsole, 'con_get_font_height');
GetS := GetProcAddress(hConsole, 'con_gets');
KbdHit := GetProcAddress(hConsole, 'con_kbhit');
PrintF := GetProcAddress(hConsole, 'con_printf');
SetCursorHeight := GetProcAddress(hConsole, 'con_set_cursor_height');
SetCursorPos := GetProcAddress(hConsole, 'con_set_cursor_pos');
SetFlags := GetProcAddress(hConsole, 'con_set_flags');
SetTitle := GetProcAddress(hConsole, 'con_set_title');
WriteASCIIZ := GetProcAddress(hConsole, 'con_write_asciiz');
WriteString := GetProcAddress(hConsole, 'con_write_string');
end;
Pointer(@con_cls) := GetProcAddress(hConsole, 'con_cls');
Pointer(@con_exit) := GetProcAddress(hConsole, 'con_exit');
Pointer(@con_getch) := GetProcAddress(hConsole, 'con_getch');
Pointer(@con_getch2) := GetProcAddress(hConsole, 'con_getch2');
Pointer(@con_get_cursor_pos) := GetProcAddress(hConsole, 'con_get_cursor_pos');
Pointer(@con_get_cursor_height) := GetProcAddress(hConsole, 'con_get_cursor_height');
Pointer(@con_get_flags) := GetProcAddress(hConsole, 'con_get_flags');
Pointer(@con_get_font_height) := GetProcAddress(hConsole, 'con_get_font_height');
Pointer(@con_gets) := GetProcAddress(hConsole, 'con_gets');
Pointer(@con_init) := GetProcAddress(hConsole, 'con_init');
Pointer(@con_kbhit) := GetProcAddress(hConsole, 'con_kbhit');
Pointer(@con_printf) := GetProcAddress(hConsole, 'con_printf');
Pointer(@con_set_cursor_height) := GetProcAddress(hConsole, 'con_set_cursor_height');
Pointer(@con_set_cursor_pos) := GetProcAddress(hConsole, 'con_set_cursor_pos');
Pointer(@con_set_flags) := GetProcAddress(hConsole, 'con_set_flags');
Pointer(@con_set_title) := GetProcAddress(hConsole, 'con_set_title');
Pointer(@con_write_asciiz) := GetProcAddress(hConsole, 'con_write_asciiz');
Pointer(@con_write_string) := GetProcAddress(hConsole, 'con_write_string');
finalization
with ConsoleInterface do
if Assigned(ConsoleExit) then
ConsoleExit(CloseWindow);
if Assigned(con_exit) then
con_exit(CloseWindow);
end.

View File

@ -121,28 +121,6 @@ type
{$ENDIF}
end;
PConsoleInterface = ^TConsoleInterface;
TConsoleInterface = record
Cls: procedure; stdcall;
ConsoleExit: procedure(CloseWindow: Boolean); stdcall;
ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Title: PKolibriChar); stdcall;
GetCh: function: Integer; stdcall;
GetCh2: function: Word; stdcall;
GetCursorPos: procedure(var X, Y: Integer); stdcall;
GetCursorHeight: function: Integer; stdcall;
GetFlags: function: LongWord; stdcall;
GetFontHeight: function: Integer; stdcall;
GetS: function(Str: PKolibriChar; Length: Integer): PKolibriChar; stdcall;
KbdHit: function: Boolean; stdcall;
PrintF: function(Str: PKolibriChar): Integer; cdecl varargs;
SetFlags: function(Flags: LongWord): LongWord; stdcall;
SetCursorHeight: function(Height: Integer): Integer; stdcall;
SetCursorPos: procedure(X, Y: Integer); stdcall;
SetTitle: procedure(Title: PKolibriChar); stdcall;
WriteASCIIZ: procedure(Str: PKolibriChar); stdcall;
WriteString: procedure(Str: PKolibriChar; Length: LongWord); stdcall;
end;
PTextBuf = ^TTextBuf;
TTextBuf = array[0..127] of KolibriChar;
@ -181,13 +159,17 @@ function _LStrLen(const S: KolibriString): LongInt;
function _LStrToPChar(const S: KolibriString): PKolibriChar;
var
ConsoleInterface: TConsoleInterface;
IOResult: Integer;
Output: Text;
Input, Output: Text;
function _Flush(var T: TTextRec): Integer;
procedure __IOTest;
function _ReadChar(var T: TTextRec): KolibriChar;
procedure _ReadCString(var T: TTextRec; Str: PKolibriChar; MaxLength: LongInt);
procedure _ReadString(var T: TTextRec; Str: PShortString; MaxLength: LongInt);
procedure _ReadLn(var T: TTextRec);
procedure _Write0Bool(var T: TTextRec; Value: Boolean);
procedure _Write0Char(var T: TTextRec; Ch: KolibriChar);
procedure _Write0Long(var T: TTextRec; Value: LongInt);
@ -202,6 +184,47 @@ procedure _WriteString(var T: TTextRec; const S: ShortString; Width: LongInt);
procedure _WriteLString(var T: TTextRec; const S: KolibriString; Width: LongInt);
procedure _WriteLn(var T: TTextRec);
{ Console Library API }
type
con_gets2_callback = function(KeyCode: Integer; var Str: PKolibriChar; var Count, Pos: Integer): Integer; stdcall;
const
CON_COLOR_BLUE = $01;
CON_COLOR_GREEN = $02;
CON_COLOR_RED = $04;
CON_COLOR_BRIGHT = $08;
CON_BGR_BLUE = $10;
CON_BGR_GREEN = $20;
CON_BGR_RED = $40;
CON_BGR_BRIGHT = $80;
CON_IGNORE_SPECIALS = $100;
CON_WINDOW_CLOSED = $200;
// TODO: con_gets2_callback constants
con_cls: procedure; stdcall = nil;
con_exit: procedure(CloseWindow: Boolean); stdcall = nil;
con_getch: function: Integer; stdcall = nil;
con_getch2: function: Word; stdcall = nil;
con_get_cursor_pos: procedure(var X, Y: Integer); stdcall = nil;
con_get_cursor_height: function: Integer; stdcall = nil;
con_get_flags: function: LongWord; stdcall = nil;
con_get_font_height: function: Integer; stdcall = nil;
con_gets: function(Str: PKolibriChar; Length: Integer): PKolibriChar; stdcall = nil;
con_gets2: function(Callback: con_gets2_callback; Str: PKolibriChar; Count: Integer): PKolibriChar; stdcall = nil;
con_init: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Title: PKolibriChar); stdcall = nil;
con_kbhit: function: Boolean; stdcall = nil;
con_printf: function(Str: PKolibriChar): Integer; cdecl varargs = nil;
con_set_flags: function(Flags: LongWord): LongWord; stdcall = nil;
con_set_cursor_height: function(Height: Integer): Integer; stdcall = nil;
con_set_cursor_pos: procedure(X, Y: Integer); stdcall = nil;
con_set_title: procedure(Title: PKolibriChar); stdcall = nil;
con_write_asciiz: procedure(Str: PKolibriChar); stdcall = nil;
con_write_string: procedure(Str: PKolibriChar; Length: LongWord); stdcall = nil;
implementation
uses
@ -370,69 +393,102 @@ end;
const
Booleans: array[Boolean] of PKolibriChar = ('False', 'True');
function _ReadChar(var T: TTextRec): KolibriChar;
begin
Result := Chr(con_getch);
end;
procedure _ReadCString(var T: TTextRec; Str: PKolibriChar; MaxLength: LongInt);
var
P, Limit: PKolibriChar;
begin
con_gets(Str, MaxLength);
P := Str;
Limit := P + MaxLength;
while (P < Limit) and not (P^ in [#0, #10]) do
Inc(P);
P^ := #0;
end;
procedure _ReadString(var T: TTextRec; Str: PShortString; MaxLength: LongInt);
var
P, Limit: PKolibriChar;
begin
P := PKolibriChar(Str) + 1;
con_gets(P, MaxLength);
Limit := P + MaxLength;
while (P < Limit) and not (P^ in [#0, #10]) do
Inc(P);
PByte(Str)^ := P - PKolibriChar(Str) - 1;
end;
procedure _ReadLn(var T: TTextRec);
asm
end;
procedure _Write0Bool(var T: TTextRec; Value: Boolean);
begin
ConsoleInterface.WriteASCIIZ(Booleans[Value]);
con_write_asciiz(Booleans[Value]);
end;
procedure _Write0Char(var T: TTextRec; Ch: KolibriChar);
begin
ConsoleInterface.WriteString(@Ch, 1);
con_write_string(@Ch, 1);
end;
procedure _Write0Long(var T: TTextRec; Value: LongInt);
begin
ConsoleInterface.PrintF('%d', Value);
con_printf('%d', Value);
end;
procedure _Write0String(var T: TTextRec; const S: ShortString);
begin
ConsoleInterface.WriteString(@S[1], Length(S));
con_write_string(@S[1], Length(S));
end;
procedure _Write0CString(var T: TTextRec; S: PKolibriChar);
begin
ConsoleInterface.WriteASCIIZ(S);
con_write_asciiz(S);
end;
procedure _Write0LString(var T: TTextRec; const S: KolibriString);
begin
ConsoleInterface.WriteString(Pointer(S), Length(S));
con_write_string(Pointer(S), Length(S));
end;
procedure _WriteBool(var T: TTextRec; Value: Boolean; Width: LongInt);
begin
ConsoleInterface.PrintF('%*s', Width, Booleans[Value]);
con_printf('%*s', Width, Booleans[Value]);
end;
procedure _WriteChar(var T: TTextRec; Ch: KolibriChar; Width: LongInt);
begin
ConsoleInterface.PrintF('%*c', Width, Ch);
con_printf('%*c', Width, Ch);
end;
procedure _WriteCString(var T: TTextRec; S: PKolibriChar; Width: LongInt);
begin
ConsoleInterface.PrintF('%*s', Width, S);
con_printf('%*s', Width, S);
end;
procedure _WriteLong(var T: TTextRec; Value, Width: LongInt);
begin
ConsoleInterface.PrintF('%*d', Width, Value);
con_printf('%*d', Width, Value);
end;
procedure _WriteString(var T: TTextRec; const S: ShortString; Width: LongInt);
begin
ConsoleInterface.PrintF('%*s', Width, @S[1]);
con_printf('%*s', Width, @S[1]);
end;
procedure _WriteLString(var T: TTextRec; const S: KolibriString; Width: LongInt);
begin
ConsoleInterface.PrintF('%*s', Width, Pointer(S));
con_printf('%*s', Width, Pointer(S));
end;
procedure _WriteLn(var T: TTextRec);
begin
ConsoleInterface.WriteString(#10, 1);
con_write_string(#10, 1);
end;
initialization