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

   1 USING: accessors assocs classes destructors functors kernel
   2 lexer math parser sequences specialized-arrays.int ui.backend
   3 words.symbol ;
   4 IN: ui.pixel-formats
   5
   6 SYMBOLS:
   7     double-buffered
   8     stereo
   9     offscreen
  10     fullscreen
  11     windowed
  12     accelerated
  13     software-rendered
  14     robust
  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: buffer-level < pixel-format-attribute ;
  42
  43 TUPLE: sample-buffers < pixel-format-attribute ;
  44 TUPLE: samples < pixel-format-attribute ;
  45
  46 HOOK: (make-pixel-format) ui-backend ( world attributes -- pixel-format-handle )
  47 HOOK: (free-pixel-format) ui-backend ( pixel-format -- )
  48 HOOK: (pixel-format-attribute) ui-backend ( pixel-format attribute-name -- value )
  49
  50 ERROR: invalid-pixel-format-attributes world attributes ;
  51
  52 TUPLE: pixel-format world handle ;
  53
  54 : <pixel-format> ( world attributes -- pixel-format )
  55     2dup (make-pixel-format)
  56     [ nip pixel-format boa ] [ invalid-pixel-format-attributes ] if* ;
  57
  58 M: pixel-format dispose
  59     [ (free-pixel-format) ] [ f >>handle drop ] bi ;
  60
  61 : pixel-format-attribute ( pixel-format attribute-name -- value )
  62     (pixel-format-attribute) ;
  63
  64 <PRIVATE
  65
  66 FUNCTOR: define-pixel-format-attribute-table ( NAME PERM TABLE -- )
  67
  68 >PFA              DEFINES >${NAME}
  69 >PFA-int-array    DEFINES >${NAME}-int-array
  70
  71 WHERE
  72
  73 GENERIC: >PFA ( attribute -- pfas )
  74
  75 M: object >PFA
  76     drop { } ;
  77 M: symbol >PFA
  78     TABLE at [ { } ] unless* ;
  79 M: pixel-format-attribute >PFA
  80     dup class TABLE at
  81     [ swap value>> suffix ]
  82     [ drop { } ] if* ;
  83
  84 : >PFA-int-array ( attribute -- int-array )
  85     [ >PFA ] map concat PERM prepend 0 suffix >int-array ;
  86
  87 ;FUNCTOR
  88
  89 SYNTAX: PIXEL-FORMAT-ATTRIBUTE-TABLE:
  90     scan scan-object scan-object define-pixel-format-attribute-table ;
  91
  92 PRIVATE>