PDA

View Full Version : start of an image covering game "prometheus" (alpha 1)



largo_winch
02-03-2013, 16:39
hello. here's my start point from my work-in-progress game "prometheus". first alpha issue shows that the computer do the mainly part (robot) for randomnessly spreading the image over canvas scene. but my idea is that the user should get this task of searching right place for covering same picture one over another one.

after start you can take the "only mouse over" button (or any other button) to start the game to activate randomness for the image. If you're wiping away the mouse into scene the animation will stop.

hoverbutton is only an idea for next updates they will come in a few days.

the example isn't perfect I know. but there's a lot of power and idea in it. if anybody has ideas for improvements I am glad to see it. therefore I have attached in zip folder *.tbasic example source code and *.exe file plus three images you need for this simple game.

there were a lot of work for me(!) you cannot see. my problem is that I haven't understand all things around gui canvas and animation, but I am learning by doing.

test example code for first issue you can find here:



' Empty GUI script created on 02-28-2013 13:16:16 by largo_winch (thinAir)


Uses "UI", "console"


Type RECT
nLeft As Long
nTop As Long
nRight As Long
nBottom As Long
End Type


Type POINTAPI
x As Long
y As Long
End Type

'Declare Function PtInRect Lib "USER32.DLL" Alias "PtInRect" ( _
' ByRef lprc As RECT _ ' __in CONST RECT *lprc

' , ByVal pt As POINT _ ' __in POINT pt
' ) As Long ' BOOL


Declare Function PtInRect Lib "USER32.DLL" Alias "PtInRect" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
Declare Function SetCapture Lib "USER32.DLL" Alias "SetCapture" (ByVal hWnd As DWord) As Long
Declare Function ReleaseCapture Lib "USER32.DLL" Alias "ReleaseCapture" () As Long
Declare Function GetCursorPos Lib "USER32.DLL" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
Declare Function GetWindowRect Lib "USER32.DLL" Alias "GetWindowRect" (ByVal hWnd As DWord, lpRect As RECT) As Long

' -- ID numbers of controls
Begin ControlID
%myCanvas
%myCanvas2
%refresh, %stops
%bClose
%tAnimationTimer
%txt_Result
%txt_Result2
%IDC_STATUSBAR
%bImage
%myDummyCanvas
%goal
End ControlID

' -- -----Create dialog here ----------->
Function TBMain() As Long
'--------------------------------------->
Local hDlg As Long, mygraf As Long, counts As Long,hHoverBtn_OK As Long

MsgBox 0,"work in progress: game how to cover an image over another one", _ '+ $CRLF +
%MB_OK Or %MB_ICONINFORMATION, _
"on RIGHT place, here only random robot modus"

Dialog New 0, "Prometheus Game Random Picking_01d",-1,-1, 400, 340,
%WS_POPUP | %WS_VISIBLE |
%WS_CLIPCHILDREN | %WS_CAPTION |
%WS_SYSMENU | %WS_MINIMIZEBOX, 0 To hDlg

Dim cx, cy As Long
Dialog Pixels hDlg, 500, 400 To Units cx, cy
Control Add Canvas, hDlg, %myCanvas, "", 5, 5, cx, cy
'Control Add Button, hDlg, %myDummyCanvas, "", 5, 5, cx, cy

Control Add Button, hDlg, %refresh, "refresh", 10+cx, 5, 50, 14, Call refreshProc
Control Add Button, hDlg, %goal, "hoverTest", 10+cx, 55, 55, 14, Call refreshProc
Control Add Button, hDlg, %stops, "stops", 10+cx, 25, 50, 14, Call stopProc
Control Add Button, hDlg, %bClose, "Close", 20, 280, 50, 14, Call bCloseProc
Control Add Button, hDlg, %bImage, "only_mouse_over", 120, 260, 120, 24
Control Add Textbox,hDlg, %txt_Result2, "" ,20, 260, 50, 14, %WS_TABSTOP


Control Handle hDlg, %bImage To hHoverBtn_OK

Canvas_Attach hDlg,%myCanvas
'Canvas_Attach hDlg,%myDummyCanvas

'Dialog Show Modal hDlg, Call dlgProc
Dialog Show Modeless hDlg, Call dlgProc
Do
Dialog DoEvents To Counts
Loop Until Counts = 0

End Function

' --- Callback for dialog ----------------------------------------------
CallBack Function dlgProc()
'----------------------------->
Static myvalue As Long,hHoverBtn_OK As Long,px,py As Long, vx As Long
Local sImageSmallwin As String = APP_SourcePath+"Prometh2aa.bmp"

Dim locX, locY As Long
Local mousePosition As POINTAPI
Local pt As POINTAPI
Local rc As RECT

Select Case CBMSG
'--------------------- >
Case %WM_INITDIALOG
'--------------------- >
' -- Put code to be executed after dialog creation here
Control Add Statusbar, CBHNDL, %IDC_STATUSBAR, "", , , , , %SBARS_SIZEGRIP
StatusBar_SetParts CBHNDL, %IDC_STATUSBAR, 300, 540, 700, -1


' -- Put code to be executed after dialog creation here
Dialog Set Timer CBHNDL, %tAnimationTimer, 50, %NULL 'the higher the value the slower

' -- Attach canvas for double buffer
Canvas_Attach(CBHNDL, %myCanvas, %TRUE) '%FALSE

'--------------------- >
Case %WM_TIMER
'--------------------- >
If CBCTL = %tAnimationTimer Then
DrawGraphics(CBHNDL, %myCanvas)
'DrawGraphics(CBHNDL, %myDummyCanvas)
End If
'--------------------- >
Case %WM_MOUSEMOVE
'----------------------------------------- //
Control Handle CBHNDL, %goal To hHoverBtn_OK '%buttonPic
SetCapture(CBHNDL)

GetCursorPos pt
GetWindowRect hHoverBtn_OK, rc

If ptInRect(rc,pt.x,pt.y) Then
'Control Set Text CBHNDL, %txt_Result2, "ButtonPIC" 'hDlg
Control Set Text CBHNDL, %txt_Result2, "ImagePIC" 'hDlg
'MsgBox 0, "mouse over button ok!"
MsgBox 0, "use only_mouse_over"
Else
Control Set Text CBHNDL, %txt_Result2, ""
End If

'ReleaseCapture ' ! desactive doesn't work for closing and using controls

Canvas_GetView pX, pY
MousePosition.x = LOINT(CBLPARAM) + pX
MousePosition.y = HIINT(CBLPARAM) + pY
StatusBar_SetText CBHNDL, %IDC_STATUSBAR, "Mouse position:" & Format$(MousePosition.x) & " " & "y=" & Format$(MousePosition.y), 1
Control Set Text CBHNDL, %txt_Result2, Str$(mousePosition.x)+", "+Str$(mousePosition.y)

ReleaseCapture

'----------------------------------------- //
Case %WM_LBUTTONDOWN 'when clicking left mouse button
' -- Get mouse position, convert it to canvas local coordinates
' Control Get Loc CBHNDL, %mycanvas To pX,pY 'locX, locY
' Win_GetCursorPos(mousePosition)
' Win_ScreenToClient(CBHNDL, mousePosition)
' mousePosition.x -= px 'locX
' mousePosition.y -= py 'locY
' Control Set Text CBHNDL, %txt_Result2, Str$(mousePosition.x)+", "+Str$(mousePosition.y)

Case %WM_DESTROY
Dialog Kill Timer CBHNDL, %tAnimationTimer
Dialog Set Timer CBHNDL, %tAnimationTimer, 150, %NULL


If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %goal Then
MsgBox 0,"goal!"
startgame()
Dialog Set Timer CBHNDL, %tAnimationTimer, 50, %NULL
End If
End If

Case %WM_CLOSE
End Select
End Function

' -- Callback for close button --------------------------- >
CallBack Function bCloseProc()

If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %BN_CLICKED Then
' -- Closes the dialog
Dialog End CBHNDL
End If
End If

End Function

' -- Refresh button --------------------------- >
CallBack Function refreshProc()

If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %BN_CLICKED Then

Dialog Kill Timer CBHNDL, %tAnimationTimer
Dialog Set Timer CBHNDL, %tAnimationTimer, 150, %NULL
End If
End If

End Function

' -- Stop button --------------------------- >
CallBack Function stopProc()

If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %BN_CLICKED Then

Dialog Kill Timer CBHNDL, %tAnimationTimer

End If
End If

End Function

'---------------------------------------------------------->
Sub DrawGraphics(ByVal hWnd As Long, ByVal lCanvas As Long)
'---------------------------------------------------------->
Local InDrawing As Long
Local z, v, r, g, b,x,y As Long
Local hDlg, mygraf As Long,targetCanvas As Long
Local oldx, oldy As Double
Local myExit As Long
Local t As Single
Dim tx As Double, ty As Double
Local sImageSmall As String = APP_SourcePath+"PromethPicker.bmp"
Local sImageSmallwin As String = APP_SourcePath+"Prometh2aa.bmp"
Local sImageBig As String = APP_SourcePath+"Prometh5.bmp"
'sImageSmall=str$(%myCanvas)
Static vx As Double = -1
Static vy As Double = 20
Static yPush As Double

r = 228
g = 255
b = 0
v = Rgb(r, g, b)
z = (r + g + b)\3
z = IIf(z < 128, 255, 0)
z = Rgb(100, 220, 40)
Canvas_Clear v
Canvas_Color z, v
Canvas_Width 1
oldx = vx
oldy = vy


'----------- use better a function for randomness ? ---------------- >

'vx=Rnd(40,300) :'vy=Rnd(40,210)
vx=Rnd(10,500) ' : vy=Rnd(10,450)
'--------------------------------- //
'better for... next ?

If vx=>87 And vx <=90 Then ' 'gut!
Dialog Kill Timer hwnd, %tAnimationTimer
Sleep 1500
MsgBox 0,"you've won! " + Str$(vx)+","+ Str$(vy)
Sleep 1500
MsgBox 0,"end of current random game"
End If

vy=Rnd(10,450)
If vy=>161 And vy <=164 Then 'gut!
'If vy=>152 And vy <=155 Then 'gut!
Dialog Kill Timer hwnd, %tAnimationTimer
Sleep 1500

'----------------- //
endofgame() ' only a first attempt
'----------------- //
MsgBox 0,"you've won! " + Str$(vx)+","+ Str$(vy)
Sleep 1500
MsgBox 0,"end of current random game and show your image position"
End If

'----------- end: use better a function for randomness ? ---------------- >


Canvas_Scale Pixels
Canvas_BitmapRender(sImageBig)
'Canvas_BitmapCopy1(hdlg,sImageSmall+Str$(vx)) ' ? test for another pic
Canvas_Redraw

'---- simple font setup ------------------------------->
Canvas_Font "Comic Sans MS", 18, 0
''Canvas_SetPos(1+vx/4,8+vy/4)
Canvas_SetPos(vx,vy)
Canvas_Scale Pixels
Canvas_Print ""+Str$(vx)+","+Str$(vy)
Canvas_BitmapRender(sImageSmall)
Canvas_Color(Rgb(255,10,100))
' if you have won give the gamer a bonus as pic, only an idea ------ //
Canvas_SetPos(20,320)
Canvas_BitmapRender(sImageSmallwin)
' if you have won give the gamer a bonus as pic, only an idea ------ //
'---- simple font part ------------------------------->
Canvas_Redraw

End Sub
'---------------- >
Sub endofgame()
'---------------- >
Local hdlg As Long,vx As Long, vy As Long
Local sImageSmallwin As String = APP_SourcePath+"Prometh2aa.bmp"
Dialog Kill Timer hdlg, %tAnimationTimer
Sleep 1500
MsgBox 0,"wait.."
End Sub


'---------------- >
Sub startgame()
'---------------- >
Local hdlg As Long,counts As Long
Canvas_Attach(hdlg, %myCanvas, %TRUE)
DrawGraphics(hdlg, %myCanvas)
Do
Dialog DoEvents To Counts
Loop Until Counts = 0

End Sub


'---------------------------------------------------------- >
' alternative way for moving objects and fonts


' -- Imitation of FOR cycles by decomposig step by step
''vx = CYCLE_Next(vx, 20, 200, 1.5)

'vx = CYCLE_Next(vx, -1, 175, 5.5)
'vy = CYCLE_Next(vy, 10, 125, 4.5)

'If vx = -1 Then
'ypush = CYCLE_Next(ypush, -1, 175, 5.5)
'End If
'---------------------------------------------------------- >



edit: a new zip file follows. there are some update needed to run perfect all after my ideas and the start game option with timer should be improved too ;)

bye, largo

ReneMiner
02-03-2013, 17:10
I still haven't understood how to play the game - but I've won everytime I played it...
Is there a possibility of losing at all?

largo_winch
02-03-2013, 21:19
thanks for feedback! you can see this is the first release how I mentioned in first post.

you can only "win", the software computerprogram (thinbasic) give all orders with randomness for the picture (image). the user interface for winning (and losing) and interactive with program level take a lot of more time and I wanted to start with general view of the GUI start of setup.

a) take a while as user how the program stop the random search for best fitted place of the image with x,y coordinate left top side you can see.

b) after program stops you can move for example "only mouse over" button you have "won" and this game ends and then you can see the centred image in middle of scene nearly perfect on right place. finetuning will come. losing the game too, there will be a special timer function for playing :)

bye, largo

largo_winch
05-03-2013, 14:23
dim str as string
str=“alien.bmp“
canvas_bitmapRender(„alien.bmp“,20,20,120,120)

question: If I have a simple image for loading into UI/canvas there's no chance to give the image a permanent and own ID (%equate) or there's another way?


Control Add Canvas, hDlg, %myPicCanvas1, "", 5, 5, cx, cy
if I am using and adding new Canvas Control for each new Image in MainDialog then it isn't working anymore in drawgraphics function. I think there must be another solution for it.

bye, largo

peter
05-03-2013, 15:50
Hi Mister Largo_Winch.

canvas_bitmpaRender(„alien.bmp“,20,20,120,120)
must be: canvas_bitmapRender(„alien.bmp“,20,20,120,120)

largo_winch
06-03-2013, 11:55
thanks peter for your info.

I've place all into %WM_InitDialog and I need only one "control add canvas" in tbmain() to insert all graphics (images) there I have explored in an example some minutes before. I tested I can load several pictures via button (%WM_COMMAND). all work in progress.


Case %WM_INITDIALOG
' -- Put code to be executed after dialog creation here
Dialog Set Timer CBHNDL, %tAnimationTimer, 10, %NULL



Control Add Canvas, CBHNDL, %bImage,"", 20, 70, w, h, %WS_BORDER

Canvas_Attach (CBHNDL, %bImage, TRUE)

Canvas_Scale Pixels

Canvas_BitmapRender(sImageSmall)



Canvas_SetPos(10,100)

Canvas_BitmapRender(sImageSmall2)



I think there's no need for unique equates or ID pro image for my example ;)

bye, largo