Accueil
Portail
Galerie
Rechercher
S'enregistrer
Connexion
Landscape Generator
Page 1 sur 1
Landscape Generator
par Papydall-Admin 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 ============================================================================
Papydall-Admin- Admin
- Messages : 93
Réputation : 0
Date d'inscription : 08/09/2015
Age : 73
Localisation : MOKNINE (Tunisie) -
Page 1 sur 1
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum
» A ceux qui célèbre Noël, bonnes fêtes
» Joyeux Noël et Bonne Année
» Planets of the Solar System : Tilts and Spins
» Bonne Année 2023
» Fractals - Mandelbrot
» Convertisseur Décimal ---> Binaire, Octal, Hexadécimal, ...
» Balises {USER...}
» Useful Dog