UI user input fix

library/bootstrap/boot-stage1.factor

@@ -52,13 +52,13 @@ sequences io vectors words ;
         "/library/collections/tree-each.factor"
         "/library/collections/queues.factor"
 
-        "/library/math/matrices.factor"
-        "/library/math/parse-numbers.factor"
-
         "/library/math/constants.factor"
         "/library/math/pow.factor"
         "/library/math/trig-hyp.factor"
         "/library/math/arc-trig-hyp.factor"
+        "/library/math/matrices.factor"
+        "/library/math/quaternions.factor"
+        "/library/math/parse-numbers.factor"
 
         "/library/words.factor"
         "/library/vocabularies.factor"

library/math/matrices.factor

@@ -11,20 +11,12 @@ USING: arrays generic kernel sequences ;
 : n/v ( n v -- v ) [ / ] map-with ;
 : v/n ( v n -- v ) swap [ swap / ] map-with ;
 
-: v+   ( v v -- v ) [ + ]   2map ;
+: v+   ( v v -- v ) [ + ] 2map ;
-: v-   ( v v -- v ) [ - ]   2map ;
+: v-   ( v v -- v ) [ - ] 2map ;
-: v*   ( v v -- v ) [ * ]   2map ;
+: v*   ( v v -- v ) [ * ] 2map ;
-: v/   ( v v -- v ) [ / ]   2map ;
+: v/   ( v v -- v ) [ / ] 2map ;
 : vmax ( v v -- v ) [ max ] 2map ;
 : vmin ( v v -- v ) [ min ] 2map ;
-: vand ( v v -- v ) [ and ] 2map ;
-: vor  ( v v -- v ) [ or ]  2map ;
-: v<   ( v v -- v ) [ < ]   2map ;
-: v<=  ( v v -- v ) [ <= ]  2map ;
-: v>   ( v v -- v ) [ > ]   2map ;
-: v>=  ( v v -- v ) [ >= ]  2map ;
-
-: vbetween? ( v from to -- v ) >r over >r v>= r> r> v<= vand ;
 
 : sum ( v -- n ) 0 [ + ] reduce ;
 : product ( v -- n ) 1 [ * ] reduce ;
@@ -32,29 +24,25 @@ USING: arrays generic kernel sequences ;
 : set-axis ( x y axis -- v )
     2dup v* >r >r drop dup r> v* v- r> v+ ;
 
-: v. ( v v -- x ) 0 [ * + ] 2reduce ;
+: v. ( v v -- x )
-: c. ( v v -- x ) 0 [ ** + ] 2reduce ;
+    #! Real inner product.
+    0 [ * + ] 2reduce ;
+
+: c. ( v v -- x )
+    #! Complex inner product.
+    0 [ ** + ] 2reduce ;
 
 : norm-sq ( v -- n ) 0 [ absq + ] reduce ;
 
+: norm ( vec -- n ) norm-sq sqrt ;
+
+: normalize ( vec -- vec ) dup norm v/n ;
+
 : proj ( u v -- w )
     #! Orthogonal projection of u onto v.
     [ [ v. ] keep norm-sq v/n ] keep n*v ;
 
-: cross-trace ( v1 v2 i1 i2 -- v1 v2 n )
-    pick nth >r pick nth r> * ;
-
-: cross-minor ( v1 v2 i1 i2 -- n )
-    [ cross-trace -rot ] 2keep swap cross-trace 2nip - ;
-
-: cross ( { x1 y1 z1 } { x2 y2 z2 } -- { z1 z2 z3 } )
-    #! Cross product of two 3-dimensional vectors.
-    [ 1 2 cross-minor ] 2keep
-    [ 2 0 cross-minor ] 2keep
-    0 1 cross-minor 3array ;
-
 ! Matrices
-
 : zero-matrix ( m n -- matrix )
     swap [ drop zero-array ] map-with ;
 
@@ -70,18 +58,10 @@ USING: arrays generic kernel sequences ;
 : n/m ( n m -- m ) [ n/v ] map-with ;
 : m/n ( m n -- m ) swap [ swap v/n ] map-with ;
 
-: m+   ( m m -- m ) [ v+ ]   2map ;
+: m+   ( m m -- m ) [ v+ ] 2map ;
-: m-   ( m m -- m ) [ v- ]   2map ;
+: m-   ( m m -- m ) [ v- ] 2map ;
-: m*   ( m m -- m ) [ v* ]   2map ;
+: m*   ( m m -- m ) [ v* ] 2map ;
-: m/   ( m m -- m ) [ v/ ]   2map ;
+: m/   ( m m -- m ) [ v/ ] 2map ;
-: mmax ( m m -- m ) [ vmax ] 2map ;
-: mmin ( m m -- m ) [ vmin ] 2map ;
-: mand ( m m -- m ) [ vand ] 2map ;
-: mor  ( m m -- m ) [ vor ]  2map ;
-: m<   ( m m -- m ) [ v< ]   2map ;
-: m<=  ( m m -- m ) [ v<= ]  2map ;
-: m>   ( m m -- m ) [ v> ]   2map ;
-: m>=  ( m m -- m ) [ v>= ]  2map ;
 
 : v.m ( v m -- v ) flip [ v. ] map-with ;
 : m.v ( m v -- v ) swap [ v. ] map-with ;

library/math/pow.factor

@@ -15,10 +15,6 @@ M: complex sqrt >polar swap fsqrt swap 2 / polar> ;
 
 M: real sqrt dup 0 < [ neg fsqrt 0 swap rect> ] [ fsqrt ] if ;
 
-: norm ( vec -- n ) norm-sq sqrt ;
-
-: normalize ( vec -- vec ) dup norm v/n ;
-
 GENERIC: ^ ( z w -- z^w ) foldable
 
 : ^mag ( w abs arg -- magnitude )

library/math/quaternions.factor

@@ -2,8 +2,10 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 
 ! Everybody's favorite non-commutative skew field, the
-! quaternions! Represented as pairs of complex numbers,
+! quaternions!
-! that is, (a+bi)+(c+di)j.
+
+! Quaternions are represented as pairs of complex numbers,
+! using the identity: (a+bi)+(c+di)j = a+bi+cj+dk.
 USING: arrays kernel math sequences ;
 IN: math-internals
 
@@ -15,13 +17,6 @@ IN: math-internals
 
 IN: math
 
-: quaternion? ( seq -- ? )
-    dup length 2 = [
-        first2 [ number? ] 2apply and
-    ] [
-        drop f
-    ] if ;
-
 : q* ( u v -- u*v )
     #! Multiply quaternions.
     [ q*a ] 2keep q*b 2array ;
@@ -30,9 +25,13 @@ IN: math
     #! Quaternion conjugate.
     first2 neg >r conjugate r> 2array ;
 
+: qrecip ( u -- 1/u )
+    #! Quaternion inverse.
+    qconjugate dup norm-sq v/n ;
+
 : q/ ( u v -- u/v )
     #! Divide quaternions.
-    [ qconjugate q* ] keep norm-sq v/n ;
+    qrecip q* ;
 
 : q*n ( q n -- q )
     #! Note: you will get the wrong result if you try to
@@ -54,20 +53,25 @@ IN: math
     #! part.
     first2 >r imaginary r> >rect 3array ;
 
+: cross ( u v -- u*v )
+    #! Cross product of two 3-vectors can be computed using
+    #! quaternion multiplication.
+    [ v>q ] 2apply q* q>v ;
+
 ! Zero
-: q0 Q{ 0 0 0 0 }Q ;
+: q0 @{ 0 0 }@ ;
 
 ! Units
-: q1 Q{ 1 0 0 0 }Q ;
+: q1 @{ 1 0 }@ ;
-: qi Q{ 0 1 0 0 }Q ;
+: qi @{ #{ 0 1 }# 0 }@ ;
-: qj Q{ 0 0 1 0 }Q ;
+: qj @{ 0 1 }@ ;
-: qk Q{ 0 0 0 1 }Q ;
+: qk @{ 0 #{ 0 1 }# }@ ;
 
 ! Euler angles -- see
 ! http://www.mathworks.com/access/helpdesk/help/toolbox/aeroblks/euleranglestoquaternions.html
 
 : (euler) ( theta unit -- q )
-    >r -0.5 * dup cos c>q swap sin r> n*q v- ;
+    >r -0.5 * dup cos c>q swap sin r> n*v v- ;
 
 : euler ( phi theta psi -- q )
     qk (euler) >r qj (euler) >r qi (euler) r> q* r> q* ;

library/syntax/parse-syntax.factor

@@ -153,9 +153,3 @@ SYMBOL: t
 : DEC: 10 (BASE) ; parsing
 : OCT: 8 (BASE) ; parsing
 : BIN: 2 (BASE) ; parsing
-
-: Q{ f ; parsing
-
-: }Q
-    reverse 2 swap cut
-    [ first2 rect> ] 2apply 2array swons ; parsing

library/syntax/prettyprint.factor

@@ -278,15 +278,7 @@ M: cons pprint* ( list -- )
    ] check-recursion ;
 
 M: array pprint* ( vector -- )
-    #! This does a hack for printing quaternions.
+    [ \ @{ \ }@ pprint-sequence ] check-recursion ;
-    [
-        dup quaternion? [
-            [ >rect 2array ] map concat
-            \ Q{ \ }Q
-        ] [
-            \ @{ \ }@
-        ] if pprint-sequence
-    ] check-recursion ;
 
 M: vector pprint* ( vector -- )
     [ \ { \ } pprint-sequence ] check-recursion ;

library/syntax/see.factor

@@ -71,7 +71,6 @@ M: compound (see)
     dup word-def swap see-body ;
 
 : method. ( word [[ class method ]] -- )
-    newline
     \ M: pprint-word
     unswons pprint-word
     swap pprint-word
@@ -80,7 +79,7 @@ M: compound (see)
 
 M: generic (see)
     dup dup "combination" word-prop swap see-body
-    dup methods [ method. ] each-with ;
+    dup methods [ newline method. ] each-with ;
 
 GENERIC: class. ( word -- )
 
@@ -88,6 +87,7 @@ GENERIC: class. ( word -- )
     #! List all methods implemented for this class.
     dup class? [
         dup implementors [
+            newline
             dup in. tuck "methods" word-prop hash* method.
         ] each-with
     ] [
@@ -95,23 +95,26 @@ GENERIC: class. ( word -- )
     ] if ;
 
 M: union class.
+    newline
     \ UNION: pprint-word
     dup pprint-word
-    members pprint-elements pprint-; newline ;
+    members pprint-elements pprint-; ;
 
 M: predicate class.
+    newline
     \ PREDICATE: pprint-word
     dup superclass pprint-word
     dup pprint-word
     <block
     "definition" word-prop pprint-elements
-    pprint-; block; newline ;
+    pprint-; block; ;
 
 M: tuple-class class.
+    newline
     \ TUPLE: pprint-word
     dup pprint-word
     "slot-names" word-prop [ f text ] each
-    pprint-; newline ;
+    pprint-; ;
 
 M: word class. drop ;
 
@@ -119,9 +122,9 @@ M: word class. drop ;
     [
         dup (synopsis)
         dup (see)
-        newline
         dup class.
         methods.
+        newline
     ] with-pprint ;
 
 : (apropos) ( substring -- seq )

library/test/math/matrices.factor

@@ -92,14 +92,6 @@ unit-test
 [ @{ @{ 1 2 }@ @{ 3 4 }@ @{ 5 6 }@ }@ flip ]
 unit-test
 
-[ @{ t t t }@ ]
-[ @{ 1 2 3 }@ @{ -1 -2 -3 }@ @{ 4 5 6 }@ vbetween? ]
-unit-test
-
-[ @{ t f t }@ ]
-[ @{ 1 10 3 }@ @{ -1 -2 -3 }@ @{ 4 5 6 }@ vbetween? ]
-unit-test
-
 [
     @{ @{ 6 }@ }@
 ] [

library/test/math/quaternions.factor

@@ -18,3 +18,8 @@ USING: kernel math test ;
 [ t ] [ qk qj q/ qi = ] unit-test
 [ t ] [ qi qk q/ qj = ] unit-test
 [ t ] [ qj qi q/ qk = ] unit-test
+[ t ] [ qi q>v v>q qi = ] unit-test
+[ t ] [ qj q>v v>q qj = ] unit-test
+[ t ] [ qk q>v v>q qk = ] unit-test
+[ t ] [ 1 c>q q1 = ] unit-test
+[ t ] [ i c>q qi = ] unit-test

library/ui/editors.factor

@@ -130,7 +130,7 @@ C: editor ( text -- )
     rect-dim @{ 0 1 1 }@ v* @{ 1 0 0 }@ v+ ;
 
 M: editor user-input* ( ch editor -- ? )
-    [ insert-char ] with-editor  t ;
+    [ insert-char ] with-editor f ;
 
 M: editor pref-dim ( editor -- dim )
     dup editor-text label-size @{ 1 0 0 }@ v+ ;

library/ui/events.factor

@@ -35,10 +35,13 @@ M: button-up-event handle-event ( event -- )
 M: motion-event handle-event ( event -- )
     motion-event-loc hand move-hand ;
 
+: control-char? ( ch -- ? )
+    "\0\e\r\u0008\u007f" member? ;
+
 M: key-down-event handle-event ( event -- )
     dup keyboard-event>binding
     hand hand-focus handle-gesture [
-        keyboard-event-unicode dup 0 = [
+        keyboard-event-unicode dup control-char? [
             drop
         ] [
             hand hand-focus user-input drop