Keskustelu: Koodit: Barnsley Fern 8th-ohjelmointikielellä

true app:isgui !

var gui

: WIDTH  500 ;
: HEIGHT 420 ;

: SCALE 40 ;
: ITERATIONS 1000000 ;


WIDTH HEIGHT img:new var, buffer


[ ` [ 0.00, 0.00, 0.00, 0.16  ] [ 2, 2] mat:new ` ,
  ` [ 0.85, 0.04, -0.04, 0.85 ] [ 2, 2] mat:new ` ,
  ` [ 0.20, -0.26, 0.23, 0.22 ] [ 2, 2] mat:new ` ,
  ` [ -0.15, 0.28, 0.26, 0.24 ] [ 2, 2] mat:new ` ] var, abcd


[ ` [ 0.00, 0.00 ] [ 2, 1 ] mat:new ` ,
  ` [ 0.00, 1.60 ] [ 2, 1 ] mat:new ` ,
  ` [ 0.00, 1.60 ] [ 2, 1 ] mat:new ` ,
  ` [ 0.00, 0.44 ] [ 2, 1 ] mat:new ` ] var, ef


[ ` [ 0, 0 ] [ 2, 1 ] mat:new ` ] var, xy


[ ( r@ 10 n:> not ) , ( abcd @ 0 a:@ nip xy @ a:len n:1- a:@ nip mat:* ef @ 0 a:@ nip mat:+ ) ,
  ( r@ 1 n:> r@ 86 n:> not and ) , ( abcd @ 1 a:@ nip xy @ a:len n:1- a:@ nip mat:* ef @ 1 a:@ nip mat:+ ) ,
  ( r@ 86 n:> r@ 93 n:> not and ) , ( abcd @ 2 a:@ nip xy @ a:len n:1- a:@ nip mat:* ef @ 2 a:@ nip mat:+ ) ,
  ( abcd @ 3 a:@ nip xy @ a:len n:1- a:@ nip mat:* ef @ 3 a:@ nip mat:+ ) ] var, when-table


: rand100
  rand-pcg n:abs 100 n:mod ;


: fern
  rand100 >r
  when-table @ a:when
  xy @ swap a:push drop
  rdrop ;


: draw-image
  1 mat:get-n n:neg SCALE n:* HEIGHT n:+ n:int swap
  0 mat:get-n SCALE n:* WIDTH 2 n:/ n:+ n:int nip
  "green" img:pix! ;


: do-draw
  buffer @ 0 0 g:image-at drop ;


: app:main
  ' fern ITERATIONS times
  buffer @ xy @ ' draw-image a:each! 2drop

  {
    kind: "win",
    title: "Fern",
    wide: ` WIDTH ` ,
    high: ` HEIGHT ` ,
    bg: "black",
    center: true,
    resizable: false,
    font: "Arial 10",
    draw: "do-draw"
  }

  g:new gui ! ;

true app:isgui !

500 constant WIDTH
420 constant HEIGHT

40 constant SCALE
1000000 constant ITERATIONS

WIDTH HEIGHT img:new var, buffer

[ 0.00, 0.00, 0.00,  0.16 ] [ 2, 2] mat:new constant A
[ 0.85, 0.04, -0.04, 0.85 ] [ 2, 2] mat:new constant B
[ 0.20, -0.26, 0.23, 0.22 ] [ 2, 2] mat:new constant C
[ -0.15, 0.28, 0.26, 0.24 ] [ 2, 2] mat:new constant D

[ 0.00, 0.00 ] [ 2, 1 ] mat:new constant E
[ 0.00, 1.60 ] [ 2, 1 ] mat:new constant F
[ 0.00, 1.60 ] [ 2, 1 ] mat:new constant G
[ 0.00, 0.44 ] [ 2, 1 ] mat:new constant H

\ This is the most recently calculated point:
[ 0, 0 ] [ 2, 1 ] mat:new var, xy

\ Put the most likely or common items first in the 'when' test:
[
  ( dup 11 85 n:between ) , ( B xy @  mat:* F mat:+ ) ,
  ( dup 11 n:< ) , ( A xy @  mat:* E mat:+ ) ,
  ( dup 86 92 n:between ) , ( C xy @  mat:* G mat:+ ) ,
  ( D xy @  mat:* H mat:+ )  \ else...
] var, when-table

: rand100
  rand-pcg n:abs 100 n:mod ;

: draw-image \ buffer xy
  over swap
  1 mat:get-n SCALE n:neg n:* HEIGHT n:+ n:int swap
  0 mat:get-n SCALE n:* WIDTH 2 n:/ n:+ n:int nip
  "green" img:pix! ;

: fern
  rand100 when-table @ a:when nip
  xy xchg draw-image drop  ;

: do-draw
  buffer @ 0 0 g:image-at drop ;

: app:main
  buffer @ ' fern ITERATIONS times

  {
    kind: "win",
    title: "Fern",
    init: ( buffer @ img:size rot drop g:size ) ,  \ set size according to image at runtime
    bg: "black",
    center: true,
    resizable: false,
    font: "Arial 10",
    draw: "do-draw"
  }

  g:new ;