Le jeu de l'élastique

rem ============================================================================
rem                    ELASTIC.BAS
rem                    PAR PAPYDALL
rem  Adaptation en PANORAMIC d’un programme en FREEBASIC
rem                  dont je n’ai plus le source
rem ============================================================================
rem  Le programme nécessite KGF.DLL pour la gestion de la souris
rem ============================================================================
rem Attrapez le maximum de boules  avec la boule verte en un temps déterminé
rem ça a l’air facile ... sauf que la boule verte est accrochée à la souris avec
rem un élastisque ...
rem Bon divertissement !!
rem ============================================================================

Run()

rem ============================================================================
SUB Run()
    dim bx,by,bvx,bvy,bax,bay,dt,cx,cy,dll$,res%,mx%,my%,temps,score
    dim dst0,dst1,dst2,dst3,t$
    dll$ = "KGF.dll" : ' Adapter le chemin de la DLL
    full_space 0 : color 0,0,0,0 : font_color 0 ,255,255,0
    picture 10 : full_space 10 : 2d_target_is 10 : print_target_is 10 : hide 10
    Font_bold 10 : font_size 10,20 : font_color 10,255,0,0 : font_name 10,"tahoma"
    2d_fill_on
    image 20
    t$ = "Attrapez le maximum de boules avec la boule verte ... <ESC> pour arrêter ..."
    caption 0,t$
    application_title "  !!! Bienvenue dans le monde de l'élastique !!!"
    Bienvenue()
    dll_on dll$
    if message_confirmation_ok("OK pour commencer ?") = 1
       InitJeu() : jeu()
    else
       Stop_Run()
    end_if
END_SUB
rem ============================================================================
SUB InitCible()
    cx = int(rnd(width(0)-50)+20) : cy = int(rnd(height(0)-50)+20)
END_SUB
rem ============================================================================
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
rem ============================================================================
SUB Jeu()
    temps = 10000 : ' c'est la durée du jeu à adapter
    score = 0 : cursor_hide 0
    repeat
        temps = temps-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
        Dst0 = 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 temps < 0 then temps = 0
        if (dst0 < 10) and (temps > 0) then Initcible() : score = score + 5
        if (dst1 < 10) and (temps > 0) then Initcible() : score = score + 10
        if (dst2 < 10) and (temps > 0) then Initcible() : score = score + 20
        if (dst3 < 10) and (temps > 0) then Initcible() : score = score + 1
        caption 0,t$ + " TEMPS RESTANT = "+ str$(temps) + "  SCORE "+ str$(score)
        if temps = 0
           print_locate width(10)/2-100,100 : print "!!! GAME OVER !!!"
           print_locate width(10)/2-150,150 : print "Votre score est : " + str$(score)+ " points"  
           Copy_Image()
           if message_information_yes_no("VOULEZ-VOUS REJOUER?") = 1
              InitJeu() : Jeu() : else : Stop_Run()
          end_if
        end_if
        2d_fill_color 000,000,000
        2d_pen_color  255,255,000 : 2d_rectangle 0,0,width(0)-1 ,height(0)-30
        2d_fill_color 000,255,000 : 2d_pen_color 000,255,000 : 2d_circle bx,by,10
        2d_pen_color  255,255,000 : 2d_line bx,by,mx%,my%
        2d_fill_color 255,000,000 : 2d_pen_color 255,000,000 : 2d_circle mx%,my%,10
        2d_fill_color 000,000,255 : 2d_pen_color 000,000,255 : 2d_circle cx,cy, 10
        2d_fill_color 000,255,255 : 2d_pen_color 000,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
        Copy_Image()
    until  scancode = 27
    Stop_Run()
END_SUB
rem ============================================================================
SUB Stop_Run()
    res% = dll_call1("KillProcessByHandle",handle(0))
END_SUB
rem ============================================================================
SUB Copy_Image()
    2d_image_copy 20,left(10),top(10),width(10),height(10)
    2d_target_is 0: 2d_image_paste 20,left(10),top(10) : 2d_target_is 10
END_SUB
rem ============================================================================
SUB Bienvenue()
    dim_local t$
    t$ = "  !!! Bienvenue dans le monde de l'élastique !!!" + chr$(13) + chr$(13)
    t$ = t$ + " Votre mission est d'attrapper le maximum de boules avec la bouble verte" + chr$(13)
    t$ = t$ + " dans un temps bien déterminé." + chr$(13)
    t$ = t$ + " Ça a l’air facile hein !... Sauf que la boule verte est accrochée " + chr$(13)
    t$ = t$ + " à la souris (la boule rouge) par un élastisque ..." + chr$(13)
    t$ = t$ + " Comme tout bon élastique qui se respecte, il s'allonge et se raccourcit"+chr$(13)
    t$ = t$ + " selon des lois que seuls les honorables élastiques connaissent !" + chr$(13)+chr$(13)    
    t$ = t$ + " Il y a 4 types de boules à attraper allant de la plus petite à la plus grosse."+chr$(13)
    t$ = t$ + " Selon leur taille, chaque boule vous apporte : "+chr$(13)
    t$ = t$ + "  1 point pour la plus grosse" + chr$(13)
    t$ = t$ + "  5 points pour la suivante" + chr$(13)
    t$ = t$ + " 10 points pour la suivante" + chr$(13)
    t$ = t$ + " 20 points pour la plus petite" + chr$(13)
    t$ = t$ + " Chaque boule attrapée augmente votre score." + chr$(13)
    t$ = t$ + " Le jeu se joue évidemment à la souris qui est cachée pour plus d'esthétique"+chr$(13) + chr$(13)
    t$ = t$ + "            Bon divertissement !!"
    message t$
END_SUB
rem ============================================================================