FBC's Cairo clock example error

[jj2007]

Nice, Knatterton!

[badidea]

Triangles and rectangles added:

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 r, b, g
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) 
	declare sub cRectFilled(p1 as xy_sgl, p2 as xy_sgl, c as rgba_sgl) 
	declare sub cRectOpen(p1 as xy_sgl, p2 as xy_sgl, lw as single, c as rgba_sgl) 
	declare sub cTriangleFilled(p1 as xy_sgl, p2 as xy_sgl, p3 as xy_sgl, 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_set_line_join(pCt, CAIRO_LINE_JOIN_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)
	cairo_set_source_rgba(pCt, c.r, c.g, c.b, c.a)
	cairo_set_line_width(pCt, lw)
	cairo_arc(pCt, p.x, p.y, r, 0, PI * 2)
	cairo_stroke(pCt)
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

'parameters: position1, position2, color
sub cScreen_type.cRectFilled(p1 as xy_sgl, p2 as xy_sgl, c as rgba_sgl)
	cairo_set_source_rgba(pCt, c.r, c.g, c.b, c.a)
	cairo_rectangle(pCt, p1.x, p1.y, p2.x - p1.x, p2.y - p1.y)
	cairo_fill(pCt)
end sub

'parameters: position1, position2, line-width, color
sub cScreen_type.cRectOpen(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_rectangle(pCt, p1.x, p1.y, p2.x - p1.x, p2.y - p1.y)
	cairo_stroke(pCt)
end sub

'parameters: position1...3, color
sub cScreen_type.cTriangleFilled(p1 as xy_sgl, p2 as xy_sgl, p3 as xy_sgl, c as rgba_sgl)
	cairo_set_source_rgba(pCt, c.r, c.g, c.b, c.a)
	cairo_move_to(pCt, p1.x, p1.y)
	cairo_line_to(pCt, p2.x, p2.y)
	cairo_line_to(pCt, p3.x, p3.y)
	cairo_close_path(pCt)
	cairo_fill(pCt)
end sub

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

screenres SCREEN_W, SCREEN_H, 32

dim as cScreen_type cScreen

dim as single r 'raduis
dim as rgb_sgl c 'color
dim as xy_sgl p, secPos, minPos, hrsPos 
dim as single secAngle, minAngle, hrsAngle

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

	screenlock()

	'clear
	cScreen.cClear(type(0.2, 0.2, 0.2, 1))

	'square
	c = getColorSgl(secAngle * 0.5 / PI)
	cScreen.cRectFilled(type(-0.45, -0.45), type(+0.45, +0.45), type(1, 1, 1, 0.2))
	cScreen.cRectOpen(type(-0.45, -0.45), type(+0.45, +0.45), 0.02, type(c.r, c.g, c.b, 0.5))

	'clock tick marks
	cScreen.cCircleOpen(type(0, 0), 0.4, 0.002, type(1, 1, 1, 0.7))
	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.8))
	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
	secPos = clockToCartesian(secAngle, 0.4)
	cScreen.cCircleFilled(secPos, 0.015, type(1, 1, 1, 0.7))
	cScreen.cLine(type(0, 0), secPos, 0.005, type(1, 1, 1, 0.7))

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

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

	'triangle between indicators
	cScreen.cTriangleFilled(type(0, 0), secPos, minPos, type(1, 1, 1, 0.25))
	cScreen.cTriangleFilled(type(0, 0), secPos, hrsPos, type(1, 1, 1, 0.25))
	cScreen.cTriangleFilled(type(0, 0), minPos, hrsPos, type(1, 1, 1, 0.25))

	screenunlock()

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

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

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

Screen capture for those without cairo installed:

[badidea]

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

"Knatterton" sounds like Kwabbernoot?

[Knatterton]

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

"Knatterton" sounds like Kwabbernoot?

No, it is the famous Nick Knatterton:
https://en.wikipedia.org/wiki/Nick_Knatterton

[dodicat]

Try to keep the pendulum in period with the seconds.

Code: Select all

#include "vbcompat.bi"

#include once "cairo.bi"
Type d2
    As Single x,y
End Type
Operator + (v1 As d2,v2 As d2) As d2
Return Type<d2>(v1.x+v2.x,v1.y+v2.y)
End Operator
Operator -(v1 As d2,v2 As d2) As d2
Return Type<d2>(v1.x-v2.x,v1.y-v2.y)
End Operator
Operator * (f As Single,v1 As d2) As d2 'scalar*d2
Return Type(f*v1.x,f*v1.y)
End Operator

'=====================

Function length(v As d2) As Single
    Return Sqr(v.x*v.x+v.y*v.y)
End Function

Function normalize(v As d2) As d2
    Dim n As Single=length(v)
    Return Type(v.x/n,v.y/n)
End Function

'=========== 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,800)
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 pendulum(c as cairo_t ptr,cx As Integer,cy As Integer,lngth As Integer,radius As Integer,diff As Single,rate As Single,col As Uinteger,damper As Single=0,byref period as single=0) As Integer
    Dim As d2 ctr=Type(cx,cy)
    Static ang As Single
    Static damp As Single
    static as double lastt
    static as long flag
    #define Red( c ) (( c ) Shr 16 And 255 )
    #define Green( c ) (( c ) Shr  8 And 255 )
    #define Blue( c ) ( ( c ) And 255 )
    #define Alph( c ) ( ( c ) Shr 24         )
    Dim As Single rd=Red(col)/255,gr=Green(col)/255,bl=Blue(col)/255,al=Alph(col)/255
    damp=damp+damper
    Dim As Single lrate=Sqr(lngth),pie2= 6.283185307179586
    ang=ang+rate
    Dim As Single Lang=ang/lrate
    Var x=cx+lngth*Cos(Lang)*.2
    If x<550-100 Then flag=0
    If x>588-100 And flag=0  Then 
        flag=1
        period = Timer-lastt
        lastt=Timer
    End If
    Var y=cy+lngth+damp
    Dim As d2 rod=Type(x,y)-ctr
    rod=normalize(rod)
    rod=lngth*rod
    Dim As d2 bobpos=ctr+rod
    Cline(C,ctr.x,ctr.y,bobpos.x,bobpos.y,.01*lngth,(C,rd/2,gr/2,bl/2,al),1)
    Var a=Atan2(ctr.y-bobpos.y,ctr.x-bobpos.x):a=a+pie2/4
    Ccircle(C,bobpos.x,bobpos.y,radius,a,pie2/2+a,1.5*radius,(C,rd,gr,bl,al),0)
    ang=ang-diff
    Ccircle(C,cx,cy,500,pie2/4-.3,pie2/4+.3,20,(C,0,200,0,1),1)
    Return 0
End Function

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

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,fps
dim as single period,setfps=46
Windowtitle "Clock"
Do
    Var dt= Format( Now, "dd-mmmm-yyyy" )
    s=Second(Now)
    Screenlock
    SetBackgroundColour((C,0,.5,1,1))
    pendulum(c,400,300,450,20,0,1.5,Rgba(200,0,0,155),0,period)
    if period>2 then setfps+=.01 else setfps-=.01 ''adjustor
    Crectangle(C,5,70,150,25,3,(C,.3,0,0,2))
    Cprint(C,10,90,"fps =  "& fps,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 regulate(setfps,fps)
Loop Until Len(Inkey)
Sleep

  

[jj2007]

@dodicat: I get Clock.bas(120) error 24: Invalid data types:

Code: Select all

        Var g=Right("0"+Str(counter-1),2)

[dodicat]

jj2007.
Strange, I have tried 32 bit and 64 bit fb 1.06. -gen gas and -gen gcc with and without optimisation flags.
Also an old 32 bit fb 24.
All seem OK.
Maybe you could try with that that little quick runner I posted the other week, which is more or less command line level.

[srvaldez]

@dodicat
nice clock, tested on macOS but I had to change #include once "cairo.bi" to #include once "cairo/cairo.bi"
also, the fps and the pendulum behave strangely, the fps started at about 24 but after a while it got up to 40 to 60, however, if I click on the clock and keep the mouse pointer in the clock window and move the mouse rapidly back and forth, the the fps shoot up to 112 but after a while it slows down to about 80, hove not tested on Windows yet.

[dodicat]

srvaldez.
Amazing, one dll for Cairo.
Tested my own clock and badidea's clock, both work perfectly (tested 64 bits)
Now it is simple for anybody on the forum to use cairo (windows anyway).
Just pop that dll beside your source code.

[srvaldez]

hi dodicat :-)
remember the 6782 puzzle ? viewtopic.php?p=187523#p187523
you wrote really clever program using cairo viewtopic.php?p=188051#p188051
btw, why is this forum so deadly quiet ?
FIFA games ?

[badidea]

btw, why is this forum so deadly quiet ?

People as very busy coding? Working on some small game using Cairo here.

Or, more likely, people are killing brain cells by watching soccer, playing steam games or streaming the latest Netflix series?

[dodicat]

With the 32 bit dll in Win 10

I put a copy of srvaldez's cairo.dll into windows/sysWOW64
I made an import lib from the original cairo.dll (With the help of minGW)
gendef cairo.dll ---- to get cairo.def
dlltool -d cairo.def -l libcairo.dll.a ----to get libcairo.dll.a
I put libcairo.dll.a into the freebasic lib/win32folder.

A silly font tester (Windows of course)

Code: Select all

#include once "cairo/cairo.bi"  

Dim Shared As cairo_font_extents_t _fonts ' 
Dim Shared As cairo_text_extents_t _text
const pi=4*atn(1)

sub InitFonts(surf as cairo_t ptr,fonttype as string="times new roman")
if len(fonttype) then
cairo_select_font_face (surf,fonttype, CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_BOLD)
end if
cairo_font_extents (surf, @_fonts)
end sub


sub Cprint(surf as cairo_t ptr,x as long,y as long,text as string,size as single,colour as ulong)
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)
var rd=cast(ubyte ptr,@colour)[2]/255
var gr=cast(ubyte ptr,@colour)[1]/255
var bl=cast(ubyte ptr,@colour)[0]/255
var al=cast(ubyte ptr,@colour)[3]/255
cairo_set_source_rgba surf,rd,gr,bl,al
cairo_show_text(surf, text)
cairo_stroke(surf)
end sub

sub Crectangle(surf as cairo_t ptr,x as long,y as long,wide as long,high as long,thickness as single,colour as ulong)
cairo_set_line_width(surf, (thickness))
var rd=cast(ubyte ptr,@colour)[2]/255
var gr=cast(ubyte ptr,@colour)[1]/255
var bl=cast(ubyte ptr,@colour)[0]/255
var al=cast(ubyte ptr,@colour)[3]/255
cairo_set_source_rgba surf,rd,gr,bl,al
cairo_move_to(surf, (x), (y))
cairo_rectangle(surf,(x),(y),(wide),(high))
cairo_stroke(surf)
end sub

sub Ccircle(surf as cairo_t ptr,cx as long,cy as long,radius as long,start as single,finish as single,thickness as single,colour as ulong,Capoption as boolean)
cairo_set_line_width(surf,(thickness))
var rd=cast(ubyte ptr,@colour)[2]/255
var gr=cast(ubyte ptr,@colour)[1]/255
var bl=cast(ubyte ptr,@colour)[0]/255
var al=cast(ubyte ptr,@colour)[3]/255
cairo_set_source_rgba surf,rd,gr,bl,al
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)
end sub

sub Cline(surf as cairo_t ptr,x1 as long,y1 as long,x2 as long,y2 as long,thickness as single,colour as ulong,CapOption as boolean)
cairo_set_line_width(surf, (thickness))
var rd=cast(ubyte ptr,@colour)[2]/255
var gr=cast(ubyte ptr,@colour)[1]/255
var bl=cast(ubyte ptr,@colour)[0]/255
var al=cast(ubyte ptr,@colour)[3]/255
cairo_set_source_rgba surf,rd,gr,bl,al
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)
end sub


sub SetBackgroundColour(c as cairo_t ptr,colour as ulong)
var rd=cast(ubyte ptr,@colour)[2]/255
var gr=cast(ubyte ptr,@colour)[1]/255
var bl=cast(ubyte ptr,@colour)[0]/255
var al=cast(ubyte ptr,@colour)[3]/255
cairo_set_source_rgba c,rd,gr,bl,al
cairo_paint(c)
end sub


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)
    static as cairo_t Ptr res
    res= cairo_create(surface)
    return res
End Function

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function



Dim  As  cairo_t Ptr C
C=setscreen(800,600)
dim as long fps,x

do
    x+=1
    if x>800 then x=0
screenlock
InitFonts(C,"georgia")
SetBackgroundColour(c,rgba(0,130,255,255))
crectangle(C,190,220,60,60,3,rgba(200,50,32,255))
cprint(C,200,250,"box",10,rgba(0,0,100,255))
ccircle(C,340,320,40,0,2*pi,9,rgba(0,100,0,200),false)
cprint(C,320,330,"circle",10,rgba(100,0,0,255))
cline(C,50,550,750,550,40,rgba(200,200,200,255),true)
cprint(C,200,120,"Version  "& *Cairo_version_string,50,rgba(0,125,0,255))
cprint(C,200,200,time,80,rgba(125,0,0,255))
cprint(C,20,50,"Framerate = " &fps,20,rgba(0,0,0,255))
cprint(C,200,560,"<esc> to end",20,rgba(0,0,0,255))

initfonts(c,"times new roman")
cprint(c,100-x,450," This is times new roman font",40,rgba(0,0,100,255))
cprint(c,100-x+800,450," This is times new roman font",40,rgba(0,0,100,255))
initfonts(c,"comic sans MS")
cprint(c,100,500," This is comic sans MS font",40,rgba(100,0,0,255))
initfonts(c,"courier new")
cprint(c,10,530," This is courier new (everything else is georgia font)",20,rgba(255,255,255,255))
screenunlock
sleep regulate(100,fps)
loop until len(inkey)
sleep
 cairo_destroy(c)

    

It is very quiet.

[srvaldez]

nice :-)

[MrSwiss]

@badidea,

while your clock is looking good, it does however, have a technical problem ...
Looking at your posted pic. I'll try to explain:

• Time shown: 23:46:33
  Minute hand pos. is about half a minute 'off' from where it should be
  (half way to 47)
  Hour hand pos. is about 3/4 of distance 'off' from where it should be
  (~3/4 way to midnight) <--- this is critical for readability!

With analog Clocks it's important (for readability) to do the needed corrections of angles:
for Hour-hand, using hour-part with added Minute offset.
for Minute-hand, using minute-part with added Second offset.

This also leads to a smoother, more continuous movement of the hands.
(you can have the minutes jump by 1, but hour correction is mandatory since,
the hour is mechanically linked to minutes, in a: "forced-follow" method.)

I've got code to show it, but of course in fbGFX2, and not in cairo.

[badidea]

A silly font tester (Windows of course)

? Looks fine on linux

while your clock is looking good, it does however, have a technical problem ...

You are right, clearly not a Swiss precision watch. I'll fix it...