Cairo Clock Example

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
lizard
Posts: 406
Joined: Oct 17, 2017 11:35
Location: Germany

Cairo Clock Example

Postby lizard » May 01, 2018 23:22

Ever wondered why the FB Cairo example in

Code: Select all

FreeBASIC-1.05.0-linux-x86/examples/graphics/cairo/clock.bas


not works as expected? There are two little changes necessary:

Code: Select all

'' Cairo clock. Translated from the C example written by Writser Cleveringa
'' Details: http://cairographics.org/documentation/

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

Const SCREEN_W = 400
Const SCREEN_H = 400 ' <------ should be quadratic to make perfect circle

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 surface = _
   cairo_image_surface_create_for_data(ScreenPtr(), _
      CAIRO_FORMAT_ARGB32, SCREEN_W, SCREEN_H, _
      SCREEN_W * 4 )

Dim As cairo_t Ptr c = cairo_create(surface)
cairo_scale(c, SCREEN_W, SCREEN_H)
'' Translate to the center of the rendering context
cairo_translate(c, 0.5, 0.5) ' <------ must be moved here from line 49

Do
   ScreenLock()

   ''
   '' Draw a clock
   ''

   '' compute the angles for the indicators of our clock
   Dim As Double minutes = Minute(Now()) * PI / 30
   Dim As Double hours = Hour(Now()) * PI / 6
   Dim As Double seconds = Second(Now()) * PI / 30

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

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

   '' Draw a black clock outline.
   cairo_set_source_rgba(c, 0, 0, 0, 1)
   'cairo_translate(c, 0.5, 0.5) ' <------ must be moved to line 25
   cairo_arc(c, 0, 0, 0.4, 0, PI * 2)
   cairo_stroke(c)

   '' Draw a white dot on the current second.
   cairo_set_source_rgba(c, 1, 1, 1, 0.6)
   cairo_arc(c, Sin(seconds) * 0.4, -Cos(seconds) * 0.4, 0.05, 0, PI * 2)
   cairo_fill(c)

   '' Draw the minutes indicator
   cairo_set_source_rgba(c, 0.2, 0.2, 1, 0.6)
   cairo_move_to(c, 0, 0)
   cairo_line_to(c, Sin(minutes) * 0.4, -Cos(minutes) * 0.4)
   cairo_stroke(c)

   '' Draw the hours indicator
   cairo_move_to(c, 0, 0)
   cairo_line_to(c, Sin(hours) * 0.2, -Cos(hours) * 0.2)
   cairo_stroke(c)

   ScreenUnlock()

   Sleep 1000
Loop While (Len(Inkey()) = 0)

'' Clean up the cairo context
cairo_destroy(c)


The lib for cairo can be installed under Mint (Ubuntu) with:

Code: Select all

sudo apt-get install libcairo2-dev libcairo2-doc


The other cairo examples are working fantastically. Saves a lot of time to save as .pdf, .png, .svg or .ps.

Edit: Made change after MrSwiss (see below)
Last edited by lizard on May 03, 2018 14:37, edited 1 time in total.
lizard
Posts: 406
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Cairo Clock Example

Postby lizard » May 03, 2018 5:23

Once we have a Cairo context it is easy to insert all the examples from here https://www.cairographics.org/samples/
It is only to put a "dim as" before the variables and delete the ";" at the ends of lines.

Code: Select all

' sphere.bas

' Translated from the C example written by Øyvind Kolås
' Public domain from here
' https://www.cairographics.org/samples/

#include once "cairo/cairo.bi"

Const SCREEN_W = 256
Const SCREEN_H = 256

CONST M_PI = 4 * ATN(1)

ScreenRes SCREEN_W, SCREEN_H, 32

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

dim as cairo_pattern_t ptr pat

pat = cairo_pattern_create_linear (0.0, 0.0,  0.0, 256.0)
cairo_pattern_add_color_stop_rgba (pat, 1, 0, 0, 0, 1)
cairo_pattern_add_color_stop_rgba (pat, 0, 1, 1, 1, 1)
cairo_rectangle (cr, 0, 0, 256, 256)
cairo_set_source (cr, pat)
cairo_fill (cr)
cairo_pattern_destroy (pat)

pat = cairo_pattern_create_radial (115.2, 102.4, 25.6, 102.4,  102.4, 128.0)
cairo_pattern_add_color_stop_rgba (pat, 0, 1, 1, 1, 1)
cairo_pattern_add_color_stop_rgba (pat, 1, 0, 0, 0, 1)
cairo_set_source (cr, pat)
cairo_arc (cr, 128.0, 128.0, 76.8, 0, 2 * M_PI)
cairo_fill (cr)
cairo_pattern_destroy (pat)

ScreenUnlock()

Sleep

' Clean up the cairo context
cairo_destroy(cr)


Edit: Made change after MrSwiss (see below)
Last edited by lizard on May 03, 2018 14:39, edited 2 times in total.
MrSwiss
Posts: 2764
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Cairo Clock Example

Postby MrSwiss » May 03, 2018 11:07

Sorry mate, but your first dim/declaration, shows the opposite (not so easy!).
Since you've promptly stepped into the trap, whenever a lib is written in C.

Most FB users still think, that: int (C) = integer (FB), which is simply not the
case (we are talking about: fixed 32bit sized, data-types):
-C-----FB----------------C------FB
int = long (signed) / uint = ulong (unsigned, aka: 32bit color)

Code: Select all

Dim As cairo_surface_t Ptr surface = cairo_image_surface_create_for_data(ScreenPtr(), _
      CAIRO_FORMAT_ARGB32, SCREEN_W, SCREEN_H, SCREEN_W * SizeOf(Integer))  ' <--- ULong (not Integer)
(it may work well with FBC 32, but in FBC 64, you are allocating 8 Bytes
per Pixel, instead of 4)
Alternative:
instead of: SCREEN_W * SizeOf(Integer), simply write: SCREEN_W * 4
(Which is btw. the same, as what: SCREEN_W * SizeOf(ULong) would be!)
counting_pine
Site Admin
Posts: 5954
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Cairo Clock Example

Postby counting_pine » May 03, 2018 12:55

That mistake was in the official example too, so I guess that makes it "three little changes necessary" then..
lizard
Posts: 406
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Cairo Clock Example

Postby lizard » May 03, 2018 14:24

MrSwiss wrote:instead of: SCREEN_W * SizeOf(Integer), simply write: SCREEN_W * 4
(Which is btw. the same, as what: SCREEN_W * SizeOf(ULong) would be!)

Thanks to point me to this mistake, MrSwiss.

Meanwhile i created another example of my own (with a little help from William).

Code: Select all

' textshake.bas

' FreeBASIC cairo example
' created by lizard

#include once "cairo/cairo.bi"

Const SCREEN_W = 400
Const SCREEN_H = 250

ScreenRes SCREEN_W, SCREEN_H, 32

' 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 canvas = cairo_create(surface)

dim as string shake(...) = {chr(34) & "To be, or not to be, that is the question:", _
"Whether 'tis nobler in the mind to suffer", "The slings and arrows of outrageous fortune,", _
"Or to take arms against a sea of troubles", "And by opposing end them. To die - to sleep..." _
& chr(34), "", "(William Shakespeare)"}   

ScreenLock()

  ' draw the entire context white
  cairo_set_source_rgba(canvas, 1, 1, 1, 1)
  cairo_paint(canvas)

  ' text color, font and size
  cairo_set_source_rgb(canvas, 0.1, 0.1, 0.1)
  cairo_select_font_face(canvas, "Times", CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_BOLD)
  cairo_set_font_size(canvas, 16)
 
  ' draw text
  for i as short = 0 to ubound(shake)
    cairo_move_to(canvas, 20, 30 + i * 30)
    cairo_show_text(canvas, shake(i))
  next i

ScreenUnlock()

' Clean up the cairo context
cairo_destroy(canvas)

sleep
Roland Chastain
Posts: 845
Joined: Nov 24, 2011 19:49
Location: Dakar, Senegal
Contact:

Re: Cairo Clock Example

Postby Roland Chastain » May 03, 2018 14:58

@lizard

Maybe you will be interested in my package of cairo examples. There are some examples that I found in the forum, and some other that I wrote myself.

cairo-examples.zip
lizard
Posts: 406
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Cairo Clock Example

Postby lizard » May 03, 2018 16:23

Thanks Roland! Thats a lot of stuff.
dodicat
Posts: 5162
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Cairo Clock Example

Postby dodicat » May 03, 2018 17:08

Runs on Windows 32 bit.
Should run OK in Roland's folder.
Good timekeeper.

Code: Select all

 



#include "vbcompat.bi"

#include once "cairo/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)
        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
dim as string dt
windowtitle "Cairo clock"
Do
     dt= Format( now, "dd-mmmm-yyyy" )
    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))
    cline(c,(400-4*len(dt)),300,400+4*len(dt)*1.7,300,5,(C,1,0,0,.3),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

 
Roland Chastain
Posts: 845
Joined: Nov 24, 2011 19:49
Location: Dakar, Senegal
Contact:

Re: Cairo Clock Example

Postby Roland Chastain » May 03, 2018 17:34

It's beautiful, I like it. Thank you dodicat.

@lizard
You are welcome. Thank you for sharing your example. Do you know that you can make PDF with cairo?
lizard
Posts: 406
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Cairo Clock Example

Postby lizard » May 03, 2018 17:49

Dodicat, your easycairo.bas and all 8 demos work here on mint, have just tested. And you are the only one who avoided the from MrSwiss mentioned mistake. Almost all other demos have the sizeof(nteger) or len(integer).
lizard
Posts: 406
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Cairo Clock Example

Postby lizard » May 03, 2018 17:50

Roland Chastain wrote:You are welcome. Thank you for sharing your example. Do you know that you can make PDF with cairo?

Yes, that is in the known examples.
lizard
Posts: 406
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Cairo Clock Example

Postby lizard » May 03, 2018 17:56

dodicat wrote:Good timekeeper.

This clock works here, too. I like it that most of your code is platform-indepent. Tested a lot of it.
lizard
Posts: 406
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Cairo Clock Example

Postby lizard » May 05, 2018 10:44

@Roland one of your package is the snowflakes, i haven`t seen before. Just shortened it from five to four flakes, because i couldn`t see a difference between the fourth and the fifth flake.

Code: Select all

' cairo_snowflake.bas

' http://www.informatik.uni-kiel.de/~sb/wissrech/cairo3_recursion.c

#include once "cairo/cairo.bi"

sub snowflake_arm(byval cr as cairo_t ptr, byval l as integer)
  cairo_move_to(cr, 0.0, 0.0)
  cairo_line_to(cr, 0.0, 0.5)
  cairo_stroke(cr)
  if l > 0 then
    cairo_save(cr)
    cairo_translate(cr, 0.0, 0.5)
    cairo_scale(cr, 0.45, 0.45)
    snowflake_arm(cr, l - 1)
    cairo_rotate(cr, 1.2)
    snowflake_arm(cr, l - 1)
    cairo_rotate(cr, -2.4)
    snowflake_arm(cr, l - 1)
    cairo_restore(cr)
  end if
end sub

const pi = 4 * atn(1)
const zoom = 3
const screen_w = zoom * 320
const screen_h = zoom * 80

screenres(screen_w, screen_h, 32)

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()
  cairo_set_source_rgba(cr, 1, 1, 1, 1)
  cairo_paint(cr)
  cairo_set_source_rgba(cr, 0, 0, 0, 1)
  for l as integer = 0 to 3
    cairo_save(cr)
    cairo_translate(cr, zoom * 40.0 + l * zoom * 80.0, zoom * 40.0)
    cairo_scale(cr, zoom * 40.0, zoom * 40.0)
    cairo_set_line_width(cr, 0.01)
    for i as integer = 0 to 4
      cairo_save(cr)
      cairo_rotate(cr, 2.0 * pi * i / 5)
      snowflake_arm(cr, l)
      cairo_restore(cr)
    next i
  cairo_restore(cr)
  next l
screenunlock()

cairo_surface_write_to_png(surface, "snowflake.png")
cairo_destroy(cr)
sleep
Roland Chastain
Posts: 845
Joined: Nov 24, 2011 19:49
Location: Dakar, Senegal
Contact:

Re: Cairo Clock Example

Postby Roland Chastain » May 05, 2018 11:17

I have also made this, which isn't in the package.

Pythagoras tree
Sierpinski triangle

I should update the package, with the latest examples written by dodicat, by you and by me (with your permission of course). :)

I also made many examples in Pascal. I could include them.
jj2007
Posts: 852
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Cairo Clock Example

Postby jj2007 » May 05, 2018 11:42

Do you need to download something to build the examples above?

FreeBasic\bin\win32\ld.exe: cannot find -lcairo

Return to “Tips and Tricks”

Who is online

Users browsing this forum: StringEpsilon and 3 guests