'BARNSLEY FERN

sys imgHnd, imgHdc

imgHnd = CreateCompatibleBitmap sys_hdc, 420,600
imgHdc = CreateCompatibleDC sys_hdc
SelectObject imgHdc, imgHnd


Sub PutPixel(sys x,y, r,g,b)
    SetpixelV imgHdc, x, 450-y, ColorRGB(r,g,b)
End Sub    

Sub FernCopy(sys x, y, width, height, iwidth, iheight)
    TransparentBlt bHdc,x,y,width,height,imgHdc,0,0,iwidth,iheight,0 
End Sub


  Sub FernParticle
  static long seed=0x12345678
  static single fxx, fxy, fyx, fyy, dxx, dyy, x, y, v
  '
  'RND 0..100
  seed=seed*0x8088405+1 'chaos
  mov eax,101           'range 0..100
  mul seed              'edx product bits 32..63
  '
  select edx
  case  0 to 10 'omit for dense fronds
  fxx = 0
  fxy = 0
  fyx = 0
  fyy = 0.16
  dxx = 0
  dyy = 0
  case 10 to 86 
  fxx = .85     'bushy
  fxy = 0.04    'curve up
  fyx = -.04    'dip density
  fyy = 0.85    'dispersal and internode
  dxx = 0.0     '
  dyy = 1.60    'height / density
  case 87 to 93 'omit for right side only 
  fxx = 0.2
  fxy = -.26
  fyx = 0.23
  fyy = 0.22
  dxx = 0
  dyy = 0.16
  case 94 to 100 'omit for left side only
  fxx = -.15  'x factor for x
  fxy = 0.28  'y factor for x
  fyx = 0.26  'x factor for y
  fyy = 0.24  'y factor for y
  dxx = 0     '  displacement for x
  dyy = 0.44  '  displacement for y
  end select

  v=x 'preserve original x
  x = fxx*v + fxy*y + dxx
  y = fyx*v + fyy*y + dyy
  PutPixel(int(x*40+275),int(y*40+50), 50,210,20)
  End Sub

sub CreateFern()
sys i
for i=1 to 64000
   FernParticle
next
end sub

sub DeleteFern()
DeleteObject imgHnd
DeleteDC     imgHdc
end sub
