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     L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
   8     ubyte-components ushort-components
   9     half-components float-components
  10     byte-integer-components ubyte-integer-components
  11     short-integer-components ushort-integer-components
  12     int-integer-components uint-integer-components ;
  13
  14 UNION: component-order
  15     L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ;
  16
  17 UNION: component-type
  18     ubyte-components ushort-components
  19     half-components float-components
  20     byte-integer-components ubyte-integer-components
  21     short-integer-components ushort-integer-components
  22     int-integer-components uint-integer-components ;
  23
  24 UNION: unnormalized-integer-components
  25     byte-integer-components ubyte-integer-components
  26     short-integer-components ushort-integer-components
  27     int-integer-components uint-integer-components ;
  28
  29 UNION: alpha-channel BGRA RGBA ABGR ARGB ;
  30
  31 TUPLE: image dim component-order component-type upside-down? bitmap ;
  32
  33 : <image> ( -- image ) image new ; inline
  34
  35 : has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
  36
  37 GENERIC: load-image* ( path class -- image )
  38
  39 DEFER: bytes-per-pixel
  40
  41 <PRIVATE
  42
  43 : bytes-per-component ( component-type -- n )
  44     {
  45         { ubyte-components [ 1 ] }
  46         { ushort-components [ 2 ] }
  47         { half-components [ 2 ] }
  48         { float-components [ 4 ] }
  49         { byte-integer-components [ 1 ] }
  50         { ubyte-integer-components [ 1 ] }
  51         { short-integer-components [ 2 ] }
  52         { ushort-integer-components [ 2 ] }
  53         { int-integer-components [ 4 ] }
  54         { uint-integer-components [ 4 ] }
  55     } case ;
  56
  57 : component-count ( component-order -- n )
  58     {
  59         { L [ 1 ] }
  60         { LA [ 2 ] }
  61         { BGR [ 3 ] }
  62         { RGB [ 3 ] }
  63         { BGRA [ 4 ] }
  64         { RGBA [ 4 ] }
  65         { ABGR [ 4 ] }
  66         { ARGB [ 4 ] }
  67         { RGBX [ 4 ] }
  68         { XRGB [ 4 ] }
  69         { BGRX [ 4 ] }
  70         { XBGR [ 4 ] }
  71     } case ;
  72
  73 : pixel@ ( x y image -- start end bitmap )
  74     [ dim>> first * + ]
  75     [ bytes-per-pixel [ * dup ] keep + ]
  76     [ bitmap>> ] tri ;
  77
  78 : set-subseq ( new-value from to victim -- )
  79     <slice> 0 swap copy ; inline
  80
  81 PRIVATE>
  82
  83 : bytes-per-pixel ( image -- n )
  84     [ component-order>> component-count ]
  85     [ component-type>>  bytes-per-component ] bi * ;
  86
  87 : pixel-at ( x y image -- pixel )
  88     pixel@ subseq ;
  89
  90 : set-pixel-at ( pixel x y image -- )
  91     pixel@ set-subseq ;