Works on my Ubuntu 18.10 box.
\
\ Simple Tetris game written in 8th.
\
\ GUI needs work. Highscore list would be nice.
\
true app:isgui !
: BOARDWIDTH 10 ;
: BOARDHEIGHT 22 ;
: BLOCKWIDTH 20 ;
: BOARDX 20 ;
: BOARDY 40 ;
: NEXTSHAPEX 270 ;
: NEXTSHAPEY 50 ;
: STARTY -4 ;
\ possible game states
: TITLE 0 ;
: RUNGAME 1 ;
: PAUSED 2 ;
: GAMEOVER 3 ;
"title.jpg" app:asset img:new var, titleimg
var gamestate
var hide-next
var delay
[30, 25, 20, 15, 10, 8] var, delays
{
"cursor up" : false,
"cursor down" : false,
"cursor left" : false,
"cursor right" : false,
"spacebar" : false,
"P" : false
} var, keys
: reset-keys
keys @
"cursor up" false m:!
"cursor down" false m:!
"cursor left" false m:!
"cursor right" false m:!
"spacebar" false m:!
"P" false m:!
drop ;
: onkey
drop
g:keyinfo nip "desc" m:@ nip
dup
keys @ swap m:exists?
if
swap true m:! drop
else
2drop
then
true ;
["black","red","orange","yellow","green","blue","cyan","violet"] var, colors
[
\ ####
{
"coords" : [
[ { "x" : 0, "y" : 1 }, { "x" : 1, "y" : 1 }, { "x" : 2, "y" : 1 }, { "x" : 3, "y" : 1 } ],
[ { "x" : 1, "y" : 0 }, { "x" : 1, "y" : 1 }, { "x" : 1, "y" : 2 }, { "x" : 1, "y" : 3 } ] ],
"points" : [ 5, 2 ],
"color" : "red"
},
\ ##
\ ##
{
"coords" : [
[ { "x" : 0, "y" : 0 }, { "x" : 0, "y" : 1 }, { "x" : 1, "y" : 0 }, { "x" : 1, "y" : 1 } ] ],
"points" : [ 6 ],
"color" : "orange"
},
\ #
\ ##
\ #
{
"coords" : [
[ { "x" : 1, "y" : 0 }, { "x" : 0, "y" : 1 }, { "x" : 1, "y" : 1 }, { "x" : 2, "y" : 1 } ],
[ { "x" : 1, "y" : 0 }, { "x" : 1, "y" : 1 }, { "x" : 2, "y" : 1 }, { "x" : 1, "y" : 2 } ],
[ { "x" : 0, "y" : 1 }, { "x" : 1, "y" : 1 }, { "x" : 2, "y" : 1 }, { "x" : 1, "y" : 2 } ],
[ { "x" : 1, "y" : 0 }, { "x" : 0, "y" : 1 }, { "x" : 1, "y" : 1 }, { "x" : 1, "y" : 2 } ] ],
"points" : [ 5, 5, 6, 5 ],
"color" : "yellow"
},
\ ##
\ ##
{
"coords" : [
[ { "x" : 0, "y" : 0 }, { "x" : 1, "y" : 0 }, { "x" : 1, "y" : 1 }, { "x" : 2, "y" : 1 } ],
[ { "x" : 1, "y" : 0 }, { "x" : 0, "y" : 1 }, { "x" : 1, "y" : 1 }, { "x" : 0, "y" : 2 } ] ],
"points" : [ 6, 7 ],
"color" : "green"
},
\ ##
\ ##
{
"coords" : [
[ { "x" : 1, "y" : 0 }, { "x" : 2, "y" : 0 }, { "x" : 0, "y" : 1 }, { "x" : 1, "y" : 1 } ],
[ { "x" : 0, "y" : 0 }, { "x" : 0, "y" : 1 }, { "x" : 1, "y" : 1 }, { "x" : 1, "y" : 2 } ] ],
"points" : [ 6, 7 ],
"color" : "blue"
},
\ ###
\ #
{
"coords" : [
[ { "x" : 2, "y" : 0 }, { "x" : 0, "y" : 1 }, { "x" : 1, "y" : 1 }, { "x" : 2, "y" : 1 } ],
[ { "x" : 0, "y" : 0 }, { "x" : 0, "y" : 1 }, { "x" : 0, "y" : 2 }, { "x" : 1, "y" : 2 } ],
[ { "x" : 0, "y" : 0 }, { "x" : 1, "y" : 0 }, { "x" : 2, "y" : 0 }, { "x" : 0, "y" : 1 } ],
[ { "x" : 0, "y" : 0 }, { "x" : 1, "y" : 0 }, { "x" : 1, "y" : 1 }, { "x" : 1, "y" : 2 } ] ],
"points" : [ 6, 7, 6, 7 ],
"color" : "cyan"
},
\ #
\ ###
{
"coords" : [
[ { "x" : 0, "y" : 0 }, { "x" : 1, "y" : 0 }, { "x" : 2, "y" : 0 }, { "x" : 2, "y" : 1 } ],
[ { "x" : 1, "y" : 0 }, { "x" : 1, "y" : 1 }, { "x" : 0, "y" : 2 }, { "x" : 1, "y" : 2 } ],
[ { "x" : 0, "y" : 0 }, { "x" : 0, "y" : 1 }, { "x" : 1, "y" : 1 }, { "x" : 2, "y" : 1 } ],
[ { "x" : 0, "y" : 0 }, { "x" : 1, "y" : 0 }, { "x" : 0, "y" : 1 }, { "x" : 0, "y" : 2 } ] ],
"points" : [ 6, 7, 6, 7 ],
"color" : "violet"
}
] var, shapes
var board
var shape
var x
var y
var rotation
var oldx
var oldy
var oldrotation
var nextshape
var nextx
var nextrotation
var score
var rows
var level
: init-board
[
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0],
[0,0,0,0,0,0,0,0,0,0]
] const board ! ;
: new-row
[0,0,0,0,0,0,0,0,0,0] const ;
: delete-rows
(
>r board @ r@ a:@
0 ' n:= a:indexof nip
null? if
drop
r@ a:-
new-row a:slide
drop
rows @ n:1+ rows !
else
2drop
then
rdrop
) 0 BOARDHEIGHT n:1- loop ;
: canmove
true >r
shape @ "coords" m:@ nip
rotation @ a:@ nip
(
nip
"x" m:@ x @ n:+ dup 0 n:<
swap 10 n:< not or
swap
"y" m:@ y @ n:+ 22 n:< not rot or
if drop break else
board @ swap
"y" m:@
y @ n:+
dup
0 n:< if
2drop drop
else
swap >r
a:@ nip
r> "x" m:@ nip
x @ n:+
a:@ nip
0 n:= not if break then
then
then
break? if false rdrop >r then
) a:each
drop
r> ;
: rand7 rand-pcg n:abs 7 n:mod ;
: next-shape
shapes @ rand7 a:@ nip dup nextshape !
"coords" m:@ nip a:len nip
rand-pcg n:abs swap n:mod nextrotation !
rand7 nextx ! ;
: draw-board
2 g:line-width
"black" g:scolor
board @
(
swap
BLOCKWIDTH n:* BOARDY n:+
>r
(
>r
rswap
BLOCKWIDTH n:* BOARDX n:+
r@
rswap
BLOCKWIDTH
BLOCKWIDTH
g:rect
colors @ r> caseof g:fcolor
g:stroke-fill
) a:each
drop
rdrop
) a:each
drop ;
: draw-shape
2 g:line-width
"black" g:scolor
>r
shape @ "color" m:@ r> swap g:fcolor swap
"coords" m:@ nip rotation @ a:@ nip
(
nip "y" m:@ y @ n:+ BLOCKWIDTH n:* BOARDY n:+ dup
BOARDY n:< not if
swap
"x" m:@ nip x @ n:+ BLOCKWIDTH n:* BOARDX n:+
swap
BLOCKWIDTH
BLOCKWIDTH
g:rect
else
2drop
then
) a:each
drop
g:stroke-fill ;
locals:
: draw-nextshape
4 "min-x" w:!
4 "min-y" w:!
0 "max-x" w:!
0 "max-y" w:!
nextshape @ "coords" m:@ nip nextrotation @ a:@ nip
(
nip
"x" m:@ dup "max-x" w:@ n:max "max-x" w:!
"min-x" w:@ n:min "min-x" w:!
"y" m:@ dup "min-y" w:@ n:max "min-y" w:!
"min-y" w:@ n:min "min-y" w:! drop
) a:each
drop
4 "max-x" w:@ "min-x" w:@ n:- n:1+ n:- BLOCKWIDTH n:* 2 n:/ "min-x" w:@ BLOCKWIDTH n:* n:- "o-x" w:!
4 "max-y" w:@ "min-y" w:@ n:- n:1+ n:- BLOCKWIDTH n:* 2 n:/ "min-y" w:@ BLOCKWIDTH n:* n:- "o-y" w:!
2 g:line-width
"black" g:scolor
"darkgray" g:fcolor
NEXTSHAPEX 5 n:- NEXTSHAPEY 5 n:- BLOCKWIDTH 4 n:* 10 n:+ dup g:rect
g:stroke-fill
hide-next @ not y @ -1 n:< not or if
>r
nextshape @ "color" m:@ r> swap g:fcolor swap
"coords" m:@ nip nextrotation @ a:@ nip
(
nip "x" m:@ BLOCKWIDTH n:* NEXTSHAPEX n:+ "o-x" w:@ n:+ swap
"y" m:@ nip BLOCKWIDTH n:* NEXTSHAPEY n:+ "o-y" w:@ n:+
BLOCKWIDTH
BLOCKWIDTH
g:rect
) a:each
drop
then
g:stroke-fill ;
: draw-title
draw-board
2 g:line-width
"black" g:scolor
"darkgray" g:fcolor
NEXTSHAPEX 5 n:- NEXTSHAPEY 5 n:- BLOCKWIDTH 4 n:* 10 n:+ dup g:rect
g:stroke-fill
"20" g:setfont
g:l-text
NEXTSHAPEX 8 n:- 160 "NEXT PIECE" g:draw-text-at
NEXTSHAPEX 30 n:- 200 score @ "score: %d" s:strfmt g:draw-text-at
NEXTSHAPEX 30 n:- 220 level @ "level: %d" s:strfmt g:draw-text-at
titleimg @ BOARDX BOARDY g:image-at ;
: draw-rungame
draw-board
draw-shape
draw-nextshape
"20" g:setfont
g:l-text
NEXTSHAPEX 8 n:- 160 "NEXT PIECE" g:draw-text-at
NEXTSHAPEX 30 n:- 200 score @ "score: %d" s:strfmt g:draw-text-at
NEXTSHAPEX 30 n:- 220 level @ "level: %d" s:strfmt g:draw-text-at ;
: draw-gameover
draw-board
draw-shape
draw-nextshape
"20" g:setfont
g:l-text
NEXTSHAPEX 8 n:- 160 "NEXT PIECE" g:draw-text-at
NEXTSHAPEX 30 n:- 200 score @ "score: %d" s:strfmt g:draw-text-at
NEXTSHAPEX 30 n:- 220 level @ "level: %d" s:strfmt g:draw-text-at
"50" g:setfont
"white" g:scolor
g:c-text
200 250 "GAME OVER!" g:draw-text-at ;
: draw-paused
draw-board
draw-shape
draw-nextshape
"20" g:setfont
g:l-text
NEXTSHAPEX 8 n:- 160 "NEXT PIECE" g:draw-text-at
NEXTSHAPEX 30 n:- 200 score @ "score: %d" s:strfmt g:draw-text-at
NEXTSHAPEX 30 n:- 220 level @ "level: %d" s:strfmt g:draw-text-at
"50" g:setfont
"white" g:scolor
g:c-text
200 250 "PAUSED!" g:draw-text-at ;
: ondraw
[ ' draw-title , ' draw-rungame , ' draw-paused , ' draw-gameover ]
gamestate @ caseof ;
: init-game
0 score !
1 level !
0 rows !
next-shape
nextshape @ shape !
nextrotation @ rotation !
nextx @ x !
STARTY y !
next-shape
delays @ 0 a:@ nip delay !
init-board
hide-next on
RUNGAME gamestate !
reset-keys ;
: points?
shape @ "points" m:@ nip rotation @ a:@ nip ;
: shape-color?
shape @ "color" m:@ nip
colors @ swap
' s:= a:indexof nip ;
: store-block \ pointmap
"y" m:@ y @ n:+
dup 0 n:< if
2drop
else
board @ swap a:@ nip
swap
"x" m:@ nip x @ n:+
shape-color? a:!
drop
then ;
: gameloop
keys @
"P"
m:@ if
reset-keys
PAUSED gamestate !
then
"cursor up"
m:@ if
"cursor up" false m:!
rotation @ dup oldrotation ! n:1+ dup rotation !
shape @ "coords" m:@ nip a:len n:1- nip
n:> if 0 rotation ! then
canmove not if oldrotation @ rotation ! then
then
"cursor left"
m:@ if
"cursor left" false m:!
x @ dup oldx ! n:1- x !
canmove not if oldx @ x ! then
then
"cursor right"
m:@ if
"cursor right" false m:!
x @ dup oldx ! n:1+ x !
canmove not if oldx @ x ! then
then
"spacebar" \ block is dropped
m:@ if
"spacebar" false m:!
repeat
y @ n:1+ y !
canmove
not if break then
again
y @ n:1-
y !
shape @ "coords" m:@ nip
rotation @ a:@ nip
(
nip
store-block
) a:each
drop
score @ points? n:+ score !
delete-rows
y @ 0 n:< if
GAMEOVER gamestate !
else
nextshape @ shape !
nextrotation @ rotation !
nextx @ x !
STARTY y !
next-shape
hide-next on
then
else \ block falls or down cursor pressed
"cursor down" m:@
delay @ n:1- dup delay !
0 n:> not or if
"cursor down" false m:!
y @ dup oldy ! n:1+ y !
canmove not if
oldy @ y !
shape @ "coords" m:@ nip
rotation @ a:@ nip
(
nip
store-block
) a:each
drop
score @ points? n:+ score !
delete-rows
y @ 0 n:< if
GAMEOVER gamestate !
else
nextshape @ shape !
nextrotation @ rotation !
nextx @ x !
STARTY y !
next-shape
hide-next off
then
else
rows @ 10 n:/ int n:1+ dup level !
0 5 n:clamp n:1-
delays @ swap a:@ nip delay !
then
then
then
drop ;
: pause
keys @
"P"
m:@ if
reset-keys
RUNGAME gamestate !
then
drop ;
: ontimer
[ ' noop , ' gameloop , ' pause , ' noop ]
gamestate @ caseof
g:invalidate ;
: onMenuSelected
n:1- [ ' init-game , ' g:quit ] case ;
var gui
{
kind: "win",
buttons: 5,
title: "Tetris clone v. 0.1",
wide: 400,
high: 500,
resizable: false,
center: true,
bg: "gray",
font: "Arial 10",
draw: "ondraw",
timer: "ontimer",
key-pressed: "onkey",
timer-period: 20,
children:
[
{
kind: "menubar",
name: "menu",
bounds: "0,0,parent.width, parent.height/20",
menu-selected: "onMenuSelected",
menu:
[
[
"Game", 0,
"New game", 1,
"Quit", 2
]
]
}
]
} var, gui-desc
: app:main
init-game
TITLE gamestate !
gui-desc @ g:new gui ! ;
