' DirectX Star Field for Rapid-Q by William Yu

$APPTYPE GUI
$TYPECHECK ON
$INCLUDE "RAPIDQ.INC"

DECLARE SUB DXTimerExpired
DECLARE SUB InitStars
DECLARE SUB KeyDown (Key AS BYTE, Shift AS BYTE)

CONST MaxStars = 500        '' Depending on your system, adjust as needed.

TYPE StarType
  X(MaxStars) AS INTEGER
  Y(MaxStars) AS INTEGER
  Z(MaxStars) AS INTEGER
END TYPE

DIM DXTimer AS QDXTimer
    DXTimer.Enabled = True
    DXTimer.Interval = 0
    DXTimer.OnTimer = DXTimerExpired
DIM Stars AS StarType

InitStars

SUB WndProc
END SUB

CREATE Form AS QForm
  Center
  Caption = "DirectX Star Field"
  ClientWidth = 640
  ClientHeight = 480
  'BorderStyle = bsNone           '' Setup fullscreen
  CREATE DXScreen AS QDXScreen
    Init(640, 480)
    BitCount = 16
    Align = alClient
    'FullScreen = True            '' Fullscreen mode
  END CREATE
  OnKeyDown = KeyDown
  WndProc = WndProc
  ShowModal
END CREATE


SUB KeyDown (Key AS BYTE, Shift AS BYTE)
  IF Key = 27 THEN
    Form.Close
  END IF
END SUB


SUB InitStars
  DIM I AS INTEGER

  RANDOMIZE TIMER

  FOR I = 1 TO MaxStars
    Stars.X(I) = RND(640)
    Stars.Y(I) = RND(480)
    Stars.Z(I) = RND(3)
  NEXT I
END SUB

SUB DXTimerExpired
  DIM I AS INTEGER

  DXScreen.Fill(0)
  FOR I = 1 TO MaxStars
    SELECT CASE Stars.Z(I)
      CASE 0
        'DXScreen.Circle(Stars.X(I),Stars.Y(I),Stars.X(I)+2,Stars.Y(I)+2,clWhite,clWhite)
        DXScreen.Pixel(Stars.X(I),Stars.Y(I)) = clWhite
        'DXScreen.Pset(Stars.X(I),Stars.Y(I), clWhite)
        Stars.Y(I) = Stars.Y(I) + 3
      CASE 1 
        'DXScreen.Circle(Stars.X(I),Stars.Y(I),Stars.X(I)+2,Stars.Y(I)+2,&HAAAAAA,&HAAAAAA)
        DXScreen.Pixel(Stars.X(I),Stars.Y(I)) = &HAAAAAA
        'DXScreen.Pset(Stars.X(I),Stars.Y(I),&HAAAAAA)
        Stars.Y(I) = Stars.Y(I) + 2
      CASE ELSE
        'DXScreen.Circle(Stars.X(I),Stars.Y(I),Stars.X(I)+2,Stars.Y(I)+2,&H777777,&H777777)
        DXScreen.Pixel(Stars.X(I),Stars.Y(I)) = &H777777
        'DXScreen.Pset(Stars.X(I),Stars.Y(I), &H777777)
        Stars.Y(I) = Stars.Y(I) + 1
    END SELECT
    IF Stars.Y(I) > 480 THEN
      Stars.Y(I) = -1
      Stars.X(I) = RND(640)
    END IF
  NEXT
  DXScreen.TextOut(10,10,"FPS: "+STR$(DXTimer.FrameRate), clWhite, -1)
  DXScreen.Flip
END SUB