From 74336ca78b2b6bd42b50cce21bd1fe71f98cc56a Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Fri, 2 Feb 2024 11:18:01 +1300 Subject: First pass at draw functions --- src/c_fl_draw.cpp | 410 +++++++++++ src/c_fl_draw.h | 125 ++++ src/fltk-draw.adb | 1631 +++++++++++++++++++++++++++++++++++++++++++ src/fltk-draw.ads | 504 +++++++++++++ src/fltk-widgets-charts.adb | 6 +- src/fltk-widgets-charts.ads | 6 +- src/fltk.ads | 47 +- 7 files changed, 2717 insertions(+), 12 deletions(-) create mode 100644 src/c_fl_draw.cpp create mode 100644 src/c_fl_draw.h create mode 100644 src/fltk-draw.adb create mode 100644 src/fltk-draw.ads (limited to 'src') diff --git a/src/c_fl_draw.cpp b/src/c_fl_draw.cpp new file mode 100644 index 0000000..d1087fe --- /dev/null +++ b/src/c_fl_draw.cpp @@ -0,0 +1,410 @@ + + +#include +#include +#include "c_fl_draw.h" + + + + +void fl_draw_reset_spot() { + fl_reset_spot(); +} + +void fl_draw_set_spot(int f, int s, int x, int y, int w, int h, void * ptr) { + fl_set_spot(f, s, x, y, w, h, reinterpret_cast(ptr)); +} + +void fl_draw_set_status(int x, int y, int w, int h) { + fl_set_status(x, y, w, h); +} + + + + +int fl_draw_can_do_alpha_blending() { + return fl_can_do_alpha_blending(); +} + +const char * fl_draw_shortcut_label(unsigned long shortcut) { + return fl_shortcut_label(shortcut); +} + + + + +const char * fl_draw_latin1_to_local(const char *t, int n) { + return fl_latin1_to_local(t, n); +} + +const char * fl_draw_local_to_latin1(const char *t, int n) { + return fl_local_to_latin1(t, n); +} + +const char * fl_draw_mac_roman_to_local(const char *t, int n) { + return fl_mac_roman_to_local(t, n); +} + +const char * fl_draw_local_to_mac_roman(const char *t, int n) { + return fl_local_to_mac_roman(t, n); +} + + + + +int fl_draw_clip_box(int x, int y, int w, int h, int &bx, int &by, int &bw, int &bh) { + return fl_clip_box(x, y, w, h, bx, by, bw, bh); +} + +int fl_draw_not_clipped(int x, int y, int w, int h) { + return fl_not_clipped(x, y, w, h); +} + +void fl_draw_pop_clip() { + fl_pop_clip(); +} + +void fl_draw_push_clip(int x, int y, int w, int h) { + fl_push_clip(x, y, w, h); +} + +void fl_draw_push_no_clip() { + fl_push_no_clip(); +} + +void fl_draw_restore_clip() { + fl_restore_clip(); +} + + + + +void fl_draw_overlay_clear() { + fl_overlay_clear(); +} + +void fl_draw_overlay_rect(int x, int y, int w, int h) { + fl_overlay_rect(x, y, w, h); +} + + + + +unsigned int fl_draw_get_color() { + return fl_color(); +} + +void fl_draw_set_color(unsigned int c) { + fl_color(c); +} + +void fl_draw_set_color2(uchar r, uchar g, uchar b) { + fl_color(r, g, b); +} + +unsigned int fl_draw_get_font() { + return (unsigned int)fl_font(); +} + +int fl_draw_size() { + return fl_size(); +} + +void fl_draw_set_font(unsigned int f, int s) { + fl_font((Fl_Font)f, (Fl_Fontsize)s); +} + +int fl_draw_height() { + return fl_height(); +} + +int fl_draw_descent() { + return fl_descent(); +} + +int fl_draw_height2(unsigned int f, int s) { + return fl_height(f, s); +} + +void fl_draw_line_style(int style, int width, char * dashes) { + fl_line_style(style, width, dashes); +} + + + + +void fl_draw_mult_matrix(double a, double b, double c, double d, double x, double y) { + fl_mult_matrix(a, b, c, d, x, y); +} + +void fl_draw_pop_matrix() { + fl_pop_matrix(); +} + +void fl_draw_push_matrix() { + fl_push_matrix(); +} + +void fl_draw_rotate(double d) { + fl_rotate(d); +} + +void fl_draw_scale(double x) { + fl_scale(x); +} + +void fl_draw_scale2(double x, double y) { + fl_scale(x, y); +} + +double fl_draw_transform_dx(double x, double y) { + return fl_transform_dx(x, y); +} + +double fl_draw_transform_dy(double x, double y) { + return fl_transform_dy(x, y); +} + +double fl_draw_transform_x(double x, double y) { + return fl_transform_x(x, y); +} + +double fl_draw_transform_y(double x, double y) { + return fl_transform_y(x, y); +} + +void fl_draw_transformed_vertex(double xf, double yf) { + fl_transformed_vertex(xf, yf); +} + +void fl_draw_translate(double x, double y) { + fl_translate(x, y); +} + +void fl_draw_vertex(double x, double y) { + fl_vertex(x, y); +} + + + + +typedef void (sym_hook)(Fl_Color); +typedef sym_hook* sym_hook_p; + +int fl_draw_add_symbol(const char *name, void *func, int scalable) { + return fl_add_symbol(name, reinterpret_cast(func), scalable); +} + +void fl_draw_draw_text(const char *str, int n, int x, int y) { + fl_draw(str, n, x, y); +} + +void fl_draw_draw_text2(const char *str, int x, int y, int w, int h, + unsigned align, void * img, int draw_symbols) { + fl_draw(str, x, y, w, h, (Fl_Align)align, (Fl_Image*)img, draw_symbols); +} + +typedef void (t_hook)(const char *, int ,int ,int); +typedef t_hook* t_hook_p; + +void fl_draw_draw_text3(const char *str, int x, int y, int w, int h, + unsigned align, void * func, void * img, int draw_symbols) { + fl_draw(str, x, y, w, h, (Fl_Align)align, + reinterpret_cast(func), (Fl_Image*)img, draw_symbols); +} + +void fl_draw_draw_text4(int angle, const char *str, int n, int x, int y) { + fl_draw(angle, str, n, x, y); +} + +void fl_draw_rtl_draw(const char *str, int n, int x, int y) { + fl_rtl_draw(str, n, x, y); +} + +void fl_draw_draw_box(int bk, int x, int y, int w, int h, unsigned int c) { + fl_draw_box((Fl_Boxtype)bk, x, y, w, h, (Fl_Color)c); +} + +void fl_draw_draw_symbol(const char *label, int x, int y, int w, int h, unsigned int c) { + fl_draw_symbol(label, x, y, w, h, (Fl_Color)c); +} + +void fl_draw_measure(const char * str, int &w, int &h, int draw_symbols) { + fl_measure(str, w, h, draw_symbols); +} + +typedef void (a_hook)(void *, int, int, int, int); +typedef a_hook* a_hook_p; + +void fl_draw_scroll(int x, int y, int w, int h, int dx, int dy, + void * func, void * data) { + fl_scroll(x, y, w, h, dx, dy, reinterpret_cast(func), data); +} + +void fl_draw_text_extents(const char * t, int n, int &dx, int &dy, int &w, int &h) { + fl_text_extents(t, n, dx, dy, w, h); +} + +double fl_draw_width(const char *txt, int n) { + return fl_width(txt, n); +} + +double fl_draw_width2(unsigned long c) { + return fl_width(c); +} + + + + +void fl_draw_begin_complex_polygon() { + fl_begin_complex_polygon(); +} + +void fl_draw_begin_line() { + fl_begin_line(); +} + +void fl_draw_begin_loop() { + fl_begin_loop(); +} + +void fl_draw_begin_points() { + fl_begin_points(); +} + +void fl_draw_begin_polygon() { + fl_begin_polygon(); +} + + + + +void fl_draw_arc(double x, double y, double r, double start, double end) { + fl_arc(x, y, r, start, end); +} + +void fl_draw_arc2(int x, int y, int w, int h, double a1, double a2) { + fl_arc(x, y, w, h, a1, a2); +} + +void fl_draw_chord(int x, int y, int w, int h, double a1, double a2) { + fl_chord(x, y, w, h, a1, a2); +} + +void fl_draw_circle(double x, double y, double r) { + fl_circle(x, y, r); +} + +void fl_draw_curve(double x0, double y0, double x1, double y1, + double x2, double y2, double x3, double y3) { + fl_curve(x0, y0, x1, y1, x2, y2, x3, y3); +} + +void fl_draw_frame(const char *s, int x, int y, int w, int h) { + fl_frame(s, x, y, w, h); +} + +void fl_draw_gap() { + fl_gap(); +} + +void fl_draw_line(int x0, int y0, int x1, int y1) { + fl_line(x0, y0, x1, y1); +} + +void fl_draw_line2(int x0, int y0, int x1, int y1, int x2, int y2) { + fl_line(x0, y0, x1, y1, x2, y2); +} + +void fl_draw_loop(int x0, int y0, int x1, int y1, int x2, int y2) { + fl_loop(x0, y0, x1, y1, x2, y2); +} + +void fl_draw_loop2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3) { + fl_loop(x0, y0, x1, y1, x2, y2, x3, y3); +} + +void fl_draw_pie(int x, int y, int w, int h, double a1, double a2) { + fl_pie(x, y, w, h, a1, a2); +} + +void fl_draw_point(int x, int y) { + fl_point(x, y); +} + +void fl_draw_polygon(int x0, int y0, int x1, int y1, int x2, int y2) { + fl_polygon(x0, y0, x1, y1, x2, y2); +} + +void fl_draw_polygon2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3) { + fl_polygon(x0, y0, x1, y1, x2, y2, x3, y3); +} + +void fl_draw_rect(int x, int y, int w, int h) { + fl_rect(x, y, w, h); +} + +void fl_draw_rect2(int x, int y, int w, int h, unsigned int c) { + fl_rect(x, y, w, h, c); +} + +void fl_draw_rect_fill(int x, int y, int w, int h) { + fl_rectf(x, y, w, h); +} + +void fl_draw_rect_fill2(int x, int y, int w, int h, unsigned int c) { + fl_rectf(x, y, w, h, (Fl_Color)c); +} + +void fl_draw_rect_fill3(int x, int y, int w, int h, uchar r, uchar g, uchar b) { + fl_rectf(x, y, w, h, r, g, b); +} + +void fl_draw_xy_line(int x0, int y0, int x1) { + fl_xyline(x0, y0, x1); +} + +void fl_draw_xy_line2(int x0, int y0, int x1, int y2) { + fl_xyline(x0, y0, x1, y2); +} + +void fl_draw_xy_line3(int x0, int y0, int x1, int y2, int x3) { + fl_xyline(x0, y0, x1, y2, x3); +} + +void fl_draw_yx_line(int x0, int y0, int y1) { + fl_yxline(x0, y0, y1); +} + +void fl_draw_yx_line2(int x0, int y0, int y1, int x2) { + fl_yxline(x0, y0, y1, x2); +} + +void fl_draw_yx_line3(int x0, int y0, int y1, int x2, int y3) { + fl_yxline(x0, y0, y1, x2, y3); +} + + + + +void fl_draw_end_complex_polygon() { + fl_end_complex_polygon(); +} + +void fl_draw_end_line() { + fl_end_line(); +} + +void fl_draw_end_loop() { + fl_end_loop(); +} + +void fl_draw_end_points() { + fl_end_points(); +} + +void fl_draw_end_polygon() { + fl_end_polygon(); +} + + diff --git a/src/c_fl_draw.h b/src/c_fl_draw.h new file mode 100644 index 0000000..592087c --- /dev/null +++ b/src/c_fl_draw.h @@ -0,0 +1,125 @@ + + +#ifndef FL_DRAW_GUARD +#define FL_DRAW_GUARD + + + + +extern "C" void fl_draw_reset_spot(); +extern "C" void fl_draw_set_spot(int f, int s, int x, int y, int w, int h, void * ptr); +extern "C" void fl_draw_set_status(int x, int y, int w, int h); + + +extern "C" int fl_draw_can_do_alpha_blending(); +extern "C" const char * fl_draw_shortcut_label(unsigned long shortcut); + + +extern "C" const char * fl_draw_latin1_to_local(const char *t, int n); +extern "C" const char * fl_draw_local_to_latin1(const char *t, int n); +extern "C" const char * fl_draw_mac_roman_to_local(const char *t, int n); +extern "C" const char * fl_draw_local_to_mac_roman(const char *t, int n); + + +extern "C" int fl_draw_clip_box(int x, int y, int w, int h, int &bx, int &by, int &bw, int &bh); +extern "C" int fl_draw_not_clipped(int x, int y, int w, int h); +extern "C" void fl_draw_pop_clip(); +extern "C" void fl_draw_push_clip(int x, int y, int w, int h); +extern "C" void fl_draw_push_no_clip(); +extern "C" void fl_draw_restore_clip(); + + +extern "C" void fl_draw_overlay_clear(); +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" unsigned int fl_draw_get_font(); +extern "C" int fl_draw_size(); +extern "C" void fl_draw_set_font(unsigned int f, int s); +extern "C" int fl_draw_height(); +extern "C" int fl_draw_descent(); +extern "C" int fl_draw_height2(unsigned int f, int s); +extern "C" void fl_draw_line_style(int style, int width, char * dashes); + + +extern "C" void fl_draw_mult_matrix(double a, double b, double c, double d, double x, double y); +extern "C" void fl_draw_pop_matrix(); +extern "C" void fl_draw_push_matrix(); +extern "C" void fl_draw_rotate(double d); +extern "C" void fl_draw_scale(double x); +extern "C" void fl_draw_scale2(double x, double y); +extern "C" double fl_draw_transform_dx(double x, double y); +extern "C" double fl_draw_transform_dy(double x, double y); +extern "C" double fl_draw_transform_x(double x, double y); +extern "C" double fl_draw_transform_y(double x, double y); +extern "C" void fl_draw_transformed_vertex(double xf, double yf); +extern "C" void fl_draw_translate(double x, double y); +extern "C" void fl_draw_vertex(double x, double y); + + +extern "C" int fl_draw_add_symbol(const char *name, void *func, int scalable); +extern "C" void fl_draw_draw_text(const char *str, int n, int x, int y); +extern "C" void fl_draw_draw_text2(const char *str, int x, int y, int w, int h, + unsigned align, void * img, int draw_symbols); +extern "C" void fl_draw_draw_text3(const char *str, int x, int y, int w, int h, + unsigned align, void * func, void * img, int draw_symbols); +extern "C" void fl_draw_draw_text4(int angle, const char *str, int n, int x, int y); +extern "C" void fl_draw_rtl_draw(const char *str, int n, int x, int y); +extern "C" void fl_draw_draw_box(int bk, int x, int y, int w, int h, unsigned int c); +extern "C" void fl_draw_draw_symbol(const char *label, int x, int y, int w, int h, unsigned int c); +extern "C" void fl_draw_measure(const char * str, int &w, int &h, int draw_symbols); +extern "C" void fl_draw_scroll(int x, int y, int w, int h, int dx, int dy, + void * func, void * data); +extern "C" void fl_draw_text_extents(const char * t, int n, int &dx, int &dy, int &w, int &h); +extern "C" double fl_draw_width(const char *txt, int n); +extern "C" double fl_draw_width2(unsigned long c); + + +extern "C" void fl_draw_begin_complex_polygon(); +extern "C" void fl_draw_begin_line(); +extern "C" void fl_draw_begin_loop(); +extern "C" void fl_draw_begin_points(); +extern "C" void fl_draw_begin_polygon(); + + +extern "C" void fl_draw_arc(double x, double y, double r, double start, double end); +extern "C" void fl_draw_arc2(int x, int y, int w, int h, double a1, double a2); +extern "C" void fl_draw_chord(int x, int y, int w, int h, double a1, double a2); +extern "C" void fl_draw_circle(double x, double y, double r); +extern "C" void fl_draw_curve(double x0, double y0, double x1, double y1, + double x2, double y2, double x3, double y3); +extern "C" void fl_draw_frame(const char *s, int x, int y, int w, int h); +extern "C" void fl_draw_gap(); +extern "C" void fl_draw_line(int x0, int y0, int x1, int y1); +extern "C" void fl_draw_line2(int x0, int y0, int x1, int y1, int x2, int y2); +extern "C" void fl_draw_loop(int x0, int y0, int x1, int y1, int x2, int y2); +extern "C" void fl_draw_loop2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3); +extern "C" void fl_draw_pie(int x, int y, int w, int h, double a1, double a2); +extern "C" void fl_draw_point(int x, int y); +extern "C" void fl_draw_polygon(int x0, int y0, int x1, int y1, int x2, int y2); +extern "C" void fl_draw_polygon2(int x0, int y0, int x1, int y1, int x2, int y2, int x3, int y3); +extern "C" void fl_draw_rect(int x, int y, int w, int h); +extern "C" void fl_draw_rect2(int x, int y, int w, int h, unsigned int c); +extern "C" void fl_draw_rect_fill(int x, int y, int w, int h); +extern "C" void fl_draw_rect_fill2(int x, int y, int w, int h, unsigned int c); +extern "C" void fl_draw_rect_fill3(int x, int y, int w, int h, uchar r, uchar g, uchar b); +extern "C" void fl_draw_xy_line(int x0, int y0, int x1); +extern "C" void fl_draw_xy_line2(int x0, int y0, int x1, int y2); +extern "C" void fl_draw_xy_line3(int x0, int y0, int x1, int y2, int x3); +extern "C" void fl_draw_yx_line(int x0, int y0, int y1); +extern "C" void fl_draw_yx_line2(int x0, int y0, int y1, int x2); +extern "C" void fl_draw_yx_line3(int x0, int y0, int y1, int x2, int y3); + + +extern "C" void fl_draw_end_complex_polygon(); +extern "C" void fl_draw_end_line(); +extern "C" void fl_draw_end_loop(); +extern "C" void fl_draw_end_points(); +extern "C" void fl_draw_end_polygon(); + + +#endif + diff --git a/src/fltk-draw.adb b/src/fltk-draw.adb new file mode 100644 index 0000000..fecca4c --- /dev/null +++ b/src/fltk-draw.adb @@ -0,0 +1,1631 @@ + + +with + + Ada.Unchecked_Deallocation, + Interfaces.C.Strings, + System; + +use type + + Interfaces.C.int, + Interfaces.C.size_t; + + +package body FLTK.Draw is + + + procedure fl_draw_reset_spot; + pragma Import (C, fl_draw_reset_spot, "fl_draw_reset_spot"); + pragma Inline (fl_draw_reset_spot); + + procedure fl_draw_set_spot + (F, S : in Interfaces.C.int; + X, Y, W, H : in Interfaces.C.int; + Ptr : in System.Address); + pragma Import (C, fl_draw_set_spot, "fl_draw_set_spot"); + pragma Inline (fl_draw_set_spot); + + procedure fl_draw_set_status + (X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_draw_set_status, "fl_draw_set_status"); + pragma Inline (fl_draw_set_status); + + + + + function fl_draw_can_do_alpha_blending + return Interfaces.C.int; + pragma Import (C, fl_draw_can_do_alpha_blending, "fl_draw_can_do_alpha_blending"); + pragma Inline (fl_draw_can_do_alpha_blending); + + function fl_draw_shortcut_label + (Shortcut : in Interfaces.C.unsigned_long) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_draw_shortcut_label, "fl_draw_shortcut_label"); + pragma Inline (fl_draw_shortcut_label); + + + + + function fl_draw_latin1_to_local + (T : in Interfaces.C.char_array; + N : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_draw_latin1_to_local, "fl_draw_latin1_to_local"); + pragma Inline (fl_draw_latin1_to_local); + + function fl_draw_local_to_latin1 + (T : in Interfaces.C.char_array; + N : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_draw_local_to_latin1, "fl_draw_local_to_latin1"); + pragma Inline (fl_draw_local_to_latin1); + + function fl_draw_mac_roman_to_local + (T : in Interfaces.C.char_array; + N : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_draw_mac_roman_to_local, "fl_draw_mac_roman_to_local"); + pragma Inline (fl_draw_mac_roman_to_local); + + function fl_draw_local_to_mac_roman + (T : in Interfaces.C.char_array; + N : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_draw_local_to_mac_roman, "fl_draw_local_to_mac_roman"); + pragma Inline (fl_draw_local_to_mac_roman); + + + + + function fl_draw_clip_box + (X, Y, W, H : in Interfaces.C.int; + BX, BY, BW, BH : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_draw_clip_box, "fl_draw_clip_box"); + pragma Inline (fl_draw_clip_box); + + function fl_draw_not_clipped + (X, Y, W, H : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_draw_not_clipped, "fl_draw_not_clipped"); + pragma Inline (fl_draw_not_clipped); + + procedure fl_draw_pop_clip; + pragma Import (C, fl_draw_pop_clip, "fl_draw_pop_clip"); + pragma Inline (fl_draw_pop_clip); + + procedure fl_draw_push_clip + (X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_draw_push_clip, "fl_draw_push_clip"); + pragma Inline (fl_draw_push_clip); + + procedure fl_draw_push_no_clip; + pragma Import (C, fl_draw_push_no_clip, "fl_draw_push_no_clip"); + pragma Inline (fl_draw_push_no_clip); + + procedure fl_draw_restore_clip; + pragma Import (C, fl_draw_restore_clip, "fl_draw_restore_clip"); + pragma Inline (fl_draw_restore_clip); + + + + + procedure fl_draw_overlay_clear; + pragma Import (C, fl_draw_overlay_clear, "fl_draw_overlay_clear"); + pragma Inline (fl_draw_overlay_clear); + + procedure fl_draw_overlay_rect + (X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_draw_overlay_rect, "fl_draw_overlay_rect"); + pragma Inline (fl_draw_overlay_rect); + + + + + function fl_draw_get_color + return Interfaces.C.unsigned; + pragma Import (C, fl_draw_get_color, "fl_draw_get_color"); + pragma Inline (fl_draw_get_color); + + procedure fl_draw_set_color + (C : in Interfaces.C.unsigned); + pragma Import (C, fl_draw_set_color, "fl_draw_set_color"); + pragma Inline (fl_draw_set_color); + + procedure fl_draw_set_color2 + (R, G, B : in Interfaces.C.unsigned_char); + pragma Import (C, fl_draw_set_color2, "fl_draw_set_color2"); + pragma Inline (fl_draw_set_color2); + + function fl_draw_get_font + return Interfaces.C.unsigned; + pragma Import (C, fl_draw_get_font, "fl_draw_get_font"); + pragma Inline (fl_draw_get_font); + + function fl_draw_size + return Interfaces.C.int; + pragma Import (C, fl_draw_size, "fl_draw_size"); + pragma Inline (fl_draw_size); + + procedure fl_draw_set_font + (F : in Interfaces.C.unsigned; + S : in Interfaces.C.int); + pragma Import (C, fl_draw_set_font, "fl_draw_set_font"); + pragma Inline (fl_draw_set_font); + + function fl_draw_height + return Interfaces.C.int; + pragma Import (C, fl_draw_height, "fl_draw_height"); + pragma Inline (fl_draw_height); + + function fl_draw_descent + return Interfaces.C.int; + pragma Import (C, fl_draw_descent, "fl_draw_descent"); + pragma Inline (fl_draw_descent); + + function fl_draw_height2 + (F : in Interfaces.C.unsigned; + S : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_draw_height2, "fl_draw_height2"); + pragma Inline (fl_draw_height2); + + procedure fl_draw_line_style + (Style : in Interfaces.C.int; + Width : in Interfaces.C.int; + Dashes : in Interfaces.C.char_array); + pragma Import (C, fl_draw_line_style, "fl_draw_line_style"); + pragma Inline (fl_draw_line_style); + + + + + procedure fl_draw_mult_matrix + (A, B, C, D, X, Y : in Interfaces.C.double); + pragma Import (C, fl_draw_mult_matrix, "fl_draw_mult_matrix"); + pragma Inline (fl_draw_mult_matrix); + + procedure fl_draw_pop_matrix; + pragma Import (C, fl_draw_pop_matrix, "fl_draw_pop_matrix"); + pragma Inline (fl_draw_pop_matrix); + + procedure fl_draw_push_matrix; + pragma Import (C, fl_draw_push_matrix, "fl_draw_push_matrix"); + pragma Inline (fl_draw_push_matrix); + + procedure fl_draw_rotate + (D : in Interfaces.C.double); + pragma Import (C, fl_draw_rotate, "fl_draw_rotate"); + pragma Inline (fl_draw_rotate); + + procedure fl_draw_scale + (X : in Interfaces.C.double); + pragma Import (C, fl_draw_scale, "fl_draw_scale"); + pragma Inline (fl_draw_scale); + + procedure fl_draw_scale2 + (X, Y : in Interfaces.C.double); + pragma Import (C, fl_draw_scale2, "fl_draw_scale2"); + pragma Inline (fl_draw_scale2); + + function fl_draw_transform_dx + (X, Y : in Interfaces.C.double) + return Interfaces.C.double; + pragma Import (C, fl_draw_transform_dx, "fl_draw_transform_dx"); + pragma Inline (fl_draw_transform_dx); + + function fl_draw_transform_dy + (X, Y : in Interfaces.C.double) + return Interfaces.C.double; + pragma Import (C, fl_draw_transform_dy, "fl_draw_transform_dy"); + pragma Inline (fl_draw_transform_dy); + + function fl_draw_transform_x + (X, Y : in Interfaces.C.double) + return Interfaces.C.double; + pragma Import (C, fl_draw_transform_x, "fl_draw_transform_x"); + pragma Inline (fl_draw_transform_x); + + function fl_draw_transform_y + (X, Y : in Interfaces.C.double) + return Interfaces.C.double; + pragma Import (C, fl_draw_transform_y, "fl_draw_transform_y"); + pragma Inline (fl_draw_transform_y); + + procedure fl_draw_transformed_vertex + (XF, YF : in Interfaces.C.double); + pragma Import (C, fl_draw_transformed_vertex, "fl_draw_transformed_vertex"); + pragma Inline (fl_draw_transformed_vertex); + + procedure fl_draw_translate + (X, Y : in Interfaces.C.double); + pragma Import (C, fl_draw_translate, "fl_draw_translate"); + pragma Inline (fl_draw_translate); + + procedure fl_draw_vertex + (X, Y : in Interfaces.C.double); + pragma Import (C, fl_draw_vertex, "fl_draw_vertex"); + pragma Inline (fl_draw_vertex); + + + + + function fl_draw_add_symbol + (Name : in Interfaces.C.char_array; + Drawit : in System.Address; + Scalable : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_draw_add_symbol, "fl_draw_add_symbol"); + pragma Inline (fl_draw_add_symbol); + + procedure fl_draw_draw_text + (Str : in Interfaces.C.char_array; + N, X, Y : in Interfaces.C.int); + pragma Import (C, fl_draw_draw_text, "fl_draw_draw_text"); + pragma Inline (fl_draw_draw_text); + + procedure fl_draw_draw_text2 + (Str : in Interfaces.C.char_array; + X, Y, W, H : in Interfaces.C.int; + Ali : in Interfaces.Unsigned_16; + Img : in System.Address; + Sym : in Interfaces.C.int); + pragma Import (C, fl_draw_draw_text2, "fl_draw_draw_text2"); + pragma Inline (fl_draw_draw_text2); + + procedure fl_draw_draw_text3 + (Str : in Interfaces.C.char_array; + X, Y, W, H : in Interfaces.C.int; + Ali : in Interfaces.Unsigned_16; + Func : in System.Address; + Img : in System.Address; + Sym : in Interfaces.C.int); + pragma Import (C, fl_draw_draw_text3, "fl_draw_draw_text3"); + pragma Inline (fl_draw_draw_text3); + + procedure fl_draw_draw_text4 + (Ang : in Interfaces.C.int; + Str : in Interfaces.C.char_array; + N, X, Y : in Interfaces.C.int); + pragma Import (C, fl_draw_draw_text4, "fl_draw_draw_text4"); + pragma Inline (fl_draw_draw_text4); + + procedure fl_draw_rtl_draw + (Str : in Interfaces.C.char_array; + N, X, Y : in Interfaces.C.int); + pragma Import (C, fl_draw_rtl_draw, "fl_draw_rtl_draw"); + pragma Inline (fl_draw_rtl_draw); + + procedure fl_draw_draw_box + (BK : in Interfaces.C.int; + X, Y, W, H : in Interfaces.C.int; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_draw_draw_box, "fl_draw_draw_box"); + pragma Inline (fl_draw_draw_box); + + function fl_draw_draw_symbol + (Lab : in Interfaces.C.char_array; + X, Y, W, H : in Interfaces.C.int; + Hue : in Interfaces.C.unsigned) + return Interfaces.C.int; + pragma Import (C, fl_draw_draw_symbol, "fl_draw_draw_symbol"); + pragma Inline (fl_draw_draw_symbol); + + procedure fl_draw_measure + (Str : in Interfaces.C.char_array; + W, H : in out Interfaces.C.int; + S : in Interfaces.C.int); + pragma Import (C, fl_draw_measure, "fl_draw_measure"); + pragma Inline (fl_draw_measure); + + procedure fl_draw_scroll + (X, Y, W, H : in Interfaces.C.int; + DX, DY : in Interfaces.C.int; + Func, Data : in System.Address); + pragma Import (C, fl_draw_scroll, "fl_draw_scroll"); + pragma Inline (fl_draw_scroll); + + procedure fl_draw_text_extents + (Str : in Interfaces.C.char_array; + N : in Interfaces.C.int; + DX, DY, W, H : out Interfaces.C.int); + pragma Import (C, fl_draw_text_extents, "fl_draw_text_extents"); + pragma Inline (fl_draw_text_extents); + + function fl_draw_width + (Str : in Interfaces.C.char_array; + N : in Interfaces.C.int) + return Interfaces.C.double; + pragma Import (C, fl_draw_width, "fl_draw_width"); + pragma Inline (fl_draw_width); + + function fl_draw_width2 + (C : in Interfaces.C.unsigned_long) + return Interfaces.C.double; + pragma Import (C, fl_draw_width2, "fl_draw_width2"); + pragma Inline (fl_draw_width2); + + + + + procedure fl_draw_begin_complex_polygon; + pragma Import (C, fl_draw_begin_complex_polygon, "fl_draw_begin_complex_polygon"); + pragma Inline (fl_draw_begin_complex_polygon); + + procedure fl_draw_begin_line; + pragma Import (C, fl_draw_begin_line, "fl_draw_begin_line"); + pragma Inline (fl_draw_begin_line); + + procedure fl_draw_begin_loop; + pragma Import (C, fl_draw_begin_loop, "fl_draw_begin_loop"); + pragma Inline (fl_draw_begin_loop); + + procedure fl_draw_begin_points; + pragma Import (C, fl_draw_begin_points, "fl_draw_begin_points"); + pragma Inline (fl_draw_begin_points); + + procedure fl_draw_begin_polygon; + pragma Import (C, fl_draw_begin_polygon, "fl_draw_begin_polygon"); + pragma Inline (fl_draw_begin_polygon); + + + + + procedure fl_draw_arc + (X, Y, R, Start, Finish : in Interfaces.C.double); + pragma Import (C, fl_draw_arc, "fl_draw_arc"); + pragma Inline (fl_draw_arc); + + procedure fl_draw_arc2 + (X, Y, W, H : in Interfaces.C.int; + A1, A2 : in Interfaces.C.double); + pragma Import (C, fl_draw_arc2, "fl_draw_arc2"); + pragma Inline (fl_draw_arc2); + + procedure fl_draw_chord + (X, Y, W, H : in Interfaces.C.int; + A1, A2 : in Interfaces.C.double); + pragma Import (C, fl_draw_chord, "fl_draw_chord"); + pragma Inline (fl_draw_chord); + + procedure fl_draw_circle + (X, Y, R : in Interfaces.C.double); + pragma Import (C, fl_draw_circle, "fl_draw_circle"); + pragma Inline (fl_draw_circle); + + procedure fl_draw_curve + (X0, Y0 : in Interfaces.C.double; + X1, Y1 : in Interfaces.C.double; + X2, Y2 : in Interfaces.C.double; + X3, Y3 : in Interfaces.C.double); + pragma Import (C, fl_draw_curve, "fl_draw_curve"); + pragma Inline (fl_draw_curve); + + procedure fl_draw_frame + (S : in Interfaces.C.char_array; + X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_draw_frame, "fl_draw_frame"); + pragma Inline (fl_draw_frame); + + procedure fl_draw_gap; + pragma Import (C, fl_draw_gap, "fl_draw_gap"); + pragma Inline (fl_draw_gap); + + procedure fl_draw_line + (X0, Y0 : in Interfaces.C.int; + X1, Y1 : in Interfaces.C.int); + pragma Import (C, fl_draw_line, "fl_draw_line"); + pragma Inline (fl_draw_line); + + procedure fl_draw_line2 + (X0, Y0 : in Interfaces.C.int; + X1, Y1 : in Interfaces.C.int; + X2, Y2 : in Interfaces.C.int); + pragma Import (C, fl_draw_line2, "fl_draw_line2"); + pragma Inline (fl_draw_line2); + + procedure fl_draw_loop + (X0, Y0 : in Interfaces.C.int; + X1, Y1 : in Interfaces.C.int; + X2, Y2 : in Interfaces.C.int); + pragma Import (C, fl_draw_loop, "fl_draw_loop"); + pragma Inline (fl_draw_loop); + + procedure fl_draw_loop2 + (X0, Y0 : in Interfaces.C.int; + X1, Y1 : in Interfaces.C.int; + X2, Y2 : in Interfaces.C.int; + X3, Y3 : in Interfaces.C.int); + pragma Import (C, fl_draw_loop2, "fl_draw_loop2"); + pragma Inline (fl_draw_loop2); + + procedure fl_draw_pie + (X, Y, W, H : in Interfaces.C.int; + A1, A2 : in Interfaces.C.double); + pragma Import (C, fl_draw_pie, "fl_draw_pie"); + pragma Inline (fl_draw_pie); + + procedure fl_draw_point + (X, Y : in Interfaces.C.int); + pragma Import (C, fl_draw_point, "fl_draw_point"); + pragma Inline (fl_draw_point); + + procedure fl_draw_polygon + (X0, Y0 : in Interfaces.C.int; + X1, Y1 : in Interfaces.C.int; + X2, Y2 : in Interfaces.C.int); + pragma Import (C, fl_draw_polygon, "fl_draw_polygon"); + pragma Inline (fl_draw_polygon); + + procedure fl_draw_polygon2 + (X0, Y0 : in Interfaces.C.int; + X1, Y1 : in Interfaces.C.int; + X2, Y2 : in Interfaces.C.int; + X3, Y3 : in Interfaces.C.int); + pragma Import (C, fl_draw_polygon2, "fl_draw_polygon2"); + pragma Inline (fl_draw_polygon2); + + procedure fl_draw_rect + (X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_draw_rect, "fl_draw_rect"); + pragma Inline (fl_draw_rect); + + procedure fl_draw_rect2 + (X, Y, W, H : in Interfaces.C.int; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_draw_rect2, "fl_draw_rect2"); + pragma Inline (fl_draw_rect2); + + procedure fl_draw_rect_fill + (X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_draw_rect_fill, "fl_draw_rect_fill"); + pragma Inline (fl_draw_rect_fill); + + procedure fl_draw_rect_fill2 + (X, Y, W, H : in Interfaces.C.int; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_draw_rect_fill2, "fl_draw_rect_fill2"); + pragma Inline (fl_draw_rect_fill2); + + procedure fl_draw_rect_fill3 + (X, Y, W, H : in Interfaces.C.int; + R, G, B : in Interfaces.C.unsigned_char); + pragma Import (C, fl_draw_rect_fill3, "fl_draw_rect_fill3"); + pragma Inline (fl_draw_rect_fill3); + + procedure fl_draw_xy_line + (X0, Y0, X1 : in Interfaces.C.int); + pragma Import (C, fl_draw_xy_line, "fl_draw_xy_line"); + pragma Inline (fl_draw_xy_line); + + procedure fl_draw_xy_line2 + (X0, Y0, X1, Y2 : in Interfaces.C.int); + pragma Import (C, fl_draw_xy_line2, "fl_draw_xy_line2"); + pragma Inline (fl_draw_xy_line2); + + procedure fl_draw_xy_line3 + (X0, Y0, X1, Y2, X3 : in Interfaces.C.int); + pragma Import (C, fl_draw_xy_line3, "fl_draw_xy_line3"); + pragma Inline (fl_draw_xy_line3); + + procedure fl_draw_yx_line + (X0, Y0, Y1 : in Interfaces.C.int); + pragma Import (C, fl_draw_yx_line, "fl_draw_yx_line"); + pragma Inline (fl_draw_yx_line); + + procedure fl_draw_yx_line2 + (X0, Y0, Y1, X2 : in Interfaces.C.int); + pragma Import (C, fl_draw_yx_line2, "fl_draw_yx_line2"); + pragma Inline (fl_draw_yx_line2); + + procedure fl_draw_yx_line3 + (X0, Y0, Y1, X2, Y3 : in Interfaces.C.int); + pragma Import (C, fl_draw_yx_line3, "fl_draw_yx_line3"); + pragma Inline (fl_draw_yx_line3); + + + + + procedure fl_draw_end_complex_polygon; + pragma Import (C, fl_draw_end_complex_polygon, "fl_draw_end_complex_polygon"); + pragma Inline (fl_draw_end_complex_polygon); + + procedure fl_draw_end_line; + pragma Import (C, fl_draw_end_line, "fl_draw_end_line"); + pragma Inline (fl_draw_end_line); + + procedure fl_draw_end_loop; + pragma Import (C, fl_draw_end_loop, "fl_draw_end_loop"); + pragma Inline (fl_draw_end_loop); + + procedure fl_draw_end_points; + pragma Import (C, fl_draw_end_points, "fl_draw_end_points"); + pragma Inline (fl_draw_end_points); + + procedure fl_draw_end_polygon; + pragma Import (C, fl_draw_end_polygon, "fl_draw_end_polygon"); + pragma Inline (fl_draw_end_polygon); + + + + + ------------------------ + -- No Documentation -- + ------------------------ + + procedure Reset_Spot is + begin + fl_draw_reset_spot; + end Reset_Spot; + + + procedure Set_Spot + (X, Y, W, H : in Integer; + Font : in Font_Kind; + Size : in Font_Size) is + begin + fl_draw_set_spot + (Font_Kind'Pos (Font), + Interfaces.C.int (Size), + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + System.Null_Address); + end Set_Spot; + + + procedure Set_Spot + (X, Y, W, H : in Integer; + Font : in Font_Kind; + Size : in Font_Size; + Pane : in FLTK.Widgets.Groups.Windows.Window'Class) is + begin + fl_draw_set_spot + (Font_Kind'Pos (Font), + Interfaces.C.int (Size), + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Wrapper (Pane).Void_Ptr); + end Set_Spot; + + + procedure Set_Status + (X, Y, W, H : in Integer) is + begin + fl_draw_set_status + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Set_Status; + + + + + --------------- + -- Utility -- + --------------- + + function Can_Do_Alpha_Blending + return Boolean + is + Result : Interfaces.C.int := fl_draw_can_do_alpha_blending; + begin + if Result = 1 then + return True; + elsif Result = 0 then + return False; + else + raise Program_Error; + end if; + end Can_Do_Alpha_Blending; + + + function Shortcut_Label + (Keys : in Key_Combo) + return String is + begin + return Interfaces.C.Strings.Value + (fl_draw_shortcut_label (To_C (Keys))); + end Shortcut_Label; + + + + + function Latin1_To_Local + (From : in String) + return String is + begin + return Interfaces.C.Strings.Value + (fl_draw_latin1_to_local (Interfaces.C.To_C (From), -1)); + end Latin1_To_Local; + + + function Local_To_Latin1 + (From : in String) + return String is + begin + return Interfaces.C.Strings.Value + (fl_draw_local_to_latin1 (Interfaces.C.To_C (From), -1)); + end Local_To_Latin1; + + + function Mac_Roman_To_Local + (From : in String) + return String is + begin + return Interfaces.C.Strings.Value + (fl_draw_mac_roman_to_local (Interfaces.C.To_C (From), -1)); + end Mac_Roman_To_Local; + + + function Local_To_Mac_Roman + (From : in String) + return String is + begin + return Interfaces.C.Strings.Value + (fl_draw_local_to_mac_roman (Interfaces.C.To_C (From), -1)); + end Local_To_Mac_Roman; + + + + + function Clip_Box + (X, Y, W, H : in Integer; + BX, BY, BW, BH : out Integer) + return Boolean + is + CX, CY, CW, CH : Interfaces.C.int; + Result : Interfaces.C.int := fl_draw_clip_box + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + CX, CY, CW, CH); + begin + BX := Integer (CX); + BY := Integer (CY); + BW := Integer (CW); + BH := Integer (CH); + return Result /= 0; + end Clip_Box; + + + function Clip_Intersects + (X, Y, W, H : in Integer) + return Boolean is + begin + return fl_draw_not_clipped + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)) /= 0; + end Clip_Intersects; + + + procedure Pop_Clip is + begin + fl_draw_pop_clip; + end Pop_Clip; + + + procedure Push_Clip + (X, Y, W, H : in Integer) is + begin + fl_draw_push_clip + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Push_Clip; + + + procedure Push_No_Clip is + begin + fl_draw_push_no_clip; + end Push_No_Clip; + + + procedure Restore_Clip is + begin + fl_draw_restore_clip; + end Restore_Clip; + + + + + procedure Overlay_Clear is + begin + fl_draw_overlay_clear; + end Overlay_Clear; + + + procedure Overlay_Rect + (X, Y, W, H : in Integer) is + begin + fl_draw_overlay_rect + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Overlay_Rect; + + + + + function Get_Color + return Color is + begin + return Color (fl_draw_get_color); + end Get_Color; + + + procedure Set_Color + (To : in Color) is + begin + fl_draw_set_color (Interfaces.C.unsigned (To)); + end Set_Color; + + + procedure Set_Color + (R, G, B : in Color_Component) is + begin + fl_draw_set_color2 + (Interfaces.C.unsigned_char (R), + Interfaces.C.unsigned_char (G), + Interfaces.C.unsigned_char (B)); + end Set_Color; + + + function Get_Font + return Font_Kind is + begin + return Font_Kind'Val (fl_draw_get_font); + end Get_Font; + + + function Get_Font_Size + return Font_Size is + begin + return Font_Size (fl_draw_size); + end Get_Font_Size; + + + procedure Set_Font + (Kind : in Font_Kind; + Size : in Font_Size) is + begin + fl_draw_set_font (Font_Kind'Pos (Kind), Interfaces.C.int (Size)); + end Set_Font; + + + function Font_Line_Spacing + return Integer is + begin + return Integer (fl_draw_height); + end Font_Line_Spacing; + + + function Font_Descent + return Integer is + begin + return Integer (fl_draw_descent); + end Font_Descent; + + + function Font_Height + (Kind : in Font_Kind; + Size : in Font_Size) + return Natural is + begin + return Natural (fl_draw_height2 (Font_Kind'Pos (Kind), Interfaces.C.int (Size))); + end Font_Height; + + + type Char_Array_Access is access Interfaces.C.char_array; + + procedure Free_Char_Array is new Ada.Unchecked_Deallocation + (Object => Interfaces.C.char_array, + Name => Char_Array_Access); + + Current_Dashes : Char_Array_Access; + + procedure Set_Line_Style + (Line : in Line_Kind := Solid_Line; + Cap : in Cap_Kind := Default_Cap; + Join : in Join_Kind := Default_Join; + Width : in Natural := 0; + Dashes : in Dash_Gap_Array := Empty_Dashes) is + begin + Free_Char_Array (Current_Dashes); + Current_Dashes := new Interfaces.C.char_array (1 .. (Dashes'Length + 1) * 2); + for Index in Integer range 1 .. Dashes'Length loop + Current_Dashes (2 * Interfaces.C.size_t (Index) - 1) := + Interfaces.C.char'Val (Integer (Dashes (Index).Solid)); + Current_Dashes (2 * Interfaces.C.size_t (Index)) := + Interfaces.C.char'Val (Integer (Dashes (Index).Blank)); + end loop; + Current_Dashes (Current_Dashes'Last - 1) := Interfaces.C.char'Val (0); + Current_Dashes (Current_Dashes'Last) := Interfaces.C.char'Val (0); + fl_draw_line_style + (Line_Kind'Pos (Line) + Cap_Kind'Pos (Cap) * 16#100# + Join_Kind'Pos (Join) * 16#1000#, + Interfaces.C.int (Width), + Current_Dashes.all); + end Set_Line_Style; + + + + + procedure Mult_Matrix + (A, B, C, D, X, Y : in Long_Float) is + begin + fl_draw_mult_matrix + (Interfaces.C.double (A), + Interfaces.C.double (B), + Interfaces.C.double (C), + Interfaces.C.double (D), + Interfaces.C.double (X), + Interfaces.C.double (Y)); + end Mult_Matrix; + + + procedure Pop_Matrix is + begin + fl_draw_pop_matrix; + end Pop_Matrix; + + + procedure Push_Matrix is + begin + fl_draw_push_matrix; + end Push_Matrix; + + + procedure Rotate + (Angle : in Long_Float) is + begin + fl_draw_rotate (Interfaces.C.double (Angle)); + end Rotate; + + + procedure Scale + (Factor : in Long_Float) is + begin + fl_draw_scale (Interfaces.C.double (Factor)); + end Scale; + + + procedure Scale + (Factor_X, Factor_Y : in Long_Float) is + begin + fl_draw_scale2 + (Interfaces.C.double (Factor_X), + Interfaces.C.double (Factor_Y)); + end Scale; + + + function Transform_DX + (X, Y : in Long_Float) + return Long_Float is + begin + return Long_Float (fl_draw_transform_dx + (Interfaces.C.double (X), + Interfaces.C.double (Y))); + end Transform_DX; + + + function Transform_DY + (X, Y : in Long_Float) + return Long_Float is + begin + return Long_Float (fl_draw_transform_dy + (Interfaces.C.double (X), + Interfaces.C.double (Y))); + end Transform_DY; + + + function Transform_X + (X, Y : in Long_Float) + return Long_Float is + begin + return Long_Float (fl_draw_transform_x + (Interfaces.C.double (X), + Interfaces.C.double (Y))); + end Transform_X; + + + function Transform_Y + (X, Y : in Long_Float) + return Long_Float is + begin + return Long_Float (fl_draw_transform_y + (Interfaces.C.double (X), + Interfaces.C.double (Y))); + end Transform_Y; + + + procedure Transformed_Vertex + (XF, YF : in Long_Float) is + begin + fl_draw_transformed_vertex + (Interfaces.C.double (XF), + Interfaces.C.double (YF)); + end Transformed_Vertex; + + + procedure Translate + (X, Y : in Long_Float) is + begin + fl_draw_translate + (Interfaces.C.double (X), + Interfaces.C.double (Y)); + end Translate; + + + procedure Vertex + (X, Y : in Long_Float) is + begin + fl_draw_vertex + (Interfaces.C.double (X), + Interfaces.C.double (Y)); + end Vertex; + + + + + procedure Add_Symbol + (Text : in String; + Callback : in Symbol_Draw_Function; + Scalable : in Boolean) + is + Ret_Val : Interfaces.C.int := fl_draw_add_symbol + (Interfaces.C.To_C (Text), + Callback.all'Address, + Boolean'Pos (Scalable)); + begin + if Ret_Val = 0 then + raise Draw_Error; + elsif Ret_Val /= 1 then + raise Program_Error; + end if; + end Add_Symbol; + + procedure Draw_Text + (X, Y : in Integer; + Text : in String) is + begin + fl_draw_draw_text + (Interfaces.C.To_C (Text), + Text'Length, + Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Draw_Text; + + + procedure Draw_Text + (X, Y, W, H : in Integer; + Text : in String; + Align : in Alignment; + Symbols : in Boolean := True) is + begin + fl_draw_draw_text2 + (Interfaces.C.To_C (Text), + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.Unsigned_16 (Align), + System.Null_Address, + Boolean'Pos (Symbols)); + end Draw_Text; + + + procedure Draw_Text + (X, Y, W, H : in Integer; + Text : in String; + Align : in Alignment; + Picture : in FLTK.Images.Image'Class; + Symbols : in Boolean := True) is + begin + fl_draw_draw_text2 + (Interfaces.C.To_C (Text), + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.Unsigned_16 (Align), + Wrapper (Picture).Void_Ptr, + Boolean'Pos (Symbols)); + end Draw_Text; + + + Text_Func_Ptr : Text_Draw_Function; + + procedure Draw_Text_Hook + (Ptr : in System.Address; + N, X0, Y0 : in Interfaces.C.int) + is + Data : String (1 .. Integer (N)); + for Data'Address use Ptr; + pragma Import (Ada, Data); + begin + Text_Func_Ptr (Integer (X0), Integer (Y0), Data); + end Draw_Text_Hook; + + + procedure Draw_Text + (X, Y, W, H : in Integer; + Text : in String; + Align : in Alignment; + Callback : in Text_Draw_Function; + Symbols : in Boolean := True) is + begin + Text_Func_Ptr := Callback; + fl_draw_draw_text3 + (Interfaces.C.To_C (Text), + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.Unsigned_16 (Align), + Draw_Text_Hook'Address, + System.Null_Address, + Boolean'Pos (Symbols)); + end Draw_Text; + + + procedure Draw_Text + (X, Y, W, H : in Integer; + Text : in String; + Align : in Alignment; + Callback : in Text_Draw_Function; + Picture : in FLTK.Images.Image'Class; + Symbols : in Boolean := True) is + begin + Text_Func_Ptr := Callback; + fl_draw_draw_text3 + (Interfaces.C.To_C (Text), + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.Unsigned_16 (Align), + Draw_Text_Hook'Address, + Wrapper (Picture).Void_Ptr, + Boolean'Pos (Symbols)); + end Draw_Text; + + + procedure Draw_Text + (X, Y : in Integer; + Text : in String; + Angle : in Integer) is + begin + fl_draw_draw_text4 + (Interfaces.C.int (Angle), + Interfaces.C.To_C (Text), + Text'Length, + Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Draw_Text; + + + procedure Draw_Text_Right_Left + (X, Y : in Integer; + Text : in String) is + begin + fl_draw_rtl_draw + (Interfaces.C.To_C (Text), + Text'Length, + Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Draw_Text_Right_Left; + + + procedure Draw_Box + (X, Y, W, H : in Integer; + Kind : in Box_Kind; + Hue : in Color) is + begin + fl_draw_draw_box + (Box_Kind'Pos (Kind), + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.unsigned (Hue)); + end Draw_Box; + + + procedure Draw_Symbol + (X, Y, W, H : in Integer; + Name : in String; + Hue : in Color) + is + Ret_Val : Interfaces.C.int := fl_draw_draw_symbol + (Interfaces.C.To_C (Name), + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.unsigned (Hue)); + begin + if Ret_Val = 0 then + raise Draw_Error; + elsif Ret_Val /= 1 then + raise Program_Error; + end if; + end Draw_Symbol; + + + procedure Measure + (Text : in String; + W, H : out Natural; + Symbols : in Boolean := True; + Wrap : in Natural := 0) + is + Result_W : Interfaces.C.int := Interfaces.C.int (Wrap); + Result_H : Interfaces.C.int := 0; + begin + fl_draw_measure + (Interfaces.C.To_C (Text), + Result_W, Result_H, + Boolean'Pos (Symbols)); + W := Natural (Result_W); + H := Natural (Result_H); + end Measure; + + + procedure Scroll_Hook + (Ptr : in Area_Draw_Function; + X, Y, W, H : in Interfaces.C.int) is + begin + Ptr.all (Integer (X), Integer (Y), Integer (W), Integer (H)); + end Scroll_Hook; + + + procedure Scroll + (X, Y, W, H : in Integer; + DX, DY : in Integer; + Callback : in Area_Draw_Function) is + begin + fl_draw_scroll + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.int (DX), + Interfaces.C.int (DY), + Scroll_Hook'Address, + Callback.all'Address); + end Scroll; + + + procedure Text_Extents + (Text : in String; + DX, DY, W, H : out Integer) + is + Result_DX, Result_DY, Result_W, Result_H : Interfaces.C.int; + begin + fl_draw_text_extents + (Interfaces.C.To_C (Text), + Text'Length, + Result_DX, + Result_DY, + Result_W, + Result_H); + DX := Integer (Result_DX); + DY := Integer (Result_DY); + W := Integer (Result_W); + H := Integer (Result_H); + end Text_Extents; + + + function Width + (Text : in String) + return Long_Float is + begin + return Long_Float (fl_draw_width (Interfaces.C.To_C (Text), Text'Length)); + end Width; + + + function Width + (Glyph : in Character) + return Long_Float is + begin + return Long_Float (fl_draw_width2 (Character'Pos (Glyph))); + end Width; + + + function Width + (Glyph : in Wide_Character) + return Long_Float is + begin + return Long_Float (fl_draw_width2 (Wide_Character'Pos (Glyph))); + end Width; + + + function Width + (Glyph : in Wide_Wide_Character) + return Long_Float is + begin + return Long_Float (fl_draw_width2 (Wide_Wide_Character'Pos (Glyph))); + end Width; + + + + + procedure Begin_Complex_Polygon is + begin + fl_draw_begin_complex_polygon; + end Begin_Complex_Polygon; + + procedure Begin_Line is + begin + fl_draw_begin_line; + end Begin_Line; + + procedure Begin_Loop is + begin + fl_draw_begin_loop; + end Begin_Loop; + + procedure Begin_Points is + begin + fl_draw_begin_points; + end Begin_Points; + + procedure Begin_Polygon is + begin + fl_draw_begin_polygon; + end Begin_Polygon; + + + + + procedure Arc + (X, Y, R, Start, Finish : in Long_Float) is + begin + fl_draw_arc + (Interfaces.C.double (X), + Interfaces.C.double (Y), + Interfaces.C.double (R), + Interfaces.C.double (Start), + Interfaces.C.double (Finish)); + end Arc; + + + procedure Arc + (X, Y, W, H : in Integer; + Start, Finish : in Long_Float) is + begin + fl_draw_arc2 + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.double (Start), + Interfaces.C.double (Finish)); + end Arc; + + + procedure Chord + (X, Y, W, H : in Integer; + Angle1, Angle2 : in Long_Float) is + begin + fl_draw_chord + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.double (Angle1), + Interfaces.C.double (Angle2)); + end Chord; + + + procedure Circle + (X, Y, R : in Long_Float) is + begin + fl_draw_circle + (Interfaces.C.double (X), + Interfaces.C.double (Y), + Interfaces.C.double (R)); + end Circle; + + + procedure Curve + (X0, Y0 : in Long_Float; + X1, Y1 : in Long_Float; + X2, Y2 : in Long_Float; + X3, Y3 : in Long_Float) is + begin + fl_draw_curve + (Interfaces.C.double (X0), Interfaces.C.double (Y0), + Interfaces.C.double (X1), Interfaces.C.double (Y1), + Interfaces.C.double (X2), Interfaces.C.double (Y2), + Interfaces.C.double (X3), Interfaces.C.double (Y3)); + end Curve; + + + procedure Frame + (X, Y, W, H : in Integer; + Top, Left, Bottom, Right : in Greyscale) is + begin + fl_draw_frame + (Interfaces.C.To_C + (Character (Top) & Character (Left) & Character (Bottom) & Character (Right)), + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Frame; + + + procedure Gap is + begin + fl_draw_gap; + end Gap; + + + procedure Line + (X0, Y0 : in Integer; + X1, Y1 : in Integer) is + begin + fl_draw_line + (Interfaces.C.int (X0), Interfaces.C.int (Y0), + Interfaces.C.int (X1), Interfaces.C.int (Y1)); + end Line; + + + procedure Line + (X0, Y0 : in Integer; + X1, Y1 : in Integer; + X2, Y2 : in Integer) is + begin + fl_draw_line2 + (Interfaces.C.int (X0), Interfaces.C.int (Y0), + Interfaces.C.int (X1), Interfaces.C.int (Y1), + Interfaces.C.int (X2), Interfaces.C.int (Y2)); + end Line; + + + procedure Outline + (X0, Y0 : in Integer; + X1, Y1 : in Integer; + X2, Y2 : in Integer) is + begin + fl_draw_loop + (Interfaces.C.int (X0), Interfaces.C.int (Y0), + Interfaces.C.int (X1), Interfaces.C.int (Y1), + Interfaces.C.int (X2), Interfaces.C.int (Y2)); + end Outline; + + + procedure Outline + (X0, Y0 : in Integer; + X1, Y1 : in Integer; + X2, Y2 : in Integer; + X3, Y3 : in Integer) is + begin + fl_draw_loop2 + (Interfaces.C.int (X0), Interfaces.C.int (Y0), + Interfaces.C.int (X1), Interfaces.C.int (Y1), + Interfaces.C.int (X2), Interfaces.C.int (Y2), + Interfaces.C.int (X3), Interfaces.C.int (Y3)); + end Outline; + + + procedure Pie + (X, Y, W, H : in Integer; + Angle1, Angle2 : in Long_Float) is + begin + fl_draw_pie + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.double (Angle1), + Interfaces.C.double (Angle2)); + end Pie; + + + procedure Point + (X, Y : in Integer) is + begin + fl_draw_point + (Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Point; + + + procedure Polygon + (X0, Y0 : in Integer; + X1, Y1 : in Integer; + X2, Y2 : in Integer) is + begin + fl_draw_polygon + (Interfaces.C.int (X0), Interfaces.C.int (Y0), + Interfaces.C.int (X1), Interfaces.C.int (Y1), + Interfaces.C.int (X2), Interfaces.C.int (Y2)); + end Polygon; + + + procedure Polygon + (X0, Y0 : in Integer; + X1, Y1 : in Integer; + X2, Y2 : in Integer; + X3, Y3 : in Integer) is + begin + fl_draw_polygon2 + (Interfaces.C.int (X0), Interfaces.C.int (Y0), + Interfaces.C.int (X1), Interfaces.C.int (Y1), + Interfaces.C.int (X2), Interfaces.C.int (Y2), + Interfaces.C.int (X3), Interfaces.C.int (Y3)); + end Polygon; + + + procedure Rect + (X, Y, W, H : in Integer) is + begin + fl_draw_rect + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Rect; + + + procedure Rect + (X, Y, W, H : in Integer; + Hue : in Color) is + begin + fl_draw_rect2 + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.unsigned (Hue)); + end Rect; + + + procedure Rect_Fill + (X, Y, W, H : in Integer) is + begin + fl_draw_rect_fill + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Rect_Fill; + + + procedure Rect_Fill + (X, Y, W, H : in Integer; + Hue : in Color) is + begin + fl_draw_rect_fill2 + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.unsigned (Hue)); + end Rect_Fill; + + + procedure Rect_Fill + (X, Y, W, H : in Integer; + R, G, B : in Color_Component) is + begin + fl_draw_rect_fill3 + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.unsigned_char (R), + Interfaces.C.unsigned_char (G), + Interfaces.C.unsigned_char (B)); + end Rect_Fill; + + + procedure XY_Line + (X0, Y0, X1 : in Integer) is + begin + fl_draw_xy_line + (Interfaces.C.int (X0), + Interfaces.C.int (Y0), + Interfaces.C.int (X1)); + end XY_Line; + + + procedure XY_Line + (X0, Y0, X1, Y2 : in Integer) is + begin + fl_draw_xy_line2 + (Interfaces.C.int (X0), + Interfaces.C.int (Y0), + Interfaces.C.int (X1), + Interfaces.C.int (Y2)); + end XY_Line; + + + procedure XY_Line + (X0, Y0, X1, Y2, X3 : in Integer) is + begin + fl_draw_xy_line3 + (Interfaces.C.int (X0), + Interfaces.C.int (Y0), + Interfaces.C.int (X1), + Interfaces.C.int (Y2), + Interfaces.C.int (X3)); + end XY_Line; + + + procedure YX_Line + (X0, Y0, Y1 : in Integer) is + begin + fl_draw_yx_line + (Interfaces.C.int (X0), + Interfaces.C.int (Y0), + Interfaces.C.int (Y1)); + end YX_Line; + + + procedure YX_Line + (X0, Y0, Y1, X2 : in Integer) is + begin + fl_draw_yx_line2 + (Interfaces.C.int (X0), + Interfaces.C.int (Y0), + Interfaces.C.int (Y1), + Interfaces.C.int (X2)); + end YX_Line; + + + procedure YX_Line + (X0, Y0, Y1, X2, Y3 : in Integer) is + begin + fl_draw_yx_line3 + (Interfaces.C.int (X0), + Interfaces.C.int (Y0), + Interfaces.C.int (Y1), + Interfaces.C.int (X2), + Interfaces.C.int (Y3)); + end YX_Line; + + + + + procedure End_Complex_Polygon is + begin + fl_draw_end_complex_polygon; + end End_Complex_Polygon; + + procedure End_Line is + begin + fl_draw_end_line; + end End_Line; + + procedure End_Loop is + begin + fl_draw_end_loop; + end End_Loop; + + procedure End_Points is + begin + fl_draw_end_points; + end End_Points; + + procedure End_Polygon is + begin + fl_draw_end_polygon; + end End_Polygon; + + +end FLTK.Draw; + + diff --git a/src/fltk-draw.ads b/src/fltk-draw.ads new file mode 100644 index 0000000..32ee90b --- /dev/null +++ b/src/fltk-draw.ads @@ -0,0 +1,504 @@ + + +with + + FLTK.Images, + FLTK.Widgets.Groups.Windows; + + +package FLTK.Draw is + + + -------------------------- + -- Types and Constants -- + -------------------------- + + type Line_Kind is + (Solid_Line, + Dash_Line, + Dot_Line, + Dashdot_Line, + Dashdotdot_Line); + + type Cap_Kind is + (Default_Cap, + Flat_Cap, + Round_Cap, + Square_Cap); + + type Join_Kind is + (Default_Join, + Miter_Join, + Round_Join, + Bevel_Join); + + type Dash_Length is new Integer range 1 .. 255; + + type Dash_Gap is record + Solid : Dash_Length; + Blank : Dash_Length; + end record; + + type Dash_Gap_Array is array (Positive range <>) of Dash_Gap; + + Empty_Dashes : constant Dash_Gap_Array (1 .. 0) := (others => (1, 1)); + + type Text_Draw_Function is access procedure + (X, Y : in Integer; + Text : in String); + + type Symbol_Draw_Function is access procedure + (Hue : in Color); + + type Area_Draw_Function is access procedure + (X, Y, W, H : in Integer); + + Draw_Error : exception; + + + + + ------------------------ + -- No Documentation -- + ------------------------ + + procedure Reset_Spot; + + procedure Set_Spot + (X, Y, W, H : in Integer; + Font : in Font_Kind; + Size : in Font_Size); + + procedure Set_Spot + (X, Y, W, H : in Integer; + Font : in Font_Kind; + Size : in Font_Size; + Pane : in FLTK.Widgets.Groups.Windows.Window'Class); + + procedure Set_Status + (X, Y, W, H : in Integer); + + + + + --------------- + -- Utility -- + --------------- + + function Can_Do_Alpha_Blending + return Boolean; + + function Shortcut_Label + (Keys : in Key_Combo) + return String; + + + + + -------------------------- + -- Charset Conversion -- + -------------------------- + + function Latin1_To_Local + (From : in String) + return String; + + function Local_To_Latin1 + (From : in String) + return String; + + function Mac_Roman_To_Local + (From : in String) + return String; + + function Local_To_Mac_Roman + (From : in String) + return String; + + + + + ---------------- + -- Clipping -- + ---------------- + + function Clip_Box + (X, Y, W, H : in Integer; + BX, BY, BW, BH : out Integer) + return Boolean; + + function Clip_Intersects + (X, Y, W, H : in Integer) + return Boolean; + + procedure Pop_Clip; + + procedure Push_Clip + (X, Y, W, H : in Integer); + + procedure Push_No_Clip; + + procedure Restore_Clip; + + + + + --------------- + -- Overlay -- + --------------- + + procedure Overlay_Clear; + + procedure Overlay_Rect + (X, Y, W, H : in Integer); + + + + + ---------------- + -- Settings -- + ---------------- + + function Get_Color + return Color; + + procedure Set_Color + (To : in Color); + + procedure Set_Color + (R, G, B : in Color_Component); + + function Get_Font + return Font_Kind; + + function Get_Font_Size + return Font_Size; + + procedure Set_Font + (Kind : in Font_Kind; + Size : in Font_Size); + + function Font_Line_Spacing + return Integer; + + function Font_Descent + return Integer; + + function Font_Height + (Kind : in Font_Kind; + Size : in Font_Size) + return Natural; + + procedure Set_Line_Style + (Line : in Line_Kind := Solid_Line; + Cap : in Cap_Kind := Default_Cap; + Join : in Join_Kind := Default_Join; + Width : in Natural := 0; + Dashes : in Dash_Gap_Array := Empty_Dashes); + + + + + ------------------------- + -- Matrix Operations -- + ------------------------- + + procedure Mult_Matrix + (A, B, C, D, X, Y : in Long_Float); + + procedure Pop_Matrix; + + procedure Push_Matrix; + + procedure Rotate + (Angle : in Long_Float); + + procedure Scale + (Factor : in Long_Float); + + procedure Scale + (Factor_X, Factor_Y : in Long_Float); + + function Transform_DX + (X, Y : in Long_Float) + return Long_Float; + + function Transform_DY + (X, Y : in Long_Float) + return Long_Float; + + function Transform_X + (X, Y : in Long_Float) + return Long_Float; + + function Transform_Y + (X, Y : in Long_Float) + return Long_Float; + + procedure Transformed_Vertex + (XF, YF : in Long_Float); + + procedure Translate + (X, Y : in Long_Float); + + procedure Vertex + (X, Y : in Long_Float); + + + + + ----------------------- + -- Special Drawing -- + ----------------------- + + procedure Add_Symbol + (Text : in String; + Callback : in Symbol_Draw_Function; + Scalable : in Boolean); + + procedure Draw_Text + (X, Y : in Integer; + Text : in String) + with Pre => Text'Length > 0; + + procedure Draw_Text + (X, Y, W, H : in Integer; + Text : in String; + Align : in Alignment; + Symbols : in Boolean := True); + + procedure Draw_Text + (X, Y, W, H : in Integer; + Text : in String; + Align : in Alignment; + Picture : in FLTK.Images.Image'Class; + Symbols : in Boolean := True); + + procedure Draw_Text + (X, Y, W, H : in Integer; + Text : in String; + Align : in Alignment; + Callback : in Text_Draw_Function; + Symbols : in Boolean := True); + + procedure Draw_Text + (X, Y, W, H : in Integer; + Text : in String; + Align : in Alignment; + Callback : in Text_Draw_Function; + Picture : in FLTK.Images.Image'Class; + Symbols : in Boolean := True); + + procedure Draw_Text + (X, Y : in Integer; + Text : in String; + Angle : in Integer); + + procedure Draw_Text_Right_Left + (X, Y : in Integer; + Text : in String); + + procedure Draw_Box + (X, Y, W, H : in Integer; + Kind : in Box_Kind; + Hue : in Color); + + procedure Draw_Symbol + (X, Y, W, H : in Integer; + Name : in String; + Hue : in Color); + + procedure Measure + (Text : in String; + W, H : out Natural; + Symbols : in Boolean := True; + Wrap : in Natural := 0); + + procedure Scroll + (X, Y, W, H : in Integer; + DX, DY : in Integer; + Callback : in Area_Draw_Function); + + procedure Text_Extents + (Text : in String; + DX, DY, W, H : out Integer); + + function Width + (Text : in String) + return Long_Float; + + function Width + (Glyph : in Character) + return Long_Float; + + function Width + (Glyph : in Wide_Character) + return Long_Float; + + function Width + (Glyph : in Wide_Wide_Character) + return Long_Float; + + + + + ---------------------- + -- Manual Drawing -- + ---------------------- + + procedure Begin_Complex_Polygon; + procedure Begin_Line; + procedure Begin_Loop; + procedure Begin_Points; + procedure Begin_Polygon; + + procedure Arc + (X, Y, R, Start, Finish : in Long_Float); + + procedure Arc + (X, Y, W, H : in Integer; + Start, Finish : in Long_Float); + + -- As per 1.3.9 docs, currently a placeholder + procedure Chord + (X, Y, W, H : in Integer; + Angle1, Angle2 : in Long_Float); + + procedure Circle + (X, Y, R : in Long_Float); + + procedure Curve + (X0, Y0 : in Long_Float; + X1, Y1 : in Long_Float; + X2, Y2 : in Long_Float; + X3, Y3 : in Long_Float); + + procedure Frame + (X, Y, W, H : in Integer; + Top, Left, Bottom, Right : in Greyscale); + + procedure Gap; + + procedure Line + (X0, Y0 : in Integer; + X1, Y1 : in Integer); + + procedure Line + (X0, Y0 : in Integer; + X1, Y1 : in Integer; + X2, Y2 : in Integer); + + procedure Outline + (X0, Y0 : in Integer; + X1, Y1 : in Integer; + X2, Y2 : in Integer); + + procedure Outline + (X0, Y0 : in Integer; + X1, Y1 : in Integer; + X2, Y2 : in Integer; + X3, Y3 : in Integer); + + procedure Pie + (X, Y, W, H : in Integer; + Angle1, Angle2 : in Long_Float); + + procedure Point + (X, Y : in Integer); + + procedure Polygon + (X0, Y0 : in Integer; + X1, Y1 : in Integer; + X2, Y2 : in Integer); + + procedure Polygon + (X0, Y0 : in Integer; + X1, Y1 : in Integer; + X2, Y2 : in Integer; + X3, Y3 : in Integer); + + procedure Rect + (X, Y, W, H : in Integer); + + procedure Rect + (X, Y, W, H : in Integer; + Hue : in Color); + + procedure Rect_Fill + (X, Y, W, H : in Integer); + + procedure Rect_Fill + (X, Y, W, H : in Integer; + Hue : in Color); + + procedure Rect_Fill + (X, Y, W, H : in Integer; + R, G, B : in Color_Component); + + procedure XY_Line + (X0, Y0, X1 : in Integer); + + procedure XY_Line + (X0, Y0, X1, Y2 : in Integer); + + procedure XY_Line + (X0, Y0, X1, Y2, X3 : in Integer); + + procedure YX_Line + (X0, Y0, Y1 : in Integer); + + procedure YX_Line + (X0, Y0, Y1, X2 : in Integer); + + procedure YX_Line + (X0, Y0, Y1, X2, Y3 : in Integer); + + procedure End_Complex_Polygon; + procedure End_Line; + procedure End_Loop; + procedure End_Points; + procedure End_Polygon; + + +private + + + pragma Convention (C, Symbol_Draw_Function); + + + pragma Inline (Can_Do_Alpha_Blending); + + + pragma Inline (Get_Color); + pragma Inline (Set_Color); + pragma Inline (Get_Font); + pragma Inline (Set_Font); + + + pragma Inline (Draw_Box); + + + pragma Inline (Begin_Complex_Polygon); + pragma Inline (Begin_Line); + pragma Inline (Begin_Loop); + pragma Inline (Begin_Points); + pragma Inline (Begin_Polygon); + + + pragma Inline (Arc); + pragma Inline (Circle); + pragma Inline (Frame); + pragma Inline (Gap); + pragma Inline (Line); + + + pragma Inline (End_Complex_Polygon); + pragma Inline (End_Line); + pragma Inline (End_Loop); + pragma Inline (End_Points); + pragma Inline (End_Polygon); + + +end FLTK.Draw; + + diff --git a/src/fltk-widgets-charts.adb b/src/fltk-widgets-charts.adb index 63bd604..573a011 100644 --- a/src/fltk-widgets-charts.adb +++ b/src/fltk-widgets-charts.adb @@ -231,7 +231,7 @@ package body FLTK.Widgets.Charts is (This : in out Chart; Data_Value : in Long_Float; Data_Label : in String := ""; - Data_Color : in Color := No_Color) is + Data_Color : in Color := Foreground_Color) is begin fl_chart_add (This.Void_Ptr, @@ -246,7 +246,7 @@ package body FLTK.Widgets.Charts is Position : in Natural; Data_Value : in Long_Float; Data_Label : in String := ""; - Data_Color : in Color := No_Color) is + Data_Color : in Color := Foreground_Color) is begin fl_chart_insert (This.Void_Ptr, @@ -262,7 +262,7 @@ package body FLTK.Widgets.Charts is Position : in Natural; Data_Value : in Long_Float; Data_Label : in String := ""; - Data_Color : in Color := No_Color) is + Data_Color : in Color := Foreground_Color) is begin fl_chart_replace (This.Void_Ptr, diff --git a/src/fltk-widgets-charts.ads b/src/fltk-widgets-charts.ads index 1369c4f..dad0f9f 100644 --- a/src/fltk-widgets-charts.ads +++ b/src/fltk-widgets-charts.ads @@ -27,21 +27,21 @@ package FLTK.Widgets.Charts is (This : in out Chart; Data_Value : in Long_Float; Data_Label : in String := ""; - Data_Color : in Color := No_Color); + Data_Color : in Color := Foreground_Color); procedure Insert (This : in out Chart; Position : in Natural; Data_Value : in Long_Float; Data_Label : in String := ""; - Data_Color : in Color := No_Color); + Data_Color : in Color := Foreground_Color); procedure Replace (This : in out Chart; Position : in Natural; Data_Value : in Long_Float; Data_Label : in String := ""; - Data_Color : in Color := No_Color); + Data_Color : in Color := Foreground_Color); procedure Clear (This : in out Chart); diff --git a/src/fltk.ads b/src/fltk.ads index 38da4c2..0356d2e 100644 --- a/src/fltk.ads +++ b/src/fltk.ads @@ -26,15 +26,50 @@ package FLTK is + -- Values scale from A/Black to X/White + type Greyscale is new Character range 'A' .. 'X'; + type Color is mod 2**32; type Color_Component is mod 256; - No_Color : constant Color := 16#00000000#; - - Red_Color : constant Color := 16#ff000000#; - Green_Color : constant Color := 16#00ff0000#; - Blue_Color : constant Color := 16#0000ff00#; - White_Color : constant Color := 16#ffffff00#; + -- Examples of RGB colors + -- The lowest byte has to be 00 for the color to be RGB + RGB_Red_Color : constant Color := 16#ff000000#; + RGB_Green_Color : constant Color := 16#00ff0000#; + RGB_Blue_Color : constant Color := 16#0000ff00#; + RGB_White_Color : constant Color := 16#ffffff00#; + + -- Standard colors used in widgets + Foreground_Color : constant Color := 0; + Background2_Color : constant Color := 7; + Inactive_Color : constant Color := 8; + Selection_Color : constant Color := 15; + + -- Standard boxtype colors + Grey0_Color : constant Color := 32; + Dark3_Color : constant Color := 39; + Dark2_Color : constant Color := 45; + Dark1_Color : constant Color := 47; + Background_Color : constant Color := 49; + Light1_Color : constant Color := 50; + Light2_Color : constant Color := 52; + Light3_Color : constant Color := 54; + + -- Color cube colors + Black_Color : constant Color := 56; + Red_Color : constant Color := 88; + Green_Color : constant Color := 63; + Yellow_Color : constant Color := 95; + Blue_Color : constant Color := 216; + Magenta_Color : constant Color := 248; + Cyan_Color : constant Color := 223; + Dark_Red_Color : constant Color := 72; + Dark_Green_Color : constant Color := 60; + Dark_Yellow_Color : constant Color := 76; + Dark_Blue_Color : constant Color := 136; + Dark_Magenta_Color : constant Color := 152; + Dark_Cyan_Color : constant Color := 140; + White_Color : constant Color := 255; -- cgit