さめがめ

（2018/01/11 公開）

　同じコマが並んでいるところにカーソル（白い四角）を合わせてエンターキーを押すと、そのコマが消えて、上にあるコマが下に落ちます。なるべく多くのコマを消すのが目標です。

　プログラムは、動作させるための最低限の実装しかしていません。気が向いたら改造していくということで。

プログラムリスト

'  SameGame for Smile Basic on Pasocom Mini
'  2018.1.10. Toshi Nagata
'  UTF-8 encoding
'
xx = 640 div 16         '  盤面の幅
yy = (360 - 36) div 16 '  盤面の高さ（画面の上 32 ドット分は使わない）
n = 5     '  駒の種類
num = 0   '  残り駒の数
point = 0 '  ポイント
cx = 0    '  現在のカーソル位置 (x)
cy = 0    '  現在のカーソル位置 (y)

dim board[xx, yy]  '  盤面

' (x,y) 位置のコマを表示する
def disppiece x, y
  var c, sx, sy, x1, y1
  c = board[x, y]
  x1 = x * 16
  y1 = y * 16 + 36
  if c == 1 then
    sx = 0 : sy = 0
  elseif c == 2 then
    sx = 32 : sy = 0
  elseif c == 3 then
    sx = 64 : sy = 0
  elseif c == 4 then
    sx = 80 : sy = 0
  elseif c == 5 then
    sx = 96 : sy = 0
  else
    sx = -1
  endif
  if sx >= 0 then
    gbox x1, y1, x1 + 15, y1 + 15, #black
    gcopy 3, sx, sy, sx + 15, sy + 15, x1, y1, 1
  else
    gfill x1, y1, x1 + 15, y1 + 15, 0
  endif
  if x == cx && y == cy then
    gbox x1, y1, x1 + 15, y1 + 15, #white
  endif
end

' 残りコマ数や得点を表示する
def dispinfo
  color #white
  locate 0, 0 : print "【さめがめ】";
  print " 残 "; format$("%-4D", num);
  print " 点 "; format$("%-6D", point);
end

' 画面表示
def display
  var x, y
  for x = 0 to xx - 1
    for y = 0 to yy - 1
      disppiece x, y
    next
  next
  dispinfo
end

' 連続しているコマの並びにマークをつけてコマ数を返す（再帰呼び出し）
def mark(x, y)
  var c, n
  c = board[x, y]
  board[x, y] = c + 100
  n = 1
  if x > 0 && board[x - 1, y] == c then n = n + mark(x - 1, y)
  if x < xx - 1 && board[x + 1, y] == c then n = n + mark(x + 1, y)
  if y > 0 && board[x, y - 1] == c then n = n + mark(x, y - 1)
  if y < yy - 1 && board[x, y + 1] == c then n = n + mark(x, y + 1)
  return n
end

' メインプログラム
for x = 0 to xx - 1
  for y = 0 to yy - 1
    board[x, y] = rnd(n) + 1
  next
next
num = xx * yy
cls
display

while 1
@redo
  locate cx * 2, cy + 1
  repeat : in$ = inkey$() : until len(in$) > 0
  ch = asc(in$)
  if ch == 27 || ch == 113 || ch == 81 then break
  wx = cx
  wy = cy
  if ch == 28 then
    cx = (cx + 1) mod xx
  elseif ch == 29 then
    cx = (cx - 1 + xx) mod xx
  elseif ch == 30 then
    cy = (cy - 1 + yy) mod yy
  elseif ch == 31 then
    cy = (cy + 1) mod yy
  elseif ch == 13 then
    n = mark(cx, cy)
    if n == 1 then
      board[cx, cy] = board[cx, cy] - 100
    else
      for x = 0 to xx - 1
        for y = 0 to yy - 1
          if board[x, y] > 100 then disppiece x, y 
        next
      next
      for x = 0 to xx - 1
        y1 = yy - 1
        for y = yy - 1 to 0 step -1
          if board[x, y] < 100 then
            board[x, y1] = board[x, y]
            y1 = y1 - 1
          endif
        next
        while y1 >= 0
          board[x, y1] = 0
          y1 = y1 - 1
        wend
      next
      x1 = 0
      for x = 0 to xx - 1
        if board[x, yy - 1] == 0 then @next
        if x != x1 then
          for y = 0 to yy - 1
            board[x1, y] = board[x, y]
          next
        endif
        x1 = x1 + 1
        @next
      next
      for x1 = x1 to xx - 1
        for y = 0 to yy - 1
          board[x1, y] = 0
        next
      next
      point = point + (n - 2) * (n - 2)
      num = num - n
      display
    endif
    goto @redo
  endif
  if wx != cx or wy != cy then
    disppiece wx, wy
    disppiece cx, cy
  endif
wend

locate 0, yy + 1
color #white