'===========================================================================
' Subject: MARTIN FRACTALS                   Date: 03-23-99 (08:41)       
'  Author: Jernej Simoncic                   Code: QB, QBasic, PDS        
'  Origin: jernej.simoncic@guest.arnes.si  Packet: GRAPHICS.ABC
'===========================================================================
' Martin fractal program, by Alan Meiss
' Converted to Rapid-Q by Jernej Simoncic
'
'  Formula from "Dynamical Systems and Fractals",
'   by Karl-Heinz Becker and Michael D”rfler,
'   Cambridge University Press, 1990
'
'
'Note: this program will compile under Linux, too, but you can't close it with
'close button. There are some other bugs, too.
'
'
DECLARE FUNCTION sign (x AS DOUBLE) AS SHORT
DECLARE SUB plot (x AS DOUBLE, y AS DOUBLE, clr AS LONG)
DECLARE FUNCTION RGB (R AS BYTE, G AS BYTE, B AS BYTE) AS LONG
DECLARE SUB martin1 (a AS DOUBLE, b AS DOUBLE, c AS DOUBLE, s AS DOUBLE)
DECLARE SUB getparam
DECLARE SUB EndMe
DECLARE SUB Restart
DECLARE SUB Resize
DECLARE SUB Start
'DEFINT A-Z
DIM xmax AS SHORT, ymax AS SHORT, t AS SHORT, tcmax AS SHORT, tc AS SHORT
DIM clr AS LONG, cx AS SHORT, cy AS SHORT, code AS SHORT
DIM sa AS DOUBLE, sav AS DOUBLE, sb AS DOUBLE, sc AS DOUBLE
DIM ch AS STRING, tt$ AS STRING
DIM xold AS DOUBLE, yold AS DOUBLE, xnew AS DOUBLE, ynew AS DOUBLE
DIM loopout AS BYTE

CREATE MainForm AS QForm
  Width=640
  Height=480
  BorderStyle=2
  Caption ="Martin fractals"
  Center
  OnClose=EndMe
  CREATE Canvas AS QCanvas
    Width=MainForm.ClientWidth
    Height=MainForm.ClientHeight
    OnCLick = Restart
  END CREATE
  OnResize=Resize
END CREATE

MainForm.Show
MainForm.OnResize=Resize  'BUG: program terminates, if this is put to create part

Start
END

SUB martin1 (a AS DOUBLE, b AS DOUBLE, c AS DOUBLE, s AS DOUBLE)

begin:   
   Canvas.FillRect (0,0,xmax,ymax,0)
   xold = 0
   yold = 0
   clr = INT(rnd*256) * 65536 + INT(rnd*256) * 256 + INT(rnd*256)
   t = 0
   tc = 0
   DO
      DOEVENTS
      plot xold * s, yold * s, clr
      xnew = yold - sign(xold) * SQR(ABS(b * xold - c))' { <- This is it! These two }
      ynew = a - xold                        '  { <- lines generate the }
      xold = xnew                             ' {     entire fractal! }
      yold = ynew
      t = t + 1
      IF t > 1000 THEN
         tc = tc + 1
         clr = INT(rnd*256) * 65536 + INT(rnd*256) * 256 + INT(rnd*256)
         t = 0
      END IF
   LOOP until loopout<>0 'UNTIL ((tc > (tcmax - 1)) AND (tcmax > 0))
   IF keypressed THEN
     ch = k$
   END IF
END SUB

SUB plot (x AS DOUBLE, y AS DOUBLE, clr AS LONG)
a=INT(.5 + x) + cx
b=INT(.5 + y) + cy
Canvas.PSET (a, b, clr)
END SUB

FUNCTION sign (x AS DOUBLE) AS SHORT
  IF x = 0 then
    sign = 0
  ELSEIF x < 0 then
    sign = -1
  ELSE
    sign = 1
  END IF
END FUNCTION

SUB EndMe
  loopout=2
  END
END SUB

SUB Restart
  loopout=1
END Sub

SUB Start
   RANDOMIZE TIMER

   cx = INT(.5 + xmax / 2)
   cy = INT(.5 + ymax / 2)
   loopout=0
   do
      xmax = MainForm.ClientWidth
      ymax = MainForm.ClientHeight
      cx = INT(.5 + xmax / 2)
      cy = INT(.5 + ymax / 2)
      sa = RND * 100! - 50!
      sb = RND * 100! - 50!
      sc = RND * 100! - 50!
      sav = (ABS(sa) + ABS(sb) + ABS(sc)) / 3!
      martin1 sa, sb, sc, 6! - ABS(sav / 10!)
      if loopout=2 then
        end
      end if
      loopout=0
   loop

   END
END SUB

SUB Resize
    Canvas.Width=MainForm.ClientWidth
    Canvas.Height=MainForm.ClientHeight
    loopout=1
    Canvas.FillRect (0,0,MainForm.ClientWidth,MainForm.ClientHeight,0)
end sub