$DESCR SCRNSAVE: Fractale de mandelbrot
$LNK Exe C:\WINDOWS\fmnrscsa.scr
$Name GFA
$Icon C:\nico\savegf\fractal1.ico

'testaction
'Config
'EDIT
IF INSTR(UPPER$(_dosCmd$),"/C")
  Config
ELSE
  @Main
ENDIF
CLEAR
END
EDIT
SYSTEM
PROCEDURE Main

  init
  precalc
  tmm0

  TITLEW #1,"Fractale de Mandelbrot"
  OPENW #1,0,0,_X,_Y,0
  CLS 0
  ~SetWindowPos(WIN(1),-1,0,0,0,0,SWP_NOMOVE | SWP_NOSIZE)
  HIDEM
  PEEKEVENT
  DO
    PEEKEVENT
    @action
    EXIT IF MENU(11) = WM_MOUSEMOVE
  LOOP UNTIL  MENU(1) = 1  OR MENU(4) > 0 OR MENU(1) = 4
  SHOWM
  CLOSEW #1
  ERASE TMM%()

RETURN
PROCEDURE action
  INC x%
  IF x% >= Scrx%
    CLR x%
    INC y%
    IF y% >= Scry%
      CLR y%
      vmax% = 0
      vmin% = imax%
      dmmax = 0
      FOR vy% = 0 TO TY% - 1
        FOR vx% = 0 TO TX% - 1
          D% = TMM%(vx%,vy%,1) - TMM%(vx%,vy%,0)
          DM = TMM%(vx%,vy%,2) / 400
          IF  TMM%(vx%,vy%,0) < vmin% AND DM > imax% / 2
            vmax% = TMM%(vx%,vy%,0) - TMM%(vx%,vy%,1)
            vmin% = TMM%(vx%,vy%,0)
            dmmax = DM
            vx = x1 + vx% * 20 * px + 10 * px + (RND - 0.5) * px
            vy = y1 + vy% * 20 * py + 10 * py + (RND - 0.5) * py
          ELSE IF DM > dmmax AND TMM%(vx%,vy%,0) = vmin%
            vmax% = D%
            vmin% = TMM%(vx%,vy%,0)
            dmmax = DM
            vx = x1 + vx% * 20 * px + 10 * px + (RND - 0.5) * px
            vy = y1 + vy% * 20 * py + 10 * py + (RND - 0.5) * py
          ENDIF
        NEXT vx%
      NEXT vy%
      tmm0
      zoom = zoom * 2
      IF zoom > 1.0E+14
        zoom = 0.5
      ENDIF
      INC imax%
      precalc
    ENDIF
  ENDIF
  x0 = x1 + x% * px
  y0 = y1 + y% * py
  IF AA% = 1
    v = @ITERATE(x0,y0)
  ELSE
    v = 0
    FOR vy% = 0 TO PRED(AA%)
      FOR vx% = 0 TO PRED(AA%)
        v = v + @ITERATE(x0 + vx% * ppx,y0 + vy% * ppy)
      NEXT vx%
    NEXT vy%
    v = v / (AA% * AA%)
  ENDIF

  IF  v < TMM%(DIV(x%,20),DIV(y%,20),0)
    TMM%(DIV(x%,20),DIV(y%,20),0) = v
  ENDIF
  IF v > TMM%(DIV(x%,20),DIV(y%,20),1)
    TMM%(DIV(x%,20),DIV(y%,20),1) = v
  ENDIF
  ADD TMM%(DIV(x%,20),DIV(y%,20),2),INT(v)

  @VRGB(v,r%,g%,b%)
  RGBCOLOR RGB(r%,g%,b%)
  PLOT x%,y%

RETURN
PROCEDURE testaction
  TITLEW #1,"Fractale de Mandelbrot"
  OPENW #1,0,0,_X,_Y,0
  init
  precalc
  tmm0

  CLS 0
  ~SetWindowPos(WIN(1),-1,0,0,0,0,SWP_NOMOVE | SWP_NOSIZE)
  HIDEM
  PEEKEVENT
  '  FULLW #1
  DO
    PEEKEVENT
    EXIT IF MENU(11) <> WM_MOUSEMOVE
  LOOP
  DO
    action
    PEEKEVENT
    EXIT IF MENU(11) = WM_MOUSEMOVE
  LOOP UNTIL MENU(1) = 4
  SHOWM
  CLOSEW #1
  ERASE TMM%()

RETURN
FUNCTION ITERATE(x0,y0)
  LOCAL x,y,xnew,ynew
  FOR Compteur% = 0 TO imax%
    ynew = 2 * xnew * ynew  + y0
    xnew = x - y + x0
    x = xnew ^ 2,y = ynew ^ 2
    IF x + y > 4 THEN RETURN Compteur%
  NEXT Compteur%
  RETURN imax%
ENDFUNC
PROCEDURE VRGB(v,VAR r%,g%,b%)
  r% = 127 + SIN(v * m_r + p_r) * 127
  g% = 127 + SIN(v * m_g + p_g) * 127
  b% = 127 + SIN(v * m_b + p_b) * 127
RETURN
PROCEDURE precalc
  x1 = vx - 2 / zoom,y1 = vy - 2 / Rap / zoom
  x2 = x1 + 4 / zoom
  y2 = y1 + 4 / Rap / zoom
  px = (x2 - x1) / Scrx%
  py = (y2 - y1) / Scry%
  ppx = px / AA%
  ppy = py / AA%
RETURN
PROCEDURE tmm0
  LOCAL x%,y%
  FOR y% = 0 TO TY%
    FOR x% = 0 TO TX%
      TMM%(x%,y%,0) = imax%
      TMM%(x%,y%,1) = 0
      TMM%(x%,y%,2) = 0
    NEXT x%
  NEXT y%
RETURN
PROCEDURE init
  '  AA% = 2
  LireConfig
  '  imax% = 50
  m_r = 0.005 + RND * RND * RND * 4
  m_g = 0.005 + RND * RND * RND * 4
  m_b = 0.005 + RND * RND * RND * 4
  p_r = RND * 2 * PI
  p_g = RND * 2 * PI
  p_b = RND * 2 * PI
  Scrx% = _X,Scry% = _Y
  Rap = Scrx% / Scry%
  vx = 0,vy = 0
  zoom = 1
  TX% = Scrx% / 20,TY% = Scry% / 20
  DIM TMM%(TX%,TY%,2)

RETURN

PROCEDURE Config
  LireConfig

  info$ = "La fractale est en (-2,-2)-(2,2)), zoomée 1.5x sur une zone hétérogène et retracée."
  info$ = info$ + "|Si le zoom atteint 10 puissance 13 sa repart à zéro."
  info$ = info$ + "|Couleurs : Le nombre d'itérations donne une courbe sinuosidale,"
  info$ = info$ + "|fréquence choisie au hazard au départ."

  DW% = 350
  DH% = 300
  DIALOG #0,_X / 2 - DW% / 2,_Y / 2 - DH% / 2,DW%,DH%,"Fractale de Mandelbrot - Economiseur d'écran",$10080000

    CONTROL "Anticrénelage",100,"button",$10000007 | WS_TABSTOP,10,10,DW% / 2 - 20,DH% - 40
    CONTROL "Aucun",101,"button",$50000009,20,30,64,24
    CONTROL "4",102,"button",$50000009,20,70,70,20
    CONTROL "9",103,"button",$50000009,20,90,64,24
    CONTROL "16",104,"button",$50000009,20,110,64,24
    CONTROL "25",105,"button",$50000009,20,130,64,24
    CONTROL "36",106,"button",$50000009,20,150,64,24
    CONTROL "49",107,"button",$50000009,20,170,64,24
    CONTROL "64",108,"button",$50000009,20,190,64,24
    CONTROL "81",109,"button",$50000009,20,210,64,24
    CONTROL "100",110,"button",$50000009,20,230,64,24

    CONTROL "i Max (10 à 50000) :",111,"static",$5000000b,DW% / 2 + 10,10,DW% / 2 - 20,20
    CONTROL STR$(imax%),112,"edit",$50800000 | WS_TABSTOP,DW% / 2 + 10,30,DW% / 2 - 20,20

    CONTROL "Ok",120,"button",$50000000 | WS_TABSTOP,DW% / 2 + 10,60,DW% / 2 - 20,32
    CONTROL "Test",121,"button",$50000000 | WS_TABSTOP,DW% / 2 + 10,100,DW% / 2 - 20,32
    CONTROL "Annuler",122,"button",$50000000 | WS_TABSTOP,DW% / 2 + 10,DH% - 70,DW% / 2 - 20,32
    CONTROL "Information",123,"button",$50000000 | WS_TABSTOP,DW% / 2 + 10,DH% - 120,DW% / 2 - 20,32
  ENDDIALOG
  SHOWDIALOG #0
  IF AA% > 1 AND AA% <= 10
    SETCHECK 0,100 + AA%,TRUE
  ELSE
    SETCHECK 0,101,TRUE
    AA% = 1
  ENDIF
  DO
    PEEKEVENT
    IF MENU(1) = 30
      IF MENU(6) = 120
        FOR i% = 101 TO 110
          IF CHECK?(0,i%) <> FALSE
            AA% = i% - 100
          ENDIF
        NEXT i%
        imax% = MAX(10,MIN(50000,VAL(_WIN$(DLG(0,112)))))
        SaveConfig
        EXIT IF TRUE
      ENDIF
      IF MENU(6) = 121
        Oldaa% = AA%
        Oldimax% = imax%
        FOR i% = 101 TO 110
          IF CHECK?(0,i%) <> FALSE
            AA% = i% - 100
          ENDIF
        NEXT i%
        imax% = MAX(10,MIN(50000,VAL(_WIN$(DLG(0,112)))))
        SaveConfig
        testaction
        AA% = Oldaa%
        imax% = Oldimax%
        SaveConfig
      ENDIF
      IF MENU(6) = 122
        EXIT IF TRUE
      ENDIF
      IF MENU(6) = 123
        ALERT 1,info$,1,"Ok",rien%
      ENDIF

      IF MENU(6) <> 112
        i% = MAX(10,MIN(50000,VAL(_WIN$(DLG(0,112)))))
        _WIN$(DLG(0,112)) = STR$(i%)
      ENDIF

    ENDIF

    IF MENU(1) = 4
      EXIT IF TRUE
    ENDIF
  LOOP
  CLOSEDIALOG #0
RETURN
PROCEDURE SaveConfig
  REGDLL
  key$ = "MandelbrotEnconomiseur" + CHR$(0)
  keyval$ = STR$(AA% ) + CHR$(0)
  keyval2$ = STR$(imax%) + CHR$(0)
  N$ = "Anticrenelage" + CHR$(0)
  N2$ = "Imax" + CHR$(0)
  Ret% = ^RegCreateKey(HKEY_CLASSES_ROOT,V:key$,V:hkey%)
  Ret% = ^RegSetValue(hkey%,N$,REG_SZ,V:keyval$,0)
  Ret% = ^RegSetValue(hkey%,N2$,REG_SZ,V:keyval2$,0)
  Ret% = ^RegCloseKey(hkey%)
  FREEDLL 1
RETURN
PROCEDURE REGDLL
  DLL #1, "shell"
    DECL LONG RegCreateKey(l,l,l)
    DECL LONG RegSetValue(l,l,l,l,l)
    DECL LONG RegQueryValue(l,l,l,l)
    DECL LONG RegOpenKey(l,l,l)
    DECL LONG RegCloseKey(l)
  ENDDLL
  HKEY_CLASSES_ROOT = 1
  REG_SZ = 1
  ERROR_SUCCESS = 0
  ERROR_BADDB = 1
  ERROR_BADKEY = 2
  ERROR_CANTOPEN = 3
  ERROR_CANTREAD = 4
  ERROR_CANTWRITE = 5
  ERROR_OUTOFMEMORY = 6
  ERROR_INVALID_PARAMETER = 7
  ERROR_ACCESS_DENIED = 8
RETURN
PROCEDURE LireConfig
  REGDLL
  key$ = "MandelbrotEnconomiseur" + CHR$(0)
  keyval$ = STR$(AA%) + CHR$(0)
  N$ = "Anticrenelage" + CHR$(0)
  N2$ = "Imax" + CHR$(0)
  Ret% = ^RegOpenKey(HKEY_CLASSES_ROOT,V:key$,V:hkey%)

  bffr$ = SPACE$(128)
  sze& = LEN(bffr$)
  Ret% = ^RegQueryValue(hkey%,N$,V:bffr$,V:sze&)
  AA% = VAL(ZTRIM$(bffr$))

  bffr$ = SPACE$(128)
  sze& = LEN(bffr$)
  Ret% = ^RegQueryValue(hkey%,N2$,V:bffr$,V:sze&)
  imax% = VAL(ZTRIM$(bffr$))

  Ret% = ^RegCloseKey(hkey%)
  FREEDLL 1
RETURN