GaucheとSDLで図形言語 ４

線を引くだけではつまらんし、SDLならば簡単にBMPをロード出来るので、ビットマップのpainterを実装してみる。

まともなSchemeプログラムを組んだことがないので、異様にCぽいもんが出来た。
動いたのでよいことにする。

なんだかよく分からない座標変換が瞬時に出来る人は尊敬します。
これ書くのに三日位掛かった。

;; #t なら先のv1から線を描く

(define (which-draw-point? v1 v2)

    (let ((dx (abs (- (car v1) (car v2))))

	  (dy (abs (- (cdr v1) (cdr v2)))))

      (if (>= dx dy)

	  (< (transform-SDL-x v1) (transform-SDL-x v2))

	  (< (transform-SDL-y v1) (transform-SDL-y v2)))))
;;(which-draw-point? 20 100 10 10)
(define (count-pixel-line-bit x1 y1 x2 y2)

  (let ((dx (abs (- x1 x2)))

	(dy (abs (- y1 y2))))

    (if (> dx dy)

	dx

	dy)))
(define (count-pixel-line v1 v2)

  (count-pixel-line-bit (transform-SDL-x v1)

			(transform-SDL-y v1)

			(transform-SDL-x v2)

			(transform-SDL-y v2)))
(define (paint-bitmap-SDL file org)

  (print "paint-bitmap-SDL start")

  (and-let* )((bmp (sdl-load-bmp file))(

	     (dst (sdl-make-rect (transform-SDL-x org)

				 (- (transform-SDL-y org) (sdl-surface-h bmp))

				 0 0)))

	(begin (print "load success")

	(sdl-blit-surface bmp #f SCREEN dst))))

	 

(define (get-src-pixel-point n max src-len)

  (floor->exact (* (/. n max) (- src-len 1))))
(define (get-src-pixel c1 start_org1? c2 start_org2? c1-max c2-max bmp)

  (let ((x (if start_org1? c1 (- c1-max c1)))

	(y (if start_org2? (- c2-max c2) c2)))

    (get-pixel bmp 

	       (get-src-pixel-point x c1-max (sdl-surface-w bmp))

	       (get-src-pixel-point y c2-max (sdl-surface-h bmp)))))
(define (bitmap->painter bmp)

  ;; 画像がロードされていると仮定する

  (lambda (frame)

    (let*  )((org (origin-frame frame))(

	    (edge1 (edge1-frame frame))

	    (edge2 (edge2-frame frame))

	    (edge2_max (add-vect org edge2))

	    (edge1_max (add-vect org edge1))

	    (edge2_max_pixel (count-pixel-line org edge2_max))

	    (edge1_max_pixel (count-pixel-line org edge1_max))

	    (edge1_start_org? (which-draw-point? org edge1_max))

	    (edge2_start_org? (which-draw-point? org edge2_max))

	    (edge2_now_pixel 0))

      ;; 最初に orgから edge2方向にラインを引く

      (draw-line-internal org (add-vect org edge2) 

			  (lambda (screen x1 y1)

			    ;;  最初の線上の各点から、edge1方向へラインを引く

			    (let )((edge1_now_pixel 0))(

			      (set! edge2_now_pixel (+ edge2_now_pixel 1))

			      (draw-line-SDL screen 

					     (lambda (screen x2 y2)

					       (set! edge1_now_pixel (+ edge1_now_pixel 1))

					       ;;(if (= y2 0) (print "aaa"))

					       ;; 各点には、対応する元画像の点を置く

					       (sdl-put-pixel screen x2 y2 

							      (get-src-pixel (- edge1_now_pixel 1) edge1_start_org?

									     (- edge2_now_pixel 1) edge2_start_org?

									     edge1_max_pixel edge2_max_pixel

									     bmp)))

							      ;;LINE-COLOR))

					     x1 y1 

					     (+ (transform-SDL-x-rel edge1) x1)

					     (- y1 (transform-SDL-y-rel edge1)))))))))
;; frameで与えられた領域の中のすべてのPixelについて、

;; フレーム座標写像の逆変換を使用し、--- 無理でした。つーかわけわかんね。

;; 元画像の画素を取得

;; Pixelを書き込む を繰り返し
(define BITMAPFILE "./sample2.bmp")
(define heon 

  (let ((bmp (sdl-load-bmp BITMAPFILE)))

    (bitmap->painter bmp)))
(define (some screen)

  (heon

   (make-frame (make-vect 0.0 0.0)

	       (make-vect 0.5 0.3)

	       (make-vect 0.2 0.5)))
  (heon

   (make-frame (make-vect -1.0 -1.0)

	       (make-vect 0.5 0.0)

	       (make-vect 0.0 0.5)))

)
(define (run-test)

  (init-sdl-simple)
  (do-something some)
  (wait-key)
  (sdl-quit))


(run-test)

変形機能に難があるような気もするが、これでいいことにする。