Random Hills Generator

[SierraKen]

LOL thanks bplus. Well you can do what I did, and have both programs. The older one I posted on this thread and the last one. :)

[SierraKen]

I will post both here...

Here is the original bright green cartoon version:

Code: QB64: [Select]

1. 'Thanks to bplus and QB64.org Forum for some help!
2. 'Made by Ken G. on Oct. 27, 2019.
3.  
4. _TITLE "Space Bar to Make More. Left Click Mouse where you want Text and Press Enter. S Saves to Computer. Esc to Quit."
5. start:
6. SCREEN _NEWIMAGE(800, 600, 32)
7. CLS
8. PAINT (2, 2), _RGB32(127, 200, 255)
9. RANDOMIZE TIMER
10. tt = INT(RND * 25) + 2
11. DO
12.     _LIMIT 500
13.     RANDOMIZE TIMER
14.     x = RND * 800
15.     y = (RND * 100) + 600
16.     s = RND * 400
17.     sh = RND * 2
18.     c = 1
19.     DO
20.         ss = ss + .5
21.         c = c + .25
22.         IF ss > s THEN GOTO more:
23.         CIRCLE (x, y), ss, _RGB32(0, c, 0), , , sh
24.     LOOP
25.     more:
26.     ss = 0
27.     t = t + 1
28.     IF t = tt THEN EXIT DO
29. LOOP
30. t = 0
31. DO
32.     a$ = INKEY$
33.     IF a$ = CHR$(27) THEN END
34.     IF a$ = " " THEN GOTO start:
35.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
36.     DO WHILE _MOUSEINPUT
37.         mouseX = _MOUSEX
38.         mouseY = _MOUSEY
39.         mouseLeftButton = _MOUSEBUTTON(1)
40.     LOOP
41.     IF mouseLeftButton = -1 THEN
42.         clr& = POINT(mouseX, mouseY)
43.         COLOR _RGB32(0, 0, 0), clr&
44.         LOCATE mouseY / 16, mouseX / 8
45.         INPUT "", txt$
46.     END IF
47. LOOP
48. saving:
49. 'Now we call up the SUB to save the image to BMP.
50. SaveImage 0, "temp.bmp"
51. _DELAY .25
52. CLS
53. LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
54. COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
55. PRINT "                               Saving"
56. PRINT
57. PRINT "                  Your BMP file will be saved in the"
58. PRINT "                  same directory as this program is."
59. PRINT "                  It can be used with almost any"
60. PRINT "                  other graphics program or website."
61. PRINT "                  It is saved using:"
62. PRINT "                  width: 800  height: 600 pixels."
63. PRINT
64. PRINT "                  Type a name to save your picture"
65. PRINT "                  and press the Enter key. Do not"
66. PRINT "                  add .bmp at the end, the program"
67. PRINT "                  will do it automatically."
68. PRINT
69. PRINT "                  Also do not use the name temp"
70. PRINT "                  because the program uses that name"
71. PRINT "                  and it would be erased the next time"
72. PRINT "                  you save a picture."
73. PRINT "                  Example: MyPic"
74. PRINT "                  Quit and Enter key ends program."
75. PRINT
76. INPUT "         ->"; nm$
77. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
78. nm$ = nm$ + ".bmp"
79. 'Checking to see if the file already exists on your computer.
80. theFileExists = _FILEEXISTS(nm$)
81. IF theFileExists = -1 THEN
82.     PRINT
83.     PRINT "             File Already Exists"
84.     PRINT "             Saving will delete your old"
85.     PRINT "             bmp picture."
86.     PRINT "             Would you like to still do it?"
87.     PRINT "             (Y/N)."
88.     PRINT "             Esc goes to start screen."
89.     llloop:
90.     _LIMIT 100
91.     ag2$ = INKEY$
92.     IF ag2$ = CHR$(27) THEN GOTO start:
93.     IF ag2$ = "" THEN GOTO llloop:
94.     IF ag2$ = "y" OR ag$ = "Y" THEN
95.         SHELL _HIDE "DEL " + nm$
96.         GOTO saving2:
97.     END IF
98.     GOTO llloop:
99. END IF
100. saving2:
101. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
102. nm$ = ""
103. FOR snd = 100 TO 500 STEP 100
104.     SOUND snd, 2
105. NEXT snd
106. CLS
107. GOTO start:
108. SUB SaveImage (image AS LONG, filename AS STRING)
109.     bytesperpixel& = _PIXELSIZE(image&)
110.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
111.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
112.     x& = _WIDTH(image&)
113.     y& = _HEIGHT(image&)
114.     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)
115.     IF bytesperpixel& = 1 THEN
116.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
117.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
118.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
119.         NEXT
120.     END IF
121.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
122.     lastsource& = _SOURCE
123.     _SOURCE image&
124.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
125.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
126.         r$ = ""
127.         FOR px& = 0 TO x& - 1
128.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
129.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
130.         NEXT px&
131.         d$ = d$ + r$ + padder$
132.     NEXT py&
133.     _SOURCE lastsource&
134.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
135.     b$ = b$ + d$ ' total file data bytes to create file
136.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
137.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
138.     f& = FREEFILE
139.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
140.     OPEN filename$ + ext$ FOR BINARY AS #f&
141.     PUT #f&, , b$
142.     CLOSE #f&
143. END SUB
144.  

And here is the newer color shaded version:

Code: QB64: [Select]

1.     'Thank you to bplus and the QB64.org forum for the motivation and help!
2.     'This was made by Ken G. on Oct. 28, 2019.
3.     _TITLE "Space Bar Makes New Picture, Mouse For Text And Press Enter When Finished, (S)ave To BMP File, Esc to Quit."  
4.     SCREEN _NEWIMAGE(800, 600, 32)
5.     again:
6.     _LIMIT 500
7.     CLS
8.     bb = 50
9.     FOR sky = 0 TO 600
10.         bb = bb + .25
11.         LINE (0, sky)-(800, sky), _RGB32(75, 75, bb + 50)
12.     NEXT sky
13.     a$ = ""
14.     seconds = 45
15.     r = 127
16.     g = 100
17.     b = 127
18.     RANDOMIZE TIMER
19.     size = INT(RND * 100)
20.     RANDOMIZE TIMER
21.     amount = INT(RND * 25) + 5
22.     DO
23.         RANDOMIZE TIMER
24.         tt = RND * 90
25.         xx = RND * 800
26.         one:
27.         seconds = seconds + .25
28.         s = (60 - seconds) * 6 + (180 + tt)
29.         x = INT(SIN(s / (180 + tt) * 3.141592) * ((180 - t) + size)) + xx
30.         y = INT(COS(s / (180 + tt) * 3.141592) * ((180 - t) + size)) + 750
31.         CIRCLE (x, y), 4, _RGB32(r, g, b)
32.         PAINT (x, y), _RGB32(r, g, b)
33.         g = g + 1
34.         IF seconds = 75 THEN
35.             seconds = 45
36.             t = t + 1
37.             IF t = (180 + size) THEN
38.                 t = 0
39.                 GOTO more:
40.             END IF
41.             g = 100
42.             GOTO one:
43.         END IF
44.         GOTO one:
45.         more:
46.         RANDOMIZE TIMER
47.         size = INT(RND * 100)
48.         m = m + 1
49.         IF m = amount THEN EXIT DO
50.     LOOP
51.     m = 0
52.     DO
53.         _LIMIT 500
54.         a$ = INKEY$
55.         IF a$ = " " THEN GOTO again:
56.         IF a$ = CHR$(27) THEN END
57.         IF a$ = "s" OR a$ = "S" THEN GOTO saving:
58.         DO WHILE _MOUSEINPUT
59.             mouseX = _MOUSEX
60.             mouseY = _MOUSEY
61.             mouseLeftButton = _MOUSEBUTTON(1)
62.         LOOP
63.         IF mouseLeftButton = -1 THEN
64.             clr& = POINT(mouseX, mouseY)
65.             COLOR _RGB32(0, 0, 0), clr&
66.             LOCATE mouseY / 16, mouseX / 8
67.             INPUT "", txt$
68.         END IF
69.     LOOP
70.     saving:
71.     _LIMIT 500
72.     'Now we call up the SUB to save the image to BMP.
73.     SaveImage 0, "temp.bmp"
74.     _DELAY .25
75.     CLS
76.     LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
77.     COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
78.     PRINT "                               Saving"
79.     PRINT
80.     PRINT "                  Your BMP file will be saved in the"
81.     PRINT "                  same directory as this program is."
82.     PRINT "                  It can be used with almost any"
83.     PRINT "                  other graphics program or website."
84.     PRINT "                  It is saved using:"
85.     PRINT "                  width: 800  height: 600 pixels."
86.     PRINT
87.     PRINT "                  Type a name to save your picture"
88.     PRINT "                  and press the Enter key. Do not"
89.     PRINT "                  add .bmp at the end, the program"
90.     PRINT "                  will do it automatically."
91.     PRINT
92.     PRINT "                  Also do not use the name temp"
93.     PRINT "                  because the program uses that name"
94.     PRINT "                  and it would be erased the next time"
95.     PRINT "                  you save a picture."
96.     PRINT "                  Example: MyPic"
97.     PRINT "                  Quit and Enter key ends program."
98.     PRINT
99.     INPUT "         ->"; nm$
100.     IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
101.     nm$ = nm$ + ".bmp"
102.     'Checking to see if the file already exists on your computer.
103.     theFileExists = _FILEEXISTS(nm$)
104.     IF theFileExists = -1 THEN
105.         PRINT
106.         PRINT "             File Already Exists"
107.         PRINT "             Saving will delete your old"
108.         PRINT "             bmp picture."
109.         PRINT "             Would you like to still do it?"
110.         PRINT "             (Y/N)."
111.         PRINT "             Esc goes to start screen."
112.         llloop:
113.         _LIMIT 100
114.         ag2$ = INKEY$
115.         IF ag2$ = CHR$(27) THEN GOTO again:
116.         IF ag2$ = "" THEN GOTO llloop:
117.         IF ag2$ = "y" OR ag$ = "Y" THEN
118.             SHELL _HIDE "DEL " + nm$
119.             GOTO saving2:
120.         END IF
121.         GOTO llloop:
122.     END IF
123.     saving2:
124.     SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
125.     nm$ = ""
126.     FOR snd = 100 TO 500 STEP 100
127.         SOUND snd, 2
128.     NEXT snd
129.     CLS
130.     GOTO again:
131.     SUB SaveImage (image AS LONG, filename AS STRING)
132.         bytesperpixel& = _PIXELSIZE(image&)
133.         IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
134.         IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
135.         x& = _WIDTH(image&)
136.         y& = _HEIGHT(image&)
137.         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)
138.         IF bytesperpixel& = 1 THEN
139.             FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
140.                 cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
141.                 b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
142.             NEXT
143.         END IF
144.         MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
145.         lastsource& = _SOURCE
146.         _SOURCE image&
147.         IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
148.         FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
149.             r$ = ""
150.             FOR px& = 0 TO x& - 1
151.                 c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
152.                 IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
153.             NEXT px&
154.             d$ = d$ + r$ + padder$
155.         NEXT py&
156.         _SOURCE lastsource&
157.         MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
158.         b$ = b$ + d$ ' total file data bytes to create file
159.         MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
160.         IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
161.         f& = FREEFILE
162.         OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
163.         OPEN filename$ + ext$ FOR BINARY AS #f&
164.         PUT #f&, , b$
165.         CLOSE #f&
166.     END SUB
167.