SDLとCairoをライブラリに追加しました
SDLとCairoのバインディングをライブラリに追加しました。WindowsもOKですよ:D
まずCairoでPostScriptのデータを作成してみることにします。
;; example/cairo-demo.scm: #!r6rs (import (rnrs) (ypsilon cairo) (ypsilon c-types) (srfi :48)) ;; ヘルパーその１。 (define with-cairo-surface (lambda (surf proc) (proc surf) (cairo_surface_destroy surf))) ;; ヘルパーその２。 (define with-cairo-context (lambda (ctx proc) (proc ctx) (cairo_destroy ctx))) ;; CairoからPostScriptのデータを受け取るコールバック手続きです。 (define print (lambda (ref data length) ;; 今回はそのままコンソールにプリントします。 (format #t "~a" (utf8->string (make-bytevector-mapping data length))))) ;; cairo_text_extents_t構造体用のメソッドを展開しておきます。 (define-c-struct-methods cairo_text_extents_t) ;; 本体 (let ((text "Hello World")) (with-cairo-surface (cairo_ps_surface_create_for_stream print 0 320.0 160.0) (lambda (surf) (with-cairo-context (cairo_create surf) (lambda (cr) (cairo_select_font_face cr "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL) (cairo_set_font_size cr 32.0) ;; 縦横の大きさを見て中央に文字列をプリントします。 (let ((extents (make-cairo_text_extents_t))) (cairo_text_extents cr text extents) (let ((x (- 160.0 (/ (cairo_text_extents_t-width extents) 2.0) (cairo_text_extents_t-x_bearing extents))) (y (- 80.0 (/ (cairo_text_extents_t-height extents) 2.0) (cairo_text_extents_t-y_bearing extents)))) (cairo_move_to cr x y) (cairo_set_source_rgba cr 1.0 0.7 0.5 1.0) (cairo_show_text cr text))))))))
こんな出力が得られました。
%!PS-Adobe-3.0
%%Creator: cairo 1.8.0 (http://cairographics.org)
%%CreationDate: Thu Mar 5 23:38:07 2009
%%Pages: 1
%%BoundingBox: 0 0 320 160
%%DocumentData: Clean7Bit
%%LanguageLevel: 2
%%EndComments
%%BeginProlog
/languagelevel where
{ pop languagelevel } { 1 } ifelse
2 lt { /Helvetica findfont 12 scalefont setfont 50 500 moveto
(This print job requires a PostScript Language Level 2 printer.) show
showpage quit } if
/q { gsave } bind def
/Q { grestore } bind def
/cm { 6 array astore concat } bind def
/w { setlinewidth } bind def
:
:
%%EOFPDFでもSVGでも同じようにデータを作れるわけですから、これは便利ですね :D
次にCairoとSDLを組み合わせて、動くHello Worldを作ってみます。
;; example/sdl-cairo-hello.scm #!r6rs (import (rnrs) (ypsilon sdl base) (ypsilon sdl constants) (ypsilon sdl types) (ypsilon cairo) (ypsilon time)) ;; SDLの初期化 (when (> (SDL_Init SDL_INIT_EVERYTHING) 0) (assertion-violation 'SDL_Init (SDL_GetError))) ;; ビデオモードをセットしてウインドウを作ります (define video-surface (SDL_SetVideoMode 320 320 32 SDL_SWSURFACE)) (when (zero? video-surface) (assertion-violation 'SDL_SetVideoMode (SDL_GetError))) (SDL_WM_SetCaption "SDL/Cairo HelloWorld" 0) ;; SDLサーフェイスにマップするCairoサーフェイスを作ります (define cairo-surface ;; c-coerce-void*でSDL_SetVideoModeから返されたポインタをSDL_Surface構造体にマップします (let ((obj (c-coerce-void* video-surface SDL_Surface))) ;; define-c-struct-methodsでSDL_Surface用のメソッドをローカルに展開します (define-c-struct-methods SDL_Surface) ;; SDLサーフェイスのパラメータを使ってCairoサーフェイスを作ります (cairo_image_surface_create_for_data (SDL_Surface-pixels obj) CAIRO_FORMAT_ARGB32 (SDL_Surface-w obj) (SDL_Surface-h obj) (SDL_Surface-pitch obj)))) ;; Cairoの描画用コンテキストを作成します (define cairo-context (cairo_create cairo-surface)) ;; 描画用の手続きを定義します (define draw (lambda (delta) (let ((zero-to-one (sqrt (/ (+ (abs delta) 1.0) 2.0)))) (SDL_FillRect video-surface 0 #xffffffff) (cairo_move_to cairo-context 120.0 80.0) (cairo_rotate cairo-context delta) (cairo_set_source_rgba cairo-context 0.7 zero-to-one 1.0 zero-to-one) (cairo_select_font_face cairo-context "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL) (cairo_set_font_size cairo-context 32.0) (cairo_show_text cairo-context "Hello World") (cairo_surface_flush cairo-surface) (SDL_Flip video-surface)))) ;; アニメーションのパラメータです (define FRAME-INTERVAL 16000) (define SLEEP-TIME 1000) (define STEP (/ FRAME-INTERVAL 3200000.0)) ;; 簡単なイベントループです (define event-loop (lambda () (define event (make-SDL_Event)) (let loop ((next-update (microsecond)) (delta 0.0)) (when (> (SDL_PollEvent event) 0) (when (= (SDL_Event-type event) SDL_MOUSEBUTTONDOWN) ;; マウスのボタンが押されたら後始末をして終了します (cairo_destroy cairo-context) (cairo_surface_destroy cairo-surface) (SDL_Quit) (exit 0))) (cond ((> (microsecond) next-update) (draw (- delta 1.0)) (let ((new-delta (+ delta STEP))) (loop (+ next-update FRAME-INTERVAL) (if (> new-delta 2.0) 0.0 new-delta)))) (else (usleep SLEEP-TIME) (loop next-update delta)))))) (event-loop)
これがぐるぐる回ります :)
