ui.gadgets.slate: slate inherits from gadget

db4
Eduardo Cavazos 2008-07-17 18:23:04 -05:00
parent c73264863d
commit 897066f8a5
1 changed files with 18 additions and 13 deletions

View File

@ -1,29 +1,34 @@
USING: kernel namespaces opengl ui.render ui.gadgets ; USING: kernel namespaces opengl ui.render ui.gadgets accessors ;
IN: ui.gadgets.slate IN: ui.gadgets.slate
TUPLE: slate action dim graft ungraft ! TUPLE: slate action dim graft ungraft
! button-down
! button-up
! key-down
! key-up ;
TUPLE: slate < gadget
action pdim graft ungraft
button-down button-down
button-up button-up
key-down key-down
key-up ; key-up ;
: <slate> ( action -- slate ) : <slate> ( action -- slate )
slate construct-gadget slate new-gadget
tuck set-slate-action swap >>action
{ 100 100 } over set-slate-dim { 100 100 } >>pdim
[ ] over set-slate-graft [ ] >>graft
[ ] over set-slate-ungraft ; [ ] >>ungraft ;
M: slate pref-dim* ( slate -- dim ) slate-dim ; M: slate pref-dim* ( slate -- dim ) pdim>> ;
M: slate draw-gadget* ( slate -- ) M: slate draw-gadget* ( slate -- ) origin get swap action>> with-translation ;
origin get swap slate-action with-translation ;
M: slate graft* ( slate -- ) slate-graft call ; M: slate graft* ( slate -- ) graft>> call ;
M: slate ungraft* ( slate -- ) ungraft>> call ;
M: slate ungraft* ( slate -- ) slate-ungraft call ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!