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

extra/mason/notify/notify.factor

@@ -42,8 +42,10 @@ IN: mason.notify
 : notify-report ( status -- )
     [ "Build finished with status: " write . flush ]
     [
-        [ "report" utf8 file-contents ] dip email-report
-        "report" { "report" } status-notify
+        [ "report" ] dip
+        [ [ utf8 file-contents ] dip email-report ]
+        [ "report" swap name>> 2array status-notify ]
+        2bi
     ] bi ;
 
 : notify-release ( archive-name -- )

extra/mason/notify/server/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/mason/notify/server/server.factor

@@ -0,0 +1,82 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators combinators.smart command-line db
+db.sqlite db.tuples db.types io kernel namespaces sequences ;
+IN: mason.notify.server
+
+CONSTANT: +starting+ "starting"
+CONSTANT: +make-vm+ "make-vm"
+CONSTANT: +boot+ "boot"
+CONSTANT: +test+ "test"
+CONSTANT: +clean+ "clean"
+CONSTANT: +dirty+ "dirty"
+
+TUPLE: builder host-name os cpu clean-git-id last-git-id last-report current-git-id status ;
+
+builder "BUILDERS" {
+    { "host-name" "HOST_NAME" TEXT +user-assigned-id+ }
+    { "os" "OS" TEXT +user-assigned-id+ }
+    { "cpu" "CPU" TEXT +user-assigned-id+ }
+    { "clean-git-id" "CLEAN_GIT_ID" TEXT }
+    { "last-git-id" "LAST_GIT_ID" TEXT }
+    { "last-report" "LAST_REPORT" TEXT }
+    { "current-git-id" "CURRENT_GIT_ID" TEXT }
+    { "status" "STATUS" TEXT }
+} define-persistent
+
+SYMBOLS: host-name target-os target-cpu message message-arg ;
+
+: parse-args ( command-line -- )
+    dup peek message-arg set
+    [
+        {
+            [ host-name set ]
+            [ target-os set ]
+            [ target-cpu set ]
+            [ message set ]
+        } spread
+    ] input<sequence ;
+
+: find-builder ( -- builder )
+    builder new
+        host-name get >>host-name
+        target-os get >>os
+        target-cpu get >>cpu
+    dup select-tuple [ ] [ dup insert-tuple ] ?if ;
+
+: git-id ( builder id -- )
+    >>current-git-id +starting+ >>status drop ;
+
+: make-vm ( builder -- ) +make-vm+ >>status drop ;
+
+: boot ( report -- ) +boot+ >>status drop ;
+
+: test ( report -- ) +test+ >>status drop ;
+
+: report ( builder status content -- )
+    [ >>status ] [ >>last-report ] bi*
+    dup status>> +clean+ = [ dup current-git-id>> >>clean-git-id ] when
+    dup current-git-id>> >>last-git-id
+    drop ;
+
+: update-builder ( builder -- )
+    message get {
+        { "git-id" [ message-arg get git-id ] }
+        { "make-vm" [ make-vm ] }
+        { "boot" [ boot ] }
+        { "test" [ test ] }
+        { "report" [ message-arg get contents report ] }
+    } case ;
+
+: mason-db ( -- db ) "resource:mason.db" <sqlite-db> ;
+
+: handle-update ( command-line -- )
+    mason-db [
+        parse-args find-builder
+        [ update-builder ] [ update-tuple ] bi
+    ] with-db ;
+
+: main ( -- )
+    command-line get handle-update ;
+
+MAIN: main

extra/mason/report/report.factor

@@ -34,7 +34,7 @@ IN: mason.report
 :: failed-report ( error file what -- status )
     [
         error [ error. ] with-string-writer :> error
-        file utf8 file-contents 400 short tail* :> output
+        file utf8 file-lines 400 short tail* :> output
         
         [XML
         <h2><-what-></h2>

extra/terrain/terrain.factor

@@ -100,10 +100,13 @@ M: terrain-world tick-length
 
 : forward-vector ( player -- v )
     yaw>> 0.0
-    { 0.0 0.0 $ MOVEMENT-SPEED } vneg eye-rotate ;
+    ${ 0.0 0.0 MOVEMENT-SPEED } vneg eye-rotate ;
 : rightward-vector ( player -- v )
     yaw>> 0.0
-    { $ MOVEMENT-SPEED 0.0 0.0 } eye-rotate ;
+    ${ MOVEMENT-SPEED 0.0 0.0 } eye-rotate ;
+: clamp-pitch ( pitch -- pitch' )
+    90.0 min -90.0 max ;
+
 
 : walk-forward ( player -- )
     dup forward-vector [ v+ ] curry change-velocity drop ;
@@ -114,15 +117,20 @@ M: terrain-world tick-length
 : walk-rightward ( player -- )
     dup rightward-vector [ v+ ] curry change-velocity drop ;
 : jump ( player -- )
-    [ { 0.0 $ JUMP 0.0 } v+ ] change-velocity drop ;
+    [ ${ 0.0 JUMP 0.0 } v+ ] change-velocity drop ;
+: rotate-leftward ( player x -- )
+    [ - ] curry change-yaw drop ;
+: rotate-rightward ( player x -- )
+    [ + ] curry change-yaw drop ;
+: look-horizontally ( player x -- )
+    [ + ] curry change-yaw drop ;
+: look-vertically ( player x -- )
+    [ + clamp-pitch ] curry change-pitch drop ;
 
-: clamp-pitch ( pitch -- pitch' )
-    90.0 min -90.0 max ;
 
 : rotate-with-mouse ( player mouse -- )
-    [ dx>> MOUSE-SCALE * [ + ] curry change-yaw ]
-    [ dy>> MOUSE-SCALE * [ + clamp-pitch ] curry change-pitch ] bi
-    drop ;
+    [ dx>> MOUSE-SCALE * look-horizontally ]
+    [ dy>> MOUSE-SCALE * look-vertically ] 2bi ;
 
 :: handle-input ( world -- )
     world player>> :> player
@@ -131,6 +139,12 @@ M: terrain-world tick-length
     key-s keys nth [ player walk-backward ] when 
     key-a keys nth [ player walk-leftward ] when 
     key-d keys nth [ player walk-rightward ] when 
+    key-q keys nth [ player -1 look-horizontally ] when 
+    key-e keys nth [ player 1 look-horizontally ] when 
+    key-left-arrow keys nth [ player -1 look-horizontally ] when 
+    key-right-arrow keys nth [ player 1 look-horizontally ] when 
+    key-down-arrow keys nth [ player 1 look-vertically ] when 
+    key-up-arrow keys nth [ player -1 look-vertically ] when 
     key-space keys nth [ player jump ] when 
     key-escape keys nth [ world close-window ] when
     player read-mouse rotate-with-mouse