rogue.factor

! Copyright (C) 2018 Your name.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays colors.constants fonts io kernel locals math namespaces opengl prettyprint sequences strings
ui ui.gadgets ui.gadgets.labels ui.gadgets.worlds ui.gestures ui.render ui.text ;
IN: rogue

TUPLE: cell { value string } ;
: <cell> ( -- cell )
    cell new " " >>value ;

:: cell-at ( cells row col -- cell )
    row cells nth col swap nth ;

: make-cells ( rows cols -- cells )
    [ [ <cell> ] replicate ] curry replicate ;

:: each-cell ( ... cells quot: ( ... row col cell -- ... ) -- ... )
    cells [| row |
           [| cell col | row col cell value>> quot call ] each-index
    ] each-index ; inline

TUPLE: text-grid-gadget < gadget cells font ;
: <text-grid-gadget> ( rows cols -- gadget )
    text-grid-gadget new
    -rot make-cells >>cells
    monospace-font
    COLOR: white font-with-foreground
    COLOR: black font-with-background >>font ;

:: draw-cell ( row col cell font -- )
    font cell text-dim first2 [ col * ] [ row * ] bi* 2array
    [ font cell draw-text ] with-translation ;

:: draw-cells ( gadget -- )
    gadget font>> :> font
    gadget cells>> [ font draw-cell ] each-cell ;


M: text-grid-gadget draw-gadget* ( gadget -- )
    ! origin over dim>> gl-fill-rect
    COLOR: black gl-color
    origin get over dim>> gl-fill-rect
    draw-cells ;

  M: text-grid-gadget handle-gesture ( gesture gadget -- ? )
    over key-down? [
          over sym>>
        [ swap over [ sym>> ] [ cells>> 3 3 cell-at ] bi* value<< relayout-1 ]
        [ 2drop ] if
    ] [ 2drop ] if f ;

M: text-grid-gadget pref-dim*
    drop { 200 200 } ;

MAIN-WINDOW: rogue-show {
        { title "Rogue" }
        { window-controls
          { normal-title-bar close-button minimize-button }
        }
    }
    10 10 <text-grid-gadget>
    dup cells>> 5 5 cell-at "@" swap value<< 
    >>gadgets ;