fix space invaders

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 0c9d7f6052af87d200aea5d679f2dfeb9d1f00ed..3f69c8d4445ba32c51fdd58221afb32a5798b500 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,6 +1,5 @@
 0.79:\r
 \r
-- test everything in contrib\r
 - update handbook\r
 - fix remaining GL issues\r
 \r

diff --git a/contrib/concurrency/concurrency-examples.factor b/contrib/concurrency/concurrency-examples.factor
index 184d437d6f49a06e1b98dc93808e81697b3449ea..c798d3f82ec81290f05b5449bc4be3148b537e08 100644 (file)
--- a/contrib/concurrency/concurrency-examples.factor
+++ b/contrib/concurrency/concurrency-examples.factor
@@ -23,7 +23,8 @@
 !
 ! Examples of using the concurrency library.
 IN: concurrency-examples
-USING: concurrency kernel io lists threads math sequences namespaces unparser prettyprint errors dlists ;
+USING: concurrency dlists errors gadgets-theme io kernel lists
+math namespaces opengl prettyprint sequences threads unparser ;
 
 : (logger) ( mailbox -- )
   #! Using the given mailbox, start a thread which
@@ -161,10 +162,11 @@ USE: gadgets-presentations
 USE: gadgets-layouts
 USE: generic
 
-TUPLE: promised-label promise ;
+TUPLE: promised-label promise font color ;
 
 C: promised-label ( promise -- promised-label )
-  <gadget> over set-delegate [ set-promised-label-promise ] keep 
+  dup delegate>gadget dup label-theme
+  [ set-promised-label-promise ] keep 
   [ [ dup promised-label-promise ?promise drop relayout ] cons spawn drop ] keep ;
 
 : promised-label-text ( promised-label -- text )
@@ -175,14 +177,23 @@ C: promised-label ( promise -- promised-label )
   ] if ;
 
 M: promised-label pref-dim ( promised-label - dim )
-  dup promised-label-text label-size ;
+  label-size ;
 
 M: promised-label draw-gadget* ( promised-label -- )
-    dup delegate draw-gadget*
-    dup promised-label-text draw-string ;
+    draw-label ;
+
+M: promised-label label-text promised-label-text ;
+
+M: promised-label label-color promised-label-color ;
+
+M: promised-label label-font promised-label-font ;
+
+M: promised-label set-label-color set-promised-label-color ;
+
+M: promised-label set-label-font set-promised-label-font ;
 
 : fib ( n -- n )
   yield dup 2 < [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ;
   
 : test-promise-ui ( -- )
-  <promise> dup <promised-label> gadget. [ 12 fib unparse swap fulfill ] cons spawn drop ;
+  <promise> dup <promised-label> gadget. [ 30 fib unparse swap fulfill ] cons spawn drop ;

diff --git a/contrib/concurrency/concurrency-tests.factor b/contrib/concurrency/concurrency-tests.factor
index 207189315ae92f2b2b55978902165b61065672ef..1aff65e4b953568a40c177767f8f66560967e0bb 100644 (file)
--- a/contrib/concurrency/concurrency-tests.factor
+++ b/contrib/concurrency/concurrency-tests.factor
@@ -78,7 +78,7 @@ USING: kernel concurrency concurrency-examples threads vectors
   [ string? ] swap dlist-pred?
 ] unit-test
 
-[ { 1 2 3 } ] [
+[ V{ 1 2 3 } ] [
   0 <vector>
   make-mailbox
   2dup [ mailbox-get swap push ] cons cons in-thread
@@ -89,7 +89,7 @@ USING: kernel concurrency concurrency-examples threads vectors
   3 swap mailbox-put
 ] unit-test
 
-[ { 1 2 3 } ] [
+[ V{ 1 2 3 } ] [
   0 <vector>
   make-mailbox
   2dup [ [ integer? ] swap mailbox-get? swap push ] cons cons in-thread
@@ -100,7 +100,7 @@ USING: kernel concurrency concurrency-examples threads vectors
   3 swap mailbox-put
 ] unit-test
 
-[ { 1 "junk" 3 "junk2" } [ 456 ] ] [
+[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [
   0 <vector>
   make-mailbox
   2dup [ [ integer? ] swap mailbox-get? swap push ] cons cons in-thread
@@ -171,7 +171,7 @@ USING: kernel concurrency concurrency-examples threads vectors
   [ 50 ] future ?future
 ] unit-test
 
-[ { 50 50 50 } ] [
+[ V{ 50 50 50 } ] [
   0 <vector>
   <promise>
   2dup [ ?promise swap push ] cons cons spawn drop

diff --git a/contrib/space-invaders/space-invaders.factor b/contrib/space-invaders/space-invaders.factor
index c93a50f59598c9b8f367cde2640d49c819e22632..c80f230dfebe49be5edba70989ee6e2a483373cf 100644 (file)
--- a/contrib/space-invaders/space-invaders.factor
+++ b/contrib/space-invaders/space-invaders.factor
@@ -1,5 +1,7 @@
+USING: alien cpu-8080 errors generic io kernel kernel-internals
+lists math namespaces sdl sdl-event sdl-gfx sdl-video sequences
+styles threads ;
 IN: space-invaders
-USING: cpu-8080 kernel lists sdl sdl-event sdl-gfx sdl-video math styles sequences io namespaces generic kernel-internals threads errors ;
 
 TUPLE: space-invaders port1 port2i port2o port3o port4lo port4hi port5o ;
 
@@ -129,21 +131,32 @@ M: key-up-event handle-si-event ( cpu event -- quit? )
   #! n >= a and n <= b
   rot tuck swap <= >r swap >= r> and ;
 
-: color ( x y -- color )
-  #! Return the color to use for the given x/y position.
-  {
-    { [ dup 184 238 within pick 0 223 within and ] [ 2drop green ] }
-    { [ dup 240 247 within pick 16 133 within and ] [ 2drop green ] }
-    { [ dup 247 215 - 247 184 - within pick 0 223 within and ] [ 2drop red ] }
-    { [ t ] [ 2drop white ] }
-  } cond ;
+! : color ( x y -- color )
+!   #! Return the color to use for the given x/y position.
+!   {
+!     { [ dup 184 238 within pick 0 223 within and ] [ 2drop green ] }
+!     { [ dup 240 247 within pick 16 133 within and ] [ 2drop green ] }
+!     { [ dup 247 215 - 247 184 - within pick 0 223 within and ] [ 2drop red ] }
+!     { [ t ] [ 2drop white ] }
+!   } cond ;
+
+: black HEX: 0000 ;
+: white HEX: ffff ;
+
+: plot-pixel ( x y color -- )
+  -rot surface get [ surface-pitch * ] keep
+  [ surface-format sdl-format-BytesPerPixel rot * + ] keep
+  surface-pixels swap set-alien-unsigned-2 ;
 
 : plot-bits ( x y byte bit -- )
-  dup swapd -1 * shift 1 bitand 0 = [ ( x y bit -- )
-    - surface get -rot black rgb pixelColor
-  ] [
-    - surface get -rot 2dup color rgb pixelColor
-  ] if ;
+  dup swapd -1 * shift 1 bitand 0 =
+  [ ( x y bit -- ) - black ] [ - white ] if
+  plot-pixel ;
+
+! : plot-bits ( x y byte bit -- )
+!   dup swapd -1 * shift 1 bitand 0 =
+!   [ ( x y bit -- ) - black ] [ - 2dup color ] if
+!   rgb plot-pixel ;
 
 : do-video-update ( value addr cpu -- )
   drop addr>xy rot ( x y value )
@@ -164,7 +177,7 @@ M: space-invaders update-video ( value addr cpu -- )
   ] if ;
 
 : run ( -- )
-  224 256 0 SDL_HWSURFACE [ 
+  224 256 16 SDL_HWSURFACE [ 
    <space-invaders> "invaders.rom" over load-rom
    <event> event-loop
     SDL_Quit