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