pacpac8x8=64dot版

http://nicotak.com/picbasic/
PIC-BASIC本で紹介した「携帯LEDゲームmk2（64ドットゲーム）」用に新しいゲームを作ってみました。

(動画)
http://jp.youtube.com/watch?v=-XAggaIVHto

名付けて「PACPAC」です。
多分、世界一ショボいパック●ンだと思います。

画面のイメージです。
抽象的すぎてワケわかりませんが、ご了承ください。

あと、LEDの特性上、黄色が赤っぽく（オレンジ色に）表示されます。

・フィールドは16x16ドット。8x8ドットの画面内でスクロール表示します。
・壁は1ブロックあたり2x2ドットの緑色で表現しています。
・2x2ドットの黄色がプレイヤーです。4方向のキーで動きます。1ドット単位でなめらかに動きます。
・1x1ドットの黄色がドットです。全部集めると面クリアです。ドット一つあたり1点です。
・1x1ドットの赤色がパワーです。これを取ると一定時間だけモンスターに反撃できます。
・2x2ドットの「くの字」がモンスターです。通常は赤色でプレイヤーを追跡してきます。パワーを取ると緑色になり、プレイヤーから遠ざかります。
・プレイヤーがモンスターに接触するとゲームオーバーとなりスコアが表示されます。

'64DOT(LED)GAME 「pacpac」 for PIC-BASIC
'	8x8=64ドットマトリックスLED表示器
'	2色（赤・緑）タイプ「BU5004-RG」使用
'
'by 松原拓也 '動作無保証

Dim i As Byte
Dim sx As Byte	'スクロール座標
Dim sy As Byte
Dim x As Byte	'主人公座標
Dim y As Byte
Dim x1 As Byte	'主人公移動方向
Dim y1 As Byte
Dim cx As Byte
Dim cy As Byte
Dim score As Word
Dim tx As Byte	'文字表示座標/モンスター座標
Dim ty As Byte
Dim plane As Byte 'プレーン番号
Dim num As Byte
Dim power As Byte	'パワー
Dim cnt As Byte
Dim data As Byte
Dim col As Byte
Dim dot As Byte	'残りドット数
Dim delay As Byte
Dim mask As Byte
Dim vram(32) As Word	'vramデータ
Dim map(16) As Long	'mapデータ

	tris_ra = 0	'ra.0〜7を出力に(col用)
	tris_rb = &b00001111
		'rb.Bit0-3を入力(sw/PGM用)
		'rb.Bit4-7を出力(row用)
	tris_rc = &b10110000
		'rc.0-3を出力(row用)
		'rc.4-5を入力(sw用)
		'rc.6を出力(シリアル送信用)
		'rc.7を入力(シリアル受信用)
	tris_rd = 0	'rd.0〜7を出力に(row用)
	tris_re = 0	're.0〜2を出力に(row用)

newgame:
	score=0
clrgame:
          '4*8=16
          ' 0123456789ABCDEF

	map(00)=&b1111111111111111
	map(01)=&b1101010101011011
	map(02)=&b1101111101110111
	map(03)=&b1101010101110111
	map(04)=&b1101111101010111
	map(05)=&b1101111101110111
	map(06)=&b1101010101010111
	map(07)=&b1111111111111111

	dot=0
map2vram:
	For y=0 To 31
		vram(y)=0
	Next
	For y=0 To 15 Step 2
		For i=0 To 15 Step 2
			cnt = (map(y/2) >> i)& &b11
			If cnt=&b11 Then '壁
				vram(y+16) = vram(y+16) | (&b11 << i)
				vram(y+17) = vram(y+17) | (&b11 << i)
			Endif
			If cnt=&b01 Then 'Dot
				vram(y+ 0) = vram(y+ 0) | (&b10 << i)
				vram(y+16) = vram(y+16) | (&b10 << i)
				dot=dot+1
			Endif
			If cnt=&b10 Then 'パワー
				vram(y+ 0) = vram(y+ 0) | (&b10 << i)
				dot=dot+1
			Endif
		Next
	Next

	x=6		'プレイヤー座標
	y=12
	x1=1	'プレイヤー移動量(オフセット+1)
	y1=1
	tx=8	'モンスター座標
	ty=2
	sx=2	'スクロール座標
	sy=8
	power=0

main:
	delay=(delay+1)Mod 100
	If (delay=10) Then
		Gosub keyin
		Gosub player
		Goto main10
	Endif
	If (delay=60) Then
		Gosub player2
		If (dot=0) Then
			Gosub menclr
			Goto clrgame
		Endif
		Goto main10
	Endif
	If (delay=80) Then
		Gosub monter
		If (tx=x) And (ty=y)Then
			Gosub putscore
			Goto newgame
		Endif
	Endif
main10:
	Gosub putvram
	Goto main

keyin:
	If (rb.Bit2 = 0) Then	'上ボタン
		x1 =1-0
		y1 =1-1
	Else
		If (rb.Bit3 = 0) Then	'下ボタン
			x1 =1-0
			y1 =1+1
		Endif
	Endif

	If (rc.Bit4 = 0) Then	'右ボタン
		x1 =1+1
		y1 =1+0
	Else
		If (rc.Bit5 = 0) Then '左ボタン
			x1 =1-1
			y1 =1-0
		Endif
	Endif
	Return

player:
	cx = x+(x1*2)-2
	cy = y+(y1*2)-2

	cnt = (map(cy/2) >> (14-cx))& &b11
	If (cnt = &b11) Then
		y1 = 1
		x1 = 1
	Else
		If (cnt<>&b00) Then
			dot=dot-1
			score=score+1
			If (cnt=&b10) Then power=10

			map(cy/2) = map(cy/2) & (&hffff ^ (&hC000 >> cx))
		Endif
	Endif

player2:
	Gosub putchr0
	x = x+x1-1
	y = y+y1-1
	Gosub putchr1

	If ((sy+2)>y) Then
		sy=sy-1
	Else
		If ((sy+4)<y) Then sy=sy+1
	Endif

	If ((sx+4)<x) Then
		sx=sx+1
	Else
		If ((sx+2)>x) Then sx=sx-1
	Endif

	Return

'-------------
monter:
	i = Peek(&h101) Mod 4
	cx=tx
	cy=ty
	If (power > 0) Then nigeru

	If i=0 Then
		If (x > cx) Then cx=cx+2 Else cx=cx-2
	Endif
	If i=1 Then
		If (y > cy) Then cy=cy+2 Else cy=cy-2
	Endif
	cnt = (map(cy/2) >> (14-cx))& &b11
	If (cnt <> &b11) Then
		Gosub monster0
		tx=cx
		ty=cy
		Gosub monster1
	Endif

	Return

nigeru:
	power=power-1

	If i=0 Then
		If (x < cx) Then cx=cx+2 Else cx=cx-2
	Endif
	If i=1 Then
		If (y < cy) Then cy=cy+2 Else cy=cy-2
	Endif
	cnt = (map(cy/2) >> (14-cx))& &b11
	If (cnt <> &b11) Then
		Gosub monster0
		tx=cx
		ty=cy
		Gosub monster2
	Endif
	If (tx=x) And (ty=y) Then
		tx=8
		ty=2
		score=score+1
		power=0
	Endif

	Return

putvram:
	'---------vramからLEDに出力
	col = (col+1) Mod 8
	mask = (1 << col) ^ &b11111111

	ra = &b00111111	'表示クリア
	re = &b00000011

	i=vram(col+sy+16)>>(8-sx)
	rd = i	'緑LED

	i=vram(col+sy)>>(8-sx)
	rc = i & &b1111	'赤LED
	rb = i & &b11110000

	ra = mask & &b00111111
	re = (mask >> 6) & &b00000011

'	ra = &b00111111
'	re = &b00000011	'表示クリア
	Return


'------------------------------プレイヤー消去
putchr0:
	vram(y+ 0) = vram(y+ 0) & (&hffff ^ (&hc000 >> x))
	vram(y+ 1) = vram(y+ 1) & (&hffff ^ (&hc000 >> x))
	vram(y+16) = vram(y+16) & (&hffff ^ (&hc000 >> x))
	vram(y+17) = vram(y+17) & (&hffff ^ (&hc000 >> x))
	Return

'------------------------------プレイヤー表示
putchr1:
	vram(y+0)  = vram(y+ 0) | (&hC000 >> x)
	vram(y+1)  = vram(y+ 1) | (&hC000 >> x)
	vram(y+16) = vram(y+16) | (&hC000 >> x)
	vram(y+17) = vram(y+17) | (&hC000 >> x)
	Return


'------------------------------モンスター消去
monster0:
	vram(ty+ 0) = vram(ty+ 0) & (&hffff ^ (&h4000 >> tx))
	vram(ty+ 1) = vram(ty+ 1) & (&hffff ^ (&hc000 >> tx))
	vram(ty+16) = vram(ty+16) & (&hffff ^ (&h4000 >> tx))
	vram(ty+17) = vram(ty+17) & (&hffff ^ (&hc000 >> tx))
	Return

'------------------------------モンスター表示
monster1:
	vram(ty+ 0) = vram(ty+ 0) | (&h4000 >> tx)
	vram(ty+ 1) = vram(ty+ 1) | (&hC000 >> tx)
	Return

'------------------------------モンスター表示
monster2:
	vram(ty+16) = vram(ty+16) | (&h4000 >> tx)
	vram(ty+17) = vram(ty+17) | (&hC000 >> tx)
	Return

'----------------------
putnum:
	cnt=(num / 100) Mod 10:Gosub numchar
	cnt=(num / 10) Mod 10:Gosub numchar
	cnt=num Mod 10 :Gosub numchar
	Return

'----------------------
numchar:
	i=0
	'---------16dotデータ(4x5)をvramに転送
	Lookup cnt,data,&b0100,&b0100,&b1100,&b1100,&b0010,&b1110,&b0110,&b1110,&b0100,&b0100:Gosub txtsub
	Lookup cnt,data,&b1010,&b1100,&b0010,&b0010,&b0110,&b1000,&b1000,&b0010,&b1010,&b1010:Gosub txtsub
	Lookup cnt,data,&b1010,&b0100,&b0100,&b0100,&b1010,&b1100,&b1100,&b0100,&b0100,&b0110:Gosub txtsub
	Lookup cnt,data,&b1010,&b0100,&b1000,&b0010,&b1111,&b0010,&b1010,&b1000,&b1010,&b0010:Gosub txtsub
	Lookup cnt,data,&b0100,&b0100,&b1110,&b1100,&b0010,&b1100,&b0100,&b1000,&b0100,&b1100:Gosub txtsub
	tx=tx+4
	Return

'----------------------
txtsub:
	vram(ty+i+plane) = vram(ty+i+plane) &(&hffffffff ^ (&b11111 << (12-tx)))
	vram(ty+i+plane) = vram(ty+i+plane) |(data << (12-tx))
	i=i+1
	Return


menclr:
	For cnt=1 To 4
		For i = 0 To 31
			vram(i) = vram(i) ^ &hffff
		Next
		For delay=0 To 200
			Gosub putvram
		Next
	Next
	Return


'----------------------
putscore:
	For cnt=0 To 6
		For delay=0 To 250
			Gosub putvram
		Next
	Next

	sy=0
	For i = 0 To 31
		vram(i)=0
	Next

	plane=16
	tx=0
	ty=2
	cnt=(score / 1000) Mod 10:Gosub numchar
	cnt=(score / 100) Mod 10:Gosub numchar
	cnt=(score / 10) Mod 10:Gosub numchar
	cnt=score Mod 10 :Gosub numchar

	For sx=0 To 8
		For delay=0 To 250
			Gosub putvram
		Next
	Next

	sx=8
	For i = 0 To 15
		vram(i)=vram(i+16)
	Next

	For i=0 To 4
		For delay=0 To 250
			Gosub putvram
		Next
	Next
	Return