Kaleidoscope

[SierraKen]

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

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:
2. CLS
3. ka& = _NEWIMAGE(600, 600, 32)
4. SCREEN ka&
5. _DEST ka&
6. _SOURCE ka&
7. c1 = 50: c2 = 10: c3 = 50
8. RANDOMIZE TIMER
9. s = RND * 10000
10.  
11. DO
12.     _LIMIT 500
13.     RANDOMIZE TIMER
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.  
23.     DO WHILE _MOUSEINPUT
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."
52. LOOP
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
62. CLS
63. PRINT "                                  Saving"
64. PRINT
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."
71. PRINT
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."
76. PRINT
77. PRINT "                     Example: MyPic"
78. PRINT "                     Quit and Enter key ends program."
79. PRINT
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:
103. END IF
104. saving2:
105. CLS
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&
153. END SUB
154.  

[bplus]

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?

[OldMoses]

That's amazing, I saved it and opened it in GIMP. Nice job.

[SierraKen]

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.