« previous next »
Pages: [1] 2   Go Down

Author Topic: Program drops when putting an image in another image  (Read 5461 times)

0 Members and 1 Guest are viewing this topic.

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Program drops when putting an image in another image
« on: August 05, 2019, 08:16:25 am »
I've been writing an ap to generate star systems to import to my project at:

https://www.qb64.org/forum/index.php?topic=1429.0

It accepts stellar data input, or rolls "dice" to determine it randomly. Then it constructs a system with some number of orbits around however many stars it contains. Then it displays a graphic representation of that system and queries for the presence, number and placement of gas giant planets. TAB or right arrow cycles through the available orbits represented by boxes that are colored according to their orbital zones (inner red, habitable green & outer blue; with grey being otherwise unavailable). ENTER commits a gas giant to the highlighted orbit, at which point a name for the GG is input and the process goes on to the next GG. The previous placement is colored grey and assigned the number of the body inserted.

Sorry for the crpytic user interface, it's a work in progress.

Works well, but I wanted to show the original color of the orbit so the idea was to copy the image and put a smaller version of the previous color in the occupied orbit.

I'm very new at graphics programming, and it's easily possible that I'm missing something essential, but....

The issue is:
When I put an image into another image, the program is dropped completely. No error messages, it just vanishes within about a second or so of displaying the new image. Which it does do briefly. It's in a  do loop, so I thought maybe it's loading up with images, but I've never been able to get _FREEIMAGE to do anything other than throw errors at me, so obviously I have no understanding of how to use that one...perhaps it's just a matter of putting it in the right spot.

The difference between a working program and a dropped one seems to be associated with lines 362 & 364 in SUB GasGiants. I've commented them out so that an initial running of the program works.

Is there a limit to nested _PUTIMAGEs? Am I committing an obvious coding gaff? or is there a bug in the IDE, I'm using 1.3 96937f0

Code: QB64: [Select]
  1. 'System Buider 0.1
  2. 'companion utility to CT-Vector
  3. 'primary reference shall be DGP's WBH
  4.  
  5. '                                                               MAIN MODULE
  7.  
  8. TYPE unitpoint '                                                relative unit placement
  9.     pX AS _INTEGER64
  10.     pY AS _INTEGER64
  11.     pZ AS _INTEGER64
  13.  
  14. TYPE body '                                                     Celestial bodies
  15.     nam AS STRING * 20 '                                        Name
  16.     parnt AS STRING * 20 '                                      name of parent body
  17.     radi AS _INTEGER64 '                                        Size (needs _INTEGER64 in event of large star)
  18.     orad AS _INTEGER64 '                                        Orbital radius
  19.     oprd AS SINGLE '                                            Orbital period (years)
  20.     rota AS SINGLE '                                            Rotational period (days)
  21.     dens AS SINGLE '                                            Density, basis for grav(Gs) calculation
  22.     rank AS _BYTE '                                             1=primary, 2=planet/companion, 3=satelite
  23.     star AS _BYTE '                                             -1=star  0=non-stellar body
  24.     class AS STRING * 2 '                                       Two digit code, use for stellar class, GG, etc.
  25.     siz AS STRING * 3 '                                         three digit code, use for stellar size,
  26.     maxor AS _BYTE '                                            Maximum orbits for body
  27.     ps AS unitpoint '                                           coordinate position
  29.  
  30. TYPE layer
  31.     class AS INTEGER '                                          orbit class <3 no not use orbit
  32.     orad AS _INTEGER64 '                                        radius from rank parent
  33.     oprd AS SINGLE '                                            Orbital period (years)
  34.     pin AS INTEGER '                                            body occupant identifier
  35.     rank AS INTEGER '                                           TBD
  36.     prsnt AS INTEGER '                                          is orbit present? -1 true
  38.  
  39. TYPE roll
  40.     c AS _BYTE '                                                class DM
  41.     s AS _BYTE '                                                size DM
  43.  
  44. '                                                               VARIABLE DECLARATIONS
  45. DIM SHARED clr&(0 TO 15) '                                      32 bit equivalent of SCREEN 0 colors
  46. DIM SHARED MWin AS _BYTE '                                      Main world entered? -1 true
  47. DIM SHARED sysnat AS _BYTE '                                    1 = solo, 2 = binary, 3 = trinary
  48. DIM SHARED starroll(4) AS roll '                                memorize star class and size DMs
  49. DIM SHARED heavens(100) AS body '                                planet data array
  50. DIM SHARED orbit(21, 5) AS layer '                                 Main system orbit shells
  51. DIM SHARED orbs AS INTEGER '                                    number of stellar & planetary bodies present
  52. 'DIM SHARED in AS INTEGER '                                      planetary index
  53. 'DIM SHARED orbitclass AS INTEGER '                              0 thru 6: interior,vaporized,inner,habitable,outer,too far
  54. DIM SHARED main& '                                              main screen handle
  55. DIM SHARED starin& '                                            stellar details screen handle
  56. DIM SHARED chkbx& '                                             check box
  57. DIM SHARED plcmnt& '                                            planet placement screen
  58.  
  59. CONST AUtokm = 149668990
  60. CONST Solrad = 695700
  61.  
  62. '                                                               DEFINE SCREEN IMAGES
  63. main& = _NEWIMAGE(1200, 688, 32) '                              main screen image 1200 x 600 32bit color
  64. starin& = _NEWIMAGE(640, 688, 32) '                             stellar details screen 80x48 text
  65. chkbx& = _NEWIMAGE(24, 24, 32)
  66. plcmnt& = _NEWIMAGE(1200, 464, 32) '                            150x29
  67. 'plcmnt& = _LOADIMAGE("jup.jpg", 32)
  68.  
  69. SCREEN main& '                                                  Initiate main screen
  71. _TITLE "System Builder 0.1"
  72. _SCREENMOVE (_DESKTOPWIDTH - 1200) / 2, 1
  73.  
  74.  
  75. SetEnviron
  76. RefreshPrompt
  78.  
  79. '                                                               DATA SECTION
  80. colors:
  81. '                                                               colors 0-4
  82. DATA 0,0,0,0,0,168,0,168,0,0,168,168,168,0,0
  83. '                                                               colors 5-9
  84. DATA 168,0,168,168,84,0,168,168,168,84,84,84,84,84,252
  85. '                                                               colors 10-14
  86. DATA 84,252,84,84,252,252,252,84,84,252,84,252,252,252,84
  87. '                                                               color 15
  88. DATA 252,252,252
  89.  
  90. stellar_details:
  91. 'Steller data & orbit zones tables
  92. 'Orbit Class: Size, Type, Mass(in solar masses), Radius(in solar radii), 1=interior, 2=vaporized, 3=inner, 4=habitable, 5=outer, 6=too far
  93. DATA "Ia","B0",60,52,1,2,2,2,2,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,6
  94. DATA "Ia","B5",30,75,1,2,2,2,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  95. DATA "Ia","A0",18,135,1,1,2,2,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  96. DATA "Ia","A5",15,149,1,1,2,2,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  97. DATA "Ia","F0",13,174,1,1,1,2,2,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  98. DATA "Ia","F5",12,204,1,1,1,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,6
  99. DATA "Ia","G0",12,298,1,1,1,1,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  100. DATA "Ia","G5",13,454,1,1,1,1,1,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  101. DATA "Ia","K0",14,654,1,1,1,1,1,1,2,3,3,3,3,3,4,5,5,5,5,5,5,6
  102. DATA "Ia","K5",18,1010,1,1,1,1,1,1,2,3,3,3,3,3,4,5,5,5,5,5,5,6
  103. DATA "Ia","M0",20,1467,1,1,1,1,1,1,1,3,3,3,3,3,4,5,5,5,5,6
  104. DATA "Ia","M5",25,3020,1,1,1,1,1,1,1,1,3,3,3,3,4,5,5,5,5,6
  105. DATA "Ia","M9",30,3499,1,1,1,1,1,1,1,1,3,3,3,3,4,5,5,5,5,6
  106. DATA "Ib","B0",50,30,1,2,2,2,2,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,6
  107. DATA "Ib","B5",25,35,1,2,2,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,6
  108. DATA "Ib","A0",16,50,1,2,2,2,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,6
  109. DATA "Ib","A5",13,55,1,2,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,6
  110. DATA "Ib","F0",12,59,1,2,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,6
  111. DATA "Ib","F5",10,60,1,2,2,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,6
  112. DATA "Ib","G0",10,84,1,2,2,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,6
  113. DATA "Ib","G5",12,128,1,1,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,6
  114. DATA "Ib","K0",13,216,1,1,1,1,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  115. DATA "Ib","K5",16,392,1,1,1,1,1,2,3,3,3,3,3,5,5,5,5,5,5,5,5,6
  116. DATA "Ib","M0",16,857,1,1,1,1,1,1,3,3,3,3,3,5,5,5,5,5,5,6
  117. DATA "Ib","M5",20,2073,1,1,1,1,1,1,1,3,3,3,3,4,4,5,5,5,5,6
  118. DATA "Ib","M9",25,2876,1,1,1,1,1,1,1,1,3,3,3,4,4,5,5,5,5,6
  119. DATA "II","B0",30,22,1,2,2,2,2,2,2,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  120. DATA "II","B5",20,20,1,2,2,2,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,6
  121. DATA "II","A0",14,18,1,2,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,5,6
  122. DATA "II","A5",11,14,1,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,5,5,6
  123. DATA "II","F0",10,16,1,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,5,5,6
  124. DATA "II","F5",8.1,18,1,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,5,5,6
  125. DATA "II","G0",8.1,25,1,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,5,5,6
  126. DATA "II","G5",10,37,1,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,5,5,6
  127. DATA "II","K0",11,54,1,2,3,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,6
  128. DATA "II","K5",14,124,1,1,2,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,6
  129. DATA "II","M0",14,237,1,1,1,1,3,3,3,3,3,3,4,5,5,5,5,5,5,6
  130. DATA "II","M5",16,712,1,1,1,1,1,1,3,3,3,3,3,4,5,5,5,5,5,6
  131. DATA "II","M9",18,931,1,1,1,1,1,1,3,3,3,3,3,4,5,5,5,5,5,6
  132. DATA "III","B0",25,16,1,2,2,2,2,2,2,3,3,3,3,3,4,5,5,5,5,6
  133. DATA "III","B5",15,10,1,2,2,2,3,3,3,3,3,3,4,5,5,5,5,5,5,6
  134. DATA "III","A0",12,6.2,1,3,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  135. DATA "III","A5",9,4.6,1,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,6
  136. DATA "III","F0",8,4.7,1,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,6
  137. DATA "III","F5",5,5.2,1,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,6
  138. DATA "III","G0",2.5,7.1,1,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,5,6
  139. DATA "III","G5",3.2,11,1,3,3,3,3,3,3,4,5,5,5,5,5,5,5,5,5,6
  140. DATA "III","K0",4,16,1,3,3,3,3,3,3,4,5,5,5,5,5,5,5,6
  141. DATA "III","K5",5,42,1,3,3,3,3,3,3,3,4,5,5,5,5,5,5,6
  142. DATA "III","M0",6.3,63,1,2,3,3,3,3,3,3,4,5,5,5,5,6
  143. DATA "III","M5",7.4,228,1,1,1,1,3,3,3,3,3,4,5,5,5,6
  144. DATA "III","M9",9.2,360,1,1,1,1,1,3,3,3,3,4,5,5,5,6
  145. DATA "IV","B0",20,13,2,2,2,2,2,2,2,3,3,3,3,3,4,5,6
  146. DATA "IV","B5",10,5.3,2,2,2,3,3,3,3,3,3,4,5,5,5,5,6
  147. DATA "IV","A0",6,4.5,2,3,3,3,3,3,3,4,5,5,5,5,5,5,6
  148. DATA "IV","A5",4,2.7,3,3,3,3,3,3,4,5,5,5,5,5,5,5,6
  149. DATA "IV","F0",2.5,2.7,3,3,3,3,3,3,4,5,5,5,5,5,5,5,6
  150. DATA "IV","F5",2,2.6,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  151. DATA "IV","G0",1.75,2.5,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  152. DATA "IV","G5",2,2.8,3,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  153. DATA "IV","K0",2.3,3.3,3,3,3,3,4,5,5,5,5,5,5,6
  154. DATA "V","B0",18,10,2,2,2,2,2,2,3,3,3,3,3,3,4,6
  155. DATA "V","B5",6.5,4.4,2,2,2,2,3,3,3,3,3,4,5,5,5,6
  156. DATA "V","A0",3.2,3.2,3,3,3,3,3,3,3,4,5,5,5,5,5,6
  157. DATA "V","A5",2.1,1.8,3,3,3,3,3,3,4,5,5,5,5,5,5,6
  158. DATA "V","F0",1.7,1.7,3,3,3,3,3,4,5,5,5,5,5,5,5,6
  159. DATA "V","F5",1.3,1.4,3,3,3,3,4,5,5,5,5,5,5,5,5,6
  160. DATA "V","G0",1.04,1.03,3,3,3,4,5,5,5,5,5,5,5,5,5,6
  161. DATA "V","G5",0.94,0.91,3,3,4,5,5,5,5,5,5,5,5,5,5,6
  162. DATA "V","K0",0.825,0.908,3,3,4,5,5,5,5,5,5,5,5,6
  163. DATA "V","K5",0.57,0.566,4,5,5,5,5,5,5,5,5,5,5,6
  164. DATA "V","M0",0.489,0.549,4,5,5,5,5,5,5,5,5,6
  165. DATA "V","M5",0.331,0.358,5,5,5,5,5,5,5,5,5,6
  166. DATA "V","M9",0.215,0.201,5,5,5,5,5,5,5,5,5,6
  167. DATA "VI","F5",0.8,1.14,3,3,3,4,5,6
  168. DATA "VI","G0",0.6,1.02,3,3,4,5,5,6
  169. DATA "VI","G5",0.528,0.55,3,4,5,5,5,6
  170. DATA "VI","K0",0.430,0.4,3,4,5,5,5,6
  171. DATA "VI","K5",0.33,0.308,5,5,5,5,5,6
  172. DATA "VI","M0",0.154,0.256,5,5,5,5,5,6
  173. DATA "VI","M5",0.104,0.104,5,5,5,5,5,6
  174. DATA "VI","M9",0.058,0.053,5,5,5,5,5,6
  175. DATA "D","B0",0.26,0.018,4,5,5,5,6
  176. DATA "D","A0",0.36,0.017,5,5,5,5,6
  177. DATA "D","F0",0.42,0.013,5,5,5,5,6
  178. DATA "D","G0",0.63,0.012,5,5,5,5,6
  179. DATA "D","K0",0.83,0.009,5,5,5,5,6
  180. DATA "D","M0",1.11,0.006,5,5,5,5,6
  181.  
  182. Orbits:
  183. 'Orbit radii in AU
  184. DATA 0.2,0.4,0.7,1,1.6,2.8,5.2,10,19.6,38.8,77.2
  185. DATA 154,307.6,614.8,1229.2,2458,4915.6,9830.8,19661.2,39322
  186.  
  187. '                                                               END DATA SECTION
  188. '                                                               END MAIN MODULE
  189.  
  190. SUB AvailableOrbit (var AS INTEGER)
  191.  
  192.     DIM x%
  193.     FOR x% = 0 TO heavens(var).maxor
  194.         SELECT CASE orbit(x%, var).class
  195.             CASE 1: orbit(x%, var).prsnt = 0
  196.             CASE 2 TO 5: orbit(x%, var).prsnt = -1
  197.             CASE 6: orbit(x%, var).prsnt = 0: EXIT FOR '        <<< subtract 1 from heavens(var).maxor or set to x% ???
  198.         END SELECT
  199.     NEXT x%
  200.     IF x% < 21 THEN
  201.         DO
  202.             orbit(x%, var).prsnt = 0
  203.             x% = x% + 1
  204.         LOOP UNTIL x% = 21
  205.     END IF
  206.  
  207. END SUB 'AvailableOrbit%
  208.  
  209.  
  210. FUNCTION Choose% (query AS STRING, choice AS STRING)
  211.  
  212.     DIM ch%
  213.     PRINT query
  214.     DO
  215.         ch% = INSTR(choice, UCASE$(INKEY$))
  216.         _LIMIT 50
  217.     LOOP UNTIL ch% <> 0
  218.     Choose% = ch%
  219.  
  220. END FUNCTION 'Choose
  221.  
  222.  
  223. FUNCTION DiceRoll% (quan AS INTEGER, dice AS INTEGER, plus AS INTEGER)
  224.  
  225.     'Rolls any number of dice of any number of sides and adds modifiers
  226.     'syntax usage: DiceRoll% (number of dice rolled, number of sides, any modifier)
  227.  
  228.     DIM t%, x%
  230.     t% = plus '                                                 add modifier
  231.     FOR x% = 1 TO quan '                                        roll die <quan>tity of times
  232.         t% = t% + INT(RND * dice) + 1 '                         total up results
  233.     NEXT x%
  234.     DiceRoll% = t%
  235.  
  236. END FUNCTION 'DiceRoll%
  237.  
  238.  
  239. FUNCTION FindParent (var AS INTEGER)
  240.  
  241.     'Accepts a planetary body index (var) and finds the index of its parent body
  242.     DIM x%, p%
  243.     FOR x% = 1 TO UBOUND(heavens)
  244.         IF heavens(var).parnt = heavens(x%).nam THEN p% = x%
  245.     NEXT x%
  246.     FindParent = p%
  247.  
  248. END FUNCTION 'FindParent
  249.  
  250.  
  251. SUB GasGiants
  252.  
  253.     DIM x$, chk&, rl%, gp%, n%, x%, y%, zc%, yc%, z%, ggs%, sz%, noa%, ggdet AS body
  254.  
  255.     gp% = GetAnswer%("Gas Giant Present?: <Y>es <N>o <R>oll", "YNR")
  256.     SELECT CASE gp%
  257.         CASE 1: rl% = 6
  258.         CASE 2: rl% = 0
  259.         CASE 3: rl% = DiceRoll%(2, 6, 0) '                      roll for GG presence
  260.     END SELECT
  261.     IF rl% > 5 THEN
  262.         n% = GetAnswer%("Number of gas giants: <1> <2> <3> <4> <5> <R>oll", "12345R")
  263.         IF n% < 6 THEN
  264.             ggs% = n%
  265.         ELSE
  266.             rl% = DiceRoll%(2, 6, 0) '                          roll for GG number
  267.             IF rl% < 10 THEN
  268.                 ggs% = INT(rl% / 2)
  269.             ELSE
  270.                 ggs% = INT((rl% - 1) / 2)
  271.             END IF
  272.         END IF
  273.         'check for sufficient orbits for gas giants <<<CAN THIS BE SUBBED OUT?
  274.         noa% = 0
  275.         FOR y% = 1 TO sysnat
  276.             FOR z% = 0 TO heavens(y%).maxor
  277.                 IF orbit(z%, y%).class > 2 AND orbit(z%, y%).class < 6 THEN
  278.                     IF orbit(z%, y%).pin = 0 AND orbit(z%, y%).prsnt THEN
  279.                         noa% = noa% + 1
  280.                     END IF
  281.                 END IF
  282.             NEXT z%
  283.         NEXT y%
  284.         IF noa% = 0 THEN GOTO GGnone
  285.         IF noa% < ggs% THEN ggs% = noa%
  286.  
  287.         'Do GG orbits and details
  288.         FOR x% = 1 TO ggs%
  289.             yc% = 1: zc% = 0
  290.             ggdet.class = "GG"
  291.             rl% = DiceRoll%(1, 6, 0) '                          roll for GG size (S/L)
  292.             IF rl% < 4 THEN '                                   determine radi as per WBH
  293.                 ggdet.siz = "S"
  294.                 rl% = DiceRoll%(2, 6, 0)
  295.                 SELECT CASE rl%
  296.                     CASE IS < 7: sz% = rl% * 10
  297.                     CASE IS < 9: sz% = (rl% - 1) * 10
  298.                     CASE 10 TO 12: sz% = (rl% - 2) * 10
  299.                 END SELECT
  300.             ELSE
  301.                 ggdet.siz = "L"
  302.                 rl% = DiceRoll%(3, 6, 0)
  303.                 SELECT CASE rl%
  304.                     CASE IS < 8: sz% = (rl% + 8) * 10
  305.                     CASE 8 TO 18: sz% = (rl% + 7) * 10
  306.                 END SELECT
  307.             END IF
  308.             ggdet.radi = (((sz% * 1000) + (DiceRoll%(2, 6, -7) * 1000) + (DiceRoll%(2, 6, -7) * 100) + (DiceRoll%(2, 6, -7) * 10) + DiceRoll%(2, 6, -7)) * 1.6) / 2
  309.             '                                                   density
  310.             rl% = DiceRoll%(3, 6, 0)
  311.             SELECT CASE rl%
  312.                 CASE IS < 8: ggdet.dens = (rl% + 7) / 100
  313.                 CASE 8 TO 11: ggdet.dens = (rl% * 2) / 100
  314.                 CASE 12, 13: ggdet.dens = (rl% + 11) / 100
  315.                 CASE 14 TO 18: ggdet.dens = (rl% + 12) / 100
  316.             END SELECT
  317.  
  318.             'Gas Giant Placement routine here or call
  319.  
  320.             'Screen 0 color array
  321.             '0=black,1=blue,2=green,3=aqua,4=red,5=purple,6=brown,7=white
  322.             '8=gray, +8=bright color, except 14=yellow,
  323.             SCREEN plcmnt& '                                    <<<CAN THIS BE SUBBED OUT TOO?
  324.             _DEST plcmnt&
  325.             COLOR clr&(14), clr&(3): CLS
  326.             PRINT x%; "- "; ggdet.siz; ggdet.class; " radius="; ggdet.radi; "  density="; ggdet.dens
  327.             DO
  328.                 FOR y% = 1 TO sysnat
  329.                     LOCATE 5 * (y% - 1) + 2,
  330.                     PRINT SPC(5 * (heavens(y%).rank - 1)); _TRIM$(heavens(y%).nam); " "; heavens(y%).class; heavens(y%).siz
  331.                     PRINT SPC(5 * (heavens(y%).rank - 1));
  332.                     FOR z% = 0 TO heavens(y%).maxor
  333.                         x$ = INKEY$
  334.                         IF x$ = CHR$(0) + CHR$(77) THEN zc% = zc% + 1
  335.                         IF x$ = CHR$(9) THEN zc% = zc% + 1
  336.                         IF x$ = CHR$(13) THEN EXIT DO
  337.                         IF orbit(zc%, yc%).class < 3 THEN zc% = zc% + 1
  338.                         IF orbit(zc%, yc%).prsnt = 0 THEN zc% = zc% + 1
  339.                         IF orbit(zc%, yc%).pin > 0 THEN zc% = zc% + 1
  340.                         IF zc% > heavens(yc%).maxor THEN
  341.                             zc% = 0: yc% = yc% + 1
  342.                         END IF
  343.                         IF yc% > sysnat THEN yc% = 1
  344.                         IF z% < 10 THEN
  345.                             PRINT "  "; z%; "  ";
  346.                         ELSE
  347.                             PRINT " "; z%; "  ";
  348.                         END IF
  349.  
  350.                         _DEST chkbx&
  351.  
  352.                         SELECT CASE orbit(z%, y%).class
  353.                             CASE 2: COLOR clr&(0), clr&(15): CLS
  354.                             CASE 3: COLOR clr&(15), clr&(12): CLS
  355.                             CASE 4: COLOR clr&(15), clr&(2): CLS
  356.                             CASE 5: COLOR clr&(15), clr&(1): CLS
  357.                         END SELECT
  358.                         IF zc% = z% AND yc% = y% THEN
  359.                             LINE (1, 1)-(22, 22), clr&(4), B: LINE (2, 2)-(21, 21), clr&(15), B ' display active orbit box
  360.                         END IF
  361.                         IF orbit(z%, y%).prsnt = 0 OR orbit(z%, y%).pin > 0 THEN '           Check box greyed out or available
  362.                             'chk& = _COPYIMAGE(chkbx&)
  363.                             COLOR , clr&(8): CLS
  364.                             '_PUTIMAGE (3, 3)-(20, 20), chk&, chkbx&
  365.                             IF orbit(z%, y%).pin > 0 THEN
  366.                                 _PRINTSTRING (4, 4), _TRIM$(STR$(orbit(z%, y%).pin)), chkbx&
  367.                             END IF
  368.                         END IF
  369.  
  370.                         SCREEN plcmnt&
  371.                         _DEST plcmnt&
  372.                         IF orbit(z%, y%).class > 1 THEN
  373.                             _PUTIMAGE (((heavens(y%).rank - 1) * 40) + (56 * z%) + 16, (48 + ((y% - 1) * 80))), chkbx&, plcmnt&
  374.                         END IF
  375.                     NEXT z%
  376.                     PRINT
  377.                 NEXT y%
  378.  
  379.             LOOP
  380.             PRINT: PRINT: PRINT
  381.  
  382.             orbs = orbs + 1
  383.             heavens(orbs) = ggdet '                             sets class, size, radius, density
  384.             LOCATE sysnat * 5 + 3, 1
  385.             INPUT "Name of Gas Giant: ", heavens(orbs).nam '    sets name
  386.             heavens(orbs).parnt = heavens(yc%).nam '            sets parent name
  387.             heavens(orbs).orad = orbit(zc%, yc%).orad '         sets orbital radius (relative to .parnt
  388.             orbit(zc%, yc%).pin = orbs '                        places in orbital slot
  389.             CLS
  390.         NEXT x%
  391.  
  392.         SCREEN main&: _DEST main&
  393.     ELSE
  394.         GGnone:
  395.         PRINT "No gas giants present"
  396.         SLEEP 3
  397.  
  398.     END IF
  399.  
  400. END SUB 'GasGiants
  401.  
  402.  
  403. FUNCTION GetAnswer% (prompt$, validChars$)
  404.  
  405.     '-------------------------QUERY------------------------------------------------------CLEARED
  406.     ' FUNCTION: GetAnswer%
  407.     '
  408.     ' Purpose:
  409.     ' Display a menu prompt.
  410.     ' Get a character of input from the keyboard and return a numerical expression
  411.     ' to represent choice for SELECT CASE or similar control functions. Rejects any
  412.     ' invalid characters entered. A standard library routine stolen from "QBasic
  413.     ' for Dummies". Why reinvent a wheel?
  414.     '
  415.     ' Passed Variables:
  416.     ' prompt$ sends menu prompt to be displayed
  417.     ' validChars$ sends list of acceptable hotkey choices
  418.     '
  419.     '------------------------------------------------------------------------------------
  420.     DIM inChar$, charPos%, okchar% '                            added for OPTION _EXPLICIT
  421.     PRINT prompt$
  422.     DO
  423.         inChar$ = UCASE$(INKEY$)
  424.  
  425.         charPos% = INSTR(validChars$, inChar$) '                examine the input.
  426.         IF (LEN(inChar$) = 1) AND (charPos% <> 0) THEN
  427.             okchar% = 1
  428.         ELSE
  429.             okchar% = 0
  430.         END IF
  431.     LOOP UNTIL okchar% '                                        Stop looping when a valid character is received.
  432.  
  433.     GetAnswer% = charPos%
  434.  
  435. END FUNCTION 'GetAnswer%
  436.  
  437.  
  438. SUB MainIn
  439.  
  440.     'conduct main world UPP entry
  441.  
  442. END SUB 'MainIn
  443.  
  444.  
  445. SUB MaxOrbits (id AS INTEGER, typ AS STRING, siz AS STRING)
  446.  
  447.     DIM x%, y%, mx%, sc$, sz$, sm!, sr!, typt$, dm%, rl%, o$
  448.     STATIC o2$ '                                                used to avoid duplicating inner orbits
  449.  
  450.     IF VAL(MID$(typ, 2)) >= 5 THEN
  451.         typt$ = _TRIM$(LEFT$(typ, 1)) + "5"
  452.     ELSEIF VAL(MID$(typ, 2)) < 5 THEN
  453.         typt$ = _TRIM$(LEFT$(typ, 1)) + "0"
  454.     END IF
  455.  
  456.     RESTORE stellar_details
  457.     'Find the proper table of orbits, when found exit with data set
  458.     DO
  459.         REDIM rbits%(0 TO 21)
  460.         x% = 0
  461.         READ sz$: READ sc$: READ sm!: READ sr!
  462.         DO
  463.             READ rbits%(x%)
  464.             IF rbits%(x%) = 6 THEN EXIT DO '                    beyond available orbits for star type 6 is delimiter
  465.             x% = x% + 1
  466.         LOOP
  467.     LOOP UNTIL _TRIM$(sc$) = _TRIM$(typt$) AND _TRIM$(sz$) = _TRIM$(siz)
  468.  
  469.     PRINT sc$; " "; sz$; " ";
  470.     heavens(id).radi = sr! * Solrad
  471.     heavens(id).dens = sm! / (1.333 * _PI * (sr! ^ 3)) '        .255 solar density
  472.  
  473.     FOR y% = 0 TO x%
  474.         orbit(y%, id).class = rbits%(y%)
  475.         IF orbit(y%, id).class = 1 THEN orbit(y%, id).prsnt = 0 '       within star photosphere
  476.         PRINT orbit(y%, id).class;
  477.     NEXT y%
  478.  
  479.     IF siz = "Ia" OR siz = "Ib" OR siz = "II" THEN '            determine size modifier
  480.         dm% = dm% + 8
  481.     ELSEIF siz = "III" THEN
  482.         dm% = dm% + 4
  483.     ELSE
  484.         'no die modifier
  485.     END IF
  486.  
  487.     IF LEFT$(typ, 1) = "M" THEN '                               determine class modifier
  488.         dm% = dm% - 4
  489.     ELSEIF LEFT$(typ, 1) = "F" THEN
  490.         dm% = dm% - 2
  491.     ELSE
  492.         'no die modifier
  493.     END IF
  494.     mx% = GetAnswer%("Choose max. orbits, DM of " + STR$(dm%) + " applied: (2 - 9) A=10, B=11, C=12, <R>oll:", "23456789ABCR")
  495.     IF mx% < 12 THEN
  496.         heavens(id).maxor = mx% + 1 + dm%
  497.     ELSE
  498.         heavens(id).maxor = DiceRoll%(2, 6, dm%) '              roll for maximum orbits
  499.     END IF
  500.     AvailableOrbit id
  501.  
  502.     IF id = 1 THEN
  503.     ELSEIF id = 2 THEN
  504.         rl% = DiceRoll%(2, 6, 0) '                              roll for companion orbit
  505.         SELECT CASE rl%
  506.             CASE 2 TO 3: o$ = "c" '                             close companion
  507.             CASE 4: o$ = "1" '                                  orbit 1
  508.             CASE 5: o$ = "2" '                                  orbit 2
  509.             CASE 6: o$ = "3" '                                  orbit 3
  510.             CASE 7: o$ = STR$(4 + DiceRoll%(1, 6, 0)) '         orbit 4 + 1D
  511.             CASE 8: o$ = STR$(5 + DiceRoll%(1, 6, 0)) '         orbit 5 + 1D
  512.             CASE 9: o$ = STR$(6 + DiceRoll%(1, 6, 0)) '         orbit 6 + 1D
  513.             CASE 10: o$ = STR$(7 + DiceRoll%(1, 6, 0)) '        orbit 7 + 1D
  514.             CASE 11: o$ = STR$(8 + DiceRoll%(1, 6, 0)) '        orbit 8 + 1D
  515.             CASE 12: o$ = "f" '                                 far
  516.         END SELECT
  517.         o2$ = o$
  518.         PlaceStar id, o$
  519.     ELSEIF id = 3 THEN
  520.         try_again:
  521.         rl% = DiceRoll%(2, 6, 4) '                              roll for second companion orbit
  522.         SELECT CASE rl%
  523.             CASE 6: o$ = "3" '                                  orbit 3
  524.             CASE 7: o$ = STR$(4 + DiceRoll%(1, 6, 0)) '         orbit 4 + 1D
  525.             CASE 8: o$ = STR$(5 + DiceRoll%(1, 6, 0)) '         orbit 5 + 1D
  526.             CASE 9: o$ = STR$(6 + DiceRoll%(1, 6, 0)) '         orbit 6 + 1D
  527.             CASE 10: o$ = STR$(7 + DiceRoll%(1, 6, 0)) '        orbit 7 + 1D
  528.             CASE 11: o$ = STR$(8 + DiceRoll%(1, 6, 0)) '        orbit 8 + 1D
  529.             CASE IS >= 12: o$ = "f" '                           far
  530.         END SELECT
  531.         IF o$ = o2$ AND o$ <> "f" THEN GOTO try_again '         Don't put in same orbit as #2, but take a chance on far orbits
  532.         PlaceStar id, o$
  533.  
  534.         'id 4 & 5 on recursive call for far companion binary stars?
  535.     ELSEIF id = 4 OR id = 5 THEN
  536.         rl% = DiceRoll%(2, 6, -4)
  537.         SELECT CASE rl%
  538.             CASE IS <= 3: o$ = "c"
  539.             CASE 4: o$ = "1"
  540.             CASE 5: o$ = "2"
  541.             CASE 6: o$ = "3"
  542.             CASE 7: o$ = STR$(4 + DiceRoll%(1, 6, 0))
  543.             CASE 8: o$ = STR$(5 + DiceRoll%(1, 6, 0))
  544.         END SELECT
  545.         PlaceStar id, o$
  546.     END IF
  547.  
  548. END SUB 'MaxOrbits
  549.  
  550.  
  551. SUB PlaceStar (var AS INTEGER, orbst AS STRING)
  552.  
  553.     'Place body(var) into (orbit)
  554.  
  555.     DIM x%, y%, ao%, rl%, sc%, sz% 'DIM zo% ' DIM l%
  556.  
  557.     IF orbst = "c" THEN '                                         close companion
  558.         heavens(var).orad = heavens(1).radi + heavens(var).radi + DiceRoll%(1, 100000, 20000)
  559.         heavens(var).maxor = 0
  560.     ELSEIF orbst = "f" THEN '                                     far orbit
  561.         heavens(var).orad = (DiceRoll%(1, 6, 0) * 1000) * AUtokm
  562.         rl% = DiceRoll%(2, 6, -1) '                             is this one a binary?
  563.         IF rl% > 7 THEN '                                       yes it is
  564.             'configure far binary companion here
  565.             y% = 0
  566.             DO '                                                find next empty array element
  567.                 y% = y% + 1
  568.                 IF heavens(y%).star THEN
  569.                 ELSE
  570.                     EXIT DO '                                   y% element is empty
  571.                 END IF
  572.             LOOP
  573.             heavens(y%).star = -1
  574.             heavens(y%).rank = 3
  575.             PRINT
  576.             INPUT "Name of far companion binary star: ", heavens(y%).nam
  577.             heavens(y%).parnt = heavens(var).nam
  578.             orbs = orbs + 1: sysnat = sysnat + 1
  579.             'Star Spectral Class
  580.             sc% = GetAnswer%("Spectral class: <B><A><F><G><K><M> or <R>oll ", "BAFGKMR")
  581.             heavens(y%).class = StarClass$(y%, sc%)
  582.             PRINT heavens(y%).class
  583.             'Star Size
  584.             sz% = GetAnswer%("Star Size: <A.Ia><B.Ib><2.II><3.III><4.IV><5.V><6.VI><D> or <R>oll ", "AB23456DR")
  585.             heavens(y%).siz = StarSize$(y%, sz%)
  586.             PRINT heavens(y%).siz
  587.             MaxOrbits y%, heavens(y%).class, heavens(y%).siz
  588.         END IF
  589.     ELSE '                                                      system orbit
  590.         x% = VAL(orbst)
  591.         IF orbit(x%, FindParent(var)).orad < heavens(FindParent(var)).radi THEN 'if parent star bigger than orbit then
  592.             heavens(var).orad = heavens(FindParent(var)).radi + heavens(var).radi + DiceRoll%(1, 100000, 20000) 'close companion of giant star
  593.         ELSE
  594.             heavens(var).orad = orbit(x%, FindParent(var)).orad
  595.             orbit(x%, FindParent(var)).pin = var
  596.             'determine available orbits here
  597.             ao% = INT(x% / 2)
  598.             heavens(var).maxor = ao%
  599.             AvailableOrbit var
  600.             DO '                                                delete inner orbits from parent
  601.                 ao% = ao% + 1:
  602.                 IF ao% < x% THEN
  603.                     orbit(ao%, FindParent(var)).prsnt = 0
  604.                 ELSEIF ao% = x% THEN
  605.                     orbit(ao%, FindParent(var)).prsnt = -1
  606.                 ELSE
  607.                     orbit(ao%, FindParent(var)).prsnt = 0
  608.                 END IF
  609.             LOOP UNTIL ao% = x% + 2
  610.         END IF
  611.     END IF
  612.  
  613. END SUB 'PlaceStar
  614.  
  615.  
  616. SUB RefreshPrompt
  617.  
  618.     DIM x%
  619.     SCREEN main&
  620.     _DEST main&
  621.     CLS
  622.     'if there is a main world pre-generated, enter it first and set MWin to -1
  623.     'IF YesOrNo$("Is there a main world to enter?") = "Y" THEN MainIn
  624.     'FOR x% = 0 TO 19
  625.     '    PRINT x%; "  "; orbit(x%, 1).orad
  626.     'NEXT x%
  627.     'SLEEP
  628.     StarSystem '                                               Rank 1 primary & rank 2 companion(s)
  629.     GasGiants
  630.     SystemDisplay
  631.     'WorldSize 2
  632.  
  633. END SUB 'RefreshPromt
  634.  
  635.  
  636. SUB SetEnviron
  637.  
  638.     DIM x%, y%, r%, g%, b%, ob!
  639.  
  640.     orbs = 0
  641.  
  642.     RESTORE colors
  643.     FOR x% = 0 TO 15 '                                          iterate colors 0 thru 15
  644.         READ r% '                                               get red component
  645.         READ g% '                                               get green component
  646.         READ b% '                                               get blue component
  647.         clr&(x%) = _RGB32(r%, g%, b%) '                         mix color x into array
  648.     NEXT x%
  649.  
  650.     'Setup radii of orbit shells
  651.     FOR y% = 1 TO 5
  652.         RESTORE Orbits
  653.         'set orbital radii in km
  654.         FOR x% = 0 TO 19
  655.             READ ob!
  656.             orbit(x%, y%).orad = ob! * AUtokm
  657.         NEXT x%
  658.     NEXT y%
  659.  
  660. END SUB 'SetEnviron
  661.  
  662.  
  663. FUNCTION StarClass$ (var AS _BYTE, roll AS INTEGER)
  664.  
  665.     DIM dm%, rl%, sc$
  666.     SELECT CASE roll
  667.         CASE IS = 1: sc$ = "B"
  668.         CASE IS = 2: sc$ = "A"
  669.         CASE IS = 3: sc$ = "F"
  670.         CASE IS = 4: sc$ = "G"
  671.         CASE IS = 5: sc$ = "K"
  672.         CASE IS = 6: sc$ = "M"
  673.         CASE IS = 7
  674.             SELECT CASE var '                                   determine applicable DMs
  675.                 CASE 1: IF MWin THEN dm% = 4 '                  add UPP details when coded
  676.                 CASE 2 TO 5: dm% = starroll(FindParent(var)).c 'add DM of parent
  677.             END SELECT
  678.             rl% = DiceRoll%(2, 6, dm%): starroll(var).c = rl% - dm%
  679.             IF var > 1 THEN
  680.                 SELECT CASE rl%
  681.                     CASE IS <= 2: sc$ = "A"
  682.                     CASE 3 TO 4: sc$ = "F"
  683.                     CASE 5 TO 6: sc$ = "G"
  684.                     CASE 7 TO 8: sc$ = "K"
  685.                     CASE IS > 8: sc$ = "M"
  686.                 END SELECT
  687.             ELSE
  688.                 SELECT CASE rl%
  689.                     CASE IS <= 2: sc$ = "A"
  690.                     CASE 3 TO 7: sc$ = "M"
  691.                     CASE IS = 8: sc$ = "K"
  692.                     CASE IS = 9: sc$ = "G"
  693.                     CASE IS >= 10: sc$ = "F"
  694.                 END SELECT
  695.             END IF
  696.     END SELECT
  697.     StarClass$ = _TRIM$(sc$) + _TRIM$(STR$(DiceRoll%(1, 10, 0)))
  698.  
  699. END FUNCTION 'StarClass$
  700.  
  701.  
  702. FUNCTION StarSize$ (var AS _BYTE, roll AS INTEGER)
  703.  
  704.     DIM dm%, rl%, sz$
  705.  
  706.     SELECT CASE roll
  707.         CASE IS = 1: sz$ = "Ia"
  708.         CASE IS = 2: sz$ = "Ib"
  709.         CASE IS = 3: sz$ = "II"
  710.         CASE IS = 4: sz$ = "III"
  711.         CASE IS = 5
  712.             IF LEFT$(heavens(var).class, 1) = "M" THEN
  713.                 sz$ = "V"
  714.             ELSEIF LEFT$(heavens(var).class, 1) = "K" AND VAL(RIGHT$(heavens(var).class, 1)) > 4 THEN
  715.                 sz$ = "V"
  716.             ELSE
  717.                 sz$ = "IV"
  718.             END IF
  719.         CASE IS = 6: sz$ = "V"
  720.         CASE IS = 7: sz$ = "VI"
  721.         CASE IS = 8: sz$ = "D": heavens(var).class = LEFT$(heavens(var).class, 1)
  722.         CASE IS = 9
  723.             SELECT CASE var '                                   Apply size DMs
  724.                 CASE 1
  725.                 CASE 2 TO 5: dm% = starroll(FindParent(var)).s 'add DM of parent
  726.             END SELECT
  727.             rl% = DiceRoll%(2, 6, dm%): starroll(var).s = rl% - dm%
  728.             SELECT CASE rl%
  729.                 CASE 2: sz$ = "II"
  730.                 CASE 3: sz$ = "III"
  731.                 CASE 4 '                                        K5 thru M don't exist in size IV make them V
  732.                     IF LEFT$(heavens(var).class, 1) = "M" THEN
  733.                         sz$ = "V"
  734.                     ELSEIF LEFT$(heavens(var).class, 1) = "K" AND VAL(RIGHT$(heavens(var).class, 1)) > 4 THEN
  735.                         sz$ = "V"
  736.                     ELSE
  737.                         sz$ = "IV"
  738.                     END IF
  739.                 CASE 5 TO 10: sz$ = "V"
  740.                 CASE 11: sz$ = "VI"
  741.                 CASE IS >= 12: sz$ = "D": heavens(var).class = LEFT$(heavens(var).class, 1)
  742.             END SELECT
  743.     END SELECT
  744.     StarSize$ = sz$
  745.  
  746. END FUNCTION 'StarSize$
  747.  
  748.  
  749. SUB StarSystem
  750.  
  751.     'dimension local
  752.     DIM x%, rl%, sn%, sc%, sz%
  753.     SCREEN starin&: _DEST starin&
  754.     COLOR clr&(14), clr&(1)
  755.     CLS
  756.     LOCATE 1, 30
  757.     PRINT "STAR SYSTEM DETAILS"
  758.     LOCATE 3, 1
  759.     sn% = GetAnswer%("System nature: <1> solo, <2> binary, <3> trinary, <R>oll ", "123R")
  760.     IF sn% > 0 AND sn% < 4 THEN
  761.         sysnat = sn%
  762.     ELSE
  763.         rl% = DiceRoll%(2, 6, 0) '                              roll for system nature
  764.         SELECT CASE rl%
  765.             CASE IS < 8: sysnat = 1
  766.             CASE 8 TO 11: sysnat = 2
  767.             CASE 12: sysnat = 3
  768.         END SELECT
  769.     END IF
  770.  
  771.     'spectral class & size
  772.     FOR x% = 1 TO sysnat
  773.         heavens(x%).star = -1
  774.         IF x% = 1 THEN
  775.             heavens(x%).rank = 1
  776.             INPUT "Name of primary star: ", heavens(x%).nam
  777.             heavens(x%).ps.pX = 0: heavens(x%).ps.pY = 0: heavens(x%).ps.pZ = 0 'Primary Star
  778.             orbs = orbs + 1
  779.         ELSE
  780.             heavens(x%).rank = 2
  781.             PRINT
  782.             INPUT "Name of companion star: ", heavens(x%).nam
  783.             heavens(x%).parnt = heavens(1).nam
  784.             orbs = orbs + 1
  785.         END IF
  786.  
  787.         'Star Spectral Class
  788.         sc% = GetAnswer%("Spectral class: <B><A><F><G><K><M> or <R>oll ", "BAFGKMR")
  789.         heavens(x%).class = StarClass$(x%, sc%)
  790.         PRINT heavens(x%).class
  791.  
  792.         'Star Size
  793.         sz% = GetAnswer%("Star Size: <A.Ia><B.Ib><2.II><3.III><4.IV><5.V><6.VI><D> or <R>oll ", "AB23456DR")
  794.         heavens(x%).siz = StarSize$(x%, sz%)
  795.         PRINT heavens(x%).siz
  796.         MaxOrbits x%, heavens(x%).class, heavens(x%).siz
  797.     NEXT x%
  798.     PRINT "Press any key to continue"
  799.     SLEEP
  800.  
  801.     SCREEN main&
  802.     _DEST main&
  803.     CLS
  804.  
  805. END SUB 'StarSystem
  806.  
  807.  
  808. SUB SystemDisplay
  809.     DIM x%, y%, z%, tl$
  810.     tl$ = CHR$(192) + CHR$(196) + CHR$(196) + CHR$(196) '       orbit leader
  811.     PRINT _TRIM$(heavens(1).nam); " ";
  812.     SELECT CASE sysnat
  813.         CASE 1: PRINT "Solo"
  814.         CASE 2: PRINT "Binary"
  815.         CASE 3: PRINT "Trinary"
  816.     END SELECT
  817.     FOR x% = 1 TO UBOUND(heavens)
  818.         IF heavens(x%).rank = 0 THEN EXIT FOR
  819.         PRINT SPC(5 * (heavens(x%).rank - 1)); tl$;
  820.         PRINT " "; _TRIM$(heavens(x%).nam); " "; heavens(x%).class; heavens(x%).siz; "  orbital radius"; heavens(x%).orad; " density"; heavens(x%).dens; " Max orbits"; heavens(x%).maxor
  821.         FOR y% = 0 TO 21
  822.             IF orbit(y%, x%).prsnt THEN
  823.                 SELECT CASE orbit(y%, x%).class
  824.                     CASE 2: PRINT CHR$(196); " ";
  825.                     CASE 3: PRINT "I ";
  826.                     CASE 4: PRINT "H ";
  827.                     CASE 5: PRINT "O ";
  828.                     CASE 6: PRINT: EXIT FOR
  829.                 END SELECT
  830.                 'PRINT "* ";
  831.             ELSE
  832.                 PRINT "- ";
  833.             END IF
  834.         NEXT y%
  835.         PRINT
  836.     NEXT x%
  837.     PRINT: PRINT
  838.     FOR z% = 1 TO orbs
  839.         PRINT z%; " "; heavens(z%).nam; " "; heavens(z%).siz; heavens(z%).class; " orbital radius="; heavens(z%).orad; " from "; heavens(z%).parnt
  840.     NEXT z%
  841.  
  842. END SUB 'SystemDisplay
  843.  
  844.  
  845. SUB WorldSize (in AS INTEGER)
  846.  
  847.     'determines world radius heavens(x).radi in km
  848.     DIM s AS INTEGER
  849.     INPUT "UWP Size ", s
  850.     heavens(in).radi = (((s * 1000) + (DiceRoll%(2, 6, -7) * 100) + (DiceRoll%(2, 6, -7) * 10) + DiceRoll%(2, 6, -7)) * 1.6) / 2
  851.  
  852. END SUB 'WorldSize
  853.  
  854.  
  855. FUNCTION YesOrNo$ (question AS STRING)
  856.  
  857.     '-------------------------QUERY------------------------------------------------------CLEARED
  858.     ' FUNCTION: YesOrNo$
  859.     '
  860.     ' Purpose:
  861.     ' Display a question and wait for the user to type Y or N returning result to
  862.     ' calling routine for further processing. A standard library function that is used
  863.     ' to verify deletion of an active PC.
  864.     '
  865.     ' Passed Variables:
  866.     ' question sends displayed prompt for Yes or No choice
  867.     '
  868.     '------------------------------------------------------------------------------------
  869.  
  870.     DIM answer$
  871.     PRINT question;
  872.     DO
  873.         answer$ = UCASE$(INKEY$)
  874.     LOOP UNTIL answer$ = "Y" OR answer$ = "N"
  875.     PRINT answer$
  876.  
  877.     YesOrNo$ = answer$
  878.  
  879. END FUNCTION 'YesOrNo$
  880.  
  881.  
  882.  
  883. SUB EmptyOrbits
  884.  
  885.     DIM rl%, dm%
  886.  
  887.     rl% = DiceRoll%(1, 6, 0)
  888.     SELECT CASE rl%
  889.         CASE 1 TO 4
  890.         CASE 5, 6
  891.  
  892.     END SELECT
  893.  
  894. END SUB 'EmptyOrbits
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Program drops when putting an image in another image
« Reply #1 on: August 05, 2019, 10:34:05 am »
Hi Andy,

Do you really want the image drawn inside the other image or do you want the image drawn on screen placed over and "inside" the box of other image?

Apologies if I am misunderstanding and asking stupid question.
Logged

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Program drops when putting an image in another image
« Reply #2 on: August 05, 2019, 11:32:22 am »
Hi. This problems can do _DISPLAY. If is somewhere in program used, it can be this. I look to it.
Logged

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Program drops when putting an image in another image
« Reply #3 on: August 05, 2019, 11:48:37 am »
So. Is this correct program area?

                        IF orbit(z%, y%).prsnt = 0 OR orbit(z%, y%).pin > 0 THEN '           Check box greyed out or available
                            'chk& = _COPYIMAGE(chkbx&)
                            COLOR , clr&(8): CLS
                            _PUTIMAGE (3, 3)-(20, 20), chk&, chkbx&                                                           Here is none valid image in chk&. chk& is empty variable.
                            IF orbit(z%, y%).pin > 0 THEN
                                _PRINTSTRING (4, 4), _TRIM$(STR$(orbit(z%, y%).pin)), chkbx&
                            END IF
                        END IF

                        SCREEN plcmnt&                                                                                                   Here, if is image inserted, so program wait for nothing and draw this empty screen
                        _DEST plcmnt&                                                                                                   
                        IF orbit(z%, y%).class > 1 THEN
                            _PUTIMAGE (((heavens(y%).rank - 1) * 40) + (56 * z%) + 16, (48 + ((y% - 1) * 80))), chkbx&, plcmnt&   


So your problem is - insert to chk& valid image. As it see, so chkbx& is next image, visible after inserting to plcmnt&.  For better solution this problem insert to program PRINT chk&: SLEEP. Value for valid images must be always < -1.
« Last Edit: August 05, 2019, 12:08:08 pm by Petr »
Logged

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Program drops when putting an image in another image
« Reply #4 on: August 05, 2019, 12:25:24 pm »
First you insert Chk& to Chkbx&, if is condition "IF orbit"  valid (try BEEP insert to this condition, to be sure, that this option occur), for me it see as you copy default (current) screen area to new image chkbx& and then after this condition, you insert chkbx& to plcmnt&.

I read your code again. Just ask. You know that you should only call SCREEN if you want to see the screen. To work on the screen, even if it is not visible, just use _DEST for draw the artwork,  _SOURCE to read the colors from this unvisible screen. And when is all done, use SCREEN for view. PUTIMAGE work with it, without SCREEN need.
« Last Edit: August 05, 2019, 12:39:53 pm by Petr »
Logged

Offline Cobalt

  • QB64 Developer
  • Forum Resident
  • Posts: 878
  • At 60 I become highly radioactive!
    • View Profile
Re: Program drops when putting an image in another image
« Reply #5 on: August 05, 2019, 01:03:31 pm »
just FYI doesn't crash for me. When does it crash for you?
Logged
Granted after becoming radioactive I only have a half-life!

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: Program drops when putting an image in another image
« Reply #6 on: August 05, 2019, 01:04:53 pm »
Quote from: bplus on August 05, 2019, 10:34:05 am
Do you really want the image drawn inside the other image or do you want the image drawn on screen placed over and "inside" the box of other image?

Yes, I'm trying to get the box to show a grey core while still showing it original color as a border. That way I still have a visual reference for placing additional planets. I thought I could preload the chkbx& image with chk& in the middle and not have to worry about positioning chk& in plcmnt& over the specific chkbx&, since the overall algorithm already does that pretty well. Why it kills the program without any error message and a brief delay is what I find a mystery.

Quote from: Petr on August 05, 2019, 11:48:37 am
So. Is this correct program area?

So your problem is - insert to chk& valid image. As it see, so chkbx& is next image, visible after inserting to plcmnt&.  For better solution this problem insert to program PRINT chk&: SLEEP. Value for valid images must be always < -1.

Yes, that's the part that gives me the trouble.
I thought that _COPYIMAGE would make a copy with a valid handle, I think I don't quite understand the dynamics of images yet...

In looking at your response I realized I hadn't set _DEST for chk& and then back to chkbx& before putting the image, even though it did what it was supposed to do briefly. So I made that change thinking it might improve stability.

                        IF orbit(z%, y%).prsnt = 0 OR orbit(z%, y%).pin > 0 THEN '           Check box greyed out or available
                            chk& = _COPYIMAGE(chkbx&)
                            _DEST chk&: COLOR , clr&(8): CLS: _DEST chkbx&
                            _PUTIMAGE (3, 3)-(20, 20), chk&, chkbx&
                            IF orbit(z%, y%).pin > 0 THEN
                                _PRINTSTRING (4, 4), _TRIM$(STR$(orbit(z%, y%).pin)), chkbx&
                            END IF
                        END IF

After doing that the program hung in there a couple seconds or so longer before dropping, but it still dropped. I'm stymied, and considering just going with the number in the box and forgetting the fancy stuff.
Logged

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: Program drops when putting an image in another image
« Reply #7 on: August 05, 2019, 01:06:23 pm »
Quote from: Cobalt on August 05, 2019, 01:03:31 pm
just FYI doesn't crash for me. When does it crash for you?
It happens immediately after I set a planet in an orbit and the display in question becomes active.

Maybe I should try it on a different machine, but then that makes my laptop somewhat less than useful to me...
« Last Edit: August 05, 2019, 01:08:16 pm by OldMoses »
Logged

Offline Cobalt

  • QB64 Developer
  • Forum Resident
  • Posts: 878
  • At 60 I become highly radioactive!
    • View Profile
Re: Program drops when putting an image in another image
« Reply #8 on: August 05, 2019, 01:09:04 pm »
where does that happen? I get through all the questions and naming bits. then the program is ended by the 'END' statement


interesting output though.
though with my secondary stars density I think my system is becoming a Black Hole! though with its orbital radius it must be so far away I may not have to worry.
« Last Edit: August 05, 2019, 01:14:41 pm by Cobalt »
Logged
Granted after becoming radioactive I only have a half-life!

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: Program drops when putting an image in another image
« Reply #9 on: August 05, 2019, 01:25:19 pm »
Do it again, but type "Y" for GG present. Then you'll get the screen where you tab through the available orbits. Hit <enter> to choose an orbit for the GG listed at the top (it'll ask for a name), then it should deposit a number in the chosen box and put a grey core in the box, that's when the program drops for me.
« Last Edit: August 05, 2019, 01:30:26 pm by OldMoses »
Logged

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: Program drops when putting an image in another image
« Reply #10 on: August 05, 2019, 01:29:25 pm »
Quote from: Cobalt on August 05, 2019, 01:09:04 pm
interesting output though.
though with my secondary stars density I think my system is becoming a Black Hole! though with its orbital radius it must be so far away I may not have to worry.

That output screen is mostly a debugging leftover, but I was surprised by the density too. I think it's because the mass of a white dwarf is concentrated in such a small volume. It's a much larger star compressed into an Earth sized orb. It's kind of the last whistle stop before a black hole.
Logged

Offline Cobalt

  • QB64 Developer
  • Forum Resident
  • Posts: 878
  • At 60 I become highly radioactive!
    • View Profile
Re: Program drops when putting an image in another image
« Reply #11 on: August 05, 2019, 03:28:17 pm »
Quote from: OldMoses on August 05, 2019, 01:25:19 pm
Do it again, but type "Y" for GG present. Then you'll get the screen where you tab through the available orbits. Hit <enter> to choose an orbit for the GG listed at the top (it'll ask for a name), then it should deposit a number in the chosen box and put a grey core in the box, that's when the program drops for me.

still works for me, doesn't always seem to put the correct number of boxes though, seems to place an extra one sometimes, get 5 boxes when I press 4. Both TAB and RIGHT ARROW move the selected box. but can only move right until it cycles back no left movement. but no crashing.
Logged
Granted after becoming radioactive I only have a half-life!

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: Program drops when putting an image in another image
« Reply #12 on: August 05, 2019, 05:25:26 pm »
Quote from: Cobalt on August 05, 2019, 03:28:17 pm
still works for me, doesn't always seem to put the correct number of boxes though, seems to place an extra one sometimes, get 5 boxes when I press 4. Both TAB and RIGHT ARROW move the selected box. but can only move right until it cycles back no left movement. but no crashing.

It is going to take some tweaking to get the orbit handler right. In some cases it appears to do it wrong, in others it is doing an orbit restriction for near companion stars that have their own orbiting bodies. I have to chase down all the permutations, if that's even possible. I tried a back arrow routine and it got really squirrely, so I abandoned that for the time being.

I think I'm going to have to do a test bed program to see if I can duplicate the issue, and if it doesn't happen to anyone else, I'll have to take a hard look at my machine.
Logged

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: Program drops when putting an image in another image
« Reply #13 on: August 06, 2019, 07:12:11 am »
In essence, this is what I'm attempting to do, without all the other program stuff to wade through.

This worked fine until I put it in the DO...LOOP, at which point it also crashed. So I put a limit on it and watched with Task Manager.

It uses increasing amounts of memory, up to around 50MB and then quits.

Do I need to use _FREEIMAGE? I thought it wouldn't be an issue as I am using the same handle variables each time.

EDIT: YES!! _FREEIMAGE stopped it. I think the mystery is solved, thank you all for your attention. Still learning here...

Code: QB64: [Select]
  1. Main& = _NEWIMAGE(200, 200, 32)
  2. Inner& = _NEWIMAGE(24, 24, 32)
  3. SCREEN Main&
  4. _DEST Main&
  5. COLOR _RGBA32(255, 255, 255, 255), _RGBA32(127, 127, 127, 255)
  8.     PRINT "Let us make a box."
  9.     PRINT "Yes, let us."
  10.     _DEST Inner&
  11.     COLOR , _RGBA32(0, 0, 255, 255)
  12.     CLS
  13.     _DEST Main&
  14.     _PUTIMAGE (100, 100), Inner&, Main&
  15.     temp& = _COPYIMAGE(Inner&)
  16.     _DEST temp&
  17.     COLOR , _RGBA32(255, 0, 0, 255)
  18.     CLS
  19.     _DEST Inner&
  20.     _PUTIMAGE (4, 4)-(19, 19), temp&, Inner&
  21.     _DEST Main&
  22.     _FREEIMAGE (temp&)
  23.     _PUTIMAGE (50, 100), Inner&, Main&
  24.     x = x + 1
  25.     LOCATE 12, 1
  26.     PRINT "Loop: "; x
  27.     _DISPLAY
  28.     'SLEEP
  29.     CLS
  30.     _LIMIT 2000
  33.  
  34.  
« Last Edit: August 06, 2019, 07:24:09 am by OldMoses »
Logged

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Program drops when putting an image in another image
« Reply #14 on: August 06, 2019, 07:25:39 am »
Here's your issue and solution:

Code: QB64: [Select]
  1. Main& = _NEWIMAGE(200, 200, 32)
  2. Inner& = _NEWIMAGE(24, 24, 32)
  3. SCREEN Main&
  4. _DEST Main&
  5. COLOR _RGBA32(255, 255, 255, 255), _RGBA32(127, 127, 127, 255)
  8.     PRINT "Let us make a box."
  9.     PRINT "Yes, let us."
  10.     _DEST Inner&
  11.     COLOR , _RGBA32(0, 0, 255, 255)
  12.     CLS
  13.     _DEST Main&
  14.     _PUTIMAGE (100, 100), Inner&, Main&
  15.     IF temp& THEN _FREEIMAGE temp& 'If there's already an image called temp&, free it OR....
  16.     temp& = _COPYIMAGE(Inner&) 'Here you're making a copy of an image, so it's a new image in memory.
  17.     '                              If you make a copy on a copy machine, what happens to the paper in your print drawer?
  18.     '                              It eventually runs out and you get an ERROR!
  19.     '                           That's what is going to happen here... You'll keep making copy after copy after copy of the image
  20.     '                              until you use up all of your memory and crash.
  21.     _DEST temp&
  22.     COLOR , _RGBA32(255, 0, 0, 255)
  23.     CLS
  24.     _DEST Inner&
  25.     _PUTIMAGE (4, 4)-(19, 19), temp&, Inner&
  26.     _DEST Main&
  27.     _PUTIMAGE (50, 100), Inner&, Main&
  28.     x = x + 1
  29.     LOCATE 12, 1
  30.     PRINT "Loop: "; x
  31.     _DISPLAY
  32.     'SLEEP
  33.     CLS
  34.     _LIMIT 2000
Logged
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!
Pages: [1] 2   Go Up
« previous next »