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