Author Topic: Random Hills Generator  (Read 6600 times)

0 Members and 1 Guest are viewing this topic.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Random Hills Generator
« Reply #15 on: October 28, 2019, 08:18:17 pm »
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. :)
« Last Edit: October 28, 2019, 08:22:35 pm by SierraKen »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Random Hills Generator
« Reply #16 on: October 28, 2019, 08:20:05 pm »
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. 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.  

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