December 01, 2024, 10:20:36 AM

News:

IWBasic runs in Windows 11!


2D Program Crashes.

Started by GWS, March 18, 2011, 10:01:59 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

GWS

This one (from ZeroDog I think), works in earlier versions, but now crashes after a second or two ..


$main
AUTODEFINE "off"
'
' 2D directx application to be compiled as WINDOW target.
' Display several sprites with Text (spriteID) on each and every sprites
' Added collision betwen sprites + dragging objects with mouse
' Changed to a kind of Catch'em all game :-)

' 06/01/2010

'Set up timer
'When called, this returns the number of milliseconds since the computer was turned on
DECLARE "kernel32",GetTickCount(),INT

INT fps,scrWidth,scrHeight,run,totalSprites,temp,spriteIndex
INT fullscreen,spritehit,collidedsprite

INT lastscreenupdatetime
FLOAT timesincelastscreenupdate,timesincelaunch,tTime
INT targetXpos,targetYpos,dragging

DEF myWin as WINDOW
TYPE object
DEF xpos:float
DEF ypos:float
DEF width:int
DEF height:int
DEF xvel:int
DEF yvel:int
DEF speed:float
DEF spriteID:int
DEF spriteColor:uint
ENDTYPE

POINTER mousepointer
POINTER newSprite[21] : REM if changed then change ball[21] and totalSprites also
totalSprites = 21
Def ball[21] as object
Def item[21] as object
DEF myMouse as object

INT maxColors = 8
DEF sprcol[8]:uint
DEF red,green,blue,brown,black,yellow,pink,gray as uint

' Set main colors
red = rgb(255,0,0)
green = rgb(0,255,0)
blue = rgb(0,0,255)
brown = rgb(125,85,30)
black = rgb(0,0,0)
yellow = rgb(240,240,30)
pink = rgb(255,135,245)
gray = rgb(150,150,150)

sprcol = red,green,blue,brown,black,yellow,pink,gray

fps = 0
scrWidth = 800
scrHeight = 600
run = 1

'Set up the Direct X screen
IF CREATESCREEN(scrWidth,scrHeight,16)<0
MESSAGEBOX 0,"This program requires DirectX 7 or higher","Error"
END
ENDIF
SETCURSOR frontbuffer,1
DRAWMODE backbuffer,@transparent
'SETFONT backbuffer,"arial",30,800
FRONTPEN backbuffer,rgb(255,255,255)
GOSUB mySprites()

lastscreenupdatetime=GetTickCount()
tTime=GetTickCount()
'MAIN LOOP
/******************************************************************************/
DO
timesincelastscreenupdate=GetTickCount()-lastscreenupdatetime
IF timesincelastscreenupdate>1
'At least 2mS since last screen update
'timesincelastscreenupdate will be used as a multiplier to sprite motion
'to make things run at the same speed on different PCs
lastscreenupdatetime=GetTickCount()
timesincelaunch=((lastscreenupdatetime-tTime)/1000)
RenderSprites()
CheckMousePos()
PrintText()
fps = FLIP 1
   ENDIF
UNTIL KEYDOWN(1) or run = 0
EndProgram()

/******************************************************************************/

SUB mySprites()
INT iNum
FOR spriteIndex = 0 to totalSprites-1
newSprite[spriteIndex] = CREATESPRITE(50,50,1)
IF newSprite[spriteIndex]<>null
iNum = int(rnd(maxColors))
ball[spriteIndex].width=50
ball[spriteIndex].height=50
ball[spriteIndex].xpos = rnd(ScrWidth-50) : ' 50 => spriteWidth
ball[spriteIndex].ypos = rnd(ScrHeight-50): ' 50 => spriteHeight
ball[spriteIndex].spriteID=spriteIndex
ball[spriteIndex].spriteColor=sprcol[iNum]
ball[spriteIndex].xvel = rnd(2)-1
ball[spriteIndex].yvel = rnd(2)-1
ball[spriteIndex].speed = rnd(2)+1f
/**********************************************/
SPRITETOBUFFER(newSprite[spriteIndex])
FILLSCREEN RGB(128,128,128), SpriteBuffer
' Draw the shape of our main sprite (a simple colored circle) :-)
CIRCLE SpriteBuffer, 25,25,25, RGB(50,30,10), ball[spriteIndex].spriteColor
'Set the sprites drawing mode to transparent and specify a mask color
SPRITEDRAWMODE newSprite[spriteIndex],@TRANS
SPRITEMASKCOLOR newSprite[spriteIndex],RGB(128,128,128)
ELSE             
MESSAGEBOX 0,"Could not create sprites!","Error"
run=0
ENDIF
NEXT spriteIndex
mymousepointer()
RETURN
ENDSUB

/******************************************************************************/

SUB mymousepointer()
mousepointer=createsprite(1,1,1)
IF mousepointer<>NULL
SetSpriteType mousepointer, 350
SPRITETOBUFFER(mousepointer)
FILLSCREEN RGB(128,128,128), SpriteBuffer
'Set the sprites drawing mode to transparent and specify a mask color
'SPRITEDRAWMODE mousepointer,@TRANS
'SPRITEMASKCOLOR mousepointer,RGB(128,128,128)
ELSE
MESSAGEBOX 0,"Could not create mousepointer sprite!","Error"
ENDIF
RETURN
ENDSUB

/******************************************************************************/

SUB RenderSprites()
FILLSCREEN RGB(0, 0, 0)  : ' Make sure the screen cleans
FOR spriteIndex = 0 to totalSprites-1
DRAWSPRITEXY newSprite[spriteIndex],ball[spriteIndex].xpos,ball[spriteIndex].ypos
WRITETEXT ball[spriteIndex].xpos+15,ball[spriteIndex].ypos, str$(ball[spriteIndex].spriteID)
'WRITETEXT ball[spriteIndex].xpos+15,ball[spriteIndex].ypos+20, str$(ball[spriteIndex].speed)
MoveSprites()
next spriteIndex
DRAWSPRITEXY mousepointer, myMouse.xpos, myMouse.ypos
RETURN
ENDSUB

/******************************************************************************/

SUB MoveSprites()
ball[spriteIndex].xpos = ball[spriteIndex].xpos + (ball[spriteIndex].xvel*ball[spriteIndex].speed)
ball[spriteIndex].ypos = ball[spriteIndex].ypos + (ball[spriteIndex].yvel*ball[spriteIndex].speed)

IF ball[spriteIndex].xpos <= 0
ball[spriteIndex].xvel = 1
ENDIF
IF ball[spriteIndex].xpos >= scrWidth-ball[spriteIndex].width
ball[spriteIndex].xvel = -1
ENDIF

IF ball[spriteIndex].ypos <= 0
ball[spriteIndex].yvel = 1
ENDIF
IF ball[spriteIndex].ypos >= scrHeight-ball[spriteIndex].height
ball[spriteIndex].yvel = -1
ENDIF
CheckSpritecollision()
RETURN
ENDSUB

/******************************************************************************/

SUB PrintText()
WriteText 0,0,"FPS: " + str$(fps)
WriteText 0,15,"time since launched: " + str$(timesincelaunch)
WriteText 0,30,"time since last screen update: " + str$(timesincelastscreenupdate)
WriteText 0,45,"myMouse.xpos: " +str$(myMouse.xpos)
WriteText 0,60,"myMouse.ypos: " +str$(myMouse.ypos)
WriteText 480, 790, "Press escape key to close or use menu to quit"
RETURN
ENDSUB

/******************************************************************************/

SUB CheckMousePos()
myMouse.xpos=nMX()
myMouse.ypos=nMY()
CheckMousecollision()
RETURN
ENDSUB

/******************************************************************************/

SUB CheckMousecollision()
FOR temp=0 TO totalSprites-1
'spritehit=SpriteCollidedEx(mousepointer, myMouse.xpos,myMouse.ypos,1,newSprite[temp],ball[temp].xpos,ball[temp].ypos,1)
spritehit=SpriteCollided(mousepointer, newSprite[temp])
IF spritehit<>0
WriteText 0,75,"spritehit: "+str$(spritehit)
collidedsprite=temp
WriteText myMouse.xpos,myMouse.ypos,"Mouse is over sprite: "+str$(collidedsprite)
IF MOUSEDOWN(1)
'Left Mouse button was pressed
GetSpritePosition()
DragSprite()
ENDIF
ENDIF
NEXT temp
RETURN
ENDSUB

/******************************************************************************/

SUB DragSprite()
SetSpritePosition()
RETURN
ENDSUB

/******************************************************************************/

SUB CheckSpritecollision()
INT temp2
FOR temp=0 TO totalSprites-1
FOR temp2=temp+1 TO totalSprites-1
spritehit=SpriteCollidedEx(newSprite[temp],ball[temp].xpos,ball[temp].ypos,1,newSprite[temp2],ball[temp2].xpos,ball[temp2].ypos,1)
IF spritehit<>0
WriteText 0,75,"spritehit: "+str$(spritehit)
WriteText 400,300,"Sprites Collision detected!"

'Sprites collided => If sprites have the same color then they go through otherwise they bump into each other.
/****************************************************************/
IF ball[temp].spriteColor <> ball[temp2].spriteColor
IF ball[temp].xpos > ball[temp2].xpos
ball[temp].xvel = 1
ball[temp2].xvel = -1
ENDIF
IF ball[temp].xpos < ball[temp2].xpos
ball[temp].xvel = -1
ball[temp2].xvel = 1
ENDIF
IF ball[temp].ypos > ball[temp2].ypos
ball[temp].yvel = 1
ball[temp2].yvel = -1
ENDIF
IF ball[temp].ypos < ball[temp2].ypos
ball[temp].yvel = -1
ball[temp2].yvel = 1
ENDIF
ENDIF
/****************************************************************/
ENDIF
NEXT temp2
NEXT temp
RETURN
ENDSUB

/******************************************************************************/

SUB GetSpritePosition()
item[collidedsprite].xpos = ball[collidedsprite].xpos
item[collidedsprite].ypos = ball[collidedsprite].ypos
IF dragging = 0
targetXpos = myMouse.xpos - ball[collidedsprite].xpos
targetYpos = myMouse.ypos - ball[collidedsprite].ypos
ENDIF
WriteText Mymouse.xpos,Mymouse.ypos+15,"item xpos: "+str$(ball[collidedsprite].xpos)
WriteText Mymouse.xpos,Mymouse.ypos+30,"item ypos: "+str$(ball[collidedsprite].ypos)
RETURN
ENDSUB

/******************************************************************************/

SUB SetSpritePosition()
dragging=TRUE                       
ball[collidedsprite].xpos = myMouse.xpos - targetXpos
ball[collidedsprite].ypos = myMouse.ypos - targetYpos
dragging=MOUSEDOWN(1)
RETURN
ENDSUB

/******************************************************************************/

Sub nMX(),uint
'Return the mouse x pos offset to window relative
uint mx,x1,y1,w1,h1
if fullscreen=0
GetSize myWin,x1,y1,w1,h1
'mx=MouseX()-(x1+(scrWidth/2))
mx=MouseX() - x1
else
mx=MouseX()
EndIf
Return mx
EndSub

Sub nMY(),uint
'Return the mouse y pos offset to window relative
uint my,x1,y1,w1,h1
if fullscreen=0
GetSize myWin,x1,y1,w1,h1
x1=scrWidth/2
'my=MouseY()-(y1+(scrHeight-x1))
my=MouseY() - y1
else
my=MouseY()
EndIf
Return my
EndSub

/******************************************************************************/

SUB EndProgram()
FREESPRITE mousepointer
FOR spriteIndex = 0 to totalSprites-1
IF newSprite[spriteIndex] THEN FREESPRITE newSprite[spriteIndex]
NEXT spriteIndex
CLOSESCREEN
END
RETURN
ENDSUB



all the best, :)

Graham

Tomorrow may be too late ..

pistol350

Hello Graham!
It was from me actually.
Regards,

Peter B.

sapero

March 18, 2011, 11:21:29 AM #2 Last Edit: March 18, 2011, 11:23:11 AM by sapero
Graham, if you change frame number in SpriteCollidedEx from 1 to 0, it will no more crash.
QuoteImage frames for sprites are zero based
QuotenewSprite[spriteIndex] = CreateSprite(50,50,1) ' you have one frame per sprite

GWS

Yep, that's fine .. thanks Sapero ..  ;D

Pete> my memory fails me sometimes .. can't be old age can it ?  ::)

all the best, :)

Graham
Tomorrow may be too late ..

LarryMc

Quote from: GWS on March 18, 2011, 12:46:55 PM
Pete> my memory fails me sometimes .. can't be old age can it ?  ::)

Graham
I think that our memory is always PERFECT.  It's the rest of the world that keeps changing the facts!!

That's my story and I'm sticking to it......if I can remember ;)

LarryMc
LarryMc
Larry McCaughn :)
Author of IWB+, Custom Button Designer library, Custom Chart Designer library, Snippet Manager, IWGrid control library, LM_Image control library

aurelCB

Hey i see this first time,cool program... :)

GWS

Tomorrow may be too late ..

Blue Steel

Quote
I think that our memory is always PERFECT.  It's the rest of the world that keeps changing the facts!!

That's my story and I'm sticking to it......if I can remember Wink

LarryMc

True , so darn true....
  http://www.codingmonkeys.com
Covers many languages including Aurora , IWBasicEbasic (Ebasic, IBasic) , Creative Basic