From 50b1d48d91e273d12b44850a670a21e57d0c89c5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 1 Nov 2005 00:54:31 +0000 Subject: [PATCH] fix space invaders --- TODO.FACTOR.txt | 1 - .../concurrency/concurrency-examples.factor | 25 ++++++++--- contrib/concurrency/concurrency-tests.factor | 8 ++-- contrib/space-invaders/space-invaders.factor | 43 ++++++++++++------- 4 files changed, 50 insertions(+), 27 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 0c9d7f6052..3f69c8d444 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,6 +1,5 @@ 0.79: -- test everything in contrib - update handbook - fix remaining GL issues diff --git a/contrib/concurrency/concurrency-examples.factor b/contrib/concurrency/concurrency-examples.factor index 184d437d6f..c798d3f82e 100644 --- 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 ) - 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 ( -- ) - dup gadget. [ 12 fib unparse swap fulfill ] cons spawn drop ; + dup gadget. [ 30 fib unparse swap fulfill ] cons spawn drop ; diff --git a/contrib/concurrency/concurrency-tests.factor b/contrib/concurrency/concurrency-tests.factor index 207189315a..1aff65e4b9 100644 --- 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 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 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 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 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 c93a50f595..c80f230dfe 100644 --- 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 [ "invaders.rom" over load-rom event-loop SDL_Quit