FBC's Cairo clock example error

[dodicat]

Plain no frills cairo clock.

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
'rectangle unused
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

Sub lineto(C As cairo_t Ptr,x1 As Long,y1 As Long,x2 As Long,y2 As Long,L As Single,t As Single,colour As Ulong)
    Dim As Long ox,oy
    Var dx=x2-x1,dy=y2-y1
    Var d=Sqr(dx*dx + dy*dy)
    ox=x1+L*dx/d:oy=y1+L*dy/d
    cline(C,x1,y1,ox,oy,t,colour,false)
End Sub

Sub drawline(C As cairo_t Ptr,x As Integer,y As Integer,angle As Single,length As Long,t As Single,colour As Ulong)
    angle=angle*.0174532925199433  '=4*atn(1)/180
    Var x2=x+length*Cos(angle)
    Var y2=y-length*Sin(angle)
    cline(C,x,y,x2,y2,t,colour,true)
End Sub

Sub dial(C As cairo_t Ptr)
    Dim As Long ctr,L  
    For z As Single=0 To 8*Atn(1)-.1 Step 8*Atn(1)/12
        ctr+=1
        L=Iif(Len(Str(ctr Mod 13))=2,8*2,0)
        cprint(C,400-L+230*Cos(z-2*Atn(1)*(2/3)),8+300+230*Sin(z-2*Atn(1)*(2/3)),Str(ctr Mod 13),40,Rgba(200,0,0,255))
    Next z
    ctr=0
    For z As Single=0 To 8*Atn(1)-.1 Step 8*Atn(1)/60
        lineto(C,410+200*Cos(z),300-10+200*Sin(z),400,300,10,2,Rgba(200,0,200,255))
        If ctr Mod 5=0 Then
            CCircle(C,410+200*Cos(z),300-10+200*Sin(z),3,0,2*pi,2,Rgba(0,200,0,255),false)
            lineto(C,410+200*Cos(z),300-10+200*Sin(z),400,300,20,2,Rgba(200,100,0,255))
        End If
        ctr+=1
    Next z
End Sub

#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c) 
Dim  As  cairo_t Ptr C
C=setscreen(800,600)
Dim As String t,lt,s,m,h
Dim As Single sa,ma,ha
Do
    Screenlock
    Var t=Time 
    If lt<>t Then
        SetBackgroundColour(C,Rgba(0,50,50,255))
        InitFonts(C,"comic sans MS")
        dial(C)
        initfonts(C) 'default times new roman 
        cprint(C,375,200,"Smiths",25,Rgba(200,200,200,255))
        s=Mid(t,7,2):m=Mid(t,4,2):h=Mid(t,1,2)
        sa=map(0,60,Vallng(s),360,0):ma=map(0,60,(Val(m)+Val(s)/60),360,0):ha=map(0,12,(Vallng(h)+Val(m)/60),360,0)
        drawline(C,410,300-10,ha+90,100,9,Rgba(0,200,0,255))
        drawline(C,410,300-10,ma+90,185,5,Rgba(0,200,200,255))
        drawline(C,410,300-10,sa+90,199,2,Rgba(200,200,0,255))
        drawline(C,410,300-10,sa+90+180,15,2,Rgba(200,200,0,255))
    End If
    lt=t
    Screenunlock
    Sleep 100
Loop Until Len(Inkey)


Sleep 

[badidea]

And the Swiss clock with proper hour and minute indicator angles

Code: Select all

#include once "datetime.bi"

#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 time_type
	dim as long ampm, hrs, min, sec
end type

function splitTime(dateTime as double) as time_type
	dim as time_type retVal
	retVal.sec = second(dateTime)
	retVal.min = minute(dateTime)
	retVal.hrs = hour(dateTime)
	if retVal.hrs > 12 then
		retVal.hrs -= 12
		retVal.ampm = 1
	end if
	return retVal
end function

type xy_sgl
	dim as single x, y
end type

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

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 xy_sgl p, secPos, minPos, hrsPos
dim as time_type myTime
dim as single secAngle, minAngle, hrsAngle
dim as single crossSize = 0.25

do
	myTime = splitTime(now())

	secAngle = myTime.sec * PI2 / 60
	minAngle = (myTime.min + myTime.sec / 60) * PI2 / 60
	hrsAngle = (myTime.hrs + myTime.min / 60) * PI2 / 12

	screenlock()

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

	'watch outline circle
	cScreen.cCircleFilled(type(0, 0), 0.45, type(0.8, 0, 0, 1))
	cScreen.cCircleOpen(type(0, 0), 0.45, 0.03, type(0.8, 0.8, 0.8, 1))

	'white cross
	cScreen.cRectFilled(type(-crossSize, -crossSize * (6/20)), _
		type(+crossSize, +crossSize * (6/20)), type(0.8, 0.8, 0.8, 1))
	cScreen.cRectFilled(type(-crossSize * (6/20), -crossSize), _
		type(+crossSize * (6/20), +crossSize), type(0.8, 0.8, 0.8, 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)
		cScreen.cCircleFilled(p, r, type(0.8, 0.8, 0.8, 1))
	next

	'time string text
	cScreen.cTextCentered(type(0, 0), time, 0.09, type(0, 0, 0, 0.6))
	dim as string ampmStr = iif(myTime.ampm = 0 , "AM", "PM")
	cScreen.cTextCentered(type(0, .18), ampmStr, 0.08, type(0, 0, 0, 0.6))
	
	'hours indicator
	hrsPos = clockToCartesian(hrsAngle, 0.2)
	cScreen.cLine(type(0, 0), hrsPos, 0.015, type(0, 0, 0, 0.8))
	cScreen.cLine(type(0, 0), hrsPos, 0.003, type(1, 1, 1, 0.8))

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

	'second indicator
	secPos = clockToCartesian(secAngle, 0.4)
	cScreen.cLine(type(0, 0), secPos, 0.005, type(0, 0, 0, 0.8))
	cScreen.cLine(type(0, 0), secPos, 0.001, type(1, 1, 1, 0.8))

	screenunlock()

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

[MrSwiss]

Really cool (mainly the idea) <lol>

[dodicat]

I have changed my mind about cairo.
With only one dll (~2 mb) from srvaldez to do all the work, it is a nice tool for windows.
The next time I fire up my Linux box I'll try to get cairo from the repository (via yum).
Thank you everybody.

[badidea]

Small improvement. Rotated text + indicators with 'glow in the dark' tritium.

Code: Select all

#include once "datetime.bi"

#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 time_type
	dim as long ampm, hrs, min, sec
end type

function splitTime(dateTime as double) as time_type
	dim as time_type retVal
	retVal.sec = second(dateTime)
	retVal.min = minute(dateTime)
	retVal.hrs = hour(dateTime)
	if retVal.hrs > 12 then
		retVal.hrs -= 12
		retVal.ampm = 1
	end if
	return retVal
end function

type xy_sgl
	dim as single x, y
end type

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

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 xy_sgl p, secPos, minPos, hrsPos
dim as time_type myTime
dim as single secAngle, minAngle, hrsAngle
dim as single crossSize = 0.25

do
	myTime = splitTime(now())

	secAngle = myTime.sec * PI2 / 60
	minAngle = (myTime.min + myTime.sec / 60) * PI2 / 60
	hrsAngle = (myTime.hrs + myTime.min / 60) * PI2 / 12

	screenlock()

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

	r = 0.46
	'watch outline circle
	cScreen.cCircleFilled(type(0, 0), r, type(0.8, 0, 0, 1))
	cScreen.cCircleOpen(type(0, 0), r, 0.06, type(0.8, 0.8, 0.8, 1))

	'hour labes
	for tick as integer = 1 to 12
		cairo_save(cScreen.pCt)
		cairo_rotate(cScreen.pCt, PI2 * tick / 12)
		cScreen.cTextCentered(type(0, -r), str(tick), 0.06, type(0, 0, 0, 0.9))
		cairo_restore(cScreen.pCt)
	next

	'white cross
	cScreen.cRectFilled(type(-crossSize, -crossSize * (6/20)), _
		type(+crossSize, +crossSize * (6/20)), type(0.8, 0.8, 0.8, 1))
	cScreen.cRectFilled(type(-crossSize * (6/20), -crossSize), _
		type(+crossSize * (6/20), +crossSize), type(0.8, 0.8, 0.8, 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)
		cScreen.cCircleFilled(p, r, type(0.8, 0.8, 0.8, 1))
	next

	'time string text
	cScreen.cTextCentered(type(0, 0), time, 0.09, type(0, 0, 0, 0.6))
	dim as string ampmStr = iif(myTime.ampm = 0 , "AM", "PM")
	cScreen.cTextCentered(type(0, .18), ampmStr, 0.08, type(0, 0, 0, 0.6))
	
	'hours indicator
	hrsPos = clockToCartesian(hrsAngle, 0.2)
	cScreen.cLine(type(0, 0), hrsPos, 0.015, type(0, 0, 0, 0.8))
	cScreen.cLine(type(0, 0), hrsPos, 0.003, type(0.5, 1, 0, 0.8))

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

	'second indicator
	secPos = clockToCartesian(secAngle, 0.4)
	cScreen.cLine(type(0, 0), secPos, 0.005, type(0, 0, 0, 0.8))
	cScreen.cLine(type(0, 0), secPos, 0.001, type(0.5, 1, 0, 0.8))

	screenunlock()

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

I see that it is time to go to bed.

[dodicat]

I tried to install cairo on scientific linux (Red hat).
I did su - to root in the terminal, typed yum install cairo.
I got about 8 MB in total of downloaded files, then at the last bit the terminal said: cairo latest version already installed, nothing to do.
Needless to say cairo doesn't work.
(32 bit OS)
Anyway, I have made my Smiths no frills clock run smoothly (as the old electric clocks).
If you move the screen around it'll jump a bit to catch up.
I got it down to about 14% cpu without destroying the smoothness.
If I use sleep 1 it uses about 30% cpu.

Code: Select all

 
#include once "cairo/cairo.bi" 
#define _rd_ Cast(Ubyte Ptr,@colour)[2]/255
#define _gr_ Cast(Ubyte Ptr,@colour)[1]/255
#define _bl_ Cast(Ubyte Ptr,@colour)[0]/255
#define _al_ Cast(Ubyte Ptr,@colour)[3]/255

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)
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_show_text(surf, text)
    cairo_stroke(surf)
End Sub
'rectangle unused
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))
    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))
    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))
    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)
    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

Sub lineto(C As cairo_t Ptr,x1 As Long,y1 As Long,x2 As Long,y2 As Long,L As Single,t As Single,colour As Ulong)
    Dim As Long ox,oy
    Var dx=x2-x1,dy=y2-y1
    Var d=Sqr(dx*dx + dy*dy)
    ox=x1+L*dx/d:oy=y1+L*dy/d
    cline(C,x1,y1,ox,oy,t,colour,false)
End Sub

Sub drawline(C As cairo_t Ptr,x As Long,y As Long,angle As Single,length As Long,t As Single,colour As Ulong,Byref x2 As Long=0,Byref y2 As Long=0)
    angle=angle*.0174532925199433  '=4*atn(1)/180
    x2=x+length*Cos(angle)
    y2=y-length*Sin(angle)
    cline(C,x,y,x2,y2,t,colour,true)
End Sub

Sub dial(C As cairo_t Ptr)
    Dim As Long ctr,L  
    For z As Single=0 To 8*Atn(1)-.1 Step 8*Atn(1)/12
        ctr+=1
        L=Iif(Len(Str(ctr Mod 13))=2,8*2,0)
        cprint(C,400-L+230*Cos(z-2*Atn(1)*(2/3)),8+300+230*Sin(z-2*Atn(1)*(2/3)),Str(ctr Mod 13),40,Rgba(200,0,0,255))
    Next z
    ctr=0
    For z As Single=0 To 8*Atn(1)-.1 Step 8*Atn(1)/60
        lineto(C,410+200*Cos(z),300-10+200*Sin(z),400,300,10,2,Rgba(200,0,200,255))
        If ctr Mod 5=0 Then
            CCircle(C,410+200*Cos(z),300-10+200*Sin(z),3,0,2*pi,2,Rgba(0,200,0,255),false)
            lineto(C,410+200*Cos(z),300-10+200*Sin(z),400,300,20,2,Rgba(200,100,0,255))
        End If
        ctr+=1
    Next z
End Sub

Function start As Long
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c) 
    Dim  As  cairo_t Ptr C
    C=setscreen(800,600)
    Dim As String t,lt,s,m,h
    Dim As Single sa,ma,ha
    Dim As Double offset
    Do
        Screenlock
        Var t=Time 
        SetBackgroundColour(C,Rgba(0,50,50,255))
        InitFonts(C,"comic sans MS")
        dial(C)
        initfonts(C) 'default times new roman 
        cprint(C,375,200,"Smiths",25,Rgba(200,200,200,255))
        s=Mid(t,7,2):m=Mid(t,4,2):h=Mid(t,1,2)
        If lt<>t Then offset=Timer
        sa=map(0,60,(Vallng(s)+(Timer)-offset),360,0):ma=map(0,60,(Val(m)+Val(s)/60),360,0):ha=map(0,12,(Vallng(h)+Val(m)/60),360,0)
        drawline(C,410,300-10,ha+90,100,9,Rgba(0,200,0,255))
        drawline(C,410,300-10,ma+90,185,5,Rgba(0,200,200,255))
        drawline(C,410,300-10,sa+90,199,2,Rgba(200,200,0,255))
        drawline(C,410,300-10,sa+90+180,15,4,Rgba(200,200,0,255))
        lt=t
        Screenunlock
        Sleep 10,1
    Loop Until Len(Inkey)
    Return 0
End Function

End start
Sleep
 

[badidea]

I got about 8 MB in total of downloaded files, then at the last bit the terminal said: cairo latest version already installed, nothing to do. Needless to say cairo doesn't work. (32 bit OS)

Then the stuff is probably installed, but the linker cannot find it.
I might have the same issue with the 32-bit libs. Still have to look into this...
Or some additional 'devel' libs are needed. Cairo website is broken at the moment, cannot check things there. 'cairo-devel' maybe.

Anyway, nice smooth second indicator.

[St_W]

What is the process to get this example (and maybe many more) fixed? Create a GitHub account? I have not worked with GitHub before.

1. Prerequisites:
   - a GitHub account and
   - a Git client installed on your PC
2. Fork the official FreeBasic repository https://github.com/freebasic/fbc (button on the top right of the page). You'll have a copy of the repository then in your account.
3. Clone the repository you just forked on your local machine. If you're using a command line git client use: git clone https://github.com/<your-github-account-name>/fbc. You can find out the correct URL by clicking on the green "Clone or Download" button when viewing your fork of fbc on GitHub.
4. Before you start performing your changes it's recommended to create a branch for your changes (even if it's very small change). You can create a branch & switch to that branch using git checkout -b <branch_name>. An example name could e.g. be "fix/stw/cairo-clock-example".
5. Now you can perform changes, e.g. fix the example shipped with fbc. After you changed the source files and tested your changes you've to add & commit your changes to the local repository on your machine and then back all the way to your fork on GitHub and finally to the official fbc repository on GitHub. Use git add <file/directory> followed by git commit -m <message> to store the changes in your local repository on your machine. An example commit message could be e.g. "fix cairo clock example".
6. Having the changes in your local repository you need to upload them back on GitHub. Use this command to upload your new branch to your fork on GitHub: git push -u origin <branch-name>. Use the same branch name as when creating it two steps earlier.
7. Finally you can ask the fbc developers to include your changes in the official fbc repository. This is done by a submitting a "pull request". Got to your fork's page on GitHub, select your new branch and click "Create pull request". Add a meaningful description and review your changes. Also check that source and target of your pull request is correct: It should show something like this: [base repository: freebasic/fbc] [base: master] <-- [head repository: <username>/fbc] [compare: <branch-name>].
8. The fbc developers will then review your changes and include them in the official fbc repository if everything is fine. They may also add comments to your pull request and ask for changes, cleanup or reasons for your change in case of unclarities.

Especially if you're a beginner I recommend installing and using a graphical git client. GitHub has it's own one, I can also recommend SmartGit (non-commercial use only) or SourceTree. If you're used to explorer integration (e.g. from TortoiseSVN) you'll probably like GitExtension. You can find more on https://git-scm.com/downloads/guis

[badidea]

GitHub account created. I'll play with a project of my own first.

Git-clients tried so far from Ubuntu repository:
* Giggle : Seems like a piece of crap, no useful help, absolutely no idea how use it.
* gitg : Also seems like a piece of crap, on first run never ending stream of GTK errors, broken help link, most stuff just seems missing.
* Git-Cola : Seems better, but still no idea how to use it. Maybe I first have to read what 'fetch', 'push', 'pull', 'stash', 'stage', etc. means.

[Knatterton]

Maybe somebody is interested, i still have a few simple examples like this:

Code: Select all

#include once "cairo/cairo.bi"

Const SCREEN_W = 512
Const SCREEN_H = 128

ScreenRes SCREEN_W, SCREEN_H, 32
windowtitle "Operations"

' 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 light gray
cairo_set_source_rgba(cr, 0.9, 0.9, 0.9, 1)
cairo_paint(cr)

sub do_drawing(cr as cairo_t ptr, x as long,  w as long, h as long, op as cairo_operator_t)

  dim as cairo_t ptr first_cr, second_cr
  dim as cairo_surface_t ptr first, second_

  first = cairo_surface_create_similar(cairo_get_target(cr), CAIRO_CONTENT_COLOR_ALPHA, w, h)

  second_ = cairo_surface_create_similar(cairo_get_target(cr),  CAIRO_CONTENT_COLOR_ALPHA, w, h)

  ScreenLock
    first_cr = cairo_create(first)
    cairo_set_source_rgb(first_cr, 0, 0.5, 0.7)
    cairo_rectangle(first_cr, x, 20, 50, 50)
    cairo_fill(first_cr)
    
    second_cr = cairo_create(second_)
    cairo_set_source_rgb(second_cr, 0.4, 0.8, 0)
    cairo_rectangle(second_cr, x+10, 40, 50, 50)
    cairo_fill(second_cr)
    
    cairo_set_operator(first_cr, op)
    cairo_set_source_surface(first_cr, second_, 0, 0)
    cairo_paint(first_cr)
    
    cairo_set_source_surface(cr, first, 0, 0)
    cairo_paint(cr)
    
    cairo_surface_destroy(first)
    cairo_surface_destroy(second_)
    
    cairo_destroy(first_cr)
    cairo_destroy(second_cr)
  ScreenUnlock

end sub

  
dim as cairo_operator_t oper(5) = { CAIRO_OPERATOR_DEST_OVER, CAIRO_OPERATOR_DEST_IN, _
  CAIRO_OPERATOR_OUT, CAIRO_OPERATOR_ADD, CAIRO_OPERATOR_ATOP, CAIRO_OPERATOR_DEST_ATOP }
  
dim as long x = 20, y = 20

for i as short = 0 to 5
  do_drawing(cr, x, SCREEN_W, SCREEN_H, oper(i))
  x += 80
next i


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

Sleep

It just shows six bllitting modes with different logical operators (AND, OR, XOR...) like we know from many graphics systems.

[dodicat]

Tried rotating fonts.
I am going by results of google search for this, but the rotations seem very cpu hungry.
Perhaps there is a better way.

Code: Select all

#include once "cairo/cairo.bi" 
#define _rd_ Cast(Ubyte Ptr,@colour)[2]/255
#define _gr_ Cast(Ubyte Ptr,@colour)[1]/255
#define _bl_ Cast(Ubyte Ptr,@colour)[0]/255
#define _al_ Cast(Ubyte Ptr,@colour)[3]/255

Dim Shared As cairo_font_extents_t _fonts  
Dim Shared As cairo_text_extents_t _text
Const pi=4*Atn(1)

Type ball
    x As Single    'position x component
    y As Single    'position y component
    dx As Single   'velocity x component
    dy As Single   'velocity y component
    a As Single     'angular distance
    da As Single   'angular speed
    col As Ulong   'colour
    col2 As Ulong  'contrast to col (for ball text)
    As Long r,m    'radius, mass
End Type

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,x,y+size/2)
    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))
    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 Crectanglefill(surf As cairo_t Ptr,x As Long,y As Long,wide As Long,high As Long,colour As Ulong)
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_rectangle(surf,(x),(y),(wide),(high))
    cairo_fill(surf)
    cairo_stroke(surf)
End Sub

Sub Ccircle(Byref 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))
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_arc(surf,(cx),(cy),(radius-thickness/2),(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 Ccirclefill(Byref surf As cairo_t Ptr,cx As Long,cy As Long,radius As Long,colour As Ulong)
    cairo_set_line_width(surf,(1))
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_arc(surf,(cx),(cy),(radius),(0),(2*pi))
    cairo_fill(surf)
    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))
    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)
    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

Sub Rotate_texture(c As cairo_t Ptr,xpos As Single,ypos As Single,size As Single,col1 As Ulong,col2 As Ulong,an As Single,num As Long=0)
    ccircle(c,xpos,ypos,size,0,2*pi,size/7,col1,false)
    Var l=2+size/2
    'handle rotating fonts
    'an=0  'uncheck for no rotation
    cairo_save(c)
    Var tx=xpos-l,ty=ypos-l/2
    cairo_translate(c,xpos,ypos)
    cairo_rotate(c, an)
    cairo_translate(c,-xpos,-ypos)
    cprint(c,tx,ty,Right("00"+Str(num),2),size,col2)
    cline(c,xpos-size/2,ypos+size/2,xpos+size/2,ypos+size/2,size/10,col2,true)
    cairo_restore(c) 
    'done
End Sub

Sub MoveAndDraw(c As cairo_t Ptr, b() As ball,Byref e As Long,Byref ae As Long,i As Any Ptr=0)'get energy also
    For n As Long=Lbound(b) To Ubound(b)
        b(n).x+=b(n).dx:b(n).y+=b(n).dy
        b(n).a+=b(n).da*(1/b(n).r)
        Rotate_texture(c,b(n).x,b(n).y,b(n).r,b(n).col2,b(n).col,b(n).a,n)
        e+=.5*b(n).m*(b(n).dx*b(n).dx + b(n).dy*b(n).dy)
        ae+=b(n).da*b(n).da
    Next n
End Sub

Sub edges(b() As ball,xres As Long,yres As Long,Byref status As Long ) 'get status also
    For n As Long=Lbound(b) To Ubound(b) 
        If(b(n).x<b(n).r) Then b(n).x=b(n).r: b(n).dx=-b(n).dx:b(n).da=Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dy)
        If(b(n).x>xres-b(n).r )Then b(n).x=xres-b(n).r: b(n).dx=-b(n).dx:b(n).da=-Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dy)
        
        If(b(n).y<b(n).r)Then b(n).y=b(n).r:b(n).dy=-b(n).dy:b(n).da=-Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dx)
        If(b(n).y>yres-b(n).r)Then  b(n).y=yres-b(n).r:b(n).dy=-b(n).dy:b(n).da=Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dx)
        If b(n).x<0 Or b(n).x>xres Then status=0
        If b(n).y<0 Or b(n).y>yres Then status=0
    Next n
End Sub

Function DetectBallCollisions( B1 As ball,B2 As ball) As Single 'avoid using sqr if they are well seperated
    Dim As Single xdiff = B2.x-B1.x
    Dim As Single ydiff = B2.y-B1.y
    If Abs(xdiff) > (B2.r+B1.r) Then Return 0
    If Abs(ydiff) > (B2.r+B1.r) Then Return 0
    Var L=Sqr(xdiff*xdiff+ydiff*ydiff)
    If L<=(B2.r+B1.r) Then Function=L Else Function=0
End Function

'sub handle_anglular_velocity(
#include "crt.bi"
Sub BallCollisions(b() As ball)
    For n1 As Long=Lbound(b) To Ubound(b)-1
        For n2 As Long=n1+1 To Ubound(b)
            Dim As Single  L= DetectBallCollisions(b(n1),b(n2))
            If L Then
                
                
                Dim As Single  impulsex=(b(n1).x-b(n2).x)/L
                Dim As Single  impulsey=(b(n1).y-b(n2).y)/L
                'set one ball to nearest non overlap position
                b(n1).x=b(n2).x+(b(n2).r+b(n1).r)*impulsex
                b(n1).y=b(n2).y+(b(n2).r+b(n1).r)*impulsey
                
                Dim As Single  impactx=b(n1).dx-b(n2).dx
                Dim As Single  impacty=b(n1).dy-b(n2).dy
                
                Dim As Single  dot=impactx*impulsex+impacty*impulsey
                Dim As Single  mn2=b(n1).m/(b(n1).m+b(n2).m),mn1=b(n2).m/(b(n1).m+b(n2).m)
                
                b(n1).dx-=dot*impulsex*2*mn1 
                b(n1).dy-=dot*impulsey*2*mn1 
                b(n2).dx+=dot*impulsex*2*mn2 
                b(n2).dy+=dot*impulsey*2*mn2 
                'handle rotating angles
                Var v1=Sqr(b(n1).dx^2 + b(n1).dy^2)
                Var v2=Sqr(b(n2).dx^2 + b(n2).dy^2)
                b(n1).da=-v1
                b(n2).da=-v2
                
                Swap b(n1).da,b(n2).da
                b(n1).da*=mn1'apply weights
                b(n2).da*=mn2
                
            End If
        Next n2
    Next n1
End Sub

Sub circles(numballs As Long,OutsideRadius As Long,cx As Long,cy As Long,a() As ball)
    Redim a(1 To numballs+1)
    Dim As Double r,bigr,num,x,y,k=OutsideRadius
    #define rad *pi/180  
    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 To 2*pi Step 2*pi/numballs
        counter+=1
        x=cx+bigr*Cos(z)
        y=cy+bigr*Sin(z)
        If counter>numballs Then Exit For
        a(counter).x=x
        a(counter).y=y
        a(counter).r=r
    Next z
    
    a(Ubound(a)).x=cx
    a(Ubound(a)).y=cy
    a(Ubound(a)).r=OutsideRadius-r*2-2
End Sub

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 contrast(c As Ulong) As Ulong
    #define Intrange(f,l) Int(Rnd*((l+1)-(f))+(f))
    'get the rgb values
    Dim As Ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2
    Do
        r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)
        'get at least 120 ubyte difference
    Loop Until Abs(r-r2)>120 Andalso Abs(g-g2)>120 Andalso Abs(b-b2)>120
    Return Rgb(r2,g2,b2) 
End Function

Function start As Long
    Dim As cairo_t Ptr c=setscreen(1024,768)
    initfonts(c)
    Dim As Integer xres,yres
    Screeninfo xres,yres
    Dim As Long energy,angenergy,status=1,fps
    'set up some balls
    Redim As ball b()
    circles(15,200,xres/3,yres/2,b())
    Redim Preserve b(Lbound(b) To Ubound(b)+2)'add two rxtras
    b(Ubound(b)).x=700: b(Ubound(b)).y=300:b(Ubound(b)).r= 60
    b(Ubound(b)-1).x=700: b(Ubound(b)-1).y=600:b(Ubound(b)-1).r= 80
    Randomize 2
    For n As Long=Lbound(b) To Ubound(b)
        With b(n)
            .dx=0
            .dy=0
            .col=Rgb(Rnd*255,Rnd*255,Rnd*255)
            .col2=contrast(.col)
            '.r (determined in circles sub)
            .m=.r*.r
        End With
    Next
    cprint(c,10,30,"Press a key",30,Rgba(255,255,255,255))
    'done
    Screenlock
    MoveAndDraw(c,b(),0,0)'first view (static)
    Screenunlock
    Sleep
    b(1).dx=12 'set system alive
    While 1
        energy=0
        AngEnergy=0
        edges(b(),xres,yres,status)
        BallCollisions(b())
        Screenlock
        Cls
        MoveAndDraw(c,b(),energy,AngEnergy)
        cprint(c,50, 10, " Press escape key to end", 30, Rgb(255, 200, 0))
        cprint(c,50, 55, "framerate " &fps , 30, Rgb(0, 200, 0))
        cprint(c,50,100,"Kinetic energy  " &energy,30,Rgba(200,200,200,255))
        cprint(c,50,140,"Angular energy  " & AngEnergy,30,Rgba(200,200,200,255))
        cprint(c,50,190,"System status " & Iif(status,"OK","Leaks"),30,Rgba(200,0,0,255))
        Screenunlock
        Sleep regulate(60,fps)
        If Inkey=Chr(27) Then Exit While
    Wend
    Return 0
End Function

End start


  

[Knatterton]

Great demo! Mine is much simpler.

Code: Select all

#include once "cairo/cairo.bi"

Const SCREEN_W = 500
Const SCREEN_H = 500

CONST M_PI = 4 * ATN(1)

ScreenRes SCREEN_W, SCREEN_H, 32
windowtitle " Cairo Text Rotate"

' 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)

ScreenLock

	' draw the entire context blue
	cairo_set_source_rgb(cr, 0.1, 0.1, 0.9)
	cairo_paint(cr)
	
	' yellow text
	cairo_set_font_size(cr, 40.0)
    cairo_set_source_rgb(cr, 0.9, 0.9, 0.1)
	cairo_select_font_face (cr, "arial", CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_NORMAL)
	
	' rotate, center at beginning
	cairo_move_to(cr, 250, 250)
	
	for i as long = 0 to 360 step 45
	cairo_save(cr)
	cairo_move_to(cr, 250, 250) 
	cairo_rotate(cr, i * M_PI/180)
	cairo_show_text(cr, "   cairo   ")
	cairo_restore(cr)
	next i

	' red text
	cairo_set_font_size(cr, 22.0)
	cairo_set_source_rgb(cr, 1, 0.1, 0.1)
	cairo_select_font_face (cr, "Garamond", CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_BOLD)
	
	' rotate, center at end
	cairo_move_to(cr, 175, 65)
	
	for i as long = 0 to 360 step 45
	  cairo_save(cr)
	  cairo_rotate(cr, i * M_PI / 180)
	  cairo_show_text(cr, " FreeBASIC ")
	  cairo_restore(cr)
	next i

ScreenUnlock

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

sleep

[badidea]

Tried rotating fonts.
I am going by results of google search for this, but the rotations seem very cpu hungry.
Perhaps there is a better way.

At 60 fps 34% load on 1 CPU-core here.
Your energy calculation seems incorrect. The total energy in the system should be a constant.
Do you include energy in the form of (spring) compression? No compression I see now.
The kinetic energy should be divided by the time step (v = dx / dt) to get E_kin = 1/2 * m * v^2
The angular energy calculation should include 'angular mass' (or https://en.wikipedia.org/wiki/Moment_of_inertia). (2/5) * m * R^2 for a sphere.
Actually, they are considered both as parts of the kinetic energy, see last formula in this section: https://en.wikipedia.org/wiki/Moment_of ... c_energy_2
But how the call the energy parts individually, I don't know.
Linear kinetic energy and Rotational kinetic energy (http://hyperphysics.phy-astr.gsu.edu/hb ... we.html#ro)

[dodicat]

Badidea
The linear kinetic energy is zeroed then summed for every loop
Ke+=.5*m*v^2
It just accumulates for each ball per loop.
It is very nearly constant, fluctuating 1 to 3 parts in about 78402.
Main thing, it doesn't fizzle away or get bigger and bigger (runaway).
The linear maths are OK.
The angular maths are a fudge, I was more interested in getting a text rotation in situ (on the ball).
But I simply use (angular velocity)^2 to show it.
I shall have a shot at correct angular transfer.
But it will also be a fudge because I assume frictionless motion and no momentum loss for linear collisions, but if angular motion is transferred between the balls then friction is implied.
So we have a closed system where all friction is concentrated in rotation and the balls still have to keep turning.


Thanks Knatterton, I see you use moveto and not translate.

[Knatterton]

Very few seem to actually use cairo. I have searched with google several times, but mostly there is only this dozen examples from the cairo page. One of them is the "mesh pattern".

Code: Select all

#include once "cairo/cairo.bi"

#define SetSourceColor(cairo, colour) cairo_set_source_rgb(cairo, _ 
(colour and &hFF0000) / &hFF0000, (colour and &h00FF00) / &h00FF00, (colour and &h0000FF) / &h0000FF)

const screen_w = 256
const screen_h = 256

screenres screen_w, screen_h, 32
windowtitle "Mesh Patterns"

' 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)
dim as short i

screenlock

cairo_save(cr)
cairo_set_source_rgb(cr,0.8,0.8,0.8)    ' light gray
cairo_rectangle(cr,0.0,0.0,256.0,256.0) ' background
cairo_fill(cr)
cairo_restore(cr)

cairo_save(cr) 

	dim as long PAT_WIDTH  = 170, 	PAT_HEIGHT = 170, 	SIZE = PAT_WIDTH, 	PAD = 2
	dim as long WIDTHS = (PAD + SIZE + PAD), 	HEIGHT = WIDTHS

	dim as cairo_pattern_t ptr pattern = cairo_pattern_create_mesh ()

	'cairo_test_paint_checkered (cr) 

	cairo_translate(cr, PAD, PAD) 
	cairo_translate(cr, 10, 10) 

	cairo_mesh_pattern_begin_patch(pattern) 

	cairo_mesh_pattern_move_to(pattern, 0, 0) 
	cairo_mesh_pattern_curve_to(pattern, 30, -30,  60,  30, 100, 0) 
	cairo_mesh_pattern_curve_to(pattern, 60,  30, 130,  60, 100, 100) 
	cairo_mesh_pattern_curve_to(pattern, 60,  70,  30, 130,   0, 100) 
	cairo_mesh_pattern_curve_to(pattern, 30,  70, -30,  30,   0, 0) 

	cairo_mesh_pattern_set_corner_color_rgb(pattern, 0, 1, 0, 0) 
	cairo_mesh_pattern_set_corner_color_rgb(pattern, 1, 0, 1, 0) 
	cairo_mesh_pattern_set_corner_color_rgb(pattern, 2, 0, 0, 1) 
	cairo_mesh_pattern_set_corner_color_rgb(pattern, 3, 1, 1, 0) 

	cairo_mesh_pattern_end_patch(pattern) 

	cairo_mesh_pattern_begin_patch(pattern) 

	cairo_mesh_pattern_move_to(pattern, 50, 50) 
	cairo_mesh_pattern_curve_to(pattern,  80,  20, 110,  80, 150, 50) 
	cairo_mesh_pattern_curve_to(pattern, 110,  80, 180, 110, 150, 150) 
	cairo_mesh_pattern_curve_to(pattern, 110, 120,  80, 180,  50, 150) 
	cairo_mesh_pattern_curve_to(pattern,  80, 120,  20,  80,  50, 50) 

	cairo_mesh_pattern_set_corner_color_rgba(pattern, 0, 1, 0, 0, 0.3) 
	cairo_mesh_pattern_set_corner_color_rgb(pattern, 1, 0, 1, 0) 
	cairo_mesh_pattern_set_corner_color_rgba(pattern, 2, 0, 0, 1, 0.3) 
	cairo_mesh_pattern_set_corner_color_rgb(pattern, 3, 1, 1, 0) 

	cairo_mesh_pattern_end_patch(pattern) 

	cairo_set_source(cr, pattern) 
	cairo_paint(cr) 
	'cairo_pattern_destroy (pattern) 

screenunlock

' write output
cairo_surface_write_to_png (surface, "meshpattern.png")

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

sleep