diff options
Diffstat (limited to 'spec/fltk.ads')
| -rw-r--r-- | spec/fltk.ads | 599 |
1 files changed, 599 insertions, 0 deletions
diff --git a/spec/fltk.ads b/spec/fltk.ads new file mode 100644 index 0000000..785ad23 --- /dev/null +++ b/spec/fltk.ads @@ -0,0 +1,599 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Ada.Finalization; + +private with + + Interfaces.C, + System.Storage_Elements; + + +package FLTK is + + + -- Ugly implementation detail, never use this. + -- This is necessary so things like Text_Buffers and + -- Widgets can talk to each other behind the binding. + type Wrapper is new Ada.Finalization.Limited_Controlled with private; + + function Is_Valid + (Object : in Wrapper) + return Boolean; + + -- If this is ever raised it means FLTK has returned a value or otherwise + -- acted in a way that the binding really did not expect. + Internal_FLTK_Error : exception; + + -- Text buffers for marshalling purposes will be this size. + Buffer_Size : constant Natural := 1024; + + + + + -- 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; + type Color_Component_Array is array (Positive range <>) of aliased Color_Component; + + function RGB_Color + (R, G, B : in Color_Component) + return Color; + + -- Examples of RGB colors without the above function + -- 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; + + + + + type Alignment is private; + Align_Center : constant Alignment; + Align_Top : constant Alignment; + Align_Bottom : constant Alignment; + Align_Left : constant Alignment; + Align_Right : constant Alignment; + + + + + type Mouse_Cursor_Kind is + (Default_Mouse, + Arrow_Mouse, + Crosshair_Mouse, + Wait_Mouse, + Insert_Mouse, + Hand_Mouse, + Help_Mouse, + Move_Mouse, + NS_Mouse, + WE_Mouse, + NWSE_Mouse, + NESW_Mouse, + N_Mouse, + NE_Mouse, + E_Mouse, + SE_Mouse, + S_Mouse, + SW_Mouse, + W_Mouse, + NW_Mouse, + None_Mouse); + + + + + type Keypress is private; + subtype Pressable_Key is Character range Character'Val (32) .. Character'Val (126); + function Press (Key : in Pressable_Key) return Keypress; + Enter_Key : constant Keypress; + Keypad_Enter_Key : constant Keypress; + Backspace_Key : constant Keypress; + Insert_Key : constant Keypress; + Delete_Key : constant Keypress; + Home_Key : constant Keypress; + End_Key : constant Keypress; + Page_Down_Key : constant Keypress; + Page_Up_Key : constant Keypress; + Down_Key : constant Keypress; + Left_Key : constant Keypress; + Right_Key : constant Keypress; + Up_Key : constant Keypress; + Escape_Key : constant Keypress; + Tab_Key : constant Keypress; + + type Mouse_Button is (No_Button, Left_Button, Middle_Button, Right_Button); + + type Key_Combo is private; + function Press (Key : in Pressable_Key) return Key_Combo; + function Press (Key : in Keypress) return Key_Combo; + function Press (Key : in Mouse_Button) return Key_Combo; + No_Key : constant Key_Combo; + + type Modifier is private; + function "+" (Left, Right : in Modifier) return Modifier; + function "+" (Left : in Modifier; Right : in Pressable_Key) return Key_Combo; + function "+" (Left : in Modifier; Right : in Keypress) return Key_Combo; + function "+" (Left : in Modifier; Right : in Mouse_Button) return Key_Combo; + function "+" (Left : in Modifier; Right : in Key_Combo) return Key_Combo; + Mod_None : constant Modifier; + Mod_Shift : constant Modifier; + Mod_Caps_Lock : constant Modifier; + Mod_Ctrl : constant Modifier; + Mod_Alt : constant Modifier; + Mod_Num_Lock : constant Modifier; + Mod_Meta : constant Modifier; + Mod_Scroll_Lock : constant Modifier; + Mod_Command : constant Modifier; + + + + + type Box_Kind is + (No_Box, + Flat_Box, + Up_Box, + Down_Box, + Up_Frame, + Down_Frame, + Thin_Up_Box, + Thin_Down_Box, + Thin_Up_Frame, + Thin_Down_Frame, + Engraved_Box, + Embossed_Box, + Engraved_Frame, + Embossed_Frame, + Border_Box, + Shadow_Box, + Border_Frame, + Shadow_Frame, + Rounded_Box, + RShadow_Box, + Rounded_Frame, + RFlat_Box, + Round_Up_Box, + Round_Down_Box, + Diamond_Up_Box, + Diamond_Down_Box, + Oval_Box, + OShadow_Box, + Oval_Frame, + OFlat_Box, + Plastic_Up_Box, + Plastic_Down_Box, + Plastic_Up_Frame, + Plastic_Down_Frame, + Plastic_Thin_Up_Box, + Plastic_Thin_Down_Box, + Plastic_Round_Up_Box, + Plastic_Round_Down_Box, + Gtk_Up_Box, + Gtk_Down_Box, + Gtk_Up_Frame, + Gtk_Down_Frame, + Gtk_Thin_Up_Box, + Gtk_Thin_Down_Box, + Gtk_Thin_Up_Frame, + Gtk_Thin_Down_Frame, + Gtk_Round_Up_Box, + Gtk_Round_Down_Box, + Gleam_Up_Box, + Gleam_Down_Box, + Gleam_Up_Frame, + Gleam_Down_Frame, + Gleam_Thin_Up_Box, + Gleam_Thin_Down_Box, + Gleam_Round_Up_Box, + Gleam_Round_Down_Box, + Free_Box); + + + + + type Font_Kind is + (Helvetica, + Helvetica_Bold, + Helvetica_Italic, + Helvetica_Bold_Italic, + Courier, + Courier_Bold, + Courier_Italic, + Courier_Bold_Italic, + Times, + Times_Bold, + Times_Italic, + Times_Bold_Italic, + Symbol, + Monospace, + Monospace_Bold, + Zapf_Dingbats, + Free_Font); + + type Font_Size is new Natural; + Normal_Size : constant Font_Size := 14; + + type Font_Size_Array is array (Positive range <>) of Font_Size; + + + + + type Label_Kind is + (Normal_Label, + No_Label, + Shadow_Label, + Engraved_Label, + Embossed_Label, + Multi_Label, + Icon_Label, + Image_Label, + Free_Label); + + + + + type Event_Kind is + (No_Event, + Push, + Release, + Enter, + Leave, + Drag, + Focus, + Unfocus, + Keydown, + Keyup, + Close, + Move, + Shortcut, + Deactivate, + Activate, + Hide, + Show, + Paste, + Selection_Clear, + Mouse_Wheel, + DnD_Enter, + DnD_Drag, + DnD_Leave, + DnD_Release, + Screen_Config_Changed, + Fullscreen); + + type Event_Outcome is (Not_Handled, Handled); + + + + + type Menu_Flag is private; + function "+" (Left, Right : in Menu_Flag) return Menu_Flag; + Flag_Normal : constant Menu_Flag; + Flag_Inactive : constant Menu_Flag; + Flag_Toggle : constant Menu_Flag; + Flag_Value : constant Menu_Flag; + Flag_Radio : constant Menu_Flag; + Flag_Invisible : constant Menu_Flag; + Flag_Submenu : constant Menu_Flag; + Flag_Divider : constant Menu_Flag; + + + + + type Version_Number is new Natural; + + + + + function ABI_Check + (ABI_Ver : in Version_Number) + return Boolean; + + function ABI_Version + return Version_Number; + + function API_Version + return Version_Number; + + function Version + return Version_Number; + + + + + procedure Awake; + + procedure Lock; + + procedure Unlock; + + + + + function Is_Damaged + return Boolean; + + procedure Set_Damaged + (To : in Boolean); + + procedure Flush; + + procedure Redraw; + + + + + function Check + return Boolean; + + function Ready + return Boolean; + + function Wait + return Integer; + + function Wait + (Seconds : in Long_Float) + return Integer; + + function Run + return Integer; + + +private + + + package Storage renames System.Storage_Elements; + use type Interfaces.C.size_t, Storage.Integer_Address; + + + Null_Pointer : constant Storage.Integer_Address := Storage.To_Integer (System.Null_Address); + + + pragma Linker_Options ("-lfltk"); + pragma Linker_Options ("-lfltk_images"); + pragma Linker_Options ("-lfltk_gl"); + + + function c_pointer_size + return Interfaces.C.size_t; + pragma Import (C, c_pointer_size, "c_pointer_size"); + + -- If this fails then we are on an architecture that for whatever reason + -- has significant problems interfacing between C and Ada + pragma Assert + (c_pointer_size * Interfaces.C.CHAR_BIT = Storage.Integer_Address'Size, + "Size of C void pointers and size of Ada address values do not match"); + + + + + -- Note: This has to be Limited because otherwise the various init subprograms + -- wouldn't work, the widget callbacks wouldn't work, deallocation would be + -- a mess, really just all sorts of problems. + type Wrapper is new Ada.Finalization.Limited_Controlled with + record + Void_Ptr : Storage.Integer_Address := Null_Pointer; + Needs_Dealloc : Boolean := True; + end record; + + overriding procedure Initialize + (This : in out Wrapper); + + + + + for Color_Component_Array'Component_Size use Interfaces.C.CHAR_BIT; + pragma Convention (C, Color_Component_Array); + pragma Pack (Color_Component_Array); + + + + + type Alignment is new Interfaces.Unsigned_16; + Align_Center : constant Alignment := 0; + Align_Top : constant Alignment := 1; + Align_Bottom : constant Alignment := 2; + Align_Left : constant Alignment := 4; + Align_Right : constant Alignment := 8; + + + + + -- What delightful magic numbers FLTK cursors are! + -- (These correspond to the enum found in Enumerations.H) + Cursor_Values : array (Mouse_Cursor_Kind) of Interfaces.C.int := + (Default_Mouse => 0, + Arrow_Mouse => 35, + Crosshair_Mouse => 66, + Wait_Mouse => 76, + Insert_Mouse => 77, + Hand_Mouse => 31, + Help_Mouse => 47, + Move_Mouse => 27, + NS_Mouse => 78, + WE_Mouse => 79, + NWSE_Mouse => 80, + NESW_Mouse => 81, + N_Mouse => 70, + NE_Mouse => 69, + E_Mouse => 49, + SE_Mouse => 8, + S_Mouse => 9, + SW_Mouse => 7, + W_Mouse => 36, + NW_Mouse => 68, + None_Mouse => 255); + + + + + type Keypress is new Interfaces.Unsigned_16; + type Modifier is new Interfaces.Unsigned_16; + type Key_Combo is + record + Modcode : Modifier; + Keycode : Keypress; + Mousecode : Mouse_Button; + end record; + + function To_C + (Key : in Key_Combo) + return Interfaces.C.int; + + function To_Ada + (Key : in Interfaces.C.int) + return Key_Combo; + + function To_C + (Key : in Keypress) + return Interfaces.C.int; + + function To_Ada + (Key : in Interfaces.C.int) + return Keypress; + + function To_C + (Modi : in Modifier) + return Interfaces.C.int; + + function To_Ada + (Modi : in Interfaces.C.int) + return Modifier; + + function To_C + (Button : in Mouse_Button) + return Interfaces.C.int; + + function To_Ada + (Button : in Interfaces.C.int) + return Mouse_Button; + + -- these values designed to align with FLTK enumeration types + Mod_None : constant Modifier := 2#00000000#; + Mod_Shift : constant Modifier := 2#00000001#; + Mod_Caps_Lock : constant Modifier := 2#00000010#; + Mod_Ctrl : constant Modifier := 2#00000100#; + Mod_Alt : constant Modifier := 2#00001000#; + Mod_Num_Lock : constant Modifier := 2#00010000#; + -- Missing 2#00100000#; + Mod_Meta : constant Modifier := 2#01000000#; + Mod_Scroll_Lock : constant Modifier := 2#10000000#; + + -- If this is Apple then Mod_Meta, otherwise Mod_Ctrl + pragma Import (C, Mod_Command, "fl_mod_command"); + + No_Key : constant Key_Combo := (Modcode => Mod_None, Keycode => 0, Mousecode => No_Button); + + -- these values correspond to constants defined in FLTK Enumerations.H + Enter_Key : constant Keypress := 16#ff0d#; + Keypad_Enter_Key : constant Keypress := 16#ff8d#; + Backspace_Key : constant Keypress := 16#ff08#; + Insert_Key : constant Keypress := 16#ff63#; + Delete_Key : constant Keypress := 16#ffff#; + Home_Key : constant Keypress := 16#ff50#; + End_Key : constant Keypress := 16#ff57#; + Page_Down_Key : constant Keypress := 16#ff56#; + Page_Up_Key : constant Keypress := 16#ff55#; + Down_Key : constant Keypress := 16#ff54#; + Left_Key : constant Keypress := 16#ff51#; + Right_Key : constant Keypress := 16#ff53#; + Up_Key : constant Keypress := 16#ff52#; + Escape_Key : constant Keypress := 16#ff1b#; + Tab_Key : constant Keypress := 16#ff09#; + + + + + type Menu_Flag is new Interfaces.Unsigned_8; + Flag_Normal : constant Menu_Flag := 2#00000000#; + Flag_Inactive : constant Menu_Flag := 2#00000001#; + Flag_Toggle : constant Menu_Flag := 2#00000010#; + Flag_Value : constant Menu_Flag := 2#00000100#; + Flag_Radio : constant Menu_Flag := 2#00001000#; + Flag_Invisible : constant Menu_Flag := 2#00010000#; + -- Flag_Submenu_Pointer unlikely to be used + Flag_Submenu : constant Menu_Flag := 2#01000000#; + Flag_Divider : constant Menu_Flag := 2#10000000#; + + + + + pragma Import (C, Awake, "fl_awake"); + pragma Import (C, Lock, "fl_lock"); + pragma Import (C, Unlock, "fl_unlock"); + + + pragma Import (C, Flush, "fl_flush"); + pragma Import (C, Redraw, "fl_redraw"); + + + + + pragma Inline (ABI_Check); + pragma Inline (ABI_Version); + pragma Inline (API_Version); + pragma Inline (Version); + + + pragma Inline (Awake); + pragma Inline (Lock); + pragma Inline (Unlock); + + + pragma Inline (Is_Damaged); + pragma Inline (Set_Damaged); + pragma Inline (Flush); + pragma Inline (Redraw); + + + pragma Inline (Check); + pragma Inline (Ready); + pragma Inline (Wait); + pragma Inline (Run); + + +end FLTK; + |