Mosaico de Truchet

[galil...@gmail.com]

^r4/lib/gui.txt

#tile1 )( 20000

#tile2 )( 20000

#acc

#t>

:ran rnd $0001 and ;

:getpix px@ t> !+ 't> ! ;

:setpix t> @ px!+ 4 't> +! ;

:b1 | x1 x2 y2 y1 x2 x1 --

  ( over <? )( pick2 2dup setxy 'acc @ exec drop 1+ ) 2drop ; 

:b0 | x1 x2 y2 y1 --

  ( over <? )( 2over swap b1 1+ ) ;

:putbit$ | x y w h --

  >r rot dup >r + r> swap rot dup r> + swap 

  'setpix 'acc !

  b0 4drop ;

:getbit$ | x1 y1 x2 y2 -- w h

  over pick4 - >r pick2 over swap - >r

  'getpix 'acc ! 

  rot b0 4drop r> r> ;

:dibuja | w h --

  swap

  0 ( sh pick3 - <? )(

    0 ( sw pick3 - <? )(

       2over swap 2over swap 2swap ran 0? ( drop 'tile1 't> ! )( drop 'tile2 't> ! ) putbit$ pick3 + )

    drop over + )

  3drop ;

:aro | x y r --

  dup 2over rot blanco fcircle 5 - negro fcircle ;

: clrscr

  100 100 15 aro

  75 75 15 aro

  200 200 15 aro

  175 225 15 aro

  'tile1 't> ! 75 75 100 100 getbit$ 2drop

  'tile2 't> ! 175 200 200 225 getbit$

  clrscr

  dibuja

  show 'exit >esc< ;

[Pablo Hugo Reda]

Cada vez lo tengo mas dificil.

Hice un poco de trampa, me fije en el codigo de lib/img.txt, la libreria de manejo de bitmaps, llegue al este bucle luego de muchas pruebas!!

Aunque la rutina de recorrido del la imagen se puede compartir, con una variable o con la direccion del vector en la pila (esto es mejor), 

el codigo que se debe ejecutar esta muy adentro, tiene dos bucles afuera!

entonces defino dos palabras, grabar un tile! y poner un tile@, aunque son casi iguales.

Elijo utilizar w y h, no x2 y2 asi no tengo que calcular las distancias

:tile@ | w h x y adr --
 >r
 setxy
 sw pick2 - | precalculo de suma linea
 swap | w dw h
 ( 1? )(
   pick2 ( 1? )( r@+ px!+ 1- ) drop
   over px+!
   1- ) 3drop
 rdrop ;


:tile! | w h x y adr --
 >r
 setxy
 sw pick2 -
 swap | w dw h
 ( 1? )(
   pick2 ( 1? )( px@ r!+ 1 px+! 1- ) drop
   over px+!
   1- ) 3drop
 rdrop ;

fijate que lo que trato de hacer es usar SETXY solo una vez

ahora obtener los tiles correctos

 cls
 100 100 15 aro
 75 75 15 aro
 200 200 15 aro
 175 225 15 aro

 25 25 75 75 'tile1 tile!
 25 25 175 200 'tile2 tile!

un detalle, uso CLS y no CLRSCR porque esta ultima esta hecha para SHOW, ademas de hacer CLS limpia las variables para la GUI y inicializa el cursor para PRINT, aqui no uso nada de esto. CLRSCR esta definida en gui.txt

DIBUJA queda casi igual

#tiles 'tile1 'tile2

:dibuja | w h --

  0 ( sh pick3 - <? )(
    0 ( sw pick3 - <? )(
      2over swap 2over

swap
      ran 2 << 'tiles + @ tile@

      pick3 + )
    drop over + )
  3drop ;

la llamada seria

cls
25 25 dibuja

Ultimo detalle, el azar siempre es el mismo, para  modificarlo:

msec rndseed

inicia la semilla de rnd con los milisegundos del sistema.

[galil...@gmail.com]

Muchas gracias por tus consejos y orientación.

Me encanta leer tus soluciones porque siempre suelen ser elegantes. Mi código funcionaba, pero no era nada "bonito". Sin embargo, con lo que me costó hacerlo funcionar, no me encontraba con fuerzas para depurarlo. Espero que llegue el día en que no me resulte tan difícil escribir códio para reda4 y pueda dedicar más tiempo a la optimización.