summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--adapad.gpr2
-rw-r--r--logo.pngbin0 -> 6740 bytes
-rw-r--r--src/editor_windows.adb24
-rw-r--r--src/editor_windows.ads1
-rw-r--r--src/fltk_binding/c_fl_image.cpp33
-rw-r--r--src/fltk_binding/c_fl_image.h20
-rw-r--r--src/fltk_binding/c_fl_png_image.cpp16
-rw-r--r--src/fltk_binding/c_fl_png_image.h15
-rw-r--r--src/fltk_binding/c_fl_widget.cpp6
-rw-r--r--src/fltk_binding/c_fl_widget.h1
-rw-r--r--src/fltk_binding/c_fl_window.cpp16
-rw-r--r--src/fltk_binding/c_fl_window.h3
-rw-r--r--src/fltk_binding/fltk-images-rgb-png.adb49
-rw-r--r--src/fltk_binding/fltk-images-rgb-png.ads25
-rw-r--r--src/fltk_binding/fltk-images-rgb.adb14
-rw-r--r--src/fltk_binding/fltk-images-rgb.ads20
-rw-r--r--src/fltk_binding/fltk-images.adb96
-rw-r--r--src/fltk_binding/fltk-images.ads30
-rw-r--r--src/fltk_binding/fltk-widgets-groups-windows.adb43
-rw-r--r--src/fltk_binding/fltk-widgets-groups-windows.ads16
-rw-r--r--src/fltk_binding/fltk-widgets.adb28
-rw-r--r--src/fltk_binding/fltk-widgets.ads15
22 files changed, 471 insertions, 2 deletions
diff --git a/adapad.gpr b/adapad.gpr
index c5128a4..71d5b60 100644
--- a/adapad.gpr
+++ b/adapad.gpr
@@ -29,7 +29,7 @@ project AdaPad is
package Linker is
-- should this be filed under C++ somehow?
- for Default_Switches("Ada") use ("-lfltk");
+ for Default_Switches("Ada") use ("-lfltk", "-lfltk_images");
end Linker;
diff --git a/logo.png b/logo.png
new file mode 100644
index 0000000..48b65ec
--- /dev/null
+++ b/logo.png
Binary files differ
diff --git a/src/editor_windows.adb b/src/editor_windows.adb
index 20ccbbd..0f013bc 100644
--- a/src/editor_windows.adb
+++ b/src/editor_windows.adb
@@ -8,11 +8,18 @@ with FLTK.Widgets.Groups;
use FLTK.Widgets.Groups;
with FLTK.Widgets.Groups.Windows;
use FLTK.Widgets.Groups.Windows;
+with FLTK.Images.RGB.PNG;
+use FLTK.Images.RGB.PNG;
package body Editor_Windows is
+ Logo : PNG_Image := Create ("logo.png");
+
+
+
+
-- Editor_Window functions and procedures
function Create
@@ -47,6 +54,7 @@ package body Editor_Windows is
This.Editor.Set_Text_Font (Courier);
This.Set_Resizable (This.Editor);
This.Set_Size_Range (Min_Editor_Width, Min_Editor_Height);
+ This.Set_Icon (Logo);
end return;
end Create;
@@ -203,6 +211,10 @@ package body Editor_Windows is
My_Width : Integer := 350;
My_Height : Integer := 250;
+ Logo_Line : Integer := 30;
+ Logo_Width : Integer := 50;
+ Logo_Height : Integer := 50;
+
Button_Width : Integer := 140;
Button_Height : Integer := 40;
@@ -221,6 +233,9 @@ package body Editor_Windows is
return This : About_Window :=
(Double_Window'(Create (0, 0, My_Width, My_Height, "About Adapad")) with
+ Picture => Box'(Create
+ ((My_Width - Logo_Width) / 2,
+ Logo_Line, Logo_Width, Logo_Height, "")),
Heading => Box'(Create
(0, Heading_Line, My_Width, Heading_Size, Heading_Text)),
Blurb => Box'(Create
@@ -231,13 +246,18 @@ package body Editor_Windows is
((My_Width - Button_Width) / 2,
Button_Line, Button_Width, Button_Height, "Close"))) do
+ This.Add (This.Picture);
+ This.Picture.Set_Image (Logo);
This.Add (This.Heading);
This.Heading.Set_Label_Size (Font_Size (Heading_Size));
This.Add (This.Blurb);
This.Add (This.Author);
This.Add (This.Dismiss);
This.Dismiss.Set_Callback (Hide_CB'Access);
+
This.Set_Callback (Hide_CB'Access);
+ This.Set_Icon (Logo);
+ This.Set_Modal;
end return;
end Create;
@@ -333,6 +353,8 @@ package body Editor_Windows is
This.Start.Set_Callback (Find_M'Access);
This.Set_Callback (Hide_CB'Access);
+ This.Set_Icon (Logo);
+ This.Set_Modal;
end return;
end Create;
@@ -451,6 +473,8 @@ package body Editor_Windows is
This.Start.Set_Callback (Replace_M'Access);
This.Set_Callback (Hide_CB'Access);
+ This.Set_Icon (Logo);
+ This.Set_Modal;
end return;
end Create;
diff --git a/src/editor_windows.ads b/src/editor_windows.ads
index b6c6a00..7e6d42c 100644
--- a/src/editor_windows.ads
+++ b/src/editor_windows.ads
@@ -173,6 +173,7 @@ private
type About_Window is new Double_Window with
record
+ Picture : Box;
Heading : Box;
Blurb : Box;
Author : Box;
diff --git a/src/fltk_binding/c_fl_image.cpp b/src/fltk_binding/c_fl_image.cpp
new file mode 100644
index 0000000..8222392
--- /dev/null
+++ b/src/fltk_binding/c_fl_image.cpp
@@ -0,0 +1,33 @@
+
+
+#include <FL/Fl_Image.H>
+#include "c_fl_image.h"
+
+
+IMAGE new_fl_image(int w, int h, int d) {
+ Fl_Image *i = new Fl_Image(w, h, d);
+ return i;
+}
+
+
+void free_fl_image(IMAGE i) {
+ delete reinterpret_cast<Fl_Image*>(i);
+}
+
+
+
+
+int fl_image_w(IMAGE i) {
+ return reinterpret_cast<Fl_Image*>(i)->w();
+}
+
+
+int fl_image_h(IMAGE i) {
+ return reinterpret_cast<Fl_Image*>(i)->h();
+}
+
+
+int fl_image_d(IMAGE i) {
+ return reinterpret_cast<Fl_Image*>(i)->d();
+}
+
diff --git a/src/fltk_binding/c_fl_image.h b/src/fltk_binding/c_fl_image.h
new file mode 100644
index 0000000..a4be6df
--- /dev/null
+++ b/src/fltk_binding/c_fl_image.h
@@ -0,0 +1,20 @@
+
+
+#ifndef FL_IMAGE_GUARD
+#define FL_IMAGE_GUARD
+
+
+typedef void* IMAGE;
+
+
+extern "C" IMAGE new_fl_image(int w, int h, int d);
+extern "C" void free_fl_image(IMAGE i);
+
+
+extern "C" int fl_image_w(IMAGE i);
+extern "C" int fl_image_h(IMAGE i);
+extern "C" int fl_image_d(IMAGE i);
+
+
+#endif
+
diff --git a/src/fltk_binding/c_fl_png_image.cpp b/src/fltk_binding/c_fl_png_image.cpp
new file mode 100644
index 0000000..16d5927
--- /dev/null
+++ b/src/fltk_binding/c_fl_png_image.cpp
@@ -0,0 +1,16 @@
+
+
+#include <FL/Fl_PNG_Image.H>
+#include "c_fl_png_image.h"
+
+
+PNG_IMAGE new_fl_png_image(const char * f) {
+ Fl_PNG_Image *p = new Fl_PNG_Image(f);
+ return p;
+}
+
+
+void free_fl_png_image(PNG_IMAGE p) {
+ delete reinterpret_cast<Fl_PNG_Image*>(p);
+}
+
diff --git a/src/fltk_binding/c_fl_png_image.h b/src/fltk_binding/c_fl_png_image.h
new file mode 100644
index 0000000..a67a5aa
--- /dev/null
+++ b/src/fltk_binding/c_fl_png_image.h
@@ -0,0 +1,15 @@
+
+
+#ifndef FL_PNG_IMAGE_GUARD
+#define FL_PNG_IMAGE_GUARD
+
+
+typedef void* PNG_IMAGE;
+
+
+extern "C" PNG_IMAGE new_fl_png_image(const char * f);
+extern "C" void free_fl_png_image(PNG_IMAGE p);
+
+
+#endif
+
diff --git a/src/fltk_binding/c_fl_widget.cpp b/src/fltk_binding/c_fl_widget.cpp
index 9dea7ee..30c4de3 100644
--- a/src/fltk_binding/c_fl_widget.cpp
+++ b/src/fltk_binding/c_fl_widget.cpp
@@ -1,6 +1,7 @@
#include <FL/Fl_Widget.H>
+#include <FL/Fl_Image.H>
#include "c_fl_widget.h"
@@ -111,3 +112,8 @@ void fl_widget_position(WIDGET w, int x, int y) {
reinterpret_cast<Fl_Widget*>(w)->position(x, y);
}
+
+void fl_widget_set_image(WIDGET w, void * img) {
+ reinterpret_cast<Fl_Widget*>(w)->image(reinterpret_cast<Fl_Image*>(img));
+}
+
diff --git a/src/fltk_binding/c_fl_widget.h b/src/fltk_binding/c_fl_widget.h
index a9379f6..3c20dc2 100644
--- a/src/fltk_binding/c_fl_widget.h
+++ b/src/fltk_binding/c_fl_widget.h
@@ -33,6 +33,7 @@ extern "C" int fl_widget_get_w(WIDGET w);
extern "C" int fl_widget_get_h(WIDGET w);
extern "C" void fl_widget_size(WIDGET w, int d, int h);
extern "C" void fl_widget_position(WIDGET w, int x, int y);
+extern "C" void fl_widget_set_image(WIDGET w, void * img);
#endif
diff --git a/src/fltk_binding/c_fl_window.cpp b/src/fltk_binding/c_fl_window.cpp
index 9c8dbc6..fbce39b 100644
--- a/src/fltk_binding/c_fl_window.cpp
+++ b/src/fltk_binding/c_fl_window.cpp
@@ -1,6 +1,7 @@
#include <FL/Fl_Window.H>
+#include <FL/Fl_RGB_Image.H>
#include "c_fl_window.h"
@@ -40,3 +41,18 @@ void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int
reinterpret_cast<Fl_Window*>(n)->size_range(lw, lh, hw, hh, dw, dh, a);
}
+
+void fl_window_set_icon(WINDOW n, void * img) {
+ reinterpret_cast<Fl_Window*>(n)->icon(reinterpret_cast<Fl_RGB_Image*>(img));
+}
+
+
+void fl_window_set_modal(WINDOW n) {
+ reinterpret_cast<Fl_Window*>(n)->set_modal();
+}
+
+
+void fl_window_set_non_modal(WINDOW n) {
+ reinterpret_cast<Fl_Window*>(n)->set_non_modal();
+}
+
diff --git a/src/fltk_binding/c_fl_window.h b/src/fltk_binding/c_fl_window.h
index 526811a..c382919 100644
--- a/src/fltk_binding/c_fl_window.h
+++ b/src/fltk_binding/c_fl_window.h
@@ -15,6 +15,9 @@ extern "C" void fl_window_show(WINDOW n);
extern "C" void fl_window_hide(WINDOW n);
extern "C" void fl_window_set_label(WINDOW n, char* text);
extern "C" void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a);
+extern "C" void fl_window_set_icon(WINDOW n, void * img);
+extern "C" void fl_window_set_modal(WINDOW n);
+extern "C" void fl_window_set_non_modal(WINDOW n);
#endif
diff --git a/src/fltk_binding/fltk-images-rgb-png.adb b/src/fltk_binding/fltk-images-rgb-png.adb
new file mode 100644
index 0000000..ecb2f5e
--- /dev/null
+++ b/src/fltk_binding/fltk-images-rgb-png.adb
@@ -0,0 +1,49 @@
+
+
+with Interfaces.C;
+with System;
+use type System.Address;
+
+
+package body FLTK.Images.RGB.PNG is
+
+
+ function new_fl_png_image
+ (F : in Interfaces.C.char_array)
+ return System.Address;
+ pragma Import (C, new_fl_png_image, "new_fl_png_image");
+
+ procedure free_fl_png_image
+ (P : in System.Address);
+ pragma Import (C, free_fl_png_image, "free_fl_png_image");
+
+
+
+
+ overriding procedure Finalize
+ (This : in out PNG_Image) is
+ begin
+ Finalize (RGB_Image (This));
+ if This.Void_Ptr /= System.Null_Address then
+ if This in PNG_Image then
+ free_fl_png_image (This.Void_Ptr);
+ end if;
+ end if;
+ end Finalize;
+
+
+
+
+ function Create
+ (Filename : in String)
+ return PNG_Image is
+ begin
+ return This : PNG_Image do
+ This.Void_Ptr := new_fl_png_image
+ (Interfaces.C.To_C (Filename));
+ end return;
+ end Create;
+
+
+end FLTK.Images.RGB.PNG;
+
diff --git a/src/fltk_binding/fltk-images-rgb-png.ads b/src/fltk_binding/fltk-images-rgb-png.ads
new file mode 100644
index 0000000..0b44cb0
--- /dev/null
+++ b/src/fltk_binding/fltk-images-rgb-png.ads
@@ -0,0 +1,25 @@
+
+
+package FLTK.Images.RGB.PNG is
+
+
+ type PNG_Image is new RGB_Image with private;
+
+
+ function Create
+ (Filename : in String)
+ return PNG_Image;
+
+
+private
+
+
+ type PNG_Image is new RGB_Image with null record;
+
+
+ overriding procedure Finalize
+ (This : in out PNG_Image);
+
+
+end FLTK.Images.RGB.PNG;
+
diff --git a/src/fltk_binding/fltk-images-rgb.adb b/src/fltk_binding/fltk-images-rgb.adb
new file mode 100644
index 0000000..3556f74
--- /dev/null
+++ b/src/fltk_binding/fltk-images-rgb.adb
@@ -0,0 +1,14 @@
+
+
+package body FLTK.Images.RGB is
+
+
+ overriding procedure Finalize
+ (This : in out RGB_Image) is
+ begin
+ Finalize (Image (This));
+ end Finalize;
+
+
+end FLTK.Images.RGB;
+
diff --git a/src/fltk_binding/fltk-images-rgb.ads b/src/fltk_binding/fltk-images-rgb.ads
new file mode 100644
index 0000000..ba47793
--- /dev/null
+++ b/src/fltk_binding/fltk-images-rgb.ads
@@ -0,0 +1,20 @@
+
+
+package FLTK.Images.RGB is
+
+
+ type RGB_Image is new Image with private;
+
+
+private
+
+
+ type RGB_Image is new Image with null record;
+
+
+ overriding procedure Finalize
+ (This : in out RGB_Image);
+
+
+end FLTK.Images.RGB;
+
diff --git a/src/fltk_binding/fltk-images.adb b/src/fltk_binding/fltk-images.adb
new file mode 100644
index 0000000..bbd87c9
--- /dev/null
+++ b/src/fltk_binding/fltk-images.adb
@@ -0,0 +1,96 @@
+
+
+with Interfaces.C;
+with System;
+use type System.Address;
+
+
+package body FLTK.Images is
+
+
+ function new_fl_image
+ (W, H, D : in Interfaces.C.int)
+ return System.Address;
+ pragma Import (C, new_fl_image, "new_fl_image");
+
+ procedure free_fl_image
+ (I : in System.Address);
+ pragma Import (C, free_fl_image, "free_fl_image");
+
+ function fl_image_w
+ (I : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_image_w, "fl_image_w");
+
+ function fl_image_h
+ (I : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_image_h, "fl_image_h");
+
+ function fl_image_d
+ (I : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_image_d, "fl_image_d");
+
+
+
+
+ overriding procedure Finalize
+ (This : in out Image) is
+ begin
+ Finalize (Wrapper (This));
+ if This.Void_Ptr /= System.Null_Address then
+ if This in Image then
+ free_fl_image (This.Void_Ptr);
+ end if;
+ end if;
+ end Finalize;
+
+
+
+
+ function Create
+ (Width, Height, Depth : in Natural)
+ return Image is
+ begin
+ return This : Image do
+ This.Void_Ptr := new_fl_image
+ (Interfaces.C.int (Width),
+ Interfaces.C.int (Height),
+ Interfaces.C.int (Depth));
+ end return;
+ end Create;
+
+
+
+
+ function Get_W
+ (This : in Image)
+ return Natural is
+ begin
+ return Natural (fl_image_w (This.Void_Ptr));
+ end Get_W;
+
+
+
+
+ function Get_H
+ (This : in Image)
+ return Natural is
+ begin
+ return Natural (fl_image_h (This.Void_Ptr));
+ end Get_H;
+
+
+
+
+ function Get_D
+ (This : in Image)
+ return Natural is
+ begin
+ return Natural (fl_image_d (This.Void_Ptr));
+ end Get_D;
+
+
+end FLTK.Images;
+
diff --git a/src/fltk_binding/fltk-images.ads b/src/fltk_binding/fltk-images.ads
new file mode 100644
index 0000000..88d7658
--- /dev/null
+++ b/src/fltk_binding/fltk-images.ads
@@ -0,0 +1,30 @@
+
+
+package FLTK.Images is
+
+
+ type Image is new Wrapper with private;
+
+
+ function Create
+ (Width, Height, Depth : in Natural)
+ return Image;
+
+
+ function Get_W (This : in Image) return Natural;
+ function Get_H (This : in Image) return Natural;
+ function Get_D (This : in Image) return Natural;
+
+
+private
+
+
+ type Image is new Wrapper with null record;
+
+
+ overriding procedure Finalize
+ (This : in out Image);
+
+
+end FLTK.Images;
+
diff --git a/src/fltk_binding/fltk-widgets-groups-windows.adb b/src/fltk_binding/fltk-widgets-groups-windows.adb
index a0262e1..2d93bdd 100644
--- a/src/fltk_binding/fltk-widgets-groups-windows.adb
+++ b/src/fltk_binding/fltk-widgets-groups-windows.adb
@@ -2,6 +2,7 @@
with Interfaces.C;
with System;
+with FLTK.Images.RGB;
use type System.Address;
@@ -41,6 +42,18 @@ package body FLTK.Widgets.Groups.Windows is
LW, LH, HW, HH, DW, DH, A : in Interfaces.C.int);
pragma Import (C, fl_window_size_range, "fl_window_size_range");
+ procedure fl_window_set_icon
+ (W, P : in System.Address);
+ pragma Import (C, fl_window_set_icon, "fl_window_set_icon");
+
+ procedure fl_window_set_modal
+ (W : in System.Address);
+ pragma Import (C, fl_window_set_modal, "fl_window_set_modal");
+
+ procedure fl_window_set_non_modal
+ (W : in System.Address);
+ pragma Import (C, fl_window_set_non_modal, "fl_window_set_non_modal");
+
@@ -144,5 +157,35 @@ package body FLTK.Widgets.Groups.Windows is
end Set_Size_Range;
+
+
+ procedure Set_Icon
+ (This : in out Window;
+ Pic : in out FLTK.Images.RGB.RGB_Image'Class) is
+ begin
+ fl_window_set_icon
+ (This.Void_Ptr,
+ Wrapper (Pic).Void_Ptr);
+ end Set_Icon;
+
+
+
+
+ procedure Set_Modal
+ (This : in out Window) is
+ begin
+ fl_window_set_modal (This.Void_Ptr);
+ end Set_Modal;
+
+
+
+
+ procedure Set_Non_Modal
+ (This : in out Window) is
+ begin
+ fl_window_set_non_modal (This.Void_Ptr);
+ end Set_Non_Modal;
+
+
end FLTK.Widgets.Groups.Windows;
diff --git a/src/fltk_binding/fltk-widgets-groups-windows.ads b/src/fltk_binding/fltk-widgets-groups-windows.ads
index 2213563..96047ee 100644
--- a/src/fltk_binding/fltk-widgets-groups-windows.ads
+++ b/src/fltk_binding/fltk-widgets-groups-windows.ads
@@ -1,5 +1,8 @@
+with FLTK.Images.RGB;
+
+
package FLTK.Widgets.Groups.Windows is
@@ -37,6 +40,19 @@ package FLTK.Widgets.Groups.Windows is
Keep_Aspect : in Boolean := False);
+ procedure Set_Icon
+ (This : in out Window;
+ Pic : in out FLTK.Images.RGB.RGB_Image'Class);
+
+
+ procedure Set_Modal
+ (This : in out Window);
+
+
+ procedure Set_Non_Modal
+ (This : in out Window);
+
+
private
diff --git a/src/fltk_binding/fltk-widgets.adb b/src/fltk_binding/fltk-widgets.adb
index 0a159c7..c6ab5c0 100644
--- a/src/fltk_binding/fltk-widgets.adb
+++ b/src/fltk_binding/fltk-widgets.adb
@@ -5,6 +5,7 @@ with Interfaces.C.Strings;
with System;
with System.Address_To_Access_Conversions;
with FLTK.Widgets.Groups; use FLTK.Widgets.Groups;
+with FLTK.Images;
use type System.Address;
@@ -105,6 +106,10 @@ package body FLTK.Widgets is
X, Y : in Interfaces.C.int);
pragma Import (C, fl_widget_position, "fl_widget_position");
+ procedure fl_widget_set_image
+ (W, I : in System.Address);
+ pragma Import (C, fl_widget_set_image, "fl_widget_set_image");
+
@@ -319,5 +324,28 @@ package body FLTK.Widgets is
end Reposition;
+
+
+ function Get_Image
+ (This : in Widget)
+ return access FLTK.Images.Image'Class is
+ begin
+ return This.Current_Image;
+ end Get_Image;
+
+
+
+
+ procedure Set_Image
+ (This : in out Widget;
+ Pic : in out FLTK.Images.Image'Class) is
+ begin
+ This.Current_Image := Pic'Unchecked_Access;
+ fl_widget_set_image
+ (This.Void_Ptr,
+ Wrapper (Pic).Void_Ptr);
+ end Set_Image;
+
+
end FLTK.Widgets;
diff --git a/src/fltk_binding/fltk-widgets.ads b/src/fltk_binding/fltk-widgets.ads
index 05bba29..e692a65 100644
--- a/src/fltk_binding/fltk-widgets.ads
+++ b/src/fltk_binding/fltk-widgets.ads
@@ -1,6 +1,7 @@
with FLTK.Enums; use FLTK.Enums;
+with FLTK.Images;
limited with FLTK.Widgets.Groups;
private with System;
private with System.Address_To_Access_Conversions;
@@ -98,12 +99,24 @@ package FLTK.Widgets is
procedure Resize (This : in out Widget; W, H : in Integer);
procedure Reposition (This : in out Widget; X, Y : in Integer);
+
+ function Get_Image
+ (This : in Widget)
+ return access FLTK.Images.Image'Class;
+
+
+ procedure Set_Image
+ (This : in out Widget;
+ Pic : in out FLTK.Images.Image'Class);
+
+
private
type Widget is abstract new Wrapper with
record
- Callback : access Widget_Callback'Class;
+ Callback : access Widget_Callback'Class;
+ Current_Image : access FLTK.Images.Image'Class;
end record;
generated by cgit (git 2.30.0) at 2024-12-22 14:25:59 +0000