summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJedidiah Barber <contact@jedbarber.id.au>2024-02-06 21:53:06 +1300
committerJedidiah Barber <contact@jedbarber.id.au>2024-02-06 21:53:06 +1300
commitc47bea48a24e51e178354f3e3bb53d8b9964b769 (patch)
tree0235aa00983da4722cc49de315f76d3ea3978026
parentfeef4803ef4cabd6190e5a76c34ccc9866da380d (diff)
Moved mouse cursors and added cursor functions to FLTK.Draw
-rw-r--r--doc/fl.html5
-rw-r--r--doc/fl_draw.html13
-rw-r--r--doc/fl_window.html9
-rw-r--r--src/c_fl_draw.cpp8
-rw-r--r--src/c_fl_draw.h2
-rw-r--r--src/fltk-draw.adb29
-rw-r--r--src/fltk-draw.ads8
-rw-r--r--src/fltk-widgets-groups-windows.adb4
-rw-r--r--src/fltk-widgets-groups-windows.ads39
-rw-r--r--src/fltk.ads54
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>&nbsp;</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>&nbsp;</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