summaryrefslogtreecommitdiff
path: root/tetris/engine.prn
blob: bd0043370f03f18fbf954786a204149da0c6b50d (plain)
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
#Elements in e_blockqueue and e_boardblock are in the form (rot<<3) + idx


mkarray "e_blockqueue" store  #(rot<<3) + idx

@defun "e_init" {
	-1 ntiles_x ntiles_y * replicate
	ntiles_x ntiles_y * mkarrayp
	"e_boardblock" gstore  #(rot<<3) + idx

	0 ntiles_x ntiles_y * replicate
	ntiles_x ntiles_y * mkarrayp
	"e_boardfilled" gstore  #booleans

	e_pushnewblock
	e_newcblock  #initialises cblock vars
}

@defun "e_test" {
	0 "i" store
	i b_nblocks < while
		0 "j" store
		j 4 < while
			io_clearscreen
			io_windowbox
			0 0 i j b_drawblock
			1000000 sleep
			j 1 + "j" store
		j 4 < end
		i 1 + "i" store
	i b_nblocks < end
	io_pos_after io_goto
}

@defun "e_nextblock" {
	"e_blockqueue" swapoutvar
	arrlen 1 < if
		"ERROR: blockqueue empty while requesting nextblock" print
		error
	end
	0 arridx
	swap
	arrpopf "e_blockqueue" gstore
	e_pushnewblock
}

@defun "e_peekblock" {
	"e_blockqueue" swapoutvar
	arrlen 1 < if
		-1
	else
		0 arridx
	end
	swap
	"e_blockqueue" gstore
}

@defun "e_pushnewblock" {
	"e_blockqueue" swapoutvar
	0 7 randr arrpush
	"e_blockqueue" gstore
}

@defun "e_newcblock" {
	e_nextblock "e_cblock" gstore
	ntiles_x 2 - 2 / "e_cblockpos" gstore
}

@defun "e_fullrender" {
	io_clearscreen
	io_windowbox

	io_printheader

	"e_boardblock" swapoutvar
	arrlen "sz" store
	0 "i" store
	i sz < while
		i arridx
		dup -1 = ! if
			i ntiles_x % swap
			i ntiles_x / swap
			dup 8 % swap 8 /
			b_drawblock
		else
			pop
		end
		i 1 + "i" store
	i sz < end
	"e_boardblock" gstore

	io_pos_windowend pop 4 + 2 io_pos_windowstart add2 io_goto
	"Next block:" print
	ntiles_x 3 + 1
	e_peekblock dup 8 % swap 8 /
	b_drawblock

	e_cblockpos dup ntiles_x % swap ntiles_x /
	e_cblock dup 8 % swap 8 /
	dup4
	b_drawblock
	sleep_time sleep
	b_undrawblock
}

@defun "e_validcbp" { #args: cblock cblockpos (compares purely to e_boardfilled)
	dup ntiles_x % swap ntiles_x / "cbposy" store "cbposx" store
	dup 8 % swap 8 / b_getblock "bits" store
	1 "retval" store
	0 "y" store
	bits while
		0 "x" store
		x 4 < bits !! & while
			bits 1 & if
				cbposx x + 1 <
				cbposx x + ntiles_x 1 - > |
				cbposy y + ntiles_y 1 - > | if
					0 "retval" store
					0 "bits" store  #make the loops break
				else
					"e_boardfilled" swapoutvar
					ntiles_x cbposy y + * cbposx x + +
					arridx
					swap "e_boardfilled" gstore
					if
						0 "retval" store
						0 "bits" store  #make the loops break
					end
				end
			end
			bits 2 / "bits" store
			x 1 + "x" store
		x 4 < bits !! & end
		y 1 + "y" store
	bits end
	retval
}

@defun "e_applyblock" { #args: block blockpos
	dup "blockpos" store
	dup ntiles_x % swap ntiles_x / "blockposy" store "blockposx" store
	dup "block" store
	dup 8 % swap 8 / b_getblock "bits" store

	"e_boardblock" swapoutvar
	block blockpos arrset
	"e_boardblock" gstore

	"e_boardfilled" swapoutvar
	0 "y" store
	y 4 < bits !! & while
		0 "x" store
		x 4 < while
			bits 1 & if
				1 blockposy y + ntiles_x * blockposx x + + arrset
			end
			bits 2 / "bits" store
			x 1 + "x" store
		x 4 < end
		y 1 + "y" store
	y 4 < bits !! & end
	"e_boardfilled" gstore
}

@defun "e_runloop" {
	1 while
		e_fullrender
		e_cblockpos ntiles_x + #new cblockpos
		dup e_cblock swap e_validcbp if
			"e_cblockpos" gstore
		else
			pop
			e_cblock e_cblockpos e_applyblock
			e_newcblock
		end
	1 end
}