mason: move alignment to mason.css, right align but-last columns in table body

[factor.git] / extra / jamshred / jamshred.factor

diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor
old mode 100755 (executable)
new mode 100644 (file)
index d0b7441..3b653fd
--- a/extra/jamshred/jamshred.factor
+++ b/extra/jamshred/jamshred.factor
@@ -1,21 +1,24 @@
 ! Copyright (C) 2007, 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.geometry.rect math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ;
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors arrays calendar jamshred.game jamshred.gl
+jamshred.player kernel math math.constants math.vectors
+namespaces sequences threads ui ui.gadgets ui.gadgets.worlds
+ui.gestures ui.render ;
 IN: jamshred
 
 TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ;
 
 : <jamshred-gadget> ( jamshred -- gadget )
-    jamshred-gadget new-gadget swap >>jamshred ;
+    jamshred-gadget new swap >>jamshred ;
 
-: default-width ( -- x ) 800 ;
-: default-height ( -- y ) 600 ;
+CONSTANT: default-width 800
+CONSTANT: default-height 600
 
 M: jamshred-gadget pref-dim*
     drop default-width default-height 2array ;
 
 M: jamshred-gadget draw-gadget* ( gadget -- )
-    [ jamshred>> ] [ rect-dim first2 draw-jamshred ] bi ;
+    [ jamshred>> ] [ dim>> first2 draw-jamshred ] bi ;
 
 : jamshred-loop ( gadget -- )
     dup jamshred>> quit>> [
@@ -23,23 +26,15 @@ M: jamshred-gadget draw-gadget* ( gadget -- )
     ] [
         [ jamshred>> jamshred-update ]
         [ relayout-1 ]
-        [ 10 milliseconds sleep yield jamshred-loop ] tri
+        [ 100 milliseconds sleep jamshred-loop ] tri
     ] if ;
 
-: fullscreen ( gadget -- )
-    find-world t swap set-fullscreen* ;
-
-: no-fullscreen ( gadget -- )
-    find-world f swap set-fullscreen* ;
-
-: toggle-fullscreen ( world -- )
-    [ fullscreen? not ] keep set-fullscreen* ;
-
 M: jamshred-gadget graft* ( gadget -- )
-    [ jamshred-loop ] curry in-thread ;
+    [ find-gl-context init-graphics ]
+    [ [ jamshred-loop ] curry in-thread ] bi ;
 
 M: jamshred-gadget ungraft* ( gadget -- )
-    jamshred>> t swap (>>quit) ;
+    dup find-gl-context cleanup-graphics jamshred>> t swap quit<< ;
 
 : jamshred-restart ( jamshred-gadget -- )
     <jamshred> >>jamshred drop ;
@@ -48,23 +43,22 @@ M: jamshred-gadget ungraft* ( gadget -- )
     / pi 4 * * ; ! 2 / / pi 2 * * ;
 
 : x>radians ( x gadget -- theta )
-    #! translate motion of x pixels to an angle
-    rect-dim first pix>radians neg ;
+    ! translate motion of x pixels to an angle
+    dim>> first pix>radians neg ;
 
 : y>radians ( y gadget -- theta )
-    #! translate motion of y pixels to an angle
-    rect-dim second pix>radians ;
+    ! translate motion of y pixels to an angle
+    dim>> second pix>radians ;
 
 : (handle-mouse-motion) ( jamshred-gadget mouse-motion -- )
-    over jamshred>> >r
-    [ first swap x>radians ] 2keep second swap y>radians
-    r> mouse-moved ;
-    
+    dupd [ first swap x>radians ] [ second swap y>radians ] 2bi
+    rot jamshred>> mouse-moved ;
+
 : handle-mouse-motion ( jamshred-gadget -- )
     hand-loc get [
         over last-hand-loc>> [
-            v- (handle-mouse-motion) 
-        ] [ 2drop ] if* 
+            v- (handle-mouse-motion)
+        ] [ 2drop ] if*
     ] 2keep >>last-hand-loc drop ;
 
 : handle-mouse-scroll ( jamshred-gadget -- )
@@ -73,22 +67,21 @@ M: jamshred-gadget ungraft* ( gadget -- )
     [ second mouse-scroll-y ] 2bi ;
 
 : quit ( gadget -- )
-    [ no-fullscreen ] [ close-window ] bi ;
+    [ f set-fullscreen ] [ close-window ] bi ;
 
 jamshred-gadget H{
     { T{ key-down f f "r" } [ jamshred-restart ] }
     { T{ key-down f f " " } [ jamshred>> toggle-running ] }
-    { T{ key-down f f "f" } [ find-world toggle-fullscreen ] }
+    { T{ key-down f f "f" } [ toggle-fullscreen ] }
     { T{ key-down f f "UP" } [ jamshred>> jamshred-player 1 swap change-player-speed ] }
     { T{ key-down f f "DOWN" } [ jamshred>> jamshred-player -1 swap change-player-speed ] }
     { T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] }
     { T{ key-down f f "RIGHT" } [ jamshred>> -1 jamshred-roll ] }
+    { T{ key-down f f "ESC" } [ quit ] }
     { T{ key-down f f "q" } [ quit ] }
-    { T{ motion } [ handle-mouse-motion ] }
-    { T{ mouse-scroll } [ handle-mouse-scroll ] }
+    { motion [ handle-mouse-motion ] }
+    { mouse-scroll [ handle-mouse-scroll ] }
 } set-gestures
 
-: jamshred-window ( -- gadget )
-    [ <jamshred> <jamshred-gadget> dup "Jamshred" open-window ] with-ui ;
-
-MAIN: jamshred-window
+MAIN-WINDOW: jamshred-window { { title "Jamshred" } }
+    <jamshred> <jamshred-gadget> >>gadgets ;