Various load-everything fixes

db4
Slava Pestov 2009-03-07 01:22:21 -06:00
parent c2a0613929
commit 375c5e69b5
140 changed files with 70 additions and 361 deletions

View File

@ -42,7 +42,7 @@ MACRO: all-enabled ( seq quot -- )
[ words>values ] dip '[ _ _ (all-enabled) ] ;
MACRO: all-enabled-client-state ( seq quot -- )
[ words>values ] dip '[ _ (all-enabled-client-state) ] ;
[ words>values ] dip '[ _ _ (all-enabled-client-state) ] ;
: do-matrix ( mode quot -- )
swap [ glMatrixMode glPushMatrix call ] keep

View File

@ -288,7 +288,7 @@ M: vocab-tag article-name name>> ;
M: vocab-tag article-content
\ $tagged-vocabs swap name>> 2array ;
M: vocab-tag article-parent drop "vocab-index" ;
M: vocab-tag article-parent drop "vocab-tags" ;
M: vocab-tag summary article-title ;
@ -302,6 +302,6 @@ M: vocab-author article-name name>> ;
M: vocab-author article-content
\ $authored-vocabs swap name>> 2array ;
M: vocab-author article-parent drop "vocab-index" ;
M: vocab-author article-parent drop "vocab-authors" ;
M: vocab-author summary article-title ;

View File

@ -1,14 +1,14 @@
! Copyright (C) 2007 Slava Pestov.
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ui.backend ui.gadgets
ui.gadgets.worlds ui.render opengl opengl.gl kernel namespaces
classes.tuple colors accessors ;
USING: ui.backend ui.gadgets ui.gadgets.worlds ui.pens.solid opengl
opengl.gl kernel namespaces classes.tuple colors colors.constants
accessors ;
IN: ui.gadgets.canvas
TUPLE: canvas < gadget dlist ;
: new-canvas ( class -- canvas )
new black <solid> >>interior ; inline
new COLOR: black <solid> >>interior ; inline
: delete-canvas-dlist ( canvas -- )
[ find-gl-context ]
@ -23,8 +23,6 @@ TUPLE: canvas < gadget dlist ;
[ 2nip ] [ drop make-canvas-dlist ] if ; inline
: draw-canvas ( canvas quot -- )
origin get [
cache-canvas-dlist glCallList
] with-translation ; inline
cache-canvas-dlist glCallList ; inline
M: canvas ungraft* delete-canvas-dlist ;

View File

@ -1,5 +1,5 @@
USING: colors help.markup help.syntax ui.pens ;
IN: ui.pens.polygon
USING: help.markup help.syntax ;
HELP: polygon
{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid filled polygon, respectively. Instances of " { $link polygon } " have two slots:"

View File

@ -1,6 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ;
USING: accessors colors help.markup help.syntax kernel opengl
opengl.gl sequences specialized-arrays.float ui.pens ;
IN: ui.pens.polygon
! Polygon pen

View File

@ -1 +0,0 @@
Windows UI backend

View File

@ -1 +0,0 @@
X11 UI backend

View File

@ -1,297 +0,0 @@
! Copyright (C) 2005, 2008 Eduardo Cavazos and Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays ui ui.gadgets
ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
ui.event-loop assocs kernel math namespaces opengl sequences
strings x11.xlib x11.events x11.xim x11.glx x11.clipboard
x11.constants x11.windows io.encodings.string io.encodings.ascii
io.encodings.utf8 combinators combinators.short-circuit command-line
math.vectors classes.tuple opengl.gl threads math.geometry.rect
environment ascii ;
IN: ui.x11
SINGLETON: x11-ui-backend
: XA_NET_WM_NAME ( -- atom ) "_NET_WM_NAME" x-atom ;
TUPLE: x11-handle-base glx ;
TUPLE: x11-handle < x11-handle-base xic window ;
TUPLE: x11-pixmap-handle < x11-handle-base pixmap glx-pixmap ;
C: <x11-handle> x11-handle
C: <x11-pixmap-handle> x11-pixmap-handle
M: world expose-event nip relayout ;
M: world configure-event
over configured-loc >>window-loc
swap configured-dim >>dim
! In case dimensions didn't change
relayout-1 ;
CONSTANT: modifiers
{
{ S+ HEX: 1 }
{ C+ HEX: 4 }
{ A+ HEX: 8 }
}
CONSTANT: key-codes
H{
{ HEX: FF08 "BACKSPACE" }
{ HEX: FF09 "TAB" }
{ HEX: FF0D "RET" }
{ HEX: FF8D "ENTER" }
{ HEX: FF1B "ESC" }
{ HEX: FFFF "DELETE" }
{ HEX: FF50 "HOME" }
{ HEX: FF51 "LEFT" }
{ HEX: FF52 "UP" }
{ HEX: FF53 "RIGHT" }
{ HEX: FF54 "DOWN" }
{ HEX: FF55 "PAGE_UP" }
{ HEX: FF56 "PAGE_DOWN" }
{ HEX: FF57 "END" }
{ HEX: FF58 "BEGIN" }
{ HEX: FFBE "F1" }
{ HEX: FFBF "F2" }
{ HEX: FFC0 "F3" }
{ HEX: FFC1 "F4" }
{ HEX: FFC2 "F5" }
{ HEX: FFC3 "F6" }
{ HEX: FFC4 "F7" }
{ HEX: FFC5 "F8" }
{ HEX: FFC6 "F9" }
}
: key-code ( keysym -- keycode action? )
dup key-codes at [ t ] [ 1string f ] ?if ;
: event-modifiers ( event -- seq )
XKeyEvent-state modifiers modifier ;
: valid-input? ( string gesture -- ? )
over empty? [ 2drop f ] [
mods>> { f { S+ } } member? [
[ { [ 127 = not ] [ CHAR: \s >= ] } 1&& ] all?
] [
[ { [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] } 1&& ] all?
] if
] if ;
: key-down-event>gesture ( event world -- string gesture )
dupd
handle>> xic>> lookup-string
[ swap event-modifiers ] dip key-code <key-down> ;
M: world key-down-event
[ key-down-event>gesture ] keep
[ propagate-key-gesture drop ]
[ 2over valid-input? [ nip user-input ] [ 3drop ] if ]
3bi ;
: key-up-event>gesture ( event -- gesture )
dup event-modifiers swap 0 XLookupKeysym key-code <key-up> ;
M: world key-up-event
[ key-up-event>gesture ] dip propagate-key-gesture ;
: mouse-event>gesture ( event -- modifiers button loc )
[ event-modifiers ]
[ XButtonEvent-button ]
[ mouse-event-loc ]
tri ;
M: world button-down-event
[ mouse-event>gesture [ <button-down> ] dip ] dip
send-button-down ;
M: world button-up-event
[ mouse-event>gesture [ <button-up> ] dip ] dip
send-button-up ;
: mouse-event>scroll-direction ( event -- pair )
XButtonEvent-button {
{ 4 { 0 -1 } }
{ 5 { 0 1 } }
{ 6 { -1 0 } }
{ 7 { 1 0 } }
} at ;
M: world wheel-event
[ [ mouse-event>scroll-direction ] [ mouse-event-loc ] bi ] dip
send-wheel ;
M: world enter-event motion-event ;
M: world leave-event 2drop forget-rollover ;
M: world motion-event
[ [ XMotionEvent-x ] [ XMotionEvent-y ] bi 2array ] dip
move-hand fire-motion ;
M: world focus-in-event
nip
dup handle>> xic>> XSetICFocus focus-world ;
M: world focus-out-event
nip
dup handle>> xic>> XUnsetICFocus unfocus-world ;
M: world selection-notify-event
[ handle>> window>> selection-from-event ] keep
user-input ;
: supported-type? ( atom -- ? )
{ "UTF8_STRING" "STRING" "TEXT" }
[ x-atom = ] with any? ;
: clipboard-for-atom ( atom -- clipboard )
{
{ XA_PRIMARY [ selection get ] }
{ XA_CLIPBOARD [ clipboard get ] }
[ drop <clipboard> ]
} case ;
: encode-clipboard ( string type -- bytes )
XSelectionRequestEvent-target
XA_UTF8_STRING = utf8 ascii ? encode ;
: set-selection-prop ( evt -- )
dpy get swap
[ XSelectionRequestEvent-requestor ] keep
[ XSelectionRequestEvent-property ] keep
[ XSelectionRequestEvent-target ] keep
[ 8 PropModeReplace ] dip
[
XSelectionRequestEvent-selection
clipboard-for-atom contents>>
] keep encode-clipboard dup length XChangeProperty drop ;
M: world selection-request-event
drop dup XSelectionRequestEvent-target {
{ [ dup supported-type? ] [ drop dup set-selection-prop send-notify-success ] }
{ [ dup "TARGETS" x-atom = ] [ drop dup set-targets-prop send-notify-success ] }
{ [ dup "TIMESTAMP" x-atom = ] [ drop dup set-timestamp-prop send-notify-success ] }
[ drop send-notify-failure ]
} cond ;
M: x11-ui-backend (close-window) ( handle -- )
dup xic>> XDestroyIC
dup glx>> destroy-glx
window>> dup unregister-window
destroy-window ;
M: world client-event
swap close-box? [ ungraft ] [ drop ] if ;
: gadget-window ( world -- )
dup window-loc>> over rect-dim glx-window
over "Factor" create-xic rot <x11-handle>
2dup window>> register-window
>>handle drop ;
: wait-event ( -- event )
QueuedAfterFlush events-queued 0 > [
next-event dup
None XFilterEvent zero? [ drop wait-event ] unless
] [
ui-wait wait-event
] if ;
M: x11-ui-backend do-events
wait-event dup XAnyEvent-window window dup
[ handle-event ] [ 2drop ] if ;
: x-clipboard@ ( gadget clipboard -- prop win )
atom>> swap
find-world handle>> window>> ;
M: x-clipboard copy-clipboard
[ x-clipboard@ own-selection ] keep
(>>contents) ;
M: x-clipboard paste-clipboard
[ find-world handle>> window>> ] dip atom>> convert-selection ;
: init-clipboard ( -- )
XA_PRIMARY <x-clipboard> selection set-global
XA_CLIPBOARD <x-clipboard> clipboard set-global ;
: set-title-old ( dpy window string -- )
dup [ 127 <= ] all? [ XStoreName drop ] [ 3drop ] if ;
: set-title-new ( dpy window string -- )
[ XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace ] dip
utf8 encode dup length XChangeProperty drop ;
M: x11-ui-backend set-title ( string world -- )
handle>> window>> swap
[ dpy get ] 2dip [ set-title-old ] [ set-title-new ] 3bi ;
M: x11-ui-backend set-fullscreen* ( ? world -- )
handle>> window>> "XClientMessageEvent" <c-object>
tuck set-XClientMessageEvent-window
swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
over set-XClientMessageEvent-data0
ClientMessage over set-XClientMessageEvent-type
dpy get over set-XClientMessageEvent-display
"_NET_WM_STATE" x-atom over set-XClientMessageEvent-message_type
32 over set-XClientMessageEvent-format
"_NET_WM_STATE_FULLSCREEN" x-atom over set-XClientMessageEvent-data1
[ dpy get root get 0 SubstructureNotifyMask ] dip XSendEvent drop ;
M: x11-ui-backend (open-window) ( world -- )
dup gadget-window
handle>> window>> dup set-closable map-window ;
M: x11-ui-backend raise-window* ( world -- )
handle>> [
dpy get swap window>> XRaiseWindow drop
] when* ;
M: x11-handle select-gl-context ( handle -- )
dpy get swap
[ window>> ] [ glx>> ] bi glXMakeCurrent
[ "Failed to set current GLX context" throw ] unless ;
M: x11-handle flush-gl-context ( handle -- )
dpy get swap window>> glXSwapBuffers ;
M: x11-pixmap-handle select-gl-context ( handle -- )
dpy get swap
[ glx-pixmap>> ] [ glx>> ] bi glXMakeCurrent
[ "Failed to set current GLX context" throw ] unless ;
M: x11-pixmap-handle flush-gl-context ( handle -- )
drop ;
M: x11-ui-backend (open-offscreen-buffer) ( world -- )
dup dim>> glx-pixmap <x11-pixmap-handle> >>handle drop ;
M: x11-ui-backend (close-offscreen-buffer) ( handle -- )
dpy get swap
[ glx-pixmap>> glXDestroyGLXPixmap ]
[ pixmap>> XFreePixmap drop ]
[ glx>> glXDestroyContext ] 2tri ;
M: x11-ui-backend offscreen-pixels ( world -- alien w h )
[ [ dim>> ] [ handle>> pixmap>> ] bi pixmap-bits ] [ dim>> first2 ] bi ;
M: x11-ui-backend ui ( -- )
[
f [
[
init-clipboard
start-ui
event-loop
] with-xim
] with-x
] ui-running ;
M: x11-ui-backend beep ( -- )
dpy get 100 XBell drop ;
x11-ui-backend ui-backend set-global
[ "DISPLAY" os-env "ui" "listener" ? ]
main-vocab-hook set-global

View File

@ -1,6 +1,7 @@
! (c)2009 Joe Groff, Doug Coleman. see BSD license
USING: accessors combinators.short-circuit definitions functors
kernel lexer namespaces parser prettyprint sequences words ;
kernel lexer namespaces parser prettyprint tools.crossref
sequences words ;
IN: annotations
<<

View File

@ -1,6 +1,6 @@
USING: arrays bunny.model bunny.cel-shaded continuations
destructors kernel math multiline opengl opengl.shaders
opengl.framebuffers opengl.gl opengl.demo-support fry
opengl.framebuffers opengl.gl opengl.textures opengl.demo-support fry
opengl.capabilities sequences ui.gadgets combinators accessors
macros locals ;
IN: bunny.outlined

View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions math.parser models
models.arrow models.range models.product sequences ui
ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs
ui.gadgets.sliders ui.render math.rectangles accessors
ui.gadgets ui.gadgets.tracks ui.gadgets.labels ui.gadgets.packs
ui.gadgets.sliders ui.pens.solid ui.render math.rectangles accessors
ui.gadgets.grids colors ;
IN: color-picker
@ -12,7 +12,7 @@ IN: color-picker
TUPLE: color-preview < gadget ;
: <color-preview> ( model -- gadget )
color-preview new-gadget
color-preview new
swap >>model
{ 100 100 } >>dim ;
@ -32,16 +32,16 @@ M: color-preview model-changed
bi ;
: <color-picker> ( -- gadget )
<frame>
vertical <track>
{ 5 5 } >>gap
<color-sliders>
[ @top grid-add ]
[ f track-add ]
[
[ <color-model> <color-preview> @center grid-add ]
[ <color-model> <color-preview> 1 track-add ]
[
[ [ truncate number>string ] map " " join ]
<arrow> <label-control>
@bottom grid-add
f track-add
] bi
] bi* ;

View File

@ -10,7 +10,7 @@ IN: demos
: demo-vocabs ( -- seq ) "demos" tagged [ second ] map concat [ name>> ] map ;
: <run-vocab-button> ( vocab-name -- button )
dup '[ drop [ _ run ] call-listener ] <bevel-button> { 0 0 } >>align ;
dup '[ drop [ _ run ] call-listener ] <border-button> ;
: <demo-runner> ( -- gadget )
<pile> 1 >>fill demo-vocabs [ <run-vocab-button> add-gadget ] each ;

View File

@ -0,0 +1,7 @@
IN: game-input.tests
USING: game-input tools.test kernel system ;
os windows? os macosx? or [
[ ] [ open-game-input ] unit-test
[ ] [ close-game-input ] unit-test
] when

View File

@ -19,7 +19,7 @@ M: image-gadget draw-gadget* ( gadget -- )
image>> draw-image ;
: <image-gadget> ( image -- gadget )
\ image-gadget new-gadget
\ image-gadget new
swap >>image ;
: image-window ( path -- gadget )

View File

@ -1,7 +1,7 @@
USING: ui ui.gadgets sequences kernel arrays math colors
ui.render math.vectors accessors fry ui.gadgets.packs game-input
ui.gadgets.labels ui.gadgets.borders alarms
calendar locals strings ui.gadgets.buttons
colors.constants ui.render ui.pens.polygon ui.pens.solid math.vectors
accessors fry ui.gadgets.packs game-input ui.gadgets.labels
ui.gadgets.borders alarms calendar locals strings ui.gadgets.buttons
combinators math.parser assocs threads ;
IN: joystick-demo
@ -56,11 +56,11 @@ CONSTANT: pov-polygons
[ z-indicator>> (>>loc) ] 2bi* ;
: move-pov ( gadget pov -- )
swap pov>> [ interior>> -rot = [ gray ] [ white ] if >>color drop ]
swap pov>> [ interior>> -rot = COLOR: gray COLOR: white ? >>color drop ]
with assoc-each ;
:: add-pov-gadget ( gadget direction polygon -- gadget direction gadget )
gadget white polygon <polygon-gadget> [ add-gadget ] keep
gadget COLOR: white polygon <polygon-gadget> [ add-gadget ] keep
direction swap ;
: add-pov-gadgets ( gadget -- gadget )
@ -69,14 +69,14 @@ CONSTANT: pov-polygons
: <axis-gadget> ( -- gadget )
axis-gadget new
add-pov-gadgets
black <indicator-gadget> [ >>z-indicator ] [ add-gadget ] bi
red <indicator-gadget> [ >>indicator ] [ add-gadget ] bi
COLOR: black <indicator-gadget> [ >>z-indicator ] [ add-gadget ] bi
COLOR: red <indicator-gadget> [ >>indicator ] [ add-gadget ] bi
dup [ 0.0 0.0 0.0 move-axis ] [ f move-pov ] bi ;
TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
: add-gadget-with-border ( parent child -- parent )
{ 2 2 } <border> gray <solid> >>boundary add-gadget ;
{ 2 2 } <border> COLOR: gray <solid> >>boundary add-gadget ;
: add-controller-label ( gadget controller -- gadget )
[ >>controller ] [ product-string <label> add-gadget ] bi ;
@ -89,7 +89,7 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
:: (add-button-gadgets) ( gadget shelf -- )
gadget controller>> read-controller buttons>> length [
number>string [ ] <bevel-button>
number>string [ drop ] <border-button>
shelf over add-gadget drop
] map gadget (>>buttons) ;
@ -107,7 +107,7 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
[ >>selected? drop ] 2each ;
: kill-update-axes ( gadget -- )
gray <solid> >>interior
COLOR: gray <solid> >>interior
[ [ cancel-alarm ] when* f ] change-alarm
relayout-1 ;

View File

@ -139,7 +139,7 @@ TUPLE: key-caps-gadget < gadget keys alarm ;
: make-key-gadget ( scancode dim array -- )
[
swap [
" " [ drop ] <bevel-button>
" " [ drop ] <border-button>
swap [ first >>loc ] [ second >>dim ] bi
] [ execute ] bi*
] dip set-nth ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors sequences kernel math io calendar grouping
calendar.format calendar.model arrays models models.arrow
namespaces ui.gadgets ui.gadgets.labels ui.gadgets.theme ui ;
calendar.format calendar.model fonts arrays models models.arrow
namespaces ui.gadgets ui.gadgets.labels ui ;
IN: lcd
: lcd-digit ( row digit -- str )

View File

@ -1,7 +1,7 @@
! From http://www.ffconsultancy.com/ocaml/maze/index.html
USING: sequences namespaces math math.vectors opengl opengl.gl
arrays kernel random ui ui.gadgets ui.gadgets.canvas ui.render
math.order math.rectangles ;
math.order math.rectangles accessors ;
IN: maze
CONSTANT: line-width 8

View File

@ -5,10 +5,10 @@ IN: nehe
: nehe-window ( -- )
[
<filled-pile>
"Nehe 2" [ drop run2 ] <bevel-button> add-gadget
"Nehe 3" [ drop run3 ] <bevel-button> add-gadget
"Nehe 4" [ drop run4 ] <bevel-button> add-gadget
"Nehe 5" [ drop run5 ] <bevel-button> add-gadget
"Nehe 2" [ drop run2 ] <border-button> add-gadget
"Nehe 3" [ drop run3 ] <border-button> add-gadget
"Nehe 4" [ drop run4 ] <border-button> add-gadget
"Nehe 5" [ drop run5 ] <border-button> add-gadget
"Nehe examples" open-window
] with-ui ;

View File

@ -15,7 +15,7 @@ TUPLE: demo-gadget < gadget yaw pitch distance ;
new
swap >>distance
swap >>pitch
swap >>yaw ;
swap >>yaw ; inline
GENERIC: far-plane ( gadget -- z )
GENERIC: near-plane ( gadget -- z )
@ -104,6 +104,6 @@ demo-gadget H{
{ T{ button-down f f 1 } [ drop reset-last-drag-rel ] }
{ T{ drag f 1 } [ drag-yaw-pitch rot [ pitch-demo-gadget ] keep yaw-demo-gadget ] }
{ T{ mouse-scroll } [ scroll-direction get second over distance-step * swap zoom-demo-gadget ] }
{ mouse-scroll [ scroll-direction get second over distance-step * swap zoom-demo-gadget ] }
} set-gestures

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays hashtables help.markup help.stylesheet io
io.styles kernel math models namespaces sequences ui ui.gadgets
ui.gadgets.books ui.gadgets.panes ui.gestures ui.render
ui.gadgets.books ui.gadgets.panes ui.gestures ui.pens.gradient ui.render
parser accessors colors ;
IN: slides
@ -10,7 +10,7 @@ CONSTANT: stylesheet
H{
{ default-span-style
H{
{ font "sans-serif" }
{ font-name "sans-serif" }
{ font-size 36 }
}
}
@ -21,14 +21,14 @@ CONSTANT: stylesheet
}
{ code-style
H{
{ font "monospace" }
{ font-name "monospace" }
{ font-size 36 }
{ page-color T{ rgba f 0.4 0.4 0.4 0.3 } }
}
}
{ snippet-style
H{
{ font "monospace" }
{ font-name "monospace" }
{ font-size 36 }
{ foreground T{ rgba f 0.1 0.1 0.4 1 } }
}
@ -39,11 +39,10 @@ CONSTANT: stylesheet
{ list-style
H{ { table-gap { 10 20 } } }
}
{ bullet "\u0000b7" }
}
: $title ( string -- )
[ H{ { font "sans-serif" } { font-size 48 } } format ] ($block) ;
[ H{ { font-name "sans-serif" } { font-size 48 } } format ] ($block) ;
: $divider ( -- )
[

View File

@ -1,4 +1,4 @@
USING: kernel opengl opengl.demo-support opengl.gl
USING: kernel opengl opengl.demo-support opengl.gl opengl.textures
opengl.shaders opengl.framebuffers opengl.capabilities multiline
ui.gadgets accessors sequences ui.render ui math locals arrays
generalizations combinators ui.gadgets.worlds ;

View File

@ -1,6 +1,8 @@
! Copyright (C) 2006, 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators kernel math math.vectors namespaces opengl opengl.gl sequences tetris.board tetris.game tetris.piece ui.render tetris.tetromino ui.gadgets ;
USING: accessors arrays combinators kernel math math.vectors
namespaces opengl opengl.gl sequences tetris.board tetris.game
tetris.piece ui.render tetris.tetromino ui.gadgets colors ;
IN: tetris.gl
#! OpenGL rendering for tetris
@ -16,7 +18,7 @@ IN: tetris.gl
: draw-next-piece ( piece -- )
dup tetromino>> colour>>
clone 0.2 >>alpha gl-color draw-piece-blocks ;
>rgba-components drop 0.2 <rgba> gl-color draw-piece-blocks ;
! TODO: move implementation specific stuff into tetris-board
: (draw-row) ( x y row -- )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: kernel arrays namespaces sequences math math.order
math.vectors colors random ;
math.vectors colors colors.constants random ;
IN: tetris.tetromino
TUPLE: tetromino states colour ;
@ -20,7 +20,7 @@ SYMBOL: tetrominoes
{ 0 2 }
{ 0 3 }
}
} cyan
} COLOR: cyan
] [
{
{ { 1 0 }
@ -37,11 +37,11 @@ SYMBOL: tetrominoes
{ 0 1 } { 1 1 }
{ 1 2 }
}
} purple
} COLOR: purple
] [
{ { { 0 0 } { 1 0 }
{ 0 1 } { 1 1 } }
} yellow
} COLOR: yellow
] [
{
{ { 0 0 } { 1 0 } { 2 0 }
@ -58,7 +58,7 @@ SYMBOL: tetrominoes
{ 0 1 }
{ 0 2 } { 1 2 }
}
} orange
} COLOR: orange
] [
{
{ { 0 0 } { 1 0 } { 2 0 }
@ -75,7 +75,7 @@ SYMBOL: tetrominoes
{ 0 1 }
{ 0 2 }
}
} blue
} COLOR: blue
] [
{
{ { 1 0 } { 2 0 }
@ -85,7 +85,7 @@ SYMBOL: tetrominoes
{ 0 1 } { 1 1 }
{ 1 2 }
}
} green
} COLOR: green
] [
{
{
@ -96,9 +96,9 @@ SYMBOL: tetrominoes
{ 0 1 } { 1 1 }
{ 0 2 }
}
} red
} COLOR: red
]
} [ call <tetromino> ] map tetrominoes set-global
} [ first2 <tetromino> ] map tetrominoes set-global
: random-tetromino ( -- tetromino )
tetrominoes get random ;

Some files were not shown because too many files have changed in this diff Show More