unofficial mirror of guile-user@gnu.org 
 help / color / mirror / Atom feed
From: Vladimir Zhbanov <vzhbanov@gmail.com>
To: guile-user@gnu.org
Subject: Re: Example usages of guile-cairo
Date: Wed, 27 Jul 2016 22:30:27 +0300	[thread overview]
Message-ID: <20160727193027.GB21477@localhost.localdomain> (raw)
In-Reply-To: <CAMFYt2aHs0ChZzEFMucvXnWp6tNO2H_AQSrJawArdg+TZRy1xQ@mail.gmail.com>

[-- Attachment #1: Type: text/plain, Size: 1992 bytes --]

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

[-- Attachment #2: grid.scm --]
[-- Type: text/plain, Size: 5410 bytes --]

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

  reply	other threads:[~2016-07-27 19:30 UTC|newest]

Thread overview: 5+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2016-07-06 20:01 Example usages of guile-cairo Panicz Maciej Godek
2016-07-15 20:19 ` Vladimir Zhbanov
2016-07-16  8:05   ` Panicz Maciej Godek
2016-07-27 19:30     ` Vladimir Zhbanov [this message]
2016-08-04 21:06 ` Andy Wingo

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/guile/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20160727193027.GB21477@localhost.localdomain \
    --to=vzhbanov@gmail.com \
    --cc=guile-user@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).