Here is a 8th programming language version of my original version for Fortran. Uses grid layout for drawing.
\
\ Simple Tetris game for 8th programming language
\
needs[ nk/gui nk/keyboard nk/render-timed ]
18 font:system font:new "font1" font:atlas! drop
42 font:system font:new "font2" font:atlas! drop
\ Tetrominos, coords stored using [row,col] order.
[
{
coords: [
[[1,0],[1,1],[1,2],[1,3]],
[[0,1],[1,1],[2,1],[3,1]]
],
color: 1,
score: [5,8]
},
{
coords: [
[[0,0],[1,0],[0,1],[1,1]]
],
color: 2,
score: [6]
},
{ coords: [
[[0,1],[1,0],[1,1],[1,2]],
[[0,1],[1,1],[1,2],[2,1]],
[[1,0],[1,1],[1,2],[2,1]],
[[0,1],[1,0],[1,1],[2,1]]
],
color: 3,
score: [5,5,6,5]
},
{
coords: [
[[0,0],[0,1],[1,1],[1,2]],
[[0,1],[1,0],[1,1],[2,0]]
],
color: 4,
score: [6,7]
},
{
coords: [
[[0,1],[0,2],[1,0],[1,1]],
[[0,0],[1,0],[1,1],[2,1]]
],
color: 5,
score: [6,7]
},
{
coords: [
[[0,2],[1,0],[1,1],[1,2]],
[[0,0],[1,0],[2,0],[2,1]],
[[0,0],[0,1],[0,2],[1,0]],
[[0,0],[0,1],[1,1],[2,1]]
],
color: 6,
score: [6,7,6,7]
},
{
coords: [
[[0,0],[0,1],[0,2],[1,2]],
[[0,1],[1,1],[2,0],[2,1]],
[[0,0],[1,0],[1,1],[1,2]],
[[0,0],[0,1],[1,0],[2,0]]
],
color: 7,
score: [6,7,6,7]
}
] constant tetrominos
[ [255,255,255,255], [0,255,255,255], [255,255,0,255],
[255,0,255,255], [255,0,0,255], [0,255,0,255],
[255,127,0,255], [0,0,255,255] ] constant colors
[300, 250, 200, 150, 100, 80] constant delays
20 constant blocksize
3 constant startx
-4 constant starty
var grid
var score
var rows
var level
var delay
var gameover
var tetromino
var rotation
var next-tetromino
var next-rotation
var old-rotation
var drop-tetromino
var x
var y
: new-row
[0,0,0,0,0,0,0,0,0,0] const ;
: init-grid
null grid !
a:new ( new-row a:push ) 22 times grid ! ;
: random-tetromino
rand-pcg 7 n:mod ;
: random-rotation \ tetromino -- n
tetrominos swap a:_@ "coords" m:_@ a:len nip
rand-pcg swap n:mod ;
: init-game
false gameover !
init-grid
startx x !
starty y !
random-tetromino next-tetromino !
next-tetromino @ random-rotation next-rotation !
random-tetromino tetromino !
tetromino @ random-rotation rotation !
0 level !
0 score !
0 rows !
delays 0 a:_@ nk:timer-delay ;
: delete-rows
grid @
( dup>r a:@
0 ' n:= a:indexof nip
null? if
drop r@ a:-
new-row a:slide
1 rows n:+!
rows @ 10 n:/ n:int level !
level @ delays a:len nip n:< not if
delays a:len nip n:1- level !
then
delay @ delays level @ a:_@ dup delay !
n:= !if
delay @ nk:timer-delay
then
tetrominos tetromino @ a:_@ "score" m:_@ rotation @ a:_@ score n:+!
else
drop
then
rdrop ) 0 21 loop drop ;
[ @scan:LEFT, @scan:RIGHT, @scan:UP, @scan:DOWN, @scan:SPACE ] constant keys
: key-state-changed? \ s a -- a
nk:scancode?
' >n a:map over nk:get over ?:
rot third nk:set
' n:cmp a:2map ;
: key? \ -- n | null
null "keystates" keys key-state-changed?
(
swap a:pop -1 n:= if
rot drop break
else
nip
then
) 0 third a:len nip n:1- loop- drop ;
: new-win
{
name: "main",
wide: 320,
high: 448,
resizable: false,
bg: "white",
title: "Tetris"
} nk:win ;
: draw-grid
grid @
( swap dup rot ( dup>r 0 n:= !if
1 tuck nk:grid dup 0 colors r> a:_@ nk:fill-rect
0 2 "black" nk:stroke-rect
else
2drop rdrop
then dup ) a:each 3drop ) a:each drop ;
: store-tetromino
tetrominos tetromino @ a:_@ "coords" m:@ rotation @ a:_@
( 0 a:@ y @ n:+ dup 0 n:< !if
grid @ swap a:_@ swap 1 a:_@ x @ n:+
third "color" m:_@ a:! drop
else
2drop
then
) a:each! 2drop ;
: draw-tetromino
tetrominos tetromino @ a:_@ "coords" m:@ rotation @ a:_@
( y @ x @ 2 a:close ' n:+ a:2map
1 a:@ 0 9 n:between swap 0 a:@ 0 21 n:between rot and if
a:open 1 tuck nk:grid
dup>r 0 third "color" m:_@ colors swap a:_@ nk:fill-rect
r> 0 2 "black" nk:stroke-rect
else
drop
then
) a:each! 2drop ;
: can-move? \ [row,col] rot -- T
tetrominos tetromino @ a:_@ "coords" m:_@ swap a:_@
true swap
( third ' n:+ a:2map dup>r
1 a:@ 0 9 n:between swap 0 a:_@ -4 21 n:between and and dup !if
break
else
r@ 0 a:@ 0 n:< !if
grid @ swap a:open >r a:_@ r> a:_@ 0 n:= and dup !if
break
then
else
drop
then
then rdrop ) a:each! drop nip ;
: left-key
y @ x @ n:1- 2 a:close rotation @ can-move? if
-1 x n:+!
then ;
: right-key
y @ x @ n:1+ 2 a:close rotation @ can-move? if
1 x n:+!
then ;
: up-key
rotation @ dup old-rotation !
n:1+ tetrominos tetromino @ a:_@ "coords" m:_@ a:len nip n:mod rotation !
y @ x @ 2 a:close rotation @ can-move? !if
old-rotation @ rotation !
then ;
: down-key
repeat
y @ n:1+ x @ 2 a:close rotation @ can-move? if
1 y n:+!
else
break
then
again
store-tetromino
delete-rows
y @ 0 n:< if
true gameover !
else
startx x !
starty y !
next-tetromino @ tetromino !
next-rotation @ rotation !
random-tetromino next-tetromino !
next-tetromino @ random-rotation next-rotation !
then ;
: play-area
gameover @ !if
false drop-tetromino !
key? null? !if
[ ' left-key , ' right-key , ' up-key , ' down-key , ' down-key ] case
else
drop
then
nk:timer? drop-tetromino @ not and if
y @ n:1+ x @ 2 a:close rotation @ can-move? if
1 y n:+!
else
store-tetromino
delete-rows
y @ 0 n:< if
true gameover !
else
startx x !
starty y !
next-tetromino @ tetromino !
next-rotation @ rotation !
random-tetromino next-tetromino !
next-tetromino @ random-rotation next-rotation !
then
then
then
else
key? null? !if
init-game
then drop
then
nk:widget if
22 10 nk:layout-grid-begin
0 22 0 10 nk:grid 0 "lightgray" nk:fill-rect
0 22 0 10 nk:grid 0 1 "black" nk:stroke-rect
draw-grid
draw-tetromino
gameover @ if
0 22 0 10 nk:grid
"Game Over" "font2" nk:measure-font nk:pt>rect nk:center-rect
"Game Over" "font2" [255,255,255,128] "black"
nk:draw-text-centered
then
nk:layout-grid-end
then ;
locals:
: next-area
nk:widget if
4 "minx" w:!
0 "maxx" w:!
4 "miny" w:!
0 "maxy" w:!
tetrominos next-tetromino @ a:_@ "coords" m:_@ next-rotation @ a:_@
( 1 a:@ "maxx" w:@ n:max "maxx" w:!
1 a:@ "minx" w:@ n:min "minx" w:!
0 a:@ "maxy" w:@ n:max "maxy" w:!
0 a:_@ "miny" w:@ n:min "miny" w:!
) a:each! drop
4 "maxx" w:@ "minx" w:@ n:- n:- blocksize n:* 2 n:/ "minx" w:@ blocksize n:* n:- "x" w:!
4 "maxy" w:@ "miny" w:@ n:- n:- blocksize n:* 2 n:/ "miny" w:@ blocksize n:* n:- "y" w:!
0 nk:rect@ "x" w:@ n:+ "x" w:!
1 nk:rect@ "y" w:@ n:+ "y" w:!
dup 0 "lightgray" nk:fill-rect
0 1 "black" nk:stroke-rect
tetrominos next-tetromino @ a:_@ "coords" m:@ next-rotation @ a:_@
( a:open blocksize n:* "x" w:@ n:+ swap blocksize n:* "y" w:@ n:+
blocksize dup 4 a:close dup>r 0 third "color" m:_@ colors swap a:_@ nk:fill-rect
r> 0 2 "black" nk:stroke-rect ) a:each! 2drop
then ;
: score-area
nk:widget if
{ rows: 3, cols: 1, margin: 4 } nk:layout-grid-begin
0 1 0 1 nk:grid nk:rect>local nk:grid-push
score @ "Score: %d" s:strfmt nk:TEXT_LEFT "black" nk:label-colored
1 1 0 1 nk:grid nk:rect>local nk:grid-push
level @ "Level: %d" s:strfmt nk:TEXT_LEFT "black" nk:label-colored
2 1 0 1 nk:grid nk:rect>local nk:grid-push
rows @ "Rows: %d" s:strfmt nk:TEXT_LEFT "black" nk:label-colored
nk:layout-grid-end
then ;
: info-area
nk:widget if
{ rows: [100,80], cols:[100], rgap: 8 } nk:layout-grid-begin
0 1 0 1 nk:grid nk:rect>local nk:grid-push next-area
1 0 0 1 nk:grid nk:rect>local nk:grid-push score-area
nk:layout-grid-end
then ;
: main-render
{
bg: "darkgray",
padding: [0,0],
flags: [ @nk:WINDOW_NO_SCROLLBAR ]
}
nk:begin
null { rows: 1, cols: [204, 116], margin: 4, cgap: 4 } nk:layout-grid-begin
0 1 0 1 nk:grid nk:rect>local nk:grid-push play-area
0 1 1 1 nk:grid nk:rect>local nk:grid-push info-area
nk:layout-grid-end
nk:end ;
: app:main
null rand-pcg-seed
' init-game w:is nk:rendering
new-win ' main-render -1 nk:render-timed ;
