diff options
| -rw-r--r-- | doc/fl_label.html | 216 | ||||
| -rw-r--r-- | doc/index.html | 3 | ||||
| -rw-r--r-- | progress.txt | 2 | ||||
| -rw-r--r-- | src/c_fl_label.cpp | 96 | ||||
| -rw-r--r-- | src/c_fl_label.h | 45 | ||||
| -rw-r--r-- | src/fltk-labels.adb | 358 | ||||
| -rw-r--r-- | src/fltk-labels.ads | 155 |
7 files changed, 873 insertions, 2 deletions
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 @@ + +<!DOCTYPE html> + +<html lang="en"> + <head> + <meta charset="utf-8"> + <title>Fl_Label Binding Map</title> + <link href="map.css" rel="stylesheet"> + </head> + + <body> + + +<h2>Fl_Label Binding Map</h2> + + +<a href="index.html">Back to Index</a> + + +<table class="package"> + <tr><th colspan="2">Package name</th></tr> + + <tr> + <td>Fl_Label</td> + <td>FLTK.Labels</td> + </tr> + +</table> + + + +<table class="type"> + <tr><th colspan="2">Types</th></tr> + + <tr> + <td>Fl_Label</td> + <td>Label</td> + </tr> + + <tr> + <td> </td> + <td>Label_Reference</td> + </tr> + +</table> + + + +<table class="function"> + <tr><th colspan="2">Functions and Procedures</th></tr> + + <tr> +<td> </td> +<td><pre> +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; +</pre></td> + </tr> + + <tr> +<td><pre> +Fl_Align align_; +</pre></td> +<td><pre> +function Get_Alignment + (This : in Label) + return Alignment; + +procedure Set_Alignment + (This : in out Label; + Place : in Alignment); +</pre></td> + </tr> + + <tr> +<td><pre> +Fl_Color color; +</pre></td> +<td><pre> +function Get_Color + (This : in Label) + return Color; + +procedure Set_Color + (This : in out Label; + Hue : in Color); +</pre></td> + </tr> + + <tr> +<td><pre> +Fl_Image * deimage; +</pre></td> +<td><pre> +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); +</pre></td> + </tr> + + <tr> +<td><pre> +void draw(int, int, int, int, Fl_Align); +</pre></td> +<td><pre> +procedure Draw + (This : in out Label; + X, Y, W, H : in Integer; + Place : in Alignment); +</pre></td> + </tr> + + <tr> +<td><pre> +Fl_Font font; +</pre></td> +<td><pre> +function Get_Font + (This : in Label) + return Font_Kind; + +procedure Set_Font + (This : in out Label; + Font : in Font_Kind); +</pre></td> + </tr> + + <tr> +<td><pre> +Fl_Image * image; +</pre></td> +<td><pre> +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); +</pre></td> + </tr> + + <tr> +<td><pre> +void measure(int, &w, int &h) const; +</pre></td> +<td><pre> +procedure Measure + (This : in Label; + W, H : out Integer); +</pre></td> + </tr> + + <tr> +<td><pre> +Fl_Fontsize size; +</pre></td> +<td><pre> +function Get_Size + (This : in Label) + return Font_Size; + +procedure Set_Size + (This : in out Label; + Size : in Font_Size); +</pre></td> + </tr> + + <tr> +<td><pre> +uchar type; +</pre></td> +<td><pre> +function Get_Kind + (This : in Label) + return Label_Kind; + +procedure Set_Kind + (This : in out Label; + Kind : in Label_Kind); +</pre></td> + </tr> + + <tr> +<td><pre> +const char * value; +</pre></td> +<td><pre> +function Get_Value + (This : in Label) + return String; + +procedure Set_Value + (This : in out Label; + Text : in String); +</pre></td> + </tr> + +</table> + + + </body> +</html> + 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 @@ <li><a href="fl_input_choice.html">Fl_Input_Choice</a></li> <li><a href="fl_int_input.html">Fl_Int_Input</a></li> <li><a href="fl_jpeg_image.html">Fl_JPEG_Image</a></li> - <li>Fl_Label</li> + <li><a href="fl_label.html">Fl_Label</a></li> <li><a href="fl_light_button.html">Fl_Light_Button</a></li> <li><a href="fl_line_dial.html">Fl_Line_Dial</a></li> <li><a href="fl_menu_.html">Fl_Menu_</a></li> @@ -160,6 +160,7 @@ <li><a href="fl_pnm_image.html">FLTK.Images.RGB.PNM</a></li> <li><a href="fl_shared_image.html">FLTK.Images.Shared</a></li> <li><a href="fl_tiled_image.html">FLTK.Images.Tiled</a></li> + <li><a href="fl_label.html">FLTK.Labels</a></li> <li><a href="fl_menu_item.html">FLTK.Menu_Items</a></li> <li><a href="fl.html">FLTK.Screen</a></li> <li><a href="fl.html">FLTK.Static</a></li> 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 <FL/Fl_Widget.H> +#include <FL/Fl_Image.H> +#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<Fl_Label*>(l); +} + + + + +void fl_label_set_value(LABEL l, const char * v) { + reinterpret_cast<Fl_Label*>(l)->value = v; +} + +int fl_label_get_font(LABEL l) { + return reinterpret_cast<Fl_Label*>(l)->font; +} + +void fl_label_set_font(LABEL l, int f) { + reinterpret_cast<Fl_Label*>(l)->font = f; +} + +int fl_label_get_size(LABEL l) { + return reinterpret_cast<Fl_Label*>(l)->size; +} + +void fl_label_set_size(LABEL l, int s) { + reinterpret_cast<Fl_Label*>(l)->size = s; +} + +unsigned int fl_label_get_color(LABEL l) { + return reinterpret_cast<Fl_Label*>(l)->color; +} + +void fl_label_set_color(LABEL l, unsigned int h) { + reinterpret_cast<Fl_Label*>(l)->color = h; +} + +int fl_label_get_type(LABEL l) { + return (int)reinterpret_cast<Fl_Label*>(l)->type; +} + +void fl_label_set_type(LABEL l, int k) { + reinterpret_cast<Fl_Label*>(l)->type = (uchar)k; +} + +unsigned int fl_label_get_align(LABEL l) { + return reinterpret_cast<Fl_Label*>(l)->align_; +} + +void fl_label_set_align(LABEL l, unsigned int p) { + reinterpret_cast<Fl_Label*>(l)->align_ = p; +} + +void fl_label_set_image(LABEL l, void * i) { + reinterpret_cast<Fl_Label*>(l)->image = reinterpret_cast<Fl_Image*>(i); +} + +void fl_label_set_deimage(LABEL l, void * i) { + reinterpret_cast<Fl_Label*>(l)->deimage = reinterpret_cast<Fl_Image*>(i); +} + + + + +void fl_label_draw(LABEL l, int x, int y, int w, int h, unsigned int p) { + reinterpret_cast<Fl_Label*>(l)->draw(x, y, w, h, p); +} + +void fl_label_measure(LABEL l, int &w, int &h) { + reinterpret_cast<Fl_Label*>(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; + + |