(*
/*

CLASS {NATIVE_Console|_Delphi}, NATIVE,
ABSTRACT :

IMPORT, ANYWAY: {Console} .

NATIVE: "uses NATIVE_Console;" .
NATIVE: "///COPY NATIVE_Console.pas" .
*/
*)
unit NATIVE_Console;

{$I AL4_options.inc}

interface

uses AL4,
	 {$IFDEF KOL}
		KOL, Windows
	 {$ELSE}
	 	{$IFDEF FPC}
		 	SysUtils 
		 	{$IFDEF LINUX}
		 		, crt
		 	{$ELSE} 
		 		, Windows 
		 	{$ENDIF}
		 {$ELSE}
		 	Windows
	 	 {$ENDIF}
	 {$ENDIF} ;
	 
//------------------------------- 'internal functions'
procedure con_fg(f_color: Byte);	 
procedure con_bg(b_color: Byte);
procedure apply_color_ansi(param: Integer; color_RGB: Integer);
procedure Extended_write(const S: String);
procedure Console_ANSI_colors(Add_support: Boolean);

var End_input_detected: Boolean;

var Last_foreground_color: Byte = 7;
var Last_background_color: Byte;

function Get_char: char;
	 
implementation

uses
	unitC_NATIVE_Console, unitC_Console;

var prev_Foreground: Integer = 7;
var prev_Background: Integer = 0;
var prev_intensity: Boolean;
var high_intensity: Boolean;

procedure con_fg(f_color: Byte);
begin
	{$IFDEF LINUX}
		TextColor(f_color);
	{$ELSE}
	    SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
	        f_color or (Last_background_color shl 4) );
    {$ENDIF}
    Last_foreground_color := f_color;
end;

procedure con_bg(b_color: Byte);
begin
	{$IFDEF LINUX}
		TextBackground(b_color);
	{$ELSE}
	    SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
	        Last_foreground_color or (b_color shl 4) );
    {$ENDIF}
    Last_background_color := b_color;
end;

function color_nearest_to(color_RGB: Integer): Integer;
var cR, cB, cG, rgb, r, g, b: Integer;
	delta, new_delta, i: Integer;
begin
	cR := color_RGB and $ff;
	cG := (color_RGB shr 8) and $ff;
	cB := (color_RGB shr 16) and $ff;
	Result := 0;
	delta := 256 * 3;
	for i := 0 to 15 do
	begin
		rgb := 0;
		case i of
		0: rgb := 0; //black
		1: rgb := $800000; //dark blue
		2: rgb := $008000; // dark green
		3: rgb := $808000; // dark cyan
		4: rgb := $000080; // dark red
		5: rgb := $808080; // dark magenta
		6: rgb := $008080; // dark yellow
		7: rgb := $808080; // dark gray
		8: rgb := $404040; // dark gray
		9: rgb := $C00000; // blue
		10: rgb := $00C000; // green
		11: rgb := $C0C000; // cyan
		12: rgb := $00000C0; // red
		13: rgb := $C000C0; // magenta
		14: rgb := $00C0C0; // yellow
		15: rgb := $C0C0C0; // white
		end;
		r := rgb and $ff;
		g := (rgb shr 8) and $ff;
		b := (rgb shr 16) and $ff;
		new_delta := Abs(r - cR) + Abs(g - cG) + Abs(b - cB);
		if (new_delta < delta) then
		begin
			Result := i;
			delta := new_delta;
		end;
	end;
end;

procedure apply_color_ansi(
param: Integer; color_RGB: Integer);
var was_Foreground, was_Background: Byte;
begin
    case (param) of
    -1: Exit;
    0:  
		begin
            high_intensity := false;
            con_fg(7); con_bg(0);
        end;
    1:  
		begin
            high_intensity := true;
            con_fg(Last_foreground_color or 8);
            con_bg(Last_background_color or 8);
        end;
    7:	
		begin
            was_Foreground := Last_foreground_color;
            was_Background := Last_background_color;
            con_fg(was_Background);
            con_bg(was_Foreground);
        end;
    30: if high_intensity then con_fg(8) else con_fg(0);   // BLACK
    31: if high_intensity then con_fg(8+4) else con_fg(4); // RED
    32: if high_intensity then con_fg(8+2) else con_fg(2); // GREEN
    33: if high_intensity then con_fg(8+6) else con_fg(6); // YELLOW
    34: if high_intensity then con_fg(8+1) else con_fg(1); // BLUE
    35: if high_intensity then con_fg(8+5) else con_fg(5); // MAGENTA
    36: if high_intensity then con_fg(8+3) else con_fg(3); // CYAN
    37: if high_intensity then con_fg(8+7) else con_fg(7); // WHITE
    38: con_fg(color_nearest_to(color_RGB));
    40: if high_intensity then con_bg(8) else con_bg(0);   // BLACK
    41: if high_intensity then con_bg(8+4) else con_bg(4); // RED
    42: if high_intensity then con_bg(8+2) else con_bg(2); // GREEN
    43: if high_intensity then con_bg(8+6) else con_bg(6); // YELLOW
    44: if high_intensity then con_bg(8+1) else con_bg(1); // BLUE
    45: if high_intensity then con_bg(8+5) else con_bg(5); // MAGENTA
    46: if high_intensity then con_bg(8+3) else con_bg(3); // CYAN
    47: if high_intensity then con_bg(8+7) else con_bg(7); // WHITE
    48: con_bg(color_nearest_to(color_RGB));
    108: 
		 begin prev_Foreground := Last_foreground_color;
               prev_Background := Last_background_color;
               prev_intensity := high_intensity;
         end;
    109: 
		 begin high_intensity := prev_intensity;
               con_fg(prev_Foreground);
               con_bg(prev_Background);
         end;
    end;
end;	 

procedure Extended_write(const S: String);
begin
	
	unitC_Console.M_Extended_write(S);
	
end;

procedure Console_ANSI_colors(Add_support: Boolean);
begin
	if Add_support then
		 Redirect_write := {$IFDEF FPC}@{$ENDIF} Extended_write
	else Redirect_write :=  {$IFDEF FPC}@{$ENDIF} Write_direct;
end;

function Get_char: char;
{$IFDEF LINUX}
{$ELSE}
var InputRec: TInputRecord;
var NumRead: DWORD;
{$ENDIF}
begin
{$IFDEF LINUX}
	Result := ReadKey;
	if Result = #0 then
		Result := ReadKey;
{$ELSE}
	RESULT := #0;
 	while ReadConsoleInput(GetStdHandle(STD_INPUT_HANDLE), 
 		InputRec, 1, NumRead) do begin
 		if InputRec.EventType <> KEY_EVENT then continue;
 		if not InputRec 
 			{$IFDEF MODERN_CODE} .Event 
 			{$ENDIF} 
 		   .KeyEvent.bKeyDown then continue;
 		RESULT := InputRec
 					{$IFDEF MODERN_CODE} .Event 
 					{$ENDIF}
 				  .KeyEvent.AsciiChar;
 		Exit;
 	end;
{$ENDIF}
end;

(*
/*
CONST STR:
    NATIVE_Import_console = @
    "uses NATIVE_Console {$IFDEF LINUX} , crt {$ELSE} , Windows {$ENDIF} ;"
    
    NATIVE_Support_console_ANSI = @
    "	RESULT := true;"

    NATIVE_Console_color = @
    "{$IFDEF LINUX}"
	"TextColor(X_C);"
	"{$ELSE}"   
	"  {$IFnDEF ANDROID}"
	"  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE), X_C);"
	"  {$ENDIF}"
	"{$ENDIF}"
    "Last_foreground_color := X_C;"

    NATIVE_Console_colors = @
	"{$IFDEF LINUX}"
	"TextColor(X_F);"
	"TextBackground(X_B);"
	"{$ELSE}"  
	"	{$IFnDEF ANDROID}" 
	"	SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),"
    "    X_F or (X_B shl 4) );"
    "	{$ENDIF}"
    "{$ENDIF}"
    "Last_foreground_color := X_F;"
    "Last_background_color := X_B;"
    
    NATIVE_Get_console_color = @
    "if X_Which = 0 then"
    "   RESULT := Last_foreground_color"
    "else RESULT := Last_background_color;"

	NATIVE_Console_ANSI_colors = @
	"	Console_ANSI_colors(X_Add);"
	
	NATIVE_Write_direct  = @
	"  Write_direct(X_S);"
	
	NATIVE_apply_color_ansi = @
	"	apply_color_ansi(X_Param, X_Color);"
	
	NATIVE_Get_char = @
	"RESULT := Get_char;"
	"if (Length(RESULT) = 1) and (RESULT[1] = Char(26)) then"
	"	End_input_detected := true;"
	
	NATIVE_End_input = @
	"  RESULT := End_input_detected;"
	
	NATIVE_Input_ready = @
	"	RESULT := false;"
	
	NATIVE_Key_pressed = @
	"	{$IFDEF LINUX}"
	"	{$ELSE}"
	"	RESULT := GetKeyState(X_Key) < 0;"
	"	{$ENDIF}"
	
	NATIVE_Key_pressed_async = @
	"	{$IFDEF LINUX}"
	"	{$ELSE}"
	"	RESULT := GetAsyncKeyState(X_Key);"
	"	{$ENDIF}"
	
	NATIVE_Cursor_X = @
	"	RESULT := 0;"
	
	NATIVE_Cursor_Y = @
	"	RESULT := 0;"
	
	NATIVE_Set_cursor_pos = @
	"	"
	
	NATIVE_Console_height = @
	"	RESULT := 24;"
	
	NATIVE_Console_width = @
	"	RESULT := 80;"
	
	NATIVE_Set_console_size = @
	"	"
	 
    .
    

    
END
*/
*)

end.
