Fl_Label Binding Map

From a6a1c9763c62b9aa8643b0c5b9937f3a930337b8 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Mon, 28 Oct 2024 02:34:18 +1300 Subject: Fl_Label binding added --- doc/fl_label.html | 216 +++++++++++++++++++++++++++++++ doc/index.html | 3 +- progress.txt | 2 +- src/c_fl_label.cpp | 96 ++++++++++++++ src/c_fl_label.h | 45 +++++++ src/fltk-labels.adb | 358 ++++++++++++++++++++++++++++++++++++++++++++++++++++ src/fltk-labels.ads | 155 +++++++++++++++++++++++ 7 files changed, 873 insertions(+), 2 deletions(-) create mode 100644 doc/fl_label.html create mode 100644 src/c_fl_label.cpp create mode 100644 src/c_fl_label.h create mode 100644 src/fltk-labels.adb create mode 100644 src/fltk-labels.ads diff --git a/doc/fl_label.html b/doc/fl_label.html new file mode 100644 index 0000000..66df8fe --- /dev/null +++ b/doc/fl_label.html @@ -0,0 +1,216 @@ + + + + + + + Fl_Label Binding Map + + + + + + +

Fl_Label Binding Map

+ + +Back to Index + + + + + + + + + + +

Package name
Fl_Label	FLTK.Labels

+ + + + + + + + + + + + + + + + +

Types
Fl_Label	Label
	Label_Reference

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Functions and Procedures
	+function Create + (Value : in String; + Font : in Font_Kind := Helvetica; + Size : in Font_Size := Normal_Size; + Hue : in Color := Foreground_Color; + Kind : in Label_Kind := Normal_Label; + Place : in Alignment := Align_Center; + Active : access FLTK.Images.Image'Class := null; + Inactive : access FLTK.Images.Image'Class := null) + return Label; +
+Fl_Align align_; +	+function Get_Alignment + (This : in Label) + return Alignment; + +procedure Set_Alignment + (This : in out Label; + Place : in Alignment); +
+Fl_Color color; +	+function Get_Color + (This : in Label) + return Color; + +procedure Set_Color + (This : in out Label; + Hue : in Color); +
+Fl_Image * deimage; +	+function Get_Inactive + (This : in Label) + return access FLTK.Images.Image'Class; + +procedure Set_Inactive + (This : in out Label; + Pic : access FLTK.Images.Image'Class); +
+void draw(int, int, int, int, Fl_Align); +	+procedure Draw + (This : in out Label; + X, Y, W, H : in Integer; + Place : in Alignment); +
+Fl_Font font; +	+function Get_Font + (This : in Label) + return Font_Kind; + +procedure Set_Font + (This : in out Label; + Font : in Font_Kind); +
+Fl_Image * image; +	+function Get_Active + (This : in Label) + return access FLTK.Images.Image'Class; + +procedure Set_Active + (This : in out Label; + Pic : access FLTK.Images.Image'Class); +
+void measure(int, &w, int &h) const; +	+procedure Measure + (This : in Label; + W, H : out Integer); +
+Fl_Fontsize size; +	+function Get_Size + (This : in Label) + return Font_Size; + +procedure Set_Size + (This : in out Label; + Size : in Font_Size); +
+uchar type; +	+function Get_Kind + (This : in Label) + return Label_Kind; + +procedure Set_Kind + (This : in out Label; + Kind : in Label_Kind); +
+const char * value; +	+function Get_Value + (This : in Label) + return String; + +procedure Set_Value + (This : in out Label; + Text : in String); +

+ + + + + diff --git a/doc/index.html b/doc/index.html index 8c41b3d..c692083 100644 --- a/doc/index.html +++ b/doc/index.html @@ -67,7 +67,7 @@

Fl_Label

@@ -160,6 +160,7 @@

diff --git a/progress.txt b/progress.txt index 6f3f56d..15f15cf 100644 --- a/progress.txt +++ b/progress.txt @@ -43,6 +43,7 @@ FLTK.Images.RGB.PNG FLTK.Images.RGB.PNM FLTK.Images.Shared FLTK.Images.Tiled +FLTK.Labels FLTK.Menu_Items FLTK.Screen FLTK.Static @@ -143,7 +144,6 @@ Fl_File_Chooser Fl_Glut_Window Fl_Help_Dialog Fl_Hold_Browser -Fl_Label Fl_Multi_Browser Fl_Postscript_File_Device Fl_Select_Browser diff --git a/src/c_fl_label.cpp b/src/c_fl_label.cpp new file mode 100644 index 0000000..71b81ba --- /dev/null +++ b/src/c_fl_label.cpp @@ -0,0 +1,96 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include +#include +#include "c_fl_label.h" +#include "c_fl_type.h" + + + + +LABEL new_fl_label(const char * v, int f, int s, unsigned int h, int k, unsigned int p) { + Fl_Label *l = new Fl_Label; + l->value = v; + l->font = f; + l->size = s; + l->color = h; + l->align_ = p; + l->type = (uchar)k; + return l; +} + +void free_fl_label(LABEL l) { + delete reinterpret_cast(l); +} + + + + +void fl_label_set_value(LABEL l, const char * v) { + reinterpret_cast(l)->value = v; +} + +int fl_label_get_font(LABEL l) { + return reinterpret_cast(l)->font; +} + +void fl_label_set_font(LABEL l, int f) { + reinterpret_cast(l)->font = f; +} + +int fl_label_get_size(LABEL l) { + return reinterpret_cast(l)->size; +} + +void fl_label_set_size(LABEL l, int s) { + reinterpret_cast(l)->size = s; +} + +unsigned int fl_label_get_color(LABEL l) { + return reinterpret_cast(l)->color; +} + +void fl_label_set_color(LABEL l, unsigned int h) { + reinterpret_cast(l)->color = h; +} + +int fl_label_get_type(LABEL l) { + return (int)reinterpret_cast(l)->type; +} + +void fl_label_set_type(LABEL l, int k) { + reinterpret_cast(l)->type = (uchar)k; +} + +unsigned int fl_label_get_align(LABEL l) { + return reinterpret_cast(l)->align_; +} + +void fl_label_set_align(LABEL l, unsigned int p) { + reinterpret_cast(l)->align_ = p; +} + +void fl_label_set_image(LABEL l, void * i) { + reinterpret_cast(l)->image = reinterpret_cast(i); +} + +void fl_label_set_deimage(LABEL l, void * i) { + reinterpret_cast(l)->deimage = reinterpret_cast(i); +} + + + + +void fl_label_draw(LABEL l, int x, int y, int w, int h, unsigned int p) { + reinterpret_cast(l)->draw(x, y, w, h, p); +} + +void fl_label_measure(LABEL l, int &w, int &h) { + reinterpret_cast(l)->measure(w, h); +} + + diff --git a/src/c_fl_label.h b/src/c_fl_label.h new file mode 100644 index 0000000..ea69d51 --- /dev/null +++ b/src/c_fl_label.h @@ -0,0 +1,45 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_LABEL_GUARD +#define FL_LABEL_GUARD + + + + +typedef void* LABEL; + + + + +extern "C" LABEL new_fl_label(const char * v, int f, int s, unsigned int h, int k, unsigned int p); +extern "C" void free_fl_label(LABEL l); + + + + +extern "C" void fl_label_set_value(LABEL l, const char * v); +extern "C" int fl_label_get_font(LABEL l); +extern "C" void fl_label_set_font(LABEL l, int f); +extern "C" int fl_label_get_size(LABEL l); +extern "C" void fl_label_set_size(LABEL l, int s); +extern "C" unsigned int fl_label_get_color(LABEL l); +extern "C" void fl_label_set_color(LABEL l, unsigned int h); +extern "C" int fl_label_get_type(LABEL l); +extern "C" void fl_label_set_type(LABEL l, int k); +extern "C" unsigned int fl_label_get_align(LABEL l); +extern "C" void fl_label_set_align(LABEL l, unsigned int p); +extern "C" void fl_label_set_image(LABEL l, void * i); +extern "C" void fl_label_set_deimage(LABEL l, void * i); + + +extern "C" void fl_label_draw(LABEL l, int x, int y, int w, int h, unsigned int p); +extern "C" void fl_label_measure(LABEL l, int &w, int &h); + + +#endif + + diff --git a/src/fltk-labels.adb b/src/fltk-labels.adb new file mode 100644 index 0000000..493ac8d --- /dev/null +++ b/src/fltk-labels.adb @@ -0,0 +1,358 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings; + + +package body FLTK.Labels is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_label + (V : in Interfaces.C.Strings.chars_ptr; + F : in Interfaces.C.int; + S : in Interfaces.C.int; + H : in Interfaces.C.unsigned; + K : in Interfaces.C.int; + P : in Interfaces.C.unsigned) + return Storage.Integer_Address; + pragma Import (C, new_fl_label, "new_fl_label"); + pragma Inline (new_fl_label); + + procedure free_fl_label + (L : in Storage.Integer_Address); + pragma Import (C, free_fl_label, "free_fl_label"); + pragma Inline (free_fl_label); + + + + + procedure fl_label_set_value + (L : in Storage.Integer_Address; + V : in Interfaces.C.Strings.chars_ptr); + pragma Import (C, fl_label_set_value, "fl_label_set_value"); + pragma Inline (fl_label_set_value); + + function fl_label_get_font + (L : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_label_get_font, "fl_label_get_font"); + pragma Inline (fl_label_get_font); + + procedure fl_label_set_font + (L : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_label_set_font, "fl_label_set_font"); + pragma Inline (fl_label_set_font); + + function fl_label_get_size + (L : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_label_get_size, "fl_label_get_size"); + pragma Inline (fl_label_get_size); + + procedure fl_label_set_size + (L : in Storage.Integer_Address; + S : in Interfaces.C.int); + pragma Import (C, fl_label_set_size, "fl_label_set_size"); + pragma Inline (fl_label_set_size); + + function fl_label_get_color + (L : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_label_get_color, "fl_label_get_color"); + pragma Inline (fl_label_get_color); + + procedure fl_label_set_color + (L : in Storage.Integer_Address; + H : in Interfaces.C.unsigned); + pragma Import (C, fl_label_set_color, "fl_label_set_color"); + pragma Inline (fl_label_set_color); + + function fl_label_get_type + (L : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_label_get_type, "fl_label_get_type"); + pragma Inline (fl_label_get_type); + + procedure fl_label_set_type + (L : in Storage.Integer_Address; + K : in Interfaces.C.int); + pragma Import (C, fl_label_set_type, "fl_label_set_type"); + pragma Inline (fl_label_set_type); + + function fl_label_get_align + (L : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_label_get_align, "fl_label_get_align"); + pragma Inline (fl_label_get_align); + + procedure fl_label_set_align + (L : in Storage.Integer_Address; + P : in Interfaces.C.unsigned); + pragma Import (C, fl_label_set_align, "fl_label_set_align"); + pragma Inline (fl_label_set_align); + + procedure fl_label_set_image + (L, I : in Storage.Integer_Address); + pragma Import (C, fl_label_set_image, "fl_label_set_image"); + pragma Inline (fl_label_set_image); + + procedure fl_label_set_deimage + (L, I : in Storage.Integer_Address); + pragma Import (C, fl_label_set_deimage, "fl_label_set_deimage"); + pragma Inline (fl_label_set_deimage); + + + + + procedure fl_label_draw + (L : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int; + P : in Interfaces.C.unsigned); + pragma Import (C, fl_label_draw, "fl_label_draw"); + pragma Inline (fl_label_draw); + + procedure fl_label_measure + (L : in Storage.Integer_Address; + W, H : out Interfaces.C.int); + pragma Import (C, fl_label_measure, "fl_label_measure"); + pragma Inline (fl_label_measure); + + + + + ----------------------------------- + -- Controlled Type Subprograms -- + ----------------------------------- + + procedure Finalize + (This : in out Label) is + begin + if This.Void_Ptr /= Null_Pointer and then + This in Label'Class + then + free_fl_label (This.Void_Ptr); + Interfaces.C.Strings.Free (This.My_Text); + This.Void_Ptr := Null_Pointer; + end if; + Finalize (Wrapper (This)); + end Finalize; + + + + + ----------------- + -- Label API -- + ----------------- + + package body Forge is + + function Create + (Value : in String; + Font : in Font_Kind := Helvetica; + Size : in Font_Size := Normal_Size; + Hue : in Color := Foreground_Color; + Kind : in Label_Kind := Normal_Label; + Place : in Alignment := Align_Center; + Active : access FLTK.Images.Image'Class := null; + Inactive : access FLTK.Images.Image'Class := null) + return Label is + begin + return This : Label do + This.My_Text := Interfaces.C.Strings.New_String (Value); + This.Void_Ptr := new_fl_label + (This.My_Text, -- Interfaces.C.Strings.chars_ptr + Font_Kind'Pos (Font), -- Interfaces.C.int + Interfaces.C.int (Size), + Interfaces.C.unsigned (Hue), + Label_Kind'Pos (Kind), -- Interfaces.C.int + Interfaces.C.unsigned (Place)); + This.Set_Active (Active); + This.Set_Inactive (Inactive); + end return; + end Create; + + end Forge; + + + + + function Get_Value + (This : in Label) + return String is + begin + return Interfaces.C.Strings.Value (This.My_Text); + end Get_Value; + + + procedure Set_Value + (This : in out Label; + Text : in String) is + begin + Interfaces.C.Strings.Free (This.My_Text); + This.My_Text := Interfaces.C.Strings.New_String (Text); + fl_label_set_value (This.Void_Ptr, This.My_Text); + end Set_Value; + + + function Get_Font + (This : in Label) + return Font_Kind is + begin + return Font_Kind'Val (fl_label_get_font (This.Void_Ptr)); + end Get_Font; + + + procedure Set_Font + (This : in out Label; + Font : in Font_Kind) is + begin + fl_label_set_font (This.Void_Ptr, Font_Kind'Pos (Font)); + end Set_Font; + + + function Get_Size + (This : in Label) + return Font_Size is + begin + return Font_Size (fl_label_get_size (This.Void_Ptr)); + end Get_Size; + + + procedure Set_Size + (This : in out Label; + Size : in Font_Size) is + begin + fl_label_set_size (This.Void_Ptr, Interfaces.C.int (Size)); + end Set_Size; + + + function Get_Color + (This : in Label) + return Color is + begin + return Color (fl_label_get_color (This.Void_Ptr)); + end Get_Color; + + + procedure Set_Color + (This : in out Label; + Hue : in Color) is + begin + fl_label_set_color (This.Void_Ptr, Interfaces.C.unsigned (Hue)); + end Set_Color; + + + function Get_Kind + (This : in Label) + return Label_Kind is + begin + return Label_Kind'Val (fl_label_get_type (This.Void_Ptr)); + end Get_Kind; + + + procedure Set_Kind + (This : in out Label; + Kind : in Label_Kind) is + begin + fl_label_set_type (This.Void_Ptr, Label_Kind'Pos (Kind)); + end Set_Kind; + + + function Get_Alignment + (This : in Label) + return Alignment is + begin + return Alignment (fl_label_get_align (This.Void_Ptr)); + end Get_Alignment; + + + procedure Set_Alignment + (This : in out Label; + Place : in Alignment) is + begin + fl_label_set_align (This.Void_Ptr, Interfaces.C.unsigned (Place)); + end Set_Alignment; + + + function Get_Active + (This : in Label) + return access FLTK.Images.Image'Class is + begin + return This.My_Active; + end Get_Active; + + + procedure Set_Active + (This : in out Label; + Pic : access FLTK.Images.Image'Class) is + begin + if Pic /= null then + fl_label_set_image (This.Void_Ptr, Wrapper (Pic.all).Void_Ptr); + else + fl_label_set_image (This.Void_Ptr, Null_Pointer); + end if; + This.My_Active := Pic; + end Set_Active; + + + function Get_Inactive + (This : in Label) + return access FLTK.Images.Image'Class is + begin + return This.My_Inactive; + end Get_Inactive; + + + procedure Set_Inactive + (This : in out Label; + Pic : access FLTK.Images.Image'Class) is + begin + if Pic /= null then + fl_label_set_deimage (This.Void_Ptr, Wrapper (Pic.all).Void_Ptr); + else + fl_label_set_deimage (This.Void_Ptr, Null_Pointer); + end if; + This.My_Inactive := Pic; + end Set_Inactive; + + + + + procedure Draw + (This : in out Label; + X, Y, W, H : in Integer; + Place : in Alignment) is + begin + fl_label_draw + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.unsigned (Place)); + end Draw; + + procedure Measure + (This : in Label; + W, H : out Integer) is + begin + fl_label_measure + (This.Void_Ptr, + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Measure; + + +end FLTK.Labels; + + diff --git a/src/fltk-labels.ads b/src/fltk-labels.ads new file mode 100644 index 0000000..5e13a2e --- /dev/null +++ b/src/fltk-labels.ads @@ -0,0 +1,155 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + FLTK.Images; + +private with + + Interfaces.C.Strings; + + +package FLTK.Labels is + + + type Label is new Wrapper with private; + + type Label_Reference (Data : not null access Label'Class) is limited null record + with Implicit_Dereference => Data; + + + + + package Forge is + + function Create + (Value : in String; + Font : in Font_Kind := Helvetica; + Size : in Font_Size := Normal_Size; + Hue : in Color := Foreground_Color; + Kind : in Label_Kind := Normal_Label; + Place : in Alignment := Align_Center; + Active : access FLTK.Images.Image'Class := null; + Inactive : access FLTK.Images.Image'Class := null) + return Label; + + end Forge; + + + + + function Get_Value + (This : in Label) + return String; + + procedure Set_Value + (This : in out Label; + Text : in String); + + function Get_Font + (This : in Label) + return Font_Kind; + + procedure Set_Font + (This : in out Label; + Font : in Font_Kind); + + function Get_Size + (This : in Label) + return Font_Size; + + procedure Set_Size + (This : in out Label; + Size : in Font_Size); + + function Get_Color + (This : in Label) + return Color; + + procedure Set_Color + (This : in out Label; + Hue : in Color); + + function Get_Kind + (This : in Label) + return Label_Kind; + + procedure Set_Kind + (This : in out Label; + Kind : in Label_Kind); + + function Get_Alignment + (This : in Label) + return Alignment; + + procedure Set_Alignment + (This : in out Label; + Place : in Alignment); + + function Get_Active + (This : in Label) + return access FLTK.Images.Image'Class; + + procedure Set_Active + (This : in out Label; + Pic : access FLTK.Images.Image'Class); + + function Get_Inactive + (This : in Label) + return access FLTK.Images.Image'Class; + + procedure Set_Inactive + (This : in out Label; + Pic : access FLTK.Images.Image'Class); + + + + + procedure Draw + (This : in out Label; + X, Y, W, H : in Integer; + Place : in Alignment); + + procedure Measure + (This : in Label; + W, H : out Integer); + + +private + + + type Label is new Wrapper with record + My_Active : access FLTK.Images.Image'Class; + My_Inactive : access FLTK.Images.Image'Class; + My_Text : Interfaces.C.Strings.chars_ptr; + end record; + + overriding procedure Finalize + (This : in out Label); + + + pragma Inline (Get_Value); + pragma Inline (Get_Font); + pragma Inline (Set_Font); + pragma Inline (Get_Size); + pragma Inline (Set_Size); + pragma Inline (Get_Color); + pragma Inline (Set_Color); + pragma Inline (Get_Kind); + pragma Inline (Set_Kind); + pragma Inline (Get_Alignment); + pragma Inline (Set_Alignment); + pragma Inline (Get_Active); + pragma Inline (Get_Inactive); + + pragma Inline (Draw); + pragma Inline (Measure); + + +end FLTK.Labels; + + -- cgit