extra/ui/render/test/test.factor

   1 ! Copyright (C) 2008 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
   5 ui.gadgets ui.gadgets.packs ui.gadgets.borders ui.gadgets.grids
   6 ui.gadgets.grid-lines ui.gadgets.labels ui.gadgets.buttons
   7 ui.render ui opengl opengl.gl images ;
   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 : stride ( bitmap -- n ) width>> 3 * ;
  30
  31 : bitmap= ( bitmap1 bitmap2 -- ? )
  32     [
  33         [ [ buffer>> ] [ stride 4 align ] bi group ] [ stride ] bi
  34         '[ _ head twiddle ] map
  35     ] bi@ = ;
  36
  37 : check-rendering ( gadget -- )
  38     screenshot
  39     [ render-output set-global ]
  40     [
  41         "resource:extra/ui/render/test/reference.bmp" <image>
  42         bitmap= "is perfect" "needs work" ?
  43         "Your UI rendering " prepend
  44         message-window
  45     ] bi ;
  46
  47 TUPLE: take-screenshot { first-time? initial: t } ;
  48
  49 M: take-screenshot draw-boundary
  50     dup first-time?>> [
  51         over check-rendering
  52         f >>first-time?
  53     ] when
  54     2drop ;
  55
  56 : <ui-render-test> ( -- gadget )
  57     <shelf>
  58         take-screenshot new >>boundary
  59         <gadget>
  60             black <solid> >>interior
  61             { 98 98 } >>dim
  62         1 <border> add-gadget
  63         <gadget>
  64             gray <solid> >>boundary
  65             { 94 94 } >>dim
  66         3 <border>
  67             red <solid> >>boundary
  68         add-gadget
  69             <line-gadget> <line-gadget> <line-gadget> 3array
  70             <line-gadget> <line-gadget> <line-gadget> 3array
  71             <line-gadget> <line-gadget> <line-gadget> 3array
  72         3array <grid>
  73             { 5 5 } >>gap
  74             blue <grid-lines> >>boundary
  75         add-gadget
  76         <gadget>
  77             { 14 14 } >>dim
  78             black <checkmark-paint> >>interior
  79             black <solid> >>boundary
  80         4 <border>
  81         add-gadget ;
  82
  83 : ui-render-test ( -- )
  84     <ui-render-test> "Test" open-window ;
  85
  86 MAIN: ui-render-test