extra/gml/types/types.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 USING: accessors kernel math sequences sequences.private
   3 hashtables assocs locals arrays combinators classes.struct
   4 math.vectors math.vectors.simd math.vectors.simd.cords ;
   5 IN: gml.types
   6
   7 : true? ( obj -- ? ) 0 number= not ; inline
   8 : >true ( ? -- 1/0 ) 1 0 ? ; inline
   9
  10 TUPLE: proc { array array read-only } { registers array read-only } ;
  11
  12 C: <proc> proc
  13
  14 M: proc clone [ array>> clone ] [ registers>> clone ] bi <proc> ;
  15
  16 M: proc length array>> length ;
  17 M: proc nth-unsafe array>> nth-unsafe ;
  18 M: proc set-nth-unsafe array>> set-nth-unsafe ;
  19 M: proc like drop dup proc? [ { } like { } <proc> ] unless ;
  20 M: proc new-sequence drop 0 <array> { } <proc> ;
  21
  22 INSTANCE: proc sequence
  23
  24 : wrap ( n seq -- n seq ) [ length rem ] keep ; inline
  25
  26 GENERIC#: (gml-get) 1 ( collection key -- elt )
  27
  28 M: sequence (gml-get) swap wrap nth ;
  29 M: hashtable (gml-get) of ;
  30
  31 GENERIC#: (gml-put) 2 ( collection key elt -- )
  32
  33 M:: sequence (gml-put) ( collection key elt -- )
  34     elt key collection wrap set-nth ;
  35 M:: hashtable (gml-put) ( collection key elt -- )
  36     elt key collection set-at ;
  37
  38 GENERIC: (gml-copy) ( collection -- collection' )
  39
  40 M: array (gml-copy) clone ;
  41 M: hashtable (gml-copy) clone ;
  42 M: proc (gml-copy) clone ;
  43
  44 ALIAS: vec2d? double-2?
  45
  46 ALIAS: <vec2d> double-2-boa
  47
  48 ALIAS: scalar>vec2d double-2-with
  49
  50 ALIAS: vec3d? double-4?
  51
  52 : <vec3d> ( x y z -- vec ) 0.0 double-4-boa ; inline
  53
  54 : scalar>vec3d ( x -- vec ) dup dup 0.0 double-4-boa ; inline
  55
  56 GENERIC: mask-vec3d ( value -- value' )
  57
  58 M: double-2 mask-vec3d ; inline
  59
  60 M: double-4 mask-vec3d
  61     longlong-4{ -1 -1 -1 0 } double-4-cast vbitand ; inline