FLTK headers for FreeBasic OOP (no C wrapper)

[demosthenesk]

Because the type of Fl_Callback is :
SUB CDECL(AS FL_WIDGET PTR, AS ANY PTR)

Maybe:

Code: Select all

sub rename_me cdecl(o as Fl_Widget ptr, s as any ptr)
	dim s0 as Fl_Input ptr = s
	o->label(s0->value)
	o->redraw()
end sub

yes that is a fix
thanks

it works also without CDECL

Code: Select all

sub rename_me(o as Fl_Widget ptr, s as any ptr)
	dim s0 as Fl_Input ptr = s
	o->label(s0->value)
	o->redraw()
end sub

[demosthenesk]

Another FLTK example.
We have a window with a Box and 3 scrollbars.
Each scrollbar sets the color value of Red, Green, Blue of box color

Code: Select all

#include once "FLTK/Fl_Double_Window.bi"
#include once "FLTK/Fl_Scrollbar.bi"
#include once "FLTK/Fl_Box.bi"

declare sub setColor(as Fl_Widget ptr, as any ptr)

'' main program

Dim shared w as Fl_Double_Window = Fl_Double_Window(600, 300, "Window")
	Dim shared box As Fl_Box = Fl_Box(FL_BORDER_BOX,20,30,500,100,"Color")
	Dim shared hScrollBarRed As Fl_Scrollbar=Fl_Scrollbar(20,135,300,24,"Red")
	Dim shared hScrollBarGreen As Fl_Scrollbar=Fl_Scrollbar(20,185,300,24,"Green")
	Dim shared hScrollBarBlue As Fl_Scrollbar=Fl_Scrollbar(20,235,300,24,"Blue")

	hScrollBarRed.type_(FL_HORIZONTAL)
	hScrollBarGreen.type_(FL_HORIZONTAL)
	hScrollBarBlue.type_(FL_HORIZONTAL)

	hScrollBarRed.minimum(0)
	hScrollBarRed.maximum(255)
	hScrollBarRed.value(0)
	
	hScrollBarGreen.minimum(0)
	hScrollBarGreen.maximum(255)
	hScrollBarGreen.value(128)
	
	hScrollBarBlue.minimum(0)
	hScrollBarBlue.maximum(255)
	hScrollBarBlue.value(0)
	
	Dim c as Fl_Color = fl_rgb_color(hScrollBarRed.value,hScrollBarGreen.value,hScrollBarBlue.value)
	box.Color(c)
	
	Dim cb as Fl_Callback = @setColor
	hScrollBarRed.callback(cb)
	hScrollBarGreen.callback(cb)
	hScrollBarBlue.callback(cb)

w.end_()
w.show()

fl.run_
'' end of main program

sub setColor(o as Fl_Widget ptr, p as any ptr)
	Dim c as Fl_Color = fl_rgb_color(hScrollBarRed.value,hScrollBarGreen.value,hScrollBarBlue.value)
	box.Color(c)
	box.redraw()
end sub

[demosthenesk]

Another FLTK example.
We have a window with a box.
We run a while...wend loop to catch keystrokes and show message to a box

Code: Select all

#include once "FLTK/Fl_Double_Window.bi"
#include once "FLTK/Fl_Box.bi"

'' main program
Dim z as zstring*128
Dim s as string
Dim w as Fl_Double_Window = _
	Fl_Double_Window(600, 300, "Window")
	Dim box As Fl_Box =_
		Fl_Box(FL_BORDER_BOX,20,30,500,200,"Press any key...")

	while(true)
		s=str(fl.event_key)
		z=!"Press ENTER to exit loop.\nPress any key to see its keycode\nKey code = "+s
		box.label(z)
		box.redraw()
		w.show()
		'if user press ENTER exit loop
		if fl.event_key = 65293 then
			exit while
		end if
		fl.check()
	wend
	
	box.label(!"You pressed ENTER\nExit while...now you can close the window!")
	w.end_
	fl.run_

[demosthenesk]

I was started to writing a book about FLTK and FreeBASIC.
It is based on fltk-1.3.5.pdf documentation and example code by Angelo Rosina (angros47) and me Demosthenes Koptsis (demosthenesk).
Soon available...

https://github.com/demosthenesk/Getting ... BASIC-Book

[fxm]

Because the type of Fl_Callback is :
SUB CDECL(AS FL_WIDGET PTR, AS ANY PTR)

Maybe:

Code: Select all

sub rename_me cdecl(o as Fl_Widget ptr, s as any ptr)
	dim s0 as Fl_Input ptr = s
	o->label(s0->value)
	o->redraw()
end sub

yes that is a fix
thanks

it works also without CDECL

Code: Select all

sub rename_me(o as Fl_Widget ptr, s as any ptr)
	dim s0 as Fl_Input ptr = s
	o->label(s0->value)
	o->redraw()
end sub

The default calling convention changes depending on the platform. For Windows it is stdcall; while on Linux, the *BSDs, and DOS, it is cdecl
If you does not have a pointer warning (as for me on Windows), maybe you are using Linux?

[demosthenesk]

Because the type of Fl_Callback is :
SUB CDECL(AS FL_WIDGET PTR, AS ANY PTR)

Maybe:

Code: Select all

sub rename_me cdecl(o as Fl_Widget ptr, s as any ptr)
	dim s0 as Fl_Input ptr = s
	o->label(s0->value)
	o->redraw()
end sub

yes that is a fix
thanks

it works also without CDECL

Code: Select all

sub rename_me(o as Fl_Widget ptr, s as any ptr)
	dim s0 as Fl_Input ptr = s
	o->label(s0->value)
	o->redraw()
end sub

The default calling convention changes depending on the platform. For Windows it is stdcall; while on Linux, the *BSDs, and DOS, it is cdecl
If you does not have a pointer warning (as for me on Windows), maybe you are using Linux?

yes, that's true, i am on Debian

[demosthenesk]

Another example of FLTK...
We have two windows. We drag from one window to another...from a box to second windows's box

Code: Select all

#include once "FLTK/Fl_Window.bi"
#include once "FLTK/Fl_Box.bi"

'SIMPLE SENDER CLASS
Type sender extends Fl_Box
	declare constructor()
	declare constructor (byref w as const sender)
	declare operator let (byref w as const sender)
	declare function handle(as long) as long
End Type

constructor sender()
	base(FL_FLAT_BOX, 0,0,100,100,"Sender")
end constructor

function sender.handle(event as long) as long
	dim ret as long = base.handle(event)
	select case event
		case FL_PUSH
			dim msg as string = "It works!"
			Fl.copy(msg, len(msg),0)
			Fl.dnd()
			ret=1
	end select
	return(ret)
end function

'SIMPLE RECIEVER CLASS
Type reciever extends Fl_Box
	declare constructor()
	declare constructor (byref w as const reciever)
	declare operator let (byref w as const reciever)
	declare function handle(as long) as long
End Type

constructor reciever()
	base(FL_FLAT_BOX, 100,0,100,100,"Reciever")
end constructor

function reciever.handle(event as long) as long
	dim ret as long = base.handle(event)
	select case event
		case FL_DND_ENTER	'return(1) for these events to 'accept' dnd
			ret=1
		case FL_DND_DRAG
			ret=1
		case FL_DND_RELEASE
			ret=1
		case FL_PASTE	'handle actual drop (paste) operation
			this.label(Fl.event_text())
			ret=1
	end select
	return(ret)
end function

''main program
Dim win_a as Fl_Window = Fl_Window(0,0,200,100,"Sender")
	Dim a as sender = sender()
	a.Color(9)
	a.label(!"Drag \nfrom here...")
win_a.end_()
win_a.show()

	'Create receiver window and widget
Dim win_b as Fl_Window = Fl_Window(400,0,200,100,"Receiver")
	Dim b as reciever= reciever()
	b.Color(10)
	b.label(!"...to\nhere!")
win_b.end_()
win_b.show()

Fl.run_()

[demosthenesk]

Another example of FLTK...
We have a window-wizard with 3 steps...

Code: Select all

#include once "FLTK/Fl_Window.bi"
#include once "FLTK/Fl_Group.bi"
#include once "FLTK/Fl_Wizard.bi"
#include once "FLTK/Fl_Button.bi"
#include once "FLTK/Fl_Multiline_Output.bi"

Dim shared G_Win as Fl_Window = Fl_Window(400,300,"Example Wizard")
Dim shared G_Wiz as Fl_Wizard = Fl_Wizard(0,0,400,300)

public sub back_cb cdecl(o as Fl_Widget ptr, p as any ptr)
	G_Wiz.prev()
end sub

public sub next_cb cdecl(o as Fl_Widget ptr, p as any ptr)
	G_Wiz.next_()
end sub

public sub done_cb cdecl(o as Fl_Widget ptr, p as any ptr)
	end
end sub

' Wizard: page 1
Dim g1 as Fl_Group = Fl_Group(0,0,400,300)
Dim next1 as Fl_Button = Fl_Button(290,265,100,25,"Next @->")
Dim cb1 as Fl_Callback = @next_cb
next1.callback(cb1)
Dim out1 as Fl_Multiline_Output = Fl_Multiline_Output(10,30,400-20,300-80,"Welcome")
out1.labelsize(20)
out1.align(FL_ALIGN_TOP or FL_ALIGN_LEFT)
out1.value("This is First page")
g1.end_()

' Wizard: page 2
Dim g2 as Fl_Group = Fl_Group(0,0,400,300)
Dim next2 as Fl_Button = Fl_Button(290,265,100,25,"Next @->")
next2.callback(cb1)
Dim back1 as Fl_Button = Fl_Button(180,265,100,25,"@<- Back")
Dim cb2 as Fl_Callback = @back_cb
back1.callback(cb2)
Dim out2 as Fl_Multiline_Output = Fl_Multiline_Output(10,30,400-20,300-80,"Terms And Conditions")
out2.labelsize(20)
out2.align(FL_ALIGN_TOP or FL_ALIGN_LEFT)
out2.value("This is the Second page")
g2.end_()

' Wizard: page 3
Dim g3 as Fl_Group = Fl_Group(0,0,400,300)
Dim  done as Fl_Button = Fl_Button(290,265,100,25,"Finish")
Dim cb3 as Fl_Callback = @done_cb
done.callback(cb3)
Dim back as Fl_Button = Fl_Button(180,265,100,25,"@<- Back")
back.callback(cb2)
Dim out3 as Fl_Multiline_Output = Fl_Multiline_Output(10,30,400-20,300-80,"Finish")
out3.labelsize(20)
out3.align(FL_ALIGN_TOP or FL_ALIGN_LEFT)
out3.value("This is the Last page")
g3.end_()

G_Wiz.end_()
G_Win.end_()
G_Win.show()
Fl.run_()

[demosthenesk]

the
fl_open_uri()
is not in filename.bi
see example menubar-add.cxx

[demosthenesk]

i try the tree-simple example and i get these errors

Code: Select all

#include once "FLTK/Fl_Double_Window.bi"
#include once "FLTK/Fl_Tree.bi"

'Tree's callback
'Invoked whenever an item's state changes.
'This callback is invoked whenever the user clicks an item in the menu bar
Sub TreeCallback(w as Fl_Widget ptr, p as any ptr)
	var tree = cptr(Fl_Tree ptr, w)
	dim item as const Fl_Tree_Item ptr = cptr(Fl_Tree_Item ptr, tree->callback_item())
	if (item <> 1) then 
		exit sub
	end if
	
	select case (tree->callback_reason())
	case FL_TREE_REASON_SELECTED
		dim pathname as string*256
		tree->item_pathname(pathname, sizeof(pathname), item)
		print "TreeCallback: Item selected=" & item->label() & " Full pathname= " & pathname
	case FL_TREE_REASON_DESELECTED
		print "TreeCallback: Item " & item->label() & " deselected"
	case FL_TREE_REASON_OPENED
		print "TreeCallback: Item " & item->label() & " opened"
	case FL_TREE_REASON_CLOSED
		print "TreeCallback: Item " & item->label() & " closed"
	end select
end sub

'main program
Fl.scheme("gtk+")
dim win as Fl_Double_Window = Fl_Double_Window(250, 400, "Simple Tree")
win.begin()
'Create the tree
dim tree as Fl_Tree= Fl_Tree(10, 10, win.w()-20, win.h()-20)
tree.showroot(0)	'don't show root of tree
dim cb as Fl_Callback = @TreeCallback
tree.callback(cb)	'setup a callback for the tree

'Add some items
tree.add("Flintstones/Fred")
tree.add("Flintstones/Wilma")
tree.add("Flintstones/Pebbles")
tree.add("Simpsons/Homer")
tree.add("Simpsons/Marge")
tree.add("Simpsons/Bart")
tree.add("Simpsons/Lisa")
tree.add(!"Pathnames/\\/bin")	'front slashes
tree.add(!"Pathnames/\\/usr\\/sbin")
tree.add(!"Pathnames/C:\\\\Program Files")	'backslashes
tree.add(!"Pathnames/C:\\\\Documents and Settings")

win.end_()
win.resizable(win)
win.show()
Fl.run_()

Buinding Project: [tree]......

/home/user/Bin/FreeBASIC/FreeBASIC-1.10.0-source/bin/fbc -c -m "tree" -b "tree.bas" -i "/home/user/Bin/FreeBASIC/FreeBASIC-1.10.0-source/inc" -p "/home/user/Bin/FreeBASIC/FreeBASIC-1.10.0-source/lib/freebasic/linux-x86_64" -l Xrender -l Xcursor -l Xfixes -l Xext -l Xft -l fontconfig -l Xinerama -l pthread -l m -l X11 -l png -l z -l jpeg


tree.c: In function ‘_Z8FL_COLORhhh’:
tree.c13: warning: infinite recursion detected [-Winfinite-recursion]
1293 | static void _Z8FL_COLORhhh( uint8 R$1, uint8 G$1, uint8 B$1 )
| ^~~~~~~~~~~~~~
tree.c9: note: recursive call
1296 | _Z8FL_COLORhhh( R$1, G$1, B$1 );
| ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
tree.c: In function ‘_ZNK7Fl_Tree5prefsEv’:
tree.c33: warning: infinite recursion detected [-Winfinite-recursion]
1664 | static struct $13Fl_Tree_Prefs* _ZNK7Fl_Tree5prefsEv( struct $7Fl_Tree* THIS$1 )
| ^~~~~~~~~~~~~~~~~~~~
tree.c41: note: recursive call
1669 | struct $13Fl_Tree_Prefs* vr$1 = _ZNK7Fl_Tree5prefsEv( THIS$1 );
| ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Compile Success!!

************************************

Continue Link Project: [tree]......

/home/user/Bin/FreeBASIC/FreeBASIC-1.10.0-source/bin/fbc -x "tree" -a "tree.o" -i "/home/user/Bin/FreeBASIC/FreeBASIC-1.10.0-source/inc" -p "/home/user/Bin/FreeBASIC/FreeBASIC-1.10.0-source/lib/freebasic/linux-x86_64" -l Xrender -l Xcursor -l Xfixes -l Xext -l Xft -l fontconfig -l Xinerama -l pthread -l m -l X11 -l png -l z -l jpeg

ld: tree.o:(.data.rel+0x400): undefined reference to `Fl_Image::label(FL_MENU_ITEM*)'
ld: tree.o:(.data.rel+0x460): undefined reference to `Fl_RGB_Image::label(FL_MENU_ITEM*)'
ld: tree.o:(.data.rel+0x4c0): undefined reference to `Fl_Bitmap::label(FL_MENU_ITEM*)'
ld: tree.o:(.data.rel+0x520): undefined reference to `Fl_Pixmap::label(FL_MENU_ITEM*)'

Compile Error...

[angros47]

In the file "fl_draw.bi", replace the lines:

Code: Select all

private sub fl_color overload(r as ubyte, g as ubyte, b as ubyte)
	fl_color(r, g, b)
end sub

with:

Code: Select all

private sub fl_color overload(r as ubyte, g as ubyte, b as ubyte)
	fl_graphics_driver_->fl_color(r, g, b)
end sub

See if it gets rid of the warnings.

Also, add the line

Code: Select all

#include once "FLTK/Fl_Menu_Bar.bi"

to your program

[demosthenesk]

In the file "fl_draw.bi", replace the lines:

Code: Select all

private sub fl_color overload(r as ubyte, g as ubyte, b as ubyte)
	fl_color(r, g, b)
end sub

with:

Code: Select all

private sub fl_color overload(r as ubyte, g as ubyte, b as ubyte)
	fl_graphics_driver_->fl_color(r, g, b)
end sub

See if it gets rid of the warnings.

Also, add the line

Code: Select all

#include once "FLTK/Fl_Menu_Bar.bi"

to your program

i get
fl_draw.bi(17) error 18: Element not defined, fl_color in 'fl_graphics_driver_->fl_color(r, g, b)'

[demosthenesk]

In the file "fl_draw.bi", replace the lines:

Code: Select all

private sub fl_color overload(r as ubyte, g as ubyte, b as ubyte)
	fl_color(r, g, b)
end sub

with:

Code: Select all

private sub fl_color overload(r as ubyte, g as ubyte, b as ubyte)
	fl_graphics_driver_->fl_color(r, g, b)
end sub

See if it gets rid of the warnings.

Also, add the line

Code: Select all

#include once "FLTK/Fl_Menu_Bar.bi"

to your program

i change to color(r,g,b)

Code: Select all

private sub fl_color overload(r as ubyte, g as ubyte, b as ubyte)
	fl_graphics_driver_->color(r, g, b)
end sub

and i get
Building Project: tree......

/home/user/Bin/FreeBASIC/FreeBASIC-1.10.0-source/bin/fbc -x "tree" -m "tree" -b "tree.bas" -i "/home/user/Bin/FreeBASIC/FreeBASIC-1.10.0-source/inc" -p "/home/user/Bin/FreeBASIC/FreeBASIC-1.10.0-source/lib/freebasic/linux-x86_64" -l Xrender -l Xcursor -l Xfixes -l Xext -l Xft -l fontconfig -l Xinerama -l pthread -l m -l X11 -l png -l z -l jpeg

tree.c: In function ‘_ZNK7Fl_Tree5prefsEv’:
tree.c33: warning: infinite recursion detected [-Winfinite-recursion]
1769 | static struct $13Fl_Tree_Prefs* _ZNK7Fl_Tree5prefsEv( struct $7Fl_Tree* THIS$1 )
| ^~~~~~~~~~~~~~~~~~~~
tree.c41: note: recursive call
1774 | struct $13Fl_Tree_Prefs* vr$1 = _ZNK7Fl_Tree5prefsEv( THIS$1 );
| ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Compile Success!!

The app is running successfully

[angros47]

Sorry, should have been:

Code: Select all

	fl_graphics_driver_->color(r, g, b)

My mistake

[demosthenesk]

Sorry, should have been:

Code: Select all

	fl_graphics_driver_->color(r, g, b)

My mistake

yes... i thought it too..

now i get only
warning: infinite recursion