unit uScreen;

interface

uses
{$IFDEF VCL}
  Forms,
{$ELSE}
  QForms,
{$ENDIF}
  Rubies;

var
  cScreen: Tvalue;
  vScreen: Tvalue;

function ap_cScreen: Tvalue;
function ap_vScreen: Tvalue;
procedure Init_Screen;

implementation

uses uDefUtils, uAlloc, uProp, uPhi,
{$IFDEF VCL}
  uRect,
{$ENDIF}
{$IFDEF VCL}
  Graphics,
{$ELSE}
  QGraphics,
{$ENDIF}
  uFont,
  uConv,
  uStrings, uPersistent, uComponent;

function ap_cScreen: Tvalue;
begin
  result := cScreen;
end;

function ap_vScreen: Tvalue;
begin
  result := vScreen;
end;

function Screen_get_height(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.height);
end;

function Screen_get_width(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.width);
end;

function Screen_get_cursor(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.cursor);
end;

function Screen_get_active_control(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := real.ActiveControl.tag;
end;

function Screen_get_active_form(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := real.ActiveForm.tag;
end;

function Screen_set_cursor(This, v: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  real.cursor := FIX2INT(v);
  result := v;
end;

function Screen_get_cursors(This, index: Tvalue): Tvalue; cdecl;
{$IFDEF VCL}
var
  real: TScreen;
{$ENDIF}
begin
{$IFDEF VCL}
  real := ap_data_get_struct(This);
  result := INT2FIX(real.Cursors[FIX2INT(index)]);
{$ELSE}
  result := Qnil;
{$ENDIF}
end;

function Screen_set_cursors(This, index, cur: Tvalue): Tvalue; cdecl;
{$IFDEF VCL}
var
  real: TScreen;
{$ENDIF}
begin
{$IFDEF VCL}
  real := ap_data_get_struct(This);
  real.Cursors[FIX2INT(index)] := FIX2INT(cur);
{$ENDIF}
  result := cur;
end;

function Screen_get_forms(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
  I: Integer;
  obj: Tvalue;
begin
  real := ap_data_get_struct(This);
  result := rb_ary_new;
  for I := 0 to real.FormCount-1 do
  begin
    obj := real.Forms[I].tag;
    if obj = 0 then Continue;
    rb_ary_push(result, obj);
  end;
end;

function Screen_get_form_count(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.FormCount);
end;

function Screen_instance(This: Tvalue): Tvalue; cdecl;
begin
  result := vScreen;
end;

procedure Regist_Screen;
var
  real: TScreen;
  obj: Tvalue;
begin
  real := Screen;
  obj := ChildAlloc(cScreen, real);
  vScreen := obj;
  rb_define_const(mPhi, 'SCREEN', obj);
  rb_iv_set(obj, '@fonts', ap_iStrings(real.Fonts, obj));
{$IFDEF VCL}
  rb_iv_set(obj, '@imes', ap_iStrings(real.Imes, obj));
  rb_iv_set(obj, '@default_ime', rb_str_new2(PChar(real.DefaultIme)));
{$ENDIF}
end;

{$IFDEF VCL}
function Screen_get_work_area_height(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.WorkAreaHeight);
end;

function Screen_get_work_area_left(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.WorkAreaLeft);
end;

function Screen_get_work_area_rect(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := ap_iRect(real.WorkAreaRect, This);
end;

function Screen_get_work_area_top(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.WorkAreaTop);
end;

function Screen_get_work_area_width(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.WorkAreaWidth);
end;
{$ENDIF}

function Screen_get_pixels_per_inch(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.PixelsPerInch);
end;
{$IFDEF VCL}
function Screen_disable_align(This : Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  real.DisableAlign;
  result := This;
end;

function Screen_enable_align(This : Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  real.EnableAlign;
  result := This;
end;

function Screen_realign(This : Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  real.Realign;
  result := This;
end;

function Screen_reset_fonts(This : Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  real.ResetFonts;
  result := This;
end;

function Screen_get_desktop_rect(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := ap_iRect(real.DesktopRect,This);
end;

function Screen_get_desktop_height(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(Ord(real.DesktopHeight));
end;

function Screen_get_desktop_left(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(Ord(real.DesktopLeft));
end;

function Screen_get_desktop_top(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(Ord(real.DesktopTop));
end;

function Screen_get_desktop_width(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(Ord(real.DesktopWidth));
end;
{$ENDIF}
function Screen_get_hint_font(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := ap_iFont(real.HintFont,This);
end;

function Screen_set_hint_font(This, v: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  real.HintFont := ap_data_get_struct(v);
  result := v;
end;
{$IFDEF VCL}
function Screen_get_icon_font(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := ap_iFont(real.IconFont,This);
end;

function Screen_set_icon_font(This, v: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  real.IconFont := ap_data_get_struct(v);
  result := v;
end;

function Screen_get_menu_font(This: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  result := ap_iFont(real.MenuFont,This);
end;

function Screen_set_menu_font(This, v: Tvalue): Tvalue; cdecl;
var
  real: TScreen;
begin
  real := ap_data_get_struct(This);
  real.MenuFont := ap_data_get_struct(v);
  result := v;
end;
{$ENDIF}
procedure Init_Screen;
begin
  cScreen := OutputPersistentClass(mPhi, TScreen, cComponent, nil);

  rb_undef_method(CLASS_OF(cScreen), 'new');
  rb_define_singleton_method(cScreen, 'instance', @Screen_instance, 0);

  DefineAttrGet(cScreen, 'height', Screen_get_height);
  DefineAttrGet(cScreen, 'width', Screen_get_width);

  DefineAttrGet(cScreen, 'active_control', Screen_get_active_control);
  DefineAttrGet(cScreen, 'active_form', Screen_get_active_form);
  DefineAttrGet(cScreen, 'cursor', Screen_get_cursor);
  DefineAttrSet(cScreen, 'cursor', Screen_set_cursor);
  rb_define_method(cScreen, 'get_cursors', @Screen_get_cursors, 1);
  rb_define_method(cScreen, 'set_cursors', @Screen_set_cursors, 2);
  DefineAttrGet(cScreen, 'forms', Screen_get_forms);
  DefineAttrGet(cScreen, 'form_count', Screen_get_form_count);
  rb_define_attr(cScreen, 'fonts', 1, 0);
  rb_define_attr(cScreen, 'imes', 1, 0);
  rb_define_attr(cScreen, 'default_ime', 1, 0);
{$IFDEF VCL}
  DefineAttrGet(cScreen, 'work_area_height', Screen_get_work_area_height);
  DefineAttrGet(cScreen, 'work_area_left', Screen_get_work_area_left);
  DefineAttrGet(cScreen, 'work_area_rect', Screen_get_work_area_rect);
  DefineAttrGet(cScreen, 'work_area_top', Screen_get_work_area_top);
  DefineAttrGet(cScreen, 'work_area_width', Screen_get_work_area_width);
{$ENDIF}
  DefineAttrGet(cScreen, 'pixels_per_inch', Screen_get_pixels_per_inch);
{$IFDEF VCL}
  rb_define_method(cScreen, 'disable_align', @Screen_disable_align, 0);
  rb_define_method(cScreen, 'enable_align', @Screen_enable_align, 0);
  rb_define_method(cScreen, 'realign', @Screen_realign, 0);
  rb_define_method(cScreen, 'reset_fonts', @Screen_reset_fonts, 0);
  DefineAttrGet(cScreen, 'desktop_rect', Screen_get_desktop_rect);
  DefineAttrGet(cScreen, 'desktop_height', Screen_get_desktop_height);
  DefineAttrGet(cScreen, 'desktop_left', Screen_get_desktop_left);
  DefineAttrGet(cScreen, 'desktop_top', Screen_get_desktop_top);
  DefineAttrGet(cScreen, 'desktop_width', Screen_get_desktop_width);
{$ENDIF}
  DefineAttrGet(cScreen, 'hint_font', Screen_get_hint_font);
  DefineAttrSet(cScreen, 'hint_font', Screen_set_hint_font);
{$IFDEF VCL}
  DefineAttrGet(cScreen, 'icon_font', Screen_get_icon_font);
  DefineAttrSet(cScreen, 'icon_font', Screen_set_icon_font);
  DefineAttrGet(cScreen, 'menu_font', Screen_get_menu_font);
  DefineAttrSet(cScreen, 'menu_font', Screen_set_menu_font);
{$ENDIF}
  Regist_Screen;
end;

end.
