Forum de Programmation en langage PANORAMIC


Rejoignez le forum, c’est rapide et facile

Forum de Programmation en langage PANORAMIC
Forum de Programmation en langage PANORAMIC
Vous souhaitez réagir à ce message ? Créez un compte en quelques clics ou connectez-vous pour continuer.
Rechercher
 
 

Résultats par :
 


Rechercher Recherche avancée

Derniers sujets
» Bonne année 2024
Arbres, nuages et Soleil  EmptyLun 1 Jan - 0:25 par Papydall-Admin

» A ceux qui célèbre Noël, bonnes fêtes
Arbres, nuages et Soleil  EmptyDim 24 Déc - 10:49 par Papydall-Admin

» Joyeux Noël et Bonne Année
Arbres, nuages et Soleil  EmptyVen 8 Déc - 1:34 par Papydall-Admin

» Planets of the Solar System : Tilts and Spins
Arbres, nuages et Soleil  EmptyLun 20 Mar - 15:43 par Papydall-Admin

» Bonne Année 2023
Arbres, nuages et Soleil  EmptySam 31 Déc - 1:39 par Papydall-Admin

» Fractals - Mandelbrot
Arbres, nuages et Soleil  EmptyVen 21 Aoû - 22:51 par Papydall-Admin

» Convertisseur Décimal ---> Binaire, Octal, Hexadécimal, ...
Arbres, nuages et Soleil  EmptyMer 21 Nov - 1:08 par Papydall-Admin

» Balises {USER...}
Arbres, nuages et Soleil  EmptyLun 19 Nov - 22:12 par Papydall-Admin

» Useful Dog
Arbres, nuages et Soleil  EmptyVen 6 Avr - 14:25 par Papydall-Admin

Avril 2024
LunMarMerJeuVenSamDim
1234567
891011121314
15161718192021
22232425262728
2930     

Calendrier Calendrier

Le Deal du moment : -40%
-40% sur le Pack Gaming Mario PDP Manette filaire + ...
Voir le deal
29.99 €

Arbres, nuages et Soleil

Aller en bas

Arbres, nuages et Soleil  Empty Arbres, nuages et Soleil

Message par Papydall-Admin Jeu 13 Oct - 14:02

Code:

rem ============================================================================
rem        PLANTS.BAS par PAPYDALL
rem ============================================================================
init() : go() : caption 0, "Programme arrêté par l'utilisateur"
end
rem ============================================================================
SUB init()
    dim ss% : ss% = 20
    dim sang,sang1(ss%),xx(ss%),yy(ss%)
    dim p,compteur%,xp,yp,xp1,yp1,xpos%,ypos%,x,y,x1,y1,ran1,ran2,s2,zx,zy
    dim a$,a0$,a1$,b$,st,gen%,k%,s,ang,ang1,an,j%,cl,i%
    dim xsun%,ysun%,rsun%,titre$
    
    full_space 0 : color 0,10,100,150
    p = pi/180
    compteur% = 0 : ypos% = screen_y * 0.8
    xsun% = int(rnd(screen_x -100)+100) : ysun% = 50 : rsun% = 20
    titre$ = " *** SI VOUS VOUS ENNUYEZ TROP <CLICK> POUR ARRETER"
    titre$ = titre$ + " ***  MAIS VOUS NE PERDREZ RIEN SI VOUS PATIENTER UN PEU !!!"
    soleil(xsun%,rnd(ysun%)+25,rsun%)
    for i% = 1 to 10
        Nuages(rnd(200),200+rnd(50),rnd(20)+20)
        Nuages(rnd(screen_x-200)+200+rnd(50),200,rnd(20)+10)
    next i%
END_SUB
rem ============================================================================
SUB soleil(x%,y%,r%)
    2d_circle x%,y%,r% : 2d_flood x%,y%,255,255,0
END_SUB
rem ============================================================================
SUB Nuages(x%,y%,r%)
    2d_pen_color 255,255,255 : 2d_fill_color 255,255,255
    2d_circle x%,y%,r%       : 2d_circle x%+r%,y%,r%
    2d_circle x%+2*r%,y%,r%  : 2d_circle x%+r%,y%-r%,r%
END_SUB
rem ============================================================================
SUB go()
    repeat
      xpos% = int(rnd(screen_x -200)+100)
      B$ = "" : A$ = "" : A0$ = "" : A1$ = ""
      st = 0 : gen% = mod(compteur%,13)+1 : compteur% = compteur% + 1
      if mod(compteur%,3) = 1 then Nuages(rnd(screen_x-200)+200+rnd(50),200,rnd(20)+10)
      caption 0,"NOMBRE DE PLANTS DESSINES  : " + str$(compteur%) + string$(5," ") + titre$
      select gen%
        case 1
          k% = 6 : s = 1.5 : ang1 = int(rnd(80)+8)
          A$ = "0" : A1$ = "11" : A0$ = "1##10!+0!-0"
        case 2
          k% = 5 : s = 3 : ang1 = int(rnd(20)+16)
          A$ = "1" : A1$ = "11-#-1+0+0!+#+1-0-0!" : A0$ = "0"
        case 3
          k% = 6 : s = 1.5 : ang1 = int(rnd(45)+8)
          A$ = "0" : A1$ = "11" : A0$ = "1#+0!1#-0!0"
        case 4
          k% = 5 : s = 3 : ang1 = int(rnd(10)+10)
          A$ = "1" : A1$ = "1#+0!#=0!1#+1+-0!#-1-+0!" : A0$ = "0-0++0"
        case 5
          k% = 5 : s = 3 : ang1 = int(rnd(16)+16)
          A$ = "1" : A1$ = "11-#-1+0+0!+#+1-0-0!" : A0$ = "#0-0++0!"
        case 6
          k% = 4 : s = 2.5 : ang1 = int(rnd(10)+10)
          A$ = "1" : A1$ = "1#+10!1#-10!1" : A0$ = "#0-0++0!"
        case 7
          k% = 4 : s = 1.75 : ang1 = int(rnd(30)+10)
          A$ = "1" : A1$ = "1#+1-10!1#-1+10!10" : A0$ = "#0-0++0!"
        case 8
          k% = 4 : s = 3 : ang1 = int(rnd(15)+10)
          A$ = "1" : A1$ = "11#+1-1+10!#-1+1-10!" : A0$ = "#0-0++0!"
        case 9
          k% = 4 : s = 3.5 : ang1 = 10
          A$ = "1" : A1$ = "11#+1+1-#0-0++0!!0#-1-1+#0-0++0!!" : A0$ = "#0-0++0!"
        case 10
          k% = 4 : s = 3.6 : ang1 = int(rnd(5)+10)
          A$ = "#+1-1!#-1+1!" : A1$ = "1#-1+0!1#+1-0!0" : A0$ = "#0-0++0!"
        case 11
          k% = 3 : s = 2.75 : ang1 = int(rnd(3)+8)
          A$ = "1" : A1$ = "11#+10-10+10-10!1#-10+10-10+10!0" : A0$ = "0"
        case 12
          k% = 3 : s = 4 : ang1 = int(rnd(60)+20)
          A$ = "1" : A1$ = "1#-10-10-10!1#+10+10+10!1#10!" : A0$ = "0"
        case 13
          k% = 4 : s = 2 : ang1 = int(rnd(8)+10)
          A$ = "0" : A1$ = "111" : A0$ = "11#+0!#++0!#+++0!#-0!#--0!#---0!0"

      end_select

      for j% = 1 to k%
          cl = len(A$)
          for i% = 1 to cl
              if mid$(A$,i%,1) = "1"
                 B$ = B$ + A1$
              else
                 if mid$(A$,i%,1)="0"
                    B$ = B$ + A0$
                 else
                    B$ = B$ + mid$(A$,i%,1)
                 end_if
              end_if
          next i%
          A$ = B$ : B$ = ""
          ang = 360 / ang1 : x = 0 : y = 0 : an = 0 : cl = len(A$)
          for i% = 1 to cl
              if mid$(A$,i%,1) = "1"
                 ran1 = rnd(1) : ran2 = rnd(1) : s2 = s  + 0.5 *(ran1-ran2)* s
                 ran1 = rnd(1) : ran2 = rnd(1) : an = an + 5.0 *(ran1-ran2)
                 sang = an : x1 = s2 * sin(an*p)+ x : y1 = s2 * cos(an*p)+ y
                 xp = 2 * x + xpos% : yp = ypos% - 2 * y
                 xp1 = 2 * x1 + xpos% : yp1 = ypos% - 2 * y1
                 2d_pen_color 0,192,0 : 2d_line xp,yp , xp1,yp1
                 x = x1 : y = y1
              else
                 if mid$(A$,i%,1) = "0"
                    zx = sin(an*p): zy = cos(an*p)
                    x1 = zx * s + x : y1 = zy * s + y
                    xp = 2 * x + xpos% : yp = ypos% - 2 * y
                    xp1 = 2 * x1 + xpos% : yp1 = ypos% - 2 * y1
                    2d_pen_color 255,128,0 : 2d_line xp,yp , xp1,yp1
                    x1 = 0.25 * zx * s + x : y1 = 0.25 * zy * s + y
                    xp1 = 2 * x1 + xpos% : yp1 = ypos% - 2 * y1
                    2d_pen_color 255,0,0 : 2d_line xp,yp , xp1,yp1
                 else
                    if mid$(A$,i%,1) = "-"
                       ran1 = rnd(1) : ran2 = rnd(1)
                       an = an - ang - 10 *(ran1-ran2) : sang = an
                    else
                       if mid$(A$,i%,1)="+"
                          ran1 = rnd(1) : ran2 = rnd(1)
                          an = an + ang + 10 *(ran1-ran2) : sang=an
                       else
                          if mid$(A$,i%,1)="#"
                             st = st + 1 : sang1(st) = sang
                             xx(st) = x : yy(st) = y
                          else
                             if mid$(A$,i%,1)="!"
                                x = xx(st) : y = yy(st)
                                an = sang1(st) : sang = an : st = st-1
                             end_if
                          end_if
                       end_if
                    end_if
                 end_if
             end_if
             if scancode <> 0 then exit_sub
          next i%
      next j%
    until scancode <> 0
END_SUB
rem ========================== FIN =============================================  
Papydall-Admin
Papydall-Admin
Admin

Messages : 93
Réputation : 0
Date d'inscription : 08/09/2015
Age : 73
Localisation : MOKNINE (Tunisie)

https://papydall-panoramic.forumarabia.com

Revenir en haut Aller en bas

Revenir en haut


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