File: gdk-animation.scm

package info (click to toggle)
gauche-gtk 0.6%2Bgit20160927-3
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 1,452 kB
  • sloc: ansic: 7,097; lisp: 5,659; sh: 2,829; makefile: 338
file content (54 lines) | stat: -rw-r--r-- 1,866 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
;;
;; Somebody asked me a sample of doing simple animation in Gauche-gtk,
;; and I hacked this up.  If you know better way, let me know.
;; Public domain -- use this as you like.  [SK]
;; $Id: gdk-animation.scm,v 1.3 2007/01/13 01:36:29 maruska Exp $
;;

(use math.const)
(use gtk)

(define *angle* 0)

(define (draw drawable fg bg)
  ;; clear
  (gdk-draw-rectangle drawable bg #t 0 0 100 100)
  ;; draw line
  (let ((x (inexact->exact (round (+ 50 (* (cos *angle*) 50)))))
        (y (inexact->exact (round (+ 50 (* (sin *angle*) 50))))))
    (gdk-draw-line drawable fg 50 50 x y)
    #t))

(define (main args)
  (gtk-init args)
  (let1 w (gtk-window-new GTK_WINDOW_TOPLEVEL)
    (g-signal-connect w "destroy" (lambda _ (gtk-main-quit)))
    (let* ((area (gtk-drawing-area-new))
           (drawable #f)  ;; initialized by realize callback
           (fg-gc #f)     ;; initialized by realize callback
           (bg-gc #f)     ;; initialized by realize callback
           )
      (gtk-widget-set-size-request area 100 100)
      (gtk-container-add w area)
      (g-signal-connect area "realize"
                        (lambda _
                          (set! drawable (ref area 'window))
                          (set! fg-gc (gdk-gc-new drawable))
                          (set! bg-gc (gdk-gc-new drawable))
                          (gdk-gc-set-foreground bg-gc
                                                 (ref (ref (ref area 'style) 'bg) 0))
                          ))
      (g-signal-connect area "expose_event"
                        (lambda (w event) (draw drawable fg-gc bg-gc)))
      (gtk-timeout-add 10
                       (lambda ()
                         (inc! *angle* (* pi 0.02))
                         (when drawable (draw drawable fg-gc bg-gc))))
      (gtk-widget-show area)
      )
    (gtk-widget-show w))
  (gtk-main)
  0)