Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SierraKen on December 15, 2019, 10:23:57 pm

Title: A Different Galaxy Maker
Post by: SierraKen on December 15, 2019, 10:23:57 pm
Sir Crow made a Galaxy Generator back in September which inspired me to make my own today. His is still better in my opinion, but mine is just different. Mine also makes a spiral galaxy but they are made at random angles and random stars. I also added a way to save it at any time (even during the making of it) to a .bmp file. One thing I learned about the code I've been using to make .bmp pictures is that since I use the REN command to rename temp.bmp, your picture file cannot have spaces. I tried to change the nm$ to delete all the spaces between the characters but I couldn't figure it out. I know there's a way to remove the spaces before and after characters in a string, but I'm not sure about in between. You might want to put this one in its own directory so the pictures can easily be found. I might just remove the REN command and the temp.bmp code and put the picture in its own string and put it back on the screen after you read the Save screen and give it a name. Then it can go back on the screen and save it under just the name you want. I'll look into that, but for now, here is the working version.

If you want to see Sir Crow's version, you can see it on this post:
https://www.qb64.org/forum/index.php?topic=1684.msg109277#msg109277 (https://www.qb64.org/forum/index.php?topic=1684.msg109277#msg109277)

Here is mine:

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2. start:
  4. c1 = 50: c2 = 10: c3 = 50
  6. s = RND * 10000
  8.     _LIMIT 500
  10.     clr = INT(RND * 300) + 1
  11.     IF clr = 1 THEN c1 = c1 + 25
  12.     IF c1 > 255 THEN c1 = 50
  13.     IF clr = 2 THEN c3 = c3 + 50
  14.     IF c3 > 255 THEN c3 = 0
  15.     IF clr > 298 THEN c3 = c1: c2 = c1
  16.     IF c3 > 255 THEN c3 = 5
  17.  
  19.     st = (RND * 5) + 1
  20.     dd = (RND * 300) - 300
  21.     dd2 = (RND * 300) - 300
  22.     IF dd2 < dd THEN st = -st
  23.     FOR d = dd TO dd2 STEP st
  24.         s = s + st
  25.         x = COS(s * 3.141592 / 180) * d
  26.         y = SIN(s * 3.151492 / 180) * d
  27.         PSET (x + 400, y + 300), _RGB32(c1, c2, c3)
  28.     NEXT d
  29.     IF c > 255 THEN c = 50
  30.     a$ = INKEY$
  31.     IF a$ = " " THEN GOTO start:
  32.     IF a$ = CHR$(27) THEN END
  33.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  34.     p = p + .02
  35.     pe = INT(p)
  36.     p$ = STR$(pe)
  37.     _TITLE "Percent Full: " + p$ + "   Press S to save as .bmp file anytime or Space Bar for new one."
  38.     IF p > 100 THEN p = 0: GOSUB more:
  40. more:
  41. _TITLE "Press Space Bar to make a new one or Press S to save as .bmp file."
  42. again:
  43. ag$ = INKEY$
  44. IF ag$ = " " THEN GOTO start:
  45. IF ag$ = "s" OR ag$ = "S" THEN GOTO saving:
  46. GOTO again:
  47. '---------------------------------------------------------------------------
  48. saving:
  49. 'Saving
  50. 'This section first saves your picture as temp.bmp and then
  51. 'asks you a name for your picture and then renames temp.bmp to your name.
  52. _TITLE "Saving Picture"
  53. 'Now we call up the SUB to save the image to BMP.
  54. SaveImage 0, "temp.bmp"
  55. _DELAY .25
  57. PRINT "                                  Saving"
  59. PRINT "                     Your bmp file will be saved in the"
  60. PRINT "                     same directory as this program is."
  61. PRINT "                     It can be used with almost any"
  62. PRINT "                     other graphics program or website."
  63. PRINT "                     It is saved using:"
  64. PRINT "                     width: 800  height: 600 pixels."
  66. PRINT "                     Type a name to save your picture"
  67. PRINT "                     and press the Enter key. Do not"
  68. PRINT "                     add .bmp at the end, the program"
  69. PRINT "                     will do it automatically."
  71. PRINT "                     Also do not add spaces to your name."
  72. PRINT "                     If you accidentally add a space, your"
  73. PRINT "                     file will be called temp.bmp. You must"
  74. PRINT "                     rename that in Windows or it will be lost"
  75. PRINT "                     next time you save a galaxy picture."
  77. PRINT "                     Also do not use the name temp"
  78. PRINT "                     because the program uses that name"
  79. PRINT "                     and it would be erased the next time"
  80. PRINT "                     you save a picture."
  81. PRINT "                     Example: MyPic"
  82. PRINT "                     Quit and Enter key ends program."
  84. INPUT "                     ->"; nm$
  85.  
  86.  
  87. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
  88. nm$ = nm$ + ".bmp"
  89. 'Checking to see if the file already exists on your computer.
  90. theFileExists = _FILEEXISTS(nm$)
  91. IF theFileExists = -1 THEN
  92.     PRINT
  93.     PRINT "                File Already Exists"
  94.     PRINT "                Saving will delete your old"
  95.     PRINT "                bmp picture."
  96.     PRINT "                Would you like to still do it?"
  97.     PRINT "                (Y/N)."
  98.     PRINT "               Esc goes to start screen."
  99.     llloop:
  100.     _LIMIT 500
  101.     ag2$ = INKEY$
  102.     IF ag2$ = CHR$(27) THEN GOTO start:
  103.     IF ag2$ = "" THEN GOTO llloop:
  104.     IF ag2$ = "y" OR ag$ = "Y" THEN
  105.         SHELL _HIDE "DEL " + nm$
  106.         GOTO saving2:
  107.     END IF
  108.     GOTO llloop:
  110. saving2:
  111. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
  112. FOR snd = 100 TO 700 STEP 100
  113.     SOUND snd, 2
  114. NEXT snd
  115. nm$ = ""
  117. GOTO start:
  118.  
  119.  
  120. 'This section saves the .bmp picture file.
  121. SUB SaveImage (image AS LONG, filename AS STRING)
  122.     bytesperpixel& = _PIXELSIZE(image&)
  123.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  124.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  125.     x& = _WIDTH(image&)
  126.     y& = _HEIGHT(image&)
  127.     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)
  128.     IF bytesperpixel& = 1 THEN
  129.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  130.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  131.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  132.         NEXT
  133.     END IF
  134.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  135.     lastsource& = _SOURCE
  136.     _SOURCE image&
  137.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  138.     FOR py& = y& - 1 TO 0 STEP -1 ' read image pixel color data
  139.         r$ = ""
  140.         FOR px& = 0 TO x& - 1
  141.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  142.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  143.         NEXT px&
  144.         d$ = d$ + r$ + padder$
  145.     NEXT py&
  146.     _SOURCE lastsource&
  147.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  148.     b$ = b$ + d$ ' total file data bytes to create file
  149.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  150.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  151.     f& = FREEFILE
  152.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  153.     OPEN filename$ + ext$ FOR BINARY AS #f&
  154.     PUT #f&, , b$
  155.     CLOSE #f&
  157.  
Title: Re: A Different Galaxy Maker
Post by: Qbee on December 15, 2019, 10:50:34 pm
Works fine, @SierraKen !
With GIMP I can set the backgroundcolor to transparent and stretch the image as needed.
Thanks for sharing.
Title: Re: A Different Galaxy Maker
Post by: bplus on December 15, 2019, 11:05:25 pm
Quote
I tried to change the nm$ to delete all the spaces between the characters but I couldn't figure it out.

Here is a function that will strip outside spaces from a string and replace all inner spaces with an "_" which is what might be better for filenames that can't have spaces.
Code: QB64: [Select]
  2.     INPUT "Enter a test string with spaces (just enter to quit) "; test$
  3.     PRINT "fillSpace changed '"; test$; "' to '"; fillSpace$(test$); "'."
  4.     PRINT
  5. LOOP UNTIL test$ = ""
  6.  
  7. FUNCTION fillSpace$ (s$)
  8.     test$ = _TRIM$(s$)
  9.     IF test$ = "" THEN
  10.         fillSpace$ = "_"
  11.     ELSE
  12.         FOR i = 1 TO LEN(test$)
  13.             IF MID$(test$, i, 1) = " " THEN b$ = b$ + "_" ELSE b$ = b$ + MID$(test$, i, 1)
  14.         NEXT
  15.         fillSpace$ = b$
  16.     END IF
  18.  
Title: Re: A Different Galaxy Maker
Post by: SierraKen on December 15, 2019, 11:08:52 pm
Thanks QBee... well I just made an even better one...
I actually figured out how to save a .bmp picture without first making a temp.bmp! And just like I said, I used the _PUTIMAGE command to place the picture back to the screen after the Save info screen. Then it saves the screen as the .bmp in your choice of names (EVEN with spaces!) and without having to save any temp file. I've been wanting to do this for months. I know you guys told me how to do it a long time ago, but I never really pushed myself until tonight.

Code: QB64: [Select]
  1. start:
  3. galaxy& = _NEWIMAGE(800, 600, 32)
  4. SCREEN galaxy&
  5. _DEST galaxy&
  6. _SOURCE galaxy&
  7. c1 = 50: c2 = 10: c3 = 50
  9. s = RND * 10000
  11.     _LIMIT 500
  13.     clr = INT(RND * 300) + 1
  14.     IF clr = 1 THEN c1 = c1 + 25
  15.     IF c1 > 255 THEN c1 = 50
  16.     IF clr = 2 THEN c3 = c3 + 50
  17.     IF c3 > 255 THEN c3 = 0
  18.     IF clr > 298 THEN c3 = c1: c2 = c1
  19.     IF c3 > 255 THEN c3 = 5
  20.  
  22.     st = (RND * 5) + 1
  23.     dd = (RND * 300) - 300
  24.     dd2 = (RND * 300) - 300
  25.     IF dd2 < dd THEN st = -st
  26.     FOR d = dd TO dd2 STEP st
  27.         s = s + st
  28.         x = COS(s * 3.141592 / 180) * d
  29.         y = SIN(s * 3.151492 / 180) * d
  30.         PSET (x + 400, y + 300), _RGB32(c1, c2, c3)
  31.     NEXT d
  32.     IF c > 255 THEN c = 50
  33.     a$ = INKEY$
  34.     IF a$ = " " THEN GOTO start:
  35.     IF a$ = CHR$(27) THEN END
  36.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  37.     p = p + .02
  38.     pe = INT(p)
  39.     p$ = STR$(pe)
  40.     _TITLE "Percent Full: " + p$ + "   Press S to save as .bmp file anytime or Space Bar for new one."
  41.     IF p > 100 THEN p = 0: GOSUB more:
  43. more:
  44. _TITLE "Press Space Bar to make a new one or Press S to save as .bmp file."
  45. again:
  46. ag$ = INKEY$
  47. IF ag$ = " " THEN GOTO start:
  48. IF ag$ = "s" OR ag$ = "S" THEN GOTO saving:
  49. GOTO again:
  50. '---------------------------------------------------------------------------
  51. saving:
  52. galaxy2& = _COPYIMAGE(galaxy&)
  53.  
  54. 'Saving
  55. _TITLE "Saving Picture"
  56. _DELAY .25
  58. PRINT "                                  Saving"
  60. PRINT "                     Your bmp file will be saved in the"
  61. PRINT "                     same directory as this program is."
  62. PRINT "                     It can be used with almost any"
  63. PRINT "                     other graphics program or website."
  64. PRINT "                     It is saved using:"
  65. PRINT "                     width: 800  height: 600 pixels."
  67. PRINT "                     Type a name to save your picture"
  68. PRINT "                     and press the Enter key. Do not"
  69. PRINT "                     add .bmp at the end, the program"
  70. PRINT "                     will do it automatically."
  72. PRINT "                     Example: MyPic"
  73. PRINT "                     Quit and Enter key ends program."
  75. INPUT "                     ->"; nm$
  76. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
  77. nm$ = nm$ + ".bmp"
  78. 'Checking to see if the file already exists on your computer.
  79. theFileExists = _FILEEXISTS(nm$)
  80. IF theFileExists = -1 THEN
  81.     PRINT
  82.     PRINT "                File Already Exists"
  83.     PRINT "                Saving will delete your old"
  84.     PRINT "                bmp picture."
  85.     PRINT "                Would you like to still do it?"
  86.     PRINT "                (Y/N)."
  87.     PRINT "               Esc goes to start screen."
  88.     llloop:
  89.     _LIMIT 500
  90.     ag2$ = INKEY$
  91.     IF ag2$ = CHR$(27) THEN GOTO start:
  92.     IF ag2$ = "" THEN GOTO llloop:
  93.     IF ag2$ = "y" OR ag$ = "Y" THEN
  94.         SHELL _HIDE "DEL " + nm$
  95.         GOTO saving2:
  96.     END IF
  97.     GOTO llloop:
  99. saving2:
  101. SCREEN galaxy2&
  102. SaveImage 0, nm$
  103. FOR snd = 100 TO 800 STEP 50
  104.     SOUND snd, 1
  105. NEXT snd
  106. nm$ = ""
  107. galaxy& = 0
  108. galaxy2& = 0
  109. GOTO start:
  110.  
  111.  
  112. 'This section saves the .bmp picture file.
  113. SUB SaveImage (image AS LONG, filename AS STRING)
  114.     bytesperpixel& = _PIXELSIZE(image&)
  115.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  116.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  117.     x& = _WIDTH(image&)
  118.     y& = _HEIGHT(image&)
  119.     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)
  120.     IF bytesperpixel& = 1 THEN
  121.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  122.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  123.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  124.         NEXT
  125.     END IF
  126.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  127.     lastsource& = _SOURCE
  128.     _SOURCE image&
  129.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  130.     FOR py& = y& - 1 TO 0 STEP -1 ' read image pixel color data
  131.         r$ = ""
  132.         FOR px& = 0 TO x& - 1
  133.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  134.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  135.         NEXT px&
  136.         d$ = d$ + r$ + padder$
  137.     NEXT py&
  138.     _SOURCE lastsource&
  139.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  140.     b$ = b$ + d$ ' total file data bytes to create file
  141.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  142.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  143.     f& = FREEFILE
  144.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  145.     OPEN filename$ + ext$ FOR BINARY AS #f&
  146.     PUT #f&, , b$
  147.     CLOSE #f&
  149.  

Title: Re: A Different Galaxy Maker
Post by: SierraKen on December 15, 2019, 11:10:53 pm
Thanks B+, but it wasn't needed this time. I'll keep your code though in case I need it down the way. You can read why I didn't need it anymore above.
Text Only | Text with Attachments