ARBRE2.QB

' calcul
DEF FNGAUSS(MINI%,MAXI%)
  EVENTAIL%=MAXI%-MINI%
  VALEUR%=((EVENTAIL%*RND)+(EVENTAIL%*RND)+(EVENTAIL%*RND)+(EVENTAIL%*RND))/4
  FNGAUSS=MINI%+VALEUR%
END DEF

DEF FNRNDSGN%
  OUINON%=RND
  FNRNDSGN%=1-(2*OUINON%)
END DEF

'*********************** ARBRE ALEATOIRE ************************************

SCREEN 1 : FOND%=1 : RANDOMIZE TIMER
PI=ATN(1)*4 : DEGRES=PI/180 : YAJUST=1.15

DIM COULEUR$(11)
COULEUR$(1)=CHR$(&H55)
COULEUR$(2)=CHR$(&HAA)
COULEUR$(3)=CHR$(&HFF)
COULEUR$(4)=CHR$(&H66)+CHR$(&H99)
COULEUR$(5)=CHR$(&H77)+CHR$(&HDD)
COULEUR$(6)=CHR$(&H44)+CHR$(&H11)
COULEUR$(7)=CHR$(&HBB)+CHR$(&HEE)
COULEUR$(8)=CHR$(&H88)+CHR$(&H22)
COULEUR$(9)=CHR$(&HCC)+CHR$(&H33)

INPUT "QUELLE PALLETTE (1-6)",p%
if p%>=7 OR P%<=0 THEN P%=1
INPUT "nombre d'ARBRES d‚sir‚s : ",NA%
INPUT "COULEUR DE TERRE (1-11) : ",CT%
IF CT%<=0 OR CT%>=12 THEN CT%=4
CALL PAL(P%)
CLS
LINE(0,100)-(319,100),1:PAINT(150,150),COULEUR$(CT%),1
CALL HERBE(0,110,319,199) : CALL EAU(150,180)

FOR i%=1 TO NA%
  AVANCE%=AVANCE%+20
  X1%=320*RND : Y1%=80+AVANCE% : X2%=X1% : Y2%=Y1%-AVANCE%
  CALL ARBRE(X1%,Y1%,X2%,Y2%)
NEXT

WHILE INKEY$="" : WEND

END

'____________________________________________________________________________
'                             TRACES DES ARBRES
'____________________________________________________________________________
SUB ARBRE(AX1%,AY1%,AX2%,AY2%) STATIC
SHARED HAUTEUR%
HAUTEUR%=AY1%-AY2%
  FOR I%=1 TO 2
     X1%=AX1% : Y1%=AY1% : X2%=AX2% : Y2%=AY2%
     CALL TRONC(X1%,Y1%,X2%,Y2%)
  NEXT
END SUB

SUB TRONC(X1%,Y1%,X2%,Y2%) STATIC
STATIC NOMBRE%
  NOMBRE%=NOMBRE%+1
  FOR X%=X1% TO X1%+(5-NOMBRE%)
     LINE(X%,Y1%)-(X2%,Y2%),3
     CALL FEUILLAGE(X2%,Y2%)
  NEXT
  IF NOMBRE% < 4 THEN
     CALL BRANCHE(X1%,Y1%, X2%,Y2%)
     CALL TRONC  (X1%,Y1%, X2%,Y2%)
  END IF
  NOMBRE%=0
END SUB

SUB BRANCHE(X1%,Y1%,X2%,Y2%) STATIC
SHARED DEGRES, YAJUST
  ANGLE=FNGAUSS(40,85)*DEGRES
  X1%=(X1%+X2%)/2: Y1%=(Y1%+Y2%)/2
  X%=ABS(X2%-X1%) : Y%=ABS(Y1%-Y2%)*YAJUST
  LONGUEUR%=SQR((X%^2)+(Y%^2))
  X2%=X1%+(FNRNDSGN%*(LONGUEUR%*(COS(ANGLE))))
  Y2%=Y1%-((LONGUEUR%*(SIN(ANGLE)))/YAJUST)
END SUB

SUB FEUILLAGE(X2%,Y2%) STATIC
SHARED PI,HAUTEUR%
  D%=HAUTEUR% / 5
  DIAMETRE%=D%+(D%*RND)
  X%=X2%+(FNRNDSGN%*DIAMETRE%*RND)
  Y%=Y2%+(FNRNDSGN%*DIAMETRE%*RND)
  ASPECT=(RND+RND+RND)/10
  CIRCLE(X%,Y%),DIAMETRE%,2,,,ASPECT
  PAINT(X%,Y%),2,2
  CIRCLE(X%,Y%),DIAMETRE%,3,,,ASPECT
  PAINT(X%,Y%),3,3
  CIRCLE(X%,Y%),DIAMETRE%,1,,,ASPECT
  PAINT(X%,Y%),1,1
  CIRCLE(X%,Y%),DIAMETRE%,0,PI,0,ASPECT
END SUB

' HERBE ET EAU

SUB HERBE(X1%,Y1%,X2%,Y2%) STATIC
FOR I%=0 TO 100
  X%=X1%+(X2%-X1%)*RND:Y%=Y1%+(Y2%-Y1%)*RND
  LINE(X%,Y%)-(X%+FNRNDSGN%,Y%-6),1
NEXT
END SUB

SUB EAU(X%,Y%) STATIC
 FOR I%=1 TO 5
    DIAMETRE%=20+20*RND
    X%=X%+(FNRNDSGN%*(FNGAUSS(0,60)))
    Y%=Y%+(FNRNDSGN%*(FNGAUSS(0,5)))
    ASPECT=(RND+RND+RND)/10
    CIRCLE(X%,Y%),DIAMETRE%,2,,,ASPECT
    PAINT(X%,Y%),2,2
    CIRCLE(X%,Y%),DIAMETRE%,0,,,ASPECT
    PAINT(X%,Y%),0,0
  NEXT
END SUB


' CHOIX DE PALETTE

SUB PAL(NUMERO%) STATIC
SHARED FOND%

IF NUMERO%=1 THEN  OUT &H3D8, 10 : OUT &H3D9,FOND%
IF NUMERO%=2 THEN  OUT &H3D8, 10 : OUT &H3D9,FOND%+16
IF NUMERO%=3 THEN  OUT &H3D8, 10 : OUT &H3D9,FOND%+32
IF NUMERO%=4 THEN  OUT &H3D8, 10 : OUT &H3D9,FOND%+48
IF NUMERO%=5 THEN  OUT &H3D8, 14 : OUT &H3D9,FOND%
IF NUMERO%=6 THEN  OUT &H3D8, 14 : OUT &H3D9,FOND%+16

END SUB