Générateur de paysages

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 = 40
    dim rand : rand = rnd(1)
    dim lowmount  : lowmount  = 0
    dim startval1 : startval1 = 256 : ' 500
    dim startval2 : startval2 = 2   : ' 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,200,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
' Dessiner la chaîne de montagnes
       oldrange = range(0) : 2d_pen_color col,col,col
       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
' Couleur plus sombre
       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
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 ============================================================================
' Ma valeur aléatoire
SUB MyRnd()
    seed = (221*seed) + 2113 : seed = seed-(INT(seed/10000)*10000)
    a = seed/10000
END_SUB
rem ============================================================================

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
      if n=1 then 2d_pen_color 230,255,240
      if n=2 then 2d_pen_color 200,255,200
      if n=3 then 2d_pen_color 150,200,150
      if n=4 then 2d_pen_color 100,150,100
      if n=5 then 2d_pen_color 50,100,50
      if n=6 then 2d_pen_color 0,50,0

' 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
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 ============================================================================
' Ma valeur aléatoire
SUB MyRnd()
    seed = (221*seed) + 2113 : seed = seed-(INT(seed/10000)*10000)
    a = seed/10000
END_SUB
rem ============================================================================

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 ============================================================================