diff --git a/basis/http/server/cgi/cgi.factor b/basis/http/server/cgi/cgi.factor index 59cd62f338..0c2f639cba 100644 --- a/basis/http/server/cgi/cgi.factor +++ b/basis/http/server/cgi/cgi.factor @@ -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 binary [ post-request? [ request get post-data>> raw>> write flush ] when input-stream get swap (stream-copy) diff --git a/extra/L-system/L-system.factor b/extra/L-system/L-system.factor index 97a971de47..9b8bdc1914 100644 --- a/extra/L-system/L-system.factor +++ b/extra/L-system/L-system.factor @@ -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: < 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: < 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: < 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:: 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:: 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 ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + 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 ) 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" \ No newline at end of file diff --git a/extra/L-system/models/abop-1/abop-1.factor b/extra/L-system/models/abop-1/abop-1.factor index 45cc522470..34f1d4777a 100644 --- a/extra/L-system/models/abop-1/abop-1.factor +++ b/extra/L-system/models/abop-1/abop-1.factor @@ -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 ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/L-system/models/abop-2/abop-2.factor b/extra/L-system/models/abop-2/abop-2.factor new file mode 100644 index 0000000000..2ed8f64abe --- /dev/null +++ b/extra/L-system/models/abop-2/abop-2.factor @@ -0,0 +1,28 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-2 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-2 ( -- ) + + 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 + \ No newline at end of file