HMG for Games

Moderator: Rathinagiri

Post Reply
User avatar
hmgchang
Posts: 273
Joined: Tue Aug 13, 2013 4:46 am
Location: Indonesia

HMG for Games

Post by hmgchang »

Hola Masters,
I tried to make a simple game with hmg,
but unfortunately using do while doesn't make it run.

Pls help and suggest any solution

Code: Select all

#include "hmg.ch"

#define ZPY 1
#define ZPX 2
#define ZPW 3
#define ZPH 4
#define ZPCOLOR 5
#define ZPLINEWIDTH 6
#define ZPSPEED 7

#define ZBY 1
#define ZBX 2
#define ZBW 3
#define ZBH 4
#define ZBFILLCOLOR 5
#define ZBLINECOLOR 6
#define ZBLINEWIDTH 7
#define ZBSPEEDX 8
#define ZBSPEEDY 9

FUNCTION Main()
  MEMVAR aPaddle, hDC, aCanvas, aWin, aBall, lPause
  PRIVATE hBitmap := 0, aPaddle, hDC, aCanvas, aWin, aBall, lPause := .F.
  aWin := { "winBricks"}
  DEFINE WINDOW winBricks ;
    AT 0, 0 ;
    WIDTH 800;
    HEIGHT 600 ;
    TITLE "Bricks Game" ;
    Main ;
    ON INIT winBricks_OnInit();
    ON PAINT winBricks_OnPaint() ;
    ON RELEASE winBricks_OnRelease()
    
    ON KEY LEFT ACTION winBricks_OnKey_Action( "LEFT")
    ON KEY RIGHT ACTION winBricks_OnKey_Action( "RIGHT")
    ON KEY ESCAPE ACTION DoPause()
    
    
    @10, 50 BUTTON Button_1 CAPTION "start" ACTION winBricks_Button_1_Action()
  END WINDOW
  CENTER WINDOW winBricks 
  ACTIVATE WINDOW winBricks  
  RETURN NIL
  // 
    
FUNCTION winBricks_OnInit()
  hBitmap := BT_BitmapLoadFile ("Shotokan.png")
  RETURN NIL
  
FUNCTION winBricks_OnPaint()
  LOCAL BTstruct
  MEMVAR aPaddle, hDC, aCanvas, aWin, aBall
  aCanvas := { BT_ClientAreaWidth( aWin[ 1]), BT_ClientAreaHeight( aWin[ 1])}
  aPaddle := { 0, 0, 100, 25, BLUE, 1, 10}
  aPaddle[ ZPX] := ( aCanvas[ 1] - aPaddle[ ZPW]) / 2 
  aPaddle[ ZPY] := aCanvas[ 2] - aPaddle[ ZPH] - 20
  hDc := BT_CreateDC( "winBricks", BT_HDC_INVALIDCLIENTAREA, @BTstruct)
  DrawPaddle()
  // BT_DrawBitmap( hDC, 10, 10, 20, 20, BT_STRETCH, hBitmap)
  aBall := { 0, 0, 25, 25, RED, RED, 1, 10, 10}
  DrawBall()
  // BT_DeleteDC( BTstruct)  
  RETURN NIL
  
FUNCTION winBricks_OnRelease()
    BT_BitmapRelease( hBitmap)
  RETURN NIL  
  
// ------------
FUNCTION winBricks_Button_1_Action()
  MEMVAR lPause
  aClearColor := BT_DrawGetPixel( hDC, aBall[ ZBY] + 2, aBall[ ZBX])
  DO WHILE .NOT. lPause
    //
    DO CASE
      CASE aBall[ ZBY] + aBall[ ZBH] > aCanvas[ 2]  .OR. aBall[ ZBY] < 0
        aBall[ ZBSPEEDY] *= -1
      CASE aBall[ ZBX] + aBall[ ZBW] > aCanvas[ 1]  .OR. aBall[ ZBX] < 0
        aBall[ ZBSPEEDX] *= -1
    ENDCASE
    aBall[ ZBFILLCOLOR] := aBall[ ZBLINECOLOR] := aClearColor
    DrawBall()
    aBall[ ZBX] += aBall[ ZBSPEEDX]
    aBall[ ZBY] += aBall[ ZBSPEEDY]
    aBall[ ZBFILLCOLOR] := aBall[ ZBLINECOLOR] := RED
    DrawBall()
    INKEY( .05)
  ENDDO
  msgDebug( "Stop")
  RETURN NIL  
  
FUNCTION DoPause()
  MEMVAR lPause
  lpause := .T.
  msgDebug( "Pause")
  RETURN NIL  
  
// -------------
FUNCTION winBricks_OnKey_Action( cDirection)
  MEMVAR aPaddle, hDC
  aClearColor := BT_DrawGetPixel( hDC, aPaddle[ ZPY] - 2, aPaddle[ ZPX])
  IF cDirection == "LEFT"
    IF aPaddle[ ZPX] - aPaddle[ ZPSPEED] > 0
      aPaddle[ ZPCOLOR] := aClearColor
      DrawPaddle()
      aPaddle[ ZPX] -= aPaddle[ ZPSPEED]
      aPaddle[ ZPCOLOR] := BLUE
      DrawPaddle()
    ENDIF  
  ELSE // RIGHT
    IF aPaddle[ ZPX] + aPaddle[ ZPW] + aPaddle[ ZPSPEED] < aCanvas[ 1]
      aPaddle[ ZPCOLOR] := aClearColor
      DrawPaddle()
      aPaddle[ ZPX] += aPaddle[ ZPSPEED]
      aPaddle[ ZPCOLOR] := BLUE
      DrawPaddle()
    ENDIF  
  ENDIF
  RETURN NIL  
  

// ---------
FUNCTION DrawPaddle()
  MEMVAR aPaddle, hDC
  BT_DrawFillRectangle( hDC, aPaddle[ ZPY], aPaddle[ ZPX], aPaddle[ ZPW], aPaddle[ ZPH], ;
                        aPaddle[ ZPCOLOR], aPaddle[ ZPLINEWIDTH]) 
  RETURN NIL  
  
FUNCTION DrawBall()
  MEMVAR aBall, hDC  
  BT_DrawFillEllipse( hDC, aBall[ ZBY], aBall[ ZBX], aBall[ ZBW], aBall[ ZBH], ;
                        aBall[ ZBFILLCOLOR], aBall[ ZBLINECOLOR], aBall[ ZBLINEWIDTH])

Thks n Rgds
Chang
Just Hmg It !
User avatar
mol
Posts: 3723
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Contact:

Re: HMG for Games

Post by mol »

Try to add DO EVENTS at the end of the loop
Last edited by mol on Sat Mar 27, 2021 7:42 am, edited 1 time in total.
User avatar
hmgchang
Posts: 273
Joined: Tue Aug 13, 2013 4:46 am
Location: Indonesia

Re: HMG for Games

Post by hmgchang »

Hola Mol ....
+1
Thks Mol.... it works...


:lol:
Just Hmg It !
Post Reply