From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Vladimir Zhbanov <vzhbanov@gmail.com> Newsgroups: gmane.lisp.guile.user Subject: Re: Example usages of guile-cairo Date: Wed, 27 Jul 2016 22:30:27 +0300 Message-ID: <20160727193027.GB21477@localhost.localdomain> References: <CAMFYt2aWLCOJxVqUtx-dj4P8oOPzUpD0R=QMfztPgy6Cn9P48w@mail.gmail.com> <20160715201922.GB12575@localhost.localdomain> <CAMFYt2aHs0ChZzEFMucvXnWp6tNO2H_AQSrJawArdg+TZRy1xQ@mail.gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="wac7ysb48OaltWcw" X-Trace: ger.gmane.org 1469647867 22528 80.91.229.3 (27 Jul 2016 19:31:07 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 27 Jul 2016 19:31:07 +0000 (UTC) To: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Wed Jul 27 21:31:02 2016 Return-path: <guile-user-bounces+guile-user=m.gmane.org@gnu.org> Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from <guile-user-bounces+guile-user=m.gmane.org@gnu.org>) id 1bSUXl-0004Ef-A5 for guile-user@m.gmane.org; Wed, 27 Jul 2016 21:31:01 +0200 Original-Received: from localhost ([::1]:48323 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from <guile-user-bounces+guile-user=m.gmane.org@gnu.org>) id 1bSUXk-0008HW-Gj for guile-user@m.gmane.org; Wed, 27 Jul 2016 15:31:00 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:45874) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from <vzhbanov@gmail.com>) id 1bSUXN-0008HC-Tz for guile-user@gnu.org; Wed, 27 Jul 2016 15:30:39 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from <vzhbanov@gmail.com>) id 1bSUXK-0004ee-5F for guile-user@gnu.org; Wed, 27 Jul 2016 15:30:37 -0400 Original-Received: from mail-lf0-x22b.google.com ([2a00:1450:4010:c07::22b]:35413) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <vzhbanov@gmail.com>) id 1bSUXJ-0004eI-PR for guile-user@gnu.org; Wed, 27 Jul 2016 15:30:34 -0400 Original-Received: by mail-lf0-x22b.google.com with SMTP id f93so34475611lfi.2 for <guile-user@gnu.org>; Wed, 27 Jul 2016 12:30:31 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=date:from:to:subject:message-id:mail-followup-to:references :mime-version:content-disposition:in-reply-to:user-agent; bh=ASdV2k5nD84tieTkKaez0OwEaIjDgm7+dauPIdX2Vck=; b=HFRBwSdzqPuq2876izyTJQnq0lsBmv8ooTPeuMRKv8GMcAdAO18LnyUwKHqNBSZK68 e3zuryUFszQYRAeUE2V5AIplZpe4Co5KZKRTxxZzNdI0vVYDsN2TPVwoHODrfan6/dDr +ztxPp5utGwEq58s2mcthBXKOarygq+8oj/fvOUQwfOz8sKu5t5bMzVcLXY93JD4piHR FVb+uuMeYY8AHZ7Cy7gkF4kDoEYv/Xn8/wAJ9E5YogsO422Vn0BPF2nz5wK6qAMlaE0p nw6HtHKNo8fKurgl0QkQILTX+rpJMUBDFIVnXgHPNkykURRlBjz2Hzqxktd0vKXG7UGo 1+YA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:date:from:to:subject:message-id:mail-followup-to :references:mime-version:content-disposition:in-reply-to:user-agent; bh=ASdV2k5nD84tieTkKaez0OwEaIjDgm7+dauPIdX2Vck=; b=C9nVKLwDgke1y0b2e7yXyfN0pfDXQnKCO6v53SFFVwqPT0NiApekoCO3YghnGcvqI7 G+lF1TTZ0pGcO+hso1ul8OuzNdGgSB7NErdbvW0ur879Kx0SCTjfx/tjFMZxHPMg4F2S Izt5YcA3l23ibKKPtVRL4IVu4BOoQzjrN4DAj4Fr2APXDtaiseFZvjPgpxxv5837DaBf sxryRuEuROuAnc0ORlILZZbdAlRQv/GD/CK1l8UQAtYrHlnh/JlOKZIRgXlkfrSN1QIU DLNtKffqPMsR7YfmiGkHty73bl3kRXBkTUY4rayIi80tRXWSkSSDtbRmfj5GLIlF2JCX qJzA== X-Gm-Message-State: AEkoouvTwPr1YxcipQv1RWos7FDOVBLJ3Ks0Hbw4Q2hl8yXerm/ZxxI/M5vuAuZ6CnVGsA== X-Received: by 10.25.210.80 with SMTP id j77mr11148828lfg.139.1469647830138; Wed, 27 Jul 2016 12:30:30 -0700 (PDT) Original-Received: from newvzh.vzh ([217.107.127.93]) by smtp.gmail.com with ESMTPSA id 78sm1233095lfv.39.2016.07.27.12.30.28 for <guile-user@gnu.org> (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Wed, 27 Jul 2016 12:30:29 -0700 (PDT) Original-Received: from vovka by newvzh.vzh with local (Exim 4.84_2) (envelope-from <vzhbanov@gmail.com>) id 1bSUXD-0003lo-EK for guile-user@gnu.org; Wed, 27 Jul 2016 22:30:27 +0300 Mail-Followup-To: guile-user@gnu.org Content-Disposition: inline In-Reply-To: <CAMFYt2aHs0ChZzEFMucvXnWp6tNO2H_AQSrJawArdg+TZRy1xQ@mail.gmail.com> User-Agent: Mutt/1.5.23 (2014-03-12) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2a00:1450:4010:c07::22b X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: General Guile related discussions <guile-user.gnu.org> List-Unsubscribe: <https://lists.gnu.org/mailman/options/guile-user>, <mailto:guile-user-request@gnu.org?subject=unsubscribe> List-Archive: <http://lists.gnu.org/archive/html/guile-user/> List-Post: <mailto:guile-user@gnu.org> List-Help: <mailto:guile-user-request@gnu.org?subject=help> List-Subscribe: <https://lists.gnu.org/mailman/listinfo/guile-user>, <mailto:guile-user-request@gnu.org?subject=subscribe> Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: "guile-user" <guile-user-bounces+guile-user=m.gmane.org@gnu.org> Xref: news.gmane.org gmane.lisp.guile.user:12801 Archived-At: <http://permalink.gmane.org/gmane.lisp.guile.user/12801> --wac7ysb48OaltWcw Content-Type: text/plain; charset=utf-8 Content-Disposition: inline On Sat, Jul 16, 2016 at 10:05:45AM +0200, Panicz Maciej Godek wrote: > Hi, > thanks for your reply -- I think I have solved it (although I took a > slightly different approach*) -- the problem was probably that the scale > was too small for anything to be visible, and it was sufficient to enlarge > the values of points. > > Of course, if you publish your examples, as it is always a pleasure to read > other people's ideas :) I don't think they have anything valuable Scheme-wise. Anyways, the code is attached. It uses gtk and cairo, and repeating patterns which I used to prototype custom grids on my canvas. Probably it could be useful for someone. Working on the code I've learned hard way gtk is not thread save and how to avoid this issue working in the Emacs Geiser environment. Basically, it is something like (gdk-threads-init) ; only once ; and then (and (gdk-threads-enter) (your-function) (gdk-threads-leave)) Other attempts always lead me to crashes due to non-thread-safe underground libraries (I cannot recall all, though one of which is libpango which bugged me not long ago when I worked on another issue). Even using (begin ...) instead of (and ...) lead to crashes. Now I suspect the procedures in the (begin ...) body while are executed one by one, nobody waits until any of them finishes, which leads to race conditions in the gtk case. Probably I'm wrong, don't know. Further investigation has showed me that the standard external REPL server (I still use the stock version of guile in Debian stable which is 2.0.11) doesn't even use after-eval-hook so I cannot try to automate those two calls without using work-arounds in my code. I've found the rework of REPL in the Sly (previously guile-2d) code by David Thompson which solves this for his library. Hope to see something like this in the future releases of guile. BTW, thank you for your pamphlet against R. It has given me many new ideas wrt the code I'm now working on. -- Vladimir --wac7ysb48OaltWcw Content-Type: text/plain; charset=utf-8 Content-Disposition: attachment; filename="grid.scm" (use-modules (srfi srfi-1) (oop goops) (cairo) (gnome-2) (gnome gobject) (gnome gtk)) ;;; The following commands may sometimes be very useful: ;;; (gtype-class-get-signal-names <gtk-drawing-area>) ;;; (get-property-names <gtk-drawing-area>) ;;; 3.1415926 (define pi (* 4 (atan 1))) (define (draw-sample cr width height) (let ((radius 3) (x (/ width 2)) (y (/ height 2))) ;; Use (cairo-antialias-get-values) to define the value of the ;; type <cairo-antialias-t> you need. (cairo-set-antialias cr 'none) ;; Set background color (cairo-set-source-rgba cr 0 .7 .4 .5) ;; Paint all area with it (cairo-paint cr) ;; paint a circle (cairo-set-source-rgba cr 1 1 0 1) (cairo-arc cr x y radius 0 (* 2 pi)) ;; set background color and fill it (cairo-fill-preserve cr) ;; set margin color and stroke it (cairo-set-source-rgb cr 0 0 0) (cairo-set-line-width cr 1) (cairo-stroke cr) )) (define (create-sample-surface-similar-to global-cr size scale) (let* ((width (* size scale)) (height width) ;; create a new local surface that is as compatible as possible ;; with an existing one for the global context; ;; (cairo-get-target) gets the cairo surface for the given ;; cairo context (surface (cairo-surface-create-similar (cairo-get-target global-cr) ;; Use (cairo-content-get-values) to define the ;; value of the type <cairo-content-t> you need. 'color-alpha width height)) ;; create a new cairo context for the new surface (cr (cairo-create surface))) ;; This sample will become the pattern repeated over the canvas (draw-sample cr width height) surface)) (define (dots-pattern global-cr size scale) ;; next, create a pattern for the local surface we have (let ((pattern (cairo-pattern-create-for-surface (create-sample-surface-similar-to global-cr size scale)))) ;; Adjust the pattern to make it be repeated. ;; Use (cairo-extend-get-values) to define the value of the ;; type <cairo-extend-t> you need. (cairo-pattern-set-extend pattern 'repeat) pattern)) (define (draw cr width height size scale) (let ((halfway (/ (* size scale) 2)) (pattern (dots-pattern cr size scale))) (cairo-translate cr halfway halfway) ;; set the pattern as a source for the global context (cairo-set-source cr pattern) (cairo-translate cr (- halfway) (- halfway)) ;; create a path in the global cairo context (I use the whole ;; area) (cairo-rectangle cr 0 0 width height) ;; and fill it with the pattern (cairo-fill cr) )) ;;; Get size of GDK-WINDOW ;;; We could use something like ;;; (event-coord-info (vector->list ;;; (fourth ;;; (vector->list ;;; (gdk-event->vector event))))) ;;; However there is a more specialized way. ;;; The function gdk-drawable-get-size used here is deprecated in ;;; new gtk+ versions, but I use it since guile-cairo on my Debian ;;; system is slightly old and doesn't support its replacements ;;; gdk-window-get-width and gdk-window-get-height. (define (get-size gdk-window) (call-with-values (lambda () (gdk-drawable-get-size gdk-window)) (lambda (a b) (cons a b)))) (define (grid-pattern-expose widget event) (let* ((size 15) (scale 3) (gdk-window (get widget 'window)) ;; get cairo context for gtk widget (cr (gdk-cairo-create gdk-window)) (window-size (get-size gdk-window)) (width (car window-size)) (height (cdr window-size))) (apply draw cr `(,width ,height ,size ,scale)) #f)) (define-class <grid-pattern> (<gtk-drawing-area>) #:gsignal '(hi #f)) (define-method (grid-pattern:hi (entry <grid-pattern>)) (format #t "Hi, all! I'm here! My name is ~A\n" entry)) (define (make-widget) (let ((widget (make <grid-pattern>))) (connect widget 'expose-event grid-pattern-expose) widget)) (define (make-window) (let* ((window (make <gtk-window> #:type 'toplevel #:title "Guile Cairo")) ;;;; (button (make <gtk-button> #:label "Hello, World!")) ) (set window 'border-width 10) ;;;; (add window button) ;;;; (gtype-instance-signal-connect button 'clicked (lambda (b) (gtk-main-quit))) (connect window 'destroy (lambda (b) (gtk-main-quit))) window)) ;;; Make a window and a widget for it. (define w (make-window)) (define widget (make-widget)) (add w widget) (show-all w) (emit widget 'hi) ;;; Threading (gdk-threads-init) ;;; The above command (gdk-threads-init) is not sufficient to ;;; prevent crashes in multy-threaded environment. The following ;;; pair of commands must be used in the Guile REPL to prevent ;;; crashes while working in Geiser (using a socket): ;;; (gdk-threads-enter) ;;; (gdk-threads-leave) ;;; Convenience procedures (define -> (gdk-threads-enter)) (define <- (gdk-threads-leave)) ;;; Use the following sequence: ;;; -> (your-command) <- ;;; Run main gtk loop yourself if you're working in Geiser (gtk-main) --wac7ysb48OaltWcw--