10 CONSTANT _w   _w const w      \ ширина стакана
20 CONSTANT _h   _h const h      \ высота стакана

: w[h[
\ макрос начала цикла по стакану
   h 0 # ( h 0 ) do
      w 0 # ( w 0 ) do
;

: ]]
\ макрос конца цикла по 2м координатам
      loop
   loop
;

_w _h ~* CONSTANT ~poolsz      \ \ размер буфера стакана
~poolsz const poolsz         \ /

~poolsz buffer pool         \ буфер стакана

: pool[] ( x y -- offset=y*w+x )
\ пересчет кооржинат в стакане в смещение от начала буфера
   ( y ) w * ( x ) +
;

{ pool@ ( x y -- value )
\ чтение состояния элемента
   ( x y )    pool[]       \ координаты --> смещение от начала буфера
   ( offset ) pool +       \ смещение --> адрес памяти
   ( addr )   c@          \ элемент стакана кодируется байтом
}

{ pool! ( value x y -- )
\ запись элемента стакана
   ( x y )          pool[]      \ смещение
   ( offset )     pool +      \ адрес
   ( value addr ) c!      \ запись элемента
}

0 var (c)   : c (c) @ ;      \ размер элемента стакана в пикселах

: CALCULATE_c ( -- )
\ определение размера элемента в пикселах
\ по размерам экрана и размерам стакана
\ слово вызывается после старта графического драйвера
   gr/Xsz w / ( Xsz/w )
   gr/Ysz h / ( Ysz/h )
          min ( cvalue ) (c) !
;

{ c ( -- sz )
\ вариант с отслеживанием динамически меняющегося размера графического окна
\ без кеширования -- движок шустрый, операции деления дешевы, вычисляем с каждый
\ раз заново, не сравнивая предыдущие и текущие значения Xsz Ysz
     gr/Xsz w / ( Xsz/w ) gr/Ysz h / ( Ysz/h ) min ( cvalue )
}

0 var cell/x            \ \ экранные координаты угла элемента
0 var cell/y            \ /

: x1   cell/x @ ;   : x2   x1 c +     ;
: y1   cell/y @ ;   : y2   y1 c +    ;

: x[y[
\ макрос заголовка цикла по 2м координатам
   y2 y1 do
      x2 x1 do
;

{ pool/draw ( x y -- )
\ отрисовка x;y элемента стакана
   over ( x ) c * cell/x !      \ экранная координата X элемента
   dup  ( y ) c * cell/y !      \ экранная координата Y элемента
   ( x y )
   pool@ if         \ чтение состояния элемента стакана
      x[y[ i j gr/set ]]
   else
      x[y[ i j gr/clr ]]
   endif
}

{ REDRAW ( -- )
\ перерисовка экрана
   w[h[ i j pool/draw ]]      \ цикл отрисовки стакана
}

{ POOLRANDFILL ( -- )
\ слово нужно для демонстрации работы REDRAW
\ выполняется перед перерисовкой экрана, заполняет стакан случайным образом
   w[h[   1 # rnd ( value ) i j pool!   ]]
}