|
Post by vovchik on Feb 3, 2014 22:36:05 GMT 1
Dear Joe, Your fix worked for the Grandchild prog, and I think Peter's next beta may solve the lib location problem for good. Thanks... With kind regards, vovchik
|
|
|
Post by alexfish on Feb 15, 2014 19:01:59 GMT 1
Hi All
This demo is a test card for X11 + cairo double buffering
Set up = Main Window as in create Main Top Level , + add child window , ' this could be a widget !'
Set up cairo surfaces on the Create Back Buffers , Draw cairo rectangles on the back buffers then Swap the buffers
Do not Blink as it has an amazing turn of pace , the delay is set to 10 msec , draws and swaps 2 back buffers in between
tested on atom and CPU usage , looks like what I expected from cairo + low but still fast on blitting'
Here We go + have Fun Alex
'@ cairo double buffering X11 test card
PRAGMA LDFLAGS `pkg-config --cflags --libs x11 --libs xext --libs cairo`
PRAGMA INCLUDE /usr/include/X11/Xlib.h PRAGMA INCLUDE /usr/include/X11/Xutil.h PRAGMA INCLUDE /usr/include/X11/keysym.h PRAGMA INCLUDE /usr/include/X11/extensions/Xdbe.h PRAGMA INCLUDE cairo.h PRAGMA INCLUDE cairo-xlib.h
'@ Cairo bits PROTO cairo_reference PROTO cairo_xlib_surface_create PROTO cairo_xlib_surface_create_for_bitmap PROTO cairo_xlib_surface_set_size PROTO cairo_xlib_surface_get_display PROTO cairo_xlib_surface_get_screen PROTO cairo_xlib_surface_set_drawable PROTO cairo_xlib_surface_get_drawable PROTO cairo_xlib_surface_get_visual PROTO cairo_xlib_surface_get_width PROTO cairo_xlib_surface_get_heigh PROTO cairo_xlib_surface_get_depth PROTO cairo_surface_flush PROTO cairo_create PROTO cairo_rectangle PROTO cairo_set_source_rgb PROTO cairo_fill PROTO cairo_move_to PROTO cairo_set_source_rgb PROTO cairo_show_text PROTO cairo_show_page PROTO cairo_destroy PROTO cairo_surface_destroy PROTO cairo_set_font_size PROTO cairo_line_to PROTO cairo_save PROTO cairo_set_line_width PROTO cairo_stroke DECLARE *cs TYPE cairo_surface_t DECLARE *cs_child_win TYPE cairo_surface_t
'@ X11 bits PROTO XStoreName PROTO DefaultScreen PROTO XCreateSimpleWindow PROTO RootWindow PROTO XSelectInput PROTO XMapWindow PROTO XNextEvent PROTO XFillRectangle PROTO XDrawString PROTO XCloseDisplay PROTO XFlush PROTO XCreateWindow PROTO DefaultRootWindow PROTO XNextEvent PROTO XSetForeground PROTO XClearWindow
'@ setting Attributes '@ for delete event PROTO XInternAtom PROTO XSetWMProtocols PROTO Atom
PROTO GC PROTO XGCValues PROTO XdbeSwapBuffers PROTO XSetWindowAttributes
'@ for double buffering PROTO XdbeBackBuffer PROTO XdbeQueryExtension PROTO XdbeUndefined PROTO XdbeAllocateBackBufferName PROTO XdbeGetBackBufferAttributes PROTO XSetInputFocus PROTO XFreeGC '---pointer to X Display structure
DECLARE attributes TYPE XSetWindowAttributes '---pointer to the newly created window DECLARE w TYPE Window '---pointer to the XEvent DECLARE e TYPE XEvent '--- number of screen to place the window on DECLARE s TYPE int
'@ for double buffer DECLARE major, minor TYPE int
PROTO XdbeBackBuffer PROTO XdbeSwapInfo PROTO XdbeBackBufferAttributes DECLARE d_backBuf TYPE XdbeBackBuffer DECLARE *backAttr TYPE XdbeBackBufferAttributes DECLARE swapInfo TYPE XdbeSwapInfo DECLARE d_backBuf2 TYPE XdbeBackBuffer DECLARE *backAttr2 TYPE XdbeBackBufferAttributes DECLARE swapInfo2 TYPE XdbeSwapInfo
SUB PIXEL_2(cairo_surface_t *cs,double xpos,double ypos)
LOCAL *c TYPE cairo_t LOCAL t ,ty ,c_col TYPE double
c=cairo_create(cs) cairo_set_source_rgb(c,1.0, 1.0,1.0) cairo_rectangle(c, 0, 0,600, 400) cairo_fill(c)
cairo_rectangle(c, xpos, ypos,32.0,32.0) c_col = (double)(RANDOM(100))/100 c_col2= (double)(RANDOM(100))/100 cairo_set_source_rgb(c,c_col, c_col2, c_col) cairo_fill(c) cairo_surface_flush(cs) cairo_destroy(c)
END SUB
ISDO = 0
SUB DRAW_1(cairo_surface_t *cs,double xpos,double ypos)
LOCAL *c TYPE cairo_t LOCAL t ,ty ,c_col TYPE double LOCAL ttime
c=cairo_create(cs) cairo_set_source_rgb(c,1.0, 1.0,1.0) cairo_rectangle(c, 0, 0,600, 400) cairo_fill(c)
FOR t = 0 TO 350 STEP 50.0 ISDO = 1 FOR ty= 0 TO 550 STEP 50.0 cairo_rectangle(c, ty, t,50.0, 50.0) c_col = (double)(RANDOM(32)) c_col2= (double)(RANDOM(32)) c_col3= (double)(RANDOM(32)) cairo_set_source_rgb(c,c_col, c_col2, c_col3) cairo_fill(c) NEXT NEXT cairo_surface_flush(cs) cairo_destroy(c) ISDO = 0 END SUB
SUB DRAW_2(cairo_surface_t *cs,double xpos,double ypos)
LOCAL *c TYPE cairo_t LOCAL t ,ty ,c_col TYPE double LOCAL ttime
c=cairo_create(cs) cairo_set_source_rgb(c,0.0, 1.0,0.0) cairo_rectangle(c, 0, 0,200, 200) cairo_fill(c)
FOR t = 0 TO 200 STEP 10.0 ISDO = 1 FOR ty= 0 TO 200 STEP 10.0 cairo_rectangle(c, ty, t,10.0, 10.0) c_col = (double)(RANDOM(32)) c_col2= (double)(RANDOM(32)) c_col3= (double)(RANDOM(32)) cairo_set_source_rgb(c,c_col,c_col2, c_col3) cairo_fill(c) NEXT NEXT cairo_surface_flush(cs) cairo_destroy(c) ISDO = 0 END SUB
'@ for display DECLARE d TYPE Display* 'Display *display d = XOpenDisplay(NULL) s = DefaultScreen(d) root = DefaultRootWindow(d)
'@ for Main
attributes.event_mask = KeyPressMask | KeyReleaseMask | KeymapStateMask | ButtonPressMask | ButtonReleaseMask | EnterWindowMask | LeaveWindowMask | ExposureMask | VisibilityChangeMask | StructureNotifyMask | SubstructureNotifyMask | SubstructureRedirectMask | FocusChangeMask /* Various window attributes */ attributes.backing_store = Always attributes.save_under = True attributes.override_redirect = False attributes.background_pixel = WhitePixel(d, s) '@ Creat main window w = XCreateWindow( d, root, 0, 0, 600, 400, 0,CopyFromParent, InputOutput, CopyFromParent,CWBackingStore|CWOverrideRedirect|CWEventMask|CWSaveUnder|CWBackPixel,&attributes ) XStoreName(d, w, "X11+ Cairo double buffer / Press key to Exit") '@ create a sub window , have used this since can use as widget + can make easy detection for collisions using animation child_win = XCreateSimpleWindow(d, w, 50,50, \ 200, 200, \ 2, \ WhitePixel(d, s), \ BlackPixel(d, s)) '@ set som WM protocols , although they do not work have left code as is DECLARE wmProtocols[3] TYPE Atom DECLARE wmDeleteWindow TYPE Atom DECLARE wmTakeFocus TYPE Atom '@ think possible have a bacon problem with arrays but not sure the delete event is def not working but press any key to esc wmProtocols[0] = XInternAtom(d, "WM_PROTOCOLS", True) wmProtocols[1] = wmDeleteWindow = XInternAtom(d, "WM_DELETE_WINDOW", False) wmProtocols[2] = wmTakeFocus = XInternAtom(d, "WM_TAKE_FOCUS", False) XSetWMProtocols(d, w, wmProtocols, 3) DECLARE gc TYPE GC DECLARE gcv TYPE XGCValues /* Create gc just for fun son can also test it altough not impimented in the demo*/ gcv.foreground = WhitePixel(d, s) gcv.background = BlackPixel(d, s) gc = XCreateGC(d, w, GCForeground | GCBackground, &gcv) /* Allocate back buffer */ /* From XdbeSwapBuffers man page : */ /* XdbeUndefined */ /* The contents of the new back buffer become undefined. This may */ /* be the most efficient action since it allows the implementation */ /* to discard the contents of the buffer if it needs to. */ /* ... so we'll have to do the cleanup by hand. And as we didn't specify any */ '@ bits for main
'@ Main back-buffer backBuffer = XdbeAllocateBackBufferName(d, w, XdbeUndefined) /* Get back buffer attributes (used for swapping) */ backAttr = XdbeGetBackBufferAttributes(d, backBuffer) swapInfo.swap_window = backAttr->window swapInfo.swap_action = XdbeUndefined '@ back-buffer for child win backBuffer2 = XdbeAllocateBackBufferName(d, child_win, XdbeUndefined) /* Get back buffer attributes (used for swapping) */ backAttr2 = XdbeGetBackBufferAttributes(d, backBuffer2) swapInfo2.swap_window = backAttr2->window swapInfo2.swap_action = XdbeUndefined PROTO XFree PROTO XRaiseWindow '@ free the back buffer attribures XFree(backAttr) XFree(backAttr2) '@ Creat cairo surfaces and map to the back buffers cs=cairo_xlib_surface_create(d, backBuffer, DefaultVisual(d, 0),600, 400) cs_child_win=cairo_xlib_surface_create(d, backBuffer2, DefaultVisual(d, 0),600, 400) IF cs THEN PRINT "Cairo OK"
ELSE PRINT "Cairo fail" END IF '@ map windows and raise main to top dog XMapWindow(d, w) XRaiseWindow(d, w) XMapWindow(d, child_win) '@ check if can double buffer doing = 0 IF (XdbeQueryExtension(d, &major, &minor)) THEN PRINT "OK", major, " : " , minor doing=1 END IF
xpos = 0 Can_draw=0
WHILE (doing) '@ use pending events . IF pending do not draw Read though to end at ELSE IF (XPending(d)) THEN XNextEvent(d, &e)
SELECT e.type CASE Expose PRINT "Expose" '@ ensure the window is realised before double buffering Can_draw = 1 CASE KeyPress BREAK CASE ClientMessage PRINT " Client" IF (e.xclient.message_type == wmProtocols[0]) THEN PRINT " Do Something Here" END IF IF (e.xclient.data.l[1] == wmDeleteWindow) THEN run = FALSE PRINT "Delete" ELIF (e.xclient.data.l[0] == wmTakeFocus) THEN /* The WM wants the window to gain focus. */ PRINT " Focus" XSetInputFocus(d, e.xclient.window, RevertToParent, CurrentTime) END IF END SELECT ELSE '@ draw on main DRAW_1(cs,100,70) '@ swap main win double buffer XdbeSwapBuffers(d, &swapInfo, 1) '@ draw on child DRAW_2(cs_child_win,100,70) '@ swap main win double buffer XdbeSwapBuffers(d, &swapInfo2, 1) SLEEP (10) INCR xpos , 20 IF xpos >= 500 THEN xpos = 0 END IF END IF WEND
'@ checking last cr is not left in memory IF = 1 then problem : free the bits PRINT " exit : ISDO : ",ISDO cairo_surface_destroy(cs) cairo_surface_destroy(cs_child_win) XFreeGC(d, gc) PRINT " GC Free" XFlush(d) XCloseDisplay(d) PRINT " Done"
|
|
|
Post by vovchik on Feb 15, 2014 20:43:02 GMT 1
Dear Alex,
Had to change the INCLUDEs by adding cairo/..., but fabulous - and remarkably fast. Great work!
With kind regards, vovchik
|
|
|
Post by alexfish on Feb 16, 2014 4:38:44 GMT 1
Thanks for the kind words Vovchik,
but I found a problem with the fast no-name buffer "undefined", if resize the window it be gone , poof Oops , dam double Oops!!
so have done a mod to the code , Here setting the window RESIZE false , this is done by setting the min/max size the same much same as hug default window
here we go + Have Fun
Alex PS : please note Vovchik's note about cairo , I assuming this is for bacon beta new compile Scheme ,
'@ cairo double buffering X11 test card = set window resize false this will prevent the no name double buffer bug on resizable window
PRAGMA LDFLAGS `pkg-config --cflags --libs x11 --libs xext --libs cairo`
PRAGMA INCLUDE /usr/include/X11/Xlib.h PRAGMA INCLUDE /usr/include/X11/Xutil.h PRAGMA INCLUDE /usr/include/X11/Xos.h PRAGMA INCLUDE /usr/include/X11/keysym.h PRAGMA INCLUDE /usr/include/X11/extensions/Xdbe.h PRAGMA INCLUDE cairo.h PRAGMA INCLUDE cairo-xlib.h
'@ Cairo bits PROTO cairo_xlib_surface_set_size PROTO cairo_reference PROTO cairo_xlib_surface_create PROTO cairo_xlib_surface_create_for_bitmap PROTO cairo_xlib_surface_set_size PROTO cairo_xlib_surface_get_display PROTO cairo_xlib_surface_get_screen PROTO cairo_xlib_surface_set_drawable PROTO cairo_xlib_surface_get_drawable PROTO cairo_xlib_surface_get_visual PROTO cairo_xlib_surface_get_width PROTO cairo_xlib_surface_get_heigh PROTO cairo_xlib_surface_get_depth PROTO cairo_surface_flush PROTO cairo_create PROTO cairo_rectangle PROTO cairo_set_source_rgb PROTO cairo_fill PROTO cairo_move_to PROTO cairo_set_source_rgb PROTO cairo_show_text PROTO cairo_show_page PROTO cairo_destroy PROTO cairo_surface_destroy PROTO cairo_set_font_size PROTO cairo_line_to PROTO cairo_save PROTO cairo_set_line_width PROTO cairo_stroke DECLARE *cs TYPE cairo_surface_t DECLARE *cs_child_win TYPE cairo_surface_t
'@ X11 bits PROTO XGetGeometry PROTO XStoreName PROTO DefaultScreen PROTO XCreateSimpleWindow PROTO RootWindow PROTO XSelectInput PROTO XMapWindow PROTO XNextEvent PROTO XFillRectangle PROTO XDrawString PROTO XCloseDisplay PROTO XFlush PROTO XCreateWindow PROTO DefaultRootWindow PROTO XNextEvent PROTO XSetForeground PROTO XClearWindow
'@ setting Attributes '@ for delete event PROTO XInternAtom PROTO XSetWMProtocols PROTO Atom
PROTO GC PROTO XGCValues PROTO XdbeSwapBuffers PROTO XSetWindowAttributes
'@ for double buffering PROTO XdbeBackBuffer PROTO XdbeQueryExtension PROTO XdbeUndefined PROTO XdbeAllocateBackBufferName PROTO XdbeGetBackBufferAttributes PROTO XSetInputFocus PROTO XFreeGC '---pointer to X Display structure
DECLARE attributes TYPE XSetWindowAttributes '---pointer to the newly created window DECLARE w TYPE Window '---pointer to the XEvent DECLARE e TYPE XEvent '--- number of screen to place the window on DECLARE s TYPE int
'@ for double buffer DECLARE major, minor TYPE int
PROTO XdbeBackBuffer PROTO XdbeSwapInfo PROTO XdbeBackBufferAttributes DECLARE d_backBuf TYPE XdbeBackBuffer DECLARE *backAttr TYPE XdbeBackBufferAttributes DECLARE swapInfo TYPE XdbeSwapInfo DECLARE d_backBuf2 TYPE XdbeBackBuffer DECLARE *backAttr2 TYPE XdbeBackBufferAttributes DECLARE swapInfo2 TYPE XdbeSwapInfo
SUB PIXEL_2(cairo_surface_t *cs,double xpos,double ypos)
LOCAL *c TYPE cairo_t LOCAL t ,ty ,c_col TYPE double
c=cairo_create(cs) cairo_set_source_rgb(c,1.0, 1.0,1.0) cairo_rectangle(c, 0, 0,600, 400) cairo_fill(c)
cairo_rectangle(c, xpos, ypos,32.0,32.0) c_col = (double)(RANDOM(100))/100 c_col2= (double)(RANDOM(100))/100 cairo_set_source_rgb(c,c_col, c_col2, c_col) cairo_fill(c) cairo_surface_flush(cs) cairo_destroy(c)
END SUB
ISDO = 0
SUB DRAW_1(cairo_surface_t *cs,double xpos,double ypos)
LOCAL *c TYPE cairo_t LOCAL t ,ty ,c_col TYPE double LOCAL ttime color$="#FF00FF" c=cairo_create(cs) cairo_set_source_rgb(c,DEC(MID$(color$, 2, 2)), DEC(MID$(color$, 4, 2)), DEC(MID$(color$, 6, 2)) ) cairo_rectangle(c, 0, 0,600, 400) cairo_fill(c)
FOR t = 0 TO 350 STEP 50.0 ISDO = 1 FOR ty= 0 TO 550 STEP 50.0 cairo_rectangle(c, ty, t,50.0, 50.0) c_col = (double)(RANDOM(32)) c_col2= (double)(RANDOM(32)) c_col3= (double)(RANDOM(32)) cairo_set_source_rgb(c,c_col, c_col2, c_col3) cairo_fill(c) NEXT NEXT cairo_surface_flush(cs) cairo_destroy(c) ISDO = 0 END SUB
SUB DRAW_2(cairo_surface_t *cs,double xpos,double ypos)
LOCAL *c TYPE cairo_t LOCAL t ,ty ,c_col TYPE double LOCAL ttime
c=cairo_create(cs) cairo_set_source_rgb(c,0.0, 1.0,0.0) cairo_rectangle(c, 0, 0,200, 200) cairo_fill(c)
FOR t = 0 TO 200 STEP 10.0 ISDO = 1 FOR ty= 0 TO 200 STEP 10.0 cairo_rectangle(c, ty, t,10.0, 10.0) c_col = (double)(RANDOM(32)) c_col2= (double)(RANDOM(32)) c_col3= (double)(RANDOM(32)) cairo_set_source_rgb(c,c_col,c_col2, c_col3) cairo_fill(c) NEXT NEXT cairo_surface_flush(cs) cairo_destroy(c) ISDO = 0 END SUB '@ RECORD for storing window Geometry RECORD geometry LOCAL x , y ,width,height ,border,depth TYPE int LOCAL root END RECORD ' @ getting Geometry SUB Geometry(NUMBER window)
XGetGeometry(d,window,&geometry.root,&geometry.x,&geometry.y,&geometry.width,&geometry.height,&geometry.border,&geometry.depth) WITH geometry PRINT geometry.x PRINT geometry.y PRINT geometry.width PRINT geometry.height PRINT geometry.border PRINT geometry.depth END WITH
END SUB
'@ for display DECLARE d TYPE Display* 'Display *display d = XOpenDisplay(NULL) s = DefaultScreen(d) root = DefaultRootWindow(d)
'@ for Main
attributes.event_mask = KeyPressMask | KeyReleaseMask | KeymapStateMask | ButtonPressMask | ButtonReleaseMask | EnterWindowMask | LeaveWindowMask | ExposureMask | VisibilityChangeMask | StructureNotifyMask | SubstructureNotifyMask | SubstructureRedirectMask | FocusChangeMask /* Various window attributes */ attributes.backing_store = Always attributes.save_under = True attributes.override_redirect = False attributes.background_pixel = WhitePixel(d, s) '@ Creat main window w = XCreateWindow( d, root, 0, 0, 600, 400, 0,CopyFromParent, InputOutput, CopyFromParent,CWBackingStore|CWOverrideRedirect|CWEventMask|CWSaveUnder|CWBackPixel,&attributes ) '@ added make window none resize by setting min max the same PROTO XSizeHints PROTO XSetNormalHints PROTO XWMHints PROTO XAllocWMHints PROTO XAllocClassHint PROTO XAllocSizeHints
DECLARE size_hints TYPE XSizeHints* DECLARE wm_hints TYPE XWMHints* DECLARE class_hints TYPE XClassHint * size_hints = XAllocSizeHints() wm_hints = XAllocWMHints() class_hints = XAllocClassHint() REM ------------------------------ size_hints->flags = PPosition | PSize | PMinSize |PMaxSize size_hints->min_width = 600 size_hints->min_height = 400 size_hints->max_width = 600 size_hints->max_height = 400 PROTO XSetWMNormalHints XSetWMNormalHints(d,w,size_hints)
'XSetNormalHints(d,w,size_hints) XStoreName(d, w, "X11+ Cairo double buffer / Press key to Exit") '@ create a sub window , have used this since can use as widget + can make easy detection for collisions using animation child_win = XCreateSimpleWindow(d, w, 50,50, \ 200, 200, \ 2, \ WhitePixel(d, s), \ BlackPixel(d, s)) '@ set som WM protocols , although they do not work have left code as is DECLARE wmProtocols[3] TYPE Atom DECLARE wmDeleteWindow TYPE Atom DECLARE wmTakeFocus TYPE Atom '@ think possible have a bacon problem with arrays but not sure the delete event is def not working but press any key to esc wmProtocols[0] = XInternAtom(d, "WM_PROTOCOLS", True) wmProtocols[1] = wmDeleteWindow = XInternAtom(d, "WM_DELETE_WINDOW", False) wmProtocols[2] = wmTakeFocus = XInternAtom(d, "WM_TAKE_FOCUS", False) XSetWMProtocols(d, w, wmProtocols, 3) /* Allocate back buffer */ /* From XdbeSwapBuffers man page : */ /* XdbeUndefined */ /* The contents of the new back buffer become undefined. This may */ /* be the most efficient action since it allows the implementation */ /* to discard the contents of the buffer if it needs to. */ /* ... so we'll have to do the cleanup by hand. And as we didn't specify any */ '@ bits for main
'@ Main back-buffer backBuffer = XdbeAllocateBackBufferName(d, w, XdbeUndefined) /* Get back buffer attributes (used for swapping) */ backAttr = XdbeGetBackBufferAttributes(d, backBuffer) swapInfo.swap_window = backAttr->window swapInfo.swap_action = XdbeUndefined '@ back-buffer for child win backBuffer2 = XdbeAllocateBackBufferName(d, child_win, XdbeUndefined) /* Get back buffer attributes (used for swapping) */ backAttr2 = XdbeGetBackBufferAttributes(d, backBuffer2) swapInfo2.swap_window = backAttr2->window swapInfo2.swap_action = XdbeUndefined PROTO XFree PROTO XRaiseWindow '@ free the back buffer attribures XFree(backAttr) XFree(backAttr2) '@ Creat cairo surfaces and map to the back buffers cs=cairo_xlib_surface_create(d, backBuffer, DefaultVisual(d, 0),600, 400) cs_child_win=cairo_xlib_surface_create(d, backBuffer2, DefaultVisual(d, 0),600, 400) IF cs THEN PRINT "Cairo OK"
ELSE PRINT "Cairo fail" END IF '@ map windows and raise main to top dog XMapWindow(d, w) XRaiseWindow(d, w) XMapWindow(d, child_win) '@ check if can double buffer doing = 0 IF (XdbeQueryExtension(d, &major, &minor)) THEN PRINT "OK", major, " : " , minor doing=1 END IF
xpos = 0 Can_draw=0 Xpoed=0 WHILE (doing) '@ use pending events . IF pending do not draw Read though to end at ELSE IF (XPending(d)) THEN XNextEvent(d, &e)
SELECT e.type CASE Expose PRINT "Expose" INCR Xpoed '@ ensure the window is realised before double buffering IF Xpoed = 4 THEN Can_draw = 1 CASE KeyPress BREAK CASE ConfigureNotify
Geometry(w) PRINT "ConfigureNotify width ",geometry.width cairo_xlib_surface_set_size(cs,geometry.width,geometry.height) CASE ClientMessage PRINT " Client" IF (e.xclient.message_type == wmProtocols[0]) THEN PRINT " Do Something Here" END IF IF (e.xclient.data.l[1] == wmDeleteWindow) THEN run = FALSE PRINT "Delete" ELIF (e.xclient.data.l[0] == wmTakeFocus) THEN /* The WM wants the window to gain focus. */ PRINT " Focus" XSetInputFocus(d, e.xclient.window, RevertToParent, CurrentTime) END IF END SELECT ELSE '@ draw on main DRAW_1(cs,100,70) '@ swap main win double buffer XdbeSwapBuffers(d, &swapInfo, 1) '@ draw on child DRAW_2(cs_child_win,100,70) '@ swap main win double buffer XdbeSwapBuffers(d, &swapInfo2, 1) SLEEP (200) INCR xpos , 20 IF xpos >= 500 THEN xpos = 0 END IF END IF WEND
'@ checking last cr is not left in memory IF = 1 then problem : free the bits PRINT " exit : ISDO : ",ISDO cairo_surface_destroy(cs) cairo_surface_destroy(cs_child_win) 'XFreeGC(d, gc) PRINT " GC Free" XFlush(d) XCloseDisplay(d) PRINT " Done"
|
|
|
Post by vovchik on Feb 16, 2014 15:45:32 GMT 1
Dear Alex, Just adding a bit of alpha and linear fill - experimenting. As usual, I think you are onto something nice and useful. With kind regards, vovchik ' cairo double buffering X11 test card = set window resize false. ' this will prevent the no name double buffer bug on resizable window
' *********************** ' COMPILER DIRECTIVES ' ***********************
PRAGMA LDFLAGS `pkg-config --cflags --libs x11 --libs xext --libs cairo` PRAGMA INCLUDE /usr/include/X11/Xlib.h PRAGMA INCLUDE /usr/include/X11/Xutil.h PRAGMA INCLUDE /usr/include/X11/Xos.h PRAGMA INCLUDE /usr/include/X11/keysym.h PRAGMA INCLUDE /usr/include/X11/extensions/Xdbe.h ' PRAGMA INCLUDE cairo.h ' PRAGMA INCLUDE cairo-xlib.h ' for new compile scheme PRAGMA INCLUDE cairo/cairo.h PRAGMA INCLUDE cairo/cairo-xlib.h
' *********************** ' END COMPILER DIRECTIVES ' ***********************
' *********************** ' EXTERNAL FUNCTIONS ' ***********************
' Cairo bits PROTO cairo_xlib_surface_set_size PROTO cairo_reference PROTO cairo_xlib_surface_create PROTO cairo_xlib_surface_create_for_bitmap PROTO cairo_xlib_surface_set_size PROTO cairo_xlib_surface_get_display PROTO cairo_xlib_surface_get_screen PROTO cairo_xlib_surface_set_drawable PROTO cairo_xlib_surface_get_drawable PROTO cairo_xlib_surface_get_visual PROTO cairo_xlib_surface_get_width PROTO cairo_xlib_surface_get_heigh PROTO cairo_xlib_surface_get_depth PROTO cairo_surface_flush PROTO cairo_create PROTO cairo_rectangle PROTO cairo_set_source_rgb PROTO cairo_fill PROTO cairo_move_to PROTO cairo_set_source_rgb PROTO cairo_show_text PROTO cairo_show_page PROTO cairo_destroy PROTO cairo_surface_destroy PROTO cairo_set_font_size PROTO cairo_line_to PROTO cairo_save PROTO cairo_set_line_width PROTO cairo_stroke ' X11 bits PROTO XGetGeometry PROTO XStoreName PROTO DefaultScreen PROTO XCreateSimpleWindow PROTO RootWindow PROTO XSelectInput PROTO XMapWindow PROTO XNextEvent PROTO XFillRectangle PROTO XDrawString PROTO XCloseDisplay PROTO XFlush PROTO XCreateWindow PROTO DefaultRootWindow PROTO XNextEvent PROTO XSetForeground PROTO XClearWindow ' setting Attributes ' for delete event PROTO XInternAtom PROTO XSetWMProtocols PROTO Atom PROTO GC PROTO XGCValues PROTO XdbeSwapBuffers PROTO XSetWindowAttributes ' for double buffering PROTO XdbeBackBuffer PROTO XdbeQueryExtension PROTO XdbeUndefined PROTO XdbeAllocateBackBufferName PROTO XdbeGetBackBufferAttributes PROTO XSetInputFocus PROTO XFreeGC PROTO XdbeBackBuffer PROTO XdbeSwapInfo PROTO XdbeBackBufferAttributes ' added make window none resize by setting min max the same PROTO XSizeHints PROTO XSetNormalHints PROTO XWMHints PROTO XAllocWMHints PROTO XAllocClassHint PROTO XAllocSizeHints PROTO XSetWMNormalHints PROTO XFree PROTO XRaiseWindow ' vovchik PROTO cairo_set_source_rgba PROTO cairo_pattern_create_rgba PROTO cairo_pattern_create_linear PROTO cairo_pattern_create_radial PROTO cairo_fill PROTO cairo_set_source PROTO cairo_set_line_width PROTO cairo_translate PROTO cairo_set_antialias PROTO cairo_pattern_add_color_stop_rgba PROTO cairo_pattern_destroy
' *********************** ' END EXTERNAL FUNCTIONS ' ***********************
' *********************** ' INITIALIZATION ' ***********************
' pointer to X Display structure DECLARE attributes TYPE XSetWindowAttributes ' pointer to the newly created window DECLARE w TYPE Window ' pointer to the XEvent DECLARE e TYPE XEvent ' number of screen to place the window on DECLARE s TYPE int ' for double buffer DECLARE major, minor TYPE int ' RECORD for storing window Geometry RECORD geometry LOCAL x, y, width,height, border, depth TYPE int LOCAL root END RECORD DECLARE d_backBuf TYPE XdbeBackBuffer DECLARE *backAttr TYPE XdbeBackBufferAttributes DECLARE swapInfo TYPE XdbeSwapInfo DECLARE d_backBuf2 TYPE XdbeBackBuffer DECLARE *backAttr2 TYPE XdbeBackBufferAttributes DECLARE swapInfo2 TYPE XdbeSwapInfo DECLARE *cs TYPE cairo_surface_t DECLARE *cs_child_win TYPE cairo_surface_t ISDO = 0
' *********************** ' END INITIALIZATION ' ***********************
' *********************** ' SUBS & FUNCTIONS ' ***********************
' ------------------ SUB PIXEL_2(cairo_surface_t *cs, double xpos, double ypos) ' ------------------ LOCAL *c TYPE cairo_t LOCAL t, ty , c_col TYPE double c = cairo_create(cs) cairo_set_antialias(c, 6) cairo_set_source_rgba(c, 1.0, 1.0, 1.0, 0.9) cairo_rectangle(c, 0, 0, 600, 400) cairo_fill(c) cairo_rectangle(c, xpos, ypos, 32.0, 32.0) c_col = (double)(RANDOM(100))/100 c_col2= (double)(RANDOM(100))/100 cairo_set_source_rgba(c, c_col, c_col2, c_col, 0.9) cairo_fill(c) cairo_surface_flush(cs) cairo_destroy(c) END SUB
' ------------------ SUB DRAW_1(cairo_surface_t *cs, double xpos, double ypos) ' ------------------ LOCAL *c TYPE cairo_t LOCAL t, ty, c_col1, c_col2, c_col3 TYPE double LOCAL ttime LOCAL *pat1 TYPE cairo_pattern_t color$ = "#3a3a3a" c = cairo_create(cs) cairo_set_antialias(c, 6) cairo_set_source_rgba(c, \ (double)(DEC(MID$(color$, 2, 2))/100.0), \ (double)(DEC(MID$(color$, 4, 2))/100.0), \ (double)(DEC(MID$(color$, 6, 2))/100.0), 0.6) cairo_rectangle(c, 0, 0, 600, 400) cairo_fill(c) FOR t = 0 TO 350 STEP 50.0 ISDO = 1 FOR ty = 0 TO 550 STEP 50.0 cairo_rectangle(c, ty, t, 45.0, 45.0) c_col1 = (double)((RANDOM(60) + 20)/100.0) c_col2 = (double)(RANDOM(32)/100.0) c_col3 = (double)(RANDOM(32)/100.0) pat1 = cairo_pattern_create_linear(0.0, 0.0, 50.0, 50.0) cairo_pattern_add_color_stop_rgba(pat1, 0.1, c_col1, 0, 0, 0.9) cairo_pattern_add_color_stop_rgba(pat1, 0.5, c_col2, 0, 0, 0.9) cairo_pattern_add_color_stop_rgba(pat1, 0.9, 0, c_col3, 0, 0.9) ' cairo_set_source_rgba(c, c_col1, c_col1 + 0.3, 0.6, 0.9) cairo_set_source(c, pat1) cairo_fill(c) cairo_pattern_destroy(pat1) NEXT ty NEXT t cairo_surface_flush(cs) cairo_destroy(c) ISDO = 0 END SUB
' ------------------ SUB DRAW_2(cairo_surface_t *cs, double xpos, double ypos) ' ------------------ LOCAL *c TYPE cairo_t LOCAL t, ty , c_col1, c_col2, c_col3 TYPE double LOCAL ttime c = cairo_create(cs) cairo_set_antialias(c, 6) cairo_set_source_rgba(c, 1.0, 1.0, 1.0, 0.9) cairo_rectangle(c, 0, 0, 190, 190) cairo_fill(c) FOR t = 0 TO 190 STEP 10.0 ISDO = 1 FOR ty = 0 TO 190 STEP 10.0 cairo_rectangle(c, ty, t, 10.0, 10.0) c_col1 = (double)(RANDOM(32)/100.0) c_col2 = (double)(RANDOM(32)/100.0) c_col3 = (double)(RANDOM(32)/100.0) cairo_set_source_rgba(c, c_col1, c_col2, c_col3, 0.9) cairo_fill(c) NEXT ty NEXT t cairo_surface_flush(cs) cairo_destroy(c) ISDO = 0 END SUB
' ------------------ SUB GEOMETRY(NUMBER window) ' ------------------ ' getting Geometry XGetGeometry(d, window, &geometry.root, &geometry.x, &geometry.y, \ &geometry.width,&geometry.height,&geometry.border,&geometry.depth) WITH geometry PRINT geometry.x PRINT geometry.y PRINT geometry.width PRINT geometry.height PRINT geometry.border PRINT geometry.depth END WITH END SUB
' ------------------ SUB MK_DRAWING() ' ------------------ ' for display DECLARE d TYPE Display* DECLARE size_hints TYPE XSizeHints* DECLARE wm_hints TYPE XWMHints* DECLARE class_hints TYPE XClassHint * DECLARE wmProtocols[3] TYPE Atom DECLARE wmDeleteWindow TYPE Atom DECLARE wmTakeFocus TYPE Atom 'Display *display d = XOpenDisplay(NULL) s = DefaultScreen(d) root = DefaultRootWindow(d) ' for Main attributes.event_mask = KeyPressMask | KeyReleaseMask | \ KeymapStateMask | ButtonPressMask | ButtonReleaseMask | \ EnterWindowMask | LeaveWindowMask | ExposureMask | \ VisibilityChangeMask | StructureNotifyMask | \ SubstructureNotifyMask | SubstructureRedirectMask | \ FocusChangeMask ' Various window attributes attributes.backing_store = Always attributes.save_under = TRUE attributes.override_redirect = FALSE attributes.background_pixel = WhitePixel(d, s) ' Creat main window w = XCreateWindow(d, root, 0, 0, 600, 400, 0, CopyFromParent, \ InputOutput, CopyFromParent,CWBackingStore|CWOverrideRedirect| \ CWEventMask|CWSaveUnder|CWBackPixel,&attributes ) size_hints = XAllocSizeHints() wm_hints = XAllocWMHints() class_hints = XAllocClassHint() size_hints->flags = PPosition | PSize | PMinSize |PMaxSize size_hints->min_width = 600 size_hints->min_height = 400 size_hints->max_width = 600 size_hints->max_height = 400 XSetWMNormalHints(d,w,size_hints) 'XSetNormalHints(d,w,size_hints) XStoreName(d, w, "X11/Cairo double buffer with alpha - press any key to exit") ' create a sub window , have used this since can use as widget + ' can make easy detection for collisions using animation child_win = XCreateSimpleWindow(d, w, 50, 50, \ 191, 191, 2, WhitePixel(d, s), BlackPixel(d, s)) ' set some WM protocols , although they do not work have left code as is ' think possible have a bacon problem with arrays but not sure ' the delete event is def not working but press any key to esc wmProtocols[0] = XInternAtom(d, "WM_PROTOCOLS", TRUE) wmProtocols[1] = wmDeleteWindow = XInternAtom(d, "WM_DELETE_WINDOW", FALSE) wmProtocols[2] = wmTakeFocus = XInternAtom(d, "WM_TAKE_FOCUS", FALSE) XSetWMProtocols(d, w, wmProtocols, 3) ' Allocate back buffer ' From XdbeSwapBuffers man page : ' XdbeUndefined ' The contents of the new back buffer become undefined. This may ' be the most efficient action since it allows the implementation ' to discard the contents of the buffer if it needs to. ' ... so we't specify any '@ bits for main '@ Main back-buffer backBuffer = XdbeAllocateBackBufferName(d, w, XdbeUndefined) ' Get back buffer attributes (used for swapping) backAttr = XdbeGetBackBufferAttributes(d, backBuffer) swapInfo.swap_window = backAttr->window swapInfo.swap_action = XdbeUndefined '@ back-buffer for child win backBuffer2 = XdbeAllocateBackBufferName(d, child_win, XdbeUndefined) ' Get back buffer attributes (used for swapping) backAttr2 = XdbeGetBackBufferAttributes(d, backBuffer2) swapInfo2.swap_window = backAttr2->window swapInfo2.swap_action = XdbeUndefined ' free the back buffer attribures XFree(backAttr) XFree(backAttr2) ' Creat cairo surfaces and map to the back buffers cs = cairo_xlib_surface_create(d, backBuffer, DefaultVisual(d, 0), \ 600, 400) cs_child_win = cairo_xlib_surface_create(d, backBuffer2, \ DefaultVisual(d, 0),600, 400) IF cs THEN PRINT "Cairo OK" ELSE PRINT "Cairo fail" END IF ' map windows and raise main to top dog XMapWindow(d, w) XRaiseWindow(d, w) XMapWindow(d, child_win) ' check if can double buffer doing = 0 IF (XdbeQueryExtension(d, &major, &minor)) THEN PRINT "OK", major, " : " , minor doing = 1 END IF xpos = 0 Can_draw = 0 Xpoed = 0 WHILE doing DO ' use pending events . IF pending do not draw Read though to end at ELSE IF (XPending(d)) THEN XNextEvent(d, &e) SELECT e.type CASE Expose PRINT "Expose" INCR Xpoed ' ensure the window is realised before double buffering IF Xpoed = 4 THEN Can_draw = 1 CASE KeyPress BREAK CASE ConfigureNotify GEOMETRY(w) PRINT "ConfigureNotify width ", geometry.width cairo_xlib_surface_set_size(cs, geometry.width, geometry.height) CASE ClientMessage PRINT " Client" IF (e.xclient.message_type == wmProtocols[0]) THEN PRINT " Do Something Here" END IF IF (e.xclient.data.l[1] == wmDeleteWindow) THEN run = FALSE PRINT "Delete" ELIF (e.xclient.data.l[0] == wmTakeFocus) THEN ' The WM wants the window to gain focus. PRINT " Focus" XSetInputFocus(d, e.xclient.window, RevertToParent, CurrentTime) END IF END SELECT ELSE ' draw on main DRAW_1(cs, 100, 70) ' swap main win double buffer XdbeSwapBuffers(d, &swapInfo, 1) ' draw on child DRAW_2(cs_child_win, 100, 70) ' swap main win double buffer XdbeSwapBuffers(d, &swapInfo2, 1) SLEEP 200 INCR xpos , 20 IF xpos >= 500 THEN xpos = 0 END IF END IF WEND END SUB
' *********************** ' END SUBS & FUNCTIONS ' ***********************
' *********************** ' MAIN ' ***********************
MK_DRAWING() ' checking last cr is not left in memory IF = 1 then problem : free the bits PRINT " exit : ISDO : ", ISDO cairo_surface_destroy(cs) cairo_surface_destroy(cs_child_win) 'XFreeGC(d, gc) PRINT " GC Free" XFlush(d) XCloseDisplay(d) PRINT " Done"
' *********************** ' END MAIN ' ***********************
|
|
|
Post by alexfish on Feb 16, 2014 20:54:40 GMT 1
Hi Vovchik Nice work , did a couple of mods , this one gives a check'y pattern on all the squares , using part of rnd function + using cairo extend , very much Tartan Effect BR Alex ' cairo double buffering X11 test card = set window resize false. ' this will prevent the no name double buffer bug on resizable window
' *********************** ' COMPILER DIRECTIVES ' ***********************
PRAGMA LDFLAGS `pkg-config --cflags --libs x11 --libs xext --libs cairo` PRAGMA INCLUDE /usr/include/X11/Xlib.h PRAGMA INCLUDE /usr/include/X11/Xutil.h PRAGMA INCLUDE /usr/include/X11/Xos.h PRAGMA INCLUDE /usr/include/X11/keysym.h PRAGMA INCLUDE /usr/include/X11/extensions/Xdbe.h ' PRAGMA INCLUDE cairo.h ' PRAGMA INCLUDE cairo-xlib.h ' for new compile scheme PRAGMA INCLUDE cairo/cairo.h PRAGMA INCLUDE cairo/cairo-xlib.h
' *********************** ' END COMPILER DIRECTIVES ' ***********************
' *********************** ' EXTERNAL FUNCTIONS ' ***********************
' Cairo bits PROTO cairo_pattern_set_extend PROTO cairo_xlib_surface_set_size PROTO cairo_reference PROTO cairo_xlib_surface_create PROTO cairo_xlib_surface_create_for_bitmap PROTO cairo_xlib_surface_set_size PROTO cairo_xlib_surface_get_display PROTO cairo_xlib_surface_get_screen PROTO cairo_xlib_surface_set_drawable PROTO cairo_xlib_surface_get_drawable PROTO cairo_xlib_surface_get_visual PROTO cairo_xlib_surface_get_width PROTO cairo_xlib_surface_get_heigh PROTO cairo_xlib_surface_get_depth PROTO cairo_surface_flush PROTO cairo_create PROTO cairo_rectangle PROTO cairo_set_source_rgb PROTO cairo_fill PROTO cairo_move_to PROTO cairo_set_source_rgb PROTO cairo_show_text PROTO cairo_show_page PROTO cairo_destroy PROTO cairo_surface_destroy PROTO cairo_set_font_size PROTO cairo_line_to PROTO cairo_save PROTO cairo_set_line_width PROTO cairo_stroke ' X11 bits PROTO XGetGeometry PROTO XStoreName PROTO DefaultScreen PROTO XCreateSimpleWindow PROTO RootWindow PROTO XSelectInput PROTO XMapWindow PROTO XNextEvent PROTO XFillRectangle PROTO XDrawString PROTO XCloseDisplay PROTO XFlush PROTO XCreateWindow PROTO DefaultRootWindow PROTO XNextEvent PROTO XSetForeground PROTO XClearWindow ' setting Attributes ' for delete event PROTO XInternAtom PROTO XSetWMProtocols PROTO Atom PROTO GC PROTO XGCValues PROTO XdbeSwapBuffers PROTO XSetWindowAttributes ' for double buffering PROTO XdbeBackBuffer PROTO XdbeQueryExtension PROTO XdbeUndefined PROTO XdbeAllocateBackBufferName PROTO XdbeGetBackBufferAttributes PROTO XSetInputFocus PROTO XFreeGC PROTO XdbeBackBuffer PROTO XdbeSwapInfo PROTO XdbeBackBufferAttributes ' added make window none resize by setting min max the same PROTO XSizeHints PROTO XSetNormalHints PROTO XWMHints PROTO XAllocWMHints PROTO XAllocClassHint PROTO XAllocSizeHints PROTO XSetWMNormalHints PROTO XFree PROTO XRaiseWindow ' vovchik PROTO cairo_set_source_rgba PROTO cairo_pattern_create_rgba PROTO cairo_pattern_create_linear PROTO cairo_pattern_create_radial PROTO cairo_fill PROTO cairo_set_source PROTO cairo_set_line_width PROTO cairo_translate PROTO cairo_set_antialias PROTO cairo_pattern_add_color_stop_rgba PROTO cairo_pattern_destroy
' *********************** ' END EXTERNAL FUNCTIONS ' ***********************
' *********************** ' INITIALIZATION ' ***********************
' pointer to X Display structure DECLARE attributes TYPE XSetWindowAttributes ' pointer to the newly created window DECLARE w TYPE Window ' pointer to the XEvent DECLARE e TYPE XEvent ' number of screen to place the window on DECLARE s TYPE int ' for double buffer DECLARE major, minor TYPE int ' RECORD for storing window Geometry RECORD geometry LOCAL x, y, width,height, border, depth TYPE int LOCAL root END RECORD DECLARE d_backBuf TYPE XdbeBackBuffer DECLARE *backAttr TYPE XdbeBackBufferAttributes DECLARE swapInfo TYPE XdbeSwapInfo DECLARE d_backBuf2 TYPE XdbeBackBuffer DECLARE *backAttr2 TYPE XdbeBackBufferAttributes DECLARE swapInfo2 TYPE XdbeSwapInfo DECLARE *cs TYPE cairo_surface_t DECLARE *cs_child_win TYPE cairo_surface_t ISDO = 0
' *********************** ' END INITIALIZATION ' ***********************
' *********************** ' SUBS & FUNCTIONS ' ***********************
' ------------------ SUB PIXEL_2(cairo_surface_t *cs, double xpos, double ypos) ' ------------------ LOCAL *c TYPE cairo_t LOCAL t, ty , c_col TYPE double c = cairo_create(cs) cairo_set_antialias(c, 6) cairo_set_source_rgba(c, 1.0, 1.0, 1.0, 0.9) cairo_rectangle(c, 0, 0, 600, 400) cairo_fill(c) cairo_rectangle(c, xpos, ypos, 32.0, 32.0) c_col = (double)(RANDOM(100))/100 c_col2= (double)(RANDOM(100))/100 cairo_set_source_rgba(c, c_col, c_col2, c_col, 0.9) cairo_fill(c) cairo_surface_flush(cs) cairo_destroy(c) END SUB
' ------------------ SUB DRAW_1(cairo_surface_t *cs, double xpos, double ypos) ' ------------------ LOCAL *c TYPE cairo_t LOCAL t, ty, c_col1, c_col2, c_col3 TYPE double LOCAL ttime LOCAL *pat1 TYPE cairo_pattern_t color$ = "#3a3a3a" c = cairo_create(cs) cairo_set_antialias(c, 6) cairo_set_source_rgba(c, \ (double)(DEC(MID$(color$, 2, 2))/100.0), \ (double)(DEC(MID$(color$, 4, 2))/100.0), \ (double)(DEC(MID$(color$, 6, 2))/100.0), 0.6) cairo_rectangle(c, 0, 0, 600, 400) cairo_fill(c) FOR t = 0 TO 350 STEP 50.0 ISDO = 1 FOR ty = 0 TO 550 STEP 50.0 cairo_rectangle(c, ty, t, 45.0, 45.0) c_col1 = (double)((RANDOM(60) + 20)/100.0) c_col2 = (double)(RANDOM(32)/100.0) c_col3 = (double)(RANDOM(32)/100.0) pat1 = cairo_pattern_create_linear(c_col1, c_col3, 0.0, 0.0) cairo_pattern_add_color_stop_rgba(pat1, 0.5, c_col1, 0, 0, 0.9) cairo_pattern_add_color_stop_rgba(pat1, 0.7, c_col2, 0, 0, 0.9) cairo_pattern_add_color_stop_rgba(pat1, 1.0, 0, c_col3, 0, 0.9) cairo_pattern_set_extend(pat1,1)
cairo_set_source(c, pat1) cairo_fill(c) cairo_pattern_destroy(pat1) NEXT ty NEXT t cairo_surface_flush(cs) cairo_destroy(c) ISDO = 0 END SUB
' ------------------ SUB DRAW_2(cairo_surface_t *cs, double xpos, double ypos) ' ------------------ LOCAL *c TYPE cairo_t LOCAL t, ty , c_col1, c_col2, c_col3 TYPE double LOCAL ttime c = cairo_create(cs) cairo_set_antialias(c, 6) cairo_set_source_rgba(c, 1.0, 1.0, 1.0, 0.9) cairo_rectangle(c, 0, 0, 190, 190) cairo_fill(c) FOR t = 0 TO 190 STEP 10.0 ISDO = 1 FOR ty = 0 TO 190 STEP 10.0 cairo_rectangle(c, ty, t, 10.0, 10.0) c_col1 = (double)(RANDOM(32)/100.0) c_col2 = (double)(RANDOM(32)/100.0) c_col3 = (double)(RANDOM(32)/100.0) cairo_set_source_rgba(c, c_col1, c_col2, c_col3, 0.9) cairo_fill(c) NEXT ty NEXT t cairo_surface_flush(cs) cairo_destroy(c) ISDO = 0 END SUB
' ------------------ SUB GEOMETRY(NUMBER window) ' ------------------ ' getting Geometry XGetGeometry(d, window, &geometry.root, &geometry.x, &geometry.y, \ &geometry.width,&geometry.height,&geometry.border,&geometry.depth) WITH geometry PRINT geometry.x PRINT geometry.y PRINT geometry.width PRINT geometry.height PRINT geometry.border PRINT geometry.depth END WITH END SUB
' ------------------ SUB MK_DRAWING() ' ------------------ ' for display DECLARE d TYPE Display* DECLARE size_hints TYPE XSizeHints* DECLARE wm_hints TYPE XWMHints* DECLARE class_hints TYPE XClassHint * DECLARE wmProtocols[3] TYPE Atom DECLARE wmDeleteWindow TYPE Atom DECLARE wmTakeFocus TYPE Atom 'Display *display d = XOpenDisplay(NULL) s = DefaultScreen(d) root = DefaultRootWindow(d) ' for Main attributes.event_mask = KeyPressMask | KeyReleaseMask | \ KeymapStateMask | ButtonPressMask | ButtonReleaseMask | \ EnterWindowMask | LeaveWindowMask | ExposureMask | \ VisibilityChangeMask | StructureNotifyMask | \ SubstructureNotifyMask | SubstructureRedirectMask | \ FocusChangeMask ' Various window attributes attributes.backing_store = Always attributes.save_under = TRUE attributes.override_redirect = FALSE attributes.background_pixel = WhitePixel(d, s) ' Creat main window w = XCreateWindow(d, root, 0, 0, 600, 400, 0, CopyFromParent, \ InputOutput, CopyFromParent,CWBackingStore|CWOverrideRedirect| \ CWEventMask|CWSaveUnder|CWBackPixel,&attributes ) size_hints = XAllocSizeHints() wm_hints = XAllocWMHints() class_hints = XAllocClassHint() size_hints->flags = PPosition | PSize | PMinSize |PMaxSize size_hints->min_width = 600 size_hints->min_height = 400 size_hints->max_width = 600 size_hints->max_height = 400 XSetWMNormalHints(d,w,size_hints) 'XSetNormalHints(d,w,size_hints) XStoreName(d, w, "X11/Cairo double buffer with alpha - press any key to exit") ' create a sub window , have used this since can use as widget + ' can make easy detection for collisions using animation child_win = XCreateSimpleWindow(d, w, 50, 50, \ 191, 191, 2, WhitePixel(d, s), BlackPixel(d, s)) ' set some WM protocols , although they do not work have left code as is ' think possible have a bacon problem with arrays but not sure ' the delete event is def not working but press any key to esc wmProtocols[0] = XInternAtom(d, "WM_PROTOCOLS", TRUE) wmProtocols[1] = wmDeleteWindow = XInternAtom(d, "WM_DELETE_WINDOW", FALSE) wmProtocols[2] = wmTakeFocus = XInternAtom(d, "WM_TAKE_FOCUS", FALSE) XSetWMProtocols(d, w, wmProtocols, 3) ' Allocate back buffer ' From XdbeSwapBuffers man page : ' XdbeUndefined ' The contents of the new back buffer become undefined. This may ' be the most efficient action since it allows the implementation ' to discard the contents of the buffer if it needs to. ' ... so we't specify any '@ bits for main '@ Main back-buffer backBuffer = XdbeAllocateBackBufferName(d, w, XdbeUndefined) ' Get back buffer attributes (used for swapping) backAttr = XdbeGetBackBufferAttributes(d, backBuffer) swapInfo.swap_window = backAttr->window swapInfo.swap_action = XdbeUndefined '@ back-buffer for child win backBuffer2 = XdbeAllocateBackBufferName(d, child_win, XdbeUndefined) ' Get back buffer attributes (used for swapping) backAttr2 = XdbeGetBackBufferAttributes(d, backBuffer2) swapInfo2.swap_window = backAttr2->window swapInfo2.swap_action = XdbeUndefined ' free the back buffer attribures XFree(backAttr) XFree(backAttr2) ' Creat cairo surfaces and map to the back buffers cs = cairo_xlib_surface_create(d, backBuffer, DefaultVisual(d, 0), \ 600, 400) cs_child_win = cairo_xlib_surface_create(d, backBuffer2, \ DefaultVisual(d, 0),600, 400) IF cs THEN PRINT "Cairo OK" ELSE PRINT "Cairo fail" END IF ' map windows and raise main to top dog XMapWindow(d, w) XRaiseWindow(d, w) XMapWindow(d, child_win) ' check if can double buffer doing = 0 IF (XdbeQueryExtension(d, &major, &minor)) THEN PRINT "OK", major, " : " , minor doing = 1 END IF xpos = 0 Can_draw = 0 Xpoed = 0 WHILE doing DO ' use pending events . IF pending do not draw Read though to end at ELSE IF (XPending(d)) THEN XNextEvent(d, &e) SELECT e.type CASE Expose PRINT "Expose" INCR Xpoed ' ensure the window is realised before double buffering IF Xpoed = 4 THEN Can_draw = 1 CASE KeyPress BREAK CASE ConfigureNotify GEOMETRY(w) PRINT "ConfigureNotify width ", geometry.width cairo_xlib_surface_set_size(cs, geometry.width, geometry.height) CASE ClientMessage PRINT " Client" IF (e.xclient.message_type == wmProtocols[0]) THEN PRINT " Do Something Here" END IF IF (e.xclient.data.l[1] == wmDeleteWindow) THEN run = FALSE PRINT "Delete" ELIF (e.xclient.data.l[0] == wmTakeFocus) THEN ' The WM wants the window to gain focus. PRINT " Focus" XSetInputFocus(d, e.xclient.window, RevertToParent, CurrentTime) END IF END SELECT ELSE ' draw on main DRAW_1(cs, 100, 70) ' swap main win double buffer XdbeSwapBuffers(d, &swapInfo, 1) ' draw on child DRAW_2(cs_child_win, 100, 70) ' swap main win double buffer XdbeSwapBuffers(d, &swapInfo2, 1) SLEEP 60 INCR xpos , 20 IF xpos >= 500 THEN xpos = 0 END IF END IF WEND END SUB
' *********************** ' END SUBS & FUNCTIONS ' ***********************
' *********************** ' MAIN ' ***********************
MK_DRAWING() ' checking last cr is not left in memory IF = 1 then problem : free the bits PRINT " exit : ISDO : ", ISDO cairo_surface_destroy(cs) cairo_surface_destroy(cs_child_win) 'XFreeGC(d, gc) PRINT " GC Free" XFlush(d) XCloseDisplay(d) PRINT " Done"
' *********************** ' END MAIN ' *********************** Picky Attachments:
|
|
|
Post by vovchik on Feb 16, 2014 21:05:43 GMT 1
Dear Alex, We are getting classy Great work, looks very nice and is fast, in spite of all the patterns that have to be created and rendered. With kind regards, vovchik PS. Nothing better than putting the "tart" back in tartan.
|
|
|
Post by alexfish on Feb 16, 2014 21:33:48 GMT 1
Hi Vovchik
Can't beat playing around with tart ..
did a post on the SDL thread by Joe , in it is how to get Cairo into SDL , so hopeful Joe could play around with some tart, Err I mean play around with the bits + looking at the product maybe an ideal way of getting textures into sdl . + cairo can save to PNG ..blagh blag
BR Alex
|
|
|
Post by bigbass on Feb 17, 2014 1:14:39 GMT 1
Hey Alex Thanks for the demos with cairo and the backbuffers while just about every widget library uses Xlib it is good to test out some ideas without GTK or SDL going back in time and adding new cairo with just Xlib and taking a new look at some things from another angle P.S there is a lot of basic code out there if people want to port it There are a lot of games out there in C if people want to port it to BaCon don't try that with Qbasic we have more power now than the old Basic with its limits we now can get down to the low level stuff too and embed libraries (yes a bit ugly but it is doable) when we are done with the testing phase we can roll it up with better syntax (Note that we didn't make the GTK XLIB SDL syntax but we can make it more basic friendly to read when we are done and use it with BaCon showing that BaCon can meet the needs of the old world of basic and live in 2014 too Joe
|
|
|
Post by alexfish on Feb 17, 2014 14:12:47 GMT 1
Hi Vovchik . have converted the BBC ufo demo to cairo
as mentioned in PM need to look at the cairo coordinates system or adapt code to suit , so posting code as is
Have put bits in to get position on the axis + scale factor , so Scale will have slight impact on the render time
but on the Atom , depending on what U got running desk to wise I getting render times of 1 to 1.5 seconds
BR Alex
'@ cairo double buffering X11 test card = set window resize false this will prevent the no name double buffer bug on resizable window
PRAGMA LDFLAGS `pkg-config --cflags --libs x11 --libs xext --libs cairo`
PRAGMA INCLUDE /usr/include/X11/Xlib.h PRAGMA INCLUDE /usr/include/X11/Xutil.h PRAGMA INCLUDE /usr/include/X11/Xos.h PRAGMA INCLUDE /usr/include/X11/keysym.h PRAGMA INCLUDE /usr/include/X11/extensions/Xdbe.h PRAGMA INCLUDE cairo.h PRAGMA INCLUDE cairo-xlib.h
'@ Cairo bits PROTO cairo_rotate PROTO cairo_scale PROTO cairo_translate PROTO cairo_xlib_surface_set_size PROTO cairo_reference PROTO cairo_xlib_surface_create PROTO cairo_xlib_surface_create_for_bitmap PROTO cairo_xlib_surface_set_size PROTO cairo_xlib_surface_get_display PROTO cairo_xlib_surface_get_screen PROTO cairo_xlib_surface_set_drawable PROTO cairo_xlib_surface_get_drawable PROTO cairo_xlib_surface_get_visual PROTO cairo_xlib_surface_get_width PROTO cairo_xlib_surface_get_heigh PROTO cairo_xlib_surface_get_depth PROTO cairo_surface_flush PROTO cairo_create PROTO cairo_rectangle PROTO cairo_set_source_rgb PROTO cairo_fill PROTO cairo_move_to PROTO cairo_set_source_rgb PROTO cairo_show_text PROTO cairo_show_page PROTO cairo_destroy PROTO cairo_surface_destroy PROTO cairo_set_font_size PROTO cairo_line_to PROTO cairo_save PROTO cairo_set_line_width PROTO cairo_stroke DECLARE *cs TYPE cairo_surface_t DECLARE *cs_child_win TYPE cairo_surface_t
'@ X11 bits PROTO XGetGeometry PROTO XStoreName PROTO DefaultScreen PROTO XCreateSimpleWindow PROTO RootWindow PROTO XSelectInput PROTO XMapWindow PROTO XNextEvent PROTO XFillRectangle PROTO XDrawString PROTO XCloseDisplay PROTO XFlush PROTO XCreateWindow PROTO DefaultRootWindow PROTO XNextEvent PROTO XSetForeground PROTO XClearWindow PROTO XUnmapWindow
'@ setting Attributes '@ for delete event PROTO XInternAtom PROTO XSetWMProtocols PROTO Atom
PROTO GC PROTO XGCValues PROTO XdbeSwapBuffers PROTO XSetWindowAttributes
'@ for double buffering PROTO XdbeBackBuffer PROTO XdbeQueryExtension PROTO XdbeUndefined PROTO XdbeAllocateBackBufferName PROTO XdbeGetBackBufferAttributes PROTO XSetInputFocus PROTO XFreeGC '---pointer to X Display structure
DECLARE attributes TYPE XSetWindowAttributes '---pointer to the newly created window DECLARE w TYPE Window '---pointer to the XEvent DECLARE e TYPE XEvent '--- number of screen to place the window on DECLARE s TYPE int
'@ for double buffer DECLARE major, minor TYPE int
PROTO XdbeBackBuffer PROTO XdbeSwapInfo PROTO XdbeBackBufferAttributes DECLARE d_backBuf TYPE XdbeBackBuffer DECLARE *backAttr TYPE XdbeBackBufferAttributes DECLARE swapInfo TYPE XdbeSwapInfo DECLARE d_backBuf2 TYPE XdbeBackBuffer DECLARE *backAttr2 TYPE XdbeBackBufferAttributes DECLARE swapInfo2 TYPE XdbeSwapInfo
SUB PIXEL_2(cairo_surface_t *cs,double xpos,double ypos)
LOCAL *c TYPE cairo_t LOCAL t ,ty ,c_col TYPE double
c=cairo_create(cs) cairo_set_source_rgb(c,1.0, 1.0,1.0) cairo_rectangle(c, 0, 0,600, 400) cairo_fill(c)
cairo_rectangle(c, xpos, ypos,32.0,32.0) c_col = (double)(RANDOM(100))/100 c_col2= (double)(RANDOM(100))/100 cairo_set_source_rgb(c,c_col, c_col2, c_col) cairo_fill(c) cairo_surface_flush(cs) cairo_destroy(c)
END SUB
ISDO = 0
SUB DRAW_1(cairo_surface_t *cs,double xpos,double ypos)
LOCAL *c TYPE cairo_t LOCAL t ,ty ,c_col TYPE double LOCAL ttime color$="#FF00FF" c=cairo_create(cs) cairo_set_source_rgb(c,DEC(MID$(color$, 2, 2)), DEC(MID$(color$, 4, 2)), DEC(MID$(color$, 6, 2)) ) cairo_rectangle(c, 0, 0,600, 400) cairo_fill(c)
FOR t = 0 TO 350 STEP 50.0 ISDO = 1 FOR ty= 0 TO 550 STEP 50.0 cairo_rectangle(c, ty, t,50.0, 50.0) c_col = (double)(RANDOM(32)) c_col2= (double)(RANDOM(32)) c_col3= (double)(RANDOM(32)) cairo_set_source_rgb(c,c_col, c_col2, c_col3) cairo_fill(c) NEXT NEXT cairo_surface_flush(cs) cairo_destroy(c) ISDO = 0 END SUB SUB UFO(cairo_surface_t *cs) /* goo_canvas_item_rotate (GooCanvasItem *item, gdouble degrees, gdouble cx, gdouble cy) { GooCanvasItemIface *iface = GOO_CANVAS_ITEM_GET_IFACE (item); cairo_matrix_t new_matrix = { 1, 0, 0, 1, 0, 0 }; double radians = degrees * (M_PI / 180);
iface->get_transform (item, &new_matrix); cairo_matrix_translate (&new_matrix, cx, cy); cairo_matrix_rotate (&new_matrix, radians); cairo_matrix_translate (&new_matrix, -cx, -cy); iface->set_transform (item, &new_matrix); */ ISDO = 0 color$="#FF00E2" DECLARE xs = 1 TYPE double DECLARE ys = 1 TYPE double 'DECLARE a = 350 TYPE double DECLARE a = 700 TYPE double b = (double)a * a ' DECLARE c = 300 TYPE double DECLARE c = 600 TYPE double DECLARE q,r,y TYPE double DECLARE i,m,n,p,x,st TYPE double ia = (double)1/a LOCAL *cr TYPE cairo_t cr=cairo_create(cs)
'cairo_scale(cr,0.5,0.5) start=TIMER cairo_set_source_rgb(cr,1.0, 1.0,0.0) cairo_rectangle(cr, 0, 0,800, 800) cairo_fill(cr) cairo_scale(cr,0.5,0.5) 'cairo_rotate(cr,Rot) cairo_set_source_rgb(cr,DEC(MID$(color$, 2, 2)), DEC(MID$(color$, 4, 2)), DEC(MID$(color$, 6, 2)) ) 'PRINT " a " , a , " Step " , xs, FOR x = 0 TO a STEP 2 s = x * x p = SQR(b - s) st=6*ys FOR i = -p TO p STEP st r = SQR(s + i * i) /a q = (r -1.0) * SIN(24 * r) y = FLOOR(i/3 + q * c) IF i=-p THEN m=y n=y END IF IF y > m THEN m = y IF y < n THEN n = y IF m = y OR n = y THEN cairo_rectangle(cr, (double)-x+800, (double)y+700,2.0, 2.0) cairo_fill(cr) cairo_rectangle(cr, (double)x+800,(double)y+700,2.0, 2.0) cairo_fill(cr) END IF NEXT NEXT
cairo_surface_flush(cs) cairo_destroy(cr) ISDO = 0 PRINT "Render Time ",TIMER-start , " mSec" END SUB SUB DRAW_2(cairo_surface_t *cs,double xpos,double ypos)
LOCAL *c TYPE cairo_t LOCAL t ,ty ,c_col TYPE double LOCAL ttime
c=cairo_create(cs) cairo_set_source_rgb(c,0.0, 1.0,0.0) cairo_rectangle(c, 0, 0,200, 200) cairo_fill(c)
FOR t = 0 TO 200 STEP 10.0 ISDO = 1 FOR ty= 0 TO 200 STEP 10.0 cairo_rectangle(c, ty, t,10.0, 10.0) c_col = (double)(RANDOM(32)) c_col2= (double)(RANDOM(32)) c_col3= (double)(RANDOM(32)) cairo_set_source_rgb(c,c_col,c_col2, c_col3) cairo_fill(c) NEXT NEXT cairo_surface_flush(cs) cairo_destroy(c) ISDO = 0 END SUB '@ RECORD for storing window Geometry RECORD geometry LOCAL x , y ,width,height ,border,depth TYPE int LOCAL root END RECORD ' @ getting Geometry SUB Geometry(NUMBER window)
XGetGeometry(d,window,&geometry.root,&geometry.x,&geometry.y,&geometry.width,&geometry.height,&geometry.border,&geometry.depth) WITH geometry PRINT geometry.x PRINT geometry.y PRINT geometry.width PRINT geometry.height PRINT geometry.border PRINT geometry.depth END WITH
END SUB
'@ for display DECLARE d TYPE Display* 'Display *display d = XOpenDisplay(NULL) s = DefaultScreen(d) root = DefaultRootWindow(d)
'@ for Main
attributes.event_mask = KeyPressMask | KeyReleaseMask | KeymapStateMask | ButtonPressMask | ButtonReleaseMask | EnterWindowMask | LeaveWindowMask | ExposureMask | VisibilityChangeMask | StructureNotifyMask | SubstructureNotifyMask | SubstructureRedirectMask | FocusChangeMask /* Various window attributes */ attributes.backing_store = Always attributes.save_under = True attributes.override_redirect = False attributes.background_pixel = WhitePixel(d, s) '@ Creat main window w = XCreateWindow( d, root, 0, 0, 800, 800, 0,CopyFromParent, InputOutput, CopyFromParent,CWBackingStore|CWOverrideRedirect|CWEventMask|CWSaveUnder|CWBackPixel,&attributes ) '@ added make window none resize by setting min max the same PROTO XSizeHints PROTO XSetNormalHints PROTO XWMHints PROTO XAllocWMHints PROTO XAllocClassHint PROTO XAllocSizeHints
DECLARE size_hints TYPE XSizeHints* DECLARE wm_hints TYPE XWMHints* DECLARE class_hints TYPE XClassHint * size_hints = XAllocSizeHints() wm_hints = XAllocWMHints() class_hints = XAllocClassHint() REM ------------------------------ size_hints->flags = PPosition | PSize | PMinSize |PMaxSize size_hints->min_width = 800 size_hints->min_height = 800 size_hints->max_width = 800 size_hints->max_height = 800 PROTO XSetWMNormalHints XSetWMNormalHints(d,w,size_hints)
'XSetNormalHints(d,w,size_hints) XStoreName(d, w, "X11+ Cairo double buffer / Press key to Exit") '@ create a sub window , have used this since can use as widget + can make easy detection for collisions using animation child_win = XCreateSimpleWindow(d, w, 50,50, \ 200, 200, \ 2, \ WhitePixel(d, s), \ BlackPixel(d, s)) '@ set som WM protocols , although they do not work have left code as is DECLARE wmProtocols[3] TYPE Atom DECLARE wmDeleteWindow TYPE Atom DECLARE wmTakeFocus TYPE Atom '@ think possible have a bacon problem with arrays but not sure the delete event is def not working but press any key to esc wmProtocols[0] = XInternAtom(d, "WM_PROTOCOLS", True) wmProtocols[1] = wmDeleteWindow = XInternAtom(d, "WM_DELETE_WINDOW", False) wmProtocols[2] = wmTakeFocus = XInternAtom(d, "WM_TAKE_FOCUS", False) XSetWMProtocols(d, w, wmProtocols, 3) /* Allocate back buffer */ /* From XdbeSwapBuffers man page : */ /* XdbeUndefined */ /* The contents of the new back buffer become undefined. This may */ /* be the most efficient action since it allows the implementation */ /* to discard the contents of the buffer if it needs to. */ /* ... so we'll have to do the cleanup by hand. And as we didn't specify any */ '@ bits for main
'@ Main back-buffer backBuffer = XdbeAllocateBackBufferName(d, w, XdbeUndefined) /* Get back buffer attributes (used for swapping) */ backAttr = XdbeGetBackBufferAttributes(d, backBuffer) swapInfo.swap_window = backAttr->window swapInfo.swap_action = XdbeUndefined '@ back-buffer for child win backBuffer2 = XdbeAllocateBackBufferName(d, child_win, XdbeUndefined) /* Get back buffer attributes (used for swapping) */ backAttr2 = XdbeGetBackBufferAttributes(d, backBuffer2) swapInfo2.swap_window = backAttr2->window swapInfo2.swap_action = XdbeUndefined PROTO XFree PROTO XRaiseWindow '@ free the back buffer attribures XFree(backAttr) XFree(backAttr2) '@ Creat cairo surfaces and map to the back buffers cs=cairo_xlib_surface_create(d, backBuffer, DefaultVisual(d, 0),800, 800) cs_child_win=cairo_xlib_surface_create(d, backBuffer2, DefaultVisual(d, 0),800, 800) IF cs THEN PRINT "Cairo OK"
ELSE PRINT "Cairo fail" END IF '@ map windows and raise main to top dog XMapWindow(d, w) XRaiseWindow(d, w) 'XMapWindow(d, child_win) '@ check if can double buffer doing = 0 IF (XdbeQueryExtension(d, &major, &minor)) THEN PRINT "OK", major, " : " , minor doing=1 END IF
xpos = 0 Can_draw=0 Xpoed=0 DECLARE Rot = 0.0 TYPE double WHILE (doing) '@ use pending events . IF pending do not draw Read though to end at ELSE IF (XPending(d)) THEN XNextEvent(d, &e)
SELECT e.type CASE Expose PRINT "Expose"
CASE KeyPress BREAK CASE ConfigureNotify INCR Xpoed '@ ensure the window is realised before double buffering IF Xpoed = 2 THEN Can_draw = 1 'Geometry(w) 'PRINT "ConfigureNotify width ",geometry.width 'cairo_xlib_surface_set_size(cs,geometry.width,geometry.height) CASE ClientMessage PRINT " Client" IF (e.xclient.message_type == wmProtocols[0]) THEN PRINT " Do Something Here" END IF IF (e.xclient.data.l[1] == wmDeleteWindow) THEN run = FALSE PRINT "Delete" ELIF (e.xclient.data.l[0] == wmTakeFocus) THEN /* The WM wants the window to gain focus. */ PRINT " Focus" XSetInputFocus(d, e.xclient.window, RevertToParent, CurrentTime) END IF END SELECT ELSE '@ draw on main 'DRAW_1(cs,100,70) IF Can_draw THEN UFO(cs) '@ swap main win double buffer XdbeSwapBuffers(d, &swapInfo, 1) '@ draw on child 'DRAW_2(cs_child_win,100,70) '@ swap main win double buffer 'XdbeSwapBuffers(d, &swapInfo2, 1) SLEEP (20) END IF INCR Rot PRINT xpos 'IF xpos = 50 THEN 'PRINT "unmap" 'XUnmapWindow(d,child_win) ' 'END IF 'IF xpos = 100 THEN 'XMapWindow(d, child_win) 'END IF END IF WEND
'@ checking last cr is not left in memory IF = 1 then problem : free the bits PRINT " exit : ISDO : ",ISDO cairo_surface_destroy(cs) cairo_surface_destroy(cs_child_win) 'XFreeGC(d, gc) PRINT " GC Free" XFlush(d) XCloseDisplay(d) PRINT " Done"
|
|
|
Post by vovchik on Feb 17, 2014 14:30:48 GMT 1
Dear Alex, This is what I did for the colours, mainly: ' cairo double buffering X11 test card = set window resize false. ' this will prevent the no name double buffer bug on resizable window ' vov = added ButtonPress in SELECT/CASE to exit and rbga
' *********************** ' COMPILER DIRECTIVES ' ***********************
PRAGMA LDFLAGS `pkg-config --cflags --libs x11 --libs xext --libs cairo` PRAGMA INCLUDE /usr/include/X11/Xlib.h PRAGMA INCLUDE /usr/include/X11/Xutil.h PRAGMA INCLUDE /usr/include/X11/Xos.h PRAGMA INCLUDE /usr/include/X11/keysym.h PRAGMA INCLUDE /usr/include/X11/extensions/Xdbe.h ' PRAGMA INCLUDE cairo.h ' PRAGMA INCLUDE cairo-xlib.h ' for new compile scheme PRAGMA INCLUDE cairo/cairo.h PRAGMA INCLUDE cairo/cairo-xlib.h
' *********************** ' END COMPILER DIRECTIVES ' ***********************
' *********************** ' EXTERNAL FUNCTIONS ' ***********************
' Cairo bits PROTO cairo_pattern_set_extend PROTO cairo_xlib_surface_set_size PROTO cairo_reference PROTO cairo_xlib_surface_create PROTO cairo_xlib_surface_create_for_bitmap PROTO cairo_xlib_surface_set_size PROTO cairo_xlib_surface_get_display PROTO cairo_xlib_surface_get_screen PROTO cairo_xlib_surface_set_drawable PROTO cairo_xlib_surface_get_drawable PROTO cairo_xlib_surface_get_visual PROTO cairo_xlib_surface_get_width PROTO cairo_xlib_surface_get_heigh PROTO cairo_xlib_surface_get_depth PROTO cairo_surface_flush PROTO cairo_create PROTO cairo_rectangle PROTO cairo_set_source_rgb PROTO cairo_fill PROTO cairo_move_to PROTO cairo_set_source_rgb PROTO cairo_show_text PROTO cairo_show_page PROTO cairo_destroy PROTO cairo_surface_destroy PROTO cairo_set_font_size PROTO cairo_line_to PROTO cairo_save PROTO cairo_set_line_width PROTO cairo_stroke ' X11 bits PROTO XGetGeometry PROTO XStoreName PROTO DefaultScreen PROTO XCreateSimpleWindow PROTO RootWindow PROTO XSelectInput PROTO XMapWindow PROTO XNextEvent PROTO XFillRectangle PROTO XDrawString PROTO XCloseDisplay PROTO XFlush PROTO XCreateWindow PROTO DefaultRootWindow PROTO XNextEvent PROTO XSetForeground PROTO XClearWindow ' setting Attributes ' for delete event PROTO XInternAtom PROTO XSetWMProtocols PROTO Atom PROTO GC PROTO XGCValues PROTO XdbeSwapBuffers PROTO XSetWindowAttributes ' for double buffering PROTO XdbeBackBuffer PROTO XdbeQueryExtension PROTO XdbeUndefined PROTO XdbeAllocateBackBufferName PROTO XdbeGetBackBufferAttributes PROTO XSetInputFocus PROTO XFreeGC PROTO XdbeBackBuffer PROTO XdbeSwapInfo PROTO XdbeBackBufferAttributes ' added make window none resize by setting min max the same PROTO XSizeHints PROTO XSetNormalHints PROTO XWMHints PROTO XAllocWMHints PROTO XAllocClassHint PROTO XAllocSizeHints PROTO XSetWMNormalHints PROTO XFree PROTO XRaiseWindow ' vovchik PROTO cairo_set_source_rgba PROTO cairo_pattern_create_rgba PROTO cairo_pattern_create_linear PROTO cairo_pattern_create_radial PROTO cairo_fill PROTO cairo_set_source PROTO cairo_set_line_width PROTO cairo_translate PROTO cairo_set_antialias PROTO cairo_pattern_add_color_stop_rgba PROTO cairo_pattern_destroy ' alex ufo PROTO cairo_scale ' vovchik PROTO cairo_set_source_rgb
' *********************** ' END EXTERNAL FUNCTIONS ' ***********************
' *********************** ' INITIALIZATION ' ***********************
' pointer to X Display structure DECLARE attributes TYPE XSetWindowAttributes ' pointer to the newly created window DECLARE w TYPE Window ' pointer to the XEvent DECLARE e TYPE XEvent ' number of screen to place the window on DECLARE s TYPE int ' for double buffer DECLARE major, minor TYPE int ' RECORD for storing window Geometry RECORD geometry LOCAL x, y, width,height, border, depth TYPE int LOCAL root END RECORD DECLARE d_backBuf TYPE XdbeBackBuffer DECLARE *backAttr TYPE XdbeBackBufferAttributes DECLARE swapInfo TYPE XdbeSwapInfo DECLARE d_backBuf2 TYPE XdbeBackBuffer DECLARE *backAttr2 TYPE XdbeBackBufferAttributes DECLARE swapInfo2 TYPE XdbeSwapInfo DECLARE *cs TYPE cairo_surface_t DECLARE *cs_child_win TYPE cairo_surface_t ISDO = 0
' *********************** ' END INITIALIZATION ' ***********************
' *********************** ' SUBS & FUNCTIONS ' ***********************
' ------------------ FUNCTION HEX2RGB(STRING hex$, int byte) ' ------------------ ' Author - vovchik ' converts bytes of an html/css color specification ' to rgb value suitable for cairo (decimal) ranging ' in value from 0 to 1. The # affix is needed for ' hex values. 'Named colors' can also be used, as per ' [url]http://cloford.com/resources/colours/namedcol.htm[/url] LOCAL rgb, tmp TYPE double LOCAL i, name_found TYPE int LOCAL named$[138] TYPE STRING named$[ 0] = "aliceblue|#F0F8FF" named$[ 1] = "antiquewhite|#FAEBD7" named$[ 2] = "aqua|#00FFFF" named$[ 3] = "aquamarine|#7FFFD4" named$[ 4] = "azure|#F0FFFF" named$[ 5] = "beige|#F5F5DC" named$[ 6] = "bisque|#FFE4C4" named$[ 7] = "black|#000000" named$[ 8] = "blanchedalmond|#FFEBCD" named$[ 9] = "blue|#0000FF" named$[ 10] = "blueviolet|#8A2BE2" named$[ 11] = "brown|#A52A2A" named$[ 12] = "burlywood|#DEB887" named$[ 13] = "cadetblue|#5F9EA0" named$[ 14] = "chartreuse|#7FFF00" named$[ 15] = "chocolate|#D2691E" named$[ 16] = "coral|#FF7F50" named$[ 17] = "cornflowerblue|#6495ED" named$[ 18] = "cornsilk|#FFF8DC" named$[ 19] = "crimson|#DC143C" named$[ 20] = "darkblue|#00008B" named$[ 21] = "darkcyan|#008B8B" named$[ 22] = "darkgoldenrod|#B8860B" named$[ 23] = "darkgray|#A9A9A9" named$[ 24] = "darkgreen|#006400" named$[ 25] = "darkkhaki|#BDB76B" named$[ 26] = "darkmagenta|#8B008B" named$[ 27] = "darkolivegreen|#556B2F" named$[ 28] = "darkorange|#FF8C00" named$[ 29] = "darkorchid|#9932CC" named$[ 30] = "darkred|#8B0000" named$[ 31] = "darksalmon|#E9967A" named$[ 32] = "darkseagreen|#8FBC8F" named$[ 33] = "darkslateblue|#483D8B" named$[ 34] = "darkslategray|#2F4F4F" named$[ 35] = "darkturquoise|#00CED1" named$[ 36] = "darkviolet|#9400D3" named$[ 37] = "deeppink|#FF1493" named$[ 38] = "deepskyblue|#00BFFF" named$[ 39] = "dimgray|#696969" named$[ 40] = "dodgerblue|#1E90FF" named$[ 41] = "firebrick|#B22222" named$[ 42] = "floralwhite|#FFFAF0" named$[ 43] = "forestgreen|#228B22" named$[ 44] = "fuchsia|#FF00FF" named$[ 45] = "gainsboro|#DCDCDC" named$[ 46] = "ghostwhite|#F8F8FF" named$[ 47] = "goldenrod|#DAA520" named$[ 48] = "gold|#FFD700" named$[ 49] = "gray|#808080" named$[ 50] = "green|#008000" named$[ 51] = "greenyellow|#ADFF2F" named$[ 52] = "honeydew|#F0FFF0" named$[ 53] = "hotpink|#FF69B4" named$[ 54] = "indianred|#CD5C5C" named$[ 55] = "indigo|#4B0082" named$[ 56] = "ivory|#FFFFF0" named$[ 57] = "khaki|#F0E68C" named$[ 58] = "lavenderblush|#FFF0F5" named$[ 59] = "lavender|#E6E6FA" named$[ 60] = "lawngreen|#7CFC00" named$[ 61] = "lemonchiffon|#FFFACD" named$[ 62] = "lightblue|#ADD8E6" named$[ 63] = "lightcoral|#F08080" named$[ 64] = "lightcyan|#E0FFFF" named$[ 65] = "lightgoldenrodyellow|#FAFAD2" named$[ 66] = "lightgreen|#90EE90" named$[ 67] = "lightgrey|#D3D3D3" named$[ 68] = "lightpink|#FFB6C1" named$[ 69] = "lightsalmon|#FFA07A" named$[ 70] = "lightseagreen|#20B2AA" named$[ 71] = "lightskyblue|#87CEFA" named$[ 72] = "lightslategray|#778899" named$[ 73] = "lightsteelblue|#B0C4DE" named$[ 74] = "lightyellow|#FFFFE0" named$[ 75] = "lime|#00FF00" named$[ 76] = "limegreen|#32CD32" named$[ 77] = "linen|#FAF0E6" named$[ 78] = "maroon|#800000" named$[ 79] = "mediumaquamarine|#66CDAA" named$[ 80] = "mediumblue|#0000CD" named$[ 81] = "mediumorchid|#BA55D3" named$[ 82] = "mediumpurple|#9370DB" named$[ 83] = "mediumseagreen|#3CB371" named$[ 84] = "mediumslateblue|#7B68EE" named$[ 85] = "mediumspringgreen|#00FA9A" named$[ 86] = "mediumturquoise|#48D1CC" named$[ 87] = "mediumvioletred|#C71585" named$[ 88] = "midnightblue|#191970" named$[ 89] = "mintcream|#F5FFFA" named$[ 90] = "mistyrose|#FFE4E1" named$[ 91] = "moccasin|#FFE4B5" named$[ 92] = "navajowhite|#FFDEAD" named$[ 93] = "navy|#000080" named$[ 94] = "oldlace|#FDF5E6" named$[ 95] = "olive|#808000" named$[ 96] = "olivedrab|#6B8E23" named$[ 97] = "orange|#FFA500" named$[ 98] = "orangered|#FF4500" named$[ 99] = "orchid|#DA70D6" named$[100] = "palegoldenrod|#EEE8AA" named$[101] = "palegreen|#98FB98" named$[102] = "paleturquoise|#AFEEEE" named$[103] = "palevioletred|#DB7093" named$[104] = "papayawhip|#FFEFD5" named$[105] = "peachpuff|#FFDAB9" named$[106] = "peru|#CD853F" named$[107] = "pink|#FFC0CB" named$[108] = "plum|#DDA0DD" named$[109] = "powderblue|#B0E0E6" named$[110] = "purple|#800080" named$[111] = "red|#FF0000" named$[112] = "rosybrown|#BC8F8F" named$[113] = "royalblue|#4169E1" named$[114] = "saddlebrown|#8B4513" named$[115] = "salmon|#FA8072" named$[116] = "sandybrown|#F4A460" named$[117] = "seagreen|#2E8B57" named$[118] = "seashell|#FFF5EE" named$[119] = "sienna|#A0522D" named$[120] = "silver|#C0C0C0" named$[121] = "skyblue|#87CEEB" named$[122] = "slateblue|#6A5ACD" named$[123] = "slategray|#708090" named$[124] = "snow|#FFFAFA" named$[125] = "springgreen|#00FF7F" named$[126] = "steelblue|#4682B4" named$[127] = "tan|#D2B48C" named$[128] = "teal|#008080" named$[129] = "thistle|#D8BFD8" named$[130] = "tomato|#FF6347" named$[131] = "turquoise|#40E0D0" named$[132] = "violet|#EE82EE" named$[133] = "wheat|#F5DEB3" named$[134] = "white|#FFFFFF" named$[135] = "whitesmoke|#F5F5F5" named$[136] = "yellow|#FFFF00" named$[137] = "yellowgreen|#9ACD32" named_found = FALSE ' check whether a named color is being used IF MID$(hex$, 1, 1) <> "#" THEN FOR i = 0 TO 137 IF hex$ = MID$(named$[i], 1, INSTR(named$[i], "|") - 1) THEN hex$ = MID$(named$[i], INSTR(named$[i], "|") + 1) name_found = TRUE BREAK END IF NEXT i IF ISFALSE(name_found) THEN ' if hex$ is invalid named color, convert to white PRINT "Invalid named color: ", hex$ hex$ = "#FFFFFF" END IF ELSE ' check whether css/html hex$ is valid IF ISFALSE(REGEX(hex$, "^#([A-Fa-f0-9]{6}|[A-Fa-f0-9]{3})$")) THEN ' if hex$ is bad, convert to white PRINT "Invalid hex number: ", hex$ hex$ = "#FFFFFF" END IF END IF SELECT byte CASE 1 tmp = DEC(MID$(hex$, 2, 2)) CASE 2 tmp = DEC(MID$(hex$, 4, 2)) CASE 3 tmp = DEC(MID$(hex$, 6, 2)) END SELECT rgb = tmp / 255.0 RETURN rgb END FUNCTION
' ------------------ SUB UFO(cairo_surface_t *cs) ' ------------------ LOCAL color$ TYPE STRING ISDO = 0 DECLARE xs = 1 TYPE int DECLARE ys = 1 TYPE int DECLARE a = 700 TYPE int b = a * a DECLARE c = 600 TYPE int DECLARE q, r, y TYPE float DECLARE i, m, n, p, x, st TYPE int DECLARE ia TYPE double ia = (double)(1/a) DECLARE *cr TYPE cairo_t cr = cairo_create(cs) color$ = "black" cairo_set_source_rgba(cr, \ HEX2RGB(color$, 1), \ HEX2RGB(color$, 2), \ HEX2RGB(color$, 2), \ 1.0) 'cairo_set_source_rgba(cr, 0.0, 0.0, 0.0, 0.9) cairo_rectangle(cr, 0, 0, 800, 800) cairo_fill(cr) cairo_scale(cr, 0.5, 0.5) color$ = "aqua" cairo_set_source_rgba(cr, \ HEX2RGB(color$, 1), \ HEX2RGB(color$, 2), \ HEX2RGB(color$, 2), \ 0.8) FOR x = 0 TO a STEP xs s = x * x p = SQR(b - s) st = 6 * ys FOR i = -p TO p STEP st r = SQR(s + i * i) / a q = (r - 1.0) * SIN(24 * r) y = FLOOR(i / 3 + q * c) IF i= -p THEN m = y n = y END IF IF y > m THEN m = y IF y < n THEN n = y IF m = y OR n = y THEN cairo_rectangle(cr, (double)(-x + 800), (double)(y + 700), 1.0, 1.0) cairo_fill(cr) cairo_rectangle(cr, (double)(x + 800), (double)(y + 700), 1.0, 1.0) cairo_fill(cr) END IF NEXT i NEXT x cairo_surface_flush(cs) cairo_destroy(cr) ISDO = 0 END SUB
' ------------------ SUB GEOMETRY(NUMBER window) ' ------------------ ' getting Geometry XGetGeometry(d, window, &geometry.root, &geometry.x, &geometry.y, \ &geometry.width,&geometry.height,&geometry.border,&geometry.depth) WITH geometry PRINT geometry.x PRINT geometry.y PRINT geometry.width PRINT geometry.height PRINT geometry.border PRINT geometry.depth END WITH END SUB
' ------------------ SUB MK_DRAWING() ' ------------------ ' for display DECLARE d TYPE Display* DECLARE size_hints TYPE XSizeHints* DECLARE wm_hints TYPE XWMHints* DECLARE class_hints TYPE XClassHint * DECLARE wmProtocols[3] TYPE Atom DECLARE wmDeleteWindow TYPE Atom DECLARE wmTakeFocus TYPE Atom 'Display *display d = XOpenDisplay(NULL) s = DefaultScreen(d) root = DefaultRootWindow(d) ' for Main attributes.event_mask = KeyPressMask | KeyReleaseMask | \ KeymapStateMask | ButtonPressMask | ButtonReleaseMask | \ EnterWindowMask | LeaveWindowMask | ExposureMask | \ VisibilityChangeMask | StructureNotifyMask | \ SubstructureNotifyMask | SubstructureRedirectMask | \ FocusChangeMask ' Various window attributes attributes.backing_store = Always attributes.save_under = TRUE attributes.override_redirect = FALSE attributes.background_pixel = WhitePixel(d, s) ' Creat main window w = XCreateWindow(d, root, 0, 0, 800, 800, 0, CopyFromParent, \ InputOutput, CopyFromParent,CWBackingStore|CWOverrideRedirect| \ CWEventMask|CWSaveUnder|CWBackPixel,&attributes ) size_hints = XAllocSizeHints() wm_hints = XAllocWMHints() class_hints = XAllocClassHint() size_hints->flags = PPosition | PSize | PMinSize |PMaxSize size_hints->min_width = 800 size_hints->min_height = 800 size_hints->max_width = 800 size_hints->max_height = 800 XSetWMNormalHints(d,w,size_hints) 'XSetNormalHints(d,w,size_hints) XStoreName(d, w, "X11/Cairo double buffer with alpha - press key or mouse button to exit") ' create a sub window , have used this since can use as widget + ' can make easy detection for collisions using animation child_win = XCreateSimpleWindow(d, w, 0, 0, \ 800, 800, 2, WhitePixel(d, s), BlackPixel(d, s)) ' set some WM protocols , although they do not work have left code as is ' think possible have a bacon problem with arrays but not sure ' the delete event is def not working but press any key to esc wmProtocols[0] = XInternAtom(d, "WM_PROTOCOLS", TRUE) wmProtocols[1] = wmDeleteWindow = XInternAtom(d, "WM_DELETE_WINDOW", FALSE) wmProtocols[2] = wmTakeFocus = XInternAtom(d, "WM_TAKE_FOCUS", FALSE) XSetWMProtocols(d, w, wmProtocols, 3) ' Allocate back buffer ' From XdbeSwapBuffers man page : ' XdbeUndefined ' The contents of the new back buffer become undefined. This may ' be the most efficient action since it allows the implementation ' to discard the contents of the buffer if it needs to. ' ... so we't specify any '@ bits for main '@ Main back-buffer backBuffer = XdbeAllocateBackBufferName(d, w, XdbeUndefined) ' Get back buffer attributes (used for swapping) backAttr = XdbeGetBackBufferAttributes(d, backBuffer) swapInfo.swap_window = backAttr->window swapInfo.swap_action = XdbeUndefined '@ back-buffer for child win backBuffer2 = XdbeAllocateBackBufferName(d, child_win, XdbeUndefined) ' Get back buffer attributes (used for swapping) backAttr2 = XdbeGetBackBufferAttributes(d, backBuffer2) swapInfo2.swap_window = backAttr2->window swapInfo2.swap_action = XdbeUndefined ' free the back buffer attribures XFree(backAttr) XFree(backAttr2) ' Creat cairo surfaces and map to the back buffers cs = cairo_xlib_surface_create(d, backBuffer, DefaultVisual(d, 0), \ 800, 800) IF cs THEN PRINT "Cairo OK" ELSE PRINT "Cairo fail" END IF ' map windows and raise main to top dog XMapWindow(d, w) XRaiseWindow(d, w) ' check if can double buffer doing = 0 IF (XdbeQueryExtension(d, &major, &minor)) THEN PRINT "OK", major, " : " , minor doing = 1 END IF xpos = 0 Can_draw = 0 Xpoed = 0 WHILE doing DO ' use pending events . IF pending do not draw Read though to end at ELSE IF (XPending(d)) THEN XNextEvent(d, &e) SELECT e.type CASE Expose PRINT "Expose" INCR Xpoed ' ensure the window is realised before double buffering IF Xpoed = 4 THEN Can_draw = 1 CASE KeyPress; CASE ButtonPress BREAK CASE ConfigureNotify GEOMETRY(w) PRINT "ConfigureNotify width ", geometry.width cairo_xlib_surface_set_size(cs, geometry.width, \ geometry.height) CASE ClientMessage PRINT " Client" IF (e.xclient.message_type == wmProtocols[0]) THEN PRINT " Do Something Here" END IF IF (e.xclient.data.l[1] == wmDeleteWindow) THEN run = FALSE PRINT "Delete" ELIF (e.xclient.data.l[0] == wmTakeFocus) THEN ' The WM wants the window to gain focus. PRINT " Focus" XSetInputFocus(d, e.xclient.window, \ RevertToParent, CurrentTime) END IF END SELECT ELSE ' draw on main UFO(cs) XdbeSwapBuffers(d, &swapInfo, 1) SLEEP 60 END IF WEND END SUB
' *********************** ' END SUBS & FUNCTIONS ' ***********************
' *********************** ' MAIN ' ***********************
MK_DRAWING() ' checking last cr is not left in memory IF = 1 then problem : free the bits PRINT " exit : ISDO : ", ISDO cairo_surface_destroy(cs) cairo_surface_destroy(cs_child_win) 'XFreeGC(d, gc) PRINT " GC Free" XFlush(d) XCloseDisplay(d) PRINT " Done"
' *********************** ' END MAIN ' ***********************
With kind regards, vovchik Attachments:
|
|
|
Post by bigbass on Feb 17, 2014 14:54:18 GMT 1
Hey Alex I agree working code speaks the loudest An EXCELLENT demo to express just a sample of what just cairo can do without a library on top we can make it anyway from scratch adding in whatever we need to extend the power of BaCon ! P.S you did that rather quickly I may add @vochik thanks for the demo too both yours and Alex's work for me Joe
|
|
|
Post by alexfish on Feb 17, 2014 15:08:22 GMT 1
Hi Joe , Thanks again, Here is a screen shot of the render , Note :: see how refined and smooth the render is compared to SDL direct or GL , There is a GL example on Oxygen Basic Forum .. BR Alex Picture for all to compare , Attachments:
|
|
|
Post by vovchik on Feb 17, 2014 15:31:29 GMT 1
Dear Alex and Joe, I looked at that Oxygen Basic ufo image. Yes, it looks pretty ugly, but, then, some GL smoothing tricks are not used (and could be) and the colour depth is low (I think). But the Alex cairo version speaks for itself. This is the link to the Oxygen Basic image: h2o_ufo. With kind regards, vovchik
|
|
|
Post by vovchik on Feb 17, 2014 17:04:24 GMT 1
Dear Joe and Alex, And here another ufo, but with a gratuitous bit of radial gradient thrown in... With kind regards, vovchik
|
|