FLTK 1.3.x C Wrapper (obsolete)

[SARG]

Hi,

There were several errors in my code. Now it's working.
One point I don't understand, in the code below :
- the value of x for the first menu button is 0 and no problem the menu is displayed when right clicking.
- For the second menu button, defined in the sub, the x value must be set at 310 otherwise nothing happens.
That's strange.

Code: Select all

#include once "fltk-c.bi"

' test of: Fl_TabsEnd, Fl_TabNew and Fl_TabEnd 
' this are macros defined in fltk-c.bi

Sub TreeCB cdecl (byval wgt as Fl_Widget ptr,byval tree as any ptr)
  dim as Fl_Tree_Item ptr item = Fl_TreeGetCallbackItem(tree)
  if (item=0) then exit sub
  print *Fl_Tree_ItemGetLabel(item);
  select case Fl_TreeGetCallbackReason(tree)
  case FL_TREE_REASON_SELECTED
    print " selected"
  case FL_TREE_REASON_DESELECTED
    print " deselected"
  case FL_TREE_REASON_OPENED
    print " opened"
  case FL_TREE_REASON_CLOSED
    print " closed"
  case else
    print "?"
  end select
end sub

sub TestCB cdecl (byval self as Fl_Widget ptr,byval userdata as any ptr)
  dim as Fl_Menu_     ptr mnu = cptr(Fl_Menu_ ptr,self)
  dim as Fl_Menu_Item ptr mi  = cptr(any ptr,Fl_Menu_MValue(mnu))
  if (mi=0) then
    print ("NULL")
  elseif Fl_Menu_ItemGetShortcut(mi) then
    print *Fl_Menu_ItemGetLabel(mi), *Fl_GetShortcutLabel(Fl_Menu_ItemGetShortcut(mi))
  else
    print *Fl_Menu_ItemGetLabel(mi)
  end if
end sub

'
' main
'
Dim Shared As Fl_Menu_Item menuitems(...) => _
 {(@"Red"    ,FL_ALT+asc("r")), _
  (@"Green"  ,FL_ALT+asc("g")), _
  (@"Blue"   ,FL_ALT+asc("b")), _
  (@"Strange",FL_ALT+asc("s"),0,0,FL_MENU_INACTIVE), _
  (@"&Charm" ,FL_ALT+asc("c")), _
  (@"Truth"  ,FL_ALT+asc("t")), _
  (@"Beauty" ,FL_ALT+asc("b")), _
  (0)}
dim As Fl_Menu_Item menuitems2(...) => _
 {(@"ONE"    ,FL_ALT+asc("r")), _
  (@"TWO"  ,FL_ALT+asc("g")), _
  (@"THREE"   ,FL_ALT+asc("b")), _
  (@"FOUR",FL_ALT+asc("s"),0,0,FL_MENU_INACTIVE), _
  (0)}

sub TabCB cdecl (byval tabs as FL_WIDGET ptr,byval parent as any ptr)
  print "TabCB: " & *Fl_WidgetGetLabel(Fl_TabsGetValue(parent))
end sub

sub ButtonCB cdecl (byval btn as FL_WIDGET ptr)
  print "ButtonCB: " & *Fl_WidgetGetLabel(btn)
end sub
Sub create_menu(ByRef mb As fl_menu_button Ptr,tb As fl_group Ptr,w As Long,h As Long)
	Fl_GroupBegin(tb)
mb= Fl_Menu_ButtonNew(310,0,w,900,"&popup")'310
Fl_WidgetSetType mb,POPUP3
Fl_WidgetSetBox mb,FL_NO_BOX
Fl_Menu_SetMenu mb,@menuitems(0)
Fl_WidgetSetCallback mb,@TestCB
'fl_groupadd(tb,mb)
fl_groupend(tb)
End Sub
dim as Fl_Window ptr win = Fl_WindowNew(600,200, "Fl_Tree01.bas")

dim as fl_tabs ptr tabs=fl_tabsnew(310,10,300,170)
  Fl_WidgetSetCallbackArg tabs,@TabCB,tabs
    var tab1 = Fl_TabNew(310,35,500-20,200-45,"Tab 1")
   Fl_WidgetSetCallback0 Fl_ButtonNew(350,60,90,25,"Button A"),@ButtonCB
   Fl_WidgetSetCallback0 Fl_ButtonNew(350,90,90,25,"Button B"),@ButtonCB
   
   dim as FL_MENU_BUTTON ptr mb2 = Fl_Menu_ButtonNew(0,0,Fl_WidgetGetW(tab1),Fl_WidgetGetH(tab1),"&popup")
	Fl_WidgetSetType mb2,POPUP3
	Fl_WidgetSetBox mb2,FL_NO_BOX
	Fl_Menu_SetMenu mb2,@menuitems2(0)
	Fl_WidgetSetCallback mb2,@TestCB
   
    Fl_TabEnd tab1
    
Fl_WindowEnd(win)

'Fl_Windowbegin(win)
  Var tab2 = Fl_TabNew(310,35,500-20,200-45,"Tab 2")
   dim as Fl_Tree ptr tree = Fl_TreeNew(310,50,300,170,"Fl_Tree")
	Fl_TreeBegin tree
  Fl_TreeSetShowRoot(tree,0)         ' don't show root of tree

  Fl_TreeAdd(tree,"Flintstones/Fred") ' add some items
  Fl_TreeAdd(tree,"Flintstones/Wilma")
  Fl_TreeAdd(tree,"Flintstones/Pebbles")

  Fl_TreeAdd(tree,"Simpsons/Homer")
  Fl_TreeAdd(tree,"Simpsons/Marge")
  Fl_TreeAdd(tree,"Simpsons/Bart")
  Fl_TreeAdd(tree,"Simpsons/Lisa")
  Fl_TreeClose(tree,"Simpsons") ' Start with one item closed


Fl_WidgetSetCallbackArg(tree,@TreeCB,tree) ' setup a callback for the treeview
Fl_TreeEnd tree
Fl_TabEnd tab2

dim as FL_MENU_BUTTON ptr mb '= Fl_Menu_ButtonNew(0,0,Fl_WidgetGetW(tree),Fl_WidgetGetH(tree),"&popup")
create_menu(mb,tab2,Fl_WidgetGetW(tree),Fl_WidgetGetH(tree))
fl_groupadd(tabs,tab2)
'Fl_WindowEnd(win)
Fl_GroupSetResizable(win,win)
Fl_WindowShow win
Fl_Run

An other strange thing : the right click doesn't work on the whole tab area. At right and bottom sides of the area no menu....


Also I don't know why but it seems that this sub reacts very slowly even when not changing the tab. The aim is just to highlight a given line.

Code: Select all

Sub dsp_line(newtab As Long =curtab,newline As Long=curline)
	Dim As Fl_Text_Buffer Ptr curbuftxt=Fl_Text_DisplayGetBuffer(curdsptxt)
	
	Dim As integer ps,ps2
  	Dim txt As zstring Ptr
  		 
  	Fl_Text_BufferUnhighlight(curbuftxt)

  	If shwtab<>newtab Then
  		shwtab=newtab:Fl_Text_DisplaySetBuffer(curdsptxt,TextBuffer(shwtab)):curbuftxt=Fl_Text_DisplayGetBuffer(curdsptxt)
  		Fl_TabsSetValue(Cast(fl_tabs Ptr,Fl_WidgetGetParent(tabx(shwtab))),tabx(shwtab))
  		Fl_Widgetredraw(Fl_WidgetGetParent(tabx(0)))
		fl_widgetredraw(Fl_WidgetGetParent(Fl_WidgetGetParent(tabx(0))))
		fl_widgetredraw(Fl_WidgetGetParent(Fl_WidgetGetParent(Fl_WidgetGetParent(tabx(0)))))
  	EndIf
  		ps=Fl_Text_BufferSkipLines(curbuftxt,0,newline-1)
  		ps2=Fl_Text_BufferLineEnd(curbuftxt,ps)1
		Fl_Text_BufferSetHighlight(curbuftxt,ps,ps2)
		fl_widgetsetlabel(hcurline,Fl_Text_BufferHighlightText(curbuftxt))
		Fl_Text_DisplayScroll(curdsptxt,newline-3,0)
End Sub

[D.J.Peters]

@SARG the primary part of woking tab's are the position and it's size
I rewrote your short test to make it more clear for you and other readers.

First time FLTK users don't know that a Fl_Tab height (child) is the (parent) Fl_Tabs height - TABS_BUTTON_HEIGHT.
(if the FL_Tabs buttons are on top or bottom)

The second point for working tabs are all tab cards must have the same position and size.

The region to activate a context menu are the same as the whole tab child region.

By the way HOTKEYS of menu items should be unique I changed the key's of menuitems2
(isn't important for this short test code but for your real debugger application.)

Joshy

Code: Select all

#include once "fltk-c.bi"

Sub TreeCB cdecl (byval wgt as Fl_Widget ptr,byval tree as any ptr)
  dim as Fl_Tree_Item ptr item = Fl_TreeGetCallbackItem(tree)
  if (item=0) then exit sub
  print *Fl_Tree_ItemGetLabel(item);
  select case Fl_TreeGetCallbackReason(tree)
  case FL_TREE_REASON_SELECTED
    print " selected"
  case FL_TREE_REASON_DESELECTED
    print " deselected"
  case FL_TREE_REASON_OPENED
    print " opened"
  case FL_TREE_REASON_CLOSED
    print " closed"
  case else
    print "?"
  end select
end sub

sub TestCB cdecl (byval self as Fl_Widget ptr,byval userdata as any ptr)
  dim as Fl_Menu_     ptr mnu = cptr(Fl_Menu_ ptr,self)
  dim as Fl_Menu_Item ptr mi  = cptr(any ptr,Fl_Menu_MValue(mnu))
  if (mi=0) then
    print ("NULL")
  elseif Fl_Menu_ItemGetShortcut(mi) then
    print *Fl_Menu_ItemGetLabel(mi), *Fl_GetShortcutLabel(Fl_Menu_ItemGetShortcut(mi))
  else
    print *Fl_Menu_ItemGetLabel(mi)
  end if
end sub

'
' main
'
Dim Shared As Fl_Menu_Item menuitems(...) => _
 {(@"Red"    ,FL_ALT+asc("r")), _
  (@"Green"  ,FL_ALT+asc("g")), _
  (@"Blue"   ,FL_ALT+asc("b")), _
  (@"Strange",FL_ALT+asc("s"),0,0,FL_MENU_INACTIVE), _
  (@"&Charm" ,FL_ALT+asc("c")), _
  (@"Truth"  ,FL_ALT+asc("t")), _
  (@"Beauty" ,FL_ALT+asc("b")), _
  (0)}
dim As Fl_Menu_Item menuitems2(...) => _
 {(@"ONE"    ,FL_ALT+asc("0")), _
  (@"TWO"  ,FL_ALT+asc("2")), _
  (@"THREE"   ,FL_ALT+asc("3")), _
  (@"FOUR",FL_ALT+asc("4"),0,0,FL_MENU_INACTIVE), _
  (0)}

sub TabCB cdecl (byval tabs as FL_WIDGET ptr,byval parent as any ptr)
  print "TabCB: " & *Fl_WidgetGetLabel(Fl_TabsGetValue(parent))
end sub

sub ButtonCB cdecl (byval btn as FL_WIDGET ptr)
  print "ButtonCB: " & *Fl_WidgetGetLabel(btn)
end sub

Sub create_menu(ByRef mb As Fl_Menu_Button Ptr,byval tree As Fl_Tree ptr)
  var x = Fl_WidgetGetX(tree)
  var y = Fl_WidgetGetY(tree)
  var w = Fl_WidgetGetW(tree)
  var h = Fl_WidgetGetH(tree)
  mb= Fl_Menu_ButtonNew(x,y,w,h)
  Fl_WidgetSetType mb,POPUP3
  Fl_WidgetSetBox mb,FL_NO_BOX
  Fl_Menu_SetMenu mb,@menuitems(0)
  Fl_WidgetSetCallback mb,@TestCB
End Sub

const TABS_WIDTH = 300
const TABS_GAP   =  10
const TABS_BUTTON_HEIGHT = 30
const TAB_GAP = 5

var win = Fl_WindowNew(600,200, "SARG has problems with widget coords")
  var tabsX = Fl_WidgetGetW(win)-2*TABS_GAP-TABS_WIDTH
  var tabsY = TABS_GAP
  var tabsH = Fl_WidgetGetH(win)-2*TABS_GAP
  var tabsW = TABS_WIDTH
  var tabs = Fl_TabsNew(tabsX,tabsY,tabsW,tabsH)
    var tabX = tabsX+TAB_GAP
    var tabY = TABS_BUTTON_HEIGHT
    var tabW = tabsW-2*TAB_GAP
    var tabH = tabsH-TABS_BUTTON_HEIGHT+TAB_GAP
    Fl_WidgetSetCallbackArg tabs,@TabCB,tabs
    var tab1 = Fl_TabNew(tabX,tabY,tabW,tabH,"Tab 1")
      Fl_WidgetSetCallback0 Fl_ButtonNew(350,60,90,25,"Button A"),@ButtonCB
      Fl_WidgetSetCallback0 Fl_ButtonNew(350,90,90,25,"Button B"),@ButtonCB
      var mb2 = Fl_Menu_ButtonNew(tabX,tabY,tabW,tabH)
      Fl_WidgetSetType mb2,POPUP3
      Fl_WidgetSetBox mb2,FL_NO_BOX
      Fl_Menu_SetMenu mb2,@menuitems2(0)
      Fl_WidgetSetCallback mb2,@TestCB
    Fl_TabEnd tab1

    var tab2 = Fl_TabNew(tabX,tabY,tabW,tabH,"Tab 2")
      var tree = Fl_TreeNew(tabX,tabY,tabW,tabH)
      Fl_TreeBegin tree
        Fl_TreeSetShowRoot(tree,0)         ' don't show root of tree
        Fl_TreeAdd(tree,"Flintstones/Fred") ' add some items
        Fl_TreeAdd(tree,"Flintstones/Wilma")
        Fl_TreeAdd(tree,"Flintstones/Pebbles")
     
        Fl_TreeAdd(tree,"Simpsons/Homer")
        Fl_TreeAdd(tree,"Simpsons/Marge")
        Fl_TreeAdd(tree,"Simpsons/Bart")
        Fl_TreeAdd(tree,"Simpsons/Lisa")
        Fl_WidgetSetCallbackArg(tree,@TreeCB,tree)
        dim as FL_MENU_BUTTON ptr mb
        create_menu(mb,tree)
      Fl_TreeEnd tree
    Fl_TabEnd tab2
  Fl_TabsEnd tabs
Fl_WindowEnd win

Fl_GroupSetResizable win,win
Fl_WindowShow win
Fl_Run

[SARG]

@SARG the primary part of woking tab's are the position and it's size

Really ? That's the only thing I understand about FLTK ;-)

I rewrote your short test to make it more clear for you and other readers.

Code: Select all

var win = Fl_WindowNew(600,200, "SARG has problems with widget coords")

lol. Thanks, I found all I needed for fixing my problem.

First time FLTK users don't know that a Fl_Tab height (child) is the (parent) Fl_Tabs height - TABS_BUTTON_HEIGHT.
(if the FL_Tabs buttons are on top or bottom)

I'm not used to code in OOP so I miss these types of things. On the other hand using Windows's APis is a bit different.

The second point for working tabs are all tab cards must have the same position and size.
The region to activate a context menu are the same as the whole tab child region.

Good to know.

By the way HOTKEYS of menu items should be unique I changed the key's of menuitems2
(isn't important for this short test code but for your real debugger application.)

Have you thrown a glance at fbdebugger ? I guess that the answer is no. Otherwise you would not say that. ;-)

Thanks again for the time you take to answer to my questions, and I guess there will be still other ones.

Sarg.

[D.J.Peters]

New download available

fixed: Fl_OutputDelete
added: Fl_RGB_ImageDelete
changed: Fl_Canvas draw callback

Test of rendering text and image capture as Fl_RGB_Image and use it as WidgetLabel or MenuItemLabel.

Joshy

file: Fl_Menu_AddImageLabel.bas

Code: Select all

#include once "fltk-c.bi"

function Fl_Menu_AddImageLabel(byval mnuBar  as Fl_Menu_ ptr, _
                               byval mnuName as const zstring ptr, _
                               byval imgFile as const zstring ptr, _
                               byval labText as const zstring ptr, _
                               byval leftAlign as integer=1) as Fl_Menu_Item ptr
  if mnuBar =0 then return 0
  if mnuName=0 then return 0
  if imgFile=0 then return 0
  if labText=0 then return 0
  Fl_Menu_Add3 mnuBar,mnuName
  dim as Fl_Menu_Item ptr itm = Fl_Menu_FindItemByName(mnuBar,mnuName)
  var img = Fl_PNG_ImageNew(imgFile) 
  Fl_WindowMakeCurrent  Fl_WidgetWindow(mnuBar)
  DrawSetFont Fl_WidgetGetLabelFont(mnuBar),Fl_WidgetGetLabelSize(mnuBar) 
  var h = iif(DrawGetFontHeight()>Fl_ImageW(img),DrawGetFontHeight(),Fl_ImageW(img))
  var w = DrawGetStrWidth(labText)+Fl_ImageW(img)
  if w<100 then w=100
  DrawSetColor Fl_BACKGROUND_COLOR : DrawRectFill 0,0,w,h

  DrawSetColor Fl_WidgetGetLabelColor(mnuBar)
  if leftAlign then
    DrawStrBox labText,0,0,w,h,Fl_ALIGN_IMAGE_NEXT_TO_TEXT or FL_ALIGN_LEFT,img
  else
    DrawStrBox labText,0,0,w,h,Fl_ALIGN_TEXT_NEXT_TO_IMAGE or FL_Align_RIGHT,img
  end if
  var pixels=DrawReadImage(0,0,0,w,h,0)
  var tmp = Fl_RGB_ImageNew(pixels,w,h,3)
  Fl_RGB_ImageLabel2 tmp,itm
  Fl_RGB_ImageDelete img
  return itm
end function
'
' main
'
var win = Fl_WindowNew(640,480)
var bar = Fl_Menu_BarNew(0,0,Fl_WidgetGetW(win),32)
Fl_WindowShow win
Fl_Menu_AddImageLabel(bar,"File/New" ,"media/new-2_24x24.png" ,"New")
Fl_Menu_AddImageLabel(bar,"File/Open","media/open-2_24x24.png","Open ...")
Fl_Menu_AddImageLabel(bar,"File/Exit","media/exit-2_24x24.png","Exit")

Fl_Run

[Boris the Old]

@Joshy

Whenever you update the wrapper file, could you add the date of the change on the first posting of this thread? For example:

FreeBASIC libraries and examples: fltk-c-1.3.3.zip last updated: 2015-01-20

It's very easy to miss your update announcements, especially if the forums are not checked every day.

Thanks

Rod

[Boris the Old]

@Joshy

A couple of problems with the examples when running on Linux Mint 17.1

Code: Select all

build ./Fl_Glut01.bas
ld: cannot find -lGL
build ./Fl_GL_WidgetEx.bas
ld: cannot find -lGL
ld: cannot find -lGLU
build ./Fl_GL_WindowEx.bas
ld: cannot find -lGL

Code: Select all

rod@boris ~/fltk-c-1.3.3 $ ./Fl_UserTabs
nChilds 1
Segmentation fault
rod@boris ~/fltk-c-1.3.3 $ 

I haven't tested these with Windows.

Rod

[D.J.Peters]

... could you add the date of the change on the first posting of this thread?

Sure no problem.

A couple of problems with the examples when running on Linux Mint 17.1

Looks like you don't have a working OpenGL environment on your box. (isn't a fltk problem)

Install OpenGL libs on your box or ignore fltk OpenGL tests.

You can delete Fl_UserTabs.bas it was from my private folder and should not be a part of the fltk-c download.

Joshy

[Boris the Old]

Thanks Joshy

And I fixed my GL problem by installing "freeglut3-dev"

Rod

[Boris the Old]

@Joshy

I've encountered a strange problem when compiling code that uses statements of the form: Fl_xxxxxDelete(widget)

For example, in Fl_Menu_Bar01.bas, if I add the statement:

Code: Select all

Fl_Menu_BarDelete(mnb)

the code gives a clean compile if I do a syntax check, but gives the following error if I do a full compile:

Code: Select all

Fl_Menu_Bar01.o: In function 'main':
(.text+0x5383): undefined reference to 'Fl_Menu_BarDelete'
Compilation failed.

This same error occurs with other widgets, but not with the Fl_PrinterDelete statement. I didn't test all the widget types, and only tested with Linux Mint17.1.

Is there something I should know about using these Delete statements for deleting widgets, or should I just be using the the code shown in Fl_DeleteWidget.bas. Not all of my widgets are deleted in callback routines.

Thanks

Rod

[D.J.Peters]

@Rod you are right not all FL_XXXDelete are exported ATM (good find).
but you can delete all widgets with Fl_DeleteWidget xxx
Take a look at "Fl_DeleteWidget.bas"

Can you post your code where you need to delete a Fl_Menu_Bar manually ?

Joshy

[Boris the Old]

Can you post your code where you need to delete a Fl_Menu_Bar manually ?

Over the past 35 years I've developed libraries and classes that can be used to interface with various GUI packages. My applications dynamically create and destroy GUI elements as needed.

I create widgets in the class Constructors, and delete them in the class Destructors. But this is only one line of code, so there's not much to show you.

If this becomes a problem for me I'll no doubt find a workaround. :-)

Rod

[ike]

LOTHAR, here is how not to use SHARED. If you use NAMESPACES then all variable are SHARED and STATIC


main.bas

Code: Select all

#include once "fltk-c.bi"
#include "form1.bi"

Fl_WindowShow F.win
Fl_Run
 

form1.bi

Code: Select all

namespace F
	DIM AS Fl_Window PTR win
	DIM AS Fl_Button PTR btn1
	DIM AS Fl_Input PTR in1, in2, in3
end namespace

sub ButtonCB CDECL (widget AS FL_WIDGET PTR)
    dim as double v1=val(*Fl_Input_GetValue (F.in1)), v2 =val(*Fl_Input_GetValue (F.in2))
    Fl_Input_SetValue F.in3, str(v1+v2)
end sub

Fl_SetScheme "gleam"

F.win = Fl_Double_WindowNew (200,200,"a+b=c")
F.in1 = Fl_InputNew(30,30,100,20, "a=")
F.in2 = Fl_InputNew(30,60,100,20, "b=")
F.in3 = Fl_InputNew(30,90,100,20, "c=")

F.btn1 = Fl_ButtonNew(30,120,100,30,"Calc c")
Fl_WidgetSetCallback0 F.btn1, @ButtonCB
 

[Lothar Schirm]

@ike: thank you! I am sorry to answer so late, I did not look into this topic for longer time.

@D.J.Peters: I cannot compile a ode with "Fl_Secret_InputNew"! My small program is "Verschluesseln.bas". The compiler reports:
Verschluesseln.o:fake:(.text+0xd270): undefined reference to `Fl_Secret_InputNew'.
It worked with fltk-c 1.32.

[D.J.Peters]

Verschluesseln.o:fake:(.text+0xd270): undefined reference to `Fl_Secret_InputNew'.

Another good find is fixed now.

Joshy

[Lothar Schirm]

Thank you!