Private tempus As Timer
Private dsp As Pointer
Private grcnt As Pointer
Private win As Integer
Private Const dl As Short = 1000
Library "libX11:6.3.0"
Private Const IncludeInferiors As Integer = 1
Private Const CapButt As Integer = 1
Private Const LineSolid As Integer = 0
Private Const JoinRound As Integer = 1
Private Const GXxor As Integer = 6
' Display *XOpenDisplay(char *display_name)
' Opens a connection to the X server that controls a display.
Private Extern XOpenDisplay(display_name As Pointer) As Pointer
' int XDefaultScreen (Display *display)
' returns the default screen number referenced by the XOpenDisplay function.
Private Extern XDefaultScreen(display As Pointer) As Integer
' Window XRootWindow(Display *display, int screen_number)
' Returns the root window.
Private Extern XRootWindow(display As Pointer, screen_number As Integer) As Integer
' GC XCreateGC(Display *display, Drawable d, unsigned long valuemask, XGCValues *values)
' Creates a graphics context and returns a GC.
Private Extern XCreateGC(display As Pointer, d As Integer, valuemask As Long, values As Pointer) As Pointer
' XSetForeground (Display *display, GC gc, unsigned long foreground)
' sets the foreground.
Private Extern XSetForeground(display As Pointer, gc As Pointer, foreground As Long)
' XSetSubwindowMode(Display *display, GC gc, int subwindow_mode)
' Sets the subwindow mode in the specified GC.
Private Extern XSetSubwindowMode(display As Pointer, gc As Pointer, subwindow_mode As Integer)
' XSetLineAttributes(Display *display, GC gc, unsigned int spessore, int line_style, int cap_style, int join_style)
' Sets the line drawing components in the specified GC.
Private Extern XSetLineAttributes(display As Pointer, gc As Pointer, spessore As Integer, line_style As Integer, cap_style As Integer, join_style As Integer)
' int XSetFunction(Display *display, GC gc, int function)
' Sets a specified value in the specified GC.
Private Extern XSetFunction(display As Pointer, gc As Pointer, ifunction As Integer) As Integer
' int XGrabServer(Display *display)
' Disables processing of requests and close downs on all other connections than the one this request arrived on.
Private Extern XGrabServer(display As Pointer) As Integer
' int XDrawArc(Display *display, Drawable d, GC gc, int x, int y, unsigned int width, unsigned int height, int angle1, int angle2)
' Draws a single circular or elliptical arc.
Private Extern XDrawArc(display As Pointer, d As Integer, gc As Pointer, x As Integer, y As Integer, width As Integer, height As Integer, angle1 As Integer, angle2 As Integer) As Integer
' Bool XQueryPointer(Display *display, Window w, Window *root_return, Window *child_return, int *root_x_return, int *root_y_return, int *win_x_return, int *win_y_return, unsigned int *mask_return)
' Returns the root window the pointer is logically on and the pointer coordinates relative to the root window's origin.
Private Extern XQueryPointer(display As Pointer, w As Integer, root_return As Pointer, child_return As Pointer, root_x_return As Pointer, root_y_return As Pointer, win_x_return As Pointer, win_y_return As Pointer, mask_return As Pointer) As Boolean
' int XFlush(Display *display)
' Flushes the output buffer.
Private Extern XFlush(display As Pointer) As Integer
' int XUngrabServer(Display *display)
' Restarts processing of requests and close downs on other connections.
Private Extern XUngrabServer(display As Pointer) As Integer
' int XCloseDisplay(Display *display)
' Closes the connection to the X server for the display specified in the Display structure and destroys all windows.
Private Extern XCloseDisplay(display As Pointer) As Integer
Public Sub Main()
Dim spessore, scr As Integer
' Imposta lo spessore delle linee:
spessore = 6
dsp = XOpenDisplay(0)
If dsp = 0 Then Error.Raise("Impossibile connettersi al server X !")
scr = XDefaultScreen(dsp)
win = XRootWindow(dsp, scr)
' Crea un contesto grafico X:
grcnt = XCreateGC(dsp, win, 0, 0)
If grcnt = 0 Then Error.Raise("Impossibile creare un contesto grafico X !")
XSetForeground(dsp, grcnt, &0000FFFF)
XSetSubwindowMode(dsp, grcnt, IncludeInferiors)
XSetLineAttributes(dsp, grcnt, spessore, LineSolid, CapButt, JoinRound)
XSetFunction(dsp, grcnt, GXxor)
With tempus = New Timer As "Tempus"
.Delay = dl
.Start
End With
End
Public Sub Tempus_Timer()
Dim rag, raggio, dist_archi As Integer
Dim rr, cr, x, y, xr, yr, mr As Integer
Dim sh As Short
raggio = 400
dist_archi = 40
Do
raggio -= dist_archi
If rag Then
XDrawArc(dsp, win, grcnt, x - rag / 2, y - rag / 2, rag, rag, 0, 360 * 64)
Endif
If raggio > 0 Then
XQueryPointer(dsp, win, VarPtr(rr), VarPtr(cr), VarPtr(x), VarPtr(y), VarPtr(xr), VarPtr(yr), VarPtr(mr))
XDrawArc(dsp, win, grcnt, x - raggio / 2, y - raggio / 2, raggio, raggio, 0, 360 * 64)
Endif
XFlush(dsp)
Sleep 0.016
rag = raggio
XUngrabServer(dsp)
Inc sh
If sh = dl Then
sh = 0
XGrabServer(dsp)
Endif
Loop Until raggio < 0
End
Public Sub Application_Read()
Dim s As String
Input s
If s = "q" Then
XUngrabServer(dsp)
XCloseDisplay(dsp)
Quit
Endif
End