Dr Matt O'Dowd's black hole/space time t-shirt emulator

Started by BasicBoy, August 17, 2023, 13:18:38

Previous topic - Next topic

BasicBoy

Those of you familiar with this guy...

https://www.mattodowd.space/


...will probably also be familiar by now with the t-shirt he likes to wear on occasion (I rather like it myself).

So, to pass some time this morning I quickly erected this program in BBC BASIC to draw something similar to that black hole t-shirt design because... why not  ;D

      REM "SPACE TIME"
      REM Requires 'BBC BASIC for Windows' (a.k.a. BB4W)
      REM Will run under 'BBC BASIC for SDL 2.0' if modified to do so

      *ESC OFF
      MODE 21 : REM 800x600
      OFF

      ON ERROR OSCLI "REFRESH ON" : ON : COLOUR 15 : REPORT : PRINT " at line "; ERL : END

      REM Read Window width & height:
      Win_w = @vdu%!208
      Win_h = @vdu%!212

      REM Define some globals:
      Degs = PI / 180
      BH_radius = 32
      View_angle = 70

      COLOUR 0, 8, 8, 20 : REM define background colour (very, very dark blue)

      REPEAT
        PROCdraw_orbits
        PROCdisplay_text( "SPACE  TIME" )
        WAIT 200 : REM pause for 2 seconds
      UNTIL FALSE

      DEF PROCdraw_orbits
      LOCAL angle, dash_len, dash_count, draw_flag, ellipse_w, ellipse_h, num_orbits, orbit
      LOCAL col, i, r, plot_x, plot_y, theta, theta_step, x_offs, x_scale, y_scale
      LOCAL x, y, x2, y2, x3, y3, z3

      ORIGIN Win_w, Win_h + 0.35*Win_h

      *REFRESH OFF

      COLOUR 128
      CLS

      REM Draw the black hole:
      COLOUR 4, 0, 0, 1 : GCOL 4
      CIRCLE FILL 0, 0, 2*BH_radius
      GCOL 7

      REM Draw a random number of elliptical orbits - scaled, rotated and perspectivized:
      num_orbits = 5 + RND(20)

      FOR orbit = 1 TO num_orbits
 
        angle = RND(360) : REM ellipse angle
 
        ellipse_w = Win_w / (5 + 2*RND(1))
        ellipse_h = Win_h / (8 + 2*RND(1))
        dash_len = RND(5)
        dash_count = 0
        draw_flag = TRUE
        theta_step = 0.5 + 1.5 * RND(1)
        x_offs = ellipse_w/2 + 0.3 * ellipse_w
 
        x_scale = 0.8 + 0.4 * RND(1)
        y_scale = 0.8 + 0.4 * RND(1)
 
        FOR theta = 0 TO 359 STEP theta_step
   
          IF draw_flag THEN
     
            REM Calculate point along ellipse:
            x = x_scale * (x_offs + ellipse_w * COS(theta * Degs))
            y = y_scale * ellipse_h * SIN(theta * Degs)
     
            REM Rotate the point about the Z-axis (i.e. in the X-Y plane):
            x2 = x * COS(angle * Degs) - y * SIN(angle * Degs)
            y2 = x * SIN(angle * Degs) + y * COS(angle * Degs)
     
            REM Now rotate it about the X-axis (i.e. in the Y-Z plane):
            x3 = x2
            y3 = y2 * COS(View_angle * Degs)
            z3 = y2 * SIN(View_angle * Degs)
     
            plot_x = Win_w*x3 / (z3 + Win_w/2)
            plot_y = Win_w*y3 / (z3 + Win_w/2)
     
            col = POINT(plot_x, plot_y) : REM get background pixel colour
     
            IF col = 0 OR z3 < 0 THEN
              k = 1 - (z3 + Win_w/2) / Win_w
              r = 1 + 6*k : REM circle radius
              i = 60 + 190*k : REM greyscale intensity
              COLOUR 7, i, i, i
              CIRCLE FILL plot_x, plot_y, 2*r
            ENDIF
     
          ENDIF
   
          IF dash_count > 0 THEN
            dash_count -= 1
          ELSE
            dash_count = dash_len
            draw_flag = NOT draw_flag
          ENDIF
   
        NEXT theta
      NEXT orbit

      *REFRESH ON
      ENDPROC

      DEF PROCdisplay_text( s$ )
      LOCAL size{}
      DIM size{cx%, cy%}
      ORIGIN Win_w, Win_h
      *FONT "IMPACT", 40
      COLOUR 2, 200+RND(55), 200+RND(55), 255
      GCOL 2
      SYS "GetTextExtentPoint32", @memhdc%, s$, LEN(s$), size{}
      VDU 5
      MOVE -size.cx%, -0.75*Win_h
      PRINT s$
      VDU 4
      *FONT
      ENDPROC

The program isn't at all physics-based, it just draws rotated & perspectivized ellipses. Also, the code is written with easy or easy-ish porting in mind; it's not usually how I write programs in BBC BASIC.

Screenshot:



YouTube video of the program running:

https://youtu.be/OtnUWN51I4E

I'm sure many SB guys here can massively improve on my effort!