basis/ui/pixel-formats/pixel-formats.factor

   1 USING: accessors alien.c-types alien.data assocs classes
   2 combinators destructors kernel math sequences specialized-arrays
   3 ui.backend words ;
   4 SPECIALIZED-ARRAY: int
   5 IN: ui.pixel-formats
   6
   7 SYMBOLS:
   8     double-buffered
   9     stereo
  10     offscreen
  11     fullscreen
  12     windowed
  13     accelerated
  14     software-rendered
  15     backing-store
  16     multisampled
  17     supersampled
  18     sample-alpha
  19     color-float ;
  20
  21 TUPLE: pixel-format-attribute { value integer } ;
  22
  23 TUPLE: color-bits < pixel-format-attribute ;
  24 TUPLE: red-bits < pixel-format-attribute ;
  25 TUPLE: green-bits < pixel-format-attribute ;
  26 TUPLE: blue-bits < pixel-format-attribute ;
  27 TUPLE: alpha-bits < pixel-format-attribute ;
  28
  29 TUPLE: accum-bits < pixel-format-attribute ;
  30 TUPLE: accum-red-bits < pixel-format-attribute ;
  31 TUPLE: accum-green-bits < pixel-format-attribute ;
  32 TUPLE: accum-blue-bits < pixel-format-attribute ;
  33 TUPLE: accum-alpha-bits < pixel-format-attribute ;
  34
  35 TUPLE: depth-bits < pixel-format-attribute ;
  36
  37 TUPLE: stencil-bits < pixel-format-attribute ;
  38
  39 TUPLE: aux-buffers < pixel-format-attribute ;
  40
  41 TUPLE: sample-buffers < pixel-format-attribute ;
  42 TUPLE: samples < pixel-format-attribute ;
  43
  44 HOOK: (make-pixel-format) ui-backend ( world attributes --
  45                                        pixel-format-handle )
  46 HOOK: (free-pixel-format) ui-backend ( pixel-format -- )
  47
  48 ERROR: invalid-pixel-format-attributes world attributes ;
  49
  50 TUPLE: pixel-format < disposable world handle ;
  51
  52 : <pixel-format> ( world attributes -- pixel-format )
  53     2dup (make-pixel-format)
  54     [ pixel-format new-disposable swap >>handle swap >>world ]
  55     [ invalid-pixel-format-attributes ]
  56     ?if-old ;
  57
  58 M: pixel-format dispose*
  59     [ (free-pixel-format) ] [ f >>handle drop ] bi ;
  60
  61 : (pixel-format-attribute) ( attribute table -- arr/f )
  62     [ dup class-of ] dip at [ swap value>> suffix ] [ drop f ] if* ;
  63
  64 : pixel-format-attribute>array ( obj table -- arr/f )
  65     {
  66         { [ over pixel-format-attribute? ] [ (pixel-format-attribute) ] }
  67         { [ over word? ] [ at ] }
  68         [ 2drop f ]
  69     } cond ;
  70
  71 : pixel-format-attributes>int-array ( attrs perm table -- arr )
  72     swapd '[ _ pixel-format-attribute>array ] map sift concat append
  73     ! 0 happens to work as a sentinel value for all ui backends.
  74     0 suffix int >c-array ;
  75
  76 GENERIC: world-pixel-format-attributes ( world -- attributes )
  77
  78 GENERIC#: check-world-pixel-format 1 ( world pixel-format -- )