Re: guile-clutter - prelim work - patch 1,3,4 out of 4

[joakim]

David Pirotte <address@hidden> writes:

>> > I read this just now, sorry!
>> 
>> Hey it's OK by me, I got to do some Guile-Clutter hacking at work due to
>> your absence :-))
>
> Ha ha, yes nice work Andy, thanks
>
>       Hey, joakim, did you get to play with the latest release ?
>
> A beer to the first of you guys telling me why in the attached clutter/cairo 
> minimal
> example the bouncer does not 'show' and moves on click ...

Cool, I'll have a look!  I havent tested the release yet, but I intend
to use it for my game Matangle:

https://github.com/jave/matangle

it's currently an old school implementation, plain C wrappers for the
Clutter functions I use.

>
> Cheers,
> David
>
>
> #! /bin/sh
> # -*- scheme -*-
> exec guile -e main -s $0 "$@"
> !#
> ;; guile-gnome
> ;; Copyright (C) 2008, 2012 Free Software Foundation, Inc.
>
> ;; This program is free software; you can redistribute it and/or    
> ;; modify it under the terms of the GNU General Public License as   
> ;; published by the Free Software Foundation; either version 2 of   
> ;; the License, or (at your option) any later version.              
> ;;                                                                  
> ;; This program is distributed in the hope that it will be useful,  
> ;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
> ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
> ;; GNU General Public License for more details.                     
> ;;                                                                  
> ;; You should have received a copy of the GNU General Public License
> ;; along with this program; if not, contact:
> ;;
> ;; Free Software Foundation           Voice:  +1-617-542-5942
> ;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
> ;; Boston, MA  02111-1307,  USA       address@hidden
>
>
> (use-modules (ice-9 receive)
>            (system foreign)
>            (gnome-2)
>              (oop goops)
>            (cairo)
>              (gnome gobject)
>              (gnome glib)
>              (gnome clutter))
>
> (define pi (acos -1))
>
> (define libguile-gnome-gobject-2 (dynamic-link "libguile-gnome-gobject-2"))
> (define libguile-cairo (dynamic-link "libguile-cairo"))
>
> (define scm-c-gvalue-peek-boxed
>   (pointer->procedure 
>    '*
>    (dynamic-func "scm_c_gvalue_peek_boxed" libguile-gnome-gobject-2)
>    (list '*)))
>
> (define scm-from-cairo
>   (pointer->procedure 
>    '*
>    (dynamic-func "scm_from_cairo" libguile-cairo)
>    (list '*)))
>
> (define (fix-cairo x)
>   (pointer->scm (scm-from-cairo (scm-c-gvalue-peek-boxed (scm->pointer x)))))
>
> (define (get-colour name)
>   (or (clutter-color-from-string name)
>       (begin
>       (pk "Warning! undefined color " name)
>       '(#xff #xcc #xcc #xdd))))
>
> (define (prep-stage w h bg title loop)
>   (let ((stage  (clutter-stage-new)))
>     (set-background-color stage bg)
>     (set-size stage w h)
>     (set-title stage title)
>     (connect stage
>            'delete-event
>            (lambda (. args)
>              (g-main-loop-quit loop)
>              #t)) ;; stops the event to be propagated
>     stage))
>
> (define (draw-bouncer cairo-t cairo-cbf) ;; cairo-context-before-fix
>   (clear cairo-t)
>   (receive (w h)
>       (clutter-cairo-texture-get-surface-size cairo-t)
>     (let* ((cairo-c (fix-cairo cairo-cbf))
>          (radius (max w h))
>          (radius/2 (/ radius 2))
>          (dummy (cairo-arc cairo-c radius/2 radius/2 radius/2 0 (* 2 pi)))
>          (pattern (cairo-pattern-create-radial radius/2 radius/2 0 radius 
> radius radius))
>          (color (get-colour "Bisque4"))
>          (red (/ (car color) 255))
>          (green (/ (cadr color) 255))
>          (blue (/ (caddr color) 255))
>          (alpha (/ (cadddr color) 255)))
>       ;; (pk w h radius)
>       (cairo-pattern-add-color-stop-rgba pattern 0 red green blue alpha)
>       (cairo-pattern-add-color-stop-rgba pattern 0.85 red green blue 0.25)
>       ;; (cairo-set-source-rgba cairo-c red green blue alpha)
>       (cairo-set-source cairo-c pattern)
>       (cairo-fill-preserve cairo-c))))
>
> (define (make-bouncer w h x y stage)
>   (let ((b (clutter-cairo-texture-new w h)))
>     (connect b
>            'draw
>            (lambda (cairo-t cairo-c)
>              (pk "drawing the bouncer" cairo-t cairo-c)
>              (draw-bouncer cairo-t cairo-c)
>              #t)) ;; stops the event to be propagated
>     (set-name b "bouncer")
>     (set-size b w h) ;; c code does that, but is it not done above ?
>     (set-anchor-point b (/ w 2) (/ h 2))
>     (set-position b x y)
>     (set-reactive b #t)
>     (add-child stage b)
>     (invalidate b) ;; <- drawing the bouncer immediately
>     b))
>
> (define (main args)
>   (let* ((loop (g-main-loop-new))
>        (bg '(#x3c #x3c #x3c #xdd))
>        (sw 600)
>        (sh 400)
>        (stage (prep-stage sw sh bg "Bouncer" loop))
>        (bouncer (make-bouncer 75 75 200 200 stage)))
>     (connect stage
>            'button-press-event
>            (lambda (s e) 
>              (receive (x y)
>                  (get-coords e)
>                ;; (pk "button pressed @ x y: " x y)
>                (save-easing-state bouncer)
>                (set-position bouncer x y)
>                (restore-easing-state bouncer))
>              #t)) ;; stops the event to be propagated
>     (show stage)
>     (g-main-loop-run loop)
>     (exit 0)))

-- 
Joakim Verona