Merge branch 'master' of git://factorcode.org/git/factor
slava
commit
a2c0df8a05
|
|
@ -0,0 +1,88 @@
|
|||
|
||||
USING: kernel namespaces sequences random math math.constants math.libm vars
|
||||
ui
|
||||
processing
|
||||
processing.gadget
|
||||
bubble-chamber.common
|
||||
bubble-chamber.particle
|
||||
bubble-chamber.particle.muon
|
||||
bubble-chamber.particle.quark
|
||||
bubble-chamber.particle.hadron
|
||||
bubble-chamber.particle.axion ;
|
||||
|
||||
IN: bubble-chamber
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VARS: particles muons quarks hadrons axions ;
|
||||
|
||||
VAR: boom
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: collide-all ( -- )
|
||||
|
||||
2 pi * 1random >collision-theta
|
||||
|
||||
particles> [ collide ] each ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: collide-one ( -- )
|
||||
|
||||
dim 2 / mouse-x - dim 2 / mouse-y - fatan2 >collision-theta
|
||||
|
||||
hadrons> random collide
|
||||
quarks> random collide
|
||||
muons> random collide ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: mouse-pressed ( -- )
|
||||
boom on
|
||||
1 background ! kludge
|
||||
11 [ drop collide-one ] each ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: key-released ( -- )
|
||||
key " " =
|
||||
[
|
||||
boom on
|
||||
1 background
|
||||
collide-all
|
||||
]
|
||||
when ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: bubble-chamber ( -- )
|
||||
|
||||
1000 1000 size*
|
||||
|
||||
[
|
||||
1 background
|
||||
no-stroke
|
||||
|
||||
1789 [ drop <muon> ] map >muons
|
||||
1300 [ drop <quark> ] map >quarks
|
||||
1000 [ drop <hadron> ] map >hadrons
|
||||
111 [ drop <axion> ] map >axions
|
||||
|
||||
muons> quarks> hadrons> axions> 3append append >particles
|
||||
|
||||
collide-one
|
||||
] setup
|
||||
|
||||
[
|
||||
boom>
|
||||
[ particles> [ move ] each ]
|
||||
when
|
||||
] draw
|
||||
|
||||
[ mouse-pressed ] button-down
|
||||
[ key-released ] key-up ;
|
||||
|
||||
: go ( -- ) [ bubble-chamber run ] with-ui ;
|
||||
|
||||
MAIN: go
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
|
||||
USING: kernel math accessors combinators.cleave vars ;
|
||||
|
||||
IN: bubble-chamber.common
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: collision-theta
|
||||
|
||||
: dim ( -- dim ) 1000 ;
|
||||
|
||||
: center ( -- point ) dim 2 / dup {2} ; foldable
|
||||
|
|
@ -0,0 +1,67 @@
|
|||
|
||||
USING: kernel sequences random accessors multi-methods
|
||||
math math.constants math.ranges math.points combinators.cleave
|
||||
processing bubble-chamber.common bubble-chamber.particle ;
|
||||
|
||||
IN: bubble-chamber.particle.axion
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: axion < particle ;
|
||||
|
||||
: <axion> ( -- axion ) axion construct-empty initialize-particle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { axion }
|
||||
|
||||
center >>pos
|
||||
2 pi * 1random >>theta
|
||||
1.0 6.0 2random >>speed
|
||||
0.998 1.000 2random >>speed-d
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: dy>alpha ( dy -- alpha ) neg 6 * 30 + 255.0 / ;
|
||||
|
||||
: axion-white ( dy -- dy ) dup 1 swap dy>alpha {2} stroke ;
|
||||
: axion-black ( dy -- dy ) dup 0 swap dy>alpha {2} stroke ;
|
||||
|
||||
: axion-point- ( particle dy -- particle ) >r dup pos>> r> v-y point ;
|
||||
: axion-point+ ( particle dy -- particle ) >r dup pos>> r> v+y point ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { axion }
|
||||
|
||||
{ 0.06 0.59 } stroke
|
||||
dup pos>> point
|
||||
|
||||
1 4 [a,b] [ axion-white axion-point- ] each
|
||||
1 4 [a,b] [ axion-black axion-point+ ] each
|
||||
|
||||
dup vel>> move-by
|
||||
|
||||
turn
|
||||
|
||||
step-theta
|
||||
step-theta-d
|
||||
step-speed-mul
|
||||
|
||||
[ ] [ speed-d>> 0.9999 * ] bi >>speed-d
|
||||
|
||||
1000 random 996 >
|
||||
[
|
||||
dup speed>> neg >>speed
|
||||
dup speed-d>> neg 2 + >>speed-d
|
||||
|
||||
100 random 30 > [ collide ] [ drop ] if
|
||||
]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
|
@ -0,0 +1,60 @@
|
|||
|
||||
USING: kernel random math math.constants math.points accessors multi-methods
|
||||
processing
|
||||
processing.color
|
||||
bubble-chamber.common
|
||||
bubble-chamber.particle ;
|
||||
|
||||
IN: bubble-chamber.particle.hadron
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: hadron < particle ;
|
||||
|
||||
: <hadron> ( -- hadron ) hadron construct-empty initialize-particle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { hadron }
|
||||
|
||||
center >>pos
|
||||
2 pi * 1random >>theta
|
||||
0.5 3.5 2random >>speed
|
||||
0.996 1.001 2random >>speed-d
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
|
||||
|
||||
0 1 0 <rgb> >>myc
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { hadron }
|
||||
|
||||
{ 1 0.11 } stroke
|
||||
dup pos>> 1 v-y point
|
||||
|
||||
{ 0 0.11 } stroke
|
||||
dup pos>> 1 v+y point
|
||||
|
||||
dup vel>> move-by
|
||||
|
||||
turn
|
||||
|
||||
step-theta
|
||||
step-theta-d
|
||||
step-speed-mul
|
||||
|
||||
1000 random 997 >
|
||||
[
|
||||
1.0 >>speed-d
|
||||
0.00001 >>theta-dd
|
||||
|
||||
100 random 70 > [ dup collide ] when
|
||||
]
|
||||
when
|
||||
|
||||
out-of-bounds? [ collide ] [ drop ] if ;
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
|
||||
USING: kernel sequences math math.constants accessors
|
||||
processing
|
||||
processing.color ;
|
||||
|
||||
IN: bubble-chamber.particle.muon.colors
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: good-colors ( -- seq )
|
||||
{
|
||||
T{ rgba f 0.23 0.14 0.17 1 }
|
||||
T{ rgba f 0.23 0.14 0.15 1 }
|
||||
T{ rgba f 0.21 0.14 0.15 1 }
|
||||
T{ rgba f 0.51 0.39 0.33 1 }
|
||||
T{ rgba f 0.49 0.33 0.20 1 }
|
||||
T{ rgba f 0.55 0.45 0.32 1 }
|
||||
T{ rgba f 0.69 0.63 0.51 1 }
|
||||
T{ rgba f 0.64 0.39 0.18 1 }
|
||||
T{ rgba f 0.73 0.42 0.20 1 }
|
||||
T{ rgba f 0.71 0.45 0.29 1 }
|
||||
T{ rgba f 0.79 0.45 0.22 1 }
|
||||
T{ rgba f 0.82 0.56 0.34 1 }
|
||||
T{ rgba f 0.88 0.72 0.49 1 }
|
||||
T{ rgba f 0.85 0.69 0.40 1 }
|
||||
T{ rgba f 0.96 0.92 0.75 1 }
|
||||
T{ rgba f 0.99 0.98 0.87 1 }
|
||||
T{ rgba f 0.85 0.82 0.69 1 }
|
||||
T{ rgba f 0.99 0.98 0.87 1 }
|
||||
T{ rgba f 0.82 0.82 0.79 1 }
|
||||
T{ rgba f 0.65 0.69 0.67 1 }
|
||||
T{ rgba f 0.53 0.60 0.55 1 }
|
||||
T{ rgba f 0.57 0.53 0.68 1 }
|
||||
T{ rgba f 0.47 0.42 0.56 1 }
|
||||
} ;
|
||||
|
||||
: anti-colors ( -- seq ) good-colors <reversed> ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: color-fraction ( particle -- particle fraction ) dup theta>> pi + 2 pi * / ;
|
||||
|
||||
: set-good-color ( particle -- particle )
|
||||
color-fraction dup 0 1 between?
|
||||
[ good-colors at-fraction-of >>myc ]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
||||
: set-anti-color ( particle -- particle )
|
||||
color-fraction dup 0 1 between?
|
||||
[ anti-colors at-fraction-of >>mya ]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
|
||||
USING: kernel arrays sequences random
|
||||
math
|
||||
math.ranges
|
||||
math.functions
|
||||
math.vectors
|
||||
multi-methods accessors
|
||||
combinators.cleave
|
||||
processing
|
||||
bubble-chamber.common
|
||||
bubble-chamber.particle
|
||||
bubble-chamber.particle.muon.colors ;
|
||||
|
||||
IN: bubble-chamber.particle.muon
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: muon < particle ;
|
||||
|
||||
: <muon> ( -- muon ) muon construct-empty initialize-particle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { muon }
|
||||
|
||||
center >>pos
|
||||
2 32 [a,b] random >>speed
|
||||
0.0001 0.001 2random >>speed-d
|
||||
|
||||
collision-theta> -0.1 0.1 2random + >>theta
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ 0.001 theta-dd-small? ] [ -0.1 0.1 random-theta-dd ] [ ] while
|
||||
|
||||
set-good-color
|
||||
set-anti-color
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { muon }
|
||||
|
||||
dup myc>> 0.16 >>alpha stroke
|
||||
dup pos>> point
|
||||
|
||||
dup mya>> 0.16 >>alpha stroke
|
||||
dup pos>> first2 >r dim swap - r> 2array point
|
||||
|
||||
dup
|
||||
[ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
|
||||
move-by
|
||||
|
||||
step-theta
|
||||
step-theta-d
|
||||
step-speed-sub
|
||||
|
||||
out-of-bounds? [ collide ] [ drop ] if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -0,0 +1,68 @@
|
|||
|
||||
USING: kernel sequences combinators
|
||||
math math.vectors math.functions multi-methods
|
||||
accessors combinators.cleave processing processing.color
|
||||
bubble-chamber.common ;
|
||||
|
||||
IN: bubble-chamber.particle
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
GENERIC: collide ( particle -- )
|
||||
GENERIC: move ( particle -- )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: particle pos vel speed speed-d theta theta-d theta-dd myc mya ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: initialize-particle ( particle -- particle )
|
||||
|
||||
0 0 {2} >>pos
|
||||
0 0 {2} >>vel
|
||||
|
||||
0 >>speed
|
||||
0 >>speed-d
|
||||
0 >>theta
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
0 0 0 1 <rgba> >>myc
|
||||
0 0 0 1 <rgba> >>mya ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: move-by ( obj delta -- obj ) over pos>> v+ >>pos ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: theta-dd-small? ( par limit -- par ? ) >r dup theta-dd>> abs r> < ;
|
||||
|
||||
: random-theta-dd ( par a b -- par ) 2random >>theta-dd ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: turn ( particle -- particle )
|
||||
dup
|
||||
[ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
|
||||
>>vel ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: step-theta ( p -- p ) [ ] [ theta>> ] [ theta-d>> ] tri + >>theta ;
|
||||
: step-theta-d ( p -- p ) [ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d ;
|
||||
: step-speed-sub ( p -- p ) [ ] [ speed>> ] [ speed-d>> ] tri - >>speed ;
|
||||
: step-speed-mul ( p -- p ) [ ] [ speed>> ] [ speed-d>> ] tri * >>speed ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: x ( particle -- x ) pos>> first ;
|
||||
: y ( particle -- x ) pos>> second ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: out-of-bounds? ( particle -- particle ? )
|
||||
dup
|
||||
{ [ x dim neg < ] [ x dim 2 * > ] [ y dim neg < ] [ y dim 2 * > ] } cleave
|
||||
or or or ;
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
|
||||
USING: kernel arrays sequences random math accessors multi-methods
|
||||
processing
|
||||
bubble-chamber.common
|
||||
bubble-chamber.particle ;
|
||||
|
||||
IN: bubble-chamber.particle.quark
|
||||
|
||||
TUPLE: quark < particle ;
|
||||
|
||||
: <quark> ( -- quark ) quark construct-empty initialize-particle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { quark }
|
||||
|
||||
center >>pos
|
||||
collision-theta> -0.11 0.11 2random + >>theta
|
||||
0.5 3.0 2random >>speed
|
||||
|
||||
0.996 1.001 2random >>speed-d
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { quark }
|
||||
|
||||
dup myc>> 0.13 >>alpha stroke
|
||||
dup pos>> point
|
||||
|
||||
dup pos>> first2 >r dim swap - r> 2array point
|
||||
|
||||
[ ] [ vel>> ] bi move-by
|
||||
|
||||
turn
|
||||
|
||||
step-theta
|
||||
step-theta-d
|
||||
step-speed-mul
|
||||
|
||||
1000 random 997 >
|
||||
[
|
||||
dup speed>> neg >>speed
|
||||
2 over speed-d>> - >>speed-d
|
||||
]
|
||||
when
|
||||
|
||||
out-of-bounds? [ collide ] [ drop ] if ;
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
USING: kernel math test namespaces crypto crypto-internals ;
|
||||
|
||||
[ 6 ] [ 5 T{ bbs f 590695557939 811977232793 } random-bbs-bits* ] unit-test
|
||||
[ 792723710536787233474130382522 ] [ 100 T{ bbs f 200352954495 846054538649 } [ random-bbs-bits* drop ] 2keep random-bbs-bits* ] unit-test
|
||||
|
||||
|
|
@ -18,16 +18,16 @@ TUPLE: mysql-result-set ;
|
|||
: mysql-error ( mysql -- )
|
||||
[ mysql_error throw ] when* ;
|
||||
|
||||
: mysql-connect ( mysql-connection -- )
|
||||
new-mysql over set-mysql-db-handle
|
||||
dup {
|
||||
mysql-db-handle
|
||||
mysql-db-host
|
||||
mysql-db-user
|
||||
mysql-db-password
|
||||
mysql-db-db
|
||||
mysql-db-port
|
||||
} get-slots f 0 mysql_real_connect mysql-error ;
|
||||
! : mysql-connect ( mysql-connection -- )
|
||||
! new-mysql over set-mysql-db-handle
|
||||
! dup {
|
||||
! mysql-db-handle
|
||||
! mysql-db-host
|
||||
! mysql-db-user
|
||||
! mysql-db-password
|
||||
! mysql-db-db
|
||||
! mysql-db-port
|
||||
! } get-slots f 0 mysql_real_connect mysql-error ;
|
||||
|
||||
! =========================================================
|
||||
! Low level mysql utility definitions
|
||||
|
|
|
|||
|
|
@ -1,56 +1,109 @@
|
|||
|
||||
USING: kernel sequences assocs qualified circular ;
|
||||
|
||||
USING: math multi-methods ;
|
||||
|
||||
QUALIFIED: sequences
|
||||
QUALIFIED: assocs
|
||||
QUALIFIED: circular
|
||||
|
||||
IN: newfx
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Now, we can see a new world coming into view.
|
||||
! A world in which there is the very real prospect of a new world order.
|
||||
!
|
||||
! - George Herbert Walker Bush
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
GENERIC: at ( col key -- val )
|
||||
GENERIC: of ( key col -- val )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: nth-at ( seq i -- val ) swap nth ;
|
||||
: nth-of ( i seq -- val ) nth ;
|
||||
GENERIC: grab ( col key -- col val )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: nth-is ( seq i val -- seq ) swap pick set-nth ;
|
||||
: is-nth ( seq val i -- seq ) pick set-nth ;
|
||||
GENERIC: is ( col key val -- col )
|
||||
GENERIC: as ( col val key -- col )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: nth-is-of ( i val seq -- seq ) dup >r swapd set-nth r> ;
|
||||
: is-nth-of ( val i seq -- seq ) dup >r set-nth r> ;
|
||||
GENERIC: is-of ( key val col -- col )
|
||||
GENERIC: as-of ( val key col -- col )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: mutate-nth ( seq i val -- ) swap rot set-nth ;
|
||||
: mutate-nth-at ( seq val i -- ) rot set-nth ;
|
||||
|
||||
: mutate-nth-of ( i val seq -- ) swapd set-nth ;
|
||||
: mutate-nth-at-of ( val i seq -- ) set-nth ;
|
||||
GENERIC: mutate-at ( col key val -- )
|
||||
GENERIC: mutate-as ( col val key -- )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: at-key ( tbl key -- val ) swap at ;
|
||||
: key-of ( key tbl -- val ) at ;
|
||||
GENERIC: at-mutate ( key val col -- )
|
||||
GENERIC: as-mutate ( val key col -- )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! sequence
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: at { sequence number } swap nth ;
|
||||
METHOD: of { number sequence } nth ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: key-is ( tbl key val -- tbl ) swap pick set-at ;
|
||||
: is-key ( tbl val key -- tbl ) pick set-at ;
|
||||
METHOD: grab { sequence number } dupd swap nth ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: mutate-key ( tbl key val -- ) swap rot set-at ;
|
||||
: mutate-at-key ( tbl val key -- ) rot set-at ;
|
||||
METHOD: is { sequence number object } swap pick set-nth ;
|
||||
METHOD: as { sequence object number } pick set-nth ;
|
||||
|
||||
: mutate-key-of ( key val tbl -- ) swapd set-at ;
|
||||
: mutate-at-key-of ( val key tbl -- ) set-at ;
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: is-of { number object sequence } dup >r swapd set-nth r> ;
|
||||
METHOD: as-of { object number sequence } dup >r set-nth r> ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: mutate-at { sequence number object } swap rot set-nth ;
|
||||
METHOD: mutate-as { sequence object number } rot set-nth ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: at-mutate { number object sequence } swapd set-nth ;
|
||||
METHOD: as-mutate { object number sequence } set-nth ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! assoc
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: at { assoc object } swap assocs:at ;
|
||||
METHOD: of { object assoc } assocs:at ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: grab { assoc object } dupd swap assocs:at ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: is { assoc object object } swap pick set-at ;
|
||||
METHOD: as { assoc object object } pick set-at ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: is-of { object object assoc } dup >r swapd set-at r> ;
|
||||
METHOD: as-of { object object assoc } dup >r set-at r> ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: mutate-at { assoc object object } swap rot set-at ;
|
||||
METHOD: mutate-as { assoc object object } rot set-at ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: at-mutate { object object assoc } swapd set-at ;
|
||||
METHOD: as-mutate { object object assoc } set-at ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
USING: alien alien.syntax combinators kernel parser sequences
|
||||
system words namespaces hashtables init math arrays assocs
|
||||
continuations ;
|
||||
IN: opengl.gl.extensions
|
||||
|
||||
ERROR: unknown-gl-platform ;
|
||||
<< {
|
||||
|
|
@ -9,7 +10,6 @@ ERROR: unknown-gl-platform ;
|
|||
{ [ os unix? ] [ "opengl.gl.unix" ] }
|
||||
{ [ t ] [ unknown-gl-platform ] }
|
||||
} cond use+ >>
|
||||
IN: opengl.gl.extensions
|
||||
|
||||
SYMBOL: +gl-function-number-counter+
|
||||
SYMBOL: +gl-function-pointers+
|
||||
|
|
|
|||
|
|
@ -1,97 +0,0 @@
|
|||
|
||||
USING: help.syntax help.markup ;
|
||||
|
||||
IN: processing.gallery.bubble-chamber
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
HELP: muon
|
||||
|
||||
{ $class-description
|
||||
"The muon is a colorful particle with an entangled friend."
|
||||
"It draws both itself and its horizontally symmetric partner."
|
||||
"A high range of speed and almost no speed decay allow the"
|
||||
"muon to reach the extents of the window, often forming rings"
|
||||
"where theta has decayed but speed remains stable. The result"
|
||||
"is color almost everywhere in the general direction of collision,"
|
||||
"stabilized into fuzzy rings." } ;
|
||||
|
||||
HELP: quark
|
||||
|
||||
{ $class-description
|
||||
"The quark draws as a translucent black. Their large numbers"
|
||||
"create fields of blackness overwritten only by the glowing shadows of "
|
||||
"Hadrons. "
|
||||
"quarks are allowed to accelerate away with speed decay values above 1.0. "
|
||||
"Each quark has an entangled friend. Both particles are drawn identically,"
|
||||
"mirrored along the y-axis." } ;
|
||||
|
||||
HELP: hadron
|
||||
|
||||
{ $class-description
|
||||
"Hadrons collide from totally random directions. "
|
||||
"Those hadrons that do not exit the drawing area, "
|
||||
"tend to stabilize into perfect circular orbits. "
|
||||
"Each hadron draws with a slight glowing emboss. "
|
||||
"The hadron itself is not drawn." } ;
|
||||
|
||||
HELP: axion
|
||||
|
||||
{ $class-description
|
||||
"The axion particle draws a bold black path. Axions exist "
|
||||
"in a slightly higher dimension and as such are drawn with "
|
||||
"elevated embossed shadows. Axions are quick to stabilize "
|
||||
"and fall into single pixel orbits axions automatically "
|
||||
"recollide themselves after stabilizing." } ;
|
||||
|
||||
{ muon quark hadron axion } related-words
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
ARTICLE: "bubble-chamber" "Bubble Chamber"
|
||||
|
||||
{ $subsection "bubble-chamber-introduction" }
|
||||
{ $subsection "bubble-chamber-particles" }
|
||||
{ $subsection "bubble-chamber-author" }
|
||||
{ $subsection "bubble-chamber-running" } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
ARTICLE: "bubble-chamber-introduction" "Introduction"
|
||||
|
||||
"The Bubble Chamber is a generative painting system of imaginary "
|
||||
"colliding particles. A single super-massive collision produces a "
|
||||
"discrete universe of four particle types. Particles draw their "
|
||||
"positions over time as pixel exposures. " ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
ARTICLE: "bubble-chamber-particles" "Particles"
|
||||
|
||||
"Four types of particles exist. The behavior and graphic appearance of "
|
||||
"each particle type is unique."
|
||||
|
||||
{ $subsection muon }
|
||||
{ $subsection quark }
|
||||
{ $subsection hadron }
|
||||
{ $subsection axion } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
ARTICLE: "bubble-chamber-author" "Author"
|
||||
|
||||
"Bubble Chamber was created by Jared Tarbell. "
|
||||
"It was originally implemented in Processing. "
|
||||
"It was ported to Factor by Eduardo Cavazos. "
|
||||
"The original work is on display here: "
|
||||
{ $url
|
||||
"http://www.complexification.net/gallery/machines/bubblechamber/" } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
ARTICLE: "bubble-chamber-running" "How to use"
|
||||
|
||||
"After you run the vocabulary, a window will appear. Click the "
|
||||
"mouse in a random area to fire 11 particles of each type. "
|
||||
"Another way to fire particles is to press the "
|
||||
"spacebar. This fires all the particles." ;
|
||||
|
|
@ -1,453 +0,0 @@
|
|||
|
||||
USING: kernel namespaces sequences combinators arrays threads
|
||||
|
||||
math
|
||||
math.libm
|
||||
math.vectors
|
||||
math.ranges
|
||||
math.constants
|
||||
math.functions
|
||||
math.points
|
||||
|
||||
ui
|
||||
ui.gadgets
|
||||
|
||||
random accessors multi-methods
|
||||
combinators.cleave
|
||||
vars locals
|
||||
|
||||
newfx
|
||||
|
||||
processing
|
||||
processing.gadget
|
||||
processing.color ;
|
||||
|
||||
IN: processing.gallery.bubble-chamber
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: move-by ( obj delta -- obj ) over pos>> v+ >>pos ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: dim ( -- dim ) 1000 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: collision-theta
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: boom
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VARS: particles muons quarks hadrons axions ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: good-colors ( -- seq )
|
||||
{
|
||||
T{ rgba f 0.23 0.14 0.17 1 }
|
||||
T{ rgba f 0.23 0.14 0.15 1 }
|
||||
T{ rgba f 0.21 0.14 0.15 1 }
|
||||
T{ rgba f 0.51 0.39 0.33 1 }
|
||||
T{ rgba f 0.49 0.33 0.20 1 }
|
||||
T{ rgba f 0.55 0.45 0.32 1 }
|
||||
T{ rgba f 0.69 0.63 0.51 1 }
|
||||
T{ rgba f 0.64 0.39 0.18 1 }
|
||||
T{ rgba f 0.73 0.42 0.20 1 }
|
||||
T{ rgba f 0.71 0.45 0.29 1 }
|
||||
T{ rgba f 0.79 0.45 0.22 1 }
|
||||
T{ rgba f 0.82 0.56 0.34 1 }
|
||||
T{ rgba f 0.88 0.72 0.49 1 }
|
||||
T{ rgba f 0.85 0.69 0.40 1 }
|
||||
T{ rgba f 0.96 0.92 0.75 1 }
|
||||
T{ rgba f 0.99 0.98 0.87 1 }
|
||||
T{ rgba f 0.85 0.82 0.69 1 }
|
||||
T{ rgba f 0.99 0.98 0.87 1 }
|
||||
T{ rgba f 0.82 0.82 0.79 1 }
|
||||
T{ rgba f 0.65 0.69 0.67 1 }
|
||||
T{ rgba f 0.53 0.60 0.55 1 }
|
||||
T{ rgba f 0.57 0.53 0.68 1 }
|
||||
T{ rgba f 0.47 0.42 0.56 1 }
|
||||
} ;
|
||||
|
||||
: good-color ( i -- color ) good-colors nth-of ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: x ( particle -- x ) pos>> first ;
|
||||
: y ( particle -- x ) pos>> second ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: out-of-bounds? ( particle -- particle ? )
|
||||
dup
|
||||
{ [ x dim neg < ] [ x dim 2 * > ] [ y dim neg < ] [ y dim 2 * > ] } cleave
|
||||
or or or ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: particle pos vel speed speed-d theta theta-d theta-dd myc mya ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: initialize-particle ( particle -- particle )
|
||||
|
||||
0 0 {2} >>pos
|
||||
0 0 {2} >>vel
|
||||
|
||||
0 >>speed
|
||||
0 >>speed-d
|
||||
0 >>theta
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
0 0 0 1 <rgba> >>myc
|
||||
0 0 0 1 <rgba> >>mya ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
GENERIC: collide ( particle -- )
|
||||
GENERIC: move ( particle -- )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: muon < particle ;
|
||||
|
||||
: <muon> ( -- muon ) muon construct-empty initialize-particle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { muon }
|
||||
|
||||
dim 2 / dup 2array >>pos
|
||||
2 32 [a,b] random >>speed
|
||||
0.0001 0.001 2random >>speed-d
|
||||
|
||||
collision-theta> -0.1 0.1 2random + >>theta
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ dup theta-dd>> abs 0.001 < ]
|
||||
[ -0.1 0.1 2random >>theta-dd ]
|
||||
[ ]
|
||||
while
|
||||
|
||||
dup theta>> pi +
|
||||
2 pi * /
|
||||
good-colors length 1 - *
|
||||
[ ] [ good-colors length >= ] [ 0 < ] tri or
|
||||
[ drop ]
|
||||
[
|
||||
[ good-color >>myc ]
|
||||
[ good-colors length swap - 1 - good-color >>mya ]
|
||||
bi
|
||||
]
|
||||
if
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { muon }
|
||||
|
||||
dup myc>> 0.16 >>alpha stroke
|
||||
dup pos>> point
|
||||
|
||||
dup mya>> 0.16 >>alpha stroke
|
||||
dup pos>> first2 >r dim swap - r> 2array point
|
||||
|
||||
dup
|
||||
[ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
|
||||
move-by
|
||||
|
||||
[ ] [ theta>> ] [ theta-d>> ] tri + >>theta
|
||||
[ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d
|
||||
[ ] [ speed>> ] [ speed-d>> ] tri - >>speed
|
||||
|
||||
out-of-bounds?
|
||||
[ collide ]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: quark < particle ;
|
||||
|
||||
: <quark> ( -- quark ) quark construct-empty initialize-particle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { quark }
|
||||
|
||||
dim 2 / dup 2array >>pos
|
||||
collision-theta> -0.11 0.11 2random + >>theta
|
||||
0.5 3.0 2random >>speed
|
||||
|
||||
0.996 1.001 2random >>speed-d
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ dup theta-dd>> abs 0.00001 < ]
|
||||
[ -0.001 0.001 2random >>theta-dd ]
|
||||
[ ]
|
||||
while
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { quark }
|
||||
|
||||
dup myc>> 0.13 >>alpha stroke
|
||||
dup pos>> point
|
||||
|
||||
dup pos>> first2 >r dim swap - r> 2array point
|
||||
|
||||
[ ] [ vel>> ] bi move-by
|
||||
|
||||
dup
|
||||
[ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
|
||||
>>vel
|
||||
|
||||
[ ] [ theta>> ] [ theta-d>> ] tri + >>theta
|
||||
[ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d
|
||||
[ ] [ speed>> ] [ speed-d>> ] tri * >>speed
|
||||
|
||||
! 1000 random 997 >
|
||||
3/1000 chance
|
||||
[
|
||||
dup speed>> neg >>speed
|
||||
2 over speed-d>> - >>speed-d
|
||||
]
|
||||
when
|
||||
|
||||
out-of-bounds?
|
||||
[ collide ]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: hadron < particle ;
|
||||
|
||||
: <hadron> ( -- hadron ) hadron construct-empty initialize-particle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { hadron }
|
||||
|
||||
dim 2 / dup 2array >>pos
|
||||
2 pi * 1random >>theta
|
||||
0.5 3.5 2random >>speed
|
||||
|
||||
0.996 1.001 2random >>speed-d
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ dup theta-dd>> abs 0.00001 < ]
|
||||
[ -0.001 0.001 2random >>theta-dd ]
|
||||
[ ]
|
||||
while
|
||||
|
||||
0 1 0 <rgb> >>myc
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { hadron }
|
||||
|
||||
{ 1 0.11 } stroke
|
||||
dup pos>> 1 v-y point
|
||||
|
||||
{ 0 0.11 } stroke
|
||||
dup pos>> 1 v+y point
|
||||
|
||||
dup vel>> move-by
|
||||
|
||||
dup
|
||||
[ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
|
||||
>>vel
|
||||
|
||||
[ ] [ theta>> ] [ theta-d>> ] tri + >>theta
|
||||
[ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d
|
||||
[ ] [ speed>> ] [ speed-d>> ] tri * >>speed
|
||||
|
||||
! 1000 random 997 >
|
||||
3/1000 chance
|
||||
[
|
||||
1.0 >>speed-d
|
||||
0.00001 >>theta-dd
|
||||
|
||||
! 100 random 70 >
|
||||
30/100 chance
|
||||
[
|
||||
dim 2 / dup 2array >>pos
|
||||
dup collide
|
||||
]
|
||||
when
|
||||
]
|
||||
when
|
||||
|
||||
out-of-bounds?
|
||||
[ collide ]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: axion < particle ;
|
||||
|
||||
: <axion> ( -- axion ) axion construct-empty initialize-particle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { axion }
|
||||
|
||||
dim 2 / dup 2array >>pos
|
||||
2 pi * 1random >>theta
|
||||
1.0 6.0 2random >>speed
|
||||
|
||||
0.998 1.000 2random >>speed-d
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ dup theta-dd>> abs 0.00001 < ]
|
||||
[ -0.001 0.001 2random >>theta-dd ]
|
||||
[ ]
|
||||
while
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { axion }
|
||||
|
||||
{ 0.06 0.59 } stroke
|
||||
dup pos>> point
|
||||
|
||||
1 4 [a,b]
|
||||
[| dy |
|
||||
1 30 dy 6 * - 255.0 / 2array stroke
|
||||
dup pos>> 0 dy neg 2array v+ point
|
||||
] with-locals
|
||||
each
|
||||
|
||||
1 4 [a,b]
|
||||
[| dy |
|
||||
0 30 dy 6 * - 255.0 / 2array stroke
|
||||
dup pos>> dy v+y point
|
||||
] with-locals
|
||||
each
|
||||
|
||||
dup vel>> move-by
|
||||
|
||||
dup
|
||||
[ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
|
||||
>>vel
|
||||
|
||||
[ ] [ theta>> ] [ theta-d>> ] tri + >>theta
|
||||
[ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d
|
||||
[ ] [ speed>> ] [ speed-d>> ] tri * >>speed
|
||||
|
||||
[ ] [ speed-d>> 0.9999 * ] bi >>speed-d
|
||||
|
||||
! 1000 random 996 >
|
||||
4/1000 chance
|
||||
[
|
||||
dup speed>> neg >>speed
|
||||
dup speed-d>> neg 2 + >>speed-d
|
||||
|
||||
! 100 random 30 >
|
||||
70/100 chance
|
||||
[
|
||||
dim 2 / dup 2array >>pos
|
||||
collide
|
||||
]
|
||||
[ drop ]
|
||||
if
|
||||
]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! : draw ( -- )
|
||||
|
||||
! boom>
|
||||
! [ particles> [ move ] each ]
|
||||
! when ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: collide-all ( -- )
|
||||
|
||||
2 pi * 1random >collision-theta
|
||||
|
||||
particles> [ collide ] each ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: collide-one ( -- )
|
||||
|
||||
dim 2 / mouse-x - dim 2 / mouse-y - fatan2 >collision-theta
|
||||
|
||||
hadrons> random collide
|
||||
quarks> random collide
|
||||
muons> random collide ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: mouse-pressed ( -- )
|
||||
boom on
|
||||
1 background ! kludge
|
||||
11 [ drop collide-one ] each ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: key-released ( -- )
|
||||
key " " =
|
||||
[
|
||||
boom on
|
||||
1 background
|
||||
collide-all
|
||||
]
|
||||
when ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: bubble-chamber ( -- )
|
||||
|
||||
1000 1000 size*
|
||||
|
||||
[
|
||||
1 background
|
||||
no-stroke
|
||||
|
||||
1789 [ drop <muon> ] map >muons
|
||||
1300 [ drop <quark> ] map >quarks
|
||||
1000 [ drop <hadron> ] map >hadrons
|
||||
111 [ drop <axion> ] map >axions
|
||||
|
||||
muons> quarks> hadrons> axions> 3append append >particles
|
||||
|
||||
collide-one
|
||||
] setup
|
||||
|
||||
[
|
||||
boom>
|
||||
[ particles> [ move ] each ]
|
||||
when
|
||||
] draw
|
||||
|
||||
[ mouse-pressed ] button-down
|
||||
[ key-released ] key-up
|
||||
|
||||
;
|
||||
|
||||
: go ( -- ) [ bubble-chamber run ] with-ui ;
|
||||
|
||||
MAIN: go
|
||||
|
|
@ -8,7 +8,7 @@ USING: kernel namespaces threads combinators sequences arrays
|
|||
combinators
|
||||
combinators.lib
|
||||
combinators.cleave
|
||||
rewrite-closures fry accessors
|
||||
rewrite-closures fry accessors newfx
|
||||
processing.color
|
||||
processing.gadget ;
|
||||
|
||||
|
|
@ -28,6 +28,14 @@ IN: processing
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! : at-fraction ( seq fraction -- val ) over length 1- * nth-at ;
|
||||
|
||||
: at-fraction ( seq fraction -- val ) over length 1- * at ;
|
||||
|
||||
: at-fraction-of ( fraction seq -- val ) swap at-fraction ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: fill-color
|
||||
VAR: stroke-color
|
||||
|
||||
|
|
@ -282,7 +290,7 @@ VAR: frame-rate-value
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: slate
|
||||
! VAR: slate
|
||||
|
||||
VAR: loop-flag
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,28 @@
|
|||
USING: kernel math tools.test namespaces random
|
||||
random.blum-blum-shub ;
|
||||
IN: blum-blum-shub.tests
|
||||
|
||||
[ 887708070 ] [
|
||||
T{ blum-blum-shub f 590695557939 811977232793 } random-32*
|
||||
] unit-test
|
||||
|
||||
|
||||
[ 887708070 ] [
|
||||
T{ blum-blum-shub f 590695557939 811977232793 } [
|
||||
32 random-bits
|
||||
] with-random
|
||||
] unit-test
|
||||
|
||||
[ 5726770047455156646 ] [
|
||||
T{ blum-blum-shub f 590695557939 811977232793 } [
|
||||
64 random-bits
|
||||
] with-random
|
||||
] unit-test
|
||||
|
||||
[ 3716213681 ]
|
||||
[
|
||||
100 T{ blum-blum-shub f 200352954495 846054538649 } tuck [
|
||||
random-32* drop
|
||||
] curry times
|
||||
random-32*
|
||||
] unit-test
|
||||
|
|
@ -3,34 +3,26 @@ math.miller-rabin combinators.lib
|
|||
math.functions accessors random ;
|
||||
IN: random.blum-blum-shub
|
||||
|
||||
! TODO: take (log log M) bits instead of 1 bit
|
||||
! Blum Blum Shub, M = pq
|
||||
! Blum Blum Shub, n = pq, x_i+1 = x_i ^ 2 mod n
|
||||
! return low bit of x+1
|
||||
TUPLE: blum-blum-shub x n ;
|
||||
|
||||
C: <blum-blum-shub> blum-blum-shub
|
||||
<PRIVATE
|
||||
|
||||
: generate-bbs-primes ( numbits -- p q )
|
||||
#! two primes congruent to 3 (mod 4)
|
||||
[ [ random-prime ] curry [ 4 mod 3 = ] generate ] dup bi ;
|
||||
|
||||
IN: crypto
|
||||
: <blum-blum-shub> ( numbits -- blum-blum-shub )
|
||||
#! returns a Blum-Blum-Shub tuple
|
||||
generate-bbs-primes *
|
||||
[ find-relative-prime ] keep
|
||||
blum-blum-shub construct-boa ;
|
||||
|
||||
! 256 make-bbs blum-blum-shub set-global
|
||||
|
||||
: next-bbs-bit ( bbs -- bit )
|
||||
#! x = x^2 mod n, return low bit of calculated x
|
||||
[ [ x>> 2 ] [ n>> ] bi ^mod ]
|
||||
[ [ >>x ] keep x>> 1 bitand ] bi ;
|
||||
[ [ x>> 2 ] [ n>> ] bi ^mod ] keep
|
||||
over >>x drop 1 bitand ;
|
||||
|
||||
IN: crypto
|
||||
! : random ( n -- n )
|
||||
! ! #! Cryptographically secure random number using Blum-Blum-Shub 256
|
||||
! [ log2 1+ random-bits ] keep dupd >= [ -1 shift ] when ;
|
||||
PRIVATE>
|
||||
|
||||
M: blum-blum-shub random-32* ( bbs -- r )
|
||||
;
|
||||
0 32 rot
|
||||
[ next-bbs-bit swap 1 shift bitor ] curry times ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,8 @@
|
|||
IN: tools.vocabs.tests
|
||||
USING: tools.test tools.vocabs namespaces continuations ;
|
||||
|
||||
[ ] [
|
||||
changed-vocabs get-global
|
||||
f changed-vocabs set-global
|
||||
[ "kernel" changed-vocab ] [ changed-vocabs set-global ] [ ] cleanup
|
||||
] unit-test
|
||||
|
|
@ -76,11 +76,11 @@ SYMBOL: changed-vocabs
|
|||
[ f changed-vocabs set-global ] "tools.vocabs" add-init-hook
|
||||
|
||||
: changed-vocab ( vocab -- )
|
||||
dup vocab
|
||||
[ dup changed-vocabs get-global set-at ] [ drop ] if ;
|
||||
dup vocab changed-vocabs get and
|
||||
[ dup changed-vocabs get set-at ] [ drop ] if ;
|
||||
|
||||
: unchanged-vocab ( vocab -- )
|
||||
changed-vocabs get-global delete-at ;
|
||||
changed-vocabs get delete-at ;
|
||||
|
||||
: unchanged-vocabs ( vocabs -- )
|
||||
[ unchanged-vocab ] each ;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,27 @@
|
|||
IN: ui.tools.interactor.tests
|
||||
USING: ui.tools.interactor tools.test ;
|
||||
USING: ui.tools.interactor ui.gadgets.panes namespaces
|
||||
ui.gadgets.editors concurrency.promises threads listener
|
||||
tools.test kernel calendar ;
|
||||
|
||||
\ <interactor> must-infer
|
||||
|
||||
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||
|
||||
[ ] [ "[ 1 2 3" "interactor" get set-editor-string ] unit-test
|
||||
|
||||
[ ] [ <promise> "promise" set ] unit-test
|
||||
|
||||
[
|
||||
"interactor" get stream-read-quot "promise" get fulfill
|
||||
] "Interactor test" spawn drop
|
||||
|
||||
! This should not throw an exception
|
||||
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||
|
||||
[ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test
|
||||
|
||||
[ ] [ "[ 1 2 3 ]" "interactor" get set-editor-string ] unit-test
|
||||
|
||||
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||
|
||||
[ [ [ 1 2 3 ] ] ] [ "promise" get 5 seconds ?promise-timeout ] unit-test
|
||||
|
|
|
|||
|
|
@ -138,7 +138,9 @@ M: interactor stream-read-partial
|
|||
drop parse-lines-interactive
|
||||
] [
|
||||
2nip
|
||||
dup delegate unexpected-eof? [ drop f ] when
|
||||
dup parse-error? [
|
||||
dup error>> unexpected-eof? [ drop f ] when
|
||||
] when
|
||||
] recover ;
|
||||
|
||||
: handle-interactive ( lines interactor -- quot/f ? )
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ vectors words windows.kernel32 windows.gdi32 windows.user32
|
|||
windows.opengl32 windows.messages windows.types windows.nt
|
||||
windows threads libc combinators continuations command-line
|
||||
shuffle opengl ui.render unicode.case ascii math.bitfields
|
||||
locals symbols ;
|
||||
locals symbols accessors ;
|
||||
IN: ui.windows
|
||||
|
||||
SINGLETON: windows-ui-backend
|
||||
|
|
@ -203,8 +203,18 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
|
|||
wParam keystroke>gesture <key-up>
|
||||
hWnd window-focus send-gesture drop ;
|
||||
|
||||
: set-window-active ( hwnd uMsg wParam lParam ? -- n )
|
||||
>r 4dup r> 2nip nip
|
||||
swap window set-world-active? DefWindowProc ;
|
||||
|
||||
: handle-wm-syscommand ( hWnd uMsg wParam lParam -- n )
|
||||
dup alpha? [ 4drop 0 ] [ DefWindowProc ] if ;
|
||||
{
|
||||
{ [ over SC_MINIMIZE = ] [ f set-window-active ] }
|
||||
{ [ over SC_RESTORE = ] [ t set-window-active ] }
|
||||
{ [ over SC_MAXIMIZE = ] [ t set-window-active ] }
|
||||
{ [ dup alpha? ] [ 4drop 0 ] }
|
||||
{ [ t ] [ DefWindowProc ] }
|
||||
} cond ;
|
||||
|
||||
: cleanup-window ( handle -- )
|
||||
dup win-title [ free ] when*
|
||||
|
|
|
|||
|
|
@ -61,6 +61,133 @@ LIBRARY: advapi32
|
|||
: CRYPT_MACHINE_KEYSET HEX: 20 ; inline
|
||||
: CRYPT_SILENT HEX: 40 ; inline
|
||||
|
||||
C-STRUCT: ACL
|
||||
{ "BYTE" "AclRevision" }
|
||||
{ "BYTE" "Sbz1" }
|
||||
{ "WORD" "AclSize" }
|
||||
{ "WORD" "AceCount" }
|
||||
{ "WORD" "Sbz2" } ;
|
||||
|
||||
TYPEDEF: ACL* PACL
|
||||
|
||||
: ACCESS_ALLOWED_ACE_TYPE 0 ; inline
|
||||
: ACCESS_DENIED_ACE_TYPE 1 ; inline
|
||||
: SYSTEM_AUDIT_ACE_TYPE 2 ; inline
|
||||
: SYSTEM_ALARM_ACE_TYPE 3 ; inline
|
||||
|
||||
: OBJECT_INHERIT_ACE HEX: 1 ; inline
|
||||
: CONTAINER_INHERIT_ACE HEX: 2 ; inline
|
||||
: NO_PROPAGATE_INHERIT_ACE HEX: 4 ; inline
|
||||
: INHERIT_ONLY_ACE HEX: 8 ; inline
|
||||
: VALID_INHERIT_FLAGS HEX: f ; inline
|
||||
|
||||
C-STRUCT: ACE_HEADER
|
||||
{ "BYTE" "AceType" }
|
||||
{ "BYTE" "AceFlags" }
|
||||
{ "WORD" "AceSize" } ;
|
||||
|
||||
TYPEDEF: ACE_HEADER* PACE_HEADER
|
||||
|
||||
C-STRUCT: ACCESS_ALLOWED_ACE
|
||||
{ "ACE_HEADER" "Header" }
|
||||
{ "DWORD" "Mask" }
|
||||
{ "DWORD" "SidStart" } ;
|
||||
|
||||
TYPEDEF: ACCESS_ALLOWED_ACE* PACCESS_ALLOWED_ACE
|
||||
|
||||
C-STRUCT: ACCESS_DENIED_ACE
|
||||
{ "ACE_HEADER" "Header" }
|
||||
{ "DWORD" "Mask" }
|
||||
{ "DWORD" "SidStart" } ;
|
||||
TYPEDEF: ACCESS_DENIED_ACE* PACCESS_DENIED_ACE
|
||||
|
||||
|
||||
C-STRUCT: SYSTEM_AUDIT_ACE
|
||||
{ "ACE_HEADER" "Header" }
|
||||
{ "DWORD" "Mask" }
|
||||
{ "DWORD" "SidStart" } ;
|
||||
|
||||
TYPEDEF: SYSTEM_AUDIT_ACE* PSYSTEM_AUDIT_ACE
|
||||
|
||||
C-STRUCT: SYSTEM_ALARM_ACE
|
||||
{ "ACE_HEADER" "Header" }
|
||||
{ "DWORD" "Mask" }
|
||||
{ "DWORD" "SidStart" } ;
|
||||
|
||||
TYPEDEF: SYSTEM_ALARM_ACE* PSYSTEM_ALARM_ACE
|
||||
|
||||
C-STRUCT: ACCESS_ALLOWED_CALLBACK_ACE
|
||||
{ "ACE_HEADER" "Header" }
|
||||
{ "DWORD" "Mask" }
|
||||
{ "DWORD" "SidStart" } ;
|
||||
|
||||
TYPEDEF: ACCESS_ALLOWED_CALLBACK_ACE* PACCESS_ALLOWED_CALLBACK_ACE
|
||||
|
||||
|
||||
! typedef enum _TOKEN_INFORMATION_CLASS {
|
||||
: TokenUser 1 ; inline
|
||||
: TokenGroups 2 ; inline
|
||||
: TokenPrivileges 3 ; inline
|
||||
: TokenOwner 4 ; inline
|
||||
: TokenPrimaryGroup 5 ; inline
|
||||
: TokenDefaultDacl 6 ; inline
|
||||
: TokenSource 7 ; inline
|
||||
: TokenType 8 ; inline
|
||||
: TokenImpersonationLevel 9 ; inline
|
||||
: TokenStatistics 10 ; inline
|
||||
: TokenRestrictedSids 11 ; inline
|
||||
: TokenSessionId 12 ; inline
|
||||
: TokenGroupsAndPrivileges 13 ; inline
|
||||
: TokenSessionReference 14 ; inline
|
||||
: TokenSandBoxInert 15 ; inline
|
||||
! } TOKEN_INFORMATION_CLASS;
|
||||
|
||||
: DELETE HEX: 00010000 ; inline
|
||||
: READ_CONTROL HEX: 00020000 ; inline
|
||||
: WRITE_DAC HEX: 00040000 ; inline
|
||||
: WRITE_OWNER HEX: 00080000 ; inline
|
||||
: SYNCHRONIZE HEX: 00100000 ; inline
|
||||
: STANDARD_RIGHTS_REQUIRED HEX: 000f0000 ; inline
|
||||
|
||||
: STANDARD_RIGHTS_READ READ_CONTROL ; inline
|
||||
: STANDARD_RIGHTS_WRITE READ_CONTROL ; inline
|
||||
: STANDARD_RIGHTS_EXECUTE READ_CONTROL ; inline
|
||||
|
||||
: TOKEN_TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline
|
||||
: TOKEN_ADJUST_GROUPS HEX: 0040 ; inline
|
||||
: TOKEN_ADJUST_PRIVILEGES HEX: 0020 ; inline
|
||||
: TOKEN_ADJUST_SESSIONID HEX: 0100 ; inline
|
||||
: TOKEN_ASSIGN_PRIMARY HEX: 0001 ; inline
|
||||
: TOKEN_DUPLICATE HEX: 0002 ; inline
|
||||
: TOKEN_EXECUTE STANDARD_RIGHTS_EXECUTE ; inline
|
||||
: TOKEN_IMPERSONATE HEX: 0004 ; inline
|
||||
: TOKEN_QUERY HEX: 0008 ; inline
|
||||
: TOKEN_QUERY_SOURCE HEX: 0010 ; inline
|
||||
: TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline
|
||||
: TOKEN_READ STANDARD_RIGHTS_READ TOKEN_QUERY bitor ;
|
||||
|
||||
: TOKEN_WRITE
|
||||
{
|
||||
STANDARD_RIGHTS_WRITE
|
||||
TOKEN_ADJUST_PRIVILEGES
|
||||
TOKEN_ADJUST_GROUPS
|
||||
TOKEN_ADJUST_DEFAULT
|
||||
} flags ; foldable
|
||||
|
||||
: TOKEN_ALL_ACCESS
|
||||
{
|
||||
STANDARD_RIGHTS_REQUIRED
|
||||
TOKEN_ASSIGN_PRIMARY
|
||||
TOKEN_DUPLICATE
|
||||
TOKEN_IMPERSONATE
|
||||
TOKEN_QUERY
|
||||
TOKEN_QUERY_SOURCE
|
||||
TOKEN_ADJUST_PRIVILEGES
|
||||
TOKEN_ADJUST_GROUPS
|
||||
TOKEN_ADJUST_SESSIONID
|
||||
TOKEN_ADJUST_DEFAULT
|
||||
} flags ; foldable
|
||||
|
||||
|
||||
! : I_ScGetCurrentGroupStateW ;
|
||||
! : A_SHAFinal ;
|
||||
|
|
@ -85,7 +212,7 @@ LIBRARY: advapi32
|
|||
! : AddAccessDeniedAce ;
|
||||
! : AddAccessDeniedAceEx ;
|
||||
! : AddAccessDeniedObjectAce ;
|
||||
! : AddAce ;
|
||||
FUNCTION: BOOL AddAce ( PACL pAcl, DWORD dwAceRevision, DWORD dwStartingAceIndex, LPVOID pAceList, DWORD nAceListLength ) ;
|
||||
! : AddAuditAccessAce ;
|
||||
! : AddAuditAccessAceEx ;
|
||||
! : AddAuditAccessObjectAce ;
|
||||
|
|
@ -382,7 +509,7 @@ FUNCTION: BOOL GetUserNameW ( LPCTSTR lpBuffer, LPDWORD lpnSize ) ;
|
|||
! : ImpersonateLoggedOnUser ;
|
||||
! : ImpersonateNamedPipeClient ;
|
||||
! : ImpersonateSelf ;
|
||||
! : InitializeAcl ;
|
||||
FUNCTION: BOOL InitializeAcl ( PACL pAcl, DWORD nAclLength, DWORD dwAclRevision ) ;
|
||||
! : InitializeSecurityDescriptor ;
|
||||
! : InitializeSid ;
|
||||
! : InitiateSystemShutdownA ;
|
||||
|
|
@ -508,70 +635,6 @@ FUNCTION: BOOL LookupPrivilegeValueW ( LPCTSTR lpSystemName,
|
|||
! : OpenEventLogA ;
|
||||
! : OpenEventLogW ;
|
||||
|
||||
! typedef enum _TOKEN_INFORMATION_CLASS {
|
||||
: TokenUser 1 ;
|
||||
: TokenGroups 2 ;
|
||||
: TokenPrivileges 3 ;
|
||||
: TokenOwner 4 ;
|
||||
: TokenPrimaryGroup 5 ;
|
||||
: TokenDefaultDacl 6 ;
|
||||
: TokenSource 7 ;
|
||||
: TokenType 8 ;
|
||||
: TokenImpersonationLevel 9 ;
|
||||
: TokenStatistics 10 ;
|
||||
: TokenRestrictedSids 11 ;
|
||||
: TokenSessionId 12 ;
|
||||
: TokenGroupsAndPrivileges 13 ;
|
||||
: TokenSessionReference 14 ;
|
||||
: TokenSandBoxInert 15 ;
|
||||
! } TOKEN_INFORMATION_CLASS;
|
||||
|
||||
: DELETE HEX: 00010000 ; inline
|
||||
: READ_CONTROL HEX: 00020000 ; inline
|
||||
: WRITE_DAC HEX: 00040000 ; inline
|
||||
: WRITE_OWNER HEX: 00080000 ; inline
|
||||
: SYNCHRONIZE HEX: 00100000 ; inline
|
||||
: STANDARD_RIGHTS_REQUIRED HEX: 000f0000 ; inline
|
||||
|
||||
: STANDARD_RIGHTS_READ READ_CONTROL ; inline
|
||||
: STANDARD_RIGHTS_WRITE READ_CONTROL ; inline
|
||||
: STANDARD_RIGHTS_EXECUTE READ_CONTROL ; inline
|
||||
|
||||
: TOKEN_TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline
|
||||
: TOKEN_ADJUST_GROUPS HEX: 0040 ; inline
|
||||
: TOKEN_ADJUST_PRIVILEGES HEX: 0020 ; inline
|
||||
: TOKEN_ADJUST_SESSIONID HEX: 0100 ; inline
|
||||
: TOKEN_ASSIGN_PRIMARY HEX: 0001 ; inline
|
||||
: TOKEN_DUPLICATE HEX: 0002 ; inline
|
||||
: TOKEN_EXECUTE STANDARD_RIGHTS_EXECUTE ; inline
|
||||
: TOKEN_IMPERSONATE HEX: 0004 ; inline
|
||||
: TOKEN_QUERY HEX: 0008 ; inline
|
||||
: TOKEN_QUERY_SOURCE HEX: 0010 ; inline
|
||||
: TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline
|
||||
: TOKEN_READ STANDARD_RIGHTS_READ TOKEN_QUERY bitor ;
|
||||
|
||||
: TOKEN_WRITE
|
||||
{
|
||||
STANDARD_RIGHTS_WRITE
|
||||
TOKEN_ADJUST_PRIVILEGES
|
||||
TOKEN_ADJUST_GROUPS
|
||||
TOKEN_ADJUST_DEFAULT
|
||||
} flags ; foldable
|
||||
|
||||
: TOKEN_ALL_ACCESS
|
||||
{
|
||||
STANDARD_RIGHTS_REQUIRED
|
||||
TOKEN_ASSIGN_PRIMARY
|
||||
TOKEN_DUPLICATE
|
||||
TOKEN_IMPERSONATE
|
||||
TOKEN_QUERY
|
||||
TOKEN_QUERY_SOURCE
|
||||
TOKEN_ADJUST_PRIVILEGES
|
||||
TOKEN_ADJUST_GROUPS
|
||||
TOKEN_ADJUST_SESSIONID
|
||||
TOKEN_ADJUST_DEFAULT
|
||||
} flags ; foldable
|
||||
|
||||
FUNCTION: BOOL OpenProcessToken ( HANDLE ProcessHandle,
|
||||
DWORD DesiredAccess,
|
||||
PHANDLE TokenHandle ) ;
|
||||
|
|
|
|||
|
|
@ -1001,3 +1001,25 @@ windows-messages set-global
|
|||
: LM_GETIDEALHEIGHT WM_USER HEX: 0301 + ; inline
|
||||
: LM_SETITEM WM_USER HEX: 0302 + ; inline
|
||||
: LM_GETITEM WM_USER HEX: 0303 + ; inline
|
||||
|
||||
|
||||
: WA_INACTIVE 0 ; inline
|
||||
: WA_ACTIVE 1 ; inline
|
||||
: WA_CLICKACTIVE 2 ; inline
|
||||
|
||||
: SC_SIZE HEX: f000 ; inline
|
||||
: SC_MOVE HEX: f010 ; inline
|
||||
: SC_MINIMIZE HEX: f020 ; inline
|
||||
: SC_MAXIMIZE HEX: f030 ; inline
|
||||
: SC_NEXTWINDOW HEX: f040 ; inline
|
||||
: SC_PREVWINDOW HEX: f050 ; inline
|
||||
: SC_CLOSE HEX: f060 ; inline
|
||||
: SC_VSCROLL HEX: f070 ; inline
|
||||
: SC_HSCROLL HEX: f080 ; inline
|
||||
: SC_MOUSEMENU HEX: f090 ; inline
|
||||
: SC_KEYMENU HEX: f100 ; inline
|
||||
: SC_ARRANGE HEX: f110 ; inline
|
||||
: SC_RESTORE HEX: f120 ; inline
|
||||
: SC_TASKLIST HEX: f130 ; inline
|
||||
: SC_SCREENSAVE HEX: f140 ; inline
|
||||
: SC_HOTKEY HEX: f150 ; inline
|
||||
|
|
|
|||
Loading…
Reference in New Issue