basis/images/loader/loader-tests.factor

   1 USING: accessors continuations glib.ffi images.loader
   2 io.files.temp kernel layouts sequences system tools.test ;
   3 IN: images.loader.tests
   4
   5 : open-png-image ( -- image )
   6     "vocab:images/testing/png/basi0g01.png" load-image ;
   7
   8 : convert-to ( image format -- image' )
   9     "foo." prepend temp-file [ save-graphic-image ] keep load-image ;
  10
  11 os windows? [
  12     ! Windows can handle these three formats fine.
  13     { { t t t } } [
  14         { "png" "tif" "gif" } [
  15             open-png-image [ swap convert-to ] keep =
  16         ] map
  17     ] unit-test
  18 ] when
  19
  20 os linux? [
  21     ! GTK only these two.
  22     { { t t } } [
  23         { "png" "bmp" } [
  24             open-png-image [ swap convert-to ] keep =
  25         ] map
  26     ] unit-test
  27
  28     ! It either can save to gif or throw a g-error if the gif encoder
  29     ! is excluded.
  30     { t } [
  31         [ open-png-image dup "gif" convert-to = ] [ g-error? ] recover
  32     ] unit-test
  33 ] when
  34
  35 os { linux windows } member? [
  36     { t } [
  37         [
  38             open-png-image
  39             "hai!" save-graphic-image
  40         ] [ unknown-image-extension? ] recover
  41     ] unit-test
  42
  43     ! Windows 32 can't save .bmp-files for unknown reason. It can load
  44     ! them though.
  45     64bit? [
  46         { t } [
  47             open-png-image dup "bmp" convert-to =
  48         ] unit-test
  49     ] when
  50
  51     { t } [
  52         "vocab:images/testing/bmp/rgb_8bit.bmp" load-image dup
  53         "foo.png" temp-file [ save-graphic-image ] [ load-image ] bi =
  54     ] unit-test
  55 ] when
  56
  57 ! On Windows, this image didn't load due to a funny problem with a
  58 ! callback triggering a gc causing an important pointer to be
  59 ! moved. Only happened with tiff images too.
  60 { { 1024 768 } } [
  61     "vocab:gpu/demos/bunny/loading.tiff" load-image dim>>
  62 ] unit-test