unmaintained: fix accessors (>>foo) should be foo<<.

db4
John Benediktsson 2014-10-24 21:39:58 -07:00
parent 798f6445bd
commit e9cdfcb03c
15 changed files with 26 additions and 26 deletions

View File

@ -148,10 +148,10 @@ VAR: present-space
view4> relayout-1 ;
: update-model-projections ( -- )
0 model-projection <model> view1> (>>model)
1 model-projection <model> view2> (>>model)
2 model-projection <model> view3> (>>model)
3 model-projection <model> view4> (>>model) ;
0 model-projection <model> view1> model<<
1 model-projection <model> view2> model<<
2 model-projection <model> view3> model<<
3 model-projection <model> view4> model<< ;
: camera-action ( quot -- quot )
'[ drop _ observer3d>

View File

@ -32,10 +32,10 @@ TUPLE: observer < turtle projection-mode collision-mode ;
: turtle-pos> ( -- val ) self> pos>> ;
: >turtle-pos ( val -- ) self> (>>pos) ;
: >turtle-pos ( val -- ) self> pos<< ;
: turtle-ori> ( -- val ) self> ori>> ;
: >turtle-ori ( val -- ) self> (>>ori) ;
: >turtle-ori ( val -- ) self> ori<< ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -263,7 +263,7 @@ TUPLE: <L-system> < gadget
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: iterate-system ( GADGET -- ) GADGET pedestal>> 0.5 + GADGET (>>pedestal) ;
:: iterate-system ( GADGET -- ) GADGET pedestal>> 0.5 + GADGET pedestal<< ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -357,7 +357,7 @@ TUPLE: <L-system> < gadget
L-SYSTEM string>> L-SYSTEM axiom>> or
L-SYSTEM rules>>
iterate-string
L-SYSTEM (>>string) ;
L-SYSTEM string<< ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -422,7 +422,7 @@ M:: <L-system> graft* ( L-SYSTEM -- )
L-SYSTEM find-gl-context
1 glGenLists L-SYSTEM (>>display-list) ;
1 glGenLists L-SYSTEM display-list<< ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -16,7 +16,7 @@ IN: alien.marshall.structs
define-struct-accessor ;
: define-struct-setter ( class name word type -- )
[ "(>>" prepend ")" append ] 2dip
[ "<<" append ] 2dip
marshaller [ underlying>> ] \ bi* roll 4array >quotation
define-struct-accessor ;

View File

@ -473,7 +473,7 @@ M:: <bubble-chamber> update-frame-buffer ( BUBBLE-CHAMBER -- )
v-
first2
fatan2
BUBBLE-CHAMBER (>>collision-theta)
BUBBLE-CHAMBER collision-theta<<
BUBBLE-CHAMBER ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -59,7 +59,7 @@ TUPLE: <entry> time data ;
{
{ [ ENT f = ] [ T{ <entry> f TIME V{ RDATA } } RR cache-set-at ] }
{ [ ENT expired? ] [ RR cache-delete RR cache-add ] }
{ [ t ] [ TIME ENT (>>time) RDATA ENT data>> adjoin ] }
{ [ t ] [ TIME ENT time<< RDATA ENT data>> adjoin ] }
}
cond
] ;

View File

@ -46,7 +46,7 @@ ERROR: unsupported-rotation degrees ;
: normalize-degree ( n -- n' ) 360 rem ;
: processing-effect ( image quot -- image' )
'[ image>pixel-rows @ flatten-table ] [ (>>bitmap) ] [ ] tri ; inline
'[ image>pixel-rows @ flatten-table ] [ bitmap<< ] [ ] tri ; inline
:: rotate' ( image n -- image )
n normalize-degree :> n'

View File

@ -235,7 +235,7 @@ M: irc-tab pref-dim*
<irc-client>
{ [ [ <irc-server-chat> ] dip attach-chat ]
[ chats>> +server-chat+ swap at <irc-server-tab> dup
"Server" associate ui-window new-tabbed [ swap (>>window) ] keep ]
"Server" associate ui-window new-tabbed [ swap window<< ] keep ]
[ >>client ]
[ connect-irc ] } cleave ;

View File

@ -46,7 +46,7 @@ M: fold-model model-activated drop ;
TUPLE: updater-model < multi-model values updates ;
M: updater-model (model-changed) [ tuck updates>> =
[ [ values>> value>> ] keep set-model ]
[ drop ] if ] keep f swap (>>value) ;
[ drop ] if ] keep f swap value<< ;
: updates ( values updates -- model ) [ 2array updater-model <multi-model> ] 2keep
[ >>values ] [ >>updates ] bi* ;

View File

@ -13,7 +13,7 @@ C: <ori> ori
: ori> ( -- val ) self> val>> ;
: >ori ( val -- ) self> (>>val) ;
: >ori ( val -- ) self> val<< ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -17,7 +17,7 @@ CONSULT: assoc-protocol lex-hash hash>> ;
: store-pos ( v a -- )
input of prepare-pos
lexer get [ (>>line) ] keep (>>column) ;
lexer get [ line<< ] keep column<< ;
M: lex-hash set-at
swap {

View File

@ -145,7 +145,7 @@ M:: <pong> draw-gadget* ( PONG -- )
bounce-off-wall? [ ( -- ? )
BALL FIELD in-between-horizontally? not ]
stop-game [ ( -- ) t GADGET (>>paused) ] |
stop-game [ ( -- ) t GADGET paused<< ] |
BALL FIELD in-bounds?
[
@ -173,7 +173,7 @@ M:: <pong> draw-gadget* ( PONG -- )
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: start-pong-thread ( GADGET -- )
f GADGET (>>paused)
f GADGET paused<<
[
[
GADGET paused>>

View File

@ -12,7 +12,7 @@ C: <pos> pos
: pos> ( -- val ) self> val>> ;
: >pos ( val -- ) self> (>>val) ;
: >pos ( val -- ) self> val<< ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -12,7 +12,7 @@ TUPLE: model-btn < button hook value ;
: <model-btn> ( gadget -- button ) [
[ dup hook>> [ call( button -- ) ] [ drop ] if* ]
[ [ [ value>> ] [ ] bi or ] keep set-control-value ]
[ model>> f swap (>>value) ] tri
[ model>> f swap value<< ] tri
] model-btn new-button f <basic> >>model ;
: <model-border-btn> ( text -- button ) <model-btn> border-button-theme ;

View File

@ -73,7 +73,7 @@ M: track (add-gadget-at) -rot >layout [ add-layout ] keep [ gadget>> insert-gadg
GENERIC# add-gadget-at 1 ( item location -- )
M: object add-gadget-at insertion-point -rot (add-gadget-at) ;
M: model add-gadget-at parent>> dup book:book? [ "No models in books" throw ]
[ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
[ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip model<< ] if ] if ;
: track-add-at ( item location size -- ) swap [ <layout> ] dip add-gadget-at ;
: (track-add-at) ( parent item n size -- ) swap [ <layout> ] dip (add-gadget-at) ;