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


Waltersmind - SWIRL
06-15-2014, 03:19 AM (This post was last modified: 07-19-2014 06:08 PM by Waltersmind.)
Post: #1
 (Print Post)
Waltersmind - SWIRL
I came across an article at www.SuperComputingBlog.com on how to do an imaging processing effect called SWIRL. Honestly, I first saw this effect when Windows 95 came out in one of its screen savers. I fell in love with the effect and told myself that one day, I would set down and figure it out. Well, I never did until I came across the sample code on how to do it. Since finding that article, I found several more showing different ways, but stuck with the first one.

It was written in C or C+ or some dialect of the language, so I decided to rewrite (translate) it in QB64 for simplicity and fun.  It's very easy to test out new algorithms and ideas in QB64 than most other languages I have used, which is why I love the language.

The article and C+ source code can be found at http://supercomputingblog.com/openmp/ima...algorithm/ if anyone's interested.

Below is my hack at doing a SWIRL in QB64 using the algorithm found at the site mentioned above. Please note, the frame rate is slow as I am only getting 2-3 frames per second, but it is ample enough to keep you watching. At least it was for me. In the SWIRL sub routine, I use _MEMGET & _MEMPUT to obtain as much speed as I can, but I believe it's all the calculations being performed per pixel that is causing it to run slow. I do have a line above the _MEMPUT that uses the LINE(),BF statement, but it is commented out. I left it in there so people can test both ways. Just uncomment the LINE(),BF statement and comment out the _MEMPUT. I personally do not see a speed difference, which again I believe is all the calculations being performed. I added some little visual tricks to the demo which may come in useful for other projects.

Here's the demo code:


Code Snippet: [Select]
DIM SHARED PI AS _FLOAT
DIM SHARED ScreenMain AS LONG
DIM SHARED Image1 AS LONG
DIM SHARED Image2 AS LONG

DIM CenterX AS LONG
DIM CenterY AS LONG
DIM StartX AS INTEGER
DIM StartY AS INTEGER
DIM EndX AS INTEGER
DIM EndY AS INTEGER
DIM Factor AS _FLOAT
DIM FactorInc AS _FLOAT

PI = 3.141592653589793

MainWindow = _NEWIMAGE(800, 600, 32)
Image1 = _NEWIMAGE(400, 400, 32)
Image2 = _NEWIMAGE(_WIDTH(MainWindow), _HEIGHT(MainWindow), 32)
Image3 = _NEWIMAGE(_WIDTH(MainWindow), _HEIGHT(MainWindow), 32)

SCREEN MainWindow

CenterX = _WIDTH(MainWindow) / 2
CenterY = _HEIGHT(MainWindow) / 2
StartX = CenterX - (_WIDTH(Image1) / 2)
StartY = CenterY - (_HEIGHT(Image1) / 2)
EndX = CenterX + (_WIDTH(Image1) / 2)
EndY = CenterY + (_HEIGHT(Image1) / 2)
Factor = 0
FactorInc = 0.00125

_PRINTMODE _KEEPBACKGROUND

_DEST Image2

LINE (0, 0)-(_WIDTH(MainWindow), _HEIGHT(MainWindow)), _RGB(8, 8, 64), BF

DropShadowOffset = 2

FOR iteration1 = 1 TO 5000
   x = RND * _WIDTH(Image2)
   y = RND * _HEIGHT(Image2)
   Size = RND * 20 + 10
   s = Size 'RND * 20 + 10
   FOR i = 0 TO DropShadowOffset
       LINE (x + DropShadowOffset - i, y + DropShadowOffset - i)-(x + Size + DropShadowOffset + i, y + Size + DropShadowOffset + i), _RGBA(0, 0, 0, 32), BF
   NEXT
   LINE (x, y)-(x + s, y + s), _RGB(RND * 256, RND * 256, RND * 256), BF
NEXT


DO

   $CHECKING:OFF

   _DEST Image2

   DropShadowOffset = 2

   FOR iteration1 = 1 TO 50
       x = RND * _WIDTH(Image2)
       y = RND * _HEIGHT(Image2)
       s = RND * 20 + 10
       FOR i = 0 TO DropShadowOffset
           LINE (x + DropShadowOffset - i, y + DropShadowOffset - i)-(x + s + DropShadowOffset + i, y + s + DropShadowOffset + i), _RGBA(0, 0, 0, 32), BF
       NEXT
       LINE (x, y)-(x + s, y + s), _RGB(RND * 256, RND * 256, RND * 256), BF
   NEXT

   _PUTIMAGE (0, 0), Image2, Image1, (200, 100)-(600, 500)
   _PUTIMAGE (0, 0), Image2, Image3

   _DEST Image3

   DropShadowOffset = 20

   FOR i = 0 TO 20
       LINE (200 + i + DropShadowOffset, 100 + i + DropShadowOffset)-(600 - i + DropShadowOffset, 500 - i + DropShadowOffset), _RGBA(0, 0, 0, 20), BF
   NEXT

   Swirl Image1, Image3, 200, 100, Factor
   _PUTIMAGE (0, 0), Image3, MainWindow

   _DEST MainWindow

   LINE (200, 510)-(600, 542), _RGBA(64, 64, 255, 200), BF
   LINE (200, 510)-(600, 542), _RGBA(32, 32, 200, 255), B
   COLOR _RGB(0, 0, 96)
   _PRINTSTRING (211, 521), "Factor: " + STR$(Factor)
   COLOR _RGB(255, 255, 0)
   _PRINTSTRING (210, 520), "Factor: " + STR$(Factor)

   FOR i = 0 TO 1
       LINE (200 - i, 100 - i)-(600 + i, 500 + i), _RGBA(0, 0, 0, 128), B
   NEXT

   $CHECKING:ON

   _DISPLAY

   Factor = Factor + FactorInc
   IF Factor >= 0.1 OR Factor <= -0.1 THEN FactorInc = -FactorInc


LOOP WHILE INKEY$ = ""
SYSTEM

' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB Swirl (SourceImage AS LONG, DestinationImage AS LONG, TopLeftCornerX AS INTEGER, TopLeftCornerY AS INTEGER, Factor AS _FLOAT)

DIM CenterX AS INTEGER
DIM CenterY AS INTEGER
DIM ImageMemory AS _MEM
DIM ImageDestMemory AS _MEM
DIM ImageOffset AS _OFFSET
DIM ImageCurrentOffset AS _OFFSET
DIM ImageOffsetEnd AS _OFFSET
DIM ImageByteWidth AS _UNSIGNED LONG
DIM CurrentX AS LONG
DIM CurrentY AS LONG
DIM RelativeX AS _FLOAT
DIM RelativeY AS _FLOAT
DIM OriginalAngle AS _FLOAT
DIM Radius AS _FLOAT
DIM NewAngle AS _FLOAT
DIM SrcX AS LONG
DIM SrcY AS LONG
DIM Pixel AS _UNSIGNED LONG

CenterX = _WIDTH(SourceImage) / 2
CenterY = _HEIGHT(SourceImage) / 2
CurrentX = 0
CurrentY = 0

ImageMemory = _MEMIMAGE(SourceImage)
ImageOffsetEnd = ImageMemory.OFFSET + (_WIDTH(SourceImage) * _HEIGHT(SourceImage)) * 4
ImageCurrentOffset = 0
ImageByteWidth = _WIDTH(SourceImage) * 4
ImageDestMemory = _MEMIMAGE(DestinationImage)

_DEST DestinationImage

$CHECKING:OFF

DO

   RelativeY = CenterY - CurrentY
   RelativeX = CurrentX - CenterX

   IF RelativeX <> 0 THEN
       ' *** Angle
       OriginalAngle = ATN(ABS(RelativeY) / ABS(RelativeX))
       IF RelativeX > 0 AND RelativeY < 0 THEN
           ' *** Bottom Right Quandrant
           OriginalAngle = 2 * PI - OriginalAngle
       ELSE IF RelativeX <= 0 AND RelativeY >= 0 THEN
               ' *** Top Left Quadrant
               OriginalAngle = PI - OriginalAngle
           ELSE IF RelativeX <= 0 AND RelativeY < 0 THEN
                   ' *** Bottom Left Quadrant
                   OriginalAngle = OriginalAngle + PI
               END IF
           END IF
       END IF
   ELSE
       IF RelativeY >= 0 THEN
           OriginalAngle = 0.5 * PI
       ELSE
           OriginalAngle = 1.5 * PI
       END IF
   END IF

   Radius = SQR(RelativeX ^ 2 + RelativeY ^ 2) ' + RND * 10
   NewAngle = OriginalAngle - Factor * Radius

   SrcX = INT(Radius * COS(NewAngle) + 0.5) + CenterX
   SrcY = _HEIGHT(SourceImage) - (INT(Radius * SIN(NewAngle) + 0.5) + CenterY)

   IF SrcX < 0 THEN
       SrcX = 0
   ELSE IF SrcX >= _WIDTH(SourceImage) THEN
           SrcX = _WIDTH(SourceImage) - 1
       END IF
   END IF

   IF SrcY < 0 THEN
       SrcY = 0
   ELSE IF SrcY >= _HEIGHT(SourceImage) THEN
           SrcY = _HEIGHT(SourceImage) - 1
       END IF
   END IF

   Pixel = _MEMGET(ImageMemory, ImageMemory.OFFSET + (SrcY * ImageByteWidth + SrcX * 4), _UNSIGNED LONG)
   'LINE (CurrentX + TopLeftCornerX, CurrentY + TopLeftCornerY)-(CurrentX + TopLeftCornerX, CurrentY + TopLeftCornerY), Pixel, BF
   _MEMPUT ImageDestMemory, ImageDestMemory.OFFSET + ((CurrentY + TopLeftCornerY) * (_WIDTH(DestinationImage) * 4) + (CurrentX + TopLeftCornerX) * 4), Pixel

   CurrentX = CurrentX + 1

   IF CurrentX = _WIDTH(SourceImage) THEN
       CurrentX = 0
       CurrentY = CurrentY + 1
       IF CurrentY > _HEIGHT(SourceImage) THEN ImageCurrentOffset = ImageOffsetEnd
   END IF

   ImageCurrentOffset = ImageCurrentOffset + 4

LOOP WHILE (ImageMemory.OFFSET + ImageCurrentOffset) < ImageOffsetEnd

_MEMFREE ImageMemory
_MEMFREE ImageDestMemory

$CHECKING:ON

END SUB

SCREENSHOT:

   

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