'BARNSLEY FERN

include "Window.inc"

Window " ", 640,500, 1
Font 10,20,700,"courier"

single a, b, c, d, e, f, newx, newy, sys r, wa, imgHnd, imgHdc
dim xy(2) as single

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


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

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

Sub Fern
r = Rand(0,100)
if r <= 10 
   a = 0
   b = 0
   c = 0
   d = 0.16
   e = 0
   f = 0
elseif r > 1 and r <= 86 
   a = 0.85
   b = 0.04
   c = -.04
   d = 0.85
   e = 0
   f = 1.60
elseif r > 86 and r <= 93 
   a = 0.2
   b = -.26
   c = 0.23
   d = 0.22
   e = 0
   f = 0.16
else
   a = -.15
   b = 0.28
   c = 0.26
   d = 0.24
   e = 0
   f = 0.44
end if

newx = ((a * xy(1)) + (b * xy(2)) + e)
newy = ((c * xy(1)) + (d * xy(2)) + f)
xy(1) = newx
xy(2) = newy 
PutPixel xy(1)*40+275,xy(2)*40+50, 0,210,0
End Sub

for wa=1 to 64000
   Fern
next

sys x[64],y[64],i,j,st,en,px

for i= 0 to 63
  x[i]=i*100+rand(0,50)
  y[i]=0+rand(0,100)
next


While AscKey=0 and WinExit=0
ClsColor 0x00,0x00,0x00

for i=0 to 63
  px=x[i]
  px-=2
  if px<-300 then
    px+=6400 : st=i+1
  end if
  x[i]=px
next

en=st+8

for j=st to en
  i=j and 63
  iCopy x[i],y[i],210,235,420,470    'SPRITE
next
waitFPS 60

'SetWindowText sys_hwnd,"Fern Points = " + str(wa-1)
'Text 0,0,"SPRITES", 255,255,255
Events
FlipBuffer
wend
'pause

DeleteObject imgHnd
DeleteDC     imgHdc
WinEnd