diff --git a/extra/mason/notify/notify.factor b/extra/mason/notify/notify.factor index 30da0c8286..ccabccdf8b 100644 --- a/extra/mason/notify/notify.factor +++ b/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 -- ) diff --git a/extra/mason/notify/server/authors.txt b/extra/mason/notify/server/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/mason/notify/server/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/mason/notify/server/server.factor b/extra/mason/notify/server/server.factor new file mode 100644 index 0000000000..57c6d04300 --- /dev/null +++ b/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>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" ; + +: 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 diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor index 6e48e7cf04..1b5aaf39ec 100644 --- a/extra/mason/report/report.factor +++ b/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

<-what->

diff --git a/extra/terrain/terrain.factor b/extra/terrain/terrain.factor index 411d34f44c..e459f19e40 100644 --- a/extra/terrain/terrain.factor +++ b/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