Results 1 to 6 of 6

Thread: start of an image covering game "prometheus" (alpha 1)

  1. #1

    start of an image covering game "prometheus" (alpha 1)

    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
    Attached Images Attached Images
    Attached Files Attached Files
    Last edited by largo_winch; 06-03-2013 at 11:57.

  2. #2
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,527
    Rep Power
    170
    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?
    I think there are missing some Forum-sections as beta-testing and support

  3. #3
    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
    Last edited by largo_winch; 02-03-2013 at 21:21.

  4. #4
    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
    Last edited by largo_winch; 05-03-2013 at 18:43. Reason: correction typo error

  5. #5
    Member
    Join Date
    Sep 2008
    Location
    Germany
    Posts
    406
    Rep Power
    56
    Hi Mister Largo_Winch.

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

  6. #6
    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
    Last edited by largo_winch; 06-03-2013 at 12:01.

Similar Threads

  1. Forum: added "Auto Youtube Link-Converter" plugin
    By ErosOlmi in forum Web and Forum
    Replies: 0
    Last Post: 07-05-2011, 12:47
  2. Replies: 17
    Last Post: 21-02-2010, 07:45
  3. Uses "File", "Crypto" ... ???
    By marcuslee in forum thinBasic General
    Replies: 3
    Last Post: 01-12-2009, 19:38
  4. Old "Freescape" game remade
    By catventure in forum User files and/or user projects
    Replies: 2
    Last Post: 11-05-2008, 19:11

Members who have read this thread: 0

There are no members to list at the moment.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •