-
Notifications
You must be signed in to change notification settings - Fork 3
/
Red 2048.red
88 lines (84 loc) · 2.22 KB
/
Red 2048.red
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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Red [Needs: 'View]
random/seed now
board: random [2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
; ----------- move engine -----------
tasse: function [b] [
forall b [while [b/1 = 0] [remove b]]
head append/dup b 0 4 - length? b
]
somme: function [b] [
tasse b
repeat n 3 [
m: n + 1
if all [b/:n <> 0 b/:n = b/:m] [
poke b n b/:n * 2
poke b m 0
]
]
tasse b
]
reshape: function [b d][
res: copy []
switch d [
up [repeat n 4 [extract/index/into b 4 n res] res]
down [repeat n 4 [extract/index/into b 4 n res] reverse res]
left [res: copy b]
right [res: reverse copy b]
]
]
mov: function [b d][
b1: reshape b d
moved: copy []
foreach [x y z t] b1 [append moved somme reduce [x y z t]]
reshape moved d
]
; --------- GUI ---------
colors: [0 gray 2 snow 4 linen 8 brick 16 brown 32 sienna
64 water 128 teal 256 olive 512 khaki 1024 tanned 2028 wheat]
tsize: 110x110
padsize: 4x4
padlen: 114
mainsize: tsize * 4 + (padsize * 5)
tfont: make font! [size: 30 color: black style: 'bold]
display: does [
foreach face lay/pane [
n: face/data
face/text: either board/:n = 0 [""] [form board/:n]
face/color: reduce select colors board/:n
]
]
lay: layout [
size mainsize
title "2048 game"
backdrop white
on-key [
if find [up down left right] d: event/key [
if board <> newboard: mov board d [
board: newboard
if find board 2048 [alert "You win!"]
until [
pos: random 16
0 = board/:pos
]
poke board pos either 1 = random 10 [4] [2]
display
conds: reduce [not find board 0]
foreach d [up down left right] [
append conds board = mov board d
]
if all conds [alert "You lose!"]
]
]
]
space padsize
]
repeat n length? board [append lay/pane make face! [
type: 'base
offset: padsize + padlen * as-pair (n - 1 % 4) (n - 1 / 4)
size: tsize
color: reduce select colors board/:n
data: n
font: tfont
]]
display
view lay