-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathARBRES.QB
132 lines (112 loc) · 3.12 KB
/
ARBRES.QB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
' 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 : CALL PAL(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)
LINE(0,100)-(319,100),1:PAINT(150,150),COULEUR$(4),1
CALL HERBE(0,110,319,199) : CALL EAU(150,180)
FOR i%=1 TO 4
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%=0 THEN NUMERO%=4
' SELECT CASE NUMERO%
OUT &H3D8, 10 : OUT &H3D9,FOND%
' CASE 2 : OUT &H3D8, 10 : OUT &H3D9,FOND%+16
' CASE 3 : OUT &H3D8, 10 : OUT &H3D9,FOND%+32
' CASE 4 : OUT &H3D8, 10 : OUT &H3D9,FOND%+48
' CASE 5 : OUT &H3D8, 14 : OUT &H3D9,FOND%
' CASE 6 : OUT &H3D8, 14 : OUT &H3D9,FOND%+16
' END SELECT
END SUB