ELASTIC

' ******************************************************************************
'              PAPYDALL VOUS PROPOSE
'                  ELASTIC.BAS
'  Adaptation en PANORAMIC d'un programme en FREEBASIC
'  Le programme nécessite KGF.DLL
' ------------------------------------------------------------------------------

' Attrapez le maximum de boules bleues avec la boule verte en un temps déterminé
' ça a l'air facile... sauf que la boule verte est accrochée à la souris avec
' un élastisque...    bon jeu !!
' ******************************************************************************
Run()

end
' ******************************************************************************
SUB Run()
    dim bx,by,bvx,bvy,bax,bay,dt,cx,cy,dst,dll$,res%,mx%,my%, reste , score
    dim_local tex$
    dll$ = "C:\Documents and Settings\micro\Bureau\DLL\KGF\KGF.dll" : ' à adapter
    full_space 0: color 0,0,0,0 : font_color 0 ,255,255,0

    tex$ =  "Attrapez le maximum de boules bleues avec la boule verte"
    tex$ = tex$  + "    <CLIK> pour demarrer" : caption 0,tex$
    repeat : until scancode <> 0
    dll_on dll$ : InitJeu() :  jeu()
END_SUB
' ******************************************************************************
Sub InitCible()
    cx = int(rnd(width(0)-20)+10) : cy = int(rnd(height(0)-20)+10)
end_sub
' ******************************************************************************
Sub InitJeu()
    bx = int(rnd(width(0)-20)+10) : by = int(rnd(height(0)-20)+10)
    res% = dll_call2("AbsoluteMousePosition",bx,by)
    InitCible()
end_sub
' ******************************************************************************
SUB Jeu()
    reste = 10000 : ' c'est la durée du jeu
    score = 0
    repeat
        reste = reste-1
        res% = dll_call2("GetAbsoluteMousePosition",adr(mx%),adr(my%))

        if mx% < 10 then mx% = 10
        if my% < 10 then my% = 10
        if mx% > width(0)-10  then mx% = width(0)-10
        if my% > height(0)-40 then my% = height(0)-40

        bax = sqr((mx%-bx)*(mx%-bx))/2000
        bay = sqr((my%-by)*(my%-by))/2000
        if bx < mx% then bvx = bvx + bax
        if bx > mx% then bvx = bvx - bax
        if by < my% then bvy = bvy + bay
        if by > my% then bvy = bvy - bay

        if bx < 0  then bvx = abs(bvx)* 0.8 : bvy = bvy * 0.8
        if by < 20 then bvy = abs(bvy)* 0.8 : bvx = bvx * 0.8
        if bx >  width(0) then bvx = 0-abs(bvx)* 0.8 : bvy = bvy * 0.8
        if by > height(0) then bvy = 0-abs(bvy)* 0.8 : bvx = bvx * 0.8

        bx = bx + bvx : by = by + bvy

        Dst = sqr((cx-bx)*(cx-bx)+(cy-by)*(cy-by))

        if reste < 0 then reste = 0
        if (dst < 10) and (reste > 0) then Initcible() : score = score + 1
        caption 0, "TEMPS RESTANT = "+ str$(reste) + "  SCORE "+ str$(score)
        if reste = 0
          Font_bold 0 : font_size 0,20
          print_locate width(0)/2-100,100 : print "!!! GAME OVER !!!"
          if message_information_yes_no("VOULEZ-VOUS REJOUER?")=1
              InitJeu() : Jeu(): else : Fin()
          end_if
        end_if

        2d_fill_color 0,0,0
        2d_pen_color 255,255,00 : 2d_rectangle 0,0,width(0)-1 ,height(0)-30
        2d_fill_color 0,255,0  : 2d_pen_color 0,255,0 : 2d_circle bx,by,10
        2d_pen_color 255,255,0  : 2d_line bx,by,mx%,my%
        2d_fill_color 255,0,0  : 2d_pen_color 255,0,0 : 2d_circle mx%,my%,10
        2d_fill_color 0,0,255  : 2d_pen_color 0,0,255 : 2d_circle cx,cy, 10
        wait 5

 until  scancode = 27
 Fin()
END_SUB

' ******************************************************************************

SUB Fin()
    dll_off : terminate
END_SUB
' ******************************************************************************

' ******************************************************************************
'              PAPYDALL VOUS PROPOSE
'                  ELASTIC.BAS
'                    V 2.0
'  Adaptation en PANORAMIC d'un programme en FREEBASIC
'  Le programme nécessite KGF.DLL
' ------------------------------------------------------------------------------

' Attrapez le maximum de boules  avec la boule verte en un temps déterminé
' ça a l'air facile... sauf que la boule verte est accrochée à la souris avec
' un élastisque...    bon jeu !!
' ******************************************************************************
Run()

end
' ******************************************************************************
SUB Run()
    dim bx,by,bvx,bvy,bax,bay,dt,cx,cy,dst,dll$,res%,mx%,my%, reste , score
    dim dst1,dst2,dst3
    dim_local tex$
    dll$ = "C:\Documents and Settings\micro\Bureau\DLL\KGF\KGF.dll" : ' à adapter
    full_space 0: color 0,0,0,0 : font_color 0 ,255,255,0

    tex$ =  "Attrapez le maximum de boules avec la boule verte"
    tex$ = tex$  + "    <CLIK> pour demarrer" : caption 0,tex$
    repeat : until scancode <> 0
    dll_on dll$ : InitJeu() :  jeu()
END_SUB
' ******************************************************************************
Sub InitCible()
    cx = int(rnd(width(0)-50)+20) : cy = int(rnd(height(0)-50)+20)
end_sub
' ******************************************************************************
Sub InitJeu()
    bx = int(rnd(width(0)-50)+20) : by = int(rnd(height(0)-50)+20)
    res% = dll_call2("AbsoluteMousePosition",bx,by)
    InitCible()
end_sub
' ******************************************************************************
SUB Jeu()
    reste = 10000 : ' c'est la durée du jeu
    score = 0
    cursor_hide 0
    repeat
        reste = reste-1
        res% = dll_call2("GetAbsoluteMousePosition",adr(mx%),adr(my%))

        if mx% < 10 then mx% = 10
        if my% < 10 then my% = 10
        if mx% > width(0)-10  then mx% = width(0)-10
        if my% > height(0)-40 then my% = height(0)-40

        bax = sqr((mx%-bx)*(mx%-bx))/2000
        bay = sqr((my%-by)*(my%-by))/2000
        if bx < mx% then bvx = bvx + bax
        if bx > mx% then bvx = bvx - bax
        if by < my% then bvy = bvy + bay
        if by > my% then bvy = bvy - bay

        if bx < 0  then bvx = abs(bvx)* 0.8 : bvy = bvy * 0.8
        if by < 20 then bvy = abs(bvy)* 0.8 : bvx = bvx * 0.8
        if bx >  width(0) then bvx = 0-abs(bvx)* 0.8 : bvy = bvy * 0.8
        if by > height(0) then bvy = 0-abs(bvy)* 0.8 : bvx = bvx * 0.8

        bx = bx + bvx : by = by + bvy

        Dst = sqr((cx-bx)*(cx-bx)+(cy-by)*(cy-by))
        dst1 = sqr((cx/2 -bx)*(cx/2-bx) + (cy/2-by)*(cy/2-by))
        dst2 = sqr((cx/3 -bx)*(cx/3-bx) + (cy/3-by)*(cy/3-by))
        dst3 = sqr((cx/1.5 -bx)*(cx/1.5-bx) + (cy/1.5-by)*(cy/1.5-by))

        if reste < 0 then reste = 0
        if (dst < 10) and (reste > 0) then Initcible() : score = score + 5
       
        if (dst1 < 10) and (reste > 0) then Initcible() : score = score + 10
        if (dst2 < 10) and (reste > 0) then Initcible() : score = score + 20
        if (dst3 < 10) and (reste > 0) then Initcible() : score = score + 1
       
        caption 0, "TEMPS RESTANT = "+ str$(reste) + "  SCORE "+ str$(score)
        if reste = 0
          Font_bold 0 : font_size 0,20 :font_color 0,0,0,0
          print_locate width(0)/2-100,100 : print "!!! GAME OVER !!!"
          if message_information_yes_no("VOULEZ-VOUS REJOUER?")=1
              InitJeu() : Jeu(): else : Fin()
          end_if
        end_if

        2d_fill_color 0,0,0
        2d_pen_color 255,255,00 : 2d_rectangle 0,0,width(0)-1 ,height(0)-30
        2d_fill_color 0,255,0  : 2d_pen_color 0,255,0 : 2d_circle bx,by,10
        2d_pen_color 255,255,0  : 2d_line bx,by,mx%,my%
        2d_fill_color 255,0,0  : 2d_pen_color 255,0,0 : 2d_circle mx%,my%,10
        2d_fill_color 0,0,255  : 2d_pen_color 0,0,255 : 2d_circle cx,cy, 10
        2d_fill_color 0,255,255  : 2d_pen_color 0,255,255 : 2d_circle cx/2,cy/2,8
        2d_fill_color 255,255,255  : 2d_pen_color 255,255,255 : 2d_circle cx/3,cy/3,5
        2d_fill_color 255,255,255  : 2d_pen_color 255,255,255 : 2d_circle cx/1.5,cy/1.5,15

        wait 5

 until  scancode = 27
 Fin()
END_SUB

' ******************************************************************************

SUB Fin()
    dll_off : terminate
END_SUB
' ******************************************************************************