Code : Tout sélectionner
;***déclarations***
;***16 couleurs format BRG***
#noir=$000000
#gris2=$808080
#rouge2=$000080
#kaki=$008080
#vert2=$008000
#cyan2=$808000
#bleu2=$800000
#violet=$800080
#rose=$FF00FF
#bleu=$FF0000
#cyan1=$FFFF00
#vert=$00FF00
#jaun=$00FFFF
#rouge=$0000FF
#gris=$C0C0C0
#blanc=$FFFFFF
;******
Enumeration
#vrai
#faux
#bordure
#spr_carte
#spr_bordure
#spr_mer
#spr_rivage
#spr_terre
#spr_montagne
#spr_souris
EndEnumeration
Structure couche
mer.b
terre.b
montagne.b
ID_ile.l
surface.l
visible.b
visite.b
x_detect.b
y_detect.b
EndStructure
;***variables***
Global x_map.l,y_map.l,x_carte.b,y_carte.b,tirage.s,inc_tirage.b,inc_ile.l,surface.l,montagne.l
Global Dim map.b(511,383),Dim carte.couche(63,47)
;****procedure detection***
Procedure.b detection(x.b,y.b,choix.s)
carte(x,y)\x_detect=x
carte(x,y)\y_detect=y
a.b=carte(x,y)\x_detect
b.b=carte(x,y)\y_detect
carte(a,b)\visite=1
If choix="mer"
;***test haut***
If carte(a,b-1)\mer=1 And carte(a,b-1)\visite=0
detection(a,b-1,"mer")
EndIf
;***test droite***
If carte(a+1,b)\mer=1 And carte(a+1,b)\visite=0
detection(a+1,b,"mer")
EndIf
;***test bas***
If carte(a,b+1)\mer=1 And carte(a,b+1)\visite=0
detection(a,b+1,"mer")
EndIf
;***test gauche***
If carte(a-1,b)\mer=1 And carte(a-1,b)\visite=0
detection(a-1,b,"mer")
EndIf
EndIf
If choix="terre"
carte(a,b)\ID_ile=inc_ile
;***test haut***
If carte(a,b-1)\terre=1 And carte(a,b-1)\visite=0
detection(a,b-1,"terre")
EndIf
;***test droite***
If carte(a+1,b)\terre=1 And carte(a+1,b)\visite=0
detection(a+1,b,"terre")
EndIf
;***test bas***
If carte(a,b+1)\terre=1 And carte(a,b+1)\visite=0
detection(a,b+1,"terre")
EndIf
;***test gauche***
If carte(a-1,b)\terre=1 And carte(a-1,b)\visite=0
detection(a-1,b,"terre")
EndIf
;***test haut droite***
If carte(a+1,b-1)\terre=1 And carte(a+1,b-1)\visite=0
detection(a+1,b-1,"terre")
EndIf
;***test bas droite***
If carte(a+1,b+1)\terre=1 And carte(a+1,b+1)\visite=0
detection(a+1,b+1,"terre")
EndIf
;***test bas gauche***
If carte(a-1,b+1)\terre=1 And carte(a-1,b+1)\visite=0
detection(a-1,b+1,"terre")
EndIf
;***test haut gauche***
If carte(a-1,b-1)\terre=1 And carte(a-1,b-1)\visite=0
detection(a-1,b-1,"terre")
EndIf
EndIf
EndProcedure
Procedure.b surlignage()
StartDrawing(ScreenOutput())
If carte(x_carte,y_carte-1)\terre=0;haut
Line(x_carte*16+1,y_carte*16-1,14,0,#rouge)
Line(x_carte*16,y_carte*16,16,0,#rouge)
EndIf
If carte(x_carte+1,y_carte)\terre=0;droite
Line(x_carte*16+17,y_carte*16+1,0,14,#rouge)
Line(x_carte*16+16,y_carte*16,0,16,#rouge)
EndIf
If carte(x_carte,y_carte+1)\terre=0;bas
Line(x_carte*16+1,y_carte*16+17,14,0,#rouge)
Line(x_carte*16,y_carte*16+16,16,0,#rouge)
EndIf
If carte(x_carte-1,y_carte)\terre=0;gauche
Line(x_carte*16-1,y_carte*16+1,0,14,#rouge)
Line(x_carte*16,y_carte*16,0,16,#rouge)
EndIf
DrawText(MouseX()-60,MouseY()+20,"Ile n° "+Str(carte(x_carte,y_carte)\ID_ile)+" sur "+Str(inc_ile)+" iles")
DrawText(MouseX()-60,MouseY()+40,"Surface : "+Str(surface)+" km² ("+Str(montagne*100/surface)+" % de montagnes)")
StopDrawing()
EndProcedure
;***premier découpage du tableau en cases de 64***
For y_map=0 To 383 Step 64
tirage = RSet(Bin(155+Random(100)),8,"0")
inc_tirage = 0
For x_map=0 To 511 Step 64
inc_tirage=inc_tirage+1
map(x_map,y_map)=Val(Mid(tirage,inc_tirage,1))
a.b=Val(Mid(tirage,inc_tirage,1))
carte(x_map/8,y_map/8)\terre=a
For i=0 To 7
For j=0 To 7
carte(x_map/8+i,y_map/8+j)\mer=(a Not a)
Next j
Next i
Next x_map
Next y_map
;***deuxième découpage du tableau en cases de 8
For y_map=0 To 383 Step 64
For x_map=0 To 511 Step 64
If map(x_map,y_map)=1
For j=0 To 63 Step 8
tirage = RSet(Bin(60+Random(195)),8,"0")
inc_tirage = 0
For i=0 To 63 Step 8
inc_tirage=inc_tirage+1
map(x_map+i,y_map+j)=Val(Mid(tirage,inc_tirage,1))
b.b=Val(Mid(tirage,inc_tirage,1))
carte((x_map+i)/8,(y_map+j)/8)\terre=b
carte((x_map+i)/8,(y_map+j)/8)\mer=(b Not b)
Next i
Next j
EndIf
Next x_map
Next y_map
; ***troisième découpage du tableau en cases de 4
For y_map=0 To 383 Step 8
For x_map=0 To 511 Step 8
If map(x_map,y_map)=1
For j=0 To 7 Step 4
tirage = RSet(Bin(1+Random(2)),2,"0")
inc_tirage = 0
For i=0 To 7 Step 4
inc_tirage=inc_tirage+1
map(x_map+i,y_map+j)=Val(Mid(tirage,inc_tirage,1))
Next i
Next j
EndIf
Next x_map
Next y_map
;***quatrième découpage du tableau en cases de 1
For y_map=0 To 383 Step 4
For x_map=0 To 511 Step 4
If map(x_map,y_map)=1
For j=0 To 3
tirage = RSet(Bin(Random(15)),4,"0")
inc_tirage = 0
For i=0 To 3
inc_tirage=inc_tirage+1
map(x_map+i,y_map+j)=Val(Mid(tirage,inc_tirage,1))
Next i
Next j
EndIf
Next x_map
Next y_map
;***création des bordures***
For x_carte=0 To 63
For y_carte=0 To 47
If x_carte=0 Or y_carte=0 Or x_carte=63 Or y_carte=47
carte(x_carte,y_carte)\mer=#bordure
carte( x_carte,y_carte)\terre=#bordure
carte(x_carte,y_carte)\montagne=#bordure
carte(x_carte,y_carte)\visite=#bordure
EndIf
Next y_carte
Next x_carte
;***********************************
;***bouchage des trous***
y_carte=1
For x_carte=1 To 62
If carte(x_carte,y_carte)\mer=1
detection(x_carte,y_carte,"mer")
EndIf
Next x_carte
;
y_carte=46
For x_carte=1 To 62
If carte(x_carte,y_carte)\mer=1
detection(x_carte,y_carte,"mer")
EndIf
Next x_carte
x_carte=1
For y_carte=1 To 46
If carte(x_carte,y_carte)\mer=1
detection(x_carte,y_carte,"mer")
EndIf
Next y_carte
x_carte=62
For y_carte=1 To 46
If carte(x_carte,y_carte)\mer=1
detection(x_carte,y_carte,"mer")
EndIf
Next y_carte
;
For y_carte=1 To 46
For x_carte=1 To 62
If carte(x_carte,y_carte)\visite=0 And carte(x_carte,y_carte)\mer=1
carte(x_carte,y_carte)\terre=1
carte(x_carte,y_carte)\montagne=1
carte(x_carte,y_carte)\mer=0
carte(x_carte,y_carte)\visite=0
EndIf
Next x_carte
Next y_carte
; ***identification des iles***
For y_carte=1 To 46
For x_carte= 1 To 62
If carte(x_carte,y_carte)\terre=1 And carte(x_carte,y_carte)\visite=0
inc_ile=inc_ile+1
carte(x_carte,y_carte)\ID_ile = inc_ile
detection(x_carte,y_carte,"terre")
EndIf
Next x_carte
Next y_carte
;
;***programme principal***
;***initialisation***
InitMouse()
InitKeyboard()
InitSprite()
InitSprite3D()
;********************
OpenScreen(1024,768,32,"wargame"); ouverture d'un écran de profondeur 32
;***création des sprites***
;sprite souris
CreateSprite(#spr_souris,16,16)
StartDrawing(SpriteOutput(#spr_souris))
LineXY(0,0,10,10,#rouge2)
LineXY(10,11,5,11,#rouge2)
LineXY(5,11,1,15,#rouge2)
LineXY(0,15,0,0,#rouge2)
FillArea(2,3,#rouge2,#rouge)
StopDrawing()
;sprite bordure
CreateSprite(#spr_bordure,16,16)
StartDrawing(SpriteOutput(#spr_bordure))
Box(0,0,16,16,#violet)
Box(1,1,14,14,#rose)
Box(2,2,12,12,#violet)
Box(4,4,8,8,#rose)
Box(6,6,4,4,#violet)
StopDrawing()
;sprite carte
CreateSprite(#spr_carte,1024,768)
StartDrawing(SpriteOutput(#spr_carte))
;mer
Box(16,16,992,736,#bleu2)
For i=1 To 1000
Line(Random(1020),Random(764),Random(4),1,#bleu)
Next i
For y_carte=1 To 46
For x_carte=1 To 62
If carte(x_carte,y_carte-1)\terre=1 And carte(x_carte+1,y_carte)\terre=1 And carte(x_carte,y_carte+1)\terre=1 And carte(x_carte-1,y_carte)\terre=1
Circle(x_carte*16+8,y_carte*16+8,8,#vert2)
Circle(x_carte*16+16,y_carte*16+16,5,#vert2);interstice
EndIf
Next x_carte
Next y_carte
For y_carte=0 To 47
For x_carte=0 To 63
If carte(x_carte,y_carte)\montagne=1
For i= 1 To 60
r=Random(4)
If r>1
couleur.l=#gris2
Else
couleur=#kaki
EndIf
LineXY(x_carte*16+6+Random(2),y_carte*16+Random(2),x_carte*16+Random(16),y_carte*16+Random(16),couleur)
Next i
EndIf
Next x_carte
Next y_carte
;***********tiles aléatoires**********************************
For y_map=3 To 380
For x_map=3 To 508
If map(x_map,y_map)=1
r=Random(4)
If r>1
couleur=#vert2
Else
couleur=#kaki
EndIf
Circle(x_map*2+1,y_map*2+1,Random(3)+1,couleur)
For i= 1 To 5
Plot(x_map*2-Random(2),y_map*2-Random(2),couleur)
Next i
EndIf
Next x_map
Next y_map
;***grille***
For i=2 To 62 ;lignes verticales
Line(i*16,16,0,736,#gris2)
Next i
For i=2 To 46 ;lignes horizontales
Line(16,16*i,992,0,#gris2)
Next i
StopDrawing()
UseBuffer(#spr_carte)
For y_carte=0 To 47
For x_carte=0 To 63
If carte(x_carte,y_carte)\terre=#bordure
DisplaySprite(#spr_bordure,x_carte*16,y_carte*16)
EndIf
Next x_carte
Next y_carte
UseBuffer(-1)
MouseLocate(512,384)
;***boucle principale***
Repeat
Delay(10)
DisplaySprite(#spr_carte,0,0)
DisplayTransparentSprite(#spr_souris,MouseX(),MouseY())
ExamineMouse()
numero_ile.l=carte(Int(MouseX()/16),Int(MouseY()/16))\ID_ile
surface=0
montagne=0
For y_carte=1 To 46
For x_carte=1 To 62
If carte(x_carte,y_carte)\ID_ile=numero_ile
surface=surface+1
If carte(x_carte,y_carte)\montagne=1
montagne=montagne+1
EndIf
EndIf
If numero_ile<>0 And carte(x_carte,y_carte)\ID_ile=numero_ile And MouseButton(#PB_MouseButton_Left )=1
surlignage()
EndIf
Next x_carte
Next y_carte
FlipBuffers()
Until MouseButton(2)<>0;on ferme si click droit
CloseScreen()
End