diff options
author | Jedidiah Barber <contact@jedbarber.id.au> | 2024-02-06 21:53:06 +1300 |
---|---|---|
committer | Jedidiah Barber <contact@jedbarber.id.au> | 2024-02-06 21:53:06 +1300 |
commit | c47bea48a24e51e178354f3e3bb53d8b9964b769 (patch) | |
tree | 0235aa00983da4722cc49de315f76d3ea3978026 | |
parent | feef4803ef4cabd6190e5a76c34ccc9866da380d (diff) |
Moved mouse cursors and added cursor functions to FLTK.Draw
-rw-r--r-- | doc/fl.html | 5 | ||||
-rw-r--r-- | doc/fl_draw.html | 13 | ||||
-rw-r--r-- | doc/fl_window.html | 9 | ||||
-rw-r--r-- | src/c_fl_draw.cpp | 8 | ||||
-rw-r--r-- | src/c_fl_draw.h | 2 | ||||
-rw-r--r-- | src/fltk-draw.adb | 29 | ||||
-rw-r--r-- | src/fltk-draw.ads | 8 | ||||
-rw-r--r-- | src/fltk-widgets-groups-windows.adb | 4 | ||||
-rw-r--r-- | src/fltk-widgets-groups-windows.ads | 39 | ||||
-rw-r--r-- | 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 @@ <td> </td> </tr> + <tr> + <td>Fl_Cursor</td> + <td>Mouse_Cursor</td> + </tr> + </table> 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 <tr> <td><pre> void fl_cursor(Fl_Cursor); +</pre></td> +<td><pre> +procedure Set_Cursor + (To : in Mouse_Cursor); +</pre></td> + </tr> + <tr> +<td><pre> void fl_cursor(Fl_Cursor, Fl_Color fg, Fl_Color bg=FL_WHITE); </pre></td> <td><pre> - +procedure Set_Cursor + (To : in Mouse_Cursor; + Fore : in Color; + Back : in Color := White_Color); </pre></td> </tr> 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 @@ <td>Modal_State</td> </tr> - <tr> - <td> </td> - <td>Cursor</td> - </tr> - </table> @@ -159,7 +154,7 @@ void cursor(Fl_Cursor); <td><pre> procedure Set_Cursor (This : in out Window; - To : in Cursor); + To : in Mouse_Cursor); </pre></td> </tr> @@ -211,7 +206,7 @@ void default_cursor(Fl_Cursor); <td><pre> procedure Set_Default_Cursor (This : in out Window; - To : in Cursor); + To : in Mouse_Cursor); </pre></td> </tr> 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 |