]> gitweb.factorcode.org Git - factor.git/commitdiff
some SDL renaming, fix a few typos
authorSlava Pestov <slava@factorcode.org>
Wed, 24 Aug 2005 04:30:07 +0000 (04:30 +0000)
committerSlava Pestov <slava@factorcode.org>
Wed, 24 Aug 2005 04:30:07 +0000 (04:30 +0000)
library/sdl/sdl-utils.factor
library/sdl/sdl-video.factor
library/threads.factor
library/ui/editors.factor
library/ui/gadgets.factor
library/ui/layouts.factor
library/ui/paint.factor
library/ui/text.factor
native/run.h

index e5d867e637bfd5ec7299e492349a3a3cf5e6c58d..a7fdbb22e0af8f2d0de18d8766186db3ea1d6159 100644 (file)
@@ -36,11 +36,11 @@ SYMBOL: bpp
     swap bitor ;
 
 : make-rect ( x y w h -- rect )
-    <rect>
-    [ set-rect-h ] keep
-    [ set-rect-w ] keep
-    [ set-rect-y ] keep
-    [ set-rect-x ] keep ;
+    <sdl-rect>
+    [ set-sdl-rect-h ] keep
+    [ set-sdl-rect-w ] keep
+    [ set-sdl-rect-y ] keep
+    [ set-sdl-rect-x ] keep ;
 
 : with-pixels ( quot -- )
     width get [
@@ -60,3 +60,16 @@ SYMBOL: bpp
             slip
         ] ifte SDL_Flip drop
     ] with-scope ; inline
+
+: must-lock-surface? ( surface -- ? )
+    #! This is a macro in SDL_video.h.
+    dup sdl-surface-offset 0 = [
+        sdl-surface-flags
+        SDL_HWSURFACE SDL_ASYNCBLIT bitor SDL_RLEACCEL bitor
+        bitand 0 = not
+    ] [
+        drop t
+    ] ifte ;
+
+: sdl-surface-rect ( x y surface -- rect )
+    dup sdl-surface-w swap sdl-surface-h make-rect ;
index 821b31101dee65ab1dc36e9f915c3f30faef5adc..b7259ab0cac2a47e81aca4139c7650415f984c13 100644 (file)
@@ -24,21 +24,21 @@ IN: sdl USING: alien kernel math ;
 : SDL_SRCALPHA    HEX: 00010000 ; ! Blit uses source alpha blending
 : SDL_PREALLOC    HEX: 01000000 ; ! Surface uses preallocated memory
 
-BEGIN-STRUCT: rect
+BEGIN-STRUCT: sdl-rect
     FIELD: short x
     FIELD: short y
     FIELD: ushort w
     FIELD: ushort h
 END-STRUCT
 
-BEGIN-STRUCT: color
+BEGIN-STRUCT: sdl-color
     FIELD: uchar r
     FIELD: uchar g
     FIELD: uchar b
     FIELD: uchar unused
 END-STRUCT
 
-BEGIN-STRUCT: format
+BEGIN-STRUCT: sdl-format
     FIELD: void* palette
     FIELD: uchar  BitsPerPixel
     FIELD: uchar  BytesPerPixel
@@ -58,14 +58,7 @@ BEGIN-STRUCT: format
     FIELD: uchar  alpha
 END-STRUCT
 
-BEGIN-STRUCT: rect
-    FIELD: short  clip-x
-    FIELD: short  clip-y
-    FIELD: ushort clip-w
-    FIELD: ushort clip-h
-END-STRUCT
-
-BEGIN-STRUCT: surface
+BEGIN-STRUCT: sdl-surface
     FIELD: uint    flags
     FIELD: format* format
     FIELD: int     w
@@ -85,16 +78,6 @@ BEGIN-STRUCT: surface
     FIELD: int     refcount
 END-STRUCT
 
-: must-lock-surface? ( surface -- ? )
-    #! This is a macro in SDL_video.h.
-    dup surface-offset 0 = [
-        surface-flags
-        SDL_HWSURFACE SDL_ASYNCBLIT bitor SDL_RLEACCEL bitor
-        bitand 0 = not
-    ] [
-        drop t
-    ] ifte ;
-
 : SDL_VideoInit ( driver-name flags -- )
     "int" "sdl" "SDL_VideoInit"
     [ "char*" "int" ] alien-invoke ;
index ba23d2ccabea4b34b5cabdff22c21a53260f2340..a56ac5955d2a5b126c131fb004c338d3d7bc1e82 100644 (file)
@@ -42,13 +42,6 @@ DEFER: next-thread
         try stop
     ] callcc0 drop ;
 
-: init-threads ( -- )
-    global [
-        <queue> \ run-queue set
-        10 <vector> \ sleep-queue set
-        <namespace> \ timers set
-    ] bind ;
-
 TUPLE: timer object delay last ;
 
 : timer-now millis swap set-timer-last ;
@@ -80,10 +73,17 @@ GENERIC: tick ( ms object -- )
     #! Takes current time, and a timer. If the timer is set to
     #! fire, calls its callback.
     dup next-time pick <= [
-        [ advance-timer ] keep timer-object tick*
+        [ advance-timer ] keep timer-object tick
     ] [
         2drop
     ] ifte ;
 
 : do-timers ( -- )
     millis timers hash-values [ do-timer ] each-with ;
+
+: init-threads ( -- )
+    global [
+        <queue> \ run-queue set
+        10 <vector> \ sleep-queue set
+        <namespace> \ timers set
+    ] bind ;
index 91ea21a438dbb8ae20571ea7308fefb681870999..5d4ff5b31f168e291b961c67777114fc99cf8186 100644 (file)
@@ -15,7 +15,7 @@ C: caret ( -- caret )
     dup gadget-visible? not over set-gadget-visible?
     relayout ;
 
-M: caret tick* ( ms caret -- ) nip toggle-visible ;
+M: caret tick ( ms caret -- ) nip toggle-visible ;
 
 : caret-blink 500 ;
 
index 6eab81b9c6a18d763c9c31490728c1e24f80d252..f1ded968ec07f68c610965547890db5a00de9a51 100644 (file)
@@ -24,7 +24,7 @@ GENERIC: inside? ( loc rect -- ? )
 : screen-bounds ( rect -- rect )
     dup screen-loc swap rect-dim <rect> ;
 
-M: rectangle inside? ( loc rect -- ? )
+M: rect inside? ( loc rect -- ? )
     screen-bounds rect-bounds { 1 1 1 } v- { 0 0 0 } vmax
     >r v- { 0 0 0 } r> vbetween? conjunction ;
 
index 2035c2559269b3d6db5dfdbf2f3da1e249ec93a4..1068413047ae30b4edf31653a744a339c8ab3c4b 100644 (file)
@@ -90,8 +90,9 @@ M: pack pick-up* ( point pack -- gadget )
     dup pack-vector pick rot gadget-children
     pick-up-fast tuck inside? [ drop f ] unless ;
 
-! M: pack visible-children* ( rect gadget -- list )
-!     gadget-children [ rect-loc origin get v+ intersects? ] subset-with ;
+! M: pack visible-children* ( rect pack -- list )
+!     dup pack-vector -rot gadget-children >r rect-extent r>
+!     [ rect-loc origin get v+ v- over v. ] binsearch-slice nip ;
 
 TUPLE: stack ;
 
index d0bc992ab1461002621dc9f83dd3398e40252879..ec9b8979d825f532f4eefce65c89a033afc65516 100644 (file)
@@ -31,9 +31,8 @@ GENERIC: draw-gadget* ( gadget -- )
 
 : draw-gadget ( gadget -- )
     dup gadget-visible? [
-        dup [
-            translate&clip
-            dup draw-gadget*
+        [
+            dup translate&clip dup draw-gadget*
             visible-children [ draw-gadget ] each
         ] with-scope
     ] [ drop ] ifte ;
index cef0814b85a20a643dd6ee19ab14850c0476ac1f..a9440420775ee052a265f11d5df3ad2548fd06e5 100644 (file)
@@ -4,14 +4,11 @@ IN: gadgets
 USING: alien hashtables kernel lists namespaces sdl sequences
 strings styles io ;
 
-: surface-rect ( x y surface -- rect )
-    dup surface-w swap surface-h make-rect ;
-
 : draw-surface ( x y surface -- )
     surface get SDL_UnlockSurface
     [
-        [ surface-rect ] keep swap surface get 0 0
-    ] keep surface-rect swap rot SDL_UpperBlit drop
+        [ sdl-surface-rect ] keep swap surface get 0 0
+    ] keep sdl-surface-rect swap rot SDL_UpperBlit drop
     surface get dup must-lock-surface? [
         SDL_LockSurface
     ] when drop ;
index e9cb3c04ab7b57119dd767c04dcba7da3e771d9f..ac399fd9bbc5a77677a5a0d652496c1ac9534393 100644 (file)
@@ -1,14 +1,14 @@
 #define USER_ENV 16
 
 #define CARD_OFF_ENV   1 /* for compiling set-slot */
-#define UNUSED_ENV     2
+/* 2 is unused */
 #define NAMESTACK_ENV  3 /* used by library only */
 #define GLOBAL_ENV     4
 #define BREAK_ENV      5
 #define CATCHSTACK_ENV 6 /* used by library only */
 #define CPU_ENV        7
 #define BOOT_ENV       8
-#define UNUSED_ENV     9
+/* 9 is unused */
 #define ARGS_ENV       10
 #define OS_ENV         11
 #define ERROR_ENV      12 /* a marker consed onto kernel errors */