extra/tetris/tetromino/tetromino.factor

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