FLTK headers for FreeBasic OOP (no C wrapper)

[angros47]

Found another bug, had to update the files fl_group.bi (making the function "handle" virtual) and fl_table.bi (replacing the enum Fl_Cursor with a long, since for FB enums are 8 bytes in 64 bit mode).

A spreadsheet demo:

Code: Select all

'
' "$Id$"
'
'	Simple example of an interactive spreadsheet using Fl_Table.
'	Uses Mr. Satan's technique of instancing an Fl_Input around.
'	Modified to test Jean-Marc's mods for keyboard nav and mouse selection.
'
'      Fl_Table[1.00/LGPL] 04/18/03 Mister Satan      -- Initial implementation, submitted to erco for Fl_Table
'      Fl_Table[1.10/LGPL] 05/17/03 Greg Ercolano     -- Small mods to follow changes to Fl_Table
'      Fl_Table[1.20/LGPL] 02/22/04 Jean-Marc Lienher -- Keyboard nav and mouse selection
'      Fl_Table[1.21/LGPL] 02/22/04 Greg Ercolano     -- Small reformatting mods, comments
'         FLTK[1.3.0/LGPL] 10/26/10 Greg Ercolano     -- Moved from Fl_Table to FLTK 1.3.x, CMP compliance
'
' Copyright 1998-2010 by Bill Spitzak and others.
'
' This library is free software. Distribution and use rights are outlined in
' the file "COPYING" which should have been included with this file.  If this
' file is missing or damaged, see the license at:
'
'     http:'www.fltk.org/COPYING.php
'
' Please report all bugs and problems on the following page:
'
'     http:'www.fltk.org/str.php
'
'#include <stdio.h>
'#include <stdlib.h>
#include once "FLTK/Fl.bi"
#include once "FLTK/Fl_Double_Window.bi"
#include once "FLTK/Fl_Table.bi"
#include once "FLTK/Fl_Int_Input.bi"
#include once "FLTK/Fl_Value_Slider.bi"
#include once "FLTK/fl_draw.bi"
#include once "FLTK/Fl_Menu_Bar.bi"

const MAX_COLS = 26
const MAX_ROWS = 500

type Spreadsheet extends Fl_Table
private:
	declare constructor (byref w as const Spreadsheet)
	declare operator let (byref w as const Spreadsheet)

	input_ as Fl_Int_Input ptr					' single instance of Fl_Int_Input widget
	values(MAX_ROWS-1,MAX_COLS-1) as long				' array of data for cells
	as long row_edit, col_edit					' row/col being modified
	as long s_left, s_top, s_right, s_bottom			' kb nav + mouse selection

protected:
	declare sub draw_cell(context as TableContext, a as long=0, b as long=0, c as long=0, d as long=0, e as long=0, f as long=0)
	declare sub event_callback2()				' table's event callback (instance)
	declare static sub event_callback(a as Fl_Widget ptr, v as any ptr)
	declare static sub input_cb(a as Fl_Widget ptr, v as any ptr)

public:
	declare constructor(X as long, Y as long, W as long, H as long, L as const zstring ptr=0)
	declare destructor

	' Apply value from input widget to values[row][col] array and hide (done editing)
	declare sub set_value_hide() 

	' Change number of rows
	declare sub rows(val_ as long)

	' Change number of columns
	declare sub cols(val_ as long)

	' Get number of rows
	declare function rows() as long

	' Get number of columns
	declare function cols() as long

	' Start editing a new cell: move the Fl_Int_Input widget to specified row/column
	'    Preload the widget with the cell's current value,
	'    and make the widget 'appear' at the cell's location.
	'
	declare sub start_editing(R as long, C as long) 

	' Tell the input widget it's done editing, and to 'hide'
	declare sub done_editing()

	' Return the sum of all rows in this column
	declare function sum_rows(C as long) as long

	' Return the sum of all cols in this row
	declare function sum_cols(R as long) as long

	' Return the sum of all cells in table
	declare function sum_all() as long
end type

private sub Spreadsheet.event_callback(a as Fl_Widget ptr, v as any ptr)	' table's event callback (static)
	cast(Spreadsheet ptr,v)->event_callback2()
end sub

private sub Spreadsheet.input_cb(a as Fl_Widget ptr, v as any ptr) 		' input widget's callback
	cast(Spreadsheet ptr,v)->set_value_hide()
end sub

private constructor Spreadsheet(X as long, Y as long, W as long, H as long, L as const zstring ptr)
	base(X,Y,W,H,L)
	callback(@event_callback, cast(any ptr,@this))
	when(FL_WHEN_NOT_CHANGED or when())
	' Create input widget that we'll use whenever user clicks on a cell
	input_ = new Fl_Int_Input(W/2,H/2,0,0)
	input_->hide()
	input_->callback(@input_cb, cast(any ptr,@this))
	input_->when(FL_WHEN_ENTER_KEY_ALWAYS)		' callback triggered when user hits Enter
	input_->maximum_size(5)
	row_edit = 0: col_edit = 0
	s_left = 0: s_top = 0: s_right = 0: s_bottom = 0
	for c as integer = 0 to MAX_COLS - 1
		for r as integer = 0 to MAX_ROWS - 1
			values(r,c) = (r + 2) * (c + 3)		' initialize cells
		next
	next
	end_()
end constructor

private destructor Spreadsheet
end destructor

private sub Spreadsheet.set_value_hide()
	values(row_edit,col_edit) = val(*input_->value())
	input_->hide()
	window()->cursor(FL_CURSOR_DEFAULT)		' XXX: if we don't do this, cursor can disappear!
end sub

private sub Spreadsheet.rows(val_ as long)
	base.rows(val_)
end sub

private sub Spreadsheet.cols(val_ as long)
	base.cols(val_)
end sub

private function Spreadsheet.rows() as long
	return base.rows()
end function

private function Spreadsheet.cols() as long
	return base.cols()
end function

private sub Spreadsheet.start_editing(R as long, C as long) 
	row_edit = R					' Now editing this row/col
	col_edit = C
	dim as long X,Y,W,H
	find_cell(CONTEXT_CELL, R,C, X,Y,W,H)		' Find X/Y/W/H of cell
	input_->resize(X,Y,W,H)				' Move Fl_Input widget there
	dim s as zstring *30: s=str (values(R,C))	' Load input widget with cell's current value
	input_->value(s)
	input_->position(0,len(s))			' Select entire input field
	input_->show()					' Show the input widget, now that we've positioned it
	input_->take_focus()
end sub

private sub Spreadsheet.done_editing()
	if input_->visible() then				' input widget visible, ie. edit in progress?
		set_value_hide()				' Transfer its current contents to cell and hide
	end if
end sub

private function Spreadsheet.sum_rows(C as long) as long
	dim sum as long = 0
	for r as integer=0 to rows()-2				' -1: don't include cell data in 'totals' column
		sum += values(r,C)
	next
	return(sum)
end function

private function Spreadsheet.sum_cols(R as long) as long
	dim sum as long = 0
	for c as integer=0 to cols()-2				' -1: don't include cell data in 'totals' column
		sum += values(R,c)
	next
	return(sum)
end function

private function Spreadsheet.sum_all() as long
	dim sum as long = 0
	for c as integer=0 to cols()-2				' -1: don't include cell data in 'totals' column
		for r as integer=0 to rows()-2			' -1:  ''
			sum += values(r,c)
		next
	next
	return(sum)
end function


' Handle drawing all cells in table
sub Spreadsheet.draw_cell(context as TableContext, R as long, C as long, X as long, Y as long, W as long, H as long) 
	static s as zstring * 30
	select case context
	case CONTEXT_STARTPAGE:				' table about to redraw
		' Get kb nav + mouse 'selection region' for use below
		get_selection(s_top, s_left, s_bottom, s_right)
	case CONTEXT_COL_HEADER:		' table wants us to draw a column heading (C is column)
		fl_font(FL_HELVETICA or FL_BOLD, 14)	' set font for heading to bold
		fl_push_clip(X,Y,W,H)			' clip region for text
			fl_draw_box(FL_THIN_UP_BOX, X,Y,W,H, col_header_color())
			fl_color(FL_BLACK)
			if C = cols()-1 then
				fl_draw("TOTAL", X,Y,W,H, FL_ALIGN_CENTER)
			else
				' Not last column? show column letter
				s=chr(asc("A")+C)	'sprintf(s, "%c", 'A' + C)
				fl_draw(s, X,Y,W,H, FL_ALIGN_CENTER)
			end if
		fl_pop_clip()
		return

	case CONTEXT_ROW_HEADER:			' table wants us to draw a row heading (R is row)
		fl_font(FL_HELVETICA or FL_BOLD, 14)	' set font for row heading to bold
		fl_push_clip(X,Y,W,H)
			fl_draw_box(FL_THIN_UP_BOX, X,Y,W,H, row_header_color())
			fl_color(FL_BLACK)
			if R = rows()-1 then
				fl_draw("TOTAL", X,Y,W,H, FL_ALIGN_CENTER)
			else
				s=str(R+1)	'sprintf(s, "%d", R+1);
				fl_draw(s, X,Y,W,H, FL_ALIGN_CENTER)
			end if
		fl_pop_clip()
		return

	case CONTEXT_CELL: 			' table wants us to draw a cell
		if R = row_edit andalso C = col_edit andalso input_->visible() then
			return					' dont draw for cell with input widget over it
		end if
		' Background
		' Keyboard nav and mouse selection highlighting
		if R >= s_top andalso R <= s_bottom andalso C >= s_left andalso C <= s_right then
			fl_draw_box(FL_THIN_UP_BOX, X,Y,W,H, FL_YELLOW)
		elseif C < cols()-1 andalso R < rows()-1 then
			fl_draw_box(FL_THIN_UP_BOX, X,Y,W,H, FL_WHITE)
		else
			fl_draw_box(FL_THIN_UP_BOX, X,Y,W,H, &Hbbddbb00)	' money green
		end if
		' Text
		fl_push_clip(X+3, Y+3, W-6, H-6)
			fl_color(FL_BLACK)
			if C = cols()-1 orelse R = rows()-1 then
				fl_font(FL_HELVETICA or FL_BOLD, 14)	' ..in bold font
				if C = cols()-1 andalso R = rows()-1 then
					s=str(sum_all())' sprintf(s, "%d", sum_all());
				elseif C = cols()-1 then
					s=str(sum_cols(R))' sprintf(s, "%d", sum_cols(R));
				elseif R = rows()-1 then
					s=str(sum_rows(C))' sprintf(s, "%d", sum_rows(C));
				end if
				fl_draw(s, X+3,Y+3,W-6,H-6, FL_ALIGN_RIGHT)
			else
				fl_font(FL_HELVETICA, 14)		' ..in regular font
				s=str(values(R,C))' sprintf(s, "%d", values[R][C])
				fl_draw(s, X+3,Y+3,W-6,H-6, FL_ALIGN_RIGHT)
			end if
		fl_pop_clip()
		return

	case CONTEXT_RC_RESIZE: 			' table resizing rows or columns
		if not input_->visible() then return
		find_cell(CONTEXT_TABLE, row_edit, col_edit, X, Y, W, H)
		if X=input_->x() andalso Y=input_->y() andalso W=input_->w() andalso H=input_->h() then return
		input_->resize(X,Y,W,H)
		return
	case else:
		return
	end select
end sub

' Callback whenever someone clicks on different parts of the table
sub Spreadsheet.event_callback2() 
	dim R as long = callback_row()
	dim C as long = callback_col()
	dim context as TableContext = callback_context()

	select case context
	case CONTEXT_CELL: 					' A table event occurred on a cell
		select case Fl.event()				' see what FLTK event caused it
		case FL_PUSH					' mouse click?
			done_editing()				' finish editing previous
			if R<> rows()-1 andalso C <> cols()-1 then start_editing(R,C)				' start new edit
			return

		case FL_KEYBOARD:				' key press in table?
			if Fl.event_key() = _FL_Escape then end	' ESC closes app
			if C = cols()-1 orelse R = rows()-1 then return	' no editing of totals column
			done_editing()				' finish any previous editing
			set_selection(R, C, R, C)		' select the current cell
			start_editing(R,C)			' start new edit
			if Fl.event() = FL_KEYBOARD andalso Fl.e_text[0] <> !"\r" then
				input_->handle(Fl.event())		' pass keypress to input widget
			end if
			return
		end select
		return
	case CONTEXT_TABLE, CONTEXT_ROW_HEADER, CONTEXT_COL_HEADER		' A table event occurred on dead zone in table
		done_editing()					' done editing, hide
		return
	case else
		return
	end select
end sub

' Change number of columns
sub setcols_cb cdecl(w as Fl_Widget ptr, v as any ptr) 
	dim table as Spreadsheet ptr = cast(Spreadsheet ptr,v)
	dim in as Fl_Valuator ptr = cast(Fl_Valuator ptr, w)
	dim cols as long = int(in->value()) + 1
	table->cols(cols)
	table->redraw()
end sub

' Change number of rows
sub setrows_cb cdecl(w as Fl_Widget ptr, v as any ptr)
	dim table as Spreadsheet ptr = cast(Spreadsheet ptr,v)
	dim in as Fl_Valuator ptr = cast(Fl_Valuator ptr, w)
	dim rows as long = int(in->value()) + 1
	table->rows(rows)
	table->redraw()
end sub



Fl.option(Fl.OPTION_ARROW_FOCUS, 1)		' we want arrow keys to navigate table's widgets
dim win as Fl_Double_Window ptr = new Fl_Double_Window(922, 382, "Fl_Table Spreadsheet with Keyboard Navigation")
dim table as Spreadsheet ptr = new Spreadsheet(20, 20, win->w()-80, win->h()-80)
' Table rows
table->row_header(1)
table->row_header_width(70)
table->row_resize(1)
table->rows(11)
table->row_height_all(25)
' Table cols
table->col_header(1)
table->col_header_height(25)
table->col_resize(1)
table->cols(11)
table->col_width_all(70)
table->set_selection(0,0,0,0)	' select top/left cell

' Add children to window
win->begin()

' Row slider
dim setrows as Fl_Value_Slider=Fl_Value_Slider(win->w()-40,20,20,win->h()-80, 0)
setrows.type_(FL_VERT_NICE_SLIDER_)
setrows.bounds(2,MAX_ROWS)
setrows.step_(1)
setrows.value(table->rows()-1)
setrows.callback(@setrows_cb, cast(any ptr, table))
setrows.when(FL_WHEN_CHANGED)
setrows.clear_visible_focus()

' Column slider
dim setcols as Fl_Value_Slider=Fl_Value_Slider(20,win->h()-40,win->w()-80,20, 0)
setcols.type_(FL_HOR_NICE_SLIDER_)
setcols.bounds(2,MAX_COLS)
setcols.step_(1)
setcols.value(table->cols()-1)
setcols.callback(@setcols_cb, cast(any ptr, table))
setcols.when(FL_WHEN_CHANGED)
setcols.clear_visible_focus()

win->end_()
win->resizable(table)
win->show()

Fl.run_()


'
' End of "$Id$".
'

[angros47]

tabs-simple.bas

Code: Select all

'
' "$Id$"
'
'	Simple Fl_Tabs widget example. 
'	Originally from erco's cheat sheet 06/05/2010, permission by author.
'
' Copyright 2010 Greg Ercolano.
' Copyright 1998-2010 by Bill Spitzak and others.
'
' This library is free software. Distribution and use rights are outlined in
' the file "COPYING" which should have been included with this file.  If this
' file is missing or damaged, see the license at:
'
'     http:'www.fltk.org/COPYING.php
'
' Please report all bugs and problems on the following page:
'
'     http:'www.fltk.org/str.php
'
#include once "FLTK/Fl.bi"
#include once "FLTK/Fl_Window.bi"
#include once "FLTK/Fl_Tabs.bi"
#include once "FLTK/Fl_Group.bi"
#include once "FLTK/Fl_Button.bi"
'
' Simple tabs example
'      _____  _____
'   __/ Aaa \/ Bbb \______________________
'  |    _______                           |
'  |   |_______|                          |
'  |    _______                           |
'  |   |_______|                          |
'  |    _______                           |
'  |   |_______|                          |
'  |______________________________________|
'

Fl.scheme("gtk+")
dim win as Fl_Window ptr = new Fl_Window(500,200,"Tabs Example")
	' Create the tab widget
	dim tabs as Fl_Tabs ptr = new Fl_Tabs(10,10,500-20,200-20)
	scope
		' ADD THE "Aaa" TAB
		'   We do this by adding a child group to the tab widget.
		'   The child group's label defined the label of the tab.
		'
		dim aaa as Fl_Group ptr = new Fl_Group(10,35,500-20,200-45,"Aaa")
		scope
			' Put some different buttons into the group, which will be shown
			' when the tab is selected.
			dim b1 as Fl_Button ptr = new Fl_Button(50, 60,90,25,"Button A1"): b1->color(88+1)
			dim b2 as Fl_Button ptr = new Fl_Button(50, 90,90,25,"Button A2"): b2->color(88+2)
			dim b3 as Fl_Button ptr = new Fl_Button(50,120,90,25,"Button A3"): b3->color(88+3)
		end scope
		aaa->end_()

		' ADD THE "Bbb" TAB
		'   Same details as above.
		'
		dim bbb as Fl_Group ptr = new Fl_Group(10,35,500-10,200-35,"Bbb")
		scope
			' Put some different buttons into the group, which will be shown
			' when the tab is selected.
			dim b1 as Fl_Button ptr = new Fl_Button( 50,60,90,25,"Button B1"): b1->color(88+1)
			dim b2 as Fl_Button ptr = new Fl_Button(150,60,90,25,"Button B2"): b2->color(88+3)
			dim b3 as Fl_Button ptr = new Fl_Button(250,60,90,25,"Button B3"): b3->color(88+5)
			dim b4 as Fl_Button ptr = new Fl_Button( 50,90,90,25,"Button B4"): b4->color(88+2)
			dim b5 as Fl_Button ptr = new Fl_Button(150,90,90,25,"Button B5"): b5->color(88+4)
			dim b6 as Fl_Button ptr = new Fl_Button(250,90,90,25,"Button B6"): b6->color(88+6)
		end scope
		bbb->end_()
	end scope
	tabs->end_()
win->end_()
win->show(__FB_ARGC__, __FB_ARGV__)
Fl.run_()


'
' End of "$Id$".
'

[angros47]

progress-simple.bas

Code: Select all

#include once "FLTK/Fl.bi"
#include once "FLTK/Fl_Window.bi"
#include once "FLTK/Fl_Button.bi"
#include once "FLTK/Fl_Progress.bi"

'
' "$Id$"
'
' Demonstrate using the Fl_Progress widget in an application - erco 05/02/2005
'
' Copyright 2005,2012 Greg Ercolano.
' Copyright 1998-2012 by Bill Spitzak and others.
'
' This library is free software. Distribution and use rights are outlined in
' the file "COPYING" which should have been included with this file.  If this
' file is missing or damaged, see the license at:
'
'     http:'www.fltk.org/COPYING.php
'
' Please report all bugs and problems on the following page:
'
'     http:'www.fltk.org/str.php
'


' Button callback
sub butt_cb cdecl(butt as Fl_Widget ptr, data_ as any ptr) 

	' Deactivate the button
	butt->deactivate()                        ' prevent button from being pressed again                   
	Fl.check()                                ' give fltk some cpu to gray out button
	' Make the progress bar
	dim w as Fl_Window ptr = cast(Fl_Window ptr,data_)           ' access parent window
	w->begin()                                ' add progress bar to it..
	dim progress as Fl_Progress ptr = new Fl_Progress(10,50,200,30)
	progress->minimum(0)                      ' set progress range to be 0.0 ~ 1.0
	progress->maximum(1)
	progress->color(&H88888800)               ' background color
	progress->selection_color(&H4444ff00)     ' progress bar color
	progress->labelcolor(FL_WHITE)            ' percent text color
	w->end_()                                 ' end adding to window
	' Computation loop..
	for t as integer=1 to 500
		progress->value(t/500.0)              ' update progress bar with 0.0 ~ 1.0 value
		dim percent as zstring * 10
		percent=str(int((t/500.0)*100.0))+"%"
		progress->label(percent)              ' update progress bar's label
		Fl.check()                            ' give fltk some cpu to update the screen
		sleep 1                              ' 'your stuff' that's compute intensive
	next
	' Cleanup
	w->remove(progress)                       ' remove progress bar from window
	delete(progress)                          ' deallocate it
	butt->activate()                          ' reactivate button
	w->redraw()                               ' tell window to redraw now that progress removed
end sub
' Main
dim win as Fl_Window=Fl_Window(220,90,"")
dim butt as Fl_Button=Fl_Button(10,10,100,25,"Press")
butt.callback(@butt_cb, @win)
win.resizable(win)
win.show()
Fl.run_()


'
' End of "$Id$".
'

[Lothar Schirm]

Just a curious question, because I used FLTK-C-1.3.3 for FreeBASIC by D.J.Peters viewtopic.php?t=24547 some years ago: Am I right that these new FLTK headers for FreeBASIC OOP will be distributed within the next FreeBASIC package? I see that a lot of people have used D.J.Peters' FLTK wrapper. Will this be obsolete then, or will code written with D.J.Peters' FLTK wrapper also run with the new headers?

Many thanks to all who work on this new project and to D.J.Peters for his giant work, I am worry that he was not active in the forum for long time. Hopefully he is well!

[angros47]

Yes, I pushed the headers in the new FreeBasic release. Since the code by D.J. Peters is a wrapper, made to work in non OOP languages, the syntax is different, so the programs written with his wrapper won't work with the new headers. Although it will still be possible to use his wrapper, since the inclusion of the new headers won't make their use mandatory: they are just one more option

[angros47]

Two more examples:

overlay.bas

Code: Select all

'
' "$Id$"
'
' Overlay window test program for the Fast Light Tool Kit (FLTK).
'
' Copyright 1998-2010 by Bill Spitzak and others.
'
' This library is free software. Distribution and use rights are outlined in
' the file "COPYING" which should have been included with this file.  If this
' file is missing or damaged, see the license at:
'
'     http:'www.fltk.org/COPYING.php
'
' Please report all bugs and problems on the following page:
'
'     http:'www.fltk.org/str.php
'

#include once "FLTK/Fl.bi"
#include once "FLTK/Fl_Window.bi"
#include once "FLTK/Fl_Overlay_Window.bi"
#include once "FLTK/Fl_Button.bi"
#include once "FLTK/fl_draw.bi"
#include once "FLTK/Fl_Menu_Item.bi"



dim shared as long width_=10,height=10

type overlay extends Fl_Overlay_Window 
private:
	declare constructor (byref s as const overlay)
	declare operator let (byref s as const overlay)
public:
	declare constructor (w as long, h as long)
	declare sub draw_overlay()
end type

constructor overlay(w as long, h as long)
	base(w,h)
end constructor


sub overlay.draw_overlay()
	fl_color(FL_RED): fl_rect((w()-width_)/2,(h()-height)/2,width_,height)
end sub

dim shared ovl as overlay ptr

sub bcb1(a as Fl_Widget ptr, b as any ptr)
	width_+=20: ovl->redraw_overlay()
end sub

sub bcb2 cdecl(a as Fl_Widget ptr, b as any ptr)
	width_-=20: ovl->redraw_overlay()
end sub

sub bcb3 cdecl(a as Fl_Widget ptr, b as any ptr)
	height+=20: ovl->redraw_overlay()
end sub

sub bcb4 cdecl(a as Fl_Widget ptr, b as any ptr)
	height-=20: ovl->redraw_overlay()
end sub


function arg cdecl(a as long, argv as zstring ptr ptr, byref i as long) as long
	dim n as Fl_Color = cast(Fl_Color, val(*argv[i]))
	if n<=0 then return 0
	i+=1
	dim as ubyte r,g,b
	Fl.get_color(n,r,g,b)
	Fl.set_color(FL_RED,r,g,b)
	return i
end function

dim i as long: Fl.args(__FB_ARGC__, __FB_ARGV__,i, @arg)
ovl = new overlay(400,400)
	dim b as Fl_Button ptr
	b = new Fl_Button(50,50,100,100,!"wider\n(a)")
	b->callback(@bcb1): b->shortcut(asc("a"))
	b = new Fl_Button(250,50,100,100,!"narrower\n(b)")
	b->callback(@bcb2): b->shortcut(asc("b"))
	b = new Fl_Button(50,250,100,100,!"taller\n(c)")
	b->callback(@bcb3): b->shortcut(asc("c"))
	b = new Fl_Button(250,250,100,100,!"shorter\n(d)")
	b->callback(@bcb4): b->shortcut(asc("d"))
	ovl->resizable(ovl)
ovl->end_()
ovl->show(__FB_ARGC__, __FB_ARGV__)
ovl->redraw_overlay()
Fl.run_()


'
' End of "$Id$".
'

gl_overlay.bas

Code: Select all

'
'     http:'www.fltk.org/str.php
'

#include once "FLTK/Fl.bi"
#include once "FLTK/Fl_Toggle_Button.bi"
#include once "FLTK/Fl_Window.bi"
#include once "FLTK/Fl_Hor_Slider.bi"
#include once "FLTK/gl.bi"
#include once "FLTK/Fl_Gl_Window.bi"

const M_PI = 3.14159265358979323846

type shape_window extends Fl_Gl_Window 
private:
	declare constructor (byref s as const shape_window)
	declare operator let (byref s as const shape_window)
public:
	sides as long
	overlay_sides as long
	declare constructor(x as long, y as long, w as long, h as long, l as const zstring ptr=0)
	declare sub draw()
	declare sub draw_overlay()
end type

constructor shape_window(x as long, y as long, w as long, h as long, l as const zstring ptr)
	base(x,y,w,h,l)
	sides =3: overlay_sides = 3
end constructor

sub shape_window.draw () 
	' the valid() property may be used to avoid reinitializing your
	' GL transformation for each redraw:
	if not valid() then
		valid(1)
		glLoadIdentity()
		glViewport(0,0,pixel_w(),pixel_h())
	end if
	' draw an amazing but slow graphic:
	glClear(GL_COLOR_BUFFER_BIT)
	glBegin(GL_POLYGON)
	for j as integer=0 to sides
		dim ang as double = j*2*M_PI/sides
		glColor3f(cast(single,j)/sides,cast(single,j)/sides,cast(single,j)/sides)
		glVertex3f(cos(ang),sin(ang),0)
	next
	glEnd()

end sub

sub shape_window.draw_overlay()
	' the valid() property may be used to avoid reinitializing your
	' GL transformation for each redraw:
	if not valid() then
		valid(1)
		glLoadIdentity()
		glViewport(0,0,pixel_w(),pixel_h())
	end if
	' draw an amazing graphic:
	gl_color_(FL_RED)
	glBegin(GL_LINE_LOOP)
	for j as integer=0 to overlay_sides
		dim ang as double = j*2*M_PI/overlay_sides
		glVertex3f(cos(ang),sin(ang),0)
	next
	glEnd()
end sub

' when you change the data, as in this callback, you must call redraw():
sub sides_cb cdecl(o as Fl_Widget ptr, p as any ptr) 
	dim sw as shape_window ptr = cast(shape_window ptr,p)
	sw->sides = int(cast(Fl_Slider ptr,o)->value())
	sw->redraw()
end sub

sub overlay_sides_cb cdecl(o as Fl_Widget ptr, p as any ptr) 
	dim sw as shape_window ptr = cast(shape_window ptr,p)
	sw->overlay_sides = int(cast(Fl_Slider ptr,o)->value())
	sw->redraw_overlay()
end sub



Fl.use_high_res_GL(1)
dim window_ as Fl_Window = Fl_Window(300, 370)

	dim sw as shape_window = shape_window(10, 75, window_.w()-20, window_.h()-90)
	'sw.mode(FL_RGB);
	window_.resizable(@sw)

	dim slider as  Fl_Hor_Slider =  Fl_Hor_Slider(60, 5, window_.w()-70, 30, "Sides:")
	slider.align(FL_ALIGN_LEFT)
	slider.callback(@sides_cb,@sw)
	slider.value(sw.sides)
	slider.step_(1)
	slider.bounds(3,40)

	dim oslider as  Fl_Hor_Slider = Fl_Hor_Slider(60, 40, window_.w()-70, 30, "Overlay:")
	oslider.align(FL_ALIGN_LEFT)
	oslider.callback(@overlay_sides_cb,@sw)
	oslider.value(sw.overlay_sides)
	oslider.step_(1)
	oslider.bounds(3,40)

window_.end_()
window_.show(__FB_ARGC__, __FB_ARGV__)
print "Can do overlay = "; sw.can_do_overlay()
sw.show()
sw.redraw_overlay()

Fl.run_()


'
' End of "$Id$".
'

[Lothar Schirm]

Yes, I pushed the headers in the new FreeBasic release. Since the code by D.J. Peters is a wrapper, made to work in non OOP languages, the syntax is different, so the programs written with his wrapper won't work with the new headers. Although it will still be possible to use his wrapper, since the inclusion of the new headers won't make their use mandatory: they are just one more option

Thank you!

[angros47]

Another example:

inactive.bi:

Code: Select all

' generated by Fast Light User Interface Designer (fluid) version 1.0305

#include once "FLTK/Fl.bi"
#include once "FLTK/Fl_Double_Window.bi"
#include once "FLTK/Fl_Group.bi"
'extern the_group as Fl_Group ptr
#include once "FLTK/Fl_Button.bi"
#include once "FLTK/Fl_Light_Button.bi"
#include once "FLTK/Fl_Check_Button.bi"
#include once "FLTK/Fl_Round_Button.bi"
#include once "FLTK/Fl_Slider.bi"
#include once "FLTK/Fl_Input.bi"
#include once "FLTK/Fl_Menu_Button.bi"
#include once "FLTK/Fl_Value_Output.bi"
#include once "FLTK/Fl_Box.bi"
#include once "FLTK/Fl_Scrollbar.bi"
#include once "FLTK/Fl_Roller.bi"
#include once "FLTK/Fl_Dial.bi"
#include once "FLTK/Fl_Clock.bi"
'extern menu_menu() as Fl_Menu_Item 

inactive.bas:

Code: Select all

' generated by Fast Light User Interface Designer (fluid) version 1.0305

#include "inactive.bi"

dim shared the_group as Fl_Group ptr=cast(Fl_Group ptr,0)

dim  menu_menu(...) as Fl_Menu_Item = {_
 (@"item", 0,  0, 0, 0, cast(ubyte, FL_NORMAL_LABEL), 0, 14, 0),_
 (@"item", 0,  0, 0, 0, cast(ubyte, FL_NORMAL_LABEL), 0, 14, 0),_
 (@"item", 0,  0, 0, 0, cast(ubyte, FL_NORMAL_LABEL), 0, 14, 0),_
 (@"item", 0,  0, 0, 0, cast(ubyte, FL_NORMAL_LABEL), 0, 14, 0),_
 (@"item", 0,  0, 0, 0, cast(ubyte, FL_NORMAL_LABEL), 0, 14, 0),_
 (0,0,0,0,0,0,0,0,0)}

private sub cb_active cdecl(a as Fl_Button ptr, b as any ptr)
	the_group->activate()
end sub

private sub cb_inactive cdecl(a as Fl_Button ptr, b as any ptr)
	the_group->deactivate()
end sub

dim w as Fl_Double_Window ptr
scope
	dim o as Fl_Double_Window ptr = new Fl_Double_Window(420, 369)
	w = o
	scope
		the_group = new Fl_Group(25, 25, 375, 295, "activate()/deactivate() called on this Fl_Group")
		the_group->box(FL_ENGRAVED_FRAME)
		the_group->align(cast(Fl_Align,FL_ALIGN_TOP or FL_ALIGN_INSIDE))
		scope
			var a=new Fl_Button(50, 50, 105, 25, "button")
		end scope

		scope
			dim o as Fl_Light_Button ptr = new Fl_Light_Button(50, 80, 105, 25, "light button")
			o->value(1)
			o->align(cast(Fl_Align,FL_ALIGN_CENTER or FL_ALIGN_INSIDE))
		end scope ' Fl_Light_Button* o
		scope
			dim o as Fl_Group ptr = new Fl_Group(50, 130, 105, 125, "Child group")
			o->box(FL_DOWN_FRAME)
			scope
				dim o as Fl_Check_Button ptr = new Fl_Check_Button(50, 170, 105, 25, "red")
				o->type_(102)
				o->down_box(_FL_DIAMOND_DOWN_BOX)
				o->selection_color(cast(Fl_Color,1))
				o->labelcolor(cast(Fl_Color,1))
			end scope ' Fl_Check_Button* o
			scope
				dim o as Fl_Check_Button ptr = new Fl_Check_Button(50, 190, 105, 25, "green")
				o->type_(102)
				o->down_box(_FL_DIAMOND_DOWN_BOX)
				o->selection_color(cast(Fl_Color,2))
				o->labelcolor(cast(Fl_Color,2))
			end scope ' Fl_Check_Button* o
			scope
				dim o as Fl_Check_Button ptr = new Fl_Check_Button(50, 210, 105, 25, "blue")
				o->type_(102)
				o->down_box(_FL_DIAMOND_DOWN_BOX)
				  o->selection_color(cast(Fl_Color,4))
				  o->labelcolor(cast(Fl_Color,4))
			end scope ' Fl_Check_Button* o
			scope
				dim o as Fl_Check_Button ptr = new Fl_Check_Button(50, 230, 105, 25, "white")
				o->type_(102)
				  o->down_box(_FL_DIAMOND_DOWN_BOX)
				  o->selection_color(cast(Fl_Color,55))
				  o->labelcolor(cast(Fl_Color,55))
			end scope ' Fl_Check_Button* o
			scope
				dim o as Fl_Check_Button ptr = new Fl_Check_Button(50, 130, 105, 25, "check")
				o->down_box(FL_DOWN_BOX)
			end scope ' Fl_Check_Button* o
			scope
				dim o as Fl_Round_Button ptr = new Fl_Round_Button(50, 150, 105, 25, "round")
				o->down_box(_FL_ROUND_DOWN_BOX)
			end scope ' Fl_Round_Button* o
			o->end_()
		end scope ' Fl_Group* o
		scope
			dim o as Fl_Slider ptr = new Fl_Slider(165, 50, 24, 205, "Fl_Slider")
			o->value(0.5)
		end scope ' Fl_Slider* o
		scope
			dim o as Fl_Input ptr = new Fl_Input(195, 50, 195, 30)
			o->static_value("Fl_Input")
		end scope ' Fl_Input* o
		scope
			dim o as Fl_Menu_Button ptr = new Fl_Menu_Button(245, 90, 130, 30, "menu")
			o->menu(@menu_menu(0))
		end scope ' Fl_Menu_Button* o
		scope
			dim o as Fl_Value_Output ptr = new Fl_Value_Output(245, 130, 130, 30, "value:")
			o->maximum(10000)
			o->step_(1)
			o->textfont(5)
			o->textsize(24)
			o->textcolor(cast(Fl_Color,4))
		end scope ' Fl_Value_Output* o
		scope
			dim o as Fl_Box ptr = new Fl_Box(245, 170, 140, 50, "Fl_Box")
			o->box(FL_EMBOSSED_FRAME)
			o->labeltype(FL_SHADOW_LABEL)
			o->labelfont(3)
			o->labelsize(38)
		end scope ' Fl_Box* o
		scope
			dim o as Fl_Scrollbar ptr = new Fl_Scrollbar(40, 274, 180, 20, "scrollbar")
			o->type_(1)
		end scope ' Fl_Scrollbar* o
		scope
			dim o as Fl_Roller ptr=new Fl_Roller(235, 230, 25, 65, "roller")
		end scope ' Fl_Roller* o
		scope
			dim o as Fl_Dial ptr=new Fl_Dial(275, 235, 50, 50, "dial")
		end scope ' Fl_Dial* o
		scope
			dim o as Fl_Clock ptr=new Fl_Clock(335, 235, 50, 50, "clock")
		end scope ' Fl_Clock* o
		the_group->end_()
		Fl_Group.current()->resizable(the_group)
	end scope ' Fl_Group* the_group
	scope
		dim o as Fl_Button ptr = new Fl_Button(25, 330, 185, 25, "active")
		o->type_(102)
		o->value(1)
		o->callback(cast(Fl_Callback, @cb_active))
	end scope ' Fl_Button* o
	scope
		dim o as Fl_Button ptr = new Fl_Button(220, 330, 180, 25, "inactive")
		o->type_(102)
		o->callback(cast(Fl_Callback,@cb_inactive))
	end scope ' Fl_Button* o
	o->end_()
end scope ' Fl_Double_Window* o
w->show(__FB_ARGC__, __FB_ARGV__)
Fl.run_()