another speed fractal

[zaphod]

Ported from gfa basic 32, with the magic sapero tips :

Code Select Expand


' Fractal 1.0
' iwb 2.094
' 08/18/2011
' by zaphod
' based on code for GFA BASIC 32
'
' use SAPERO magic feature for PSET
'
' mouve the mouse cursor on fractal zone and
' left button : zoom IN
' right button : zoom OUT
' ESC key : init
'
int scry, scrx, np, imax, i, p
float x1, s, x2, y1, y2,px, py, yy, x0, y0, xx, xxx, cx, cy
'
uint screenH,screenW
GETSCREENSIZE screenW,screenH
'
init()
'
window w1
OPENWINDOW w1,screenw / 2 - scrx / 2, screenh / 2 - scry / 2, scrx, scry,0x80CA0080,0,"FRACTAL",&w1_handler
SETWINDOWCOLOR w1,RGB(0,0,0)
SHOWDIALOG w1
draw()
WAITUNTIL w1=0
END
'
sub w1_handler(),int
'
SELECT @MESSAGE
'
case @IDCHAR
if @wparam=27 ' ESC for init
init()
draw()
ENDIF
'
case @IDLBUTTONDN  ' ZOOM +
    cx = x1 + @MOUSEX * px
    cy = y1 + @MOUSEY * py
    s=s*0.50
    x1 = cx - s / 2
    y1 = cy - s / 2
    x2 = cx + s / 2
    y2 = cy + s / 2
    px = (x2 - x1) / scrx
    py = (y2 - y1) / scry
draw()
case @IDRBUTTONDN ' ZOOM -
    cx = x1 + @MOUSEX * px
    cy = y1 + @MOUSEY * py
    s=s*2
    x1 = cx - s / 2
    y1 = cy - s / 2
    x2 = cx + s / 2
    y2 = cy + s / 2
    px = (x2 - x1) / scrx
    py = (y2 - y1) / scry
draw()
CASE @IDCLOSEWINDOW
CLOSEWINDOW w1

ENDSELECT
RETURN 0
ENDSUB
'
sub draw()
int ll
uint col
'
int hdcOld = w1.m_hPrintDC
w1.m_hPrintDC = GETHDC(w1)
'
for ll=1 to 150000
  i = 0
  p = (p + 31) % np
  xx = 0
  yy = 0
  x0 = x1 + (p % scrx) * px
  y0 = y1 + (p / scrx) * py
  Do
  i++
   xxx = (xx*xx) - (yy*yy) + x0
    yy = 2 * xx * yy + y0
    xx = xxx
  Until ((xxx*xxx) + (yy*yy) > 4) Or i = imax
  '
col=RGB(i<<3, i<<2, i<<1)
pset w1, p%scrx, p/scrx,col
'
next ll
'
int hdc = w1.m_hPrintDC
w1.m_hPrintDC = hdcOld
RELEASEHDC(w1, hdc)
'
ENDSUB

sub init()
scry = screenh / 2
scrx = scry
x1 = -2
s = 2
x2 = 2
y1 = -2
y2 = 2
np = scrx * scry
imax = 255 '127
px = (x2 - x1) / scrx
py = (y2 - y1) / scry
ENDSUB