123 lines
2.8 KiB
Factor
123 lines
2.8 KiB
Factor
! Copyright (C) 2009 Eduardo Cavazos
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: kernel namespaces opengl ui.render ui.gadgets accessors ;
|
|
|
|
IN: ui.gadgets.slate
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
TUPLE: slate < gadget action pdim graft ungraft ;
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
: init-slate ( slate -- slate )
|
|
init-gadget
|
|
[ ] >>action
|
|
{ 200 200 } >>pdim
|
|
[ ] >>graft
|
|
[ ] >>ungraft ;
|
|
|
|
: <slate> ( action -- slate )
|
|
slate new
|
|
init-slate
|
|
swap >>action ;
|
|
|
|
M: slate pref-dim* ( slate -- dim ) pdim>> ;
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
USING: combinators arrays sequences math math.geometry
|
|
opengl.gl ui.gadgets.worlds ;
|
|
|
|
: screen-y* ( gadget -- loc )
|
|
{
|
|
[ find-world height ]
|
|
[ screen-loc second ]
|
|
[ height ]
|
|
}
|
|
cleave
|
|
+ - ;
|
|
|
|
: screen-loc* ( gadget -- loc )
|
|
{
|
|
[ screen-loc first ]
|
|
[ screen-y* ]
|
|
}
|
|
cleave
|
|
2array ;
|
|
|
|
: setup-viewport ( gadget -- gadget )
|
|
dup
|
|
{
|
|
[ screen-loc* ]
|
|
[ dim>> ]
|
|
}
|
|
cleave
|
|
gl-viewport ;
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
: default-coordinate-system ( gadget -- gadget )
|
|
dup
|
|
{
|
|
[ drop 0 ]
|
|
[ width 1 - ]
|
|
[ height 1 - ]
|
|
[ drop 0 ]
|
|
}
|
|
cleave
|
|
-1 1
|
|
glOrtho ;
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
M: slate graft* ( slate -- ) graft>> call ;
|
|
M: slate ungraft* ( slate -- ) ungraft>> call ;
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
GENERIC: establish-coordinate-system ( gadget -- gadget )
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
M: slate establish-coordinate-system ( slate -- slate )
|
|
default-coordinate-system ;
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
GENERIC: draw-slate ( slate -- slate )
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
M: slate draw-slate ( slate -- slate ) dup action>> call ;
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
M: slate draw-gadget* ( slate -- )
|
|
|
|
GL_PROJECTION glMatrixMode glPushMatrix glLoadIdentity
|
|
|
|
establish-coordinate-system
|
|
|
|
GL_MODELVIEW glMatrixMode glPushMatrix glLoadIdentity
|
|
|
|
setup-viewport
|
|
|
|
draw-slate
|
|
|
|
GL_PROJECTION glMatrixMode glPopMatrix glLoadIdentity
|
|
GL_MODELVIEW glMatrixMode glPopMatrix glLoadIdentity
|
|
|
|
dup
|
|
find-world
|
|
! The world coordinate system is a little wacky:
|
|
dup { [ drop 0 ] [ width ] [ height ] [ drop 0 ] } cleave -1 1 glOrtho
|
|
setup-viewport
|
|
drop
|
|
drop ;
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|