-
Notifications
You must be signed in to change notification settings - Fork 205
/
gl.factor
56 lines (42 loc) · 1.57 KB
/
gl.factor
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
! Copyright (C) 2006, 2007, 2008 Alex Chapman
! See https://factorcode.org/license.txt for BSD license.
USING: accessors arrays colors combinators kernel math opengl
opengl.gl sequences tetris.game tetris.piece ;
IN: tetris.gl
! OpenGL rendering for tetris
: draw-block ( block -- )
{ 1 1 } gl-fill-rect ;
: draw-piece-blocks ( piece -- )
piece-blocks [ draw-block ] each ;
: draw-piece ( piece -- )
dup tetromino>> color>> gl-color draw-piece-blocks ;
: draw-next-piece ( piece -- )
dup tetromino>> color>>
>rgba-components drop 0.2 <rgba> gl-color draw-piece-blocks ;
! TODO: move implementation specific stuff into tetris-board
: (draw-row) ( x y row -- )
overd nth [ gl-color 2array draw-block ] [ 2drop ] if* ;
: draw-row ( y row -- )
[ length <iota> swap ] keep [ (draw-row) ] 2curry each ;
: draw-board ( board -- )
rows>> [ swap draw-row ] each-index ;
: scale-board ( width height board -- )
[ width>> ] [ height>> ] bi swapd [ / ] dup 2bi* 1 glScalef ;
: set-background-color ( tetris -- )
dup running?>> [
paused?>> COLOR: light-gray COLOR: white ?
] [ drop COLOR: black ] if gl-color ;
: draw-background ( board -- )
[ 0 0 ] dip [ width>> ] [ height>> ] bi glRectf ;
: draw-tetris ( width height tetris -- )
! width and height are in pixels
[
{
[ board>> scale-board ]
[ set-background-color ]
[ board>> draw-background ]
[ board>> draw-board ]
[ next-piece draw-next-piece ]
[ current-piece draw-piece ]
} cleave
] do-matrix ;