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

   1 USING: accessors assocs classes destructors functors kernel
   2 lexer math parser sequences specialized-arrays ui.backend
   3 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 -- pixel-format-handle )
  45 HOOK: (free-pixel-format) ui-backend ( pixel-format -- )
  46 HOOK: (pixel-format-attribute) ui-backend ( pixel-format attribute-name -- value )
  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 ;
  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: word >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>
  93
  94 GENERIC: world-pixel-format-attributes ( world -- attributes )
  95
  96 GENERIC# check-world-pixel-format 1 ( world pixel-format -- )
  97