PIC-BASIC携帯ゲームmk2の互換機

http://nicotak.com/picbasic/
PIC-BASIC本で紹介した携帯ゲーム機mk2の互換機です。
pacpacとかtetrisぽいゲームが動きます。
http://d.hatena.ne.jp/nicotakuya/20080919/1221859145
http://d.hatena.ne.jp/nicotakuya/20080919/1221859144

例によって、LEDを直結しています。「火吹いて壊れる」とか「回路から悲鳴が聞こえる」という人は任意に対策してください。改造・再配布は自由。商用/非商用の制限はありません。

動作無保証です。
サポートはしません。

SDKです。
・仮想マップのスクロールデモ。
・仮想マップへのテキスト（A〜Z）表示デモ。

'64DOT(LED)GAME SDK 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 tx As Byte	'文字表示座標
Dim ty As Byte
Dim plane As Byte 'プレーン番号
Dim num As Byte
Dim cnt As Byte
Dim data As Byte
Dim col As Byte
Dim delay As Byte
Dim mask As Byte
Dim vram(32) As Word	'VRAM

	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:
          '4*8=16
          ' 0123456789ABCDEF
vram(00)=&b1111111111111111	'赤
vram(01)=&b1000000000000001
vram(02)=&b1000000000000001
vram(03)=&b1000000000000001
vram(04)=&b1000000000000001
vram(05)=&b1000000000000001
vram(06)=&b1000000000000001
vram(07)=&b1000000000000001
vram(08)=&b1000000000000001
vram(09)=&b1000000000000001
vram(10)=&b1000000000000001
vram(11)=&b1000000000000001
vram(12)=&b1000000000000001
vram(13)=&b1000000000000001
vram(14)=&b1000000000000001
vram(15)=&b1111111111111111
	'vram(16-31)は緑

	x=0
	y=0

	sx=0
	sy=0
	cnt=0

	num=&h41

	Gosub putchr1

main:
	delay=(delay+1)Mod 60
	If (delay<>59) Then getbutton

	Gosub putchr1	'カーソル消去

	If (rb.Bit2 = 0) Then	'上ボタン
		If y>0 Then y=y-1
'		If (sy>y) And (sy>0) Then
		If (sy>y) Then
			sy=sy-1
		Endif
	Else
		If (rb.Bit3 = 0) Then	'下ボタン
			If y<(16-3) Then y=y+1
'			If ((sy+5)<y) And (sy<(16-8)) Then
			If ((sy+5)<y) Then
				sy=sy+1
			Endif
		Endif
	Endif


	If (rc.Bit4 = 0) Then	'右ボタン
		If x<(16-3) Then x=x+1
'		If ((sx+5)<x) And (sx<(16-8)) Then
		If ((sx+5)<x) Then
			sx=sx+1
		Endif
	Else
		If (rc.Bit5 = 0) Then '左ボタン
			If x>0 Then	x=x-1
			If (sx>x) Then
'			If (sx>x) And (sx>0) Then
				sx=sx-1
			Endif
		Endif
	Endif

	Gosub putchr1	'カーソル表示

getbutton:
	If (delay<>0) Then putvram

	If (rb.Bit0 = 0) Then	'ボタン
		num=num+1
		If num>&h5a Then num=&h41

		plane=16
		tx=6
		ty=2
		cnt=num:Gosub txtchar

		tx=2
		ty=8
		plane=0
		Gosub putnum
	Endif


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	'表示クリア

	Goto main

'------------------------------
putchr1:
	plane=16
	vram(y+0+plane) = vram(y+0+plane) ^ (&b010 << (13-x))
	vram(y+1+plane) = vram(y+1+plane) ^ (&b111 << (13-x))
	vram(y+2+plane) = vram(y+2+plane) ^ (&b010 << (13-x))
	Return


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

'----------------------
txtchar:
	i=0
	If(cnt<10)Then numchar
	If(cnt>=&h55)Then cnt=cnt-&h55:Goto txtchar3
	If(cnt>=&h4B)Then cnt=cnt-&h4B:Goto txtchar2
	If(cnt>=&h41)Then cnt=cnt-&h41:Goto txtchar1

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


txtchar1:'            41=A   42=B   43=C   44=D   45=E   46=F   47=G   48=H   49=I   4A=J
	Lookup cnt,data,&b0100,&b1100,&b0100,&b1100,&b1110,&b1110,&b0110,&b1010,&b1110,&b0110:Gosub txtsub
	Lookup cnt,data,&b1010,&b1010,&b1010,&b1010,&b1000,&b1000,&b1000,&b1010,&b0100,&b0010:Gosub txtsub
	Lookup cnt,data,&b1010,&b1100,&b1000,&b1010,&b1110,&b1110,&b1010,&b1110,&b0100,&b0010:Gosub txtsub
	Lookup cnt,data,&b1110,&b1010,&b1010,&b1010,&b1000,&b1000,&b1010,&b1010,&b0100,&b1010:Gosub txtsub
	Lookup cnt,data,&b1010,&b1100,&b0100,&b1100,&b1110,&b1000,&b0110,&b1010,&b1110,&b0100:Gosub txtsub
	tx=tx+4
	Return

txtchar2:'            4B=K   4C=L   4D=M   4E=N   4F=O   50=P   51=Q   52=R   53=S   54=T
	Lookup cnt,data,&b1010,&b1000,&b1010,&b0000,&b0100,&b1100,&b0100,&b1100,&b0110,&b1110:Gosub txtsub
	Lookup cnt,data,&b1010,&b1000,&b1110,&b1100,&b1010,&b1010,&b1010,&b1010,&b1000,&b0100:Gosub txtsub
	Lookup cnt,data,&b1100,&b1000,&b1010,&b1010,&b1010,&b1100,&b1010,&b1100,&b0100,&b0100:Gosub txtsub
	Lookup cnt,data,&b1010,&b1000,&b1010,&b1010,&b1010,&b1000,&b1110,&b1010,&b0010,&b0100:Gosub txtsub
	Lookup cnt,data,&b1010,&b1110,&b1010,&b1010,&b0100,&b1000,&b0110,&b1010,&b1100,&b0100:Gosub txtsub
	tx=tx+4
	Return

txtchar3:'            55=U    56=V   57=W   58=X   59=Y  5A=Z
	Lookup cnt,data,&b1010,&b1010,&b1010,&b1010,&b1010,&b1110:Gosub txtsub
	Lookup cnt,data,&b1010,&b1010,&b1010,&b1010,&b1010,&b0010:Gosub txtsub
	Lookup cnt,data,&b1010,&b1010,&b1010,&b0100,&b0100,&b0100:Gosub txtsub
	Lookup cnt,data,&b1010,&b1010,&b1110,&b1010,&b0100,&b1000:Gosub txtsub
	Lookup cnt,data,&b1110,&b0100,&b1010,&b1010,&b0100,&b1110: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