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 ; view4> relayout-1 ;
: update-model-projections ( -- ) : update-model-projections ( -- )
0 model-projection <model> view1> (>>model) 0 model-projection <model> view1> model<<
1 model-projection <model> view2> (>>model) 1 model-projection <model> view2> model<<
2 model-projection <model> view3> (>>model) 2 model-projection <model> view3> model<<
3 model-projection <model> view4> (>>model) ; 3 model-projection <model> view4> model<< ;
: camera-action ( quot -- quot ) : camera-action ( quot -- quot )
'[ drop _ observer3d> '[ 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-pos ( val -- ) self> pos<< ;
: turtle-ori> ( -- val ) self> ori>> ; : 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 string>> L-SYSTEM axiom>> or
L-SYSTEM rules>> L-SYSTEM rules>>
iterate-string iterate-string
L-SYSTEM (>>string) ; L-SYSTEM string<< ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -422,7 +422,7 @@ M:: <L-system> graft* ( L-SYSTEM -- )
L-SYSTEM find-gl-context L-SYSTEM find-gl-context
1 glGenLists L-SYSTEM (>>display-list) ; 1 glGenLists L-SYSTEM display-list<< ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -508,4 +508,4 @@ ARTICLE: "L-system" "L-system"
{ "q" "Roll left" } { "q" "Roll left" }
{ "w" "Roll right" } } ; { "w" "Roll right" } } ;
ABOUT: "L-system" ABOUT: "L-system"

View File

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

View File

@ -473,7 +473,7 @@ M:: <bubble-chamber> update-frame-buffer ( BUBBLE-CHAMBER -- )
v- v-
first2 first2
fatan2 fatan2
BUBBLE-CHAMBER (>>collision-theta) BUBBLE-CHAMBER collision-theta<<
BUBBLE-CHAMBER ; 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 f = ] [ T{ <entry> f TIME V{ RDATA } } RR cache-set-at ] }
{ [ ENT expired? ] [ RR cache-delete RR cache-add ] } { [ 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 cond
] ; ] ;

View File

@ -46,7 +46,7 @@ ERROR: unsupported-rotation degrees ;
: normalize-degree ( n -- n' ) 360 rem ; : normalize-degree ( n -- n' ) 360 rem ;
: processing-effect ( image quot -- image' ) : 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 ) :: rotate' ( image n -- image )
n normalize-degree :> n' n normalize-degree :> n'

View File

@ -235,7 +235,7 @@ M: irc-tab pref-dim*
<irc-client> <irc-client>
{ [ [ <irc-server-chat> ] dip attach-chat ] { [ [ <irc-server-chat> ] dip attach-chat ]
[ chats>> +server-chat+ swap at <irc-server-tab> dup [ 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 ] [ >>client ]
[ connect-irc ] } cleave ; [ connect-irc ] } cleave ;

View File

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

View File

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

View File

@ -14,10 +14,10 @@ CONSULT: assoc-protocol lex-hash hash>> ;
v CHAR: \n n last-index -1 or 1 + - v CHAR: \n n last-index -1 or 1 + -
n [ CHAR: \n = ] count 1 + n [ CHAR: \n = ] count 1 +
] ; ] ;
: store-pos ( v a -- ) : store-pos ( v a -- )
input of prepare-pos input of prepare-pos
lexer get [ (>>line) ] keep (>>column) ; lexer get [ line<< ] keep column<< ;
M: lex-hash set-at M: lex-hash set-at
swap { swap {

View File

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

View File

@ -12,7 +12,7 @@ C: <pos> pos
: pos> ( -- val ) self> val>> ; : 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 ) [ : <model-btn> ( gadget -- button ) [
[ dup hook>> [ call( button -- ) ] [ drop ] if* ] [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
[ [ [ value>> ] [ ] bi or ] keep set-control-value ] [ [ [ 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-btn new-button f <basic> >>model ;
: <model-border-btn> ( text -- button ) <model-btn> border-button-theme ; : <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 -- ) GENERIC# add-gadget-at 1 ( item location -- )
M: object add-gadget-at insertion-point -rot (add-gadget-at) ; 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 ] 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 ( item location size -- ) swap [ <layout> ] dip add-gadget-at ;
: (track-add-at) ( parent item n size -- ) swap [ <layout> ] dip (add-gadget-at) ; : (track-add-at) ( parent item n size -- ) swap [ <layout> ] dip (add-gadget-at) ;