Forum de Programmation en langage PANORAMIC
Rechercher
 
 

Résultats par :
 


Rechercher Recherche avancée

Mots-clés

Derniers sujets
» Régalez-vous !
Sam 29 Juil - 11:42 par Admin

» Les bienfaits du rire
Ven 7 Juil - 0:04 par Admin

» Derrière chaque beau parleur se cache un magnifique menteur
Ven 7 Juil - 0:01 par Admin

» Carré magique d’ordre 3 à 99 et plus si affinité !
Mer 5 Juil - 3:21 par Admin

» Dessine-moi une étoile
Mar 4 Juil - 17:32 par Admin

»  Equation paramétrique de la super-ellipse
Mar 4 Juil - 17:29 par Admin

»  Exécution des fichiers CPL
Sam 1 Juil - 14:01 par Admin

» Un papa à la page.
Ven 30 Juin - 15:01 par Admin

»  Exemple de menu
Lun 26 Juin - 22:36 par Admin

Août 2017
LunMarMerJeuVenSamDim
 123456
78910111213
14151617181920
21222324252627
28293031   

Calendrier Calendrier


Landscape Generator

Voir le sujet précédent Voir le sujet suivant Aller en bas

Landscape Generator

Message par Admin le Lun 24 Oct - 5:07

Code:

rem ============================================================================
rem                  Landscape_Generator.bas
rem                  Générateur de  paysages
rem                      Par Papydall
rem ============================================================================
rem Pour des chaînes de montagnes normales, utiliser startval1 = 256 et startval2 = 2
rem Pour des paysages étranges utiliser startval1 = 500 et startval2 = 6
rem Jouez avec ces paramètres pour essayer des dunes ou des paysages marins
rem ============================================================================

Init()
Draw_Mountain()
caption 20,"!!! *** A D M I R E Z  C E  P A Y S A G E *** !!!"

end
rem ============================================================================
SUB Init()
    dim w : w = screen_x *.8
    dim h : h = screen_y *.8
    dim range(4096)
    dim lowr : lowr = 10
    dim col  : col  = 240 : ' 200
    dim delta_col : delta_col = 48
    dim rand : rand = rnd(1)
    dim lowmount  : lowmount  = 0
    dim startval1 : startval1 = 300 : ' 500
    dim startval2 : startval2 = 3  : ' 6
    dim newval1, newval2, amplitude, frequence, oldx, oldrange
    dim lacr, lacg, lacb, decrease, a, seed, k,sw

    if rand < .5 then sw = 0 : else : sw = 1
    full_space 0 : color 0,220,180,220 : caption 0,"Générateur de paysages par Papydall"
    picture 10 : width 10,w : height 10,h : top 10,(height(0) - h)/2 : left 10,(width(0)-w)/2
    color 10,150,200,255 : 2d_target_is 10
    alpha 20 : top 20,20 : left 20,w/3: font_bold 20 : font_size 20,24
    caption 20,"V E U I L L E Z  P A T I E N T E R ..... "
END_SUB
rem ============================================================================
' Dessiner 6 chaînes de montagnes
SUB Draw_Mountain()
    dim_local n, inc, i
    for n = 1 to 6
        pause 1 : newval1 = startval1 : newval2 = startval2
' Chaque chaîne de montagnes est produite par 6 fonctions "Bruit de Perlin"
' avec diminution de l'amplitude et croissance de la fréquence
      for inc = 1 to 6
          newval1 = newval1/2 : newval2 = newval2*2 : k = 0 : seed = rnd(1)
          amplitude = newval1 : frequence = newval2 : oldx = 0 : Perlin()
      next inc
' Couleur
      select n
           case 1 : 2d_pen_color 255,255,255
           case 2 : 2d_pen_color 200,200,200
           case 3 : 2d_pen_color 150,150,150
           case 4 : 2d_pen_color 100,120,100
           case 5 : 2d_pen_color 50,100,50
           case 6 : 2d_pen_color 0,50,0
      end_select

' Dessiner la chaîne de montagnes
      oldrange = range(0)
      for i = 0 to w-1
          2d_line i-1,oldrange+lowmount,i,range(i)+lowmount
          2d_line i-1,oldrange+lowmount,i-1,h
          oldrange = range(i)
      next i
      lowmount = lowmount + lowr : lowr = lowr + 25
' Pour la chaîne suivante
      for i = 0 to w-1 : range(i) = 0 : next i
      col = col - delta_col
    next n

' Dessinez un lac brumeux
    lacr = col + delta_col : lacg = col + delta_col : lacb = 255
    decrease = (lacb-(col + delta_col))/100
    for i = 1 to 100
        2d_pen_color  lacr,lacg,lacb : 2d_line 0,h-i,w,h-i
        lacb = lacb - decrease
    next i
' Dessiner une rangée d'arbres
     Tree_Range()
END_SUB
rem ============================================================================
' Fonction Bruit de Perlin
SUB Perlin()
    dim_local zz,x,pointa,pointb, f,ft,interp, pi : pi = acos(-1)
    MyRnd() : pointb = a
    for zz= 1 to frequence
        pointa = pointb : MyRnd() : pointb = a
        for x = 0 to 1 step (1/(w/frequence))
            if sw = 1
              ft = x * pi : f  = (1 - cos(ft)) * .5
              interp =  pointa*(1-f) + pointb*f
            else
              interp = pointa*(1-x) + pointb*x
            end_if
            range(k) = range(k)+(interp*amplitude) : k = k + 1
        next x
        oldx = oldx + (w/frequence)
    next zz
END_SUB
rem ============================================================================
' Rangée d'arbres
' Deux fonctions "Perlin noise"
SUB Tree_Range()
    dim_local inc,i,uppery,colg
    colg = 255 : lowr = 380
    startval1 = 50 + int(rnd(50)) : startval2 = 128 +int(rnd(256))
    newval1 = startval1*2 : newval2 = startval2/2
    for inc = 1 to 2
        newval1 = newval1/2 : newval2 = newval2*3
        k = 0 : seed = rnd(1) : amplitude = newval1 : frequence = newval2
        oldx = 0 : Perlin()
    next inc
    oldrange = range(0) : 2d_pen_color 30,colg,30
    for i = 0 to w
        uppery = oldrange + h-100
        if uppery > h then uppery = h
        if uppery < 9 then uppery = 9
        2d_line i-1,uppery,i-1,h : oldrange = range(i)
    next i
    lowmount = lowmount + lowr
END_SUB
rem ============================================================================
' Ma valeur aléatoire
SUB MyRnd()
    seed = (221*seed) + 2113 : seed = seed-(INT(seed/10000)*10000)
    a = seed/10000
END_SUB
rem ============================================================================

_________________
Invité, merci d'être passé par ici.
avatar
Admin
Admin

Messages : 66
Date d'inscription : 08/09/2015
Age : 67
Localisation : MOKNINE (Tunisie)

Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com

Revenir en haut Aller en bas

Voir le sujet précédent Voir le sujet suivant Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum