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 ;
   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     backing-store
  15     multisampled
  16     supersampled
  17     sample-alpha
  18     color-float ;
  19
  20 TUPLE: pixel-format-attribute { value integer } ;
  21
  22 TUPLE: color-bits < pixel-format-attribute ;
  23 TUPLE: red-bits < pixel-format-attribute ;
  24 TUPLE: green-bits < pixel-format-attribute ;
  25 TUPLE: blue-bits < pixel-format-attribute ;
  26 TUPLE: alpha-bits < pixel-format-attribute ;
  27
  28 TUPLE: accum-bits < pixel-format-attribute ;
  29 TUPLE: accum-red-bits < pixel-format-attribute ;
  30 TUPLE: accum-green-bits < pixel-format-attribute ;
  31 TUPLE: accum-blue-bits < pixel-format-attribute ;
  32 TUPLE: accum-alpha-bits < pixel-format-attribute ;
  33
  34 TUPLE: depth-bits < pixel-format-attribute ;
  35
  36 TUPLE: stencil-bits < pixel-format-attribute ;
  37
  38 TUPLE: aux-buffers < pixel-format-attribute ;
  39
  40 TUPLE: sample-buffers < pixel-format-attribute ;
  41 TUPLE: samples < pixel-format-attribute ;
  42
  43 HOOK: (make-pixel-format) ui-backend ( world attributes -- pixel-format-handle )
  44 HOOK: (free-pixel-format) ui-backend ( pixel-format -- )
  45 HOOK: (pixel-format-attribute) ui-backend ( pixel-format attribute-name -- value )
  46
  47 ERROR: invalid-pixel-format-attributes world attributes ;
  48
  49 TUPLE: pixel-format < disposable world handle ;
  50
  51 : <pixel-format> ( world attributes -- pixel-format )
  52     2dup (make-pixel-format)
  53     [ pixel-format new-disposable swap >>handle swap >>world ]
  54     [ invalid-pixel-format-attributes ]
  55     ?if ;
  56
  57 M: pixel-format dispose*
  58     [ (free-pixel-format) ] [ f >>handle drop ] bi ;
  59
  60 : pixel-format-attribute ( pixel-format attribute-name -- value )
  61     (pixel-format-attribute) ;
  62
  63 <PRIVATE
  64
  65 FUNCTOR: define-pixel-format-attribute-table ( NAME PERM TABLE -- )
  66
  67 >PFA              DEFINES >${NAME}
  68 >PFA-int-array    DEFINES >${NAME}-int-array
  69
  70 WHERE
  71
  72 GENERIC: >PFA ( attribute -- pfas )
  73
  74 M: object >PFA
  75     drop { } ;
  76 M: word >PFA
  77     TABLE at [ { } ] unless* ;
  78 M: pixel-format-attribute >PFA
  79     dup class TABLE at
  80     [ swap value>> suffix ]
  81     [ drop { } ] if* ;
  82
  83 : >PFA-int-array ( attribute -- int-array )
  84     [ >PFA ] map concat PERM prepend 0 suffix >int-array ;
  85
  86 ;FUNCTOR
  87
  88 SYNTAX: PIXEL-FORMAT-ATTRIBUTE-TABLE:
  89     scan scan-object scan-object define-pixel-format-attribute-table ;
  90
  91 PRIVATE>
  92
  93 GENERIC: world-pixel-format-attributes ( world -- attributes )
  94
  95 GENERIC# check-world-pixel-format 1 ( world pixel-format -- )
  96