basis/images/images.factor

   1 ! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: combinators kernel accessors sequences math arrays ;
   4 IN: images
   5
   6 SINGLETONS:
   7     A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
   8     INTENSITY DEPTH R RG
   9     ubyte-components ushort-components
  10     half-components float-components
  11     byte-integer-components ubyte-integer-components
  12     short-integer-components ushort-integer-components
  13     int-integer-components uint-integer-components ;
  14
  15 UNION: component-order
  16     A L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
  17     INTENSITY DEPTH R RG ;
  18
  19 UNION: component-type
  20     ubyte-components ushort-components
  21     half-components float-components
  22     byte-integer-components ubyte-integer-components
  23     short-integer-components ushort-integer-components
  24     int-integer-components uint-integer-components ;
  25
  26 UNION: unnormalized-integer-components
  27     byte-integer-components ubyte-integer-components
  28     short-integer-components ushort-integer-components
  29     int-integer-components uint-integer-components ;
  30
  31 UNION: alpha-channel BGRA RGBA ABGR ARGB LA A INTENSITY ;
  32
  33 TUPLE: image dim component-order component-type upside-down? bitmap ;
  34
  35 : <image> ( -- image ) image new ; inline
  36
  37 : has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
  38
  39 GENERIC: load-image* ( path class -- image )
  40
  41 DEFER: bytes-per-pixel
  42
  43 <PRIVATE
  44
  45 : bytes-per-component ( component-type -- n )
  46     {
  47         { ubyte-components [ 1 ] }
  48         { ushort-components [ 2 ] }
  49         { half-components [ 2 ] }
  50         { float-components [ 4 ] }
  51         { byte-integer-components [ 1 ] }
  52         { ubyte-integer-components [ 1 ] }
  53         { short-integer-components [ 2 ] }
  54         { ushort-integer-components [ 2 ] }
  55         { int-integer-components [ 4 ] }
  56         { uint-integer-components [ 4 ] }
  57     } case ;
  58
  59 : component-count ( component-order -- n )
  60     {
  61         { A [ 1 ] }
  62         { L [ 1 ] }
  63         { LA [ 2 ] }
  64         { BGR [ 3 ] }
  65         { RGB [ 3 ] }
  66         { BGRA [ 4 ] }
  67         { RGBA [ 4 ] }
  68         { ABGR [ 4 ] }
  69         { ARGB [ 4 ] }
  70         { RGBX [ 4 ] }
  71         { XRGB [ 4 ] }
  72         { BGRX [ 4 ] }
  73         { XBGR [ 4 ] }
  74         { INTENSITY [ 1 ] }
  75         { DEPTH [ 1 ] }
  76         { R [ 1 ] }
  77         { RG [ 2 ] }
  78     } case ;
  79
  80 : pixel@ ( x y image -- start end bitmap )
  81     [ dim>> first * + ]
  82     [ bytes-per-pixel [ * dup ] keep + ]
  83     [ bitmap>> ] tri ;
  84
  85 : set-subseq ( new-value from to victim -- )
  86     <slice> 0 swap copy ; inline
  87
  88 PRIVATE>
  89
  90 : bytes-per-pixel ( image -- n )
  91     [ component-order>> component-count ]
  92     [ component-type>>  bytes-per-component ] bi * ;
  93
  94 : pixel-at ( x y image -- pixel )
  95     pixel@ subseq ;
  96
  97 : set-pixel-at ( pixel x y image -- )
  98     pixel@ set-subseq ;