diff options
Diffstat (limited to 'body/fltk-screen.adb')
| -rw-r--r-- | body/fltk-screen.adb | 132 |
1 files changed, 127 insertions, 5 deletions
diff --git a/body/fltk-screen.adb b/body/fltk-screen.adb index ad25cbe..6b8118e 100644 --- a/body/fltk-screen.adb +++ b/body/fltk-screen.adb @@ -16,6 +16,47 @@ use type package body FLTK.Screen is + ------------------------ + -- Constants From C -- + ------------------------ + + fl_enum_mode_rgb : constant Interfaces.C.int; + pragma Import (C, fl_enum_mode_rgb, "fl_enum_mode_rgb"); + + fl_enum_mode_rgb8 : constant Interfaces.C.int; + pragma Import (C, fl_enum_mode_rgb8, "fl_enum_mode_rgb8"); + + fl_enum_mode_double : constant Interfaces.C.int; + pragma Import (C, fl_enum_mode_double, "fl_enum_mode_double"); + + fl_enum_mode_index : constant Interfaces.C.int; + pragma Import (C, fl_enum_mode_index, "fl_enum_mode_index"); + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + -- Environment -- + + procedure fl_screen_display + (V : in Interfaces.C.char_array); + pragma Import (C, fl_screen_display, "fl_screen_display"); + pragma Inline (fl_screen_display); + + function fl_screen_visual + (F : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_screen_visual, "fl_screen_visual"); + pragma Inline (fl_screen_visual); + + + + + -- Basic Dimensions -- + function fl_screen_x return Interfaces.C.int; pragma Import (C, fl_screen_x, "fl_screen_x"); @@ -39,6 +80,8 @@ package body FLTK.Screen is + -- Pixel Density -- + function fl_screen_count return Interfaces.C.int; pragma Import (C, fl_screen_count, "fl_screen_count"); @@ -53,6 +96,8 @@ package body FLTK.Screen is + -- Position Lookup -- + function fl_screen_num (X, Y : in Interfaces.C.int) return Interfaces.C.int; @@ -68,6 +113,8 @@ package body FLTK.Screen is + -- Bounding Boxes -- + procedure fl_screen_work_area (X, Y, W, H : out Interfaces.C.int; PX, PY : in Interfaces.C.int); @@ -85,9 +132,6 @@ package body FLTK.Screen is pragma Import (C, fl_screen_work_area3, "fl_screen_work_area3"); pragma Inline (fl_screen_work_area3); - - - procedure fl_screen_xywh (X, Y, W, H : out Interfaces.C.int; PX, PY : in Interfaces.C.int); @@ -114,6 +158,61 @@ package body FLTK.Screen is + -- Drawing -- + + function fl_screen_get_damage + return Interfaces.C.int; + pragma Import (C, fl_screen_get_damage, "fl_screen_get_damage"); + pragma Inline (fl_screen_get_damage); + + procedure fl_screen_set_damage + (V : in Interfaces.C.int); + pragma Import (C, fl_screen_set_damage, "fl_screen_set_damage"); + pragma Inline (fl_screen_set_damage); + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + -- Environment -- + + procedure Set_Display_String + (Value : in String) is + begin + fl_screen_display (Interfaces.C.To_C (Value)); + end Set_Display_String; + + + procedure Set_Visual_Mode + (Value : in Visual_Mode) + is + Ignore : Boolean := Set_Visual_Mode (Value); + begin + null; + end Set_Visual_Mode; + + + function Set_Visual_Mode + (Value : in Visual_Mode) + return Boolean is + begin + return fl_screen_visual + ((case Value is + when RGB => fl_enum_mode_rgb, + when RGB_24bit => fl_enum_mode_rgb8, + when Double_Buffer => fl_enum_mode_double + fl_enum_mode_index, + when Double_RGB => fl_enum_mode_double + fl_enum_mode_rgb, + when Double_RGB_24bit => fl_enum_mode_double + fl_enum_mode_rgb8)) /= 0; + end Set_Visual_Mode; + + + + + -- Basic Dimensions -- + function Get_X return Integer is begin return Integer (fl_screen_x); @@ -140,6 +239,8 @@ package body FLTK.Screen is + -- Pixel Density -- + function Count return Integer is begin return Integer (fl_screen_count); @@ -160,6 +261,8 @@ package body FLTK.Screen is + -- Position Lookup -- + function Containing (X, Y : in Integer) return Integer is @@ -184,6 +287,8 @@ package body FLTK.Screen is + -- Bounding Boxes -- + procedure Work_Area (X, Y, W, H : out Integer; Pos_X, Pos_Y : in Integer) is @@ -222,8 +327,6 @@ package body FLTK.Screen is end Work_Area; - - procedure Bounding_Rect (X, Y, W, H : out Integer; Pos_X, Pos_Y : in Integer) is @@ -278,5 +381,24 @@ package body FLTK.Screen is end Bounding_Rect; + + + -- Drawing -- + + function Is_Damaged + return Boolean is + begin + return fl_screen_get_damage /= 0; + end Is_Damaged; + + + procedure Set_Damaged + (To : in Boolean) is + begin + fl_screen_set_damage (Boolean'Pos (To)); + end Set_Damaged; + + end FLTK.Screen; + |