Updating ui.gadgets.alerts, ui.gadgets.book-extras, ui.utils and drills for new_ui changes

db4
Slava Pestov 2009-03-16 03:01:32 -05:00
parent 4589aab8a4
commit 56ffaf5cb1
4 changed files with 12 additions and 11 deletions

View File

@ -1,17 +1,18 @@
USING: accessors arrays cocoa.dialogs combinators continuations USING: accessors arrays cocoa.dialogs combinators continuations
fry grouping io.encodings.utf8 io.files io.styles kernel math fry grouping io.encodings.utf8 io.files io.styles kernel math
math.parser models models.filter models.history namespaces random math.parser models models.arrow models.history namespaces random
sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks ui.gestures ; ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks ui.gestures
ui.gadgets.corners ;
IN: drills IN: drills
SYMBOLS: it startLength ; SYMBOLS: it startLength ;
: big ( gadget -- gadget ) { "sans-serif" plain 30 } >>font ; : big ( gadget -- gadget ) { "sans-serif" plain 30 } >>font ;
: card ( model quot -- button ) <filter> <label-control> big [ next ] <book-btn> ; : card ( model quot -- button ) <arrow> <label-control> big [ next ] <book-btn> ;
: op ( quot str -- gadget ) <label> big swap <book-bevel-btn> ; : op ( quot str -- gadget ) <label> big swap <book-bevel-btn> ;
: show ( model -- gadget ) dup it set-global [ random ] <filter> : show ( model -- gadget ) dup it set-global [ random ] <arrow>
{ [ [ first ] card ] { [ [ first ] card ]
[ [ [ second ] [ drop [ "malformed input" throw ] "Malformed Input" alert ] recover ] card ] [ [ [ second ] [ drop [ "malformed input" throw ] "Malformed Input" alert ] recover ] card ]
[ '[ |<< [ it get [ [ '[ |<< [ it get [
@ -20,8 +21,8 @@ SYMBOLS: it startLength ;
] change-model ] with-return ] "Yes" op ] ] change-model ] with-return ] "Yes" op ]
[ '[ |<< it get _ model-changed ] "No" op ] } cleave [ '[ |<< it get _ model-changed ] "No" op ] } cleave
2array { 1 0 } <track> swap [ 0.5 track-add ] each 2array { 1 0 } <track> swap [ 0.5 track-add ] each
3array <book*> <frame> { 450 175 } >>pref-dim swap @center grid-add 3array <book*> 3 3 <frame> { 450 175 } >>pref-dim swap @center grid-add
it get [ length startLength get swap - number>string "/" startLength get number>string 3append ] <filter> <label-control> @bottom grid-add ; it get [ length startLength get swap - number>string "/" startLength get number>string 3append ] <arrow> <label-control> @bottom grid-add ;
: drill ( -- ) [ : drill ( -- ) [
open-panel [ open-panel [

View File

@ -1,4 +1,4 @@
USING: accessors ui ui.gadgets ui.gadgets.labels ui.gadgets.buttons ui.gadgets.packs locals sequences io.styles ; USING: accessors ui ui.gadgets ui.gadgets.labels ui.gadgets.buttons ui.gadgets.packs locals sequences io.styles ;
IN: ui.gadgets.alerts IN: ui.gadgets.alerts
:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align string <label> { "sans-serif" plain 18 } >>font { 200 100 } >>pref-dim add-gadget :: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align string <label> { "sans-serif" plain 18 } >>font { 200 100 } >>pref-dim add-gadget
"okay" [ close-window ] quot append <bevel-button> add-gadget "" open-window ; "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;

View File

@ -6,6 +6,6 @@ IN: ui.gadgets.book-extras
: prev ( book -- ) model>> [ 1 - ] change-model ; : prev ( book -- ) model>> [ 1 - ] change-model ;
: (book-t) ( quot -- quot ) '[ : owner ( gadget -- book ) parent>> dup book? [ owner ] unless ; owner @ ] ; : (book-t) ( quot -- quot ) '[ : owner ( gadget -- book ) parent>> dup book? [ owner ] unless ; owner @ ] ;
: <book-btn> ( label quot -- button ) (book-t) <button> ; : <book-btn> ( label quot -- button ) (book-t) <button> ;
: <book-bevel-btn> ( label quot -- button ) (book-t) <bevel-button> ; : <book-bevel-btn> ( label quot -- button ) (book-t) <border-button> ;
: >>> ( label -- button ) [ next ] <book-btn> ; : >>> ( label -- button ) [ next ] <book-btn> ;
: <<< ( label -- button ) [ prev ] <book-btn> ; : <<< ( label -- button ) [ prev ] <book-btn> ;

View File

@ -1,6 +1,6 @@
USING: accessors sequences namespaces ui.render opengl fry ; USING: accessors sequences namespaces ui.render opengl fry kernel ;
IN: ui.utils IN: ui.utils
SYMBOLS: width height ; SYMBOLS: width height ;
: store-dim ( gadget -- ) dim>> [ first width set ] [ second height set ] bi ; : store-dim ( gadget -- ) dim>> [ first width set ] [ second height set ] bi ;
: with-dim ( gadget quot -- ) '[ _ store-dim @ ] with-scope ; : with-dim ( gadget quot -- ) '[ _ store-dim @ ] with-scope ; inline
: with-w/h ( gadget quot -- ) '[ origin get _ with-translation ] with-dim ; : with-w/h ( gadget quot -- ) '[ origin get _ with-translation ] with-dim ; inline