トップページ

ゲーム「7ならべ」作りました。レトロ感にしびれるわよ。

もくじ

気になる注意点

リファレンス

2018/11/2修正。上のリンクを右クリックからダウンロードでもどうぞ。 reference.html (507.6K)

2018年11月21日 (水)

第7回「7ならべ」

第7回「7ならべ」

前置き

SHARPのザウルスって知ってますか~?電子手帳ザウルス。自分は昔ザウルス使ってました。主に使っていたのはPIシリーズ、モノクロのザウルスですね。カラーもリナザウも使ってましたけど、思い入れのあるのはモノクロのザウルスです。パソコン通信始めたのもザウルスがきっかけでした。パソコン通信!当時自分がやってたときはもうインターネットがあった気もしますが、まだまだパソ通もありました。いまだにinfowebのメールアドレス持ってますよ。それと手書き認識には未来を感じてましたよ。Palmなんかと比べてやっぱ日本語使うには日本のメーカーの機種じゃないとなーなんて思ってました。

で、そのザウルスはBASICでプログラミングできたんです。自分もなんか楽しくてちょこちょこゲームを作っていました。その時に「7ならべ」を試しに作ってみましてね。パソコン通信なのでアップして公開したんですよ。そしたら結構褒めてもらえましてね。うれしかったなー。パソコン通信で他人と繋がるのもあんまり経験なくて、作ったゲームを軽く遊んでもらえてさらに感想をもらえるって、いい時代だなーと思いました。高校生の頃に同人ソフト出したりしてたときのことを思い出したりして。ベーマガ投稿なんかもそうですけど、やっぱり誰かに批評してもらうのって大好きになるとかハマることのきっかけになります。

おっと、話が逸れてます。その時作った「7ならべ」を思い出しながら作ってみました。また誰かさんに褒めてもらえないかなぁ。同年代の友達に見せてみようかなーと思っています。

遊び方

普通の7ならべです。4人打ち。カードを52枚全部配ります。まず7を場にならべて、それに繋がるカードを順番にならべていきます。出せない時や作戦で出さないときはパスできます。早く持ってるカードが無くなったプレイヤーが勝ちです。まぁ、普通ですよね。ネットで調べてみてもこんな感じでした。

あと細かいところでは、

  • パスは3回までです。4回目のパスに追い込まれると脱落です。
  • 最初に7を出す時に、ダイヤの7を出したプレイヤーから始めます。これはローカルルールかも。

遊び方としてはこんなもんですかねぇ。

操作方法

画面下部にプレイヤー名、持ち札、残りパス数が表示されます。順番にプレイヤー名の背景が赤く表示されますので、[YOU]のときがあなたの順番です。

画面最下部に持ち札が表示されます。カードをドラッグして場にドロップするとカードを出せます。出すことが出来ないときはメッセージと共に持ち札に戻されます。

持ち札の左側、[YOU]の表示の下あたりにパスの残りが表示されています。そのあたりをタッチするとパスできます。パスを3回すると表示が[OVER]に変わり、そこをタッチすると脱落です。

全7ゲームやって、スコアがあります。点数は持ち札が全部無くなったときの順番で、1位3点、2位2点、3位1点、4位0点です。脱落のときは順位点はありません。プレイヤーがゲーム参加中(終了でも脱落でもない)に他のプレイヤーが脱落すると1点加算されます。

PCGデータ

PCGデータはこんな感じになってます。とりあえず必要そうなアルファベットや数字などの文字群と、カードの画像、その他です。

カードの表面は2文字×2行の4文字分のPCGで構成されています。2文字と言っても半角使って1文字半、12×16ドットです。上の行がマークで下の行が数字です。半角を入れる場所を変えてマークは左上、数字は右下にしています。といっても4ドットずれるだけですけど。なるべく共通のデータを使って容量節約!なのです。数字は赤と黒の2種類、と思いきやPCGデータは共用しています。今どきの潤沢なメモリ環境ではわずかなものですけど、Dr.Dなら褒めてくれると思うのです!(ベーマガネタです。)

思考ルーチン

COMの思考ルーチンは結構このプログラムのキモでもあるので解説してみたいと思います。

考え方としては、

  • 持っているカードの外側にカードがない場合、何も考えずに出してもいい。
  • 持っているカードの外側のカードのさらに外側のカード、例えばハートの6を持っているときのハートのAを自分が持っている場合、なるべく早く出してしまってその間のカードが出ることに期待する。
  • 持っているカードの外側のカードを自分が持っていない場合、止める。
  • パスが無くなって止めたカードを出さざるを得ない場合、止めたカードの外側のカードが少ない方から出す。

自分が7ならべをやるときに考えることってこんな感じかなーと思います。これをプログラミングします。プログラム中ではサブルーチンthink:です。

まず持ち札に出すのか出さないのか優先度を付けようと考えました。


DIM pri[13]

まず優先度を計算する配列pri[]を宣言します。


FOR sj=1 TO 13
 card=hand[turn,sj]
 IF card>0 THEN
  GOSUB checkcard
  IF check THEN
   pri[sj]=6

持ち札は配列hand[]に入っています。2次元配列で1次めにプレイヤー番号(プレーヤーは4)が入ります。対象の持ち札を変数cardにセットして、0でなければそのカードが場に出すことができるかサブルーチンcheckcard:でチェックします。出すことができる場合、変数checkにTRUE(0以外)がセットされて帰ってくるので、配列pri[]に6を設定します。


   GOSUB getmarknumber

サブルーチンgetmarknumber:で変数cardに入っている持ち札のデータをマークと数字に分離します。持ち札のデータは1から52の数値で、スペードのAが1、ハートのAが2……、となっています。使うたびに計算すると間違えるのでサブルーチンにまとめて任せています。


   IF number<7 & number>1 THEN
    FOR sk=1 TO number-1
     IF !field[sk,mark] THEN pri[sj]--
    NEXT

数字が2から6の場合以下の処理に続きます。Aのときは優先度は先程設定した6です。

FOR/NEXTコマンドで1から対象の持ち札の数字-1まで、場にカードが出ているか調べます。カードが出ていなければ優先度-1です。


    FOR sk=number-1 TO 1 STEP -1
     FOR sl=1 TO 13
      IF hand[turn,sl]=(sk-1)*4+mark THEN
       pri[sj]=6
       FOR sm=sk TO number-1
        IF !field[sm,mark] THEN pri[sj]++
       NEXT
       F_N.BREAK
      ENDIF
     NEXT
    NEXT

対象のカードの数字の外側のカードを自分が持っているのか調べます。持っていたらとりあえず優先度6に設定し直します。(前の処理で優先度が下がっている可能性があるので設定し直しです。)さらに持っているカードと対象のカードの離れている分優先度を上げます。外側からチェックしているので、それより内側は調べないのでF_N.BREAKでループを抜けます。


   ELSEIF number>7 & number<13 THEN
    FOR sk=number+1 TO 13
     IF !field[sk,mark] THEN pri[sj]--
    NEXT
    FOR sk=number+1 TO 13
     FOR sl=1 TO 13
      IF hand[turn,sl]=(sk-1)*4+mark THEN
       pri[sj]=6
       FOR sm=number+1 TO sk
        IF !field[sm,mark] THEN pri[sj]++
       NEXT
       F_N.BREAK
      ENDIF
     NEXT
    NEXT
   ENDIF
  ENDIF
 ENDIF
NEXT

今度は数字が8からQの場合です。2から6の場合とやってることは同じです。


think_c=0:think_p=0
FOR si=1 TO 13
 IF pri[si]>think_p THEN think_p=pri[si]:think_c=si
NEXT
ARRAY.DELETE pri[]
RETURN

最後に一番優先度の高いものを調べて、優先度を変数think_p、持ち札の番号を変数think_cに入れて戻ります。グローバル変数に入れちゃって戻っちゃうところがBASICっぽいですねぇ。あとはサブルーチン呼び出し元で処理します。プログラムでは、優先度5以下の場合パスが残っていたらパス、残っていなければ出します。ランダムでパスが残っていても出しちゃうときがあります。ゲームが進むほど出さない傾向にしました。

あとがき

そんなわけで、7ならべでした。思考ルーチンがなかなかイジワルでなんか止められて脱落させられた~ってなると思います。そんなところが人間臭いというかちゃんと考えてる感がでてるかな、と。例えばどのプレイヤーがどのカードを出したか、それによってパスの残りを見て脱落狙いか早く出すのか、とかにするともうちょっと強くなりますかねぇ。でもそこまでしなくてもいいかなぁ。いまでも結構強いと思います。

しかし、このグラフィックは……、どうなんですかー。

やー、わはは。一応必要最低限というか。カードも充分認識できるでしょ?

まぁ、レトロというか……、味?

そうそう、いいこというわね。けっこうこのグラフィック、気にいってたりして。ぱっと見で、うおわなんか懐かしい!ってならないですかね。

なんか、花咲いてきましたよー。

ちょっと画面余ってたのでね、スコアと連動して芽→蕾→花と咲かせてみました。かわいいでしょ。ディグダグのラウンドが進むと地上に花が咲くの、あれ好きなんです。あのイメージで。何ゲーム目かも星(ドット)で現したら文字もいらないかなぁ、とか思ったんですけど、さすがに分かりづらいのでやめました。

プログラムリストに隠し機能ってある……。隠れてないですやん。

内緒!どんなのかはお楽しみ。リストを見て探してみてね。どこかが急に点滅してもバグではありませんよ。

他のプログラム言語を触ったことがあると、全部グローバル変数であることに不便さを感じますね。FOR/NEXTで使う変数って慣例的にiだったりするんですけど、サブルーチンでそれを使っててバグが出たり。サブルーチンでなくユーザー定義関数を使ったらいいんですけどね。BASICっぽさでいうとやっぱりサブルーチンかなぁとか個人的には思っちゃってます。うまく使い分けたいところですけど……。

それでは最後にプログラムリストです。ダウンロードでもどうぞ~。


REM 7ならべ ver.1
! PCG
! PCG GET
FN.DEF PCG_GET(bm,s$)
 sx=8:sy=8:x=0
 FOR i=1 TO LEN(s$)
  IF MID$(s$,i,1)="\"
   i++
   IF MID$(s$,i,1)="n" THEN x=0:sy+=8
   IF MID$(s$,i,1)="h" THEN x-=4:sx-=4
  ELSE
   x+=8:IF x>sx THEN sx=x
  ENDIF 
 NEXT
 GR.BITMAP.CREATE ret_bm,sx,sy
 x=0:y=0:z=0
 GR.COLOR 255,255,255,255,2
 GR.BITMAP.DRAWINTO.START ret_bm
 FOR i=1 TO LEN(s$)
  c$=MID$(s$,i,1)
  IF c$="\" THEN
   IF MID$(s$,i+1,1)="n" THEN
    x=0:y+=8:i++
    F_N.CONTINUE
   ELSEIF MID$(s$,i+1,1)="h" THEN
    x-=4:i++
    F_N.CONTINUE
   ELSEIF IS_IN(MID$(s$,i+1,1),"0123456789ABCDEF")>0 THEN
    z=HEX(MID$(s$,i+1,1))
    i++
    F_N.CONTINUE
   ELSE
    i++
   ENDIF
  ENDIF
  s=ASCII(c$)+z*16
  IF s>=256 THEN s-=256
  sx=MOD(s,16):sy=INT(s/16)
  GR.BITMAP.CROP b,bm,sx*8,sy*8,8,8
  GR.BITMAP.DRAW g,b,x,y
  x+=8
  GR.BITMAP.DELETE b
 NEXT
 GR.BITMAP.DRAWINTO.END
 FN.RTN ret_bm
FN.END
! PCG SET
FN.DEF PCG_SET(bm,c,data$)
 sx=MOD(c,16)*8:sy=FLOOR(c/16)*8
 b$="":r$="":g$=""
 FOR i=1 TO 16
  b$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i,1))),4)
  r$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i+16,1))),4)
  g$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i+32,1))),4)
 NEXT
 GR.BITMAP.DRAWINTO.START bm
 FOR y=0 TO 7
  FOR x=0 TO 7
   IF MID$(b$,y*8+x+1,1)="1" THEN b=255 ELSE b=0
   IF MID$(r$,y*8+x+1,1)="1" THEN r=255 ELSE r=0
   IF MID$(g$,y*8+x+1,1)="1" THEN g=255 ELSE g=0
   GR.COLOR 255,r,g,b,0
   GR.POINT g,sx+x,sy+y
  NEXT
 NEXT
 GR.BITMAP.DRAWINTO.END
FN.END

! 初期設定
x_size=200
y_size=120
GR.OPEN 255,0,0,0
GR.ORIENTATION 0
PAUSE 1000
GR.SCREEN x,y
x_scale=x/x_size
y_scale=y/y_size
GR.SCALE x_scale,y_scale
GR.SET.ANTIALIAS 0
! PCG読み込み
GR.BITMAP.CREATE pbm,128,128
READ.FROM 1
DO
 READ.NEXT c,p$
 IF p$<>"end" THEN PCG_SET(pbm,c,p$+p$+p$)
UNTIL p$="end"
DO
 READ.NEXT c,p$
 IF p$<>"end" THEN PCG_SET(pbm,c,p$)
UNTIL p$="end"
q$="fefefefefefefefc"
DO
 READ.NEXT c,p$
 IF p$<>"end" THEN
  PCG_SET(pbm,c,p$+p$+p$)
  PCG_SET(pbm,c+32,p$+q$+p$)
 ENDIF
UNTIL p$="end"
! ビットマップ作成
DIM bm_card[13,4]
FOR y=1 TO 4
 FOR x=1 TO 13
  p$="\4"+CHR$(64+y)+"E\h\n"
  z=MOD(y+1,2)
  IF x=10 THEN p$+=CHR$(84+z*32) ELSE p$+="F"
  p$+="\h"+CHR$(70+z*32+x)
  bm_card[x,y]=PCG_GET(pbm,p$)
 NEXT
NEXT
bm_reverse=PCG_GET(pbm,"\4ab\h\ncd")
bm_rev_s=PCG_GET(pbm,"\4e")
bm_pass=PCG_GET(pbm,"\4f")
bm_title=PCG_GET(pbm,"\4e\0 \h7NARABE ver.1")
bm_name=PCG_GET(pbm,"COM1:\nCOM2:\nCOM3:\n \hYOU \h:")
bm_act=PCG_GET(pbm,"act.")
bm_pt=PCG_GET(pbm,"pt.")
bm_ptimage=PCG_GET(pbm," ")

DIM bm_status[4],gl_status[4]
DIM gl_hand[13]
DIM rest[4],pass[4],hand[4,13]
DIM mount[52]
DIM field[13,4]
act=1:pt=0

init:
! 画面
GR.CLS
GR.BITMAP.DRAW g,bm_title,0,0
GR.BITMAP.DRAW g,bm_name,0,80
GR.BITMAP.DELETE bm_act
bm_act=PCG_GET(pbm,"act.\n"+USING$("","%4d",INT(act)))
GR.BITMAP.DRAW gl_act,bm_act,168,0
GR.BITMAP.DRAW gl_pt,bm_pt,168,16
GR.BITMAP.DRAW gl_ptimage,bm_ptimage,168,56
FOR i=1 TO 3
 bm_status[i]=PCG_GET(pbm,"STATUS")
 GR.BITMAP.DRAW gl_status[i],bm_status[i],40,i*8+72
NEXT
bm_status[4]=PCG_GET(pbm,"    ")
GR.BITMAP.DRAW gl_status[4],bm_status[4],8,112
! ゲーム初期化
rank=3
FOR turn=1 TO 4
 rest[turn]=0:pass[turn]=3
 FOR i=1 TO 13
  hand[turn,i]=0 
 NEXT
 GOSUB update_status
NEXT
GOSUB update_pt
! 場
FOR i=1 TO 4
 FOR j=1 TO 13
  field[j,i]=0
 NEXT
NEXT
GR.RENDER
! 山札
FOR i=1 TO 52
 mount[i]=i
NEXT
! シャッフル
ARRAY.SHUFFLE mount[]
!!
FOR i=1 TO 52
 x=FLOOR(52*RND()+1)
 SWAP mount[i],mount[x]
NEXT
!!
! 配る
FOR i=1 TO 13
 FOR turn=1 TO 4
  hand[turn,i]=mount[(i-1)*4+turn]
  rest[turn]++
  IF turn<4 THEN
   GOSUB update_status
  ELSE
   GR.BITMAP.DRAW gl_hand[i],bm_reverse,i*12+28,104
  ENDIF
  GR.RENDER
  PAUSE 33
 NEXT
NEXT
! プレイヤーのカードめくる
FOR i=1 TO 13
 card=hand[4,i]:GOSUB getmarknumber
 GR.MODIFY gl_hand[i],"bitmap",bm_card[number,mark]
 GR.RENDER
 PAUSE 33
NEXT
! ソート
FOR i=1 TO 12
 FOR j=i+1 TO 13
  IF hand[4,i]>hand[4,j] THEN
   SWAP hand[4,i],hand[4,j]
   card=hand[4,i]:GOSUB getmarknumber
   GR.MODIFY gl_hand[i],"bitmap",bm_card[number,mark]
   card=hand[4,j]:GOSUB getmarknumber
   GR.MODIFY gl_hand[j],"bitmap",bm_card[number,mark]
   GR.RENDER
   PAUSE 33
  ENDIF
 NEXT
NEXT
! 7を取り出す
FOR turn=1 TO 4
 FOR i=1 TO 13
  card=hand[turn,i]:GOSUB getmarknumber
  IF number=7 THEN
   IF mark=4 THEN
    start=turn
    GR.COLOR 127,255,0,0,2
    GR.RECT gl_turn,0,turn*8+72,40,turn*8+80
    GR.COLOR 255
   ENDIF 
   IF turn<4 THEN
    GR.BITMAP.DRAW gl_move,bm_card[number,mark],rest[turn]*8+30,turn*8+70
   ELSE
    gl_move=gl_hand[i]
   ENDIF
   hand[turn,i]=0
   rest[turn]--
   GOSUB update_status
   GOSUB to_field
   field[number,mark]=1
  ENDIF
 NEXT
NEXT
turn=start
choiced=0
message$="Start !!":GOSUB view_message
! メインループ
loop:
IF turn=4 THEN
 ! プレイヤー
 IF rest[1]<=0 & rest[2]<=0 & rest[3]<=0 THEN
  pt+=rank:GOSUB update_pt:rank=0
  message$="Finish !":GOSUB view_message
  GOSUB all_field
  GOTO turn_next
 ENDIF
 GR.TOUCH touched,x,y
 x=INT(x/x_scale):y=INT(y/y_scale)
 IF touched THEN
  IF x>=8 & x<40 & y>=104 & y<120 THEN
   ! パス
   IF pass[4]>0 THEN
    DIALOG.MESSAGE "PASS","パスしますか?",s,"はい","いいえ"
    IF s=1 THEN
     pass[4]--
     GOSUB update_status
     GR.RENDER
     GOTO turn_next
    ENDIF
   ELSE
    DIALOG.MESSAGE "OVER","脱落します……。",s,"はい","いいえ"
    IF s=1 THEN
     rank=0
     GOSUB all_field
     GOTO turn_next
    ENDIF
   ENDIF
  ELSEIF x>=168 & y<8 THEN
! AI(隠し機能)
   GOSUB think
   IF think_p>0 THEN
    FOR i=1 TO 8
     GR.SHOW.TOGGLE gl_hand[think_c]
     GR.RENDER
     PAUSE 33
    NEXT
   ELSE
    FOR i=1 TO 8
     GR.SHOW.TOGGLE gl_status[4]
     GR.RENDER
     PAUSE 33
    NEXT
   ENDIF
  ENDIF
  IF choiced=0 THEN
   IF x>=40 & x<196 & y>=104 & y<120 THEN
    choiced=INT((x-40)/12)+1
    IF hand[4,choiced]=0 THEN choiced=0
   ENDIF
  ELSE
   GR.MODIFY gl_hand[choiced],"x",x-6,"y",y-8
   GR.RENDER
  ENDIF
 ELSE
  IF choiced>0 THEN
   IF y>=9 & y<76 THEN
    card=hand[4,choiced]:GOSUB checkcard
    IF check THEN
     GOSUB getmarknumber
     GR.MODIFY gl_hand[choiced],"x",number*12-4,"y",mark*17-8
     field[number,mark]=1
     hand[4,choiced]=0
     rest[4]--
     IF rest[4]=0 THEN
      pt+=rank:GOSUB update_pt:rank=0
      message$="Complete !!":GOSUB view_message
     ENDIF
     choiced=0
     GR.RENDER
     GOTO turn_next
    ELSE
     message$="Not put out !":GOSUB view_message
     GR.MODIFY gl_hand[choiced],"x",choiced*12+28,"y",104
     GR.RENDER
     choiced=0
    ENDIF
   ELSE
    GR.MODIFY gl_hand[choiced],"x",choiced*12+28,"y",104
    GR.RENDER
    choiced=0
   ENDIF
  ENDIF
 ENDIF
ELSE
 ! COMの処理
 GOSUB think
 IF FLOOR(6*RND()+1)<act THEN
  IF pass[turn]>0 & think_p<6 THEN think_p=0
 ENDIF
 IF think_p>0 THEN
  card=hand[turn,think_c]:GOSUB getmarknumber
  GR.BITMAP.DRAW gl_move,bm_card[number,mark],rest[turn]*8+30,turn*8+70
  hand[turn,think_c]=0
  rest[turn]--
  GOSUB update_status
  GOSUB to_field
  field[number,mark]=1
  IF rest[turn]=0 THEN
   rank--
   message$="Complete !!":GOSUB view_message
   rest[turn]=-1
   GOSUB update_status
   GR.RENDER
  ENDIF
 ELSE
  IF pass[turn]>0 THEN
   pass[turn]--
   GOSUB update_status
   message$="Pass !":GOSUB view_message
  ELSE
   message$="Drop out !":GOSUB view_message
   IF rest[4]>0 THEN pt++:GOSUB update_pt
   GOSUB all_field
   rest[turn]=-2
   GOSUB update_status
   GR.RENDER
  ENDIF
 ENDIF
 GOTO turn_next
ENDIF
PAUSE 33
GOTO loop

turn_next:
! 次の人へ
IF rest[1]>0 | rest[2]>0 | rest[3]>0 | rest[4]>0 THEN
 DO
  turn++:IF turn>4 THEN turn=1
 UNTIL rest[turn]>0
 GR.MODIFY gl_turn,"top",turn*8+72,"bottom",turn*8+80
 GR.RENDER
 IF turn<4 THEN PAUSE 300
 GOTO loop 
ENDIF
act++
IF act<=7 THEN
 IF rank>0 THEN pt+=rank:GOSUB update_pt
 message$="Go to next !!":GOSUB view_message
 GOTO init
ENDIF
message$="GAME SET !!":GOSUB view_message
PAUSE 1000
! エンディング
GR.CLS
GR.BITMAP.CREATE sc,x_size,y_size
GR.BITMAP.DRAWINTO.START sc
bm=PCG_GET(pbm,"\4X\0CONGRATURATIONS !!\4X")
GR.BITMAP.DRAW g,bm,16,8
bm=PCG_GET(pbm,"Your point is")
GR.BITMAP.DRAW g,bm,16,32
bm=PCG_GET(pbm,USING$("","%4d",INT(pt))+" point.")
GR.BITMAP.DRAW g,bm,80,40
GR.BITMAP.DRAW g,bm_ptimage,168,48
bm=PCG_GET(pbm,"Thank you for playing.")
GR.BITMAP.DRAW g,bm,0,72
bm=PCG_GET(pbm,"Presented by M.Yamaguchi.")
GR.BITMAP.DRAW g,bm,8,88
GR.BITMAP.DRAWINTO.END
GR.BITMAP.DRAW g,sc,0,0
bm=PCG_GET(pbm,"Please,touch to restart.")
GR.BITMAP.DRAW g,bm,8,112
GR.RENDER
DO
 GR.SHOW.TOGGLE g
 GR.RENDER
 GR.TOUCH touched,x,y
 PAUSE 33
UNTIL touched
GR.BITMAP.DELETE sc
GR.BITMAP.DELETE bm
act=1:pt=0
GOTO init

! サブルーチン
! メッセージ表示
view_message:
bm=PCG_GET(pbm,message$)
GR.BITMAP.DRAW g,bm,85-LEN(message$)*4,39
FOR si=0 TO 8
 GR.SHOW.TOGGLE g
 GR.RENDER
 PAUSE 66
NEXT
GR.BITMAP.DELETE bm
RETURN

! 思考ルーチン
think:
DIM pri[13]
FOR sj=1 TO 13
 card=hand[turn,sj]
 IF card>0 THEN
  GOSUB checkcard
  IF check THEN
   pri[sj]=6
   GOSUB getmarknumber
   IF number<7 & number>1 THEN
    FOR sk=1 TO number-1
     IF !field[sk,mark] THEN pri[sj]--
    NEXT
    FOR sk=number-1 TO 1 STEP -1
     FOR sl=1 TO 13
      IF hand[turn,sl]=(sk-1)*4+mark THEN
       pri[sj]=6
       FOR sm=sk TO number-1
        IF !field[sm,mark] THEN pri[sj]++
       NEXT
       F_N.BREAK
      ENDIF
     NEXT
    NEXT
   ELSEIF number>7 & number<13 THEN
    FOR sk=number+1 TO 13
     IF !field[sk,mark] THEN pri[sj]--
    NEXT
    FOR sk=number+1 TO 13
     FOR sl=1 TO 13
      IF hand[turn,sl]=(sk-1)*4+mark THEN
       pri[sj]=6
       FOR sm=number+1 TO sk
        IF !field[sm,mark] THEN pri[sj]++
       NEXT
       F_N.BREAK
      ENDIF
     NEXT
    NEXT
   ENDIF
  ENDIF
 ENDIF
NEXT
think_c=0:think_p=0
FOR si=1 TO 13
 IF pri[si]>think_p THEN think_p=pri[si]:think_c=si
NEXT
ARRAY.DELETE pri[]
RETURN

! カードが出せるかチェック
checkcard:
GOSUB getmarknumber
check=1
IF number<6 THEN
 FOR si=number+1 TO 6
  IF !field[si,mark] THEN check=0
 NEXT
ELSEIF number>8 THEN
 FOR si=number-1 TO 8 STEP -1
  IF !field[si,mark] THEN check=0
 NEXT
ENDIF
RETURN

! カードを場に移動する
to_field:
GR.GET.VALUE gl_move,"x",x,"y",y
tx=number*12-4:ty=mark*17-8
mx=(tx-x)/8:my=(ty-y)/8
FOR si=1 TO 7
 GR.MOVE gl_move,mx,my
 GR.RENDER
 PAUSE 33
NEXT
GR.MODIFY gl_move,"x",tx,"y",ty
GR.RENDER
RETURN

! 全部出す
all_field:
FOR sj=1 TO 13
 IF hand[turn,sj]>0 THEN
  card=hand[turn,sj]:GOSUB getmarknumber
  IF turn=4 THEN
   gl_move=gl_hand[sj]
  ELSE
   GR.BITMAP.DRAW gl_move,bm_card[number,mark],rest[turn]*8+30,turn*8+70
  ENDIF
  hand[turn,sj]=0
  rest[turn]--
  GOSUB update_status
  GOSUB to_field
  field[number,mark]=1
  ENDIF
 NEXT
RETURN

! カード番号から数字とマークを得る
getmarknumber:
mark=MOD(card-1,4)+1
number=INT((card-1)/4)+1
RETURN

! ステータス更新
update_status:
s$=""
IF turn<4 THEN
 IF rest[turn]>0 THEN
  FOR si=1 TO 13
   IF si<=rest[turn] THEN s$+="\4e" ELSE s$+="\0 "
  NEXT
 ELSEIF rest[turn]=-1 THEN
  s$="\0  Complete   "
 ELSEIF rest[turn]=-2
  s$="\0 Drop out... "
 ELSE
  s$="\0             "
 ENDIF
ENDIF
s$+="\0 \h"
IF turn=4 & pass[turn]=0 THEN
 s$="OVER"
ELSE
 FOR si=1 TO 3
  IF si<=pass[turn] THEN s$+="\4f"
 NEXT
ENDIF
GR.BITMAP.DELETE bm_status[turn]
bm_status[turn]=PCG_GET(pbm,s$)
GR.MODIFY gl_status[turn],"bitmap",bm_status[turn] 
RETURN

! ポイント更新
update_pt:
GR.BITMAP.DELETE bm_pt
bm_pt=PCG_GET(pbm,"pt.\n"+USING$("","%4d",INT(pt)))
GR.MODIFY gl_pt,"bitmap",bm_pt
GR.BITMAP.DELETE bm_ptimage
g1$="":g2$=""
IF pt>=10 THEN g1$+="X":g2$+="W"
IF pt>=20 THEN g1$+="Y":g2$+="W"
IF pt>=30 THEN g1$+="Z":g2$+="W"
IF pt>=40 THEN g1$+="{":g2$+="W"
IF MOD(pt,10)>=5 THEN
 g2$+="V"
ELSEIF MOD(pt,10)>0 THEN
 g2$+="U"
ENDIF
bm_ptimage=PCG_GET(pbm,"\4"+g1$+"\n"+g2$)
GR.MODIFY gl_ptimage,"bitmap",bm_ptimage
RETURN

! PCGデータ
READ.DATA 32,"0000000000000000"
READ.DATA 33,"1818181818001800"
READ.DATA 34,"6c6c6c0000000000"
READ.DATA 35,"36367f367f363600"
READ.DATA 36,"183e583c1a7c1800"
READ.DATA 37,"0073760c18376700"
READ.DATA 38,"386c6c386f663f00"
READ.DATA 39,"3818300000000000"
READ.DATA 40,"0c18303030180c00"
READ.DATA 41,"30180c0c0c183000"
READ.DATA 42,"1054387c38541000"
READ.DATA 43,"0018187e18180000"
READ.DATA 44,"0000000038183000"
READ.DATA 45,"0000007e00000000"
READ.DATA 46,"0000000038380000"
READ.DATA 47,"0003060c18306000"
READ.DATA 48,"3e63636363633e00"
READ.DATA 49,"1838781818187e00"
READ.DATA 50,"3e63030e38607f00"
READ.DATA 51,"3e63033e03633e00"
READ.DATA 52,"060e1e367f060600"
READ.DATA 53,"7f607c0603663c00"
READ.DATA 54,"1e30607e63633e00"
READ.DATA 55,"7f63060c18181800"
READ.DATA 56,"3e63633e63633e00"
READ.DATA 57,"3e63633f03063c00"
READ.DATA 58,"0038380038380000"
READ.DATA 59,"0038380038183000"
READ.DATA 60,"0f1c3870381c0f00"
READ.DATA 61,"00007f007f000000"
READ.DATA 62,"781c0e070e1c7800"
READ.DATA 63,"3e63030e18001800"
READ.DATA 64,"1e336f7f6e301f00"
READ.DATA 65,"1c36637f63636300"
READ.DATA 66,"7e63637e63637e00"
READ.DATA 67,"1e33606060331e00"
READ.DATA 68,"7c36333333367c00"
READ.DATA 69,"7f60607c60607f00"
READ.DATA 70,"7f60607c60606000"
READ.DATA 71,"1e33606f63331e00"
READ.DATA 72,"6363637f63636300"
READ.DATA 73,"3c18181818183c00"
READ.DATA 74,"0f06060606663c00"
READ.DATA 75,"63666c786c666300"
READ.DATA 76,"6060606060607f00"
READ.DATA 77,"63777f6b63636300"
READ.DATA 78,"63737b6f67636300"
READ.DATA 79,"1c36636363361c00"
READ.DATA 80,"7e63637e60606000"
READ.DATA 81,"1c3663636f361b00"
READ.DATA 82,"7e63637e6c666300"
READ.DATA 83,"3e63603e03633e00"
READ.DATA 84,"7e18181818181800"
READ.DATA 85,"6363636363633e00"
READ.DATA 86,"63636336361c1c00"
READ.DATA 87,"6363636b7f774300"
READ.DATA 88,"6363361c36636300"
READ.DATA 89,"6666663c18181800"
READ.DATA 90,"7f03061c30607f00"
READ.DATA 91,"3e30303030303e00"
READ.DATA 92,"663c7e187e181800"
READ.DATA 93,"7c0c0c0c0c0c7c00"
READ.DATA 94,"183c660000000000"
READ.DATA 95,"0000000000007f00"
READ.DATA 96,"30180c0000000000"
READ.DATA 97,"00003e063e663b00"
READ.DATA 98,"60607e7363737e00"
READ.DATA 99,"00003e6360633e00"
READ.DATA 100,"03033f6763673f00"
READ.DATA 101,"00003e637f603e00"
READ.DATA 102,"0e18187e18181800"
READ.DATA 103,"00003d67673f033e"
READ.DATA 104,"60607e7363636300"
READ.DATA 105,"1800381818183c00"
READ.DATA 106,"06000e060606663c"
READ.DATA 107,"6060666c786c6600"
READ.DATA 108,"3818181818183c00"
READ.DATA 109,"0000eedbdbdbdb00"
READ.DATA 110,"00005e6363636300"
READ.DATA 111,"00003e6363633e00"
READ.DATA 112,"00005e73737e6060"
READ.DATA 113,"00003d67673f0303"
READ.DATA 114,"00005e7360606000"
READ.DATA 115,"00003f603e037e00"
READ.DATA 116,"18187e18181b0e00"
READ.DATA 117,"0000636363673d00"
READ.DATA 118,"0000636363361c00"
READ.DATA 119,"0000636b6b6b3e00"
READ.DATA 120,"000063361c366300"
READ.DATA 121,"00006363673f033e"
READ.DATA 122,"00007f061c307f00"
READ.DATA 123,"1c30306030301c00"
READ.DATA 124,"1818181818181800"
READ.DATA 125,"380c0c060c0c3800"
READ.DATA 126,"007f000000000000"
READ.DATA 127,"0000037eec6c6e00"
READ.DATA 0,"end"
READ.DATA 129,"7ff7e3c18080f7e37ff7e3c18080f7e37ff7e3c18080f7e3"
READ.DATA 130,"7fc9808080c1e3f77fffffffffffffff7fc9808080c1e3f7"
READ.DATA 131,"7fe3e3948094f7e37fe3e3948094f7e37fe3e3948094f7e3"
READ.DATA 132,"7ff7e3c180c1e3f77fffffffffffffff7ff7e3c180c1e3f7"
READ.DATA 133,"c0e0e0e0e0e0e0e0c0e0e0e0e0e0e0e0c0e0e0e0e0e0e0e0"
READ.DATA 134,"f0f0f0f0f0f0f070f0f0f0f0f0f0f070f0f0f0f0f0f0f070"
READ.DATA 148,"80c0c0c0c0c0c07080c0c0c0c0c0c07080c0c0c0c0c0c070"
READ.DATA 161,"7f808080808080807fd5aad5aad5aad57f80808080808080"
READ.DATA 162,"c020202020202020c060a060a060a060c020202020202020"
READ.DATA 163,"808080808080807faad5aad5aad5aa7f808080808080807f"
READ.DATA 164,"20202020202020c0a060a060a060a0c020202020202020c0"
READ.DATA 165,"fe8282828282fe00fed6aad6aad6fe00fe8282828282fe00"
READ.DATA 166,"78f8ececf86000007c869292869e7c007c869292869e7c00"
READ.DATA 180,"80c0c0c0c0c0c070f0f0f0f0f0f0f07080c0c0c0c0c0c070"
READ.DATA 149,"00000000000000000000000000000000000000c0ee6e1010"
READ.DATA 150,"00000000000000001038383010000000000000c0ee6e1010"
READ.DATA 151,"00000000000000000000000000000000888ad2d2d67e3c18"
READ.DATA 152,"000000000000000000385cfafebe74380000001038100000"
READ.DATA 153,"00385ceac6ae743800385cfafebe743800385cfafebe7438"
READ.DATA 154,"00385ceac6ae743800385cfafebe74380000001038100000"
READ.DATA 155,"00385ceac6ae7438000000103810000000385cfafebe7438"
READ.DATA 0,"end"
READ.DATA 135,"ce863232023232fc"
READ.DATA 136,"863232e6ce9e02fc"
READ.DATA 137,"8632f2c6f23286fc"
READ.DATA 138,"e6c6862602e6e6fc"
READ.DATA 139,"829e9e86f2f286fc"
READ.DATA 140,"86323e06323286fc"
READ.DATA 141,"0232f2e6e6cecefc"
READ.DATA 142,"86323286323286fc"
READ.DATA 143,"86323282f23286fc"
READ.DATA 144,"c69292929292c6fc"
READ.DATA 145,"c2e6e6e626268efc"
READ.DATA 146,"86323232022682f8"
READ.DATA 147,"32260e1e0e2632fc"
READ.DATA 0,"end"

2018年11月 5日 (月)

第6回「PCGエディター」

第6回「PCGエディター」

前置き

前回、PCGエディターみたいなのも欲しいなーなんて書きましたけど、作ってみました!というか、前回のキャラクターデータを作りながら作ってました。なので実際使う機能、あったらいいなと思う機能を盛り込んでみましたよ。

今回はプログラムの説明ではなく、ツールの使い方説明になります。使ったコマンド/関数も今まで使ってきたもので出来ていると思います。BASIC!なのでプログラムも好きに見られるので改造や機能追加もお好きなようにやったらいいと思いますよ~。

画面と操作

画面と操作についてです。基本的にこの画面だけです。メニューはありますけど全部一画面で完結してます。まぁ、それほど多機能でもないので……。

  • 1:編集するファイル名
  • 現在編集しているPCGのファイル名です。デフォルトで"pcgdata.png"が読み込まれます。

  • 2:全体のPCGデータ
  • PCGのファイルが表示されています。タッチするとそこのPCGが選択されたとして右側の編集エリアに拡大表示されます。選択された場所は上側と左側にある目盛りで判断できます。

  • 3:カーソル
  • 全体画面から選択はタッチだけでは指で見えにくくて操作しにくい場合があるのと、エディット操作を手軽にやりたいって思ってカーソルキーを付けました。モードによって操作が変わります。カーソルの右側に現在のモードが表示されます。そこらあたりをタッチするとモードが順番に入れ替わります。

    ほんとはカーソルキーをつけるのは邪道な気がします。2点タッチやダブルタップなどタッチパネル特有の操作を駆使したほうが直感的な操作になりそうです。でもカーソルキーを実装したほうが楽なんですよね~。という考え方が古いのだわとも思います。

    • cursor:カーソルモード
    • 全体のPCGデータの選択された位置を一つずつ移動します。PCG全体画面からの選択が細かくてうまくいかないときにこちらで見ながら選択するとよいです。

    • reverse:反転モード
    • 選択されたPCGを反転します。上下のカーソルで上下反転、左右のカーソルで左右反転します。

    • shift:1マスずらすモード
    • 選択されたPCGを1マスずらします。タッチしたカーソルの方向にずれます。

    • rotate:回転モード
    • 選択されたPCGを回転します。左右のカーソルで90度回転。上下のカーソルは180度回転します。

  • 4:クリップボード
  • ファンクションメニューの[COPY]/[PASTE]で使うクリップボードを見えるようにしてます。履歴が8個あり、貼り付け時に選択もできます。

  • 5:ファンクションメニュー
  • その他いろいろメニューです。メニューの文字をタッチすると選択できます。

    • FILE:ファイルメニュー
    • ファイル関係その他のメニューが開きます。

      • ロード
      • PCGデータをロードします。PCGデータは128×128ドットのpng形式の画像でお願いします。そうでなくても読み込んでしまいます。

      • セーブ
      • PCGデータをセーブします。ファイル名を指定してください。PCGデータといってもただのpng形式の画像です。

      • データファイル作成
      • データファイルを作成します。ファイル名とデータ化開始位置、終了位置を指定してください。データファイルの中身はただのテキストファイルで下記の形式の羅列です。

        
        READ.DATA chrno,"data..."
        

        chrnoにアスキーコードが入ります。その後に16進数が羅列された文字列がデータです。

      • サイズ変更
      • エディットサイズを変更します。8×8ドットと16×16ドットが選べます。

      • 1データ作成
      • 現在編集中の1文字分のデータがクリップボードに入ります。1文字分だけです。プログラミング中に思いついたとき、中断してPCGエディターでデータ作成、その後すぐプログラミングに戻ってリストに貼り付け!なんてことをイメージしてます。

      • 1データ取り込み
      • X1のDEFCHR$命令で使われていたデータを読み込むのに使います。24文字の16進数が羅列されたデータを入力してください。X1用のプログラムリストを持ってる人は入れてみると幸せになれるかもです。

    • FILL
    • 現在選択されているパレットで選択されているPCGを塗りつぶします。全体が同じ色になります。

    • COPY
    • クリップボードの1番に編集中のPCGをコピーします。クリップボードには8個保存できます。古いのから順に消去されます。

    • PASTE
    • 選択されたクリップボードからエディット画面に貼り付けます。タッチで貼り付けるクリップを指定できます。アンドゥは無いのでこれをうまく活用してください。

  • 6:エディット画面
  • 実際の編集画面です。タッチしたところにパレットで選択中の色が付きます。

  • 7:パレット画面
  • ここでエディット画面に付ける色を選択します。タッチで色を選択します。

作ったデータの使い方

[FILE]メニューのデータファイル作成で作成されたテキストファイルはこんな感じになります。


READ.DATA 129,"0103070f1f3f7fff01030509112040800103050911204080"
READ.DATA 130,"00000000fefefefe00000000fe02020200000000fe020202"
READ.DATA 131,"7f3f1f0f0703010040201109050301004020110905030100"
READ.DATA 132,"fefefe00000000000202fe00000000000202fe0000000000"
READ.DATA 133,"01010101ffffffff01010101ff80808001010101ff808080"
READ.DATA 134,"0080c0e0f0f8fcfe00804020100804020080402010080402"
READ.DATA 135,"ffffff01010101008080ff01010101008080ff0101010100"
READ.DATA 136,"fcf8f0e0c080000004081020408000000408102040800000"

テキストファイルの中身をコピーして自分のプログラムに貼り付けます。自分の場合はYahoo!のファイルマネージャーで選択、Chromeで開いて「すべて選択」「コピー」、その後BASIC!のエディターで「書式なしテキストとして貼り付け」で貼り付けでやってます。READ.DATAコマンド付きでデータが作ってあるので、そのままプログラムの末尾にでも貼り付けましょう。さらにデータ終わりの印に、


READ.DATA 0,"end"

と入れておいてください。そして次のようなプログラムリストをPCG定義したい場所にいれます。


GR.BITMAP.CREATE pbm,128,128
READ.FROM 1
DO
 READ.NEXT c,p$
 IF p$<>"end" THEN PCG_SET(pbm,c,p$)
UNTIL p$="end"

まずGR.BITMAP.CREATEコマンドで空のビットマップを作成します。READ.FROMコマンドでデータ位置を初期化後、DO/UNTILのループでデータが終わるまで読み込みながらPCGをPCG_SET()関数で定義します。PCG_SET()関数はユーザー定義関数です。ユーザー定義関数に関しては前回を参照してください。

ここで作成するビットマップは普通の128×128のpng形式の画像です。なのでこのPCGエディタを使わなくても他の高機能なグラフィックツールで作成してデータを読み込むだけでもOKです。(そうするとPCG_SET()関数もいらないなー。)8色でなくフルカラーでデータを作ることもできます。その場合はロードしたビットマップにPCG_SET()関数では書き込めません。GR.BITMAP.CREATEコマンドで空のビットマップを作成して、ロードしたビットマップをコピーしてください。


bm=PCG_GET(pbm,"PCG EDITOR ver.1")
GR.BITMAP.DRAW g,bm,0,0

PCGが定義できたらあとは使うだけです。PCG_GET()関数で文字列を指定するとビットマップに変換されて返されます。それを普通のビットマップとしてGR.BITMAP.DRAWコマンドで表示するだけです。

ユーザー定義関数と上記のデータ読み込み部分、そしてデータが揃えばPCGを使用することが出来ます。このPCGエディター自体もPCGを使って作っているので、リストを見れば使い方もわかるかと思います。あー、前回の方がわかりやすいかな?

こんなデータ作ってみました

このPCGエディターでこんなデータを作ってみました。自作データの雛形に使ってみてください。

普通にアスキーコードを入れてみました。実際に使いやすいようにカナや記号などは省きました。

X1のフォントを再現してみました。カタカナがなかなかいいでしょ?図形や時分秒など、昔の雰囲気が出てますね。

ひらがな、カタカナが表示できるように作ってみました。昔、同人ソフト作ったときにPCGでひらがなを作ったなー、なんて懐かしい思いで作りました。個人的感想ではザ・8ビット機って感じです。

前回のキャラクタデータを作るときに作ったデータです。上4行をワークエリアにしてどんどん作成していきました。上2行はアスキーコードでは特殊文字なので聖域っていうか使いにくいです(気持ちの問題)。このプログラムには関係ないですけどね。気がついたらうっかり数字の部分も消えてしまいました。また作らなきゃ。

あとがき

そんなわけで、PCGっぽいもの完結編です。ちょっとしたプログラムを作ったときにプログラムリスト以外に「〇〇のデータをどこどこに用意してくださいね~。」っていうのがイヤでした。プログラムリストだけ、一つのファイルだけでなんとかならないかなーと考えたときに思いついたのがPCGでした。それなりに大きなプログラムで、頑張って用意した甲斐があるのなら、やってもらってそれでもいいんですけど、あんまり頑張ってないプログラムでも見てほしいじゃん?なんて思ってます。

BASIC!はこういうツールみたいなものも比較的お手軽に作れていいですね。もっとPCを使わずにプログラミングで遊べる環境を作れればいいなーと思います。やっぱりAndroid機だけ、これだけですべて完結できるのはお手軽でよいです。ほんとに仕事の合間で遊べてるんですよー。BASIC!のエディターも超絶使いやすいってわけでもないんですけど、普通には使えます。Bluetoothのキーボードもチャタリングひどいけど、なんとかなってます。

これで準備は整いました!あとは思いつくまま気の向くまま、作りまくるだけですわ~。

それでは最後にコメントなしのプログラムリストです。ダウンロードでもどうぞ~。


REM PCG EDITOR ver1
! PCG
! PCG GET
FN.DEF PCG_GET(bm,s$)
 sx=8:sy=8:x=0
 FOR i=1 TO LEN(s$)
  IF MID$(s$,i,1)="\"
   i++
   IF MID$(s$,i,1)="n" THEN x=0:sy+=8
   IF MID$(s$,i,1)="h" THEN x-=4
  ELSE
   x+=8:IF x>sx THEN sx=x
  ENDIF 
 NEXT
 GR.BITMAP.CREATE ret_bm,sx,sy
 x=0:y=0:z=0
 GR.COLOR 255,255,255,255,2
 GR.BITMAP.DRAWINTO.START ret_bm
 FOR i=1 TO LEN(s$)
  c$=MID$(s$,i,1)
  IF c$="\" THEN
   IF MID$(s$,i+1,1)="n" THEN
    x=0:y+=8:i++
    F_N.CONTINUE
   ELSEIF MID$(s$,i+1,1)="h" THEN
    x-=4:i++
    F_N.CONTINUE
   ELSEIF IS_IN(MID$(s$,i+1,1),"0123456789ABCDEF")>0 THEN
    z=HEX(MID$(s$,i+1,1))
    i++
    F_N.CONTINUE
   ELSE
    i++
   ENDIF
  ENDIF
  s=ASCII(c$)+z*16
  IF s>=256 THEN s-=256
  sx=MOD(s,16):sy=INT(s/16)
  GR.BITMAP.CROP b,bm,sx*8,sy*8,8,8
  GR.BITMAP.DRAW g,b,x,y
  x+=8
  GR.BITMAP.DELETE b
 NEXT
 GR.BITMAP.DRAWINTO.END
 FN.RTN ret_bm
FN.END
! PCG SET
FN.DEF PCG_SET(bm,c,data$)
 sx=MOD(c,16)*8:sy=FLOOR(c/16)*8
 b$="":r$="":g$=""
 FOR i=1 TO 16
  b$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i,1))),4)
  r$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i+16,1))),4)
  g$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i+32,1))),4)
 NEXT
 GR.BITMAP.DRAWINTO.START bm
 FOR y=0 TO 7
  FOR x=0 TO 7
   IF MID$(b$,y*8+x+1,1)="1" THEN b=255 ELSE b=0
   IF MID$(r$,y*8+x+1,1)="1" THEN r=255 ELSE r=0
   IF MID$(g$,y*8+x+1,1)="1" THEN g=255 ELSE g=0
   GR.COLOR 255,r,g,b,0
   GR.POINT g,sx+x,sy+y
  NEXT
 NEXT
 GR.BITMAP.DRAWINTO.END
FN.END

! 初期設定
ARRAY.LOAD pallet$[],"000000","0000FF","00FF00","00FFFF",~
"FF0000","FF00FF","FFFF00","FFFFFF"
DIM gl_p[8]
size_edit=8
x_pcg=0:y_pcg=0
fn$="pcgdata.png"
c_mode=0
s_pallet=0
s_clip=0

x_size=400
y_size=240
GR.OPEN 255,0,0,0
GR.ORIENTATION 0
PAUSE 1000
GR.SCREEN x,y
x_scale=x/x_size
y_scale=y/y_size
GR.SCALE x_scale,y_scale
GR.SET.ANTIALIAS 0
! PCG読み込み
GR.BITMAP.CREATE pbm,128,128
READ.FROM 1
DO
 READ.NEXT c,p$
 IF p$<>"end" THEN PCG_SET(pbm,c,p$+p$+p$)
UNTIL p$="end"
DO
 READ.NEXT c,p$
 IF p$<>"end" THEN PCG_SET(pbm,c,p$)
UNTIL p$="end"
GR.BITMAP.CREATE bm_pcg,128,128
GOSUB pcgload
! コピペ用
GR.BITMAP.CREATE bm_clip,16,128

GOSUB screen_init

! メインループ
loop:
GR.TOUCH touched,x,y
IF touched THEN
 x=INT(x/x_scale):y=INT(y/y_scale)
 ! パレットエリア
 IF x>=200 & x<392 & y>=208 & y<232 THEN
  s_pallet=INT((x-200)/24)
  GR.MODIFY gl_sp,"x",s_pallet*24+208
 ! エディットエリア
 ELSEIF x>=200 & x<392 & y>=8 & y<200 THEN
  IF size_edit=8 THEN s=24 ELSE s=12
  x=INT((x-200)/s)
  y=INT((y-8)/s)
  GR.BITMAP.DRAWINTO.START bm_edit
  GR.PAINT.COPY gl_p[s_pallet+1]
  GR.RECT g,x*s+1,y*s+1,x*s+s,y*s+s
  GR.BITMAP.DRAWINTO.END
  GR.BITMAP.DRAWINTO.START bm_pcg
  GR.POINT g,x_pcg*8+x,y_pcg*8+y
  GR.BITMAP.DRAWINTO.END
 ! PCG全体
 ELSEIF x>=8 & x<136 & y>=40 & y<168 THEN
  x=INT((x-8)/8)
  y=INT((y-40)/8)
  IF size_edit=16 THEN
   IF x>=15 THEN x=14
   IF y>=15 THEN y=14
  ENDIF
  GR.MODIFY gl_px,"left",x*8+8,"right",x*8+8+size_edit
  GR.MODIFY gl_py,"top",y*8+40,"bottom",y*8+40+size_edit
  x_pcg=x:y_pcg=y
  GOSUB getpcg
! クリップボード
 ELSEIF x>=168 & x<184 & y>=40 & y<168 THEN
  s_clip=INT((y-40)/16)
  GR.MODIFY gl_clip,"y",s_clip*16+48
! モード変更
 ELSEIF x>=56 & x<128 & y>=184 & y<216 THEN
  c_mode++
  IF c_mode>3 THEN c_mode=0
  GR.MODIFY gl_cm,"top",c_mode*8+184,"bottom",c_mode*8+192
  DO
   GR.TOUCH touched,x,y
  UNTIL !touched
! カーソル
 ELSE
  c=0
  IF x>=0 & x<16 & y>=192 & y<208 THEN c=1
  IF x>=32 & x<48 & y>=192 & y<208 THEN c=2
  IF x>=16 & x<32 & y>=176 & y<192 THEN c=3
  IF x>=16 & x<32 & y>=208 & y<224 THEN c=4
  IF c>0 THEN
   SW.BEGIN c_mode
! カーソルモード
    SW.CASE 0
     IF c=1 & x_pcg>0 THEN x_pcg--
     IF c=2 & x_pcg<15 THEN x_pcg++
     IF c=3 & y_pcg>0 THEN y_pcg--
     IF c=4 & y_pcg<15 THEN y_pcg++
     IF size_edit=16 THEN
      IF x_pcg>=15 THEN x_pcg=14
      IF y_pcg>=15 THEN y_pcg=14
     ENDIF
     GR.MODIFY gl_px,"left",x_pcg*8+8,"right",x_pcg*8+8+size_edit
     GR.MODIFY gl_py,"top",y_pcg*8+40,"bottom",y_pcg*8+40+size_edit
     GOSUB getpcg 
     SW.BREAK
! リバースモード
    SW.CASE 1
     GR.BITMAP.CROP b,bm_pcg,x_pcg*8,y_pcg*8,size_edit,size_edit
     IF c=1 | c=2 THEN
      GR.BITMAP.SCALE b2,b,-size_edit,size_edit,0
     ELSE
      GR.BITMAP.SCALE b2,b,size_edit,-size_edit,0
     ENDIF
     GR.BITMAP.DRAWINTO.START bm_pcg
     GR.BITMAP.DRAW g,b2,x_pcg*8,y_pcg*8
     GR.BITMAP.DRAWINTO.END
     GR.BITMAP.DELETE b
     GR.BITMAP.DELETE b2
     GOSUB getpcg
     SW.BREAK
! シフトモード
    SW.CASE 2
     GR.BITMAP.DRAWINTO.START bm_pcg
     SW.BEGIN c
      SW.CASE 1
       GR.BITMAP.CROP b,bm_pcg,x_pcg*8+1,y_pcg*8,size_edit-1,size_edit
       GR.BITMAP.DRAW g,b,x_pcg*8,y_pcg*8
       SW.BREAK
      SW.CASE 2
       GR.BITMAP.CROP b,bm_pcg,x_pcg*8,y_pcg*8,size_edit-1,size_edit
       GR.BITMAP.DRAW g,b,x_pcg*8+1,y_pcg*8
       SW.BREAK
      SW.CASE 3
       GR.BITMAP.CROP b,bm_pcg,x_pcg*8,y_pcg*8+1,size_edit,size_edit-1
       GR.BITMAP.DRAW g,b,x_pcg*8,y_pcg*8
       SW.BREAK
      SW.CASE 4
       GR.BITMAP.CROP b,bm_pcg,x_pcg*8,y_pcg*8,size_edit,size_edit-1
       GR.BITMAP.DRAW g,b,x_pcg*8,y_pcg*8+1
       SW.BREAK
     SW.END
     GR.BITMAP.DRAWINTO.END
     GR.BITMAP.DELETE b
     GOSUB getpcg
     SW.BREAK
! 回転モード
    SW.CASE 3
     GR.BITMAP.CROP bm,bm_pcg,x_pcg*8,y_pcg*8,size_edit,size_edit
     GR.BITMAP.DRAWINTO.START bm_pcg
     IF c=1 THEN
      FOR x=0 TO size_edit-1
       FOR y=0 TO size_edit-1
        GR.GET.BMPIXEL bm,size_edit-y-1,x,a,r,g,b
        GR.COLOR a,r,g,b,2
        GR.POINT g,x_pcg*8+x,y_pcg*8+y
       NEXT
      NEXT 
     ELSEIF c=2 THEN
      FOR x=0 TO size_edit-1
       FOR y=0 TO size_edit-1
        GR.GET.BMPIXEL bm,y,size_edit-x-1,a,r,g,b
        GR.COLOR a,r,g,b,2
        GR.POINT g,x_pcg*8+x,y_pcg*8+y
       NEXT
      NEXT 
     ELSE
      FOR x=0 TO size_edit-1
       FOR y=0 TO size_edit-1
        GR.GET.BMPIXEL bm,size_edit-x-1,size_edit-y-1,a,r,g,b
        GR.COLOR a,r,g,b,2
        GR.POINT g,x_pcg*8+x,y_pcg*8+y
       NEXT
      NEXT 
     ENDIF
     GR.BITMAP.DRAWINTO.END
     GR.BITMAP.DELETE bm
     GOSUB getpcg
     SW.BREAK
   SW.END
   DO
    GR.TOUCH touched,x,y
   UNTIL !touched
! ファンクショメニュー
  ELSEIF y>=224 THEN
! FILE
   IF x<48 THEN
    GOSUB menu_file
! FILL
   ELSEIF x<96 THEN
    DIALOG.MESSAGE "FILL", "現在の色で塗りつぶしますか?",ys,"はい","いいえ"
    IF ys=1 THEN
     GR.BITMAP.DRAWINTO.START bm_pcg
     GR.PAINT.COPY gl_p[s_pallet+1]
     GR.RECT g,x_pcg*8,y_pcg*8,x_pcg*8+size_edit,y_pcg*8+size_edit     
     GR.BITMAP.DRAWINTO.END
     GOSUB getpcg
    ENDIF
! COPY
   ELSEIF x<144 THEN
    GR.BITMAP.DRAWINTO.START bm_clip
    GR.BITMAP.CROP bm,bm_clip,0,0,16,112
    GR.BITMAP.DRAW g,bm,0,16
    GR.BITMAP.DELETE bm
    GR.BITMAP.CROP bm,bm_pcg,x_pcg*8,y_pcg*8,size_edit,size_edit
    GR.COLOR 255,0,0,0,2
    GR.RECT g,0,0,16,16
    GR.BITMAP.DRAW g,bm,0,0
    GR.BITMAP.DELETE bm
    GR.BITMAP.DRAWINTO.END
    DO
     GR.TOUCH touched,x,y
    UNTIL !touched
! PASTE
   ELSEIF x<200 THEN
    GR.BITMAP.CROP bm,bm_clip,0,s_clip*16,size_edit,size_edit
    GR.BITMAP.DRAWINTO.START bm_pcg
    GR.BITMAP.DRAW g,bm,x_pcg*8,y_pcg*8
    GR.BITMAP.DELETE bm
    GR.BITMAP.DRAWINTO.END
    GOSUB getpcg
   ENDIF
  ENDIF
 ENDIF
ENDIF
GR.RENDER
PAUSE 33
GOTO loop

! サブルーチン
getpcg:
DIM data[size_edit,size_edit]
IF size_edit=8 THEN s=24 ELSE s=12
GR.BITMAP.DRAWINTO.START bm_edit
FOR x=0 TO size_edit-1
 FOR y=0 TO size_edit-1
  GR.GET.BMPIXEL bm_pcg,x_pcg*8+x,y_pcg*8+y,a,r,g,b
  !  GR.COLOR 255,r,g,b,2
  c=0
  IF b>0 THEN c++
  IF r>0 THEN c+=2
  IF g>0 THEN c+=4
  data[x+1,y+1]=c 
  GR.PAINT.COPY gl_p[c+1]
  GR.RECT g,x*s+1,y*s+1,x*s+s,y*s+s
 NEXT
NEXT
GR.BITMAP.DRAWINTO.END
ARRAY.DELETE data[]
RETURN
! PCGデータ作成
getdata:
DIM b$[8],r$[8],g$[8]
FOR y=1 TO 8
 FOR x=x_pcg*8 TO x_pcg*8+7
  GR.GET.BMPIXEL bm_pcg,x,y_pcg*8+y-1,a,r,g,b
  IF b>0 THEN b$[y]+="1" ELSE b$[y]+="0"
  IF r>0 THEN r$[y]+="1" ELSE r$[y]+="0"
  IF g>0 THEN g$[y]+="1" ELSE g$[y]+="0"
 NEXT
 b$[y]=USING$("","%02x",BIN(b$[y]))
 r$[y]=USING$("","%02x",BIN(r$[y]))
 g$[y]=USING$("","%02x",BIN(g$[y]))
NEXT
data$=""
FOR y=1 TO 8
 data$+=b$[y]
NEXT
FOR y=1 TO 8
 data$+=r$[y]
NEXT
FOR y=1 TO 8
 data$+=g$[y]
NEXT
ARRAY.DELETE r$[],g$[],b$[]
RETURN

! PCGロード
pcgload:
GR.BITMAP.DRAWINTO.START bm_pcg
GR.COLOR 255,0,0,0,2
GR.RECT g,0,0,127,127
GR.BITMAP.LOAD bm_load,fn$
IF bm_load=-1 THEN
 POPUP "読み込みエラー"
ELSE
 GR.BITMAP.DRAW g,bm_load,0,0
 GR.BITMAP.DELETE bm_load 
ENDIF
GR.BITMAP.DRAWINTO.END
RETURN

! 画面構成
screen_init:
GR.CLS
bm=PCG_GET(pbm,"\2q\0 \hPCG EDITOR ver.1")
GR.BITMAP.DRAW g,bm,0,0
bm_fn=PCG_GET(pbm,"["+fn$+"]")
GR.BITMAP.DRAW gl_fn,bm_fn,0,16
bm=PCG_GET(pbm,"[FILE][FILL][COPY][PASTE]")
GR.BITMAP.DRAW g,bm,0,232
bm=PCG_GET(pbm,"\2ab\ncd")
GR.BITMAP.DRAW g,bm,0,192
bm=PCG_GET(pbm,"\2ef\ngh")
GR.BITMAP.DRAW g,bm,32,192
bm=PCG_GET(pbm,"\2ij\nkl")
GR.BITMAP.DRAW g,bm,16,176
bm=PCG_GET(pbm,"\2mn\nop")
GR.BITMAP.DRAW g,bm,16,208
bm=PCG_GET(pbm,"[ \hcursor \h]\n[reverse]\n[ shift ]\n[ \hrotate \h]")
GR.BITMAP.DRAW g,bm,56,184
GR.COLOR 127,255,0,0,2
GR.RECT gl_cm,56,c_mode*8+184,128,c_mode*8+192
! PCG全体
GR.COLOR 255,255,255,255,2
GR.BITMAP.DRAW g,bm_pcg,8,40
bm=PCG_GET(pbm,"0123456789ABCDEF")
GR.BITMAP.DRAW g,bm,8,32
bm=PCG_GET(pbm,"0\n1\n2\n3\n4\n5\n6\n7\n8\n9\nA\nB\nC\nD\nE\nF")
GR.BITMAP.DRAW g,bm,0,40
GR.COLOR 127,255,0,0,2
GR.RECT gl_px,x_pcg*8+8,32,x_pcg*8+8+size_edit,40
GR.RECT gl_py,0,y_pcg*8+40,8,y_pcg*8+40+size_edit
! エディット画面
GR.BITMAP.CREATE bm_edit,193,193
GR.BITMAP.DRAWINTO.START bm_edit
GR.COLOR 255,127,127,127,0
FOR i=0 TO 192 STEP 192/size_edit
 GR.LINE g,i,0,i,192
 GR.LINE g,0,i,192,i
NEXT
IF size_edit=16 THEN
 GR.COLOR 255,255,0,0,0
 GR.LINE g,96,0,96,192
 GR.LINE g,0,96,192,96
ENDIF
GR.BITMAP.DRAWINTO.END
GR.BITMAP.DRAW g,bm_edit,200,8
! パレット
FOR i=1 TO 8
 r=HEX(MID$(pallet$[i],1,2))
 g=HEX(MID$(pallet$[i],3,2))
 b=HEX(MID$(pallet$[i],5,2))
 GR.COLOR 255,g,r,b,2
 GR.RECT g,i*24+176,208,i*24+200,232
 GR.GET.VALUE g,"paint",gl_p[i]
NEXT
bm=PCG_GET(pbm,"\2q")
GR.BITMAP.DRAW gl_sp,bm,s_pallet*24+208,216
! コピペエリア
GR.BITMAP.DRAW gl_clip,bm,160,s_clip*16+48
bm=PCG_GET(pbm,"[clip]\n\n1\n\n2\n\n3\n\n4\n\n5\n\n6\n\n7\n\n8")
GR.BITMAP.DRAW g,bm,152,32
GR.BITMAP.DRAW g,bm_clip,168,40
GOSUB getpcg
RETURN

! ファイルメニュー
menu_file:
ARRAY.DELETE menu$[]
ARRAY.LOAD menu$[],"ロード","セーブ","データファイル作成","サイズ変更","1データ作成","1データ取り込み"
DIALOG.SELECT s,menu$[],"ファイル"
SW.BEGIN s
 SW.CASE 1
  path$=""
  ARRAY.DELETE d1$[]
  FILE.DIR path$,d1$[]
  SELECT s,d1$[]
  IF s>0 THEN
   fn$=d1$[s]
   GOSUB pcgload
   GR.BITMAP.DELETE bm_fn
   bm_fn=PCG_GET(pbm,"["+fn$+"]")
   GR.MODIFY gl_fn,"bitmap",bm_fn
   GOSUB getpcg
   ENDIF
  SW.BREAK
 SW.CASE 2
  INPUT "ファイル名",fn$,fn$,c
  GR.BITMAP.SAVE bm_pcg,fn$
  POPUP "セーブしました"
  GR.BITMAP.DELETE bm_fn
  bm_fn=PCG_GET(pbm,"["+fn$+"]")
  GR.MODIFY gl_fn,"bitmap",bm_fn
  SW.BREAK
 SW.CASE 3
  dfn$=LEFT$(fn$,IS_IN(".",fn$))+"txt"
  INPUT "ファイル名",dfn$,dfn$,c
  IF c THEN SW.BREAK
  s$=HEX$(y_pcg*16+x_pcg)
  e$=s$
  INPUT "どこから(16進数)",s$,s$,c
  IF c THEN SW.BREAK
  INPUT "どこまで(16進数)",e$,e$,c
  IF c THEN SW.BREAK
  TEXT.OPEN w,ft,dfn$
  FOR i=HEX(s$) TO HEX(e$)
   y_pcg=FLOOR(i/16)
   x_pcg=MOD(i,16)
   GOSUB getdata
   data$=USING$("","READ.DATA %d,%s%s%s",INT(i),CHR$(34),data$,CHR$(34))
   TEXT.WRITELN ft,data$
  NEXT
  TEXT.CLOSE ft
  POPUP "データファイル"+dfn$+"作成しました"
  SW.BREAK
 SW.CASE 4
  ARRAY.DELETE menu$[]
  ARRAY.LOAD menu$[],"8x8","16x16"
  DIALOG.SELECT s,menu$[],"サイズ変更"
  IF s<>0 THEN
   size_edit=s*8
   IF size_edit=16 THEN
    IF x_pcg>=15 THEN x_pcg=14
    IF y_pcg>=15 THEN y_pcg=14
   ENDIF
   GOSUB screen_init
  ENDIF
  SW.BREAK 
 SW.CASE 5
  GOSUB getdata
  CLIPBOARD.PUT data$
  POPUP "クリップボードにコピーしました"
  SW.BREAK
 SW.CASE 6
  INPUT "PCGデータを入力してください",data$,,c
  IF !c THEN
   IF LEN(data$)<>48 THEN
    POPUP "不正なデータです"+STR$(LEN(data$))
   ELSE
    CALL pcgset(bm_pcg,y_pcg*16+x_pcg,data$)
    GOSUB getpcg
   ENDIF
  ENDIF
  SW.BREAK
SW.END
RETURN

! PCGデータ
READ.DATA 33,"1010101010001000"
READ.DATA 34,"2828280000000000"
READ.DATA 35,"24247e247e242400"
READ.DATA 36,"103c503814781000"
READ.DATA 37,"0065640810264600"
READ.DATA 38,"304848304a443a00"
READ.DATA 39,"3010200000000000"
READ.DATA 40,"0810202020100800"
READ.DATA 41,"2010080808102000"
READ.DATA 42,"1054387c38541000"
READ.DATA 43,"0010107c10100000"
READ.DATA 44,"0000000030102000"
READ.DATA 45,"0000007c00000000"
READ.DATA 46,"0000000030300000"
READ.DATA 47,"0002040810204000"
READ.DATA 48,"3c42465a62423c00"
READ.DATA 49,"1030501010107c00"
READ.DATA 50,"3c42020c30407e00"
READ.DATA 51,"3c42023c02423c00"
READ.DATA 52,"040c14247e040400"
READ.DATA 53,"7e40780402443800"
READ.DATA 54,"1c20407c42423c00"
READ.DATA 55,"7e42040810101000"
READ.DATA 56,"3c42423c42423c00"
READ.DATA 57,"3c42423e02043800"
READ.DATA 58,"0030300030300000"
READ.DATA 59,"0030300030102000"
READ.DATA 60,"0e18306030180e00"
READ.DATA 61,"00007e007e000000"
READ.DATA 62,"70180c060c187000"
READ.DATA 63,"3c42020c10001000"
READ.DATA 64,"1c224a564c201e00"
READ.DATA 65,"1824427e42424200"
READ.DATA 66,"7c42427c42427c00"
READ.DATA 67,"1c22404040221c00"
READ.DATA 68,"7824222222247800"
READ.DATA 69,"7e40407840407e00"
READ.DATA 70,"7e40407840404000"
READ.DATA 71,"1c22404e42221c00"
READ.DATA 72,"4242427e42424200"
READ.DATA 73,"3810101010103800"
READ.DATA 74,"0e04040404443800"
READ.DATA 75,"4244487048444200"
READ.DATA 76,"4040404040407e00"
READ.DATA 77,"42665a5a42424200"
READ.DATA 78,"4262524a46424200"
READ.DATA 79,"1824424242241800"
READ.DATA 80,"7c42427c40404000"
READ.DATA 81,"182442424a241a00"
READ.DATA 82,"7c42427c48444200"
READ.DATA 83,"3c42403c02423c00"
READ.DATA 84,"7c10101010101000"
READ.DATA 85,"4242424242423c00"
READ.DATA 86,"4242422424181800"
READ.DATA 87,"4242425a5a664200"
READ.DATA 88,"4242241824424200"
READ.DATA 89,"4444443810101000"
READ.DATA 90,"7e02041820407e00"
READ.DATA 91,"3c20202020203c00"
READ.DATA 92,"44287c107c101000"
READ.DATA 93,"7808080808087800"
READ.DATA 94,"1028440000000000"
READ.DATA 95,"0000000000007e00"
READ.DATA 96,"2010080000000000"
READ.DATA 97,"00003c043c443a00"
READ.DATA 98,"40405c6242625c00"
READ.DATA 99,"00003c4240423c00"
READ.DATA 100,"02023a4642463a00"
READ.DATA 101,"00003c427e403c00"
READ.DATA 102,"0c10107c10101000"
READ.DATA 103,"00003a46463a023c"
READ.DATA 104,"40405c6242424200"
READ.DATA 105,"1000301010103800"
READ.DATA 106,"04000c0404044438"
READ.DATA 107,"4040444850684400"
READ.DATA 108,"3010101010103800"
READ.DATA 109,"0000ec9292929200"
READ.DATA 110,"00005c6242424200"
READ.DATA 111,"00003c4242423c00"
READ.DATA 112,"00005c62625c4040"
READ.DATA 113,"00003a46463a0202"
READ.DATA 114,"00005c6240404000"
READ.DATA 115,"00003e403c027c00"
READ.DATA 116,"10107c1010120c00"
READ.DATA 117,"0000424242463a00"
READ.DATA 118,"0000424242241800"
READ.DATA 119,"0000829292926c00"
READ.DATA 120,"0000422418244200"
READ.DATA 121,"00004242463a0238"
READ.DATA 122,"00007e0418207e00"
READ.DATA 256,"end"
READ.DATA 129,"0103070f1f3f7fff01030509112040800103050911204080"
READ.DATA 130,"00000000fefefefe00000000fe02020200000000fe020202"
READ.DATA 131,"7f3f1f0f0703010040201109050301004020110905030100"
READ.DATA 132,"fefefe00000000000202fe00000000000202fe0000000000"
READ.DATA 133,"01010101ffffffff01010101ff80808001010101ff808080"
READ.DATA 134,"0080c0e0f0f8fcfe00804020100804020080402010080402"
READ.DATA 135,"ffffff01010101008080ff01010101008080ff0101010100"
READ.DATA 136,"fcf8f0e0c080000004081020408000000408102040800000"
READ.DATA 137,"0103070f1f3f7fff01020408102040f801020408102040f8"
READ.DATA 138,"0080c0e0f0f8fcfe008040201008043e008040201008043e"
READ.DATA 139,"0f0f0f0f0f0f0f000808080808080f000808080808080f00"
READ.DATA 140,"e0e0e0e0e0e0e000202020202020e000202020202020e000"
READ.DATA 141,"0f0f0f0f0f0f0fff0f080808080808f80f080808080808f8"
READ.DATA 142,"e0e0e0e0e0e0e0fee02020202020203ee02020202020203e"
READ.DATA 143,"7f3f1f0f0703010040201008040201004020100804020100"
READ.DATA 144,"fcf8f0e0c080000004081020408000000408102040800000"
READ.DATA 145,"00000000000000000000000000000000423c5a5affff7e24"
READ.DATA 256,"end"

2018年11月 2日 (金)

第5回「PCGっぽいのを作ってみるよ」

第5回「PCGっぽいのを作ってみるよ」

前置き

自分は昔、X1ユーザーでした。X1の強みはなんと言ってもPCG、プログラマブル・キャラクター・ジェネレータです。ざっくりいうと、テキスト文字のフォントを独自のキャラクターに切り替えて扱える機能です。しかもカラー8色!PCGがあるおかげで比較的簡単に派手めなグラフィックでゲームを作れたのです。ベーマガ(マイコンBASICマガジン)でもX1の投稿プログラムはひときわ華やかな印象でした。

AndroidのBASIC!を触り始めていろいろ遊んでるうちになんか昔を思い出しましてね、テキトーにキャラクター作ってるだけで無駄に楽しかったなーとか、思いついたらすぐキャラクター作ってすぐプログラムに反映やっぱいらんわーとか、そんなやり方がラクでホントに楽しかったのですよ。いまAndroidのBASIC!で遊んでてまたそんな感じでやりたくて、でもちょっとしたキャラのためにPCでグラフィックツール立ち上げたり、あーめんどくさーってなっちゃって。Androidでもドット絵アプリぐらいありますけど、とりあえず作るゲームにフルカラー要るんかいなそれほど細かい解像度は要らんて、イヤ待て作ったデータは一個一個読み込むより一枚のビットマップにまとめてー。あー、もう、メンドイやめやめ。そんな風なのでもっと低機能でいいからラクにやりたい!って、昔のPCはよかった今の若者はケシカランオレらの時代は云々……、あーPCGが欲しいなーあったらいいなー。悔し涙ぽろり。(大げさ)

もうソレっぽいもの作ったらいいですやん。

そやなドロイドくん!ワイもプログラマーのはしくれ、欲しいものは作っちゃるでー。

共通

まずはじめにユーザー定義関数の定義があります。説明はのちほど。他のプログラムでPCGを使うとき、この定義部分をコピーして使えるといいなーと思います。別ファイルにしてINCLUDEコマンドで読み込んでもいいけど、そんな大げさなことしなくてもいいかなーとも思います。

あとはサンプルプログラムの共通部分です。


x_size=400
y_size=240
GR.OPEN 255,0,0,0
GR.ORIENTATION 0
PAUSE 1000
GR.SCREEN x,y
x_scale=x/x_size
y_scale=y/y_size
GR.SCALE x_scale,y_scale
GR.SET.ANTIALIAS 0

毎度おなじみ、グラフィック画面設定です。今回解像度が400*240!なかなかの粗さです。


GOSUB sample01

GR.RENDER
DO
UNTIL 0
END

ここのGOSUBコマンドで飛ぶラベルを書き換えて試してみてくださいね。

サンプル1

まずは普通の文字列を表示してみます。


sample01:
GR.BITMAP.CREATE pbm,128,128
READ.FROM 1
DO
 READ.NEXT c,p$
 IF p$<>"END" THEN PCG_SET(pbm,c,p$+p$+p$)
UNTIL p$="END"
bm=PCG_GET(pbm,"Hello PCG!")
GR.BITMAP.DRAW g,bm,160,120
RETURN

まずはPCG用にビットマップを作成してください。サイズは8ドット×16列で128ドットです。0から255、16進数で00からFFで全部で256個分です。ここであらかじめ作っておいたPCG用ビットマップを読み込んでもよいです。ただし、PCG_SET()関数で新たに上書きする場合は、空のビットマップを用意してロードしたビットマップを書き込んでください。ロードしたビットマップはそのままではいじれないそうです。

READ.FROMコマンドでデータ読み込み位置を初期化します。READ.NEXTコマンドでプログラムの最後にまとめて置いてあるREAD.DATAコマンドのデータを随時読み込みます。

データが"END"でなければユーザー定義関数のPCG_SET()関数でPCGをセットします。今回は色が白なのでデータを3分の1にして定義時に3つくっつけています。

ユーザー定義関数のPCG_GET()関数で文字列をビットマップに変換します。そのビットマップをグラフィック画面に書き込んでー。どうでしょうか。

ばーん!どわはは、なんか懐かしい感じですー。

サンプル2

次はキャラクターを表示してみましょう!


sample02:
GR.BITMAP.CREATE pbm,128,128
READ.FROM 425
DO
 READ.NEXT c,p$
 IF p$<>"END" THEN PCG_SET(pbm,c,p$)
UNTIL p$="END"
bm=PCG_GET(pbm,"\4AB I\nCD J")
GR.BITMAP.DRAW g,bm,20,160
bm=PCG_GET(pbm,"  \4EF\n  GH\nEF\AWX\4EF\nGH\AYZ\4GH\n")
GR.BITMAP.DRAW g,bm,160,120
bm=PCG_GET(pbm,"\4KLWX  OP  ST\nMNYZ  QR  UV")
GR.BITMAP.DRAW g,bm,300,160
bm=PCG_GET(pbm,"\6AB\nCD\nIJ  MN  QR EF\nKL  OP  ST GH")
GR.BITMAP.DRAW g,bm,40,80
bm=PCG_GET(pbm,"\8EF IJ IJ IJ  AB\nGH KL KL KL  CD")
GR.BITMAP.DRAW g,bm,100,200
bm=PCG_GET(pbm,"\6UV\nWX")
GR.BITMAP.DRAW g,bm,260,120
bm=PCG_GET(pbm,"\8 UVUV\n WXWX UV\n  UV  WX\n  WX\nMN     QR\nOP     ST")
GR.BITMAP.DRAW g,bm,220,40
bm=PCG_GET(pbm,"\AAB EFG\nCD HIJ")
GR.BITMAP.DRAW g,bm,320,100
bm=PCG_GET(pbm,"\A  KL\n  MN\n  OP\nSTQR\nUV")
GR.BITMAP.DRAW g,bm,260,182
bm=PCG_GET(pbm,"\8   YZ\n\n\6YZYZYZYZYZ")
GR.BITMAP.DRAW g,bm,8,16
RETURN

先ほどとだいたい同じです。READ.FROMコマンドで初期値をキャラクターデータの位置に調整しています。ここの数字は試してみて調べるしかなさそうです。数えてもいいけど。ラベルが使えたらいいのになー、と思います。

PCG_GET()関数ではエスケープシーケンスを使って色々なサイズで描画してます。キャラクター切り替えもできます。便利でしょ?

ばばーん!お~、いい、いい!たーのしいなー。

なんか古臭いわねぇ。

ギロリ。いいじゃん、あの頃のゲームがやけに印象に残ってるんですー。でも作ってるときメッチャ楽しかったですよ。キャラクター見ただけですぐあれって思い出せるのはやっぱスゴイですよね。

あ、ジムくん、ハイドライドスペシャルですやん。フェアリーもなんか違う……、キャッスルエクセレントのフェアリーやわ。らぷてっく懐かしいわねー。シティコネクションのネコ、腹立つわ~。

細かいところは気にしないで~。雰囲気でお願いします。X1のゲームから拝借しようと思ったけど、結構80桁モードの細長いドットなんですよね。正方形のドットはファミコンやMSXを参考にするとよさげです。でも粗いドット8色でなかなかイケてるでしょ?

サンプル3

次は文字のアレンジに挑戦します!


sample03:
GR.BITMAP.CREATE pbm,128,128
READ.FROM 1
DO
 READ.NEXT c,p$
 q$="0000"+MID$(p$,5,6)+"000000"
 IF p$<>"END" THEN PCG_SET(pbm,c,p$+q$+p$)
UNTIL p$="END"
bm=PCG_GET(pbm,"In addition became X1 like!")
GR.BITMAP.DRAW g,bm,80,120
RETURN

プログラム的にはサンプル1とほとんど同じです。PCG_SET()関数に渡すデータにちょっとアレンジしています。具体的には文字の上下の部分の色を変えています。そうすると、どうなるのか!

ばーん!わーい、さらにX1らしくなりました。ベーマガの投稿プログラムみたいですわ。こんなふうに同じデータでいろいろできると楽しいですよー。

サンプル4

最後に、ひらがなカタカナもやってみます。


sample04:
GR.BITMAP.CREATE pbm,128,128
READ.FROM 1
DO
 READ.NEXT c,p$
 IF p$<>"END" THEN PCG_SET(pbm,c,p$+p$+p$)
UNTIL p$="END"
DO
 READ.NEXT c,p$
 IF p$<>"END" THEN PCG_SET(pbm,c,p$+p$+p$)
UNTIL p$="END"
bm=PCG_GET_KANA(pbm,"ひらがなもかけるよ、カタカナモカケチャウ。")
GR.BITMAP.DRAW g,bm,120,104
bm=PCG_GET_KANA(pbm,"Alphabetが、まざっててもイケルのよ!")
GR.BITMAP.DRAW g,bm,120,120
RETURN

プログラム自体はほとんど同じです。データを作るのが大変でした!カタカナはX1のフォントです。かな描画用のPCG_GET_KANA()関数もがんばって作りましたよ。

どうでしょうか。視認性は明らかにGR.TEXT.DRAWコマンドで描画したほうがいいです。でもまぁ、雰囲気!濁点半濁点はどうしようか迷ったんですけど、濁点あるフォントを別に作るとなると結構数があるし、ポケモンみたいに上の行に濁点を置くのもあり、でも結局普通に右に濁点を置くことにしました。そのかわり濁点は半角(4ドット)です。句読点もついでに半角。横書きの文字は縦読みできないようにずれると文字が詰まっても読みにくくなりにくい、のではないかなぁ……。

データ

データはさすがに大量なので省略します。ブログ末にはあるので見てウンザリしてください。ベーマガだったらこれを打ち込むのですよ~。

ユーザー定義関数

いよいよユーザー定義関数の説明です。ユーザー定義関数とはその名の通り自由に独自の関数を作ることができます。FN.DEFコマンドからFN.ENDコマンドの間で関数を定義します。FN.RTNコマンドで戻り値を設定できます。FN.DEFコマンドのあとに関数名と引数を指定します。ユーザー定義関数の中で使った変数は関数内でだけ使われて関数の外のプログラム内の変数とは区別されます。つまり何も考えずに変数使いまくっても他に影響を与えません。(影響を与える方法もあります。)

他のプログラムで使いまわしできそうで独立したものはユーザー定義関数、そのプログラムだけで使うのはサブルーチン(GOSUB/RETURNコマンド)かなーって思っています。

PCG_GET()

文字列をビットマップにして返します。エスケープシーケンス?みたいなのもあります。

  • \n:改行。2×2の4文字分のキャラクターのときなんかに使えます。
  • \h:半角。といっても、半文字分戻します。Iや濁点などの隙間が気になるときに。半角スペースで中央合わせにも使えます。
  • \1,\2,...\F:読み込み位置指定。アスキーコードで示せない位置を指定するのに使います。\Fは-1と考えてください。
  • \\:\一文字に置き換えられます。

FN.DEF PCG_GET(bm,s$)

まず引数によりPCGのビットマップと文字列を取得します。

PCGのビットマップを指定することにより、PCGを何枚も持てます!X1では256文字分だけでしたけど、メモリの許す限り何枚でも切り替えられます。


 sx=8:sy=8:x=0
 FOR i=1 TO LEN(s$)
  IF MID$(s$,i,1)="\"
   i++
   IF MID$(s$,i,1)="n" THEN x=0:sy+=8
   IF MID$(s$,i,1)="h" THEN x-=4
  ELSE
   x+=8:IF x>sx THEN sx=x
  ENDIF 
 NEXT
 GR.BITMAP.CREATE ret_bm,sx,sy

ビットマップのサイズを先に計測して、そのサイズのビットマップをGR.BITMAP.CREATEコマンドで作成します。戻り値は作成したビットマップのポインタになります。エスケープシーケンスにより一つの文字列で様々なサイズのビットマップが作成できます。


 x=0:y=0:z=0
 GR.COLOR 255,255,255,255,2
 GR.BITMAP.DRAWINTO.START ret_bm
 FOR i=1 TO LEN(s$)
  c$=MID$(s$,i,1)
  IF c$="\" THEN
   IF MID$(s$,i+1,1)="n" THEN
    x=0:y+=8:i++
    F_N.CONTINUE
   ELSEIF MID$(s$,i+1,1)="h" THEN
    x-=4:i++
    F_N.CONTINUE
   ELSEIF IS_IN(MID$(s$,i+1,1),"0123456789ABCDEF")>0 THEN
    z=HEX(MID$(s$,i+1,1))
    i++
    F_N.CONTINUE
   ELSE
    i++
   ENDIF
  ENDIF
  s=ASCII(c$)+z*16
  IF s>=256 THEN s-=256
  sx=MOD(s,16):sy=INT(s/16)
  GR.BITMAP.CROP b,bm,sx*8,sy*8,8,8
  GR.BITMAP.DRAW g,b,x,y
  x+=8
  GR.BITMAP.DELETE b
 NEXT
 GR.BITMAP.DRAWINTO.END
 FN.RTN ret_bm
FN.END

先程作成したビットマップに文字列が指定するキャラクターをPCGのビットマップからコピーしていきます。

GR.BITMAP.DRAWINTO.STARTコマンドでビットマップ描画モードに変更します。 GR.BITMAP.DRAWINTO.ENDコマンドに至るまでの間、描画コマンドは画面に描画されずに指定したビットマップに描画されます。

一文字ずつ評価して、エスケープシーケンスでなければそのアスキーコードにより該当位置を算出してPCGのビットマップからGR.BITMAP.CROPコマンドで切り取り、貼り付けていきます。終わったらいちいちGR.BITMAP.DELETEコマンドで削除してます。一時的に使ったビットマップは随時削除しないとメモリに溜まっていく……んじゃないかなーと思って削除します。。

最後にFN.RTNコマンドで戻り値を設定しておしまいです。

PCG_SET()

PCGをセットします。一応X1のDEFCHR$()コマンドのデータをそのまま使えます。ベーマガのバックナンバーやデラックス、X1プログラム大全集とか持ってる人はどうぞ!


FN.DEF PCG_SET(bm,c,data$)

ビットマップ、キャラクターコード(アスキーコード)とPCGデータを指定します。あらかじめビットマップを128*128のサイズで作成しておいてください。


sx=MOD(c,16)*8:sy=FLOOR(c/16)*8

アスキーコードによりPCG用ビットマップの座標を得ます

 
b$="":r$="":g$=""
 FOR i=1 TO 16
  b$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i,1))),4)
  r$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i+16,1))),4)
  g$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i+32,1))),4)
 NEXT

データを三原色分に分割、2進数に変換します。内側から、MID$()関数で文字切り出し、HEX()関数で16進数を普通の数にして、BIN$()関数で2進数に変換、そしてRIGHT$()関数で右から4文字取り出します。"1"はBIN$()関数で2進数に変換したときに0で4桁欲しいので入れてます。例えば、0000のときそのままだと0になってしまいますが、10000にして右ら4文字切り出して0000を得る、ということをやっています。


GR.BITMAP.DRAWINTO.START bm
 FOR y=0 TO 7
  FOR x=0 TO 7
   IF MID$(b$,y*8+x+1,1)="1" THEN b=255 ELSE b=0
   IF MID$(r$,y*8+x+1,1)="1" THEN r=255 ELSE r=0
   IF MID$(g$,y*8+x+1,1)="1" THEN g=255 ELSE g=0
   GR.COLOR 255,r,g,b,0
   GR.POINT g,sx+x,sy+y
  NEXT
 NEXT
 GR.BITMAP.DRAWINTO.END
FN.END

さっきのデータにより実際にビットマップに着色して行きます。ビットマップ描画モードにして、データより色情報をゲット、色を指定してGR.POINTコマンドで点を打ちます。全部のドットを打ったら終わりです。

PCG_GET_KANA()

ひらがなカタカナ表示用に作ってみました。


FN.DEF PCG_GET_KANA(bm,s$)

PCG_GET()関数と同じように、ビットマップと文字列を指定します。


 sp$=""
 hira$="あいうえおかきくけこさしすせそたちつてとなにぬねの"+~
       "はひふへほまみむめもやゆよらりるれろわをん"+~
       "っぁぃぅぇぉゃゅょ"
 kata$="アイウエオカキクケコサシスセソタチツテトナニヌネノ"+~
       "ハヒフヘホマミムメモヤユヨラリルレロワヲン"+~
       "ッァィゥェォャュョ"
 daku$="がぎぐげござじずぜぞだぢづでどばびぶべぼ"+~
       "ガギグゲゴザジズゼゾダヂヅデドバビブベボ"
 daku2$="かきくけこさしすせそたちつてとはひふへほ"+~
        "カキクケコサシスセソタチツテトハヒフヘホ"
 han$="ぱぴぷぺぽパピプペポ"
 han2$="はひふへほハヒフヘホ"
 kuto$="、。"

まずsp$を初期化します。この関数で最終的にPCG_GET()関数にデータを渡します。

全角文字を変換するため必要なデータを変数に入れています。 これは単に見やすくするためです。


 FOR i=1 TO LEN(s$)
  c$=MID$(s$,i,1)
  dh$=""
  IF IS_IN(c$,daku$)>0 THEN
   c$=MID$(daku2$,IS_IN(c$,daku$),1)
   dh$=CHR$(184)+"\h"
  ELSEIF IS_IN(c$,han$)>0 THEN
   c$=MID$(han2$,IS_IN(c$,han$),1)
   dh$=CHR$(185)+"\h"
  ENDIF
  IF IS_IN(c$,hira$)>0 THEN
   sp$+=CHR$(128+IS_IN(c$,hira$))+dh$
  ELSEIF IS_IN(c$,kata$)>0 THEN
   sp$+=CHR$(192+IS_IN(c$,kata$))+dh$
  ELSEIF IS_IN(c$,kuto$)>0 THEN
   sp$+=CHR$(185+IS_IN(c$,kuto$))+"\h"
  ELSE
   sp$+=c$
  ENDIF
 NEXT 

ここから一文字ずつ変換していきます。まずは濁点から。濁点がある文字かどうか先ほどの変数を使ってIS_IN()関数で判定します。濁点がある文字だったら濁点がない文字に変換して濁点のキャラクターを追加します。(ついでに半角指定\hもしてます。)半濁点も同じようにします。

次にひらがなカタカナ句読点の判定をします。それぞれのキャラクターコードに変換して、さらに濁点半濁点をここで追加します。句読点も半角にしました。ひらがなカタカナ句読点どれも引っかからなかったらそのまま通します。


 ret_bm=PCG_GET(bm,sp$)
FN.RTN ret_bm
FN.END

最後に出来たデータをPCG_GET()関数に渡してその戻り値をまた戻り値にして終了~。

あとがき

そんなかんじで、PCGっぽいものを作ってみました。楽しそう!やってみよーって思ってもらえたら幸いです。でもやっぱりPCGのエディターも欲しいなー、なんて思いません?ふふふ、もう作ったんですよ~。それはまた次回なのです。

それでは最後にコメントなしのプログラムリストです。ダウンロードでもどうぞ~。


REM PCG test
! PCG
! PCG GET
FN.DEF PCG_GET(bm,s$)
 sx=8:sy=8:x=0
 FOR i=1 TO LEN(s$)
  IF MID$(s$,i,1)="\"
   i++
   IF MID$(s$,i,1)="n" THEN x=0:sy+=8
   IF MID$(s$,i,1)="h" THEN x-=4
  ELSE
   x+=8:IF x>sx THEN sx=x
  ENDIF 
 NEXT
 GR.BITMAP.CREATE ret_bm,sx,sy
 x=0:y=0:z=0
 GR.COLOR 255,255,255,255,2
 GR.BITMAP.DRAWINTO.START ret_bm
 FOR i=1 TO LEN(s$)
  c$=MID$(s$,i,1)
  IF c$="\" THEN
   IF MID$(s$,i+1,1)="n" THEN
    x=0:y+=8:i++
    F_N.CONTINUE
   ELSEIF MID$(s$,i+1,1)="h" THEN
    x-=4:i++
    F_N.CONTINUE
   ELSEIF IS_IN(MID$(s$,i+1,1),"0123456789ABCDEF")>0 THEN
    z=HEX(MID$(s$,i+1,1))
    i++
    F_N.CONTINUE
   ELSE
    i++
   ENDIF
  ENDIF
  s=ASCII(c$)+z*16
  IF s>=256 THEN s-=256
  sx=MOD(s,16):sy=INT(s/16)
  GR.BITMAP.CROP b,bm,sx*8,sy*8,8,8
  GR.BITMAP.DRAW g,b,x,y
  x+=8
  GR.BITMAP.DELETE b
 NEXT
 GR.BITMAP.DRAWINTO.END
 FN.RTN ret_bm
FN.END

! PCG SET
FN.DEF PCG_SET(bm,c,data$)
 sx=MOD(c,16)*8:sy=FLOOR(c/16)*8
 b$="":r$="":g$=""
 FOR i=1 TO 16
  b$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i,1))),4)
  r$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i+16,1))),4)
  g$+=RIGHT$(BIN$(HEX("1"+MID$(data$,i+32,1))),4)
 NEXT
 GR.BITMAP.DRAWINTO.START bm
 FOR y=0 TO 7
  FOR x=0 TO 7
   IF MID$(b$,y*8+x+1,1)="1" THEN b=255 ELSE b=0
   IF MID$(r$,y*8+x+1,1)="1" THEN r=255 ELSE r=0
   IF MID$(g$,y*8+x+1,1)="1" THEN g=255 ELSE g=0
   GR.COLOR 255,r,g,b,0
   GR.POINT g,sx+x,sy+y
  NEXT
 NEXT
 GR.BITMAP.DRAWINTO.END
FN.END

! PCG GET KANA
FN.DEF PCG_GET_KANA(bm,s$)
 sp$=""
 hira$="あいうえおかきくけこさしすせそたちつてとなにぬねの"+~
       "はひふへほまみむめもやゆよらりるれろわをん"+~
       "っぁぃぅぇぉゃゅょ"
 kata$="アイウエオカキクケコサシスセソタチツテトナニヌネノ"+~
       "ハヒフヘホマミムメモヤユヨラリルレロワヲン"+~
       "ッァィゥェォャュョ"
 daku$="がぎぐげござじずぜぞだぢづでどばびぶべぼ"+~
       "ガギグゲゴザジズゼゾダヂヅデドバビブベボ"
 daku2$="かきくけこさしすせそたちつてとはひふへほ"+~
        "カキクケコサシスセソタチツテトハヒフヘホ"
 han$="ぱぴぷぺぽパピプペポ"
 han2$="はひふへほハヒフヘホ"
 kuto$="、。"
 FOR i=1 TO LEN(s$)
  c$=MID$(s$,i,1)
  dh$=""
  IF IS_IN(c$,daku$)>0 THEN
   c$=MID$(daku2$,IS_IN(c$,daku$),1)
   dh$=CHR$(184)+"\h"
  ELSEIF IS_IN(c$,han$)>0 THEN
   c$=MID$(han2$,IS_IN(c$,han$),1)
   dh$=CHR$(185)+"\h"
  ENDIF
  IF IS_IN(c$,hira$)>0 THEN
   sp$+=CHR$(128+IS_IN(c$,hira$))+dh$
  ELSEIF IS_IN(c$,kata$)>0 THEN
   sp$+=CHR$(192+IS_IN(c$,kata$))+dh$
  ELSEIF IS_IN(c$,kuto$)>0 THEN
   sp$+=CHR$(185+IS_IN(c$,kuto$))+"\h"
  ELSE
   sp$+=c$
  ENDIF
 NEXT 
 ret_bm=PCG_GET(bm,sp$)
FN.RTN ret_bm
FN.END

! ここから
x_size=400
y_size=240
GR.OPEN 255,0,0,0
GR.ORIENTATION 0
PAUSE 1000
GR.SCREEN x,y
x_scale=x/x_size
y_scale=y/y_size
GR.SCALE x_scale,y_scale
GR.SET.ANTIALIAS 0

GOSUB sample01

GR.RENDER
DO
UNTIL 0
END

sample01:
GR.BITMAP.CREATE pbm,128,128
READ.FROM 1
DO
 READ.NEXT c,p$
 IF p$<>"END" THEN PCG_SET(pbm,c,p$+p$+p$)
UNTIL p$="END"
bm=PCG_GET(pbm,"Hello PCG!")
GR.BITMAP.DRAW g,bm,160,120
RETURN

sample02:
GR.BITMAP.CREATE pbm,128,128
READ.FROM 425
DO
 READ.NEXT c,p$
 IF p$<>"END" THEN PCG_SET(pbm,c,p$)
UNTIL p$="END"
bm=PCG_GET(pbm,"\4AB I\nCD J")
GR.BITMAP.DRAW g,bm,20,160
bm=PCG_GET(pbm,"  \4EF\n  GH\nEF\AWX\4EF\nGH\AYZ\4GH\n")
GR.BITMAP.DRAW g,bm,160,120
bm=PCG_GET(pbm,"\4KLWX  OP  ST\nMNYZ  QR  UV")
GR.BITMAP.DRAW g,bm,300,160
bm=PCG_GET(pbm,"\6AB\nCD\nIJ  MN  QR EF\nKL  OP  ST GH")
GR.BITMAP.DRAW g,bm,40,80
bm=PCG_GET(pbm,"\8EF IJ IJ IJ  AB\nGH KL KL KL  CD")
GR.BITMAP.DRAW g,bm,100,200
bm=PCG_GET(pbm,"\6UV\nWX")
GR.BITMAP.DRAW g,bm,260,120
bm=PCG_GET(pbm,"\8 UVUV\n WXWX UV\n  UV  WX\n  WX\nMN     QR\nOP     ST")
GR.BITMAP.DRAW g,bm,220,40
bm=PCG_GET(pbm,"\AAB EFG\nCD HIJ")
GR.BITMAP.DRAW g,bm,320,100
bm=PCG_GET(pbm,"\A  KL\n  MN\n  OP\nSTQR\nUV")
GR.BITMAP.DRAW g,bm,260,182
bm=PCG_GET(pbm,"\8   YZ\n\n\6YZYZYZYZYZ")
GR.BITMAP.DRAW g,bm,8,16
RETURN

sample03:
GR.BITMAP.CREATE pbm,128,128
READ.FROM 1
DO
 READ.NEXT c,p$
 q$="0000"+MID$(p$,5,6)+"000000"
 IF p$<>"END" THEN PCG_SET(pbm,c,p$+q$+p$)
UNTIL p$="END"
bm=PCG_GET(pbm,"In addition became X1 like!")
GR.BITMAP.DRAW g,bm,80,120
RETURN

sample04:
GR.BITMAP.CREATE pbm,128,128
READ.FROM 1
DO
 READ.NEXT c,p$
 IF p$<>"END" THEN PCG_SET(pbm,c,p$+p$+p$)
UNTIL p$="END"
DO
 READ.NEXT c,p$
 IF p$<>"END" THEN PCG_SET(pbm,c,p$+p$+p$)
UNTIL p$="END"
bm=PCG_GET_KANA(pbm,"ひらがなもかけるよ、カタカナモカケチャウ。")
GR.BITMAP.DRAW g,bm,120,104
bm=PCG_GET_KANA(pbm,"Alphabetが、まざっててもイケルのよ!")
GR.BITMAP.DRAW g,bm,120,120
RETURN

! PCGデータ
READ.DATA 32,"0000000000000000"
READ.DATA 33,"1818181818001800"
READ.DATA 34,"6c6c6c0000000000"
READ.DATA 35,"36367f367f363600"
READ.DATA 36,"183e583c1a7c1800"
READ.DATA 37,"0073760c18376700"
READ.DATA 38,"386c6c386f663f00"
READ.DATA 39,"3818300000000000"
READ.DATA 40,"0c18303030180c00"
READ.DATA 41,"30180c0c0c183000"
READ.DATA 42,"1054387c38541000"
READ.DATA 43,"0018187e18180000"
READ.DATA 44,"0000000038183000"
READ.DATA 45,"0000007e00000000"
READ.DATA 46,"0000000038380000"
READ.DATA 47,"0003060c18306000"
READ.DATA 48,"3e63636363633e00"
READ.DATA 49,"1838781818187e00"
READ.DATA 50,"3e63030e38607f00"
READ.DATA 51,"3e63033e03633e00"
READ.DATA 52,"060e1e367f060600"
READ.DATA 53,"7f607c0603663c00"
READ.DATA 54,"1e30607e63633e00"
READ.DATA 55,"7f63060c18181800"
READ.DATA 56,"3e63633e63633e00"
READ.DATA 57,"3e63633f03063c00"
READ.DATA 58,"0038380038380000"
READ.DATA 59,"0038380038183000"
READ.DATA 60,"0f1c3870381c0f00"
READ.DATA 61,"00007f007f000000"
READ.DATA 62,"781c0e070e1c7800"
READ.DATA 63,"3e63030e18001800"
READ.DATA 64,"1e336f7f6e301f00"
READ.DATA 65,"1c36637f63636300"
READ.DATA 66,"7e63637e63637e00"
READ.DATA 67,"1e33606060331e00"
READ.DATA 68,"7c36333333367c00"
READ.DATA 69,"7f60607c60607f00"
READ.DATA 70,"7f60607c60606000"
READ.DATA 71,"1e33606f63331e00"
READ.DATA 72,"6363637f63636300"
READ.DATA 73,"3c18181818183c00"
READ.DATA 74,"0f06060606663c00"
READ.DATA 75,"63666c786c666300"
READ.DATA 76,"6060606060607f00"
READ.DATA 77,"63777f6b63636300"
READ.DATA 78,"63737b6f67636300"
READ.DATA 79,"1c26636363261c00"
READ.DATA 80,"7e63637e60606000"
READ.DATA 81,"1c3663636f361b00"
READ.DATA 82,"7e63637e6c666300"
READ.DATA 83,"3e63603e03633e00"
READ.DATA 84,"7e18181818181800"
READ.DATA 85,"6363636363633e00"
READ.DATA 86,"63636336361c1c00"
READ.DATA 87,"6363636b7f774300"
READ.DATA 88,"6363361c36636300"
READ.DATA 89,"6666663c18181800"
READ.DATA 90,"7f03061c30607f00"
READ.DATA 91,"3e30303030303e00"
READ.DATA 92,"663c7e187e181800"
READ.DATA 93,"7c0c0c0c0c0c7c00"
READ.DATA 94,"183c660000000000"
READ.DATA 95,"0000000000007f00"
READ.DATA 96,"30180c0000000000"
READ.DATA 97,"00003e063e663b00"
READ.DATA 98,"60607e7363737e00"
READ.DATA 99,"00003e6360633e00"
READ.DATA 100,"03033f6763673f00"
READ.DATA 101,"00003e637f603e00"
READ.DATA 102,"0e18187e18181800"
READ.DATA 103,"00003d67673f033e"
READ.DATA 104,"60607e7363636300"
READ.DATA 105,"1800381818183c00"
READ.DATA 106,"06000e060606663c"
READ.DATA 107,"6060666c786c6600"
READ.DATA 108,"3818181818183c00"
READ.DATA 109,"0000eedbdbdbdb00"
READ.DATA 110,"00005e6363636300"
READ.DATA 111,"00003e6363633e00"
READ.DATA 112,"00005e73737e6060"
READ.DATA 113,"00003d67673f0303"
READ.DATA 114,"00005e7360606000"
READ.DATA 115,"00003f603e037e00"
READ.DATA 116,"18187e18181b0e00"
READ.DATA 117,"0000636363673d00"
READ.DATA 118,"0000636363361c00"
READ.DATA 119,"0000636b6b6b3e00"
READ.DATA 120,"000063361c366300"
READ.DATA 121,"00006363673f033e"
READ.DATA 122,"00007f061c307f00"
READ.DATA 123,"1c30306030301c00"
READ.DATA 124,"1818181818181800"
READ.DATA 125,"380c0c060c0c3800"
READ.DATA 126,"007f000000000000"
READ.DATA 127,"0000037eec6c6e00"
READ.DATA 0,"END"
! かな
READ.DATA 129,"103c101e35593200"
READ.DATA 130,"0044424141281000"
READ.DATA 131,"3c003c4202043800"
READ.DATA 132,"3c007c0818284600"
READ.DATA 133,"107a111e31513600"
READ.DATA 134,"10107a1525244800"
READ.DATA 135,"107c087e04403c00"
READ.DATA 136,"0408304030080400"
READ.DATA 137,"44445f4444440800"
READ.DATA 138,"003c000020403e00"
READ.DATA 139,"04043f0212201e00"
READ.DATA 140,"2020202022221c00"
READ.DATA 141,"047f0c140c040800"
READ.DATA 142,"12127f1216100f00"
READ.DATA 143,"3c08107e10100c00"
READ.DATA 144,"1078172024284700"
READ.DATA 145,"087e101c22021c00"
READ.DATA 146,"001e6101010e0000"
READ.DATA 147,"0e74081010080600"
READ.DATA 148,"2020261820403e00"
READ.DATA 149,"107a11224e130c00"
READ.DATA 150,"404e404048504f00"
READ.DATA 151,"04242e3559532b00"
READ.DATA 152,"1016791133551200"
READ.DATA 153,"001c2a4951220c00"
READ.DATA 154,"42425f424e524d00"
READ.DATA 155,"1472132222221c00"
READ.DATA 156,"0804080826255900"
READ.DATA 157,"0000102844030000"
READ.DATA 158,"405f445f445e5d00"
READ.DATA 159,"043f043f043e3d00"
READ.DATA 160,"3808123e53620c00"
READ.DATA 161,"107a113050311e00"
READ.DATA 162,"04242e3559512a00"
READ.DATA 163,"107c207c22221c00"
READ.DATA 164,"242e711210080800"
READ.DATA 165,"085e69495e081000"
READ.DATA 166,"08080e08384e3200"
READ.DATA 167,"1806202e31010e00"
READ.DATA 168,"2222222202041800"
READ.DATA 169,"3e04183e411d1e00"
READ.DATA 170,"1016791132521100"
READ.DATA 171,"3e04183e41011e00"
READ.DATA 172,"1016791131511600"
READ.DATA 173,"083e103b4c140f00"
READ.DATA 174,"0808101028294600"
READ.DATA 175,"0000003804040800"
READ.DATA 176,"00103c103c5a3200"
READ.DATA 177,"0000242222281000"
READ.DATA 178,"001c001c22041800"
READ.DATA 179,"001c003c08182600"
READ.DATA 180,"00103a101c321400"
READ.DATA 181,"00082c7214100800"
READ.DATA 182,"00085c6a5c081000"
READ.DATA 183,"00101c1030583400"
READ.DATA 184,"a0a0000000000000"
READ.DATA 185,"e0a0e00000000000"
READ.DATA 186,"0000000080402000"
READ.DATA 187,"00000000e0a0e000"
READ.DATA 193,"3e020a0c08081000"
READ.DATA 194,"0204081828080800"
READ.DATA 195,"083e222202040800"
READ.DATA 196,"003e080808083e00"
READ.DATA 197,"043e040c14240400"
READ.DATA 198,"103e121212122400"
READ.DATA 199,"083e083e08080800"
READ.DATA 200,"001e122202041800"
READ.DATA 201,"101e240404040800"
READ.DATA 202,"003e020202023e00"
READ.DATA 203,"143e141404081000"
READ.DATA 204,"0030023202043800"
READ.DATA 205,"003e020408142200"
READ.DATA 206,"103e121410100e00"
READ.DATA 207,"0022221202041800"
READ.DATA 208,"001e122a06041800"
READ.DATA 209,"0438083e08081000"
READ.DATA 210,"002a2a2a02040800"
READ.DATA 211,"1c003e0808081000"
READ.DATA 212,"1010101814101000"
READ.DATA 213,"08083e0808102000"
READ.DATA 214,"00001c0000003e00"
READ.DATA 215,"003e021408142000"
READ.DATA 216,"083e04081c2a0800"
READ.DATA 217,"0404040404081000"
READ.DATA 218,"0008042222222200"
READ.DATA 219,"20203e2020203e00"
READ.DATA 220,"003e020202041800"
READ.DATA 221,"0010280402020000"
READ.DATA 222,"083e08082a2a0800"
READ.DATA 223,"003e020214080400"
READ.DATA 224,"001c001c003c0200"
READ.DATA 225,"00081020223e0200"
READ.DATA 226,"0002021408142000"
READ.DATA 227,"003e103e10100e00"
READ.DATA 228,"10103e1214101000"
READ.DATA 229,"001c040404043e00"
READ.DATA 230,"003e023e02023e00"
READ.DATA 231,"1c003e0202040800"
READ.DATA 232,"1212121212040800"
READ.DATA 233,"000828282a2a2c00"
READ.DATA 234,"0020202224283000"
READ.DATA 235,"003e222222223e00"
READ.DATA 236,"003e222202040800"
READ.DATA 237,"003e023e02040800"
READ.DATA 238,"0030000202043800"
READ.DATA 239,"0000002a2a020e00"
READ.DATA 240,"00003e020c081000"
READ.DATA 241,"0000040818280800"
READ.DATA 242,"0000083e22020c00"
READ.DATA 243,"0000003e08083e00"
READ.DATA 244,"0000043e0c142400"
READ.DATA 245,"0000103e12141000"
READ.DATA 246,"0000001c04043e00"
READ.DATA 247,"00003c043c043c00"
READ.DATA 0,"END"
READ.DATA 129,"0000000000000010030f1f3cfbf57d0f0000000003050d0f"
READ.DATA 130,"0e0f060200000008cefdfa3cdfafbef00e0f0602c0a0b0f0"
READ.DATA 131,"180000010001061e070f1f3f373f0000070300013031001e"
READ.DATA 132,"1800008000806078e0f0f8fcecfc0000e0c000800c8c0078"
READ.DATA 133,"2030393f0f333f1d20300103030103012030383c0c333f1d"
READ.DATA 134,"040c9cfcfcf8f0ce040c94c0c040c0c0040c1c3cbcb8b08e"
READ.DATA 135,"0c0101030400000008010103040000000c01010304000000"
READ.DATA 136,"fcd8c08080808000e0d0c08080808000fcd8c08080808000"
READ.DATA 137,"00000000000000003c667e7e3c1818183c667e7e3c181818"
READ.DATA 138,"00000000000000001e1e1800000000001e1e180000000000"
READ.DATA 139,"000000000000000000000000030f1f1700000000030f1f17"
READ.DATA 140,"000000000000000000000000c0f0f8e800000000c0f0f8e8"
READ.DATA 141,"000000000000000017373f3f1f1f1f1e17363f3f1f1f1f1e"
READ.DATA 142,"0000000000000000e8ecfcfcfcf8f878e86cfcfcfcf8f878"
READ.DATA 143,"00000000001824240010101800182424001010183f7fe7e7"
READ.DATA 144,"0000000000000000000000000000000000000000008080c0"
READ.DATA 145,"1c000000000000001c00000000000000ff7f3f3f1f1f1f0c"
READ.DATA 146,"00000000000000000000000000000000c0c0c0e0e0c00000"
READ.DATA 147,"00003048483000180006334f4f3e3f670000304848300018"
READ.DATA 148,"00000c12120c00180060ccf2f27cfce600000c12120c0018"
READ.DATA 149,"60e0f800000000001f1f04000c7e7e3c60e0f86000000000"
READ.DATA 150,"06071f0000000000f8f82000307e7e3c06071f0600000000"
READ.DATA 151,"0a152a458a55aa5500000000000000000000000000000000"
READ.DATA 152,"a854aa55aa55aa5500000000000000000050081402040204"
READ.DATA 153,"aa1188148a41201500000000000000000000000000000000"
READ.DATA 154,"aa55aa152a44a85000000000000000000000000000000000"
READ.DATA 161,"000000000000070c000010180c00070c01212120100f1f1c"
READ.DATA 162,"0000000000001c300080406030001c300000808040f8fcf0"
READ.DATA 163,"0c070000000000000c173818000070e01c1f3f3f1f3f70e0"
READ.DATA 164,"301c000000000000301c020103060c08f0fcfefdfbf60c08"
READ.DATA 165,"00000000070e3131060c18101f3f000001020408070e1010"
READ.DATA 166,"0000000020109090000c1830d0e028280002040800000000"
READ.DATA 167,"111f10121200000020607fb6d66f200010405092d2602000"
READ.DATA 168,"901010101020000068ecee6c68d80c0600040e0c00000c06"
READ.DATA 169,"00031f27273f1f1800001c26263e1c0000031f27273f1f18"
READ.DATA 170,"00c0f8ccccfcf8380000384c4c7c380000c0f8ccccfcf838"
READ.DATA 171,"171f1f1f1f3f3f7f0000000000000000171f1f1f1f3f3f7f"
READ.DATA 172,"c8f8f8fcfcfefeff0000000000000000c8f8f8fcfcfefeff"
READ.DATA 173,"00604e5d5f4e200400101e1d1f0f1f7f00604e5d5f4e2070"
READ.DATA 174,"00003874fc78048200003874fcf8fcff000038747c380001"
READ.DATA 175,"0505090100001c3e7f3f3f2b2b0d1d3e7020000000001c3e"
READ.DATA 176,"1212120000001c3efffafadad4d8bc3e0100000000001c3e"
READ.DATA 177,"00070f1d3f3f3f3f0000060d0f06000800073f7d3f7f7f3f"
READ.DATA 178,"00f0f8f4fcfc8c74000008040c04000000f0f8f4fcfc8c74"
READ.DATA 179,"7f7f7f3fffff7f7c04000410000000687f7f1f17ffff3e7c"
READ.DATA 180,"fefffffffcfcfe3e0201000000000016fefffbfdfccc1e1e"
READ.DATA 181,"0000000f1f046440031f3f1f1f04647f0000000f1f046440"
READ.DATA 182,"00000080c0c0c602e0f8fefcf8f8fefe00000080c0c0c602"
READ.DATA 183,"00000083804020003f1f07bfbf5f28000000008380402000"
READ.DATA 184,"000000f202020000fcf8f0fafefe0400000000f202020000"
READ.DATA 185,"0402070d1f17140300000000000000000402070d1f171403"
READ.DATA 186,"1020f0d8f4f4146000000000000000001020f0d8f4f41460"
READ.DATA 193,"182d576c5f2f160f00183833201d8480183c7c73603f968f"
READ.DATA 194,"18acd7ebd7ebf4f800183c3c3c9c9800183c3f3f3ffffcf8"
READ.DATA 195,"4fffff060f0700009006000900000307cfc6c00900000000"
READ.DATA 196,"f0f0f8ccecc00000000000200000c0c0f000002c0c000000"
READ.DATA 197,"00000000060a552a040e1f1f373e7f3f00000000061e7f3f"
READ.DATA 198,"0000000060a054a840e0f0f078f8fcf80000000060f0fcf8"
READ.DATA 199,"0503430100000a051f78f81c1e1f0f070f44c40201000e07"
READ.DATA 200,"4284804080102000763c3870f0f0f000664440e090907000"
READ.DATA 201,"000002060f1f1f09000002060f1f1f0b0000000000001602"
READ.DATA 202,"000040e0e0f080f0000040e0e0f0f0f00000000000000000"
READ.DATA 203,"00010706060701003f1f001f070703072f1e071901000207"
READ.DATA 204,"80e0c440c4d08000f0e004c4c4f880800000c08000000080"
READ.DATA 205,"000000000000000000013e1c0038100300013f1f073f1f0f"
READ.DATA 206,"0000000068c4c4c480c0000068c4c4c480c0f0f8fcd4d4d6"
READ.DATA 207,"00000000000000003711040e0e4c01033f1d0a1191f37e3c"
READ.DATA 208,"c468100078fc3c18c668100078fcfcffd6fe10fcf8fc3c18"
READ.DATA 209,"01030f1f3f2b2b6b00000000122323230103000012232323"
READ.DATA 210,"0080fcf8e0fcf8f0000000000000000000807c38001c08c0"
READ.DATA 211,"6b7f083f1f3f3c18231208001e3f3fff631208001e3f3c18"
READ.DATA 212,"fcb8508889cf7e3c00002070703080c0ec88000000060000"
READ.DATA 213,"000000181800000000001c3e3e3e1c00071f3f7f7fffffff"
READ.DATA 214,"00000000000000000000000000000000c0f0f8fcfcfefefe"
READ.DATA 215,"00000000000000000000000000000000ffff7f7f3f1f0700"
READ.DATA 216,"00000000000000000000000000000000fefefcfcf8f0c000"
READ.DATA 217,"07071f2d7f3b100007071f2d7f3b10000000000000000000"
READ.DATA 218,"e0e0f8b4fedc0800e0e0f8b4fedc08000000000000000000"
READ.DATA 225,"0000142400000000123f7f6d7fdd631f10387c6c7fdd631e"
READ.DATA 226,"0010141a151211000000848a85c281f00010141a15d29110"
READ.DATA 227,"0000000000000000ff3f1f1f0f0f0301f83e1f1b0f0e0201"
READ.DATA 228,"000000000000000080f8e0c0e41800000008c0c0e4180000"
READ.DATA 229,"000000016100001c0000011e7e3f1f030000000060000000"
READ.DATA 230,"0038fffefe7d0d013fc700000080f0fc000003067c700000"
READ.DATA 231,"300c00c0c0c0808030ec701010103030300c000000000080"
READ.DATA 232,"242c38000000000003000100000000000404180000000000"
READ.DATA 233,"0000000102020300f73fc7fa1c0400000000000000000100"
READ.DATA 234,"0000008040c08000a0e0e000000000000000000040408000"
READ.DATA 235,"00000000000000010000000000001e3e0000000000000000"
READ.DATA 236,"000000000000000000000000000078fc0000000000000000"
READ.DATA 237,"12222404020201007d7dfbfb7d7d3e1e1020200000000000"
READ.DATA 238,"4080800000000000fefefffffefefc784080800000000000"
READ.DATA 239,"0402070f0f0b1a1e04020001000e1f1f04020001000a1a1e"
READ.DATA 240,"408080c8d8d8fcf04080000818180c004080000818180c00"
READ.DATA 241,"0f0001080e0700000f070303010000000f00010000000000"
READ.DATA 242,"60c00000000000008020e0e0c00000000000000000000000"
READ.DATA 243,"000001001c1c1d0100071e1f2323627e00071e1f3b3b7e7e"
READ.DATA 244,"30387070e0e0c0c200c080800000000000c8809000200042"
READ.DATA 245,"01010104040202027e7e7e7b7b3d3d3d7e7e7e7f7f3f3f3f"
READ.DATA 246,"8fbffef0002828280000000cfed6d6d60820000cfed6d6d6"
READ.DATA 247,"03474d4b45454763115952474d4d47430141404345454743"
READ.DATA 248,"406030d0a0a0e0f88898c8e0b0b0f0c0000000c0a0a0e0c0"
READ.DATA 249,"0a7c6e0e0e000000e5030101000e0e000000000000000000"
READ.DATA 250,"fcd6fed67c380000386c446cb8c0e0e03844444438000000"
READ.DATA 0,"END"

2018年10月 4日 (木)

第4回「スライドゲームできるんやに」

第4回「スライドゲームできるんやに」

前置き

先日、うちの娘(5歳)がCM見て言いました。「おとうちゃん、できるんですほしい……!」

えー、あんなの(←失礼)欲しいの?プリキュアだから欲しいだけじゃないかいな。ちなみに「できるんです!」はサンスター文具から出ているスライドパズルゲームです。

「できるんです、できるようになりたいの。」

なんでも土曜日の保育園のいちご組ではいつもの友達がいなくて、いつもプリキュアの絵本(スマイルの。古い。)見たりして過ごしているそう。そしていちご組にはできるんですがあるそうな。

でもまた無駄遣いするとおかあちゃん怒るしなー。百円ショップで木材買って作るかなー。

タブレットでやったらいいですやん。

悪魔の声が……!(ドロイドやよ。)

そうか!プログラミング教則本には定番でよくあるし、いまのスキルで……、できそう!作ってみよー!

初期設定

最初にゲームの準備をします。


! 初期値
fn$=""
s_split=3

! 初期設定
DIM gl[25]
DIM data[6,5]
x_size=800
y_size=480
GR.OPEN 255,127,0,127,0
GR.ORIENTATION 0
PAUSE 1000
GR.SCREEN x,y
x_scale=x/x_size
y_scale=y/y_size
GR.SCALE x_scale,y_scale

bm_game=-1
GOSUB imgload

ゲームの初期値をプログラムの先頭にまとめてあります。変数fn$にファイル名を指定するとデフォルトでそのファイルが読み込まれるようになります。変数s_splitは分割数です。初期値は3×3です。

まずプログラム内で使う配列を宣言します。(配列は第2回で取り上げました。見なくてもなんとなくわかりそう。)最大5×5の25ピースで考えているので、表示リスト用配列25ピース分と、配置データ6列×5行分です。空白のために右下角を一つずらすのでプラス1列です。

次は画面設定です。背景色それっぽい色で横向きにしてます。縦のほうが本物っぽいですが、BASIC!さん縦画面だと安定しないみたい……。そしてスケーリング。もうおなじみですね。(詳しくは第1回で。)


bm_game=-1
GOSUB imgload

ここで画像を読み込みます。画像変更の時にも使うのでサブルーチンにしました。bm_gameにはゲーム用のビットマップが入るのですが、初回でまだ何もない印で-1を設定します。


! ゲーム初期設定
init:
score_step=0
score_time=0
n=1
FOR y=1 TO 5
 FOR x=1 TO 6
  IF x>s_split | y>s_split THEN
   data[x,y]=-1
  ELSE
   data[x,y]=n:n++
  ENDIF
 NEXT
NEXT
bx=s_split+1:by=s_split:data[bx,by]=0

ゲームの準備をします。ゲームを再スタートするときまたここに戻ってくるのでラベルinit:を定義します。

スコアとして何回スライドさせたか(ステップ数)とかかった時間を出しますので、それを初期化します。

次に配置データを初期化します。分割数により必要ない場所には-1を入れて、必要な場所には連番で数字を入れます。最後に空白の座標を(bx,by)に設定、そこの配置データに空白を表す0を入れます。

画面構成

ゲーム画面を作ります。


! 画面構成
GR.CLS
! 画像を分割
ps=480/s_split
FOR y=0 TO s_split-1
 FOR x=0 TO s_split-1
  GR.BITMAP.CROP g,bm_game,ps*x,ps*y,ps,ps
  GR.BITMAP.DRAW gl[y*s_split+x+1],g,ps*x+160,ps*y
 NEXT
NEXT
GR.BITMAP.DRAW gl,bm_sample,0,320
GR.COLOR 255,255,255,255
GR.TEXT.SIZE 16
GR.TEXT.ALIGN 1
GR.TEXT.DRAW gl,0,32,"▽できるんやに ver.1"
GR.TEXT.DRAW gl,0,64,USING$("","サイズ : %d x %<d",FLOOR(s_split))
GR.TEXT.DRAW gl_step,0,96,USING$("","ステップ : %d",FLOOR(score_step))
GR.TEXT.DRAW gl_time,0,128,USING$("","タイム : %d",FLOOR(score_time))
GR.COLOR 127,255,255,255
GR.TEXT.DRAW gl_setting,0,192,"setting(long press)"
GR.COLOR 255,255,0,0
GR.TEXT.SIZE 128
GR.TEXT.ALIGN 2
GR.TEXT.DRAW gl_msg,400,280,"message"
GR.HIDE gl_msg
GR.RENDER
PAUSE 1000

まず、画面をクリアします。GR.CLSコマンドは表示リストをクリアしてくれます。再プレイの時や設定を変更したとき、もうエイヤッと全部書き直します。書き直す必要のない所もあるんですけど、まぁ面倒なので全部書き直します。

次に画像を1ピース毎に分割して配置します。bm_gameにはサブルーチンimgload:で用意されたゲーム用ビットマップのポインタが入っています。それをGR.BITMAP.CROPコマンドで分割して、GR.BITMAP.DRAWコマンドで表示リストに登録します。このときの表示リストをゲーム中にピースを動かすために配列gl[]に保存します。

次にサンプル画像を画面左下に配置します。このbm_sampleもサブルーチンimgload:でセットされています。

テキストでタイトル、スコア類、設定メニュー用の文字列を表示、さらに画面の真ん中に大きくメッセージを表示するようにテキストを設定、これは実際に表示するときまでGR.HIDEコマンドで隠します。

一旦表示して、ちょっと待機。これがないといきなりシャッフルしはじめて違和感あるので一秒待ちます。

シャッフル


! シャッフル
POPUP "まぜまぜするよ!",,240
GR.MODIFY gl[data[s_split,s_split]],"x",ps*(bx-1)+160,"y",ps*(by-1)
SWAP data[bx,by],data[s_split,s_split]
bx=s_split:by=s_split
i=RANDOMIZE()
FOR i=1 TO POW(s_split,3)
 DO
  x=FLOOR(s_split*RND()+1)
  y=FLOOR(s_split*RND()+1)
 UNTIL MOD(x+y+bx+by,2)=1
 GR.MODIFY gl[data[x,y]],"x",ps*(bx-1)+160,"y",ps*(by-1)
 SWAP data[x,y],data[bx,by]
 bx=x:by=y
 GR.RENDER
 PAUSE (16-s_split*3)*10
NEXT
GR.MODIFY gl_msg,"text","スタート"
GOSUB kirakira
start_time=TIME()
draged=0
GR.GET.VALUE gl_setting,"paint",p_setting
c_setting=0

シャッフルします。POPUPコマンドで宣言してからシャッフルします。このPOPUPコマンド、便利ですねー。ちょいちょいコメント入れるのに気軽に入れられますね。

まず右下のピースを空白に移動します。GR.MODIFYコマンドで右下のピースの画像を空白の座標に変更、そして配置データもSWAPコマンドで入れ替えます。空白の座標も更新します。

そして実際にシャッフルします。(実際のシャッフルについては次項で解説します。)とりあえず分割数の3乗の数シャッフルします。まぁ、だいたいです。画面更新の待ち時間を分割数によって調整してます。5の3乗分はさすがに長い!まぁこれもだいたいです。

シャッフルが終わったらメッセージを表示、ちょっと派手にキラキラさせます(サブルーチンkiraira:)。

で、あとはメインループのための変数設定です。スコアのタイム用に始まった時間を変数start_timeに保存、ドラッグ検知用の変数draged初期化、設定メニューボタン用にペイント取得と長押し用にカウンタc_setting初期化です。

スライドゲームにおけるシャッフルについて

スライドゲームではシャッフルの仕方によっては解くことができない配置になる場合があります。

はじめ、全部ランダムで入れ替えてプログラムしてみたんですけど、どうがんばっても解けないときがありました。ググってみたら結構有名な話みたいで、1つの隣接するペアが入れ替わった配置では解くことができなくなるそうです。

それじゃ、他のプログラマはどうやってるのかな?と思って、パクろうと参考にしようといろいろググってみたけど見つかりませんでした。どこぞのサイトではパズルを解くのと逆にランダムで空白を動かしてバラバラにするとか。うーむ。……しかたない、自分で考えるか。まず、「1つの隣接するペアが入れ替わった配置」がだめなら「一個飛ばした場所と入れ替えた配置」は……?

……試してみたら解けました!そういえばググってるうちに「50%の確率で解けない配置になる」って見た気がするぞ。さらにペアを入れ替えるんじゃなくて空白と入れ替えると考えたら……。

上図の場合、空白と8番の入れ替えは当然OK。7番はNG。当然6番もOK。3番は……、試してみたらやっぱりダメでした。ということは、隣はOK、その隣はNG。空白が9番のとき、1,3,5,7はNG。……!空白が奇数の番号のときは偶数の番号と交換、空白が偶数のときは奇数の番号と交換でいいんじゃないかな!

っと、ここで新たな問題が!これでは4×4のときうまくいきません。空白が16番のとき真上が12番で同じ偶数になってしまうから。ならば座標で考えます。[4,4]が空白のとき、交換可能なのは[4,3]や[3,4]……。ピコーン!座標値で比べたら!?縦も横もいっしょくたにして、比べてみたらどうだろう。

お、よさげ!で、試した結果がプログラムです。


UNTIL MOD(x+y+bx+by,2)=1

座標値を全部足して2で割って割り切れなければ進んでよし。いろいろ考えてこうなりました。悩んだ割に単純になったなー。でもまぁ、これで解けない配置にならないと思います!何度も試したけど、大丈夫でした!

メインループ

ここからメインループです。まずはタッチされたとき!


! メインループ
loop:
GR.TOUCH touched,x,y
IF touched THEN
 x=INT(x/x_scale):y=INT(y/y_scale)
 IF x<160 & y>192-16 & y<192 THEN
  GR.COLOR 255,c_setting,0,0,,p_setting
  c_setting+=8
  IF c_setting>255 THEN GOTO setting
 ELSE
  GR.COLOR 127,255,255,255,,p_setting
  c_setting=0
 ENDIF

まずはGR.TOUCHコマンドで、画面タッチを検出します。(タッチについては第3回参照。)タッチされていたら画面のスケール係数で割って、実際のタッチ座標からスケーリングした座標に変換します。

まずはテキスト[setting(long press)]の部分がタッチされていたら、長押し用のカウンタをプラスします。このカウンタを使ってペイントで文字色も操作します。タッチし続けると色がだんだん濃くなります。そしてカウンタが一定量になったら設定が選択されたとしてsetting:にジャンプします。タッチが外れたらカウンタを戻します。(タッチしてない時も同様に。)こうして簡単に設定メニューが開かないようにしました。子供に設定変更されないようにです。おとうちゃんがやったるでな。おとうちゃんすげーやろって言いたい。


 IF !draged THEN % タッチ
  IF x>640 & x<640+ps & y>480-ps THEN tx=s_split+1:ty=s_split
  IF x>160 & x<640 THEN tx=INT((x-160)/ps)+1:ty=INT(y/ps)+1
  draged=touched
  x2=x:y2=y:mx=0:my=0

タッチされたときでドラッグでないとき(タッチのしはじめ)、ピースがあるところだったらそのピースの座標を(tx,ty)にセットします。そしてドラッグ検知用の変数dragedをTRUEにします。ドラッグする方向を検知するための準備もします。


 ELSE % ドラッグ中
  IF tx=bx & ty>by THEN % 上
   IF y<>y2 THEN
    my=y-y2
    IF my>0 THEN my=0
    IF my<-ps THEN my=-ps
    FOR i=ty TO by+1 STEP -1
     GR.MODIFY gl[data[tx,i]],"y",(i-1)*ps+my
    NEXT
   ENDIF
  ENDIF
  IF tx=bx & ty<by THEN % 下
   IF y<>y2 THEN
    my=y-y2
    IF my<0 THEN my=0
    IF my>ps THEN my=ps
    FOR i=ty TO by-1 STEP 1
     GR.MODIFY gl[data[tx,i]],"y",(i-1)*ps+my
    NEXT
   ENDIF
  ENDIF
  IF ty=by & tx>bx THEN % 左
   IF x<>x2 THEN
    mx=x-x2
    IF mx>0 THEN mx=0
    IF mx<-ps THEN mx=-ps
    FOR i=tx TO bx+1 STEP -1
     GR.MODIFY gl[data[i,ty]],"x",(i-1)*ps+160+mx
    NEXT
   ENDIF
  ENDIF
  IF ty=by & tx<bx THEN % 右
   IF x<>x2 THEN
    mx=x-x2
    IF mx<0 THEN mx=0
    IF mx>ps THEN mx=ps
    FOR i=tx TO bx-1 STEP 1
     GR.MODIFY gl[data[i,ty]],"x",(i-1)*ps+160+mx
    NEXT
   ENDIF
  ENDIF
 ENDIF

上下左右それぞれに分岐します。空白の位置によって動かせる方向が違うためです。単純に一個だけ動かすならもうちょっと簡単なんですけど、2つ3つ同時に動かせるようにしました。動かした回数をスコアと考えると少しでも少ないステップ数で!って考えちゃうので。

動かした距離をmxもしくはmyに入れて動かしすぎないように調整、そしてタッチしたピースから空白までFOR/NEXTで全部動かします。ピース一個だけでもFOR/NEXTで一回きりのループ(?)です。


ELSE
 IF draged THEN % タッチ離れたとき
  IF my<-ps/2 THEN % 上
   FOR i=by TO ty-1 STEP 1
    SWAP data[bx,i],data[bx,i+1]
   NEXT
   by=ty
   score_step++
  ENDIF
  IF my>ps/2 THEN % 下
   FOR i=by TO ty+1 STEP-1
    SWAP data[bx,i],data[bx,i-1]
   NEXT
   by=ty
   score_step++
  ENDIF
  IF mx<-ps/2 THEN % 左
   FOR i=bx TO tx-1 STEP 1
    SWAP data[i,by],data[i+1,by]
   NEXT
   bx=tx
   score_step++
  ENDIF
  IF mx>ps/2 THEN % 右
   FOR i=bx TO tx+1 STEP-1
    SWAP data[i,by],data[i-1,by]
   NEXT
   bx=tx
   score_step++
  ENDIF
  FOR y=1 TO s_split
   FOR x=1 TO s_split+1
    IF data[x,y]>0 THEN
     GR.MODIFY gl[data[x,y]],"x",(x-1)*ps+160
     GR.MODIFY gl[data[x,y]],"y",(y-1)*ps
    ENDIF
   NEXT
  NEXT
  draged=0
  tx=0:ty=0
 ENDIF
 GR.COLOR 127,255,255,255,,p_setting
 c_setting=0
ENDIF

ドラッグされた状態からタッチされてないとき、つまりタッチが離れたときです。ここでも方向によって分岐します。

ピースの半分以上動いた状態で離れたら移動させます。半分以下なら元の状態です。さっきと同じように空白からタッチされたピースまで全部処理します。スコアのステップ数も動かすときはプラス1しますよ。


GR.MODIFY gl_step,"text",USING$("","ステップ : %d",FLOOR(score_step))
score_time=(TIME()-start_time)/1000
GR.MODIFY gl_time,"text",USING$("","タイム : %d",FLOOR(score_time))
GR.RENDER
PAUSE 33
ret=0
FOR y=1 TO s_split
 FOR x=1 TO s_split
  IF data[x,y]=(y-1)*s_split+x THEN ret++
 NEXT
NEXT
IF ret<>s_split*s_split THEN GOTO loop

スコア表示をします。さりげなく画面構成のときに表示リストのオブジェクト番号を保存していたのでした。USING$コマンドは数字や文字列をうまいこと調整して文字列にしてくれます。

最後にクリアできているかチェックします。配置が順番通りに並んでいなければラベルloop:にジャンプします。クリアできてたらそのまま次へ進みます。

クリアしたときの処理


! 完成
GR.MODIFY gl_msg,"text","できあがり"
GOSUB kirakira
POPUP "がめんタッチでもういっかいできるよ!",,240
DO
 GR.TOUCH touched,x,y
UNTIL touched
GOSUB fadeout
GOTO init

画面中央に大きくキラキラしたメッセージでお祝いです!ポップアップだけじゃ寂しいですよね。

ゲーム再スタートのメッセージをポップアップして、タッチ待ちです。タッチするまで完成した絵を見て喜んでほしいです。タッチすると画面フェードアウト(サブルーチンfadeout:)して初期化init:に戻ります。

サブルーチン

ここからサブルーチンです。何回も使うような処理はサブルーチン化しましょう。プログラムがわかりやすくなるように処理を分けるのもアリです。

キラキラメッセージ

メッセージをキラキラさせるサブルーチンです。


! キラキラメッセージ
kirakira:
GR.SHOW gl_msg
GR.GET.VALUE gl_msg,"paint",p
FOR i=1 TO 32
 GR.COLOR 255,FLOOR(RND()*255),FLOOR(RND()*255),FLOOR(RND()*255),,p
 GR.RENDER
 PAUSE 33
NEXT
GR.HIDE gl_msg
GR.RENDER
RETURN

GR.SHOWコマンドにメッセージの表示リストのポインタを指定して、メッセージの表示を有効にします。そして変数pにメッセージのペイントを取得します。そのペイントにGR.COLORコマンドでランダムな色を指定します。テキトーな回数繰り返して、またGR.HIDEコマンドで隠して終わりです

画像の読み込み

ゲーム用の画像を用意します。ファイルが指定されていたら画像ファイルを読み込みます。指定されていない場合は数字のパネルを用意します。


! 画像をロードします
imgload:
IF bm_game<>-1 THEN
 GR.BITMAP.DELETE bm_game
 GR.BITMAP.DELETE bm_sample
ENDIF
IF fn$="" THEN
 GR.BITMAP.CREATE bm_game,480,480
 GR.BITMAP.DRAWINTO.START bm_game
 ps=480/s_split
 FOR y=0 TO s_split
  FOR x=0 TO s_split
   GR.COLOR 255,FLOOR(RND()*255),FLOOR(RND()*255),FLOOR(RND()*255),2
   GR.RECT gl,x*ps,y*ps,x*ps+ps,y*ps+ps
   GR.COLOR 255,255,255,255,0
   GR.RECT gl,x*ps,y*ps,x*ps+ps,y*ps+ps
  NEXT
 NEXT
 GR.COLOR 255,255,255,255,2
 GR.TEXT.SIZE 32
 GR.TEXT.ALIGN 2
 FOR y=0 TO s_split
  FOR x=0 TO s_split
   GR.TEXT.DRAW gl,x*ps+ps/2,y*ps+ps/2+16,USING$("","%d",FLOOR(y*s_split+x+1))
  NEXT
 NEXT
 GR.BITMAP.DRAWINTO.END

初回でない場合、変数bm_gameにゲーム用画像が入っている(-1でない)ので削除します。見本のbm_sampleも一緒に削除です。

変数fn$が空の場合、画像を読み込まずに数字の入ったパネルを用意します。GR.BITMAP.CREATEコマンドで空のビットマップを作成してGR.BITMAP.DRAWINTO.STARTコマンドでビットマップ描画モードにします。このモードでは描画コマンドを実行すると画面に書き込む代わりにビットマップに書き込まれます。分割数によるサイズの矩形をランダムな色で描いて、その後白で数字を書き込んでいます。できたらGR.BITMAP.DRAWINTO.ENDコマンドでビットマップ描画モードを抜けます。


ELSE
 GR.BITMAP.LOAD bm_source,fn$
 GR.BITMAP.SIZE bm_source,x,y
 IF x=y THEN
  bm_croped=bm_source
 ELSE
  IF x<y THEN
   GR.BITMAP.CROP bm_croped,bm_source,0,(y-x)/2,x,x
  ELSE
   GR.BITMAP.CROP bm_croped,bm_source,(x-y)/2,0,y,y
  ENDIF
  GR.BITMAP.DELETE bm_source
 ENDIF
 GR.BITMAP.SCALE bm_game,bm_croped,480,480
 GR.BITMAP.DELETE bm_croped
ENDIF
GR.BITMAP.SCALE bm_sample,bm_game,160,160
RETURN

GR.BITMAP.LOADコマンドで画像を読み込んでそのサイズを取得します。そのサイズの小さい方で真四角のサイズにカットします。カットする位置は真ん中です。縦も横も同じならばカットしません。真四角になったらサイズを480x480に拡大縮小します。さらに見本用に160x160にも縮小します。

フェードアウト

いきなりパッと消えるのもなんなので、フェードアウトさせてみました。簡単だし。


! フェードアウト
fadeout:
GR.COLOR 0,0,0,0,2
GR.RECT gl,0,0,x_size,y_size
GR.GET.VALUE gl,"paint",p
FOR i=0 TO 255 STEP 16
 GR.COLOR i,0,0,0,,p
 GR.RENDER
 PAUSE 33
NEXT
RETURN

画面サイズの真っ黒な矩形で画面を覆います。でもまだ透過度0で透明です。で、その透過度をほどよく操作して真っ暗になっていきます。

設定メニュー

ホントはサブルーチンではありません。GOTOコマンドでジャンプしてきてGOTOコマンドで帰ります。


! 設定画面
setting:
ARRAY.DELETE menu$[]
ARRAY.LOAD menu$[],"分割数を変更する","画像を変更する"
DIALOG.SELECT s,menu$[],"設定メニュー"
IF s=1 THEN
 ARRAY.DELETE menu$[]
 ARRAY.LOAD menu$[],"3x3","4x4","5x5"
 DIALOG.SELECT s,menu$[],"分割数"
 IF s>0 THEN
  s_split=s+2
  GOSUB fadeout
  IF fn$="" THEN GOSUB imgload
  GOTO init
 ENDIF
ELSEIF s=2 THEN
 path$=""
 ARRAY.DELETE d1$[]
 FILE.DIR path$,d1$[]
 SELECT s,d1$[]
 IF s>0 THEN
  fn$=d1$[s]
  GOSUB fadeout
  GOSUB imgload
  GOTO init
 ENDIF
ENDIF
GOTO loop

メニューダイアログを作ります。配列にメニュー項目を入れてDIAROG.SELECTコマンドを呼ぶだけ。簡単!サブメニューも自由自在です。この場合、変数sで選択された項目を取得できるので、それで分岐するだけ~。画像を変更するのほうのメニューはSELECTコマンドを使ってみました。

ファイルの選択はFILE.DIRコマンドにパスを渡すとパスの内容が取得できます。それをそのままSELECTコマンドに渡してます。面倒なのでディレクトリの移動とかしない仕様なのでやってみてもいいかもです。ファイルが画像かどうかもチェックしてません。気になる人はちゃんとやろう。

ゲームプレイ!

さぁ、それではやってみましょう!

どうでしょうか。なんとなく感覚で操作もわかるでしょ?ピースを空白がある方にドラッグすると動かせます。設定メニューは[setting(long press)]を長押しです。こどもがうかつに押さないように英語表記で長押ししないと選択できないようにしました。

できるんやにってタイトルはどうなの?なんで三重弁?

できるんです!に対してリスペクトです!少しでもあやかりたい気持ちなんですよ。とはいえ、できるんです!は素晴らしい製品で、到底及びません。しかも安いし。こどもにタブレット占拠されるよりも買ったほうがいいです。

デフォルトでは地味なパネルですが、設定メニューから画像にも変えられます。プログラム先頭の変数fn$に画像ファイルを指定するのがいいと思います。写真でもいけるよ。画像ファイルはあらかじめ[/rfo-basic/data]に置いておいてください。

お、これは……。

キュアミラクル!!か、かわいい!うあ~、ミラクル~。

きゃわわ!たまらん~。

ちなみにうちの子はエールちゃんでやってます。

あとがき

そんなわけで、スライドゲーム完成しました!簡単そうだと思ってたら、意外と手間でした。タッチ操作って、昔のBASIC世代には新鮮で、思いのほか考えることが多いです。キーボードやゲームパッドでの操作とは全く別!マウスとも違うしなー。でもこういうタッチ操作にあったゲームはいいですね。こういう端末にあった操作を考えていきたいものです。

それでは最後にコメントなしのプログラムリストです。ダウンロードでもどうぞ~。


REM できるんやに
! 初期値
fn$=""
s_split=3

! 初期設定
DIM gl[25]
DIM data[6,5]
x_size=800
y_size=480
GR.OPEN 255,127,0,127,0
GR.ORIENTATION 0
PAUSE 1000
GR.SCREEN x,y
x_scale=x/x_size
y_scale=y/y_size
GR.SCALE x_scale,y_scale

bm_game=-1
GOSUB imgload

! ゲーム初期設定
init:
score_step=0
score_time=0
n=1
FOR y=1 TO 5
 FOR x=1 TO 6
  IF x>s_split | y>s_split THEN
   data[x,y]=-1
  ELSE
   data[x,y]=n:n++
  ENDIF
 NEXT
NEXT
bx=s_split+1:by=s_split:data[bx,by]=0

! 画面構成
GR.CLS
! 画像を分割
ps=480/s_split
FOR y=0 TO s_split-1
 FOR x=0 TO s_split-1
  GR.BITMAP.CROP g,bm_game,ps*x,ps*y,ps,ps
  GR.BITMAP.DRAW gl[y*s_split+x+1],g,ps*x+160,ps*y
 NEXT
NEXT
GR.BITMAP.DRAW gl,bm_sample,0,320
GR.COLOR 255,255,255,255,2
GR.TEXT.SIZE 16
GR.TEXT.ALIGN 1
GR.TEXT.DRAW gl,0,32,"▽できるんやに ver.1"
GR.TEXT.DRAW gl,0,64,USING$("","サイズ : %d x %<d",FLOOR(s_split))
GR.TEXT.DRAW gl_step,0,96,USING$("","ステップ : %d",FLOOR(score_step))
GR.TEXT.DRAW gl_time,0,128,USING$("","タイム : %d",FLOOR(score_time))
GR.COLOR 127,255,255,255
GR.TEXT.DRAW gl_setting,0,192,"setting(long press)"
GR.COLOR 255,255,0,0
GR.TEXT.SIZE 128
GR.TEXT.ALIGN 2
GR.TEXT.DRAW gl_msg,400,280,"message"
GR.HIDE gl_msg
GR.RENDER
PAUSE 1000

! シャッフル
POPUP "まぜまぜするよ!",,240
GR.MODIFY gl[data[s_split,s_split]],"x",ps*(bx-1)+160,"y",ps*(by-1)
SWAP data[bx,by],data[s_split,s_split]
bx=s_split:by=s_split
i=RANDOMIZE()
FOR i=1 TO POW(s_split,3)
 DO
  x=FLOOR(s_split*RND()+1)
  y=FLOOR(s_split*RND()+1)
 UNTIL MOD(x+y+bx+by,2)=1
 GR.MODIFY gl[data[x,y]],"x",ps*(bx-1)+160,"y",ps*(by-1)
 SWAP data[x,y],data[bx,by]
 bx=x:by=y
 GR.RENDER
 PAUSE (16-s_split*3)*10
NEXT
GR.MODIFY gl_msg,"text","スタート"
GOSUB kirakira
start_time=TIME()
draged=0
GR.GET.VALUE gl_setting,"paint",p_setting
c_setting=0

! メインループ
loop:
GR.TOUCH touched,x,y
IF touched THEN
 x=INT(x/x_scale):y=INT(y/y_scale)
 IF x<160 & y>192-16 & y<192 THEN
  GR.COLOR 255,c_setting,0,0,,p_setting
  c_setting+=8
  IF c_setting>255 THEN GOTO setting
 ELSE
  GR.COLOR 127,255,255,255,,p_setting
  c_setting=0
 ENDIF
 IF !draged THEN % タッチ
  IF x>640 & x<640+ps & y>480-ps THEN tx=s_split+1:ty=s_split
  IF x>160 & x<640 THEN tx=INT((x-160)/ps)+1:ty=INT(y/ps)+1
  draged=touched
  x2=x:y2=y:mx=0:my=0
 ELSE % ドラッグ中
  IF tx=bx & ty>by THEN % 上
   IF y<>y2 THEN
    my=y-y2
    IF my>0 THEN my=0
    IF my<-ps THEN my=-ps
    FOR i=ty TO by+1 STEP -1
     GR.MODIFY gl[data[tx,i]],"y",(i-1)*ps+my
    NEXT
   ENDIF
  ENDIF
  IF tx=bx & ty<by THEN % 下
   IF y<>y2 THEN
    my=y-y2
    IF my<0 THEN my=0
    IF my>ps THEN my=ps
    FOR i=ty TO by-1 STEP 1
     GR.MODIFY gl[data[tx,i]],"y",(i-1)*ps+my
    NEXT
   ENDIF
  ENDIF
  IF ty=by & tx>bx THEN % 左
   IF x<>x2 THEN
    mx=x-x2
    IF mx>0 THEN mx=0
    IF mx<-ps THEN mx=-ps
    FOR i=tx TO bx+1 STEP -1
     GR.MODIFY gl[data[i,ty]],"x",(i-1)*ps+160+mx
    NEXT
   ENDIF
  ENDIF
  IF ty=by & tx<bx THEN % 右
   IF x<>x2 THEN
    mx=x-x2
    IF mx<0 THEN mx=0
    IF mx>ps THEN mx=ps
    FOR i=tx TO bx-1 STEP 1
     GR.MODIFY gl[data[i,ty]],"x",(i-1)*ps+160+mx
    NEXT
   ENDIF
  ENDIF
 ENDIF
ELSE
 IF draged THEN % タッチ離れたとき
  IF my<-ps/2 THEN % 上
   FOR i=by TO ty-1 STEP 1
    SWAP data[bx,i],data[bx,i+1]
   NEXT
   by=ty
   score_step++
  ENDIF
  IF my>ps/2 THEN % 下
   FOR i=by TO ty+1 STEP-1
    SWAP data[bx,i],data[bx,i-1]
   NEXT
   by=ty
   score_step++
  ENDIF
  IF mx<-ps/2 THEN % 左
   FOR i=bx TO tx-1 STEP 1
    SWAP data[i,by],data[i+1,by]
   NEXT
   bx=tx
   score_step++
  ENDIF
  IF mx>ps/2 THEN % 右
   FOR i=bx TO tx+1 STEP-1
    SWAP data[i,by],data[i-1,by]
   NEXT
   bx=tx
   score_step++
  ENDIF
  FOR y=1 TO s_split
   FOR x=1 TO s_split+1
    IF data[x,y]>0 THEN
     GR.MODIFY gl[data[x,y]],"x",(x-1)*ps+160
     GR.MODIFY gl[data[x,y]],"y",(y-1)*ps
    ENDIF
   NEXT
  NEXT
  draged=0
  tx=0:ty=0
 ENDIF
 GR.COLOR 127,255,255,255,,p_setting
 c_setting=0
ENDIF
GR.MODIFY gl_step,"text",USING$("","ステップ : %d",FLOOR(score_step))
score_time=(TIME()-start_time)/1000
GR.MODIFY gl_time,"text",USING$("","タイム : %d",FLOOR(score_time))
GR.RENDER
PAUSE 33
ret=0
FOR y=1 TO s_split
 FOR x=1 TO s_split
  IF data[x,y]=(y-1)*s_split+x THEN ret++
 NEXT
NEXT
IF ret<>s_split*s_split THEN GOTO loop
! 完成
GR.MODIFY gl_msg,"text","できあがり"
GOSUB kirakira
POPUP "がめんタッチでもういっかいできるよ!",,240
DO
 GR.TOUCH touched,x,y
UNTIL touched
GOSUB fadeout
GOTO init

! キラキラメッセージ
kirakira:
GR.SHOW gl_msg
GR.GET.VALUE gl_msg,"paint",p
FOR i=1 TO 32
 GR.COLOR 255,FLOOR(RND()*255),FLOOR(RND()*255),FLOOR(RND()*255),2,p
 GR.RENDER
 PAUSE 33
NEXT
GR.HIDE gl_msg
GR.RENDER
RETURN

! 画像をロードします
imgload:
IF bm_game<>-1 THEN
 GR.BITMAP.DELETE bm_game
 GR.BITMAP.DELETE bm_sample
ENDIF
IF fn$="" THEN
 GR.BITMAP.CREATE bm_game,480,480
 GR.BITMAP.DRAWINTO.START bm_game
 ps=480/s_split
 FOR y=0 TO s_split
  FOR x=0 TO s_split
   GR.COLOR 255,FLOOR(RND()*255),FLOOR(RND()*255),FLOOR(RND()*255),2
   GR.RECT gl,x*ps,y*ps,x*ps+ps,y*ps+ps
   GR.COLOR 255,255,255,255,0
   GR.RECT gl,x*ps,y*ps,x*ps+ps,y*ps+ps
  NEXT
 NEXT
 GR.COLOR 255,255,255,255,2
 GR.TEXT.SIZE 32
 GR.TEXT.ALIGN 2
 FOR y=0 TO s_split
  FOR x=0 TO s_split
   GR.TEXT.DRAW gl,x*ps+ps/2,y*ps+ps/2+16,USING$("","%d",FLOOR(y*s_split+x+1))
  NEXT
 NEXT
 GR.BITMAP.DRAWINTO.END
ELSE
 GR.BITMAP.LOAD bm_source,fn$
 GR.BITMAP.SIZE bm_source,x,y
 IF x=y THEN
  bm_croped=bm_source
 ELSE
  IF x<y THEN
   GR.BITMAP.CROP bm_croped,bm_source,0,(y-x)/2,x,x
  ELSE
   GR.BITMAP.CROP bm_croped,bm_source,(x-y)/2,0,y,y
  ENDIF
  GR.BITMAP.DELETE bm_source
 ENDIF
 GR.BITMAP.SCALE bm_game,bm_croped,480,480
 GR.BITMAP.DELETE bm_croped
ENDIF
GR.BITMAP.SCALE bm_sample,bm_game,160,160
RETURN

! フェードアウト
fadeout:
GR.COLOR 0,0,0,0,2
GR.RECT gl,0,0,x_size,y_size
GR.GET.VALUE gl,"paint",p
FOR i=0 TO 255 STEP 16
 GR.COLOR i,0,0,0,,p
 GR.RENDER
 PAUSE 33
NEXT
RETURN

! 設定画面
setting:
ARRAY.DELETE menu$[]
ARRAY.LOAD menu$[],"分割数を変更する","画像を変更する"
DIALOG.SELECT s,menu$[],"設定メニュー"
IF s=1 THEN
 ARRAY.DELETE menu$[]
 ARRAY.LOAD menu$[],"3x3","4x4","5x5"
 DIALOG.SELECT s,menu$[],"分割数"
 IF s>0 THEN
  s_split=s+2
  GOSUB fadeout
  IF fn$="" THEN GOSUB imgload
  GOTO init
 ENDIF
ELSEIF s=2 THEN
 path$=""
 ARRAY.DELETE d1$[]
 FILE.DIR path$,d1$[]
 SELECT s,d1$[]
 IF s>0 THEN
  fn$=d1$[s]
  GOSUB fadeout
  GOSUB imgload
  GOTO init
 ENDIF
ENDIF
GOTO loop

2018年9月 3日 (月)

第3回「画面タッチで触りまくるわよ」

第3回「画面タッチで触りまくるわよ」

今回は画面タッチについて考えてみます。単に画面タッチと言ってもいろいろありますよね。タップ、ダブルタップ、長押し、ピンチイン、ピンチアウト、マルチタッチ……。BASIC!では2点タッチまで読み取れます!

準備

まずはタッチしたときのステータス確認用にグラフィック画面を用意します。あ、グラフィック画面のタッチ検知をするから、表示なくてもグラフィック画面は必要なのか。コンソール画面のタッチ検出はまた別モノみたいです。


x_size=800
y_size=480
GR.OPEN 255,0,0,0
GR.ORIENTATION 0
PAUSE 1000
GR.SCREEN x,y
scale_x=x/x_size
scale_y=y/y_size
GR.SCALE scale_x,scale_y

ここらはもうおなじみな感じですかね。グラフィック画面をオープンして、向き設定、スケール調整です。わからなかったら第1回を見てみてくださいね。

タッチ?

まずは単純に、タッチしてるかどうかを見てみましょう。


GR.TEXT.SIZE 32
GR.COLOR 255,255,255,255,1
GR.TEXT.DRAW g_touch,0,32,"touched"
DO
 GR.TOUCH touched,x,y
 IF touched THEN
  x=INT(x/scale_x)
  y=INT(y/scale_y)
  GR.SHOW g_touch
 ELSE
  GR.HIDE g_touch
 ENDIF
 GR.RENDER
 PAUSE 16
UNTIL 0

まず表示リストにテキストを登録してます。そしてループ用のDO/UNTILです。

GR.TOUCHコマンドでタッチされているかどうか調べます。タッチされていればtouchedにTRUE(0以外)が返されます。タッチされていない時はFALSE(0)です。x,yにはタッチされている座標が入ります。画面のスケールを変更している場合、座標をまたスケーリングしなければなりません。ここではスケール係数で割り算してINT()関数で小数点以下を切り捨てています。

そして、タッチしている時は表示リストのテキストをGR.SHOWコマンドで表示します。タッチされていない時GR.HIDEコマンドでは隠します。

最後にGR.RENDERコマンドで画面描画、PAUSEコマンドでチョット待って(1フレーム1/60秒)、ループします。

こんな感じですかねー。これで画面をタッチたときに"touched"と表示されます。タッチしていない時は消えますよ。

ムーブ?

今度はタッチしたまま動かしたときの移動量を表示してみましょう。ってことはタッチしたままかどうかをチェックする必要がありますね……。ピコーン!

長押し?

タッチしたままをカウントして、一定量で長押しされたと認識したら良さそうです。


GR.TEXT.DRAW g_move,0,64,"move"
GR.TEXT.DRAW g_hold,0,96,"hold"
hold_count=0
DO
 GR.TOUCH touched,x,y
 IF touched THEN
  x=INT(x/scale_x)
  y=INT(y/scale_y)
  GR.SHOW g_touch
  IF hold_count=0 THEN 
   x_start=x:y_start=y
  ELSE
   x-=x_start:y-=y_start
   GR.MODIFY g_move,"text","move:"+STR$(x)+","+STR$(y)
   GR.SHOW g_move
  ENDIF
  hold_count++
  IF hold_count>15 THEN GR.SHOW g_hold
 ELSE
  GR.HIDE g_touch
  hold_count=0
  GR.HIDE g_move
  GR.HIDE g_hold
 ENDIF
 GR.RENDER
 PAUSE 16
UNTIL 0

また表示リストにテキストを登録して、タッチしたままのときのカウント用に変数hold_countを初期化します。

ループの中の先程のタッチしたときの処理の後に、変数hold_countをチェックして0だったら、タッチし始めとして変数x_start,y_startに座標を保存します。タッチし始めでない場合(変数hold_countが1以上のとき)は、タッチし始めのときに保存した座標との差を移動した距離として表示します。

タッチされてる間、変数hold_countにプラス1して、15に達したら長押しされたとして、またテキストを見えるように設定します。

タッチされてない処理では、変数hold_countをまた0にしてテキストも隠します。長押しのテキストも隠します。

そしてまた描画処理してループ!っと。どうでしょうか。

いいねいいねぇ。次いってみよー。

2点タッチ?

今度は2点目のタッチを検出してみましょう。2点間の距離や角度を測ることができればグーグルマップみたいに拡大縮小回転自由自在!もできちゃうんじゃないかなー!


GR.TEXT.DRAW g_multi,0,128,"multi touch"
GR.TEXT.DRAW g_direction,0,160,"direction"
GR.TEXT.DRAW g_distance,0,192,"distance"
DO
 GR.TOUCH touched,x,y
 IF touched THEN
  x=INT(x/scale_x)
  y=INT(y/scale_y)
  GR.TOUCH2 touched2,x2,y2
  IF touched2 THEN
   x2=INT(x2/scale_x)
   y2=INT(y2/scale_y)
   mdir=INT(TODEGREES(ATAN2(y2-y,x-x2)))+180
   GR.MODIFY g_direction,"text","direction"+STR$(mdir)
   GR.SHOW g_direction
   mdis=INT(SQR(POW(x-x2,2)+POW(y-y2,2)))
   GR.MODIFY g_distance,"text","distance"+STR$(mdis)
   GR.SHOW g_distance
   GR.SHOW g_multi
  ELSE
   GR.HIDE g_multi
   GR.HIDE g_direction
   GR.HIDE g_distance
  ENDIF
 ELSE
  GR.HIDE g_multi
  GR.HIDE g_direction
  GR.HIDE g_distance
 ENDIF
 GR.RENDER
 PAUSE 16
UNTIL 0

また例によって表示用にテキストを登録します。

先程のタッチ後の処理の次にGR.TOUCH2コマンドで2点目のタッチを調べます。コマンド名が違うだけで1点目と一緒です。変数x2,y2に2点目の座標を入れます。


mdir=INT(TODEGREES(ATAN2(y2-y,x-x2)))+180

これで変数mdirに2点の角度が入ります。これはなんかこうゆうものらしいよ。ネットで調べてこんな感じかな?っといろいろやってたら、こんな感じに落ち着きました。あーくたんじぇんとつー?ほー。


mdis=INT(SQR(POW(x-x2,2)+POW(y-y2,2)))

こちらの変数mdisには2点間の距離が入ります。これは知ってます。三平方の定理でしょ!こうゆうのもだいたい他の言語の数学的なサイトで見て、だいたいコピーしたらなんとかなります。BASIC!にもだいたい同じような関数が用意されていてくれますよー。

タッチされてないときの処理も2点分、そして描画処理、ループ!どやさ!

いいよいいよ!でもやっぱ文字だけだと地味だねぇ。

呼びましたか?マスター?

ん?あぁあぁそかそか。それでは自由自在に拡大縮小回転させちゃいましょう!


d_angle=0
GR.BITMAP.LOAD b_droid,"DROIDKUN.png"
GR.BITMAP.SIZE b_droid,b_x,b_y
d_scale=2
GR.BITMAP.SCALE b_resize,b_droid,INT(b_x*d_scale),INT(b_y*d_scale)
GR.ROTATE.START g_angle,400,240,g_rotate
GR.BITMAP.DRAW g_droid,b_resize,400-INT(b_x*d_scale/2),240-INT(b_y*d_scale/2)
GR.ROTATE.END
h_rotate=-1
h_distance=-1
DO
 GR.TOUCH touched,x,y
 IF touched THEN
  x=INT(x/scale_x)
  y=INT(y/scale_y)
  GR.SHOW g_touch
  GR.TOUCH2 touched2,x2,y2
  IF touched2 THEN
   x2=INT(x2/scale_x)
   y2=INT(y2/scale_y)
   mdir=INT(TODEGREES(ATAN2(y2-y,x-x2)))+180
   IF h_rotate=-1 THEN
    h_rotate=mdir
   ELSEIF h_rotate<>mdir THEN
    d_rotate+=h_rotate-mdir
    IF d_rotate<0 THEN d_rotate+=360
    IF d_rotate>=360 THEN d_rotate-=360
    h_rotate=mdir
    GR.MODIFY g_rotate,"angle",d_rotate
    GR.SHOW g_rotate
   ENDIF
   mdis=INT(SQR(POW(x-x2,2)+POW(y-y2,2)))
   IF h_distance=-1 THEN
    h_distance=mdis
   ELSEIF h_distance<>mdis THEN
    d_scale*=mdis/h_distance
    IF d_scale<1 THEN d_scale=1
    GR.BITMAP.DELETE b_resize  
    GR.BITMAP.SCALE b_resize,b_droid,INT(b_x*d_scale),INT(b_y*d_scale)
    GR.MODIFY g_droid,"bitmap",b_resize
    GR.MODIFY g_droid,"x",400-INT(b_x*d_scale/2),"y",240-INT(b_y*d_scale/2)
    h_distance=mdis
   ENDIF
  ELSE
   h_rotate=-1
   h_distance=-1
  ENDIF
 ELSE
  h_rotate=-1
  h_distance=-1
 ENDIF
 GR.RENDER
 PAUSE 16
UNTIL 0

まずはまたドロイドくんを召喚します。画像ファイルを読み込んで、拡大して、回転を仕込んで、表示リストに登録します。(詳しくは第1回参照。)初期値として変数d_angleに角度0度、d_scaleに拡大率2倍を設定します。

h_rotateとh_distanceに初期値として-1を設定します。これはまだ2点タッチしてない状態を表しています。2点タッチの処理の中で、-1のときは角度と距離を保存します。-1でない時は保存されたものなのでその差分を回転拡大縮小に適用します。角度は0から360まで、拡大縮小率は最低1倍に調整します。回転は角度を設定するだけ!拡大縮小は以前のビットマップを削除してまた新しく拡大縮小してセットし直しています。

あとはまぁ、だいたい今までどおり。さぁどうかな!

さわさわ~。うへへ。いいね~ドロイドくん~。

ダブルタップ?

ここで問題が出てきました。ダブルタップはどうしたらいいの?はじめてタッチしたときを検知して、次のタッチされたときの時間差を測ればいいかしら。タッチ、離す、さらにその次のタッチを検出してその時間差を……、うーむ。

と、思ってたら割り込みラベルONGRTOUCH:ってものがありましたよ。こちらだとタップしたときだけ、タッチのし始めだけ割り込んでくれます。さらにタイマー割り込みONTIMER:なんてのもありました。これだ……!

割り込みラベル?

ある一定の条件が起こったとき、対応したラベルがあるとそこに飛んできてくれます。ラベルに対応したRESUMEコマンドが出てくるとまた割り込みの前のところに戻ってくれます。いろいろなラベルが用意されているので、ひと通り見ておくといいかもです。


ONGRTOUCH:
tap_count++
TIMER.CLEAR
TIMER.SET 300
GR.ONGRTOUCH.RESUME
ONTIMER:
tap_count--
IF tap_count<1 THEN TIMER.CLEAR
TIMER.RESUME

これをプログラム中のどこかに置きます。まぁ、最後にですかね。プログラムの初期化のほうにtap_count=0も入れておいてください。

グラフィック画面をタッチしたとき、ラベルONGRTOUCH:に割り込んできてくれます。そこでtap_countをプラス1して、TIMER.SET 300でタイマー割り込みを0.3秒後にセットします。(その前に一応TIMER.CLEARでクリアしてます。)そしてGR.ONGRTOUCH.RESUMEで戻ります。

0.3秒後、ラベルONTIMER:に割り込んできます。そうしたらtap_countをマイナス1します。tap_countが0になったらTIMER.CLEARコマンドでタイマーをクリアします。これでシングルタップ、ダブルタップ、トリプルタップ、更にそれ以上でもtap_countで検知できますよ!そしてやっぱりTIMER.RESUMEで戻ります。

表示用にテキストを仕込むとこんな感じになります。

画面をタップするごとに数字が増えます。ちょっと経つと減ります。この数字でタップの回数を測ろうという魂胆です。

キーボード?

ちょっとキーボードの入力もついでにやってみたんですが……、なんかイマイチなんですよ。

INKEY$コマンドで検知すると思うんですけど、なんかキーを押したときってより、離した瞬間だけ検知してる感じ。BluetoothのTK-FBP052を使っているんですが、モノによるのかなんなのか。わかりません。

なにげに買った激安リモコンがキーボードとして認識されるので使いたかったんだけどなー。

最後にコメントなしのプログラムリストです。

また長いのでダウンロードもどうぞ!


x_size=800
y_size=480
GR.OPEN 255,0,0,0
GR.ORIENTATION 0
PAUSE 1000
GR.SCREEN x,y
scale_x=x/x_size
scale_y=y/y_size
GR.SCALE scale_x,scale_y
d_angle=0
GR.BITMAP.LOAD b_droid,"DROIDKUN.png"
GR.BITMAP.SIZE b_droid,b_x,b_y
d_scale=2
GR.BITMAP.SCALE b_resize,b_droid,INT(b_x*d_scale),INT(b_y*d_scale)
GR.ROTATE.START g_angle,400,240,g_rotate
GR.BITMAP.DRAW g_droid,b_resize,400-INT(b_x*d_scale/2),240-INT(b_y*d_scale/2)
GR.ROTATE.END
GR.TEXT.SIZE 32
GR.COLOR 255,255,255,255,1
GR.TEXT.DRAW g_touch,0,32,"touched"
GR.TEXT.DRAW g_move,0,64,"move"
GR.TEXT.DRAW g_hold,0,96,"hold"
GR.TEXT.DRAW g_multi,0,128,"multi touch"
GR.TEXT.DRAW g_direction,0,160,"direction"
GR.TEXT.DRAW g_distance,0,192,"distance"
GR.TEXT.DRAW g_tap,0,224,"tap"
GR.TEXT.DRAW g_key,0,256,"key"
tap_count=0
hold_count=0
h_rotate=-1
h_distance=-1
DO
 GR.TOUCH touched,x,y
 IF touched THEN
  x=INT(x/scale_x)
  y=INT(y/scale_y)
  GR.SHOW g_touch
  GR.TOUCH2 touched2,x2,y2
  IF touched2 THEN
   x2=INT(x2/scale_x)
   y2=INT(y2/scale_y)
   mdir=INT(TODEGREES(ATAN2(y2-y,x-x2)))+180
   GR.MODIFY g_direction,"text","direction"+STR$(mdir)
   GR.SHOW g_direction
   IF h_rotate=-1 THEN
    h_rotate=mdir
   ELSEIF h_rotate<>mdir THEN
    d_rotate+=h_rotate-mdir
    IF d_rotate<0 THEN d_rotate+=360
    IF d_rotate>=360 THEN d_rotate-=360
    h_rotate=mdir
    GR.MODIFY g_rotate,"angle",d_rotate
   ENDIF
   mdis=INT(SQR(POW(x-x2,2)+POW(y-y2,2)))
   GR.MODIFY g_distance,"text","distance"+STR$(mdis)
   GR.SHOW g_distance
   IF h_distance=-1 THEN
    h_distance=mdis
   ELSEIF h_distance<>mdis THEN
    d_scale*=mdis/h_distance
    IF d_scale<1 THEN d_scale=1
    GR.BITMAP.DELETE b_resize  
    GR.BITMAP.SCALE b_resize,b_droid,INT(b_x*d_scale),INT(b_y*d_scale)
    GR.MODIFY g_droid,"bitmap",b_resize
    GR.MODIFY g_droid,"x",400-INT(b_x*d_scale/2),"y",240-INT(b_y*d_scale/2)
    h_distance=mdis
   ENDIF
   GR.SHOW g_multi
  ELSE
   GR.HIDE g_multi
   GR.HIDE g_direction
   GR.HIDE g_distance
   h_rotate=-1
   h_distance=-1
  ENDIF
  IF hold_count=0 THEN 
   x_start=x:y_start=y
  ELSE
   x-=x_start:y-=y_start
   GR.MODIFY g_move,"text","move:"+STR$(x)+","+STR$(y)
   GR.SHOW g_move
  ENDIF
  hold_count++
  IF hold_count>15 THEN GR.SHOW g_hold
 ELSE
  GR.HIDE g_touch
  GR.HIDE g_multi
  GR.HIDE g_direction
  GR.HIDE g_distance
  hold_count=0
  GR.HIDE g_hold
  GR.HIDE g_move
  h_rotate=-1
  h_distance=-1
 ENDIF
 GR.MODIFY g_tap,"text","tap "+STR$(tap_count)
 INKEY$ k$
 GR.MODIFY g_key,"text","key"+k$
 GR.RENDER
 PAUSE 16
UNTIL 0

ONGRTOUCH:
tap_count++
TIMER.CLEAR
TIMER.SET 300
GR.ONGRTOUCH.RESUME
ONTIMER:
tap_count--
IF tap_count<1 THEN TIMER.CLEAR
TIMER.RESUME

2018年9月 1日 (土)

気になる注意点

気になる注意点

いろいろいじっていて、気になった点を記していきます。

  • PCでBASIC!リストを作成してAndroid実機に転送して実行したときに、実行できないときがありました。REMコマンドでエラーが出る!なんでやの。
  • →テキストエディタで文字コードをUTF-8Nにしてから転送したら解決!

  • Androidでリストをコピペしたら、改行がどっかいっちゃった!
  • 貼り付けのときに、「書式なしテキストとして貼り付け」で!(これが出る機種出ない機種がある?)

  • やっぱり縦画面は時々止まっちゃう。原因は今のところ不明。

第2回「アニメーション、マクロ、音楽との同期でダンシング!」

第2回「アニメーション、マクロ、音楽との同期でダンシング!」

画像表示できたら次は動かしたいですね。音楽と同期してダンスなんてどうでしょうか。

動くわよ


GR.OPEN 255,0,0,0
PAUSE 1000
GR.SCREEN w,h
width=480
hight=270
GR.SCALE w/width,h/hight
GR.BITMAP.LOAD bm_ptr,"DROIDKUN.png"

GOTO sample01

まず第1回と同じように、グラフィック画面を用意しましょう。

そして画像ファイルも読み込みます。ドロイドくんー。

はいー。

画像を右クリックでダウンロードしたら"DROIDKUN.png"にリネームして/rfo-basic/dataに置いておいてくださいね。第1回でやった方は何もしなくてもあるはずです。

今回はGOTOコマンドで各サンプルに飛ばすようにしてみました。最初はsample01から!コピペしたらココを書き換えて試してみてくださいね。


x=-16:y=hight-16
GR.BITMAP.DRAW d_gp,bm_ptr,x,y

はじめに、ドロイドくんの初期位置を設定して、画像を表示リストに登録します。(GR.RENDERコマンドの時に実際に描画されます。第1回参照。)X座標の初期位置-16……、はみ出しても大丈夫うまくやってくれるみたいです。


DO
 x=x+4
 IF x>width THEN x=-16
 GR.MODIFY d_gp,"x",x
 GR.RENDER
 PAUSE 33
UNTIL 0

ずっと繰り返すので、DO/UNTILコマンドでループします。UNTIL 0で無限ループしてます。

そしてX座標を4ドット分加算して右に移動させます。そのままだといつか画面外に行ってしまうので、IF/THENコマンドで画面端に到達したら初期位置に戻します。IF/THENコマンドは条件分岐で、ここではxがwidthより小さい場合(x>width)xを-16(初期値)に戻しています。

GR.MODIFYコマンドで先ほど表示リストに登録した画像のX座標を更新します。GR.MODIFYコマンドは表示リストに登録したあとのグラフィックオブジェクトのパラメータを変更するコマンドです。

そしてGR.RENDERコマンドで描画!そのままループすると速すぎるので、PAUSEコマンドである程度待ってます。PAUSEコマンドはミリ秒単位でプログラムを停止させてくれます。

さて、どうでしょうか。

おぉ、ドロイドくん、地ベタをセコセコ歩いております。しかし、地味だなー。

失礼ね!

ややや、ごめんごめん。ならばメンバー増員しましょう。いまやアイドルもグループが主流ですしね。

増えるわよ

まず初期設定をこうしました。(ここからsample02です。)


DIM x[8],y[8],d_gp[8]
FOR i=1 TO 8
 x[i]=i*16:y[i]=i*24+32
 GR.BITMAP.DRAW d_gp[i],bm_ptr,x[i],y[i]
NEXT

同じようなモノをたくさん用意したい場合、配列を使うと便利です。

配列?

変数がデータを入れる箱だとすると、配列とはその箱を重ねた感じでしょうか。タンスみたいなイメージです。添字によって何段目かを指定して利用できます。似たようなデータ構造に「リスト」がありますが、配列のほうがシンプルな分速いです(たぶん)。配列を使用するには、まずDIMコマンドによって宣言が必要です。まず、X座標、Y座標、グラフィックのポインタ用に8つ用意しました。

次にFOR/NEXTループで初期配置をします。FOR/NEXTはカウント付きループです。第1回でも出てきましたね。配列を使うときはまず使うのではないでしょうか。


DO
 FOR i=1 TO 8
  x[i]=x[i]+4
  IF x[i]>width THEN x[i]=-16
  GR.MODIFY d_gp[i],"x",x[i]
 NEXT
 GR.RENDER
 PAUSE 33
UNTIL 0

ループもほぼsample01と同じですね。配列に置き換えて、FOR/NEXTループで回しただけです。

はい、8人ずらりと。まぁだいたい思ったとおりですね。

プロデューサーさん……!

ファッ!?ドロイドくん、なに急に?

私たち、アイドルになりたいんです……!

(何いってんだ?)そんなこといったって、えー、ならばBGMに合わせて一糸乱れずダンスを見せてごらんなさい……!

はい!がんばります!

(がんばるのはプロデューサーじゃなかったプログラマーさんじゃねーかよ。)

というわけで、ダンスに挑戦してみましょう。(ここからsample03になりますよ。)

踊るわよ


DIM x[8],y[8],d_gp[8]
DIM data$[8],count[8],dr[8],mov[8],lp[8],lc[8],md[8]
d0$="r37"
data$[1]=d0$+~
"    [4F4r]rFRFXLXL[3r56X4L] L4[13+]XL M[13-]XL"+~
"[F8r] R20r4Fr F8 r44       X4L"
data$[2]=d0$+~
"    [4R4r]rRFRXLXL[3r56X4L] X4[13+]XL A[13-]XL"+~
"[F8r] F20r4Fr r8 r28X4Lr8  X4L"
data$[3]=d0$+~
" r64[4X4r]rXLXXLXL[ r56X4L] F4[13+]XL G[13-]XL"+~
"[F8r] L20r4Rr r8 r24X4Lr12 X4L"
data$[4]=d0$+~
" r64[4L4r]rLXLXLXL[ r56X4L] R4[13+]XL S[13-]XL"+~
"[F8r] X20r4Rr R8 r20X4Lr16 X4L"
data$[5]=d0$+~
"r128[4C4r]rCOCXLXL  r56X4L  I4[13+]XL J[13-]XL"+~
"[r8R] O20r4Fr F8 r16X4Lr20 X4L"
data$[6]=d0$+~
"r128[4O4r]rOCOXLXL  r56X4L  U4[13+]XL V[13-]XL"+~
"[r8R] C20r4Fr r8 r12X4Lr24 X4L"
data$[7]=d0$+~
"r192[4I4r]rIUIXLXL O4[13+]XL P[13-]XL"+~
"[r8R] U20r4Rr r8 r8 X4Lr28 X4L"
data$[8]=d0$+~
"r192[4U4r]rUIUXLXL C4[13+]XL D[13-]XL"+~
"[r8R] I20r4Rr R8 r4 X4Lr32 X4L"

ダンスなので、動き方の指示が必要です。まずは8人分データを作りました。MMLっぽいイメージで作ってみましたよ。MMLとはミュージック・マクロ・ランゲージ、プログラム内プログラムというか、まぁ、マクロです。仕様としては、

  • r
  • 停止です。動きません。数字が続くとその数値分繰り返します。省略すると前回と同じ数値を指定したのと同じになります。

  • A~X(大文字)
  • 動く方角です。15度刻みで24方向です。Xが12時方向でABC……VWXと時計回りです。数字が続くと……、rと同じです。省略時の数値はrと共通です。

  • +,-
  • 方角をずらします。前回の方角に+ならば時計回り、-ならば反時計回りに一つずらします。数字が続くと……、上とやっぱり同じです。

  • [,]
  • ループです。]が出てきたら[の次にジャンプします。[に続く数字の回数ループします。省略時は2になります。多重ループはできません。

と、こんな感じで考えてみました。この動きのデータを配列data$[x]にそのまま入れています。あ、データの先頭にタイミング取るようにd0$でrを入れています。実際BGMとのタイミングを見ながら調整してたのでこんな感じになってます。

あと、"~"(チルダ)が行末にあると、次の行と繋いでくれます。別にズラーッと1行に記載してもいいのですけど、スクロールすると見にくいのでこうしています。なにげに"+"で文字列をつなげています。


DIM mx[24],my[24]
FOR i=1 TO 24
 mx[i]=ROUND(SIN(i*15*PI()/180)*4,2)
 my[i]=-ROUND(COS(i*15*PI()/180)*4,2)
NEXT

ここでは方角別に移動量を先に計算して配列に格納しています。毎回計算するのは時間かかりそうなので先に必要な分だけ用意します。SIN()関数、COS()関数、PI()関数を使って移動量計算後、1ドット分じゃ少ないので4倍して、さらにROUND()関数で下2桁で丸めています。三角関数(SIN()COS())はだいたい見たとおりです。よくわからない方はそういうもんだと思ってください。自分も必要なときに毎回復習しながらレベルですので。PI()はそのまま円周率です。ROUND()関数は小数の切り捨て方を指定するときに使います。


FOR i=1 TO 8
 x[i]=232:y[i]=127
 GR.BITMAP.DRAW d_gp[i],bm_ptr,x[i],y[i]
 mov[i]=0:count[i]=1
NEXT

初期配置です。ほぼSample02と同じですね。違いは画面中央から開始にしてます。mov[i]は移動量のカウンタ、count[i]はマクロの何文字目かを数えるカウンタで、それぞれ初期化しています。


AUDIO.LOAD aft,"La_Cumparsita.mid"
AUDIO.PLAY aft
wait=58
au_next=wait
AUDIO.LENGTH au_l,aft
GR.COLOR 255,0,255,0
GR.TEXT.DRAW tgp,0,16,"play"

BGMです。とりあえず著作権フリーっぽい曲を用意しました。誰でも知ってそうな曲で、作曲者没後50年過ぎてる曲を自分で打ち込んでみました。マズかったらゴメンナサイです。

ダウンロード La_Cumparsita.mid (3.3K)

上のリンクを右クリックでダウンロードして、"La_Cumparsita.mid"にリネームしてまた/rfo-basic/dataに置いてください。

AUDIO.LOADコマンドで読み込み、AUDIO.PLAYコマンドで再生です。画像読み込みとほぼ同じような感じですね。aftにオーディオファイルのポインタを入れています。それを使って再生を指示します。

タイミングを取るために変数waitに1ループのタイミングを調整して入れています。ここも実際のBGMを見ながら聴きながら調整しました。

AUDIO.LENGTHコマンドでBGMの長さを取得します。終了時の検知なんかに使えるかなぁと思ったんですけど、なんかずれてました。

デバッグ用にとりあえず画面に文字列を配置しています。最終的にカウンタになってますが、作成時はコレでイロイロ内部数値を覗いていました。GR.COLORコマンドで色と透過度を指定して、それに基づいてGR.TEXT.DRAWコマンドでテキストを表示リストに登録です。


DO
 FOR dancer=1 TO 8
  mov[dancer]--
  WHILE(mov[dancer]<=0)
   IF LEN(data$[dancer])<count[dancer] THEN
    dr[dancer]=0:mov[dancer]=255
   ELSE

ここからメインループです。FOR/NEXTループで8人全員分回します。mov[dancer]は移動量のカウンタで、0以下になったら次のマクロを見ます。"mov[dancer]--"は"mov[dancer]=mov[dancer]-1"と同意です。

WHILE/REPEATコマンドはDO/UNTILコマンドと同じくループです。DO/UNTILコマンドは最後にループ条件があるのに対し、WHILE/REPEATコマンドは最初に条件があります。条件があわないとWHILE/REPEATコマンド間のプログラムは一度も実行されないことになります。DO/UNTILは実行してから条件を見てループします。

LEN関数でマクロの長さを取得してカウンタが長さを超えていないかチェックします。超えている場合はとりあえず動かないことにしてます。


    DO
     cmd$=MID$(data$[dancer],count[dancer],1)
     count[dancer]++
    UNTIL cmd$<>" "
    n=0
    WHILE(IS_NUMBER(MID$(data$[dancer],count[dancer],1)))
     n=n*10+VAL(MID$(data$[dancer],count[dancer],1))
     count[dancer]++
    REPEAT
    SW.BEGIN cmd$
     SW.CASE "["
      lp[dancer]=count[dancer]
      IF n=0 THEN n=2
      lc[dancer]=n
      SW.BREAK
     SW.CASE "]"
      lc[dancer]--
      IF lc[dancer]>0 THEN count[dancer]=lp[dancer]
      SW.BREAK
     SW.CASE "+"
      dr[dancer]++
      IF dr[dancer]>24 THEN dr[dancer]=1
      IF n=0 THEN n=md[dancer] ELSE md[dancer]=n
      mov[dancer]=n
      SW.BREAK
     SW.CASE "-"
      dr[dancer]--
      IF dr[dancer]<1 THEN dr[dancer]=24
      IF n=0 THEN n=md[dancer] ELSE md[dancer]=n
      mov[dancer]=n
      SW.BREAK
     SW.CASE "r"
      dr[dancer]=0
      IF n=0 THEN n=md[dancer] ELSE md[dancer]=n
      mov[dancer]=n
      SW.BREAK
     SW.DEFAULT
      cn=ASCII(cmd$)
      IF cn>=65 & cn<=88 THEN
       dr[dancer]=cn-64
       IF n=0 THEN n=md[dancer] ELSE md[dancer]=n
       mov[dancer]=n
      ELSE
       PRINT "ERROR !",cmd$,n
      ENDIF
    SW.END
   ENDIF
  REPEAT

ちょっと長いですが、ここでマクロの解析をしています。MID$()関数でマクロを一文字読んで、カウンタをプラス1します。"count[dancer]++"は"count[dancer]=count[dancer]+1"と同意です。さっきも似たの出てきました。空白ならばもう一度読みます(DO/UNTILコマンドで空白じゃなくなるまで読む)。cmd$にマクロが一文字入ります。

次に数字を読みます。まずnにゼロをセットして、WHILE/REPEATループのなかで数字ではない文字が出るまで読みます(IS_NUMBER()関数でチェック)。数字だったらnを10倍して下一桁目にその数字をプラスします。これで十進数で何桁でも読めます。WHILE/REPEATループを抜けたときnがゼロのままならば、数値は省略されたとみなします。

SWコマンド(SWITCHコマンド)でマクロ(cmd$)によって分岐します。SWITCHコマンドはIF/THENコマンドのような条件分岐で、処理が3つ以上に分かれる場合に使います。IF/THENでたくさん分岐するより見やすくて速いです。(たぶん)SW.BEGIN cmd$で、cmd$の中身によって各SW.CASEに分岐します。SW.CASEに無いのはSW.DEFAULTに飛びます。SW.BREAKが出てくるとSW.ENDに飛びます。

  • [
  • ループの先頭として、戻る位置をlp[dancer]に、数値nをカウンタlc[dancer]に保存します(数値省略時は2に上書きします)。

  • ]
  • ループの終端、カウンタlc[dancer]をマイナス1して、まだ0にならなかったら位置を保存したlp[dancer]に更新します。

  • +,-
  • 移動の方角dr[dancer]をずらします。24方向(1から24)なので範囲をはみ出したら修正します。数値nを移動量のカウンタmov[dancer]に格納して、さらに省略されたときのためにmd[dancer]に数値を保持します。数値が0の時は省略されたとみなし、以前に保持されたであろうmd[dancer]を採用します。

  • r
  • 停止を意味する0を移動の方角dr[dancer]に格納します。数値nは上記と同じくです。

  • DEFAULT(その他)
  • アルファベット、A~Xであれば、ASCII()関数で数値に変換して移動の方角dr[dancer]に格納します。Aのアスキーコードが65、Xのアスキーコードが88なので、Aが1になるように調整しています。範囲外であればデバッグ用にコンソールにエラーを出力します。数値nは上記と同じくです。


  IF dr[dancer]>0 THEN
   x[dancer]+=mx[dr[dancer]]
   y[dancer]+=my[dr[dancer]]
   GR.MODIFY d_gp[dancer],"x",x[dancer]
   GR.MODIFY d_gp[dancer],"y",y[dancer]
  ENDIF
 NEXT
 GR.RENDER

移動の方角dr[dancer]が0(停止)でなければ、座標を更新して画面表示に反映させます。"x[dancer]+=mx[dr[dancer]]"は"x[dancer]=x[dancer]+mx[dr[dancer]]と同意です。ここらで演算子についてもまとめてみます。

演算子いろいろ?

普通の算術演算子は単純でわかりやすいですよね。+-*/で加減乗除。^はべき乗です。

先程出てきた"++"や"--"は1だけ足したり引いたりします。"x++"で"x=x+1"です。"++x"だとxの値を使用する前に+1されます。例えば、


a=5
PRINT --a
PRINT a--
上のPRINTコマンドで、aがマイナス1されて4が表示されます。下のPRINTコマンドで、4が表示されてからマイナス1されます。最終的にaの中身は3です。

"="の前に算術演算子を付けると代入式をちょっとラクできます。これは例を見たほうがわかりやすいです。


a += 1                      → a = a + 1
a$ += "xyz"                 → a$ = a$ + "xyz"
b /= 5 + 3                  → b = b / (5 + 3)
c ^= LOG(37) + 1            → c = c ^ (LOG(37) + 1)
d *= --d + d--              → d = d * (--d + d--)
m &= (x$ = y$) | (x$ != z$) → m = m & ((x$ = y$) | (x$ != z$))

公式マニュアルから引用しました。左の表記で右の意味です


 AUDIO.ISDONE isdone
 IF isdone=0 THEN
  DO
   AUDIO.POSITION.CURRENT au_p
  UNTIL(au_p>=au_next)
  au_next+=wait
 ENDIF
 GR.MODIFY tgp,"text",INT$(au_p)+"/"+INT$(au_l)
UNTIL au_p>=32784
program_end:
END

AUDIO.ISDONEコマンドで現在BGM再生中か調べます。再生中ならば、次のタイミングが来るまでAUDIO.POSITION.CURRENTコマンドで現在の再生位置を見張りながら待ちます。終わったら次のタイミングに更新して、現在位置と長さをデバッグ用にテキストにセットしてます。そしてやっと最後、現在位置が最後になるまでループします。最後になったらENDコマンドで終了ー!おつかれさまー!さぁ、踊ってごらん!

おー、いいですねぇ!スクショも多めです。

気になるところ


 AUDIO.POSITION.CURRENT au_p
 IF au_p<au_next THEN
  PAUSE au_next-au_p
  au_next+=wait
 ENDIF

最後のループのところ、ほんとはこうしたほうがスマートだと思うのですが、これだとどうしてもタイミングがずれます。PAUSEコマンドで他のプロセスに行ってしまって、正確にミリ秒で戻っては来れないのでしょうか。たぶん。ちょっとわかりません。さらに最後のUNTILのところも、


UNTIL isdone
UNTIL au_p>=au_l

上のどちらかのがスマートに思うんだけど……、うまくいきません。なぜだろう。なぜかしら。

うまくいかない……!?がーん!やっぱりアイドルには向いてなのねそうなのね。プロデューサーさん……、わたし、アイドルやめます……!

えー。というわけで、アニメーション、マクロ、音楽との同期ができました。マクロなんか、シューティングゲームの敵機の動きのパターンとかに使えそうだなぁ。音楽との同期ができれば音ゲーなんかも作れそうですよね。

最後に、コメントなしのプログラムリストです。

ちょっと長いのでコピペも面倒くさい人はこちらからダウンロードどうぞ!


GR.OPEN 255,0,0,0
PAUSE 1000
GR.SCREEN w,h
width=480
hight=270
GR.SCALE w/width,h/hight
GR.BITMAP.LOAD bm_ptr,"DROIDKUN.png"
GOTO sample03

sample01:
x=-16:y=hight-16
GR.BITMAP.DRAW d_gp,bm_ptr,x,y
DO
 x=x+4
 IF x>width THEN x=-16
 GR.MODIFY d_gp,"x",x
 GR.RENDER
 PAUSE 33
UNTIL 0

sample02:
DIM x[8],y[8],d_gp[8]
FOR i=1 TO 8
 x[i]=i*16:y[i]=i*24+32
 GR.BITMAP.DRAW d_gp[i],bm_ptr,x[i],y[i]
NEXT
DO
 FOR i=1 TO 8
  x[i]=x[i]+4
  IF x[i]>width THEN x[i]=-16
  GR.MODIFY d_gp[i],"x",x[i]
 NEXT
 GR.RENDER
 PAUSE 33
UNTIL 0

sample03:
DIM x[8],y[8],d_gp[8]
DIM data$[8],count[8],dr[8],mov[8],lp[8],lc[8],md[8]
d0$="r29"
data$[1]=d0$+~
"    [4F4r]rFRFXLXL[3r56X4L] L4[13+]XL M[13-]XL"+~
"[F8r] R20r4Fr F8 r44       X4L"
data$[2]=d0$+~
"    [4R4r]rRFRXLXL[3r56X4L] X4[13+]XL A[13-]XL"+~
"[F8r] F20r4Fr r8 r28X4Lr8  X4L"
data$[3]=d0$+~
" r64[4X4r]rXLXXLXL[ r56X4L] F4[13+]XL G[13-]XL"+~
"[F8r] L20r4Rr r8 r24X4Lr12 X4L"
data$[4]=d0$+~
" r64[4L4r]rLXLXLXL[ r56X4L] R4[13+]XL S[13-]XL"+~
"[F8r] X20r4Rr R8 r20X4Lr16 X4L"
data$[5]=d0$+~
"r128[4C4r]rCOCXLXL  r56X4L  I4[13+]XL J[13-]XL"+~
"[r8R] O20r4Fr F8 r16X4Lr20 X4L"
data$[6]=d0$+~
"r128[4O4r]rOCOXLXL  r56X4L  U4[13+]XL V[13-]XL"+~
"[r8R] C20r4Fr r8 r12X4Lr24 X4L"
data$[7]=d0$+~
"r192[4I4r]rIUIXLXL O4[13+]XL P[13-]XL"+~
"[r8R] U20r4Rr r8 r8 X4Lr28 X4L"
data$[8]=d0$+~
"r192[4U4r]rUIUXLXL C4[13+]XL D[13-]XL"+~
"[r8R] I20r4Rr R8 r4 X4Lr32 X4L"
DIM mx[24],my[24]
FOR i=1 TO 24
 mx[i]=ROUND(SIN(i*15*PI()/180)*4,2)
 my[i]=-ROUND(COS(i*15*PI()/180)*4,2)
NEXT
FOR i=1 TO 8
 x[i]=232:y[i]=127
 GR.BITMAP.DRAW d_gp[i],bm_ptr,x[i],y[i]
 mov[i]=0:count[i]=1
NEXT
AUDIO.LOAD aft,"La_Cumparsita.mid"
AUDIO.PLAY aft
wait=58
au_next=wait
AUDIO.LENGTH au_l,aft
GR.COLOR 255,0,255,0
GR.TEXT.DRAW tgp,0,16,"play"
DO
 FOR dancer=1 TO 8
  mov[dancer]--
  WHILE(mov[dancer]<=0)
   IF LEN(data$[dancer])<count[dancer] THEN
    dr[dancer]=0:mov[dancer]=255
   ELSE
    DO
     cmd$=MID$(data$[dancer],count[dancer],1)
     count[dancer]++
    UNTIL cmd$<>" "
    n=0
    WHILE(IS_NUMBER(MID$(data$[dancer],count[dancer],1)))
     n=n*10+VAL(MID$(data$[dancer],count[dancer],1))
     count[dancer]++
    REPEAT
    SW.BEGIN cmd$
     SW.CASE "["
      lp[dancer]=count[dancer]
      IF n=0 THEN n=2
      lc[dancer]=n
      SW.BREAK
     SW.CASE "]"
      lc[dancer]--
      IF lc[dancer]>0 THEN count[dancer]=lp[dancer]
      SW.BREAK
     SW.CASE "+"
      dr[dancer]++
      IF dr[dancer]>24 THEN dr[dancer]=1
      IF n=0 THEN n=md[dancer] ELSE md[dancer]=n
      mov[dancer]=n
      SW.BREAK
     SW.CASE "-"
      dr[dancer]--
      IF dr[dancer]<1 THEN dr[dancer]=24
      IF n=0 THEN n=md[dancer] ELSE md[dancer]=n
      mov[dancer]=n
      SW.BREAK
     SW.CASE "r"
      dr[dancer]=0
      IF n=0 THEN n=md[dancer] ELSE md[dancer]=n
      mov[dancer]=n
      SW.BREAK
     SW.DEFAULT
      cn=ASCII(cmd$)
      IF cn>=65 & cn<=88 THEN
       dr[dancer]=cn-64
       IF n=0 THEN n=md[dancer] ELSE md[dancer]=n
       mov[dancer]=n
      ELSE
       PRINT "ERROR !",cmd$,n
      ENDIF
    SW.END
   ENDIF
  REPEAT
  IF dr[dancer]>0 THEN
   x[dancer]+=mx[dr[dancer]]
   y[dancer]+=my[dr[dancer]]
   GR.MODIFY d_gp[dancer],"x",x[dancer]
   GR.MODIFY d_gp[dancer],"y",y[dancer]
  ENDIF
 NEXT
 GR.RENDER
 AUDIO.ISDONE isdone
 IF isdone=0 THEN
  DO
   AUDIO.POSITION.CURRENT au_p
  UNTIL(au_p>=au_next)
  au_next+=wait
 ENDIF
 GR.MODIFY tgp,"text",INT$(au_p)+"/"+INT$(au_l)
UNTIL au_p>=32770
! UNTIL isdone
! UNTIL au_p>=au_l
program_end:
END

2018年8月30日 (木)

第1回「画像を表示してみよう」

第1回「画像を表示してみよう」

さて、まずは画像を表示してみたいと思います。見た目は大事ですよね!っていうか、画面無ければはじまらないです。

グラフィック画面?

BASIC!では、グラフィックスを表示する場合、グラフィック画面を開いて使います。グラフィック画面はテキスト表示のコンソール画面とはまったく別で、重ね合わせて表示なんかもできないみたいです。

具体的にはGR.OPENコマンドでグラフィック画面を開きます。同時に背景色、透明度、画面の向きも指定できます。透明度なんてなんのためにあるんだろ。使い所がわかりません……。

プログラムが終了すると、グラフィック画面も閉じてしまいます。グラフィックス画面を表示したままにしたい場合は、プログラムが終了しないように無限ループを仕込んでおいてください。とりあえず[戻る]キーをタップすればプログラムが終了してループを抜けられます。

表示リスト?

グラフィカルオブジェクト(ビットマップ、テキスト、線、円など)を描画するコマンドは、そのオブジェクトを表示リストに登録して、そのオブジェクトの番号を返します。その番号を用いてあとから一部のパラメータだけを変更できたりします。そしてGR.RENDERコマンドが実行されるとき、その表示リストに従って一気に描画されます。ひと手間面倒なようですけど、BASIC!ではこういうことみたいです。

実際に表示してみるよ

とりあえず適当に画像ファイルを用意します。ドロイド君をドット絵で作ってみましたよ。

ドロイドですー。よろしくですー。

用意した画像は"DROIDKUN.png"にリネームして/rfo-basic/dataに置いてください。プログラムはこんな感じです。


GR.OPEN 255,0,0,0
GR.BITMAP.LOAD BM_ptr,"DROIDKUN.png"
GR.BITMAP.DRAW gp,BM_ptr,0,0
GR.RENDER
DO
UNTIL 0

まずGR.OPENコマンドでグラフィック画面を開きます。

そしてGR.BITMAP.LOADコマンドでファイルから画像を読み込みます。jpgやpngが扱えるようです。他形式でもできるのかな?BM_ptrに読み込んだ画像のポインタがはいります。以降、画像を扱う時はこのポインタを使います。

GR.BITMAP.DRAWコマンドで表示リストに登録します。gpに表示リストのオブジェクト番号が入ります。次がさきほどの画像ポインタBM_ptr、その次の0,0は表示位置の座標です。

そしてGR.RENDERコマンドで実際に描画処理をします。

DO/UNTIL 0で無限ループです。気軽に無限ループさせられるっていいですね。

メニューからSAVEしてRUN!

ばーん!え?

これ?小さいわね!

そらそうですわ。16*16ドットですやん。

あらそう。今どきのスマホは解像度スゴイですからね。うちのスマホはどんなもんなのかなー。見てみましょう。


GR.SCREEN w,h
PRINT w,h

GR.SCREENコマンドで画面の大きさを取得できます。他にSCREENコマンドでもできます。w,hに幅と高さが入ります。PRINTコマンドでコンソールにとりあえず出力してみますよ。

GR.OPENコマンドのあとすぐにGR.SCREENコマンドを実行すると、画面の向きの変更前に画面の大きさを取得してしまうことがあります。GR.OPENコマンドのあとにPAUSE 1000を入れて1秒ほど待ってからのほうがいいみたいです。

ほうほう1794,1080……、カタログでは1920*1080だけど……、ナビゲーションバーの分かな?この画面で16*16ドット……、こりゃこうなりますわ。

スケーリング?

あんまり解像度高いとグラフィックリソースを準備するのが大変ですね。 気合い入れて画像を用意してる間にやる気が無くなる…、あるある!です。

他機種を参考にしてみましょうか。PSPだと490*272、VITAだと960*544だそうです。3DSは400*240、ちなみにファミコンは256*224…、まぁ縦横1/4くらいがいいかな?サンプルやチュートリアルでは800*480が多い気がする…。

BASIC!には、デバイスに依存しない方法で描画して、実際のサイズに合わせてくれる命令があります。


width=480
hight=270
GR.SCALE w/width,h/hight

GR.SCALEに倍率をセットすると、これ以降描画コマンドを倍率でスケーリングしてくれます。まぁ便利!

まぁ、いいんじゃないでしょうか。

拡大縮小?

こう簡単にスケーリングしてくれると、普通に拡大縮小もしてみたいですね。やってみましょう。


FOR i=1 TO 7
 GR.BITMAP.SCALE scbp,BM_ptr,i*4+4,i*4+4
 GR.BITMAP.DRAW gp,scbp,i*32-32,32
NEXT
GR.RENDER

FOR/NEXTループは繰り返しでよく使われます。変数でカウントしながらループしてくれるので、似たような処理を何度もしなくちゃいけない時便利です。今回は8*8、12*12、16*16、20*20、24*24、28*28、32*32まで7段階作ってみます。

GR.BITMAP.SCALEでサイズを変えられます。変数scbpにサイズ変更後のビットマップのポインタが入ります。次に元のビットマップのポインタ、変更後のサイズです。

GR.BITMAP.DRAWでサイズ変更したばかりのscbpを表示リストに入れます。重ならないようにX座標をずらしています。

で。ループして表示!

おぉ!なんかぼんやりアンチエイリアスが効いていい感じです。GR.BITMAP.SCALEコマンドの座標の後に,0を入れるとアンチエイリアスをオフにすることもできますよ。


GR.BITMAP.SCALE scbp,BM_ptr,i*4+4,i*4+4,0

アンチエイリアス?

ビットマップの拡大縮小でアンチエイリアスをオフにできました。他の描画コマンドではアンチエイリアスはどうなんでしょうか。もちろんできますよ!GR.SET.ANTIALIASコマンドを使います。


GR.SET.ANTIALIAS 0

BASIC!ではデフォルトでアンチエイリアスはオンです。1ドットの線やピクセルをどうしても描画したい時はアンチエイリアスをオフにします。引数を1にするとオン、引数無しで切り替えです。

回転?

さらに、回転も簡単にできます!拡大縮小回転なんてスーパーファミコンみたい!


FOR i=0 TO 12
 x=i*16:y=64
 GR.ROTATE.START i*30,x+8,y+8,r_pt
 GR.BITMAP.DRAW gp,BM_ptr,x,y
 GR.ROTATE.END
NEXT
GR.RENDER

GR.ROTATE.STARTコマンドからGR.ROTATE.ENDコマンドまでの間、一時的に座標系を回転させます。i*30で0度から360度まで30度刻みで指定しています。次のx+8,y+8で回転の中心位置を指定します。16*16の画像の中心座標+8です。r_ptに表示リストのオブジェクト番号が格納されます。このコマンドでは実際に描画はしませんが、表示リストに登録されます。このr_ptのrotateパラメータをいじると、後から回転具合を変更できます。

あとはGR.BITMAP.DRAWコマンドで普通に描画します。

おぉ、できました。簡単楽しい……!

最後に、コメントなしのプログラムリストです。


GR.OPEN 255,0,0,0
PAUSE 1000
GR.SCREEN w,h
width=480
hight=270
GR.SCALE w/width,h/hight

GR.BITMAP.LOAD BM_ptr,"DROIDKUN.png"
GR.BITMAP.DRAW gp,BM_ptr,0,0

FOR i=1 TO 7
 GR.BITMAP.SCALE scbp,BM_ptr,i*4+4,i*4+4
 GR.BITMAP.DRAW gp,scbp,i*32-32,32
NEXT

FOR i=0 TO 12
 x=i*16:y=64
 GR.ROTATE.START i*30,x+8,y+8,r_pt
 GR.BITMAP.DRAW gp,BM_ptr,x,y
 GR.ROTATE.END
NEXT

GR.RENDER
DO
UNTIL 0
END

2018年3月28日 (水)

はじめに

AndroidのBASIC!が面白そうなのです。


BASICのアプリもいろいろあるようですけど、無料でいろいろできそうなのでBASIC!がいいんじゃないかと。
JavaScriptの方が今どきはお手軽で役に立つのでしょうけど、もうスマホだけで気軽にプログラミングっていうのがね、楽でいいんですよ。ほんと、思いついたらすぐ作ってみようって感じで。


自分たちの世代では、パソコン=BASICでプログラミングでした。ベーマガを写経して、なんとなく覚えていったものです。
これからプログラミング教育なんかも始まるみたいですし、同じようにやっぱりBASICから始めるのも悪くないのではないかと思います。


まぁ、それよりも自分が興味があるので、いろいろいじってみようと思います。ちょっとしたゲームなんかを気軽に作りたいのです。
いじる中で、調べたことをまとめていこうと思います。使うものしかまとめません。自分のための備忘録みたいなものです。
悲しいかな歳のせいか、マニュアルが英語では頭に入ってこないの……。
勝手にやるので、怒られたらやめます……。

最近のトラックバック

カテゴリー

  • パソコン・インターネット

最近のコメント

2019年9月
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30          
無料ブログはココログ