From c47bea48a24e51e178354f3e3bb53d8b9964b769 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Tue, 6 Feb 2024 21:53:06 +1300 Subject: Moved mouse cursors and added cursor functions to FLTK.Draw --- doc/fl.html | 5 ++++ doc/fl_draw.html | 13 ++++++++- doc/fl_window.html | 9 ++----- src/c_fl_draw.cpp | 8 ++++++ src/c_fl_draw.h | 2 ++ src/fltk-draw.adb | 29 ++++++++++++++++++++ src/fltk-draw.ads | 8 ++++++ src/fltk-widgets-groups-windows.adb | 4 +-- src/fltk-widgets-groups-windows.ads | 39 ++------------------------- src/fltk.ads | 54 +++++++++++++++++++++++++++++++++++++ 10 files changed, 124 insertions(+), 47 deletions(-) diff --git a/doc/fl.html b/doc/fl.html index bb32af7..254a06e 100644 --- a/doc/fl.html +++ b/doc/fl.html @@ -222,6 +222,11 @@   + + Fl_Cursor + Mouse_Cursor + + diff --git a/doc/fl_draw.html b/doc/fl_draw.html index 3725377..71da104 100644 --- a/doc/fl_draw.html +++ b/doc/fl_draw.html @@ -269,11 +269,22 @@ procedure Set_Color 
 void fl_cursor(Fl_Cursor);
+
+
+procedure Set_Cursor
+       (To : in Mouse_Cursor);
+
+ + +
 void fl_cursor(Fl_Cursor, Fl_Color fg, Fl_Color bg=FL_WHITE);
 
-
+procedure Set_Cursor
+       (To   : in Mouse_Cursor;
+        Fore : in Color;
+        Back : in Color := White_Color);
diff --git a/doc/fl_window.html b/doc/fl_window.html index bfba28f..518dc97 100644 --- a/doc/fl_window.html +++ b/doc/fl_window.html @@ -52,11 +52,6 @@ Modal_State - -   - Cursor - - @@ -159,7 +154,7 @@ void cursor(Fl_Cursor); 
 procedure Set_Cursor
        (This : in out Window;
-        To   : in     Cursor);
+        To   : in     Mouse_Cursor);
@@ -211,7 +206,7 @@ void default_cursor(Fl_Cursor); 
 procedure Set_Default_Cursor
        (This : in out Window;
-        To   : in     Cursor);
+        To   : in     Mouse_Cursor);
diff --git a/src/c_fl_draw.cpp b/src/c_fl_draw.cpp index d1087fe..f8a5303 100644 --- a/src/c_fl_draw.cpp +++ b/src/c_fl_draw.cpp @@ -102,6 +102,14 @@ void fl_draw_set_color2(uchar r, uchar g, uchar b) { fl_color(r, g, b); } +void fl_draw_set_cursor(int m) { + fl_cursor((Fl_Cursor)m); +} + +void fl_draw_set_cursor2(int m, unsigned int f, unsigned int b) { + fl_cursor((Fl_Cursor)m, f, b); +} + unsigned int fl_draw_get_font() { return (unsigned int)fl_font(); } diff --git a/src/c_fl_draw.h b/src/c_fl_draw.h index 592087c..dec536c 100644 --- a/src/c_fl_draw.h +++ b/src/c_fl_draw.h @@ -36,6 +36,8 @@ extern "C" void fl_draw_overlay_rect(int x, int y, int w, int h); extern "C" unsigned int fl_draw_get_color(); extern "C" void fl_draw_set_color(unsigned int c); extern "C" void fl_draw_set_color2(uchar r, uchar g, uchar b); +extern "C" void fl_draw_set_cursor(int m); +extern "C" void fl_draw_set_cursor2(int m, unsigned int f, unsigned int b); extern "C" unsigned int fl_draw_get_font(); extern "C" int fl_draw_size(); extern "C" void fl_draw_set_font(unsigned int f, int s); diff --git a/src/fltk-draw.adb b/src/fltk-draw.adb index 74dccb8..544d583 100644 --- a/src/fltk-draw.adb +++ b/src/fltk-draw.adb @@ -139,6 +139,17 @@ package body FLTK.Draw is pragma Import (C, fl_draw_set_color2, "fl_draw_set_color2"); pragma Inline (fl_draw_set_color2); + procedure fl_draw_set_cursor + (M : in Interfaces.C.int); + pragma Import (C, fl_draw_set_cursor, "fl_draw_set_cursor"); + pragma Inline (fl_draw_set_cursor); + + procedure fl_draw_set_cursor2 + (M : in Interfaces.C.int; + F, B : in Interfaces.C.unsigned); + pragma Import (C, fl_draw_set_cursor2, "fl_draw_set_cursor2"); + pragma Inline (fl_draw_set_cursor2); + function fl_draw_get_font return Interfaces.C.unsigned; pragma Import (C, fl_draw_get_font, "fl_draw_get_font"); @@ -798,6 +809,24 @@ package body FLTK.Draw is end Set_Color; + procedure Set_Cursor + (To : in Mouse_Cursor) is + begin + fl_draw_set_cursor (Cursor_Values (To)); + end Set_Cursor; + + procedure Set_Cursor + (To : in Mouse_Cursor; + Fore : in Color; + Back : in Color := White_Color) is + begin + fl_draw_set_cursor2 + (Cursor_Values (To), + Interfaces.C.unsigned (Fore), + Interfaces.C.unsigned (Back)); + end Set_Cursor; + + function Get_Font return Font_Kind is begin diff --git a/src/fltk-draw.ads b/src/fltk-draw.ads index e287f90..3ec3b94 100644 --- a/src/fltk-draw.ads +++ b/src/fltk-draw.ads @@ -168,6 +168,14 @@ package FLTK.Draw is procedure Set_Color (R, G, B : in Color_Component); + procedure Set_Cursor + (To : in Mouse_Cursor); + + procedure Set_Cursor + (To : in Mouse_Cursor; + Fore : in Color; + Back : in Color := White_Color); + function Get_Font return Font_Kind; diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb index 08becbc..c1ffb31 100644 --- a/src/fltk-widgets-groups-windows.adb +++ b/src/fltk-widgets-groups-windows.adb @@ -516,7 +516,7 @@ package body FLTK.Widgets.Groups.Windows is procedure Set_Cursor (This : in out Window; - To : in Cursor) is + To : in Mouse_Cursor) is begin fl_window_set_cursor (This.Void_Ptr, Cursor_Values (To)); end Set_Cursor; @@ -537,7 +537,7 @@ package body FLTK.Widgets.Groups.Windows is procedure Set_Default_Cursor (This : in out Window; - To : in Cursor) is + To : in Mouse_Cursor) is begin fl_window_set_default_cursor (This.Void_Ptr, Cursor_Values (To)); end Set_Default_Cursor; diff --git a/src/fltk-widgets-groups-windows.ads b/src/fltk-widgets-groups-windows.ads index 5eac154..4cc8294 100644 --- a/src/fltk-widgets-groups-windows.ads +++ b/src/fltk-widgets-groups-windows.ads @@ -21,13 +21,6 @@ package FLTK.Widgets.Groups.Windows is type Modal_State is (Normal, Non_Modal, Modal); - type Cursor is - (Default, Arrow, Crosshair, Wait, - Insert, Hand, Help, Move, - NS, WE, NWSE, NESW, - N, NE, E, SE, S, SW, W, NW, - None); - @@ -114,7 +107,7 @@ package FLTK.Widgets.Groups.Windows is procedure Set_Cursor (This : in out Window; - To : in Cursor); + To : in Mouse_Cursor); procedure Set_Cursor (This : in out Window; @@ -123,7 +116,7 @@ package FLTK.Widgets.Groups.Windows is procedure Set_Default_Cursor (This : in out Window; - To : in Cursor); + To : in Mouse_Cursor); @@ -275,34 +268,6 @@ private - -- What delightful magic numbers FLTK cursors are! - -- (These correspond to the enum found in Enumerations.H) - Cursor_Values : array (Cursor) of Interfaces.C.int := - (Default => 0, - Arrow => 35, - Crosshair => 66, - Wait => 76, - Insert => 77, - Hand => 31, - Help => 47, - Move => 27, - NS => 78, - WE => 79, - NWSE => 80, - NESW => 81, - N => 70, - NE => 69, - E => 49, - SE => 8, - S => 9, - SW => 7, - W => 36, - NW => 68, - None => 255); - - - - Last_Current : access Window'Class := null; diff --git a/src/fltk.ads b/src/fltk.ads index 0356d2e..c4cf336 100644 --- a/src/fltk.ads +++ b/src/fltk.ads @@ -84,6 +84,32 @@ package FLTK is + type Mouse_Cursor is + (Default_Mouse, + Arrow_Mouse, + Crosshair_Mouse, + Wait_Mouse, + Insert_Mouse, + Hand_Mouse, + Help_Mouse, + Move_Mouse, + NS_Mouse, + WE_Mouse, + NWSE_Mouse, + NESW_Mouse, + N_Mouse, + NE_Mouse, + E_Mouse, + SE_Mouse, + S_Mouse, + SW_Mouse, + W_Mouse, + NW_Mouse, + None_Mouse); + + + + type Keypress is private; subtype Pressable_Key is Character range Character'Val (32) .. Character'Val (126); function Press (Key : in Pressable_Key) return Keypress; @@ -365,6 +391,34 @@ private + -- What delightful magic numbers FLTK cursors are! + -- (These correspond to the enum found in Enumerations.H) + Cursor_Values : array (Mouse_Cursor) of Interfaces.C.int := + (Default_Mouse => 0, + Arrow_Mouse => 35, + Crosshair_Mouse => 66, + Wait_Mouse => 76, + Insert_Mouse => 77, + Hand_Mouse => 31, + Help_Mouse => 47, + Move_Mouse => 27, + NS_Mouse => 78, + WE_Mouse => 79, + NWSE_Mouse => 80, + NESW_Mouse => 81, + N_Mouse => 70, + NE_Mouse => 69, + E_Mouse => 49, + SE_Mouse => 8, + S_Mouse => 9, + SW_Mouse => 7, + W_Mouse => 36, + NW_Mouse => 68, + None_Mouse => 255); + + + + type Keypress is new Interfaces.Unsigned_16; type Modifier is new Interfaces.Unsigned_16; type Key_Combo is -- cgit