Compte à rebours de la Saint-Valentin

rem ============================================================================
rem           Compte à rebours
rem              Par Papydall
rem ============================================================================

label compte_a_rebours
dim dat1,dat2,sec,j,h,mn,n,i
dim result,dif,temp,t$,ville$
dim heure,minute,seconde,jour,mois,annee
dim heure2,minute2,seconde2,jour2,mois2,annee2

top 0,50 : left 0,screen_x/2 : width 0,560 : height 0,160
color 0,0,255,255 : font_color 0,0,0,255 : font_bold 0: font_size 0,14
font_name 0,"tahoma"
caption 0,"Compte à rebours : *** Bonne fête aux amoureuses et aux hamoureux ***"
alpha 10 : top 10,50 : left 10,45
timer 20 : on_timer 20, compte_a_rebours
n = 24*3600 : ' nombre de secondes dans une journée
rem ============================================================================
'  Indiquer ici la date et l'heure du compte à rebours
rem ============================================================================
rem Exemples
' jour2 = 01 : mois2 = 01 : annee2 = 2016  : t$ =  "Nouvel an 2016,"
' jour2 = 25 : mois2 = 12 : annee2 = 2016  : t$ =  "Noêl 2016, "
  jour2 = 14 : mois2 = 02 : annee2 = 2016  : t$ =  "Saint-Valentin, "
  heure2 = 00 : minute2 = 00 : seconde2 = 00
rem ============================================================================
Jour_Julien(jour2,mois2,annee2)    : dat2 = result
Frac_Jour(heure2,minute2,seconde2) : dat2 = dat2 + result

Coeur(20,45,20,-1+1) : Coeur(520,45,20,-1)
for i = 1 to 19 : coeur(30*i-12,100,10,-1) : coeur(30*i-12,25,10,1) : next i
end
rem ============================================================================
compte_a_rebours:
  Get_Date_heure()
  Jour_Julien(jour,mois,annee)    : dat1 = result
  Frac_Jour(heure,minute,seconde) : dat1 = dat1 + result
  dif = (dat2-dat1) * n

  if dif > 0
      j = int(dif/n) : temp = dif - j*n
      h = int(temp/3600) : temp = temp -h*3600
      mn = int(temp/60) : temp = temp - mn*60
      sec = int(temp)
      caption 10, t$ + " c'est dans : " + str$(j) +" j "+str$(h)+" h "+str$(mn)+" mn " +str$(sec)+" s"
  else
      timer_off 20
      caption 10, "L'heure de " + t$ + " est déjà dépassée !"
  end_if
return
rem ============================================================================
' Déterminer le Jour Julien à partir d'une date
SUB Jour_Julien(jour,mois,annee)
    dim_local a,b,d,m,y
    d = jour : m = mois : y = annee
    if m < 3 then y = y - 1 : m = m + 12
    a = int(y/100) : b = 2 - a + int(a/4)
    result = int(365.25*(y+4716)) + int(30.6001*(m+1)) + d + b - 1524.5
END_SUB
rem ============================================================================
' Lire la date et l'heuree système
SUB Get_Date_heure()
    heure   = val(mid$(time$,1,2)) : minute  = val(mid$(time$,4,2)) : seconde = val(mid$(time$,7,4))
    jour    = val(mid$(date$,1,2)) : mois    = val(mid$(date$,4,2)) : annee   = val(mid$(date$,7,4))
END_SUB
rem ============================================================================
SUB Frac_Jour(heure,minute,seconde)
    result = (seconde + minute*60 + heure*3600)/n
END_SUB
rem ============================================================================
' Dessiner un coeur
' xc,yc : coordonnées du creux de la cardioîde
' r : paramètre agissant sur la forme de la cadioîde
' sens : paramètre indiquant le sens de la cardioîde :
' sens = -1 <==== la pointe est dirigée vers le bas
' sens = +1 <==== la pointe est dirigée vers le haut
SUB Coeur(xc,yc,r,sens)
    dim_local x,y,t,s
    degrees :  2d_pen_color 255,0,0 : 2d_poly_from xc,yc
    if sens <= 0 then s = -1 : else : s = 1
    for t = 0 to 360
        x = power(sin(t),3) : y = cos(t) - power(cos(t),4)
        2d_poly_to xc+r*x,yc+s*r*1.1*y
    next t
    2d_flood xc,yc-s*2,255,0,0
END_SUB
rem ============================================================================

rem ============================================================================
rem        Cardioïde sur une ellipse
rem ============================================================================
dim i,s,p
s = 1 : p = 500

for i = 200 to 100 step -50 : s = 1-s : Coeur_Sur_Ellipse(300,210,i,i,s) : next i
coeur(300,190,30,1) : coeur(300,230,30,-1)
caption 0, " <ESC> pour mettre fin à la torture !!!!"
repeat
        2d_flood 300,190-2,255,255,255
        2d_flood 300,230+2,255,255,255 : pause p
        2d_flood 300,190-2,255,000,000
        2d_flood 300,230+2,255,000,000 : pause p
until scancode = 27
caption 0,""
Quitter()
END
rem ============================================================================
' Dessiner un coeur
' Equation paramétrique d'une cardioïde
' x = power(sin(t),3)
' y = cos(t) - power(cos(t),4)
' Paramètres :
' xc,yc : coordonnées du creux de la cardioïde
' r : paramètre agissant sur la forme de la cadioïde
' sens : paramètre indiquant le sens de la cardioîde :
' sens = -1 <==== la pointe est dirigée vers le bas
' sens = +1 <==== la pointe est dirigée vers le haut
SUB Coeur(xc,yc,r,sens)
    dim_local x,y,t,s
    degrees :  2d_pen_color 255,0,0 : 2d_poly_from xc,yc
    if sens <= 0 then s = -1 : else : s = 1
    for t = 0 to 360
        x = power(sin(t),3) : y = cos(t) - power(cos(t),4)
        2d_poly_to xc+r*x,yc+s*r*y +5*s
    next t
    2d_flood xc,yc-s*2,255,0,0
END_SUB
rem ============================================================================
' xc,yc : coordonnées du centre de l'ellipse
' rh et rv respectivement rayon horizontal et rayon vertical de l'ellipse
' si rh = rv l'ellipse est un cercle
SUB Coeur_Sur_Ellipse(xc,yc,rh,rv,s)
    dim_local x,y,angle,p,r
    degrees
    p = 15
    r = min(rh,rv)/10
    for angle = 0 to 360 step p
        x = xc+rh*cos(angle) : y = yc+rv*sin(angle)
        Coeur(x,y,r,s)
    next angle

END_SUB
rem ============================================================================
SUB Quitter()
    dim_local r,g,b,dr,dg,db
    R  = 255 : G  = 0  : B  = 0
    dR = -50 : dG = 50 : dB = 10
    font_bold 0 : font_size 0,32 : font_name 0,"tahoma" : color 0,0,0,0
    repeat
      If (R < 0) Or (R > 255) Then dR = 0-dR : R = R+dR
      If (G < 0) Or (G > 255) Then dG = 0-dG : G = G+dG
      If (B < 0) Or (B > 255) Then dB = 0-dB : B = B+dB
      font_color 0,r,g,b
      print_locate 100,150 : print "C'est terminé ..." : pause 500
      print_locate 050,250 : print "Cliquez pour quitter"
      R = R + dR : G = G + dG : B = B + dB
      pause 500
   until scancode <> 0
   for r = height(0) to 10 step -10 : height 0,r : pause 50 : next r
   terminate
END_SUB
rem ============================================================================