steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Daniel Ehrenberg 2009-01-07 17:59:56 -06:00
parent 501fb3ccf1 d75f686a68
commit 844855854b
4 changed files with 107 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/http/server/cgi/cgi.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel assocs io.files io.streams.duplex
combinators arrays io.launcher io.encodings.binary io
combinators arrays io.launcher io.encodings io.encodings.binary io
http.server.static http.server http accessors sequences strings
math.parser fry urls urls.encoding calendar ;
IN: http.server.cgi
@ -52,6 +52,7 @@ IN: http.server.cgi
200 >>code
"CGI output follows" >>message
swap '[
binary encode-output
_ output-stream get swap <cgi-process> binary <process-stream> [
post-request? [ request get post-data>> raw>> write flush ] when
input-stream get swap (stream-copy)

86
extra/L-system/L-system.factor
View File

@ -1,9 +1,10 @@
USING: accessors arrays assocs colors combinators.short-circuit
kernel locals math math.functions math.matrices math.order
math.parser math.trig math.vectors opengl opengl.demo-support
opengl.gl sbufs sequences strings ui.gadgets ui.gadgets.worlds
ui.gestures ui.render ;
USING: accessors arrays assocs calendar colors
combinators.short-circuit help.markup help.syntax kernel locals
math math.functions math.matrices math.order math.parser
math.trig math.vectors opengl opengl.demo-support opengl.gl
sbufs sequences strings threads ui.gadgets ui.gadgets.worlds
ui.gestures ui.render ui.tools.workspace ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -255,8 +256,26 @@ DEFER: default-L-parser-values
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: <L-system> < gadget
camera display-list
commands axiom rules string ;
camera display-list pedestal paused commands axiom rules string ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: iterate-system ( GADGET -- ) GADGET pedestal>> 0.5 + GADGET (>>pedestal) ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: start-rotation-thread ( GADGET -- )
GADGET f >>paused drop
[
[
GADGET paused>>
[ f ]
[ GADGET iterate-system GADGET relayout-1 25 milliseconds sleep t ]
if
]
loop
]
in-thread ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -332,7 +351,7 @@ TUPLE: <L-system> < gadget
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: iterate-L-system-string ( L-SYSTEM -- )
L-SYSTEM string>>
L-SYSTEM string>> L-SYSTEM axiom>> or
L-SYSTEM rules>>
iterate-string
L-SYSTEM (>>string) ;
@ -357,7 +376,7 @@ TUPLE: <L-system> < gadget
L-SYSTEM display-list>> GL_COMPILE glNewList
turtle
L-SYSTEM string>>
L-SYSTEM string>> L-SYSTEM axiom>> or
L-SYSTEM commands>>
interpret-string
drop
@ -387,6 +406,10 @@ M:: <L-system> draw-gadget* ( L-SYSTEM -- )
! draw axis
white gl-color GL_LINES glBegin { 0 0 0 } gl-vertex { 0 0 1 } gl-vertex glEnd
! rotate pedestal
L-SYSTEM pedestal>> 0 0 1 glRotated
L-SYSTEM display-list>> glCallList ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -403,16 +426,12 @@ M:: <L-system> pref-dim* ( L-SYSTEM -- dim ) { 400 400 } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: camera-left ( L-SYSTEM -- )
L-SYSTEM camera>> 5 turn-left drop
L-SYSTEM relayout-1 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: with-camera ( L-SYSTEM QUOT -- )
L-SYSTEM camera>> QUOT call drop
L-SYSTEM relayout-1 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
<L-system>
H{
{ T{ key-down f f "LEFT" } [ [ 5 turn-left ] with-camera ] }
@ -423,6 +442,11 @@ H{
{ T{ key-down f f "a" } [ [ 1 step-turtle ] with-camera ] }
{ T{ key-down f f "z" } [ [ -1 step-turtle ] with-camera ] }
{ T{ key-down f f "q" } [ [ 5 roll-left ] with-camera ] }
{ T{ key-down f f "w" } [ [ 5 roll-right ] with-camera ] }
{ T{ key-down f f "r" } [ start-rotation-thread ] }
{
T{ key-down f f "x" }
[
@ -432,6 +456,8 @@ H{
drop
]
}
{ T{ key-down f f "F1" } [ drop "L-system" help-window ] }
}
set-gestures
@ -441,8 +467,36 @@ set-gestures
: L-system ( -- L-system )
<L-system> new-gadget
0 >>pedestal
turtle 45 turn-left 45 pitch-up 5 step-turtle 180 turn-left >>camera ;
! turtle 45 turn-left 45 pitch-up 5 step-turtle 180 turn-left >>camera ;
turtle 90 pitch-down -5 step-turtle 2 strafe-up >>camera
dup start-rotation-thread
;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ARTICLE: "L-system" "L-system"
"Press 'x' to iterate the L-system." $nl
"Camera control:"
{ $table
{ "a" "Forward" }
{ "z" "Backward" }
{ "LEFT" "Turn left" }
{ "RIGHT" "Turn right" }
{ "UP" "Pitch down" }
{ "DOWN" "Pitch up" }
{ "q" "Roll left" }
{ "w" "Roll right" } } ;
ABOUT: "L-system"

14
extra/L-system/models/abop-1/abop-1.factor
View File

@ -1,5 +1,5 @@
USING: accessors kernel ui L-system ;
USING: accessors ui L-system ;
IN: L-system.models.abop-1
@ -12,15 +12,13 @@ IN: L-system.models.abop-1
"c(12)FFAL" >>axiom
{
{ "A" "F[&'(.8)!BL]>(137)'!(.9)A" }
{ "B" "F[-'(.8)!(.9)$CL]'!(.9)C" }
{ "C" "F[+'(.8)!(.9)$BL]'!(.9)B" }
{ "A" "F [ & '(.8) ! B L ] >(137) ' !(.9) A" }
{ "B" "F [ - '(.8) !(.9) $ C L ] ' !(.9) C" }
{ "C" "F [ + '(.8) !(.9) $ B L ] ' !(.9) B" }
{ "L" "~c(8){+(30)f-(120)f-(120)f}" }
{ "L" " ~ c(8) { +(30) f -(120) f -(120) f }" }
}
>>rules
dup axiom>> >>string ;
>>rules ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

28
extra/L-system/models/abop-2/abop-2.factor Normal file
View File

@ -0,0 +1,28 @@
USING: accessors ui L-system ;
IN: L-system.models.abop-2
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: abop-2 ( <L-system> -- <L-system> )
L-parser-dialect >>commands
"c(12)FAL" >>axiom
{
{ "A" "F[&'(.7)!BL]>(137)[&'(.6)!BL]>(137)'(.9)!(.9)A" }
{ "B" "F[-'(.7)!(.9)$CL]'(.9)!(.9)C" }
{ "C" "F[+'(.7)!(.9)$BL]'(.9)!(.9)B" }
{ "L" "~c(8){+f(.1)-f(.1)-f(.1)+|+f(.1)-f(.1)-f(.1)}" }
} >>rules ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: main ( -- ) [ L-system abop-2 "L-system" open-window ] with-ui ;
MAIN: main