Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SierraKen on December 16, 2019, 04:22:08 pm

Title: Kaleidoscope
Post by: SierraKen on December 16, 2019, 04:22:08 pm
Today I was experimenting more with graphics and equations and figured out a way to make a kaleidoscope. I know I made one back in October which is more of funky, dance floor looking lights. Which can be found here if you are interested. It is called Black Hole. https://www.qb64.org/forum/index.php?topic=1756.msg110029#msg110029 (https://www.qb64.org/forum/index.php?topic=1756.msg110029#msg110029)

But here is the much better one I made today. On this one you use the Mouse Wheel to change patterns. There's unlimited amount of different patterns and it will display the number of it in the Title bar. It starts at 0 so you can go into the negative numbers or positive, it doesn't matter. You also can save anything to .bmp by pressing S if you wish. The colors also change automatically without doing anything so if you want to save an image, do it quickly before it changes, or wait until something else catches your eye. Tell me what you think, thanks.

I included 3 pictures.

Code: QB64: [Select]
  1. start:
  3. ka& = _NEWIMAGE(600, 600, 32)
  4. SCREEN ka&
  5. _DEST ka&
  7. c1 = 50: c2 = 10: c3 = 50
  9. s = RND * 10000
  10.  
  12.     _LIMIT 500
  14.     clr = INT(RND * 300) + 1
  15.     IF clr = 1 THEN c1 = c1 + 25
  16.     IF c1 > 255 THEN c1 = 50
  17.     IF clr = 2 THEN c3 = c3 + 50
  18.     IF c3 > 255 THEN c3 = 0
  19.     IF clr > 298 THEN c3 = c1: c2 = c1
  20.     IF c3 > 255 THEN c3 = 5
  21.  
  22.  
  24.         mouseX = _MOUSEX
  25.         mouseY = _MOUSEY
  26.         mouseLeftButton = _MOUSEBUTTON(1)
  27.         mouseRightButton = _MOUSEBUTTON(2)
  28.         mouseMiddleButton = _MOUSEBUTTON(3)
  29.         mouseWheel = mouseWheel + _MOUSEWHEEL
  30.     LOOP
  31.  
  32.     s = 0
  33.     FOR m = 1 TO 3
  34.         RANDOMIZE TIMER
  35.         mx = (RND * 4) - 2
  36.         my = (RND * 4) - 2
  37.         FOR d = 320 TO 0 STEP -.125
  38.             k = mouseWheel
  39.             s = s + k
  40.             x = COS(s * 3.141592 / 180) * d
  41.             x = x + mx
  42.             y = SIN(s * 3.151492 / 180) * d
  43.             y = y + my
  44.             PSET (x + 300, y + 300), _RGB32(c1, c2, c3)
  45.         NEXT d
  46.     NEXT m
  47.     a$ = INKEY$
  48.     IF a$ = CHR$(27) THEN END
  49.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  50.     k$ = STR$(k)
  51.     _TITLE "Use Mouse Wheel To Change - Pattern " + k$ + "   Press S to save picture. Esc to end."
  53.  
  54. 'The rest of this is code to save a picture.
  55. '-------------------------------------------
  56. saving:
  57. ka2& = _COPYIMAGE(ka&)
  58.  
  59. 'Saving
  60. _TITLE "Saving Picture"
  61. _DELAY .25
  63. PRINT "                                  Saving"
  65. PRINT "                     Your bmp file will be saved in the"
  66. PRINT "                     same directory as this program is."
  67. PRINT "                     It can be used with almost any"
  68. PRINT "                     other graphics program or website."
  69. PRINT "                     It is saved using:"
  70. PRINT "                     width: 600  height: 600 pixels."
  72. PRINT "                     Type a name to save your picture"
  73. PRINT "                     and press the Enter key. Do not"
  74. PRINT "                     add .bmp at the end, the program"
  75. PRINT "                     will do it automatically."
  77. PRINT "                     Example: MyPic"
  78. PRINT "                     Quit and Enter key ends program."
  80. INPUT "                     ->"; nm$
  81. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
  82. nm$ = nm$ + ".bmp"
  83. 'Checking to see if the file already exists on your computer.
  84. theFileExists = _FILEEXISTS(nm$)
  85. IF theFileExists = -1 THEN
  86.     PRINT
  87.     PRINT "                File Already Exists"
  88.     PRINT "                Saving will delete your old"
  89.     PRINT "                bmp picture."
  90.     PRINT "                Would you like to still do it?"
  91.     PRINT "                (Y/N)."
  92.     PRINT "               Esc goes to start screen."
  93.     llloop:
  94.     _LIMIT 500
  95.     ag2$ = INKEY$
  96.     IF ag2$ = CHR$(27) THEN GOTO start:
  97.     IF ag2$ = "" THEN GOTO llloop:
  98.     IF ag2$ = "y" OR ag$ = "Y" THEN
  99.         SHELL _HIDE "DEL " + nm$
  100.         GOTO saving2:
  101.     END IF
  102.     GOTO llloop:
  104. saving2:
  106. SCREEN ka2&
  107. SaveImage 0, nm$
  108. FOR snd = 100 TO 800 STEP 50
  109.     SOUND snd, 1
  110. NEXT snd
  111. nm$ = ""
  112. ka& = 0
  113. ka2& = 0
  114. GOTO start:
  115.  
  116.  
  117. 'This section saves the .bmp picture file.
  118. SUB SaveImage (image AS LONG, filename AS STRING)
  119.     bytesperpixel& = _PIXELSIZE(image&)
  120.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  121.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  122.     x& = _WIDTH(image&)
  123.     y& = _HEIGHT(image&)
  124.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
  125.     IF bytesperpixel& = 1 THEN
  126.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  127.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  128.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  129.         NEXT
  130.     END IF
  131.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  132.     lastsource& = _SOURCE
  133.     _SOURCE image&
  134.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  135.     FOR py& = y& - 1 TO 0 STEP -1 ' read image pixel color data
  136.         r$ = ""
  137.         FOR px& = 0 TO x& - 1
  138.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  139.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  140.         NEXT px&
  141.         d$ = d$ + r$ + padder$
  142.     NEXT py&
  143.     _SOURCE lastsource&
  144.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  145.     b$ = b$ + d$ ' total file data bytes to create file
  146.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  147.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  148.     f& = FREEFILE
  149.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  150.     OPEN filename$ + ext$ FOR BINARY AS #f&
  151.     PUT #f&, , b$
  152.     CLOSE #f&
  154.  
Title: Re: Kaleidoscope
Post by: bplus on December 16, 2019, 04:59:02 pm
Ken make sure to tell people to use the scroll wheel on mouse, took me awhile to figure that out.
(Update: Oh he did do that! Another great reading job by bplus.)

How did you get the pixels to look like little squares?
Title: Re: Kaleidoscope
Post by: OldMoses on December 16, 2019, 06:31:06 pm
That's amazing, I saved it and opened it in GIMP. Nice job.
Title: Re: Kaleidoscope
Post by: SierraKen on December 16, 2019, 07:56:07 pm
Thanks guys!

Bplus yeah I actually did forget to add that in the TITLE so users would know to use the mouse wheel, so I just did.
It's this code (I think) that makes the squares:

        RANDOMIZE TIMER
        mx = (RND * 4) - 2
        my = (RND * 4) - 2

and then it's added to the pixel as it loops. 
Text Only | Text with Attachments