contrib/tetris/tetromino.factor

   1 ! Copyright (C) 2006 Alex Chapman
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel arrays namespaces sequences math tetris-colours ;
   4 IN: tetromino
   5
   6 TUPLE: tetromino states colour ;
   7
   8 SYMBOL: tetrominoes
   9
  10 {
  11   [
  12     { {
  13         { 0 0 } { 1 0 } { 2 0 } { 3 0 }
  14       }
  15       { { 0 0 }
  16         { 0 1 }
  17         { 0 2 }
  18         { 0 3 }
  19       }
  20     } cyan
  21   ] [
  22     {
  23       {         { 1 0 }
  24         { 0 1 } { 1 1 } { 2 1 }
  25       } {
  26         { 0 0 }
  27         { 0 1 } { 1 1 }
  28         { 0 2 }
  29       } {
  30         { 0 0 } { 1 0 } { 2 0 }
  31                 { 1 1 }
  32       } {
  33                 { 1 0 }
  34         { 0 1 } { 1 1 }
  35                 { 1 2 }
  36       }
  37     } purple
  38   ] [
  39     { { { 0 0 } { 1 0 }
  40         { 0 1 } { 1 1 } }
  41     } yellow
  42   ] [
  43     {
  44       { { 0 0 } { 1 0 } { 2 0 }
  45         { 0 1 }
  46       } {
  47         { 0 0 } { 1 0 }
  48                 { 1 1 }
  49                 { 1 2 }
  50       } {
  51                         { 2 0 }
  52         { 0 1 } { 1 1 } { 2 1 }
  53       } {
  54         { 0 0 }
  55         { 0 1 }
  56         { 0 2 } { 1 2 }
  57       }
  58     } orange
  59   ] [
  60     {
  61       { { 0 0 } { 1 0 } { 2 0 }
  62                         { 2 1 }
  63       } {
  64                 { 1 0 }
  65                 { 1 1 }
  66         { 0 2 } { 1 2 }
  67       } {
  68         { 0 0 }
  69         { 0 1 } { 1 1 } { 2 1 }
  70       } {
  71         { 0 0 } { 1 0 }
  72         { 0 1 }
  73         { 0 2 }
  74       }
  75     } blue
  76   ] [
  77     {
  78       {          { 1 0 } { 2 0 }
  79         { 0 1 } { 1 1 }
  80       } {
  81         { 0 0 }
  82         { 0 1 } { 1 1 }
  83                 { 1 2 }
  84       }
  85     } green
  86   ] [
  87     {
  88       {
  89         { 0 0 } { 1 0 }
  90                 { 1 1 } { 2 1 }
  91       } {
  92                 { 1 0 }
  93         { 0 1 } { 1 1 }
  94         { 0 2 }
  95       }
  96     } red
  97   ]
  98 } [ call <tetromino> ] map tetrominoes set-global
  99
 100 : random-tetromino ( -- tetromino )
 101   tetrominoes get dup length random-int swap nth ;
 102
 103 : blocks-max ( blocks quot -- max )
 104     ! add 1 to each block since they are 0 indexed
 105     ! [ 1+ ] append map 0 [ max ] reduce ;
 106     map [ 1+ ] map 0 [ max ] reduce ;
 107
 108 : blocks-width ( blocks -- width )
 109     [ first ] blocks-max ;
 110
 111 : blocks-height ( blocks -- height )
 112     [ second ] blocks-max ;
 113