You are not logged in or registered. Please login or register to use the full functionality of this board...
SIGN IN Join Our Community For FREE


Martin Fractals Screen Saver demo
09-21-2014, 05:23 AM (This post was last modified: 12-30-2016 03:24 AM by Waltersmind.)
Post: #1
 (Print Post)
Martin Fractals Screen Saver demo
Here is a Martin Fractal graphical demo that I recreated from an old demo I found on a website that Anthony (ARB) shared a link to. I add my own twists to it so it is much different than the original, which was using SCREEN 12 for its graphics.

Here is the code:
Code Snippet: [Select]
DIM SHARED ScreenWidth AS _UNSIGNED INTEGER
DIM SHARED ScreenHeight AS _UNSIGNED INTEGER
DIM SHARED MainWindow AS _UNSIGNED LONG
DIM CenterX AS _FLOAT
DIM CenterY AS _FLOAT
DIM ParamA AS _FLOAT, ParamB AS _FLOAT, ParamC AS _FLOAT
DIM XOld AS _FLOAT, YOld AS _FLOAT
DIM XNew AS _FLOAT, YNew AS _FLOAT
DIM Scale AS _FLOAT
DIM CurrentCount AS _FLOAT
DIM CountMax AS _FLOAT
DIM NumPointsPlotted AS _UNSIGNED LONG
DIM PlottedMax AS _UNSIGNED LONG
DIM ColorChange AS _UNSIGNED LONG
DIM ColorChangeMax AS _UNSIGNED LONG
DIM Colr AS _UNSIGNED LONG

ScreenWidth = _DESKTOPWIDTH
ScreenHeight = _DESKTOPHEIGHT

MainWindow = _NEWIMAGE(ScreenWidth, ScreenHeight, 32)
SCREEN MainWindow

_FULLSCREEN
_MOUSEHIDE

CenterX = ScreenWidth / 2
CenterY = ScreenHeight / 2

CountMax = 10
PlottedMax = 5000
ColorChangeMax = 20000

DO

   LINE (0, 0)-(ScreenWidth - 1, ScreenHeight - 1), _RGB(255, 255, 255), BF

   ParamA = RND * 100 - 50
   ParamB = RND * 100 - 50
   ParamC = RND * 100 - 50

   XOld = 0: YOld = 0
   Colr = _RGB(RND * 255, RND * 255, RND * 255)
   ColorChange = 0
   CurrentCount = 0
   NumPointsPlotted = 0
   Scale = 6 - ABS(((ABS(ParamA) + ABS(ParamB) + ABS(ParamC)) / 3) / 10)

   DO

       PlotPoint XOld * Scale + CenterX, YOld * Scale + CenterY, Colr

       XNew = YOld - SGN(XOld) * SQR(ABS(ParamB * XOld - ParamC))
       YNew = ParamA - XOld

       XOld = XNew
       YOld = YNew

       NumPointsPlotted = NumPointsPlotted + 1

       IF NumPointsPlotted > PlottedMax THEN
           _LIMIT 60
           CurrentCount = CurrentCount + 0.0125
           NumPointsPlotted = 0
           _DISPLAY
       END IF

       ColorChange = ColorChange + 1

       IF ColorChange > ColorChangeMax THEN
           Colr = _RGB(RND * 255, RND * 255, RND * 255)
           ColorChange = 0
       END IF

       k$ = INKEY$

   LOOP WHILE k$ = "" AND CurrentCount < CountMax

   _DISPLAY

   PointsAcross = 16
   PointsDown = 8
   SectionWidth = ScreenWidth / (PointsAcross + 1)
   SectionHeight = ScreenHeight / (PointsDown + 1)
   MaxSize = SectionWidth * 1.5

   FOR ObjSize = 0 TO MaxSize STEP 2

       _LIMIT 60
       FOR y = SectionHeight TO ScreenHeight - SectionHeight / 2 STEP SectionHeight
           FOR x = SectionWidth TO ScreenWidth - SectionWidth / 2 STEP SectionWidth

               LINE (x - ObjSize, y - ObjSize)-(x + ObjSize, y + ObjSize), _RGBA(255, 255, 255, 32), BF
               IF k$ = CHR$(27) THEN SYSTEM
               k$ = INKEY$
           NEXT
       NEXT

       _DISPLAY
   NEXT


LOOP WHILE k$ <> CHR$(27)

SYSTEM


' *************************************************************************************************
' *                                                                                               *
' *************************************************************************************************
SUB PlotPoint (X AS _FLOAT, y AS _FLOAT, colr AS _UNSIGNED LONG)

Red = _RED32(colr)
Green = _GREEN32(colr)
Blue = _BLUE32(colr)
MaxI = 1
MaxRndSize = RND * 16

FOR i2 = 0 TO 7

   x1 = X + ((RND * MaxRndSize) - (MaxRndSize / 2))
   y1 = y + ((RND * MaxRndSize) - (MaxRndSize / 2))

   iMul = MaxI * (RND * 3)
   NewColr& = _RGBA(Red, Green, Blue, 8)

   LINE (INT(.5 + x1) - iMul, INT(.5 + y1) - iMul)-(INT(.5 + x1) + iMul, INT(.5 + y1) + iMul), NewColr&, BF

NEXT

END SUB

HERE ARE SOME SCREENSHOTS:

           
           
           
           
           
   

My goal is to bring joy, excitement, fun and education to all computer programming hobbyists, tinkerers, and amateurs. I also enjoy helping and working with those who aspire at becoming masters of their craft.
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - Input
QB64 Member Project - Connect Four
QB64 Member Project - Quarto
QB64 Member Project - Rotating Background
QB64 Member Project - Full Color LED Sign
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Algeria Weather
QB64 Member Project - Inside Moves
QB64 Member Project - ARB Checkers
QB64 Member Project - Score 4
QB64 Member Project - Domain
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Touche
QB64 Member Project - Spiro Roses
QB64 Member Project - Pivet version one
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Othello
QB64 Member Project - Splatter
QB64 Member Project - Bowditch curve
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Foursight
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - Overboard
QB64 Member Project - Martin Fractals version three
QB64 Member Project - MAPTRIANGLE
QB64 Member Project - Sabotage
QB64 Member Project - Color Triangles
QB64 Member Project - Kings Court
QB64 Member Project - Rubix's Magic
QB64 Member Project - Pivot version two
QB64 Member Project - Isolation
QB64 Member Project - OpenGL Triangles
QB64 Member Project - Amazon
QB64 Member Project - Swirl
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Dreamy Clock
QB64 Member Project - Blokus
QB64 Member Project - Qubic
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Line Thickness
QB64 Member Project - Martin Fractals version one
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - 9 Board
QB64 Member Project - Exit
QB64 Member Project - Point Blank
QB64 Member Project - Basic Dithering
QB64 Member Project - Color Rotating Text
QB64 Member Project - Dakapo