Author Topic: Random Hills Generator  (Read 6603 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Random Hills Generator
« on: October 27, 2019, 09:21:55 pm »
This program will create between 1 and 25 different size and shaped hills and blue sky on the screen. You can keep pressing the Space Bar to create different ones. If you want to save any of the screens to your computer as a .bmp file, press S and it will go to the Save screen where you can name it anything you want. The commands are in the Title Bar. I made it so the hills have darkness in the center and as they expand out they lighten up with a brighter green. This program can be used with other graphics programs to add text for logos or any kind of picture you wish and/or rename it to a .jpg or any other type of graphic file. Enjoy :)

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Random Hills Generator
« Reply #1 on: October 27, 2019, 11:12:29 pm »
Love the colors, kind of cartoonist.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Random Hills Generator
« Reply #2 on: October 27, 2019, 11:27:09 pm »
Thanks :). Sure would be cool if I can figure out how to add an INPUT command anywhere on the screen someone clicks, like _PRINTSTRING can do. I guess I can try to calculate it as good as I can using LOCATE and the mouse. Does anyone know of an equation that converts graphic coordinates to LOCATE text coordinates? I'll Google it to see if there's something online. I just think it would be cool if someone can add text to this program to make logos or signs, etc.
Or I guess I could just add the INPUT above and then it uses PRINTSTRING To where the person clicks.
« Last Edit: October 27, 2019, 11:29:28 pm by SierraKen »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Random Hills Generator
« Reply #3 on: October 28, 2019, 12:31:06 am »
Thanks :). Sure would be cool if I can figure out how to add an INPUT command anywhere on the screen someone clicks, like _PRINTSTRING can do. I guess I can try to calculate it as good as I can using LOCATE and the mouse. Does anyone know of an equation that converts graphic coordinates to LOCATE text coordinates? I'll Google it to see if there's something online. I just think it would be cool if someone can add text to this program to make logos or signs, etc.
Or I guess I could just add the INPUT above and then it uses PRINTSTRING To where the person clicks.

Locate row, col : input "Is this where you want to put the prompt? "; yesno$

Try different value for row (vertical character cells) , col ( horizontal character cells)

So where they click _mouseY/16 = row, and _mouseX/8 = column.

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2.  
  3.     mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
  4.     IF mb THEN
  5.         LOCATE my / 16, mx / 8: INPUT "Is this where you want your INPUT prompts "; yes$
  6.  
  7.     END IF
« Last Edit: October 28, 2019, 12:38:45 am by bplus »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Random Hills Generator
« Reply #4 on: October 28, 2019, 12:34:50 am »
I added a way to add text to it with the mouse. At first I tried a different way using _PUTIMAGE so the screen would be 100% as you left it, but for some reason I couldn't figure it out again. So instead I just put a blue box around the INPUT text when you are done with it. The only problem with that is if you add text in that same location, it will be erased if you want more after that. Oh well, it's all for fun anyway. You can also type one word and then keep moving and clicking the mouse as much as you want in as many locations as you want for that same text. I also used the POINT command to use the same color as where you clicked as the background of the text. Like if click in the sky, it will make the background text blue. If you clicked the same word(s) on the hills, it will use that certain shade of green. It's standard small text but it's OK with me.

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

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Random Hills Generator
« Reply #5 on: October 28, 2019, 12:42:23 am »
Sorry Bplus, I just added that new version a few seconds after you tried to help me. I kind of like it this way so people can quickly click with the mouse as many times as they want for the same text. But I guess your way would fix that problem I have with not having to delete anything. I will see what I can do.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Random Hills Generator
« Reply #6 on: October 28, 2019, 12:44:20 am »
yeah looked good to me.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Random Hills Generator
« Reply #7 on: October 28, 2019, 12:53:29 am »
I liked your way better. This time no text is erased at all. I didn't add any of your text though, just using the LOCATE conversion math with INPUT worked perfectly. Thank you!

Here is that certain area I changed:

Code: QB64: [Select]
  1.     a$ = INKEY$
  2.     IF a$ = CHR$(27) THEN END
  3.     IF a$ = " " THEN GOTO start:
  4.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  5.         mouseX = _MOUSEX
  6.         mouseY = _MOUSEY
  7.         mouseLeftButton = _MOUSEBUTTON(1)
  8.     LOOP
  9.     IF mouseLeftButton = -1 THEN
  10.         clr& = POINT(mouseX, mouseY)
  11.         COLOR _RGB32(0, 0, 0), clr&
  12.         LOCATE mouseY / 16, mouseX / 8
  13.         INPUT "", txt$
  14.     END IF
  15.  

« Last Edit: October 28, 2019, 01:05:02 am by SierraKen »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Random Hills Generator
« Reply #8 on: October 28, 2019, 01:06:13 am »
Here is the whole program. I had to fix the Saving screen to get the right color again hehe.
I also added my name and date in the top comments and a thank you to bplus and this forum for the help.

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Random Hills Generator
« Reply #9 on: October 28, 2019, 01:08:51 am »
Those hills....

I am thinking some sort of golfing game? Maybe it's getting late ;-))

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Random Hills Generator
« Reply #10 on: October 28, 2019, 12:15:52 pm »
LOL yeah I'm thinking about trying it a different way to make the hills.

Offline Qwerkey

  • Forum Resident
  • Posts: 755
    • View Profile
Re: Random Hills Generator
« Reply #11 on: October 28, 2019, 02:55:45 pm »
Very nice.  If you had added an audio track, some wag who likes wordplay could have commented "The Hills are Alive with the Sound of Music" and we could all have pictured Julie Andrews in Alpine garb.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Random Hills Generator
« Reply #12 on: October 28, 2019, 05:50:22 pm »
LOL cool Qwerky.

Well, I completely re-wrote the program to make it more realistic looking. I went back to the old SIN and COS again to add shades of green on the sides of the hills.
The only thing I couldn't figure out is how to change the shape of the hills like I had before. I tried to add numbers to every line but I'm not sure if that itself would do the job, it might need completely different equations that I don't know of. But anyway, this is what I have so far. With this version you can't save the picture yet since I'm not finished with it. But I thought you all would like to see it. Keep pressing the Space Bar to make new random renditions.

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2. again:
  3. PAINT (2, 2), _RGB32(128, 194, 255)
  4. a$ = ""
  5. seconds = 45
  6. r = 127
  7. g = 100
  8. b = 127
  9. size = INT(RND * 100)
  10. amount = INT(RND * 25) + 5
  11.     tt = RND * 90
  12.     xx = RND * 800
  13.     one:
  14.     seconds = seconds + .25
  15.     s = (60 - seconds) * 6 + (180 + tt)
  16.     x = INT(SIN(s / (180 + tt) * 3.141592) * ((180 - t) + size)) + xx
  17.     y = INT(COS(s / (180 + tt) * 3.141592) * ((180 - t) + size)) + 750
  18.     CIRCLE (x, y), 4, _RGB32(r, g, b)
  19.     PAINT (x, y), _RGB32(r, g, b)
  20.     g = g + 1
  21.     IF seconds = 75 THEN
  22.         seconds = 45
  23.         t = t + 1
  24.         IF t = (180 + size) THEN
  25.             t = 0
  26.             GOTO more:
  27.         END IF
  28.         g = 100
  29.         GOTO one:
  30.     END IF
  31.     GOTO one:
  32.     more:
  33.     size = INT(RND * 100)
  34.     m = m + 1
  35.     IF m = amount THEN EXIT DO
  36. m = 0
  37.     a$ = INKEY$
  38.     IF a$ = " " THEN GOTO again:
  39.     IF a$ = CHR$(27) THEN END
  40.  
« Last Edit: October 28, 2019, 05:51:49 pm by SierraKen »

Marked as best answer by SierraKen on October 28, 2019, 03:42:14 pm

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Random Hills Generator
« Reply #13 on: October 28, 2019, 07:35:32 pm »
OK I added a sky that gets darker as you look higher and added the Text and Save features again. I think I'm about done, unless someone can figure out an equation to change the shape of the hills, but I'm not worried about it. Again, I don't use the CIRCLE command for these hills, I use SIN and COS in order for the shades of green to change on the sides. This program is just a tool to add more graphics to with another graphics program mostly. Or you can just enjoy the scenes. :)

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Random Hills Generator
« Reply #14 on: October 28, 2019, 07:54:07 pm »
Nice shading of sky and hills but I miss the green.