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

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 <cgi-process> binary <process-stream> [
             post-request? [ request get post-data>> raw>> write flush ] when
             input-stream get swap (stream-copy)

extra/L-system/L-system.factor

@@ -1,9 +1,10 @@
 
-USING: accessors arrays assocs colors combinators.short-circuit
+USING: accessors arrays assocs calendar colors
-kernel locals math math.functions math.matrices math.order
+combinators.short-circuit help.markup help.syntax kernel locals
-math.parser math.trig math.vectors opengl opengl.demo-support
+math math.functions math.matrices math.order math.parser
-opengl.gl sbufs sequences strings ui.gadgets ui.gadgets.worlds
+math.trig math.vectors opengl opengl.demo-support opengl.gl
-ui.gestures ui.render ;
+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
+  camera display-list pedestal paused commands axiom rules string ;
-  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" }
     [
@@ -433,6 +457,8 @@ H{
     ]
   }
 
+  { T{ key-down f f "F1" } [ drop "L-system" help-window ] }
+    
 }
 set-gestures
 
@@ -442,7 +468,35 @@ set-gestures
 
   <L-system> new-gadget
 
-    turtle 45 turn-left 45 pitch-up 5 step-turtle 180 turn-left >>camera ;
+    0 >>pedestal
+  
+    ! 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"

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"   }
+    { "A" "F [ & '(.8) !       B L ] >(137) ' !(.9) A" }
-    { "B" "F[-'(.8)!(.9)$CL]'!(.9)C"    }
+    { "B" "F [ - '(.8) !(.9) $ C L ]        ' !(.9) C" }
-    { "C" "F[+'(.8)!(.9)$BL]'!(.9)B"    }
+    { "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
+  >>rules ;
-
-  dup axiom>> >>string ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

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-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
+