デモ用のプログラム

先日卒研の中間発表があったので、デモ用にDXRubyについているレースゲームのサンプルをlisp on yarvで書きなおしてみました。

(require "dxruby")



(= Window.caption "ミニレーシング")



(= line1 (newarray 53 430 568 438 568 438 607 261 607 261 520 200 520 200 531 151
		   531 151 602 115 602 115 562 19 562 19 113 21 113 21 34 83
		   34 83 81 180 81 180 221 207 221 207 251 274 251 274 204 299
		   204 299 61 262 61 262 26 358 26 358 53 430))

(= line2 (newarray 93 330 88 380 88 380 479 392 479 392 536 302 536 302 534 267
		   534 267 461 210 461 210 459 151 459 151 518 91 518 91 487 53
		   487 53 156 77 156 77 125 110 125 110 292 197 292 197 311 268
		   311 268 227 342 227 342 93 330))

(macro (asm str)
       `(rasm ,str))

(= $course (Image.new 640 480 (newarray 0 200 0)))

(asm "for i in 0..(line1.size/2-2)\n
  $course.line(line1[i*2], line1[i*2+1], line1[i*2+2], line1[i*2+3], [128, 128, 128])\n
 end\n
 for i in 0..(line2.size/2-2)\n
  $course.line(line2[i*2], line2[i*2+1], line2[i*2+2], line2[i*2+3], [128, 128, 128])\n
end\n")



(= Green (newarray 0 200 0))

(= Gray (newarray 128 128 128))


(macro (lwhile con *body)
       `(begin
	 (rasm "while ")
	 ,con
	 ,@(a2l body)
	 (rasm "end\n")))

(macro (aref arr num)
       `(begin
	 (macro_val_print ,arr)
	 (rasm "[")
	 (macro_val_print ,num)
	 (rasm "]")))

(def (paint x y col)
     (asm "arr = []\n\n")
     (loop (block ()
	     (= px x)
	     (= flag (newarray 1 1))
	     (if (or (< y 0) (> y 479))
		 return)
	     (lwhile (and (> px 0) ($course.compare px-1 y Green))
		     (= px (- px 1)))
	     (= lx px)
	     (= ran 0..1)
	     (lwhile (and (<= px 639) ($course.compare px y Green))
	       (ran.each (block (i)
			   (if ($course.compare px (- (+ y (* i 2)) 1) Green)
			       (if (== (aref flag i) 1)
				   (begin
				    (arr.push (newarray px (- (+ y (* i 2)) 1) col))
				    (asm "flag[i] = 0\n")))
			     (asm "flag[i] = 1 \n"))))
	       (= px (+ px 1)))
	     ($course.line lx y (- px 1) y Gray)
	     (if (asm "arr.size != 1")
		 break)
	     (asm "x = arr[0][0]\n")
	     (asm "y = arr[0][1]\n")
	     (asm "col = arr[0][2]\n")
	     (asm "arr = []\n")))
     
     (arr.each (block (ax ay acol)
		 (paint ax ay acol))))
(paint 200 300 (newarray 128 128 128))
(= carimage (Image.new 8 8))
(asm "carimage.boxFill(0, 1, 7, 6, [255, 0, 0]).boxFill(5, 2, 6, 5, [0, 0, 255]).\n
line(0, 0, 1, 0, [0, 0, 0]).line(5, 0, 6, 0, [0, 0, 0]).\n
line(0, 7, 1, 7, [0, 0, 0]).line(5, 7, 6, 7, [0, 0, 0])\n")

(= x 200)

(= y 300)

(= angle 0)

(= speed 0)

(= dx 0)

(= dy 0)

(= Window.scale 2)

(= Window.width 200)

(= Window.height 200)



(= image (Image.new 200 200 Green))
(Window.loop
 (block ()
   (asm "speed = speed + 0.1 if Input.padDown?(P_BUTTON0) and speed < 4")
   (asm "speed = speed - 0.1 if Input.padDown?(P_BUTTON1) and speed > -2")
   (asm "angle = angle - 45 if Input.padPush?(P_LEFT)")
   (asm "angle = angle + 45 if Input.padPush?(P_RIGHT)")
   (asm "dx = dx * 0.95 + Math.cos(Math::PI / 180 * angle) * speed * 0.05")
   (asm "dy = dy * 0.95 + Math.sin(Math::PI / 180 * angle) * speed * 0.05")

   (= x (+ x dx))

   (= y (+ y dy))

   (image.copyRect 0 0 $course x y 200 200)

   (Window.draw 0 0 image)
   (Window.drawRot 96 96 carimage angle)

   (if (image.compare 100 100 Green)
       (begin
	(= dx -dx)
	(= dy -dy)
	(= x (+ x dy))
	(= speed 0.5)))
   (asm "break if Input.keyPush?(K_ESCAPE)")))

時間がなかったので、ただ書き直しただけです。もう少しLispらしいコードを
書ければ、行数とかが減るような気がします。