Author Topic: Shadow over Mars  (Read 2191 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Shadow over Mars
« on: June 19, 2018, 12:52:22 pm »
[banned user]'s spinning planet now with shadow added to make look spherical.

Code: QB64: [Select]
  1. _TITLE "Planet Maker - Mars"
  2. SCREEN _NEWIMAGE(500, 500, 32)
  3.  
  4. ' \/\/\/\/\/\/\/\/\/
  5. ' Load texture image
  6. ' /\/\/\/\/\/\/\/\/\
  7. Texture = _LOADIMAGE(".\images\mars.png")
  8.  
  9. ' \/\/\/\/\/\/\/\/\/\/
  10. ' Center of the screen
  11. ' /\/\/\/\/\/\/\/\/\/\
  12. cw = 250
  13. ch = 250
  14.  
  15. ' \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  16. ' Width and Height of the texture
  17. ' /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  18. w = 480
  19. h = 480
  20.  
  21. ' \/\/\/\/\/\/\/\/\/\/\/\/\/
  22. ' Location to put the images
  23. ' /\/\/\/\/\/\/\/\/\/\/\/\/\
  24. tx = cw - w \ 2
  25. ty = ch - h \ 2
  26.  
  27. shaddow& = _NEWIMAGE(w, h)
  28. _DEST shaddow&
  29. COLOR _RGBA(10, 10, 10, 8)
  30. FOR dx = 1 TO 200
  31.     fcirc 250 + 200 + dx, 250, 250 + 2 * dx
  32.  
  33. Text = "Creating Mars planet.... "
  34. lenText = LEN(Text)
  35.  
  36. ' \/\/\/\/\/\/
  37. ' Mars images
  38. ' /\/\/\/\/\/\
  39. DIM SHARED Mars(w) AS LONG
  40. FOR f = 1 TO w
  41.     Mars(f) = _NEWIMAGE(w, h)
  42. ' \/\/\/\/\/\/\/\/\/
  43. ' Start with frame 1
  44. ' /\/\/\/\/\/\/\/\/\
  45. frames = 1
  46.  
  47. ' \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  48. ' Scroll the texture the width of the texture
  49. ' /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
  50. FOR x = 0 TO w - 1
  51.     _DEST 0
  52.     _PRINTSTRING (cw - 4 * lenText, ch - 8), Text
  53.     Text = RIGHT$(Text, lenText - 1) + LEFT$(Text, 1)
  54.  
  55.     ' \/\/\/\/\/\/\/\/\/\/\/
  56.     ' Draw to the Mars image
  57.     ' /\/\/\/\/\/\/\/\/\/\/\
  58.     _DEST Mars(frames)
  59.  
  60.     '_PUTIMAGE (tx, ty), Texture, , (x, 0)-(w, h)
  61.     '_PUTIMAGE (tx + w - x, ty), Texture, , (1, 0)-(x, h)
  62.     _PUTIMAGE (0, 0), Texture, , (x, 0)-(w, h)
  63.     _PUTIMAGE (w - x, 0), Texture, , (1, 0)-(x, h)
  64.     _PUTIMAGE , shaddow&, Mars(frames)
  65.     ' \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  66.     ' Remove all extra image data from outside the circle
  67.     ' /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
  68.     FOR r = 241 TO 341 STEP 0.05
  69.         CIRCLE (240, 240), r, _RGB(0, 0, 0)
  70.     NEXT
  71.  
  72.     ' \/\/\/\/\/\/\/\/\/\/
  73.     ' Increase frame count
  74.     ' /\/\/\/\/\/\/\/\/\/\
  75.     frames = frames + 1
  76.  
  77. ' \/\/\/\/\/\/\/\/\/\/\/\/\/
  78. ' Set destination to screen
  79. ' /\/\/\/\/\/\/\/\/\/\/\/\/\
  80.  
  81. ' \/\/\/\/\/\/\/\/
  82. ' Erase the screen
  83. ' /\/\/\/\/\/\/\/\
  84. LINE (0, 0)-(800, 600), _RGB(0, 0, 0), BF
  85.  
  86. ' \/\/\/\/\/\/\/\/\/\/\/\/\/\/
  87. ' Repeat until ESC is pressed
  88. ' /\/\/\/\/\/\/\/\/\/\/\/\/\/\
  89.  
  90.     ' \/\/\/\/\/\/\/\/\/\/
  91.     ' Show the planet Mars
  92.     ' /\/\/\/\/\/\/\/\/\/\
  93.     FOR f = 1 TO frames - 1
  94.         _PUTIMAGE (tx, ty), Mars(f), 0
  95.         _DISPLAY
  96.         _LIMIT 30
  97.     NEXT
  98.  
  99. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  100. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  101.     DIM subRadius AS LONG, RadiusError AS LONG
  102.     DIM X AS LONG, Y AS LONG
  103.  
  104.     subRadius = ABS(R)
  105.     RadiusError = -subRadius
  106.     X = subRadius
  107.     Y = 0
  108.  
  109.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  110.  
  111.     ' Draw the middle span here so we don't draw it twice in the main loop,
  112.     ' which would be a problem with blending turned on.
  113.     LINE (CX - X, CY)-(CX + X, CY), , BF
  114.  
  115.     WHILE X > Y
  116.         RadiusError = RadiusError + Y * 2 + 1
  117.         IF RadiusError >= 0 THEN
  118.             IF X <> Y + 1 THEN
  119.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  120.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  121.             END IF
  122.             X = X - 1
  123.             RadiusError = RadiusError - X * 2
  124.         END IF
  125.         Y = Y + 1
  126.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  127.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  128.     WEND
  129.  
  130.  
« Last Edit: June 19, 2018, 12:57:56 pm by bplus »