Forum de Programmation en langage PANORAMIC
Rechercher
 
 

Résultats par :
 


Rechercher Recherche avancée

Mots-clés

Derniers sujets
»  Simuler l’appui d'une touche ou combinaison de touches
Sam 16 Sep - 13:58 par Admin

» 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

Octobre 2017
LunMarMerJeuVenSamDim
      1
2345678
9101112131415
16171819202122
23242526272829
3031     

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 : 68
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