'===========================================================================
' Subject: STARFIELD SIMULATION              Date: 10-19-96 (10:23)       
' Author:  Ben Kaashoek                      Code: QB, QBasic, PDS        
' Origin:  robertk@worldaccess.nl          Packet: GRAPHICS.ABC
'===========================================================================
'Check out the difference in speed when you turn DEFINT A-Z off !!!!
DEFINT A-Z                              'Use integers as default for speed.

'The starfield code itself is not mine.
'When I got it however, it needed some speeding up. First of all I added the
'DEFINT A-Z statement. (I use this in all my programs.)
'I also found some unnessesarry statement's and removed those too.
'Then. A friend came with a rather interresting suggestion.
'"Hey, why not add something like a comet?", "Ok, I'll try it."
'I was a little suprised when it actually worked.
'The comet code probably needs some fine-tuning (it's only in there for a day
'or so. But I'm sure somebody can find it usefull.
'Oh, almost forgot. Many thanks to the original author. I hope you recognize
'YOUR piece of the work.
'                                           BEN.

TYPE StarData
 xPos AS INTEGER                        'X position of a star.
 yPos AS INTEGER                        'Y position of a star.
 Speed AS INTEGER                       'Speed of star (Parallax effect).
 Colour AS INTEGER                      'Colour of a star.
END TYPE

TYPE CometData
 xPos AS INTEGER                        'X position of a comet.
 yPos AS INTEGER                        'Y position of a comet.
 xSpeed AS INTEGER                      'Speed of comet in X direction.
 ySpeed AS INTEGER                      'Speed of comet in Y direction.
 Visible AS INTEGER                     'Is comet visible.
 TailSize AS INTEGER                    'Length of tail in pixels.
END TYPE

CONST False = 0: True = NOT False       'Boolean constants.

'--- Program settings. ------------------------------------------------------
Stars = 100                             'Number of stars to plot ?
                                        'Adjust if starfield gets "animated"
                                        '286/20 => 100 and P100 => 600.
UseRetrace = True                       'Use retrace in VGA modes ?
CometSeed = 100                         'Create comet every ... frames.
CometHeadColor = 14                     'Colour of the comet's head.
CometTailColor = 4                      'Colour of the comet's tail.
ScrMode = 12                            'Which screenmode to use ?
'--- End program settings. --------------------------------------------------

Comets = 1                              'Number of comet's (KEEP ON 1 !!!)
OPTION BASE 1                           'Start array's with element 1.
REDIM Comet(Comets) AS CometData        'Create array for comet's
REDIM StarField(Stars) AS StarData      'Create array's for stars.
REDIM OldStarField(Stars) AS StarData

SELECT CASE ScrMode                     'Determine screen boundaries.
 CASE 0
  PRINT "Sorry, graphic modes only! Maybe next time."
  END                                   'See ya later.
 CASE 7                                 'EGA 320x200
  HorLimit = 320
  VerLimit = 200
  UseRetrace = False                    'Disable using retrace as delay.
 CASE 8                                 'EGA 640x200
  HorLimit = 640
  VerLimit = 200
  UseRetrace = False                    'Disable using retrace as delay.
 CASE 9                                 'EGA 640x350
  HorLimit = 640
  VerLimit = 350
  UseRetrace = False                    'Disable using retrace as delay.
 CASE 12                                'VGA 640x480
  HorLimit = 640
  VerLimit = 480
 CASE 13                                'VGA 320x200
  HorLimit = 320
  VerLimit = 200
 CASE ELSE                              'Anything that's NOT tested.
  PRINT "Unsupported videomode."
  END                                   'See ya later.
END SELECT

'Initialize program.
SCREEN ScrMode: RANDOMIZE (TIMER)

'Fill array with random stars...
FOR I = 1 TO Stars                      'Fill 'er up.
 StarField(I).xPos = INT(RND * HorLimit + 1)
 StarField(I).yPos = INT(RND * VerLimit + 1)
 StarField(I).Speed = INT(RND * 8 + 1)
 OldStarField(I).xPos = INT(RND * HorLimit + 1)
 OldStarField(I).yPos = INT(RND * VerLimit + 1)
 OldStarField(I).Speed = INT(RND * 8 + 1)
 SELECT CASE OldStarField(I).Speed
  CASE 0 TO 3: OldStarField(I).Colour = 8
  CASE 4 TO 7: OldStarField(I).Colour = 7
  CASE 8: OldStarField(I).Colour = 15
 END SELECT
 SELECT CASE StarField(I).Speed
  CASE 0 TO 3: StarField(I).Colour = 8
  CASE 4 TO 7: StarField(I).Colour = 7
  CASE 8: StarField(I).Colour = 15
 END SELECT
NEXT I

'Fill array with random comet...
Comet(1).xPos = INT(RND * HorLimit + 1) 'Pick a random X position.
Comet(1).yPos = 1                       'Always start on the top line.
Comet(1).xSpeed = INT(RND * 4 + 2)
Comet(1).ySpeed = INT(RND * 3 + 2)
'50% of the time the direction of the comet will be altered.
IF INT(RND * 2) = 0 THEN Comet(1).xSpeed = -Comet(1).xSpeed
Comet(1).TailSize = INT(RND * 20 + 5)

DO
 IF INT(RND * CometSeed) = 1 AND NOT CometStart THEN CometStart = -1
 FOR I = 1 TO Stars                     'Replot all the stars.
  PSET (StarField(I).xPos, StarField(I).yPos), 0
  StarField(I).xPos = StarField(I).xPos - OldStarField(I).Speed
 
  IF StarField(I).xPos <= 1 THEN        'Recalculate if star hits lower limit.
   StarField(I).xPos = HorLimit
   StarField(I).yPos = INT(RND * VerLimit + 1)    'Give star new y position.
  END IF
 
  'Enable the lines below if you plan on having a left -> right effect.
  'IF OldStarField(i).xPos >= HorLimit THEN 'Recalculate if star hits higher limit.
  ' OldStarField(i).xPos = 1
  ' OldStarField(i).yPos = INT(RND * VerLimit + 1) 'Give star new y position.
  'END IF
 
  'Put the star on screen at it's modified position.
  PSET (StarField(I).xPos, StarField(I).yPos), StarField(I).Colour
 NEXT I

 'Replot comet (This part is needed when the head is NOT off the screen.)
 IF CometStart AND NOT CleanTail THEN
  PSET (Comet(1).xPos, Comet(1).yPos), CometTailColor
  Comet(1).xPos = INT(Comet(1).xPos + Comet(1).xSpeed)
  Comet(1).yPos = INT(Comet(1).yPos + Comet(1).ySpeed)
  IF Comet(1).xPos >= HorLimit OR Comet(1).xPos <= 1 OR Comet(1).yPos >= VerLimit THEN
   CleanTail = True                     'Start removing the tail.
  ELSE
   PSET (Comet(1).xPos, Comet(1).yPos), CometHeadColor
   TailxPos = Comet(1).xPos - INT(Comet(1).TailSize * Comet(1).xSpeed)
   TailyPos = Comet(1).yPos - INT(Comet(1).TailSize * Comet(1).ySpeed)
   IF TailxPos >= 1 AND TailyPos >= 1 THEN PSET (TailxPos, TailyPos), 0
  END IF
 END IF
 'Remove the rest of the tail if the head is moved off the screen.
 IF CleanTail THEN
  TailxPos = INT(Comet(1).xPos - Comet(1).TailSize * Comet(1).xSpeed)
  TailyPos = INT(Comet(1).yPos - Comet(1).TailSize * Comet(1).ySpeed)
  Comet(1).TailSize = Comet(1).TailSize - 1
  IF TailxPos >= 1 AND TailyPos >= 1 THEN PSET (TailxPos, TailyPos), 0
 
  'Create a new comet.
  IF TailxPos >= HorLimit OR TailxPos <= 1 OR TailyPos >= VerLimit THEN
   Comet(1).xPos = INT(RND * HorLimit + 1) 'Pick a random X position.
   Comet(1).yPos = 1                    'Always start on the top line.
   Comet(1).xSpeed = INT(RND * 4 + 2)
   Comet(1).ySpeed = INT(RND * 3 + 2)
   IF INT(RND * 2) = 0 THEN Comet(1).xSpeed = -Comet(1).xSpeed
   Comet(1).TailSize = INT(RND * 20 + 5)
   CometStart = False
   CleanTail = False
  END IF
 END IF

 'Using the Vertical Retrace (VGA+ only) keeps the program from being
 'affected by the number of stars to print. If you use 100 or 500 stars on
 'a P100 doesn't matter. The VR will keep everything going at the same speed.
 '(Within certain boundaries). This method works great when used on anything
 'faster then my old 286 :-). I think it has something to do with the
 'frequency of the monitor. SVGA's have a much smoother parallax effect.

 IF UseRetrace THEN WAIT &H3DA, 8    'Wait for VGA vertical retrace.

 'Put your nice scrolly or something over here.
 'LOCATE 14, 30: PRINT "Starfield Simulation..."
LOOP UNTIL INKEY$ <> ""