extra/ui/render/test/test.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors colors arrays kernel sequences math byte-arrays
   4 namespaces grouping fry cap images.bitmap ui.gadgets ui.gadgets.packs
   5 ui.gadgets.borders ui.gadgets.grids ui.gadgets.grid-lines
   6 ui.gadgets.labels ui.gadgets.buttons ui.pens ui.pens.solid ui.render
   7 ui opengl opengl.gl colors.constants images images.loader ;
   8 IN: ui.render.test
   9
  10 SINGLETON: line-test
  11
  12 M: line-test draw-interior
  13     2drop { 0 0 } { 0 10 } gl-line ;
  14
  15 : <line-gadget> ( -- gadget )
  16     <gadget>
  17         line-test >>interior
  18         { 1 10 } >>dim ;
  19
  20 : message-window ( text -- )
  21     <label> "Message" open-window ;
  22
  23 SYMBOL: render-output
  24
  25 : twiddle ( bytes -- bytes )
  26     ! On Windows, white is { 253 253 253 } ?
  27     [ 10 /i ] map ;
  28
  29 : bitmap= ( bitmap1 bitmap2 -- ? )
  30     [ bitmap>> twiddle ] same? ;
  31
  32 : check-rendering ( gadget -- )
  33     screenshot
  34     [ render-output set-global ]
  35     [
  36         "vocab:ui/render/test/reference.bmp" load-image
  37         bitmap= "is perfect" "needs work" ?
  38         "Your UI rendering " prepend
  39         message-window
  40     ] bi ;
  41
  42 TUPLE: take-screenshot { first-time? initial: t } ;
  43
  44 M: take-screenshot draw-boundary
  45     dup first-time?>> [
  46         over check-rendering
  47         f >>first-time?
  48     ] when
  49     2drop ;
  50
  51 : <ui-render-test> ( -- gadget )
  52     <shelf>
  53         take-screenshot new >>boundary
  54         <gadget>
  55             COLOR: black <solid> >>interior
  56             { 98 98 } >>dim
  57         { 1 1 } <border> add-gadget
  58         <gadget>
  59             COLOR: gray <solid> >>boundary
  60             { 94 94 } >>dim
  61         { 3 3 } <border>
  62             COLOR: red <solid> >>boundary
  63         add-gadget
  64             <line-gadget> <line-gadget> <line-gadget> 3array
  65             <line-gadget> <line-gadget> <line-gadget> 3array
  66             <line-gadget> <line-gadget> <line-gadget> 3array
  67         3array <grid>
  68             { 5 5 } >>gap
  69             COLOR: blue <grid-lines> >>boundary
  70         add-gadget ;
  71
  72 : ui-render-test ( -- )
  73     <ui-render-test> "Test" open-window ;
  74
  75 MAIN: ui-render-test