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

   1 USING: alien.c-types alien.data accessors assocs classes
   2 destructors functors kernel lexer math parser sequences
   3 specialized-arrays 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 -- 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     [ throw-invalid-pixel-format-attributes ]
  56     ?if ;
  57
  58 M: pixel-format dispose*
  59     [ (free-pixel-format) ] [ f >>handle drop ] bi ;
  60
  61 <PRIVATE
  62
  63 FUNCTOR: define-pixel-format-attribute-table ( NAME PERM TABLE -- )
  64
  65 >PFA              DEFINES >${NAME}
  66 >PFA-int-array    DEFINES >${NAME}-int-array
  67
  68 WHERE
  69
  70 GENERIC: >PFA ( attribute -- pfas )
  71
  72 M: object >PFA
  73     drop { } ;
  74 M: word >PFA
  75     TABLE at [ { } ] unless* ;
  76 M: pixel-format-attribute >PFA
  77     dup class-of TABLE at
  78     [ swap value>> suffix ]
  79     [ drop { } ] if* ;
  80
  81 : >PFA-int-array ( attribute -- int-array )
  82     [ >PFA ] map concat PERM prepend 0 suffix int >c-array ;
  83
  84 ;FUNCTOR
  85
  86 SYNTAX: PIXEL-FORMAT-ATTRIBUTE-TABLE:
  87     scan-token scan-object scan-object define-pixel-format-attribute-table ;
  88
  89 PRIVATE>
  90
  91 GENERIC: world-pixel-format-attributes ( world -- attributes )
  92
  93 GENERIC# check-world-pixel-format 1 ( world pixel-format -- )
  94