pyret 版 2048 <https://code.pyret.org/editor#share=1FxX0gSOY5apbFXIPe7Im18cR--78OyIG&v=560a5c1>

ret2048.arr

include world
include image


# 这些是我预先上传的数字图片，在开始先下载下来几个
# 也可以不写这几行，这样在运行的过程中用到是会下载
im_2 = image-url('http://taojy123.cn:2048/2.png')
im_4 = image-url('http://taojy123.cn:2048/4.png')
im_8 = image-url('http://taojy123.cn:2048/8.png')
im_16 = image-url('http://taojy123.cn:2048/16.png')


# 每格边长 100 像素
SIDE = 100

# 长宽各 4 个格子
WIDTH = SIDE * 4
HIEGHT = SIDE * 4
BACKGROUND = rectangle(WIDTH, HIEGHT, "solid", "gray") 



# 数字格 三个参数 分别是纵横坐标和数字值
data Block:
  | block(x :: Number, y :: Number, value :: Number)
end


# 棋盘 包含多个数字格的 list
data World:
  | world(blocks :: List<Block>)
end 


fun get-image-url(a-block):
  doc:"根据 block 的数值获取对应的图片网址"
  cases (Block) a-block:
    |block(x, y, value) => 
      'http://taojy123.cn:2048/' + num-to-string(value) + '.png'
  end
end



fun draw-a-block(a-block, base) -> Image:
  doc:"在画布上绘制一个 block"
  cases (Block) a-block:
    |block(x, y, value) => 
      underlay-xy(base, x * SIDE, y * SIDE, image-url(get-image-url(a-block)))
  end
end


fun draw-blocks(blocks) -> Image:
  doc:"在画布上绘制所有的 block"
  cases (List<Block>) blocks:
    | empty => BACKGROUND
    | link(first,rest) => 
      draw-a-block(first, draw-blocks(rest))
  end
end
  

fun show-world(a-world) -> Image:
  doc:"绘制棋盘（就是将里面所有的 block 绘制出来）"
  cases (World) a-world:
    |world(blocks) => 
      draw-blocks(blocks)
  end
end


fun get-block-value(x,y,blocks) -> Number:
  doc:"根据纵横坐标获取 blocks 中的数值"
  var value = 0
  _ = for each(a-block from blocks):
    if (value == 0) and (x == a-block.x) and (y == a-block.y):
      value := a-block.value
    else:
      value
    end
  end
  value
where:
  get-block-value(1,2,[list: block(0,1,2), block(1,2,8), block(2,1,4)]) is 8
  get-block-value(1,3,[list: block(0,1,2), block(1,2,8), block(2,1,4)]) is 0
end


fun remove-block(x,y,blocks) -> List<Block>:
  doc:"根据纵横坐标从 blocks 移除一个 block"
  cases (List) blocks:
    |empty => empty
    |link(first,rest) => 
      if (first.x == x) and (first.y == y):
        remove-block(x,y,rest)
      else:
        link(first, remove-block(x,y,rest))
      end
  end
where:
  remove-block(1,2,[list: block(0,1,2), block(1,2,8)]) is [list: block(0,1,2)]
end


fun block-down(a-block, blocks) -> List<Block>:
  doc:"下滑一个 block"
  var result = empty
  _ = for each(n from [list: 3, 2, 1]):
    t-value = get-block-value(a-block.x,n,blocks)
    if result == empty:
      if n <= a-block.y:
        empty
      else if t-value == 0:
        result := link(
          block(a-block.x, n, a-block.value), 
          remove-block(a-block.x,a-block.y,blocks))
      else if t-value == a-block.value:
        result := link(
          block(a-block.x, n, a-block.value * 2), 
          remove-block(a-block.x,n, remove-block(a-block.x,a-block.y,blocks)))
      else:
        empty
      end
    else:
      empty
    end
  end
  if result == empty:
    blocks
  else:
    result
  end
end



fun block-up(a-block, blocks) -> List<Block>:
  doc:"上滑一个 block"
  var result = empty
  _ = for each(n from [list: 0, 1, 2]):
    t-value = get-block-value(a-block.x,n,blocks)
    if result == empty:
      if n >= a-block.y:
        empty
      else if t-value == 0:
        result := link(
          block(a-block.x, n, a-block.value), 
          remove-block(a-block.x,a-block.y,blocks))
      else if t-value == a-block.value:
        result := link(
          block(a-block.x, n, a-block.value * 2), 
          remove-block(a-block.x,n, remove-block(a-block.x,a-block.y,blocks)))
      else:
        empty
      end
    else:
      empty
    end
  end
  if result == empty:
    blocks
  else:
    result
  end
end




fun block-left(a-block, blocks) -> List<Block>:
  doc:"左滑一个 block"
  var result = empty
  _ = for each(n from [list: 0, 1, 2]):
    t-value = get-block-value(n,a-block.y,blocks)
    if result == empty:
      if n >= a-block.x:
        empty
      else if t-value == 0:
        result := link(
          block(n, a-block.y, a-block.value), 
          remove-block(a-block.x,a-block.y,blocks))
      else if t-value == a-block.value:
        result := link(
          block(n, a-block.y, a-block.value * 2), 
          remove-block(n,a-block.y, remove-block(a-block.x,a-block.y,blocks)))
      else:
        empty
      end
    else:
      empty
    end
  end
  if result == empty:
    blocks
  else:
    result
  end
end




fun block-right(a-block, blocks) -> List<Block>:
  doc:"右滑一个 block"
  var result = empty
  _ = for each(n from [list: 3, 2, 1]):
    t-value = get-block-value(n,a-block.y,blocks)
    if result == empty:
      if n <= a-block.x:
        empty
      else if t-value == 0:
        result := link(
          block(n, a-block.y, a-block.value), 
          remove-block(a-block.x,a-block.y,blocks))
      else if t-value == a-block.value:
        result := link(
          block(n, a-block.y, a-block.value * 2), 
          remove-block(n,a-block.y, remove-block(a-block.x,a-block.y,blocks)))
      else:
        empty
      end
    else:
      empty
    end
  end
  if result == empty:
    blocks
  else:
    result
  end
end




fun all-down(blocks) -> List<Block>:
  doc:"下滑所有 block"
  var result = blocks
  _ = for each(i from [list: 3, 2, 1, 0]):
    _ = for each(j from [list: 3, 2, 1, 0]):
      v = get-block-value(i, j, result)
      if v == 0:
        j
      else:
        a-block = block(i, j, v)
        result := block-down(a-block, result)
      end
    end
    i
  end
  result
end


fun all-up(blocks) -> List<Block>:
  doc:"上滑所有 block"
  var result = blocks
  _ = for each(i from [list: 0, 1, 2, 3]):
    _ = for each(j from [list: 0, 1, 2, 3]):
      v = get-block-value(i, j, result)
      if v == 0:
        j
      else:
        a-block = block(i, j, v)
        result := block-up(a-block, result)
      end
    end
    i
  end
  result
end


fun all-left(blocks) -> List<Block>:
  doc:"左滑所有 block"
  var result = blocks
  _ = for each(i from [list: 0, 1, 2, 3]):
    _ = for each(j from [list: 0, 1, 2, 3]):
      v = get-block-value(i, j, result)
      if v == 0:
        j
      else:
        a-block = block(i, j, v)
        result := block-left(a-block, result)
      end
    end
    i
  end
  result
end


fun all-right(blocks) -> List<Block>:
  doc:"右滑所有 block"
  var result = blocks
  _ = for each(i from [list: 3, 2, 1, 0]):
    _ = for each(j from [list: 3, 2, 1, 0]):
      v = get-block-value(i, j, result)
      if v == 0:
        j
      else:
        a-block = block(i, j, v)
        result := block-right(a-block, result)
      end
    end
    i
  end
  result
end



fun build-a-block(blocks) -> List<Block>:
  doc:"随机创建一个 block "
  
  var result = empty
  r = random(4)
  
  _ = for each(i from [list: 0, 1, 2, 3]):
    _ = for each(j from [list: 0, 1, 2, 3]):
      x = num-modulo(r + i, 4)
      y = num-modulo(r + j, 4)
      v = get-block-value(x, y, blocks)
      if (result == empty) and (v == 0):
        a-block = block(x, y, 2)
        result := link(a-block, blocks)
      else:
        j
      end
    end
    i
  end
  if result == empty:
    blocks
  else:
    result
  end
end



fun key-press(a-world, key) -> World:
  doc:"处理键盘事件"
  blocks = if key == "down":
   all-down(a-world.blocks)
  else if key == "up":
    all-up(a-world.blocks)
  else if key == "left":
    all-left(a-world.blocks)
  else if key == "right":
    all-right(a-world.blocks)
  else:
    a-world.blocks
  end
  world(build-a-block(blocks))
end


# 初始化游戏
init-world = world([list: block(0,0,2), block(1,2,4)])
handlers = [list: to-draw(show-world), on-key(key-press)]
big-bang(init-world, handlers)