  #compact
  % Title "Fractal Demo: Keyboard: + - r g b f i j m z, Arrow keys, Ctrl-P for snapshot Ctrl-Q for higher quality"
 '% Animated
  % ScaleUp
  % PlaceCentral
  % AnchorCentral
 '% NoEscape

  '% filename "t.exe"
  'uses RTL64
  uses ConsoleG
  Width =  800
  Height=  800


  macro limit(v,min,max)
  ======================
  if v>max then
    v=max
  elseif v<min then
    v=min
  end if
  end macro

  indexbase 1
  pixel4 juliapix[1024*1024]
  int gc
   
  
  function TakePixelPhoto(sys hwnd,string fname,typimg, sys quality, tr, any*pix, wi, ht) as sys
  '=============================================================================================
  '
  'itr problem with resize
  '
  'typimg: image/jpeg image/png image/gif image/tiff image/bmp
  'quality: 1..100
  '
  sys hstatus,pBitmap,pf
  width   = wi
  height  = ht
  % PixelFormat24bppRGB  137224
  % PixelFormat32bppARGB 2498570
  'http://forums.purebasic.com/english/viewtopic.php?p=205981
  if tr
    pf=PixelFormat32bppARGB
  else
    pf=PixelFormat24bppRGB
  end if
  sys a=@GdipCreateBitmapFromScan0
  call a wi,ht,0,pf,0,@pBitmap
  sys b,c,p,q,x,y
  q=@pix
  if tr
    b=*q and 0xffffff 'assume uniform background
  end if
  for y=0 to <ht
    for x=0 to <wi
      c=*q
      if tr
        if b=(c and 0xffffff)
          c and =0xffffff 'make pixel transparent
        end if
      end if
      'RED BLUE SWAP
      addr ecx,c
      mov al,[rcx]
      mov ah,[rcx+2]
      mov [rcx],ah
      mov [rcx+2],al
      '
      GdipBitmapSetPixel pBitMap,x,ht-y-1,c 'FLIP Y
      q+=4
    next   
  next
  if pBitMap then
    SaveImage fname,typimg,quality,pBitMap
    GdipDisposeImage pBitMap
  end if
  end function


  function JuliaCalc(double x, y, r, s,*oc, int it,jm) as double
  ==============================================================
  double xy,mx=4.0
  int k=it
  '
  if jm then
    'SWITCH TO MANDELBROT SET
    r=x
    s=y
    x=0
    y=0
  end if
  '
  'for k=0 to it
  mov esi,it
  (
    dec esi
    jl exit
     'gc+=1
       inc dword gc
     'xy=x*y
       fld qword x
       fmul qword y
       fstp qword xy
     'x=x*x-y*y+r
       fld qword x
       fmul st0
       fld qword y
       fmul st0
       fsubp st1
       fadd qword r
       fstp qword x
     'y=2*xy+s
       fld qword xy
       fadd st0
       fadd qword s
       fstp qword y
     'if abs(xy)>mx then exit for
       'fld qword mx
       'fld qword xy
       'fabs
       'fcomip
       'fstp st0
       'ja exit
     if x*x>mx then goto ni
     if y*y>mx then goto ni
     'if x*x+y*y>mx then exit for
       'fld qword mx
       'fld qword x
       'fmul st0
       'fld qword y
       'fmul st0
       'faddp st1
       'fcomip
       'fstp st0
       'ja exit
  'next
    repeat
  )
  .ni
  sub k,esi
  oc={x,y}
  return k
 'return sqr(sqr(abs(y)))
 'return sqr(abs(x)+abs(y))
 'return sqr(abs(y))
 'return abs(x)
 'return x+y
 'return abs(x)+abs(y)
 'return abs(xy)
 'return hypot(x,y)
  '
  sub k,esi
  'return k*abs(xy)
    'fld qword xy
    'fabs
    'fimul dword k
    'return
  'return abs(xy)
    'fld qword xy
    'fabs
    'return
  'return xy
    'fld qword xy
    'return
  'return xy*xy
    'fld qword xy
    'fmul st0
    'return
  'return k
  end function  
     
     


  function JuliaRender(double mf,it,jm,mp,sc,xo,yo,rf,gf,bf,sz)
  ================================================================
  indexbase 0
  'mf 2 .. 0 'factor
  'rf 0 .. 1 'red
  'gf 0 .. 1 'green
  'bf 0 .. 1 'blue
  sys i , j, en
  double x , y , dz , rc , ic , orb, oc[1]
  gc=0
  pixel4 jp at (@JuliaPix)
  rc=mf
  ic=mf-1.0
  dz=sc*3/sz
  en=sz-1
  for i=0 to en
    y=yo-1.5*sc+i*dz
    for j=0 to en
      x=xo-1.5*sc+j*dz
      orb=JuliaCalc(x,y,rc,ic,oc,it,jm)
      '
      'RECIPROCALS
     'if oc[0] then oc[0]=1/abs(oc[0])
     'if oc[1] then oc[1]=1/abs(oc[1])
     '
     'SQUARE ROOTS
     oc[0]=sqr(abs(oc[0]))
     oc[1]=sqr(abs(oc[1]))
     '
     'COLOR SEPARATION
      jp.r=abs(oc[0])*mp*rf
      jp.g=abs(oc[0])*abs(oc[1])*mp*gf
      jp.b=abs(oc[1])*mp*bf
     'jp.g=abs(oc[0])*abs(oc[1])*orb*.005*mp*gf
      '
     'jp.color=orb*mp
      '
      'orb=abs(oc[1])*mp
      'jp.r=orb*rf 'red
      'jp.g=orb*gf 'green
      'jp.b=orb*bf 'blue
      jp.a=255    'alpha
      @jp+=4      'next pixel
    next j
  next i
  end function


  function main()
  ===============
  '
  indexbase 1
  static int init,it,jm,mp
  static double rf,gf,bf,jf,jfi,sc,xo,yo
  sys sz=512
  if not init then
    sc=1
    xo=0
    yo=0
    rf=1.0
    gf=.5
    bf=.2
    jf=0
    jfi=0.002
    it=10
    mp=60
    init=1
    NewTexture JuliaTex
  end if
  if lastkey or lastchar then
    static float kvi=.01, kva=0.05
    static int   kii=1
    int cey=lastchar
    kva=.05*sc
    if cey>0x60 and cey<0x7b then cey-=32 'to uppercase
    '
    if key[189]      then kvi=-.01 : kii=-1 '-'
    if key[187]      then kvi= .01 : kii= 1 '+'
    if key[VK_RIGHT] then xo+=kva           'ARROW RIGHT'
    if key[VK_LEFT]  then xo-=kva           'ARROW LEFT'
    if key[VK_UP]    then yo+=kva           'ARROW UP'
    if key[VK_DOWN]  then yo-=kva           'ARROW DOWN'
    if key[0x5A]     then sc*=(1-kvi*5)     'Z' ZOOM
    if key[0x46]     then jf+=kvi           'F' FACTOR
    if cey=0x49      then it+=kii           'I' ITERATIONS
    if cey=0x4a      then jm=1-jm           'J' JULIA/MANDELBROT MODE
    if cey=0x4d      then mp+=kii           'M' OUTPUT MULTIPLIER
    if key[0x52]     then rf+=kvi           'R' RED
    if key[0x47]     then gf+=kvi           'G' GREEN
    if key[0x42]     then bf+=kvi           'B' BLUE
    '
    int pquality
    if key[81] and key[VK_CONTROL]
      sz=1024
      pquality=100
    end if
    '
   'limit sc, .01,100 'Julia Zoom
   'limit jf, 0,2     'Julia factor 
    limit it, 1,1000  'JuliaCalc iterations
    limit mp, 1,1000  'Julia output multiplier
    limit rf, 0,1     'red
    limit gf, 0,1     'green
    limit bf, 0,1     'blue
    '
    '
    lastkey=0
    lastchar=0
  end if
  '
  '
  JuliaRender jf,it,jm,mp,sc,xo,yo,rf,gf,bf,sz
  '
  pushstate
    'move 15.25,-14.35
    'UserMovement m2,200
    flat : color 1,1,1,1
    texture JuliaTex
    DynSynthTexture JuliaTex,JuliaPix,sz*sz*4  
    quadnorm 16.0,16.0 'apply image texture to quad
    texture 0
  popstate
  '
  if not pquality then
    'DISPLAY FACTORS
    def fi  "  %1:" str(%1,0)
    def ff  "  %1:" str(%1,2)
    def ff4 "  %1:" str(%1,4)
    pushstate
      'move 0 , 0 , .001
      move -15 , -15 , .001
      double zf=1/sc
      printl ff jf fi it  fi mp  ff zf ff4 xo ff4 yo ff rf  ff gf  ff bf ff sz
    popstate
  end if
  '
  if pquality then
    'TakeSnapShot gwnd,"tim.png","image/png",pngquality,0,1
    TakePixelPhoto gwnd,"tim.png","image/png",pquality,0,JuliaPix,sz,sz
  end if
  '
  end function



  EndScript
