FBC's Cairo clock example error

[badidea]

Does anyone maintain the examples shipped with freeBASIC?
The example clock.bas in /graphics/cairo crashes with 64-bit fbc. Changing Integer to Ulong on line 20 fixes this.

[MrSwiss]

What else did you expect, from such old example code (from 32 bit only, times)?

[badidea]

Non-working examples can be quite annoying, especially for beginners.
What is the process to get this example (and maybe many more) fixed? Create a GitHub account? I have not worked with GitHub before.

[MrSwiss]

There is also: SourceForge (sf.net), as alternative to GitHub ...

Btw. you'll find it in: https://sourceforge.net/p/fbc/code/ci/m ... /clock.bas

[dodicat]

The clock was all squashed anyway if I remember.
After loading half a dozen dll's (eight or so megabytes of bloatware) you would at least expect a round clock.

Code: Select all

#include "vbcompat.bi"

#include once "cairo.bi"

'=========== CAIRO MACROS  ===============

#macro Cline(surf,x1,y1,x2,y2,thickness,colour,CapOption)
cairo_set_line_width(surf, (thickness))
cairo_set_source_rgba colour
cairo_move_to(surf, (x1), (y1))
cairo_line_to(surf,(x2),(y2))
If Capoption Then 
    cairo_set_line_cap(surf,CAIRO_LINE_CAP_ROUND)
Else
    cairo_set_line_cap(surf,CAIRO_LINE_CAP_SQUARE)
End If
cairo_stroke(surf)
#endmacro

#macro Ccircle(surf,cx,cy,radius,start,finish,thickness,colour,Capoption)
cairo_set_line_width(surf,(thickness))
cairo_set_source_rgba colour
cairo_arc(surf,(cx),(cy),(radius),(start),(finish))
If Capoption Then 
    cairo_set_line_cap(surf,CAIRO_LINE_CAP_ROUND)
Else
    cairo_set_line_cap(surf,CAIRO_LINE_CAP_SQUARE)
End If
cairo_stroke(surf)
#endmacro

#macro Crectangle(surf,x,y,wide,high,thickness,colour)
cairo_set_line_width(surf, (thickness))
cairo_set_source_rgba colour
cairo_move_to(surf, (x), (y))
cairo_rectangle(surf,(x),(y),(wide),(high))
cairo_stroke(surf)
#endmacro

#macro SetBackgroundColour(colour)
cairo_set_source_rgba colour
cairo_paint(c)
#endmacro

#macro InitFonts(surf)
Dim Shared As cairo_font_extents_t _fonts '                         font data
cairo_font_extents (surf, @_fonts)
Dim Shared As cairo_text_extents_t _text
#endmacro

#macro Cprint(surf,x,y,text,size,colour)
cairo_set_font_size (surf,(size))
cairo_move_to (surf, _ '                 lower left corner of text
(x) - (_text.width / 2 + _text.x_bearing), _
(y) + (_text.height / 2) - _fonts.descent)
cairo_set_source_rgba colour
cairo_show_text(surf, text)
cairo_stroke(surf)
#endmacro

Function setscreen(xres As Integer,yres As Integer)  As cairo_t Ptr
    Screenres xres,yres,32
    Var surface = cairo_image_surface_create_for_data(Screenptr(), CAIRO_FORMAT_ARGB32,xres,yres,xres*4)
    Return cairo_create(surface)
End Function

Dim  As  cairo_t Ptr C
Const pi=4*Atn(1)
C=setscreen(800,600)
SetBackgroundColour((C,0,155/255,1,255))
InitFonts(C)

'=========================================
Sub circles(surf As cairo_t Ptr,numballs As Long,OutsideRadius As Long,cx As Long,cy As Long,c As Ulong,n As Long,md As Long)
    Dim As Double r,bigr,num,x,y,k=OutsideRadius
    Dim As Ulong clr
    #define rad *pi/180  
    #define zcol(c,n) (Cast(Ubyte Ptr,@c)[n])/255
    Dim As Long counter
    num= (45*(2*numballs-4)/numballs) rad
    num=Cos(num)
    r=num/(1+num)
    bigr=((1-r))*k    'radius to ring ball centres
    r=(r)*k -1       'radius of ring balls
    For z As Double=0 -pi/2 To 2*pi -pi/2 Step 2*pi/numballs
        counter+=1
        x=cx+bigr*Cos(z)
        y=cy+bigr*Sin(z)
        If counter>numballs Or counter>n+1  Then Exit For
        If (counter-1) Mod md=0 Then clr=c+Rgba(50,50,200,255) Else clr=c
        ccircle(surf,x,y,r/2,0,2*pi,r,(surf,zcol(clr,2),zcol(clr,1),zcol(clr,0),zcol(clr,3)),1)
        If md=3 And counter=n+1 Then
            clr=Rgba(0,0,0,255)
            cline(surf,x-15,y+15,x+15,y+15,4,(surf,zcol(clr,2),zcol(clr,1),zcol(clr,0),zcol(clr,3)),0)
        End If
        Var g=Right("0"+Str(counter-1),2)
        Var l=Len(Str((counter-1)))
        If md<>3 Then 
            cprint(surf,(x-8),(y+8),g,15,(surf,0,0,0,1))
        Else
            cprint(surf,(x-6*l),(y+12),Str(counter-1),25,(surf,.5,0,0,1))
        End If
    Next z
End Sub

Function F(t As Long,Byref z As Long=0) As Long
    t=t Mod 12
    If t=12 Then t=1
    z=t
    If  z < 12 Then Return 12 Else Return 1   
End Function

Dim As Long z,s
Windowtitle "Clock"
Do
    Var dt= Format( Now, "dd-mmmm-yyyy" )
    s=Second(Now)
    Screenlock
    SetBackgroundColour((C,0,.5,1,1))
    Crectangle(C,5,70,150,25,3,(C,.3,0,0,2))
    Cprint(C,10,90,"Version  "& *Cairo_version_string,15,(C,0,0,0,1))
    Ccircle(C,400,300,300,0,(2*pi),2,(C,.2,.2,.2,1),0)     
    Cprint(C,(400-4*Len(dt)),294,dt,20,(C,0,0,0,1))
    circles(C,60,290,400,300,Rgba(255,150,0,255),Second(Now),5)
    circles(c,60,250,400,300,Rgba(250,250,250,255),Minute(Now),5)
    circles(c,F(Hour(Now),z),190,400,300,Rgba(0,150,200,255),z,3)
    Screenunlock
    Sleep 100
Loop Until Len(Inkey)
Sleep

  

[badidea]

The clock was all squashed anyway if I remember.
After loading half a dozen dll's (eight or so megabytes of bloatware) you would at least expect a round clock.

Yes, I fixed that this way:

Code: Select all

const SCREEN_W = 800, SCREEN_H = 600
const SCREEN_RATIO = SCREEN_W / SCREEN_H

screenres SCREEN_W, SCREEN_H, 32

cairo_scale(pCairo, SCREEN_H, SCREEN_H) '<-- 2 x H

cairo_translate(pCairo, 0.5 * SCREEN_RATIO, 0.5)

etc.

You can call it "bloatware", I call it lots of useful code that I don't have to write :-)

The example cairo_output.bas produces a PDF, a Postscript and a SVG file. I challenge you to do all that in freeBASIC only in one evening.

[dodicat]

Not in one evening badidea, but it could be done I reckon and NOT 8 megabytes.
I tried getting the 6 .dll's into one big dll a few years back.
But it was going to cost too much for a converter.
Also difficult getting from .dll to .a static lib.
And how many actually use Cairo with fb on this forum?
It has it's uses yes, but it is a sledgehammer IMHO, for freebasic users.

[badidea]

Colorful cairographics clock:

Code: Select all

type rgb_sgl
	dim as single b, g, r
end type

function getColorSgl(byval hue as single) as rgb_sgl
	if hue < 0 then hue = 0
	if hue > 1 then hue = 1
	hue *= 6
	dim as single intensity = hue - int(hue)
	select case hue
	case is < 1: return type(1, intensity, 0)
	case is < 2: return type(1 - intensity, 1, 0)
	case is < 3: return type(0, 1, intensity)
	case is < 4: return type(0, 1 - intensity, 1)
	case is < 5: return type(intensity, 0, 1)
	case else: return type(1, 0, 1 - intensity)
	end select
	return type(0, 0, 0) 'never
end function

'-------------------------------------------------------------------------------

#include once "cairo/cairo.bi"
#include once "datetime.bi"

const SCREEN_W = 800, SCREEN_H = 600
const SCREEN_RATIO = SCREEN_W / SCREEN_H

const PI = 3.14159265358979323846#

screenres SCREEN_W, SCREEN_H, 32

' Create a cairo drawing context, using the FB screen as surface.
dim as cairo_surface_t ptr pSurface = _
	cairo_image_surface_create_for_data(screenptr(), _
	CAIRO_FORMAT_ARGB32, SCREEN_W, SCREEN_H, SCREEN_W * sizeof(ulong))

dim as cairo_t ptr pCt = cairo_create(pSurface)
'cairo_scale(pCt, SCREEN_W, SCREEN_H)
cairo_scale(pCt, SCREEN_H, SCREEN_H)

' Translate to the center of the rendering context
cairo_translate(pCt, 0.5 * SCREEN_RATIO, 0.5)

dim as cairo_font_extents_t cfe ' font data
dim as cairo_text_extents_t cte ' text size
dim as string text = "Test1234"
dim as single x, y, r
dim as rgb_sgl colour

do
	screenlock()

	' Draw a clock

	' compute the angles for the indicators of our clock
	dim as double minAngle = minute(now()) * PI / 30
	dim as double hrsAngle = hour(now()) * PI / 6
	dim as double secAngle = second(now()) * PI / 30

	' Draw the entire context white.
	cairo_set_source_rgba(pCt, 0.2, 0.2, 0.2, 1)
	cairo_paint(pCt)

	' Who doesn't want all those nice line settings :)
	cairo_set_line_cap(pCt, CAIRO_LINE_CAP_ROUND)
	cairo_set_line_width(pCt, 0.015)

	' Draw a red clock tick marks
	for tick as integer = 0 to 59
		colour = getColorSgl(tick / 60)
		cairo_set_source_rgba(pCt, colour.r, colour.g, colour.b, 0.6)
		x = 0.4 * sin(PI * 2 * tick / 60)
		y = 0.4 * -cos(PI * 2 * tick / 60)
		r = iif(tick mod 5 = 0, 0.02, 0.01)
		cairo_arc(pCt, x, y, r, 0, PI * 2)
		cairo_fill(pCt)
	next

	' Draw the time string
	text = time
	cairo_text_extents (pCt, text, @cte)
	cairo_set_font_size (pCt, 0.14)
	cairo_move_to (pCt, -(cte.width / 2 + cte.x_bearing), cte.height / 2 - cfe.descent)
	colour = getColorSgl(secAngle * 0.5 / PI)
	cairo_set_source_rgba(pCt, colour.r, colour.g, colour.b, 0.7)
	cairo_show_text(pCt, text)
	cairo_stroke(pCt)
	
	' Draw the second indicator
	cairo_set_source_rgba(pCt, 1, 1, 1, 0.7)
	cairo_arc(pCt, sin(secAngle) * 0.4, -Cos(secAngle) * 0.4, 0.015, 0, PI * 2)
	cairo_fill(pCt)

	' Draw the minutes indicator
	cairo_move_to(pCt, 0, 0)
	cairo_line_to(pCt, sin(minAngle) * 0.4, -Cos(minAngle) * 0.4)
	cairo_stroke(pCt)

	' Draw the hours indicator
	cairo_move_to(pCt, 0, 0)
	cairo_line_to(pCt, sin(hrsAngle) * 0.2, -Cos(hrsAngle) * 0.2)
	cairo_stroke(pCt)

	screenunlock()

	sleep 15
loop while (len(inkey()) = 0)

' Clean up the cairo context
cairo_destroy(pCt)

[dodicat]

Nice colours badidea.
What 64 bit version have you?

Code: Select all

#include once "cairo.bi"  '''maybe cairo/cairo.bi
#macro InitFonts(surf)
Dim Shared As cairo_font_extents_t _fonts '                         font data
cairo_font_extents (surf, @_fonts)
Dim Shared As cairo_text_extents_t _text
#endmacro

#macro Cprint(surf,x,y,text,size,colour)
cairo_set_font_size (surf,(size))
cairo_move_to (surf, _ '                 lower left corner of text
(x) - (_text.width / 2 + _text.x_bearing), _
(y) + (_text.height / 2) - _fonts.descent)
cairo_set_source_rgba colour
cairo_show_text(surf, text)
cairo_stroke(surf)
#endmacro

#macro SetBackgroundColour(colour)
cairo_set_source_rgba colour
cairo_paint(c)
#endmacro


Function setscreen(xres As Integer,yres As Integer)  As cairo_t Ptr
    Screenres xres,yres,32
    Var surface = cairo_image_surface_create_for_data(Screenptr(), CAIRO_FORMAT_ARGB32,xres,yres,xres*4)
    Return cairo_create(surface)
End Function

Dim  As  cairo_t Ptr C
C=setscreen(800,200)
SetBackgroundColour((C,0,.5,1,255))
InitFonts(C)
screenlock
cprint(C,200,120,"Version  "& *Cairo_version_string,50,(C,0,0,0,1))
screenunlock
sleep

 

I have Version 1.14.1
(Old I think)

[badidea]

What 64 bit version have you?
I have Version 1.14.1

1.14.6

[dodicat]

Yea, mine is old, but not easy to update (six dll's, which ones to update??, where do I get them?)
Your time string is jumping at the character 1.
Here I check mine again.

Code: Select all

#include once "cairo.bi"  '''maybe cairo/cairo.bi
#macro InitFonts(surf)
Dim Shared As cairo_font_extents_t _fonts '                         font data
cairo_font_extents (surf, @_fonts)
Dim Shared As cairo_text_extents_t _text
#endmacro

#macro Cprint(surf,x,y,text,size,colour)
cairo_set_font_size (surf,(size))
cairo_move_to (surf, _ '                 lower left corner of text
(x) - (_text.width / 2 + _text.x_bearing), _
(y) + (_text.height / 2) - _fonts.descent)
cairo_set_source_rgba colour
cairo_show_text(surf, text)
cairo_stroke(surf)
#endmacro

#macro SetBackgroundColour(colour)
cairo_set_source_rgba colour
cairo_paint(c)
#endmacro


Function setscreen(xres As Integer,yres As Integer)  As cairo_t Ptr
    Screenres xres,yres,32
    Var surface = cairo_image_surface_create_for_data(Screenptr(), CAIRO_FORMAT_ARGB32,xres,yres,xres*4)
    Return cairo_create(surface)
End Function

Dim  As  cairo_t Ptr C
C=setscreen(800,300)
InitFonts(C)
do
screenlock
cls
SetBackgroundColour((C,0,.5,1,255))
cprint(C,200,120,"Version  "& *Cairo_version_string,50,(C,0,.5,0,1))
cprint(C,200,200,time,80,(C,.5,0,0,1))
screenunlock
sleep 100
loop until len(inkey)
sleep

   

[badidea]

Yea, mine is old, but not easy to update (six dll's, which ones to update??, where do I get them?)

I just get them from the Ubuntu repository. I have no idea hove much .dll (or .so files), they are somewhere on my system.
My Cairo version is probably 'old' as well as my Ubuntu install is 3 years old.
What is annoying here is that the 32-bit Cairo libraries are installed but not found by the linker. Probably need to set some symbolic links manually.

[badidea]

Instead of using macros, I tried to make some wrapper class.
The centered text keeps moving a pixel or so.

Code: Select all

#include once "cairo/cairo.bi"
#include once "datetime.bi"

const SCREEN_W = 800, SCREEN_H = 600

const PI = 3.14159265358979323846#
const PI2 = PI * 2

'------------------------- Some helper functions as UDTs -----------------------

type rgb_sgl
	dim as single b, g, r
end type

type xy_sgl
	dim as single x, y
end type

type rgba_sgl
	dim as single b, g, r, a
end type

function getColorSgl(byval hue as single) as rgb_sgl
	if hue < 0 then hue = 0
	if hue > 1 then hue = 1
	hue *= 6
	dim as single intensity = hue - int(hue)
	select case hue
	case is < 1: return type(1, intensity, 0)
	case is < 2: return type(1 - intensity, 1, 0)
	case is < 3: return type(0, 1, intensity)
	case is < 4: return type(0, 1 - intensity, 1)
	case is < 5: return type(intensity, 0, 1)
	case else: return type(1, 0, 1 - intensity)
	end select
	return type(0, 0, 0) 'never
end function

function clockToCartesian(angle as single, radius as single) as xy_sgl
	dim as xy_sgl vector
	vector.x = sin(angle) * radius
	vector.y = -cos(angle) * radius
	return vector
end function

'--------------------------- Cairo Graphics Wrapper ----------------------------

type cScreen_type
	dim as cairo_surface_t ptr pSurface
	dim as cairo_t ptr pCt
	dim as cairo_font_extents_t cFe
	dim as cairo_text_extents_t cTe
	declare constructor()
	declare destructor()
	declare sub cClear(c as rgba_sgl)
	declare sub cCircleFilled(p as xy_sgl, r as single, c as rgba_sgl)
	declare sub cCircleOpen(p as xy_sgl, r as single, lw as single, c as rgba_sgl)
	declare sub cLine(p1 as xy_sgl, p2 as xy_sgl, lw as single, c as rgba_sgl)
	declare sub cTextCentered(p as xy_sgl, text as string, fs as single, c as rgba_sgl) 
end type

'create a cairo drawing context, using the FB screen as surface
constructor cScreen_type()
	if screenptr() <> 0 then
		dim as integer w, h, d, b, p
		screeninfo w, h, d, b, p
		pSurface = cairo_image_surface_create_for_data(screenptr(), CAIRO_FORMAT_ARGB32, w, h, p)
		pCt = cairo_create(pSurface)
		if h < w then
			cairo_scale(pCt, h, h)
			cairo_translate(pCt, 0.5 * (w / h), 0.5)
		else
			cairo_scale(pCt, w, w)
			cairo_translate(pCt, 0.5, 0.5 * (w / h)) 'test this !!!!!!!!!!!
		end if
		cairo_set_line_cap(pCt, CAIRO_LINE_CAP_ROUND)
		cairo_font_extents (pCt, @cFe)
	end if
end constructor

destructor cScreen_type()
	cairo_destroy(pCt)
end destructor

'parameters: color
sub cScreen_type.cClear(c as rgba_sgl)
	cairo_set_source_rgba(pCt, c.r, c.g, c.b, c.a)
	cairo_paint(pCt)
end sub

'parameters: position, raduis, color
sub cScreen_type.cCircleFilled(p as xy_sgl, r as single, c as rgba_sgl)
	cairo_set_source_rgba(pCt, c.r, c.g, c.b, c.a)
	cairo_arc(pCt, p.x, p.y, r, 0, PI * 2)
	cairo_fill(pCt)
end sub

'parameters: position, raduis, line_width, color
sub cScreen_type.cCircleOpen(p as xy_sgl, r as single, lw as single, c as rgba_sgl)
	
end sub

'parameters: position1, position2, line_width, color
sub cScreen_type.cLine(p1 as xy_sgl, p2 as xy_sgl, lw as single, c as rgba_sgl)
	cairo_set_source_rgba(pCt, c.r, c.g, c.b, c.a)
	cairo_set_line_width(pCt, lw)
	cairo_move_to(pCt, p1.x, p1.y)
	cairo_line_to(pCt, p2.x, p2.y)
	cairo_stroke(pCt)
end sub

'parameters: position, text, font_size, color
sub cScreen_type.cTextCentered(p as xy_sgl, text as string, fs as single, c as rgba_sgl)
	cairo_set_source_rgba(pCt, c.r, c.g, c.b, c.a)
	cairo_set_font_size (pCt, fs)
	cairo_text_extents (pCt, text, @cTe)
	cairo_move_to (pCt, p.x - (cTe.width / 2 + cTe.x_bearing), p.y - (cTe.height / 2 + cTe.y_bearing))
	cairo_show_text(pCt, text)
	cairo_stroke(pCt)
end sub

'---------------------------- Main: Clock example ------------------------------

screenres SCREEN_W, SCREEN_H, 32

dim as cScreen_type cScreen

dim as single r
dim as rgb_sgl c 'color
dim as xy_sgl p 'position
dim as single minAngle, hrsAngle, secAngle

do
	minAngle = minute(now()) * PI / 30
	hrsAngle = hour(now()) * PI / 6
	secAngle = second(now()) * PI / 30

	screenlock()
	cScreen.cClear(type(0.2, 0.2, 0.2, 1))

	'clock tick marks
	for tick as integer = 0 to 59
		p = clockToCartesian(PI2 * tick / 60, 0.4)
		r = iif(tick mod 5 = 0, 0.02, 0.01)
		c = getColorSgl(tick / 60)
		cScreen.cCircleFilled(p, r, type(c.r, c.g, c.b, 0.6))
	next

	'time string text
	c = getColorSgl(secAngle * 0.5 / PI)
	cScreen.cTextCentered(type(0, 0), time, 0.14, type(c.r, c.g, c.b, 0.7))
	
	'second indicator
	p = clockToCartesian(secAngle, 0.4)
	cScreen.cCircleFilled(p, 0.015, type(1, 1, 1, 0.7))

	'minutes indicator
	p = clockToCartesian(minAngle, 0.4)
	cScreen.cLine(type(0, 0), p, 0.015, type(1, 1, 1, 0.7))

	'hours indicator
	p = clockToCartesian(hrsAngle, 0.2)
	cScreen.cLine(type(0, 0), p, 0.015, type(1, 1, 1, 0.7))

	screenunlock()

	sleep 15
loop while (len(inkey()) = 0)

'------------------------------------ Links ------------------------------------

'https://www.cairographics.org/tutorial/
'http://zetcode.com/gfx/cairo/basicdrawing/
'https://cairographics.org/manual
'https://en.wikipedia.org/wiki/Cairo_%28graphics%29

[srvaldez]

hello dodicat
just found this site that has recent all-in-one Cairo dll https://github.com/preshing/cairo-windows/releases

This repository is meant to help create Cairo DLLs for Windows. Both 32-bit and 64-bit versions can be built. The resulting cairo.dll file is fully self-contained and does not depend on any other third-party DLLs. FreeType support is included. See this blog post for more information.

https://github.com/preshing/cairo-windows
the amazing thing to me is that the dll's size is just 2 megs

[Knatterton]

Ask Zippy - Donuts are the solution for everything...

Code: Select all

#include once "cairo/cairo.bi"

CONST M_PI = 4 * ATN(1)
Const SCREEN_W = 256
Const SCREEN_H = 256

ScreenRes SCREEN_W, SCREEN_H, 32
windowtitle "Donut"

' Create a cairo drawing context, using the FB screen as surface.
Dim As cairo_surface_t Ptr surface = cairo_image_surface_create_for_data(ScreenPtr(), _
      CAIRO_FORMAT_ARGB32, SCREEN_W, SCREEN_H, SCREEN_W * 4 )

Dim As cairo_t Ptr cr = cairo_create(surface)

 ' draw the entire context ochre
cairo_set_source_rgba(cr, 0.9, 0.7, 0.1, 1)
cairo_paint(cr)

' black
cairo_set_source_rgb(cr, 0.0, 0.0, 0.0)

  ScreenLock
     cairo_set_line_width(cr, 0.5)
     cairo_translate(cr, SCREEN_W/2,SCREEN_H/2)
     cairo_arc(cr, 0, 0, 120, 0, 2 * M_PI)
     cairo_stroke(cr)
     
     for i as short = 0 to 35
       cairo_save(cr)
       cairo_rotate(cr, i * M_PI / 36)
       cairo_scale(cr, 0.3, 1)
       cairo_arc(cr, 0, 0, 120, 0, 2 * M_PI)
       cairo_restore(cr)
       cairo_stroke(cr)     
     next i    
  ScreenUnlock

' Clean up the cairo context
cairo_destroy(cr)
cairo_surface_destroy(surface)

Sleep