2000-05-17 17:59

' Target practise w/DirectX for Rapid-Q by William Yu
' Move using arrow keys, to shoot, press SPACEBAR

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

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

     CONST ScreenX = 400
     CONST ScreenY = 300
     CONST MaxStars = 150        '' 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 = 10
     DXTimer.OnTimer = DXTimerExpired
     DIM Stars AS StarType
     DIM MyShipX AS INTEGER
     MyShipX = 50
     DIM EnemyShipX AS INTEGER
     EnemyShipX = ScreenX + 45
     DIM EnemyShipY AS INTEGER
     EnemyShipY = 20
     DIM Shoot AS INTEGER, ShootX AS INTEGER, ShootY AS INTEGER
     Shoot = False
     DIM Hit AS INTEGER, HitCount AS INTEGER
     Hit = False

     InitStars

     CREATE Form AS QFORM
      Center
      CAPTION = "DirectX Target Practise"
      ClientWidth = ScreenX
      ClientHeight = ScreenY
  'BorderStyle = bsNone           '' Setup fullscreen
      CREATE DXScreen AS QDXSCREEN
       Init(ScreenX, ScreenY)
       Align = alClient
    'FullScreen = True            '' Fullscreen mode
       Cursor = crNone              '' Hide Mouse
       CREATE DXImageList AS QDXIMAGELIST
        LoadFromFile("SHIPS.DXG")
       END CREATE
      END CREATE
      OnKeyDown = KeyDown
      SHOWMODAL
     END CREATE

     SUB KeyDown (Key AS BYTE, Shift AS BYTE)
      SELECT CASE Key
      CASE 27
       Form.CLOSE
      CASE 39
       MyShipX = MyShipX + 4
      CASE 37
       MyShipX = MyShipX - 4
      CASE IS = 32 AND Shoot = False
       Shoot = True
       ShootX = MyShipX + 20
       ShootY = ScreenY - 58
      END SELECT
     END SUB


     SUB InitStars
      DIM I AS INTEGER

      RANDOMIZE TIMER

      FOR I = 1 TO MaxStars
       Stars.X(I) = RND(ScreenX)
       Stars.Y(I) = RND(ScreenY)
       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.Pixel(Stars.X(I),Stars.Y(I)) = clWhite
        Stars.Y(I) = Stars.Y(I) + 3
       CASE 1
        DXScreen.Pixel(Stars.X(I),Stars.Y(I)) = &HAAAAAA
        Stars.Y(I) = Stars.Y(I) + 2
       CASE ELSE
        DXScreen.Pixel(Stars.X(I),Stars.Y(I)) = &H555555
        Stars.Y(I) = Stars.Y(I) + 1
       END SELECT
       IF Stars.Y(I) > ScreenY THEN
        Stars.Y(I) = -1
        Stars.X(I) = RND(ScreenX)
       END IF
      NEXT I
      DXScreen.TextOut(10,10,"FPS: "+STR$(DXTimer.FrameRate), clWhite, -1)
      IF Hit THEN
       DXScreen.Circle(ShootX-HitCount/2,ShootY-20,ShootX+4+HitCount/2,ShootY-20+4+HitCount,&H2090FF,&H2090FF)
       IF HitCount = 0 THEN
        Hit = False
       ELSE
        HitCount = HitCount - 2
       END IF
      ELSE
       IF Shoot THEN
        SELECT CASE ShootX
        CASE EnemyShipX TO EnemyShipX+45
         IF ShootY > EnemyShipY AND ShootY < EnemyShipY+45 THEN
          EnemyShipX = ScreenX + 45
          EnemyShipY = EnemyShipY + 45
          Shoot = False
          Hit = True
          HitCount = 40
         END IF
        END SELECT
        DXScreen.Circle(ShootX,ShootY,ShootX+4,ShootY+4,&H2090FF,&H2090FF)
        IF ShootY < -4 THEN
         Shoot = False
        ELSE
         ShootY = ShootY - 4
        END IF
       END IF
       EnemyShipX = EnemyShipX - 2
       DXImageList.Draw(1, EnemyShipX, EnemyShipY, 0)
       IF EnemyShipX < -45 THEN
        EnemyShipX = ScreenX + 45
        EnemyShipY = EnemyShipY + 45
       END IF
      END IF
      DXImageList.Draw(0, MyShipX, ScreenY - 55, 0)
      DXScreen.Flip
     END SUB

2000-05-17 17:59