MinGW版Gaucheで楽々グラフィック表示

以前GaucheからdRuby経由でグラフィック表示したところ、コメントでGauche-sdlというのがあることを教えてもらいました。

いろいろ検索してみたら、コンパイル済みのもの発見。
http://saito.s4.xrea.com/wiliki.scm?Gauche
って、これコメントいただいたid:SaitoAtsushiさんがビルドされたものみたいですね。日本語の情報少ないしこれは大変だなーって思ってたので、すごく助かりました。

(use sdl)するだけでWindowsでも簡単にSDLが使えるようになります。

(use sdl)
(sdl-init SDL_INIT_EVERYTHING)
(define scr (sdl-set-video-mode 200 200 0 SDL_SWSURFACE))
(sdl-fill-rect scr #f #x00EEEE)
(sdl-fill-rect scr (sdl-make-rect 50 50 100 100) #xEEEE00)
(sdl-update-rect scr 0 0 0 0)

;; wait for quit
(define e (sdl-make-event))
(while (not (= (sdl-event-type e) SDL_QUIT))
       (sdl-poll-event e))

SchemeからどうやってSDLを呼ぶかはドキュメントがなさそうなので、他の言語のSDLドキュメントを見て勘で書いてます。

SICPのPainterもこんな感じでいける。実際に画像が表示できると嬉しいですね。

;; SDL utility
(use sdl)
(define image-painter-screen #t)
(define image-painter-bmp #t)
(define image-painter-scrx #t)
(define image-painter-scry #t)

(define (image-painter-init)
  (sdl-init SDL_INIT_EVERYTHING)
  (set! image-painter-bmp (sdl-load-bmp "gauche.bmp"))
  (set! image-painter-scrx (sdl-surface-w image-painter-bmp))
  (set! image-painter-scry (sdl-surface-h image-painter-bmp))
  (set! image-painter-screen
        (sdl-set-video-mode image-painter-scrx image-painter-scry 0 SDL_SWSURFACE)))

(define (image-painter-draw f)
  (define (trans-y y)
    (- (- image-painter-scry 1) y))
  (let* ((v1 (origin-frame f))
         (v2 (edge1-frame f))
         (v3 (edge2-frame f))
         (basex (* (- image-painter-scrx 1) (xcor-vect v1)))
         (basey (* (- image-painter-scry 1) (ycor-vect v1))))
    (dotimes (y image-painter-scry)
             (dotimes (x image-painter-scrx)
                      (let ((newx (truncate->exact
                                   (+ basex
                                      (* x (xcor-vect v2)) (* y (xcor-vect v3)))))
                            (newy (truncate->exact
                                   (+ basey
                                     (* x (ycor-vect v2)) (* y (ycor-vect v3))))))
                        (if (and (>= newx 0) (< newx image-painter-scrx)
                                 (>= newy 0) (< newy image-painter-scry))
                            (put-pixel image-painter-screen
                                       newx (trans-y newy)
                                       (get-pixel image-painter-bmp x (trans-y y)))))))
    (sdl-update-rect image-painter-screen 0 0 0 0)))

; Vector
(define (make-vect x y) (list x y))
(define (xcor-vect v) (car v))
(define (ycor-vect v) (cadr v))
(define (add-vect v1 v2)
  (make-vect (+ (xcor-vect v1) (xcor-vect v2))
             (+ (ycor-vect v1) (ycor-vect v2))))
(define (sub-vect v1 v2)
  (make-vect (- (xcor-vect v1) (xcor-vect v2))
             (- (ycor-vect v1) (ycor-vect v2))))
(define (scale-vect s v)
  (make-vect (* s (xcor-vect v)) (* s (ycor-vect v))))

;; Frame
(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))
(define (origin-frame f) (car f))
(define (edge1-frame f)  (cadr f))
(define (edge2-frame f)  (caddr f))

;; Painter
(define (frame-coord-map frame)
  (lambda (v)
    (add-vect
     (origin-frame frame)
     (add-vect (scale-vect (xcor-vect v)
                           (edge1-frame frame))
               (scale-vect (ycor-vect v)
                           (edge2-frame frame))))))

(define (transform-painter painter origin corner1 corner2)
  (lambda (frame)
    (let ((m (frame-coord-map frame)))
      (let ((new-origin (m origin)))
        (painter
         (make-frame new-origin
                     (sub-vect (m corner1) new-origin)
                     (sub-vect (m corner2) new-origin)))))))

(define (flip-vert painter)
  (transform-painter painter
                     (make-vect 0.0 1.0)
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 0.0)))

(define (beside painter1 painter2)
  (let ((split-point (make-vect 0.5 0.0)))
    (let ((paint-left
           (transform-painter painter1
                              (make-vect 0.0 0.0)
                              split-point
                              (make-vect 0.0 1.0)))
          (paint-right
           (transform-painter painter2
                              split-point
                              (make-vect 1.0 0.0)
                              (make-vect 0.5 1.0))))
      (lambda (frame)
        (paint-left frame)
        (paint-right frame)))))

;; draw image
(image-painter-init)
(define f1 (make-frame (make-vect 0.0 0.0) (make-vect 0.9 0.1) (make-vect 0.1 0.9)))
((beside image-painter-draw (flip-vert image-painter-draw)) f1)

;; wait for quit
(define e (sdl-make-event))
(while (not (= (sdl-event-type e) SDL_QUIT))
       (sdl-poll-event e))