Author Topic: 8th: Tetris game  (Read 54 times)

Offline jalih

  • Advocate
  • Posts: 24
8th: Tetris game
« on: March 08, 2019, 09:46:55 PM »
I wrote a Tetris game in 8th programming language.

Source and binaries for most operating systems available here.

Use cursor keys to control block movement and spacebar to drop the block.

Offline John

  • Forum Support / SB Dev
  • Posts: 2411
    • ScriptBasic Open Source Project
Re: 8th: Tetris game
« Reply #1 on: March 08, 2019, 11:19:18 PM »
Works on my Ubuntu 18.10 box.

Code: [Select]
\
\ 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 ! ;