Code : Tout sélectionner
; puredash
; --------
Global slash.s
Global white
CompilerIf #PB_Compiler_OS = #PB_OS_Linux Or #PB_Compiler_OS = #PB_OS_MacOS
slash="/"
CompilerEndIf
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
slash="\"
CompilerEndIf
CreateDirectory("updates")
Global version$="1.1"
Global release=1
Global loc.s
Global noload,exitnoload,realblack
Global *buffer=AllocateMemory(256)
Global scanline3D,scanline
Global maxx=39,maxy=21,lighton
Global NewList locale.s()
Global NewList Locales.s()
Global NewList Levels.s()
Global joysticks
Global url=1,weburl$,ingamemusic,autocheckupdates
Global timetrigger2=0
Global levelpack.s="default",lvlpck.s,watercount,full
Global Dim slimecount(255),Dim cantgrow(255),snakenaturaldeath
Global NewList mv.b(),newheading
Global criticalmass
Structure timers
interval.i ; milliseconds
previous.i ; last elapsedmilliseconds()
trigered.i ; ok
EndStructure
Structure coordones
x.i
y.i
EndStructure
Structure score
name.s
points.i
level.s
EndStructure
Structure board
canfall.b ; 1 si un objet peux tomber
sprite.i ; n° du sprite
; animation
frame.i ; image actuelle
frames.i ; nombre d'images
; ------------
unstable.b ; un objet posé desuss peux tomber
endanim.b ; a la fin de l'animation on fait quoi ? 0 loop, 1... remplace le sprite parle sprite numero -1
move.b ; type de mouvmeent 1 tourne a droite, 2 tourne a gauche , 3 slime , 4 murs extensibles, 5 eau.
heading.b
killedbyboulders.b
explosionsprite.i
falledlastturn.i
activated.i
activate.i
timer.i
player.b
soundpick.i
soundstop.i
counter.i
indestructible.b
milling.i
name.s
radius.b ; explosion radius
poisoned.b ; empoisoné lethal au contact par le joueur ou les mobs non imunisé
animation_timer.i
source.coordones
link.i
linkframe.i
type.i
EndStructure
Structure liquid
turnflag.b
x.b
y.b
blocked.b
type.board
EndStructure
Structure xplod
x.i
y.i
spr.i
radius.i
EndStructure
Structure gfx
List sprite.i()
nfo.board
EndStructure
Structure regkey
ID.i
sprite.i
EndStructure
Structure snake
lastdir.b
head.coordones
List body.xplod()
EndStructure
Structure beamer
x.i
y.i
targetx.i
targety.i
heat.i
damage.i
EndStructure
Global NewList animation_timer.timers()
Global NewList beam.beamer()
Declare destroybeam(x,y)
Declare checktimer(timar)
Declare cleartimers()
Declare checkupdate()
Declare credits()
Declare scanlines()
Declare options()
Declare light()
Declare help()
Declare editor()
Declare timeserver()
Declare displaytext(x,y,t$,fnt=1)
Declare cleanvars()
Declare vicinity(x,y)
Declare restartlevel()
Declare drawlevel(message$="",fnt=1,speed=10)
Declare loadlevel(filename.s="")
Declare makesprite(spritestart,spriteEnd,canfall,unstable,endanim,move,killedbyboulders,explosionsprite,activated,activate,timer,player,soundpick,soundstop,indestructible,name.s,regkey,radius,poison,ticks,type)
Declare chk(x,y)
Declare move(x,y,x2,y2)
Declare chkfall(x,y)
Declare convheading(dir)
Declare mx(dir)
Declare my(dir)
Declare valid(x,y)
Declare explode(x,y)
Declare movemob(x,y,heading)
Declare playermove(x,y,shifted=0,dir=0)
Declare ply_key()
Declare cangrow(xt,yt)
Declare savelevel(filename.s="")
Declare gameinfo()
Declare tileinfo()
Declare gameover()
Declare drawlvl()
Declare nextlevel()
Declare nextlevel()
Declare levelproperties()
Declare animate()
Declare hi_score(pos=0)
Declare title()
Declare playgame()
Declare checkfolders()
Declare keypushed(key)
Declare refreshkeyboard()
Declare keydown(key)
Declare preferences()
Declare loadprefs()
Declare populatelevels()
Declare create_timer(ticks)
Declare loadhiscore()
Global NewList remotebomb.coordones()
Global NewList snake.snake()
Global NewList spritepack.s()
Global spritepack.s
Global lightsize=8
Global Dim liquid.liquid(maxx,maxy)
; --------------------- initialisation des modules -------------------
InitKeyboard()
InitMouse()
InitSprite()
InitSprite3D()
InitJoystick()
UsePNGImageDecoder()
UseOGGSoundDecoder()
InitSound()
checkfolders()
loadprefs()
preferences()
InitNetwork()
If autocheckupdates=1
checkupdate()
EndIf
TransparentSpriteColor(#PB_Default,$ff00ff)
loc=(Left(Locales(),Len(locales())-4))
Global music=LoadSound(#PB_Any,"droidmarch.ogg"),musicplaying
Global music2=LoadSound(#PB_Any,"dead-waiting.ogg"),musicplaying2
Global NewList sprite.i()
Global NewList newsprite.i()
Global NewList sprites.gfx()
Global NewList falling.coordones()
Global NewList unstable.coordones()
Global NewList mobs.coordones()
Global NewList kaboom.xplod()
Global NewList niveaux.s() ; liste des niveaux
Global NewList shortcut.regkey()
Global NewList hiscore.score()
Global NewList slimes.b() ; store the active slimes ID
Global maxvolume=60,maxsndvolume=60
Global player.coordones
Global player_backup.coordones
Global turnmove
Global score=0
Global live=3
Global soundfolder.s="sounds"+slash+"default"+slash
Global playerkill=0
Global collected=0
Global needed=2
Global magicwall.i
Global selected
Global edit_mode
Global playeractive
Global niveauactuel.s
Global leveltype.b
Global magicwalltimer.i
Global levelname.s
Global gameover
Global edit_mode
Global playgame,play
Global exit.coordones
Global exit_oldtile
Global player_oldtile
loadprefs()
Global rock=LoadSound(#PB_Any,soundfolder+"rock.wav")
Global diam=LoadSound(#PB_Any,soundfolder+"diamond.wav")
Global dead=LoadSound(#PB_Any,soundfolder+"death.wav")
Global herb=LoadSound(#PB_Any,soundfolder+"herb.wav")
Global herb2=LoadSound(#PB_Any,soundfolder+"herb2.wav")
Global pick=LoadSound(#PB_Any,soundfolder+"pickup.wav")
Global expl=LoadSound(#PB_Any,soundfolder+"explode.wav")
Global plop=LoadSound(#PB_Any,"plop.ogg")
Global selection=LoadSound(#PB_Any,"select.ogg")
Global Dim chars(255)
Global Dim chars2(255)
Global timer,anim,anim2,leveltime,time2,time,diamvalue,diambonus,timertime,turnmove,timetrigger=1,timedemo
; update patcher
If FileSize("patcher.ex_")>0
DeleteFile("patcher.exe")
RenameFile("patcher.ex_","patcher.exe")
EndIf
decode.s =" !"+Chr(34)+"©*%-'[]&+,_./0123456789:;¤|£?$ABCDEFGHIJKLMNOPQRSTUVWXYZ`)°?rpbfhswtynzm"
decode2.s="!"+Chr(34)+"',-.0123456789 :;?ABCDEFGHIJKLMNOPQRSTUVWXYZ`"
For a=1 To Len(decode)
chars(Asc(Mid(decode,a,1)))=(a-1)
Next
For a=1 To Len(decode2)
chars2(Asc(Mid(decode2,a,1)))=(a-1)
Next
populatelevels()
;
;
loadhiscore()
Global Dim level.board(50,30)
Global Dim level_backup.board(50,30)
;#WM_MOUSEWHEEL = $20A
Enumeration
#vide = 0
#herb
#boulder
#diamond
#titanium
#explosion
#xplodtogem
#wall
#door
#magicwall
#slime
#firefly
#papillon
#extendwall
#player
#playerleft
#playerright
#playeridle
#exit
#activemagicwall
#playerapear
#bomb
#tnt
#activetnt
#water
#killeramoeba
#snakehead0
#snakehead1
#snakehead2
#snakehead3
#snakebody
#deadsnakebody
#hbeam
#laseroff
#laseron
#fastherb
#remotecontrolbomb
#remotecontrol
EndEnumeration
; locale
Enumeration
#loc_credits=0
#loc_timelimit
#loc_livesleft
#loc_live
#loc_lives
#loc_diamond
#loc_diamonds
#loc_score
#loc_mainmenu
#loc_options
#loc_optionsnfo
#tileinfo
#editor_help
#hiscore
#wwwgo
#askversion
#askpatcher
EndEnumeration
; --------------------------- ouverture ecran -------------------------
ExamineDesktops()
Global main=OpenWindow(#PB_Any,0,0,(maxx+1)*32,(maxy+1)*32+16,"Puredash "+version$,#PB_Window_SystemMenu|#PB_Window_Normal|#PB_Window_MaximizeGadget);,#PB_Window_BorderLess
OpenWindowedScreen(WindowID(main),0,0,(maxx+1)*32,(maxy+1)*32+16,1,0,0)
FlipBuffers()
; --------------------------- keyboard mode --------------------------
KeyboardMode(#PB_Keyboard_International)
Global graphics=LoadImage(#PB_Any,"sprites"+slash+spritepack+".png")
Global font=LoadSprite(#PB_Any,"kromasky_16x16.png",#PB_Sprite_Texture)
Global bigfont=LoadSprite(#PB_Any,"anomaly.png",#PB_Sprite_Texture)
Global bigfont3D=CreateSprite3D(#PB_Any,bigfont)
Global logo=LoadSprite(#PB_Any,"logo.png")
Global light=LoadSprite(#PB_Any,"light.png",#PB_Sprite_Texture|#PB_Sprite_AlphaBlending);,#PB_Sprite_AlphaBlending)
Global LIGHT3D=CreateSprite3D(#PB_Any,light)
Global marker=LoadSprite(#PB_Any,"editormarker.png")
Global cen=WindowWidth(main)/2
Global cenv=WindowHeight(main)/2
ClipSprite(font,chars(Asc("z"))*16,0,16,16)
DisplaySprite(font,0,0)
Global scanliner=GrabSprite(#PB_Any,0,0,16,16,#PB_Sprite_Texture)
Global scanline3d=CreateSprite3D(#PB_Any,scanliner)
scanlines()
ClearScreen(0)
realblack=GrabSprite(#PB_Any,0,0,32,32)
For y=0 To 24
StartDrawing(ScreenOutput())
DrawImage(ImageID(graphics),0,(y*-1)*32,ImageWidth(graphics),ImageHeight(graphics))
StopDrawing()
For x=0 To 7
AddElement(sprite())
sprite()=GrabSprite(#PB_Any,x*32,0,32,32)
Next
Next
Global Dim imagetiles(255)
StartDrawing(ScreenOutput())
k=-1
For y=0 To 24
DrawImage(ImageID(graphics),0,(y*-1)*32,ImageWidth(graphics),ImageHeight(graphics))
For x=0 To 7
k+1
imagetiles(k)=GrabImage(graphics,#PB_Any,x*32,y*32,32,32)
Next
Next
StopDrawing()
ClearScreen($ff00ff)
Global creditscroller=GrabSprite(#PB_Any,0,0,maxx*32,32); construction des sprites animes
makesprite(0,0,0,0,0,0,0,0,#explosion,0,0,0,herb2,0,0,"VIDE",#PB_Key_V,0,-1,50,#vide) ; vide
makesprite(9,9,0,0,0,0,0,0,#explosion,0,0,0,herb,0,0,"HERBE",#PB_Key_H,0,-1,50,#herb) ; herb
makesprite(11,11,1,1,0,0,0,#explosion,0,0,0,0,0,rock,0,"BOULDER",#PB_Key_B,0,-1,50,#boulder) ; boulder
makesprite(34,41,1,1,0,0,0,#explosion,0,0,0,0,pick,diam,0,"DIAMANT",#PB_Key_D,0,-1,130,#diamond) ; diamond
makesprite(10,10,0,1,0,0,0,0,0,0,0,0,0,0,1,"TITANIUM",#PB_Key_T,0,-1,50,#titanium) ; titanium
makesprite(1,4,0,0,1,0,0,0,0,0,0,0,0,0,0,"EXPLOSION",0,0,-1,50,0) ; explosion
makesprite(1,8,0,0,4,0,0,0,0,0,0,0,0,0,0,"expl. en diam.",0,0,-1,50,0) ; xplodtogem
makesprite(12,12,0,1,0,0,0,#explosion,0,0,0,0,0,0,0,"MUR",#PB_Key_W,0,-1,50,#wall) ; wall
makesprite(13,13,0,1,0,0,0,0,0,0,0,0,0,0,1,"EXIT",0,0,-1,50,#door) ; exit
makesprite(14,17,0,1,0,0,0,#explosion,0,0,300,0,0,0,0,"MAGIC WALL",#PB_Key_M,0,-1,50,#magicwall) ; magic wall
makesprite(18,25,0,0,0,3,0,#explosion,0,0,300,0,0,0,0,"AMOEBA",#PB_Key_A,0,0,150,#slime) ; slime
makesprite(26,33,0,0,0,2,1,#explosion,0,0,0,0,0,0,0,"FIREFLIE",#PB_Key_F,1,1,50,#firefly) ; firefly
makesprite(42,49,0,0,0,1,1,#xplodtogem,0,0,0,0,0,0,0,"BUTTERFLIE",#PB_Key_P,1,1,50,#papillon) ; papillon
; no use in level design as it's player anim
makesprite(12,12,0,1,0,4,0,0,0,0,0,0,0,0,0,"EXTENDABLE WALL",#PB_Key_E,0,-1,50,#extendwall) ; extensible wall
makesprite(50,55,0,0,0,0,1,#explosion,0,0,0,1,0,0,0,"PLAYER",0,1,0,150,0) ; player
makesprite(75,82,0,0,0,0,1,#explosion,0,0,0,1,0,0,0,"PLAYER",0,1,0,150,0) ; player LEFT
makesprite(83,90,0,0,0,0,1,#explosion,0,0,0,1,0,0,0,"PLAYER",0,1,0,150,0) ; player RIGHT
makesprite(51,74,0,0,0,0,1,#explosion,0,0,0,1,0,0,0,"PLAYER",0,1,0,150,0) ; player IDLE
makesprite(91,92,0,1,0,0,0,0,0,0,0,0,0,0,1,"EXITACTIVE",0,0,-1,500,#exit) ; exit
makesprite(93,116,0,1,0,0,0,#explosion,0,0,50,0,0,0,0,"ACTIVE MAGIC WALL",0,0,-1,50,#activemagicwall) ; magic wall
makesprite(117,124,0,0,#player+1,0,0,#explosion,0,0,0,1,0,0,0,"FX",0,0,-1,50,0)
makesprite(125,125,1,1,0,0,1,#explosion,0,0,0,0,0,rock,0,"BOMB",#PB_Key_O,2,-1,50,#bomb) ; BOMB
makesprite(126,126,1,1,0,0,1,#explosion,0,0,0,0,0,rock,0,"TNT",#PB_Key_X,1,-1,50,#tnt) ; TNT
makesprite(126,127,1,1,0,0,1,#explosion,0,0,15,0,0,rock,0,"TNT ACTIVE",#PB_Key_X,4,-1,500,#activetnt) ; TNT ACTIVE
makesprite(128,134,0,0,0,5,0,0,0,0,0,0,0,0,0,"WATER",#PB_Key_R,4,-1,50,#vide) ; water
makesprite(135,142,0,0,0,3,0,#explosion,0,0,300,0,0,0,0,"KILLR AMOEBA",#PB_Key_A,01,2,50,#killeramoeba) ; slime ;
makesprite(159,161,0,0,0,6,1,#explosion,0,0,0,0,0,0,0,"SNAKE HEAD",0,1,1,500,#snakehead0) ; snake head
makesprite(162,164,0,0,0,6,1,#explosion,0,0,0,0,0,0,0,"SNAKE HEAD",0,1,1,500,#snakehead0) ; snake head
makesprite(165,167,0,0,0,6,1,#explosion,0,0,0,0,0,0,0,"SNAKE HEAD",0,1,1,500,#snakehead0) ; snake head
makesprite(168,170,0,0,0,6,1,#explosion,0,0,0,0,0,0,0,"SNAKE HEAD",0,1,1,500,#snakehead0) ; snake head
makesprite(154,158,0,0,0,0,1,#explosion,0,0,0,0,0,0,0,"SNAKE BODY",0,0,0,500,#snakebody) ; snake body
makesprite(154,158,1,1,0,0,0,#explosion,0,0,0,0,0,0,0,"DEAD SNAKE BODY",0,0,0,50,#boulder) ; snake bodyClearScreen(0)
makesprite(143,145,0,0,0,7,0,#explosion,0,0,0,0,0,0,1,"HORIZONTAL LASER BEAM",0,0,4,25,#herb) ; snake bodyClearScreen(0)
makesprite(146,149,0,0,0,7,0,#explosion,0,0,0,0,0,0,0,"LASER BEAMER OFF",0,0,4,25,#laseroff) ; snake bodyClearScreen(0)
makesprite(150,153,0,0,0,7,0,#explosion,0,0,0,0,0,0,0,"LASER BEAMER ON",0,0,4,25,#laseron) ; snake bodyClearScreen(0)
makesprite(171,171,0,0,0,8,0,0,#explosion,0,0,0,herb,0,0,"FAST GROWING HERB",#PB_Key_H,0,-1,50,#herb) ; herb
makesprite(172,173,0,0,0,0,0,#explosion,0,0,0,0,0,0,0,"REMOTE CONTROLED BOMB",0,0,-1,50,#remotecontrolbomb) ; herb
makesprite(174,175,0,0,0,0,0,0,0,0,0,0,selection,0,0,"REMOTE CONTROL",0,0,-1,50,#remotecontrol) ; herb
bcount=0
dcount=0
selected=4
title()
;
Procedure playgame()
killcount=0
time=ElapsedMilliseconds()
timertime=ElapsedMilliseconds()
time2=ElapsedMilliseconds()
If release=1
If noload=0
FirstElement(niveaux())
loadlevel("nextlevel")
EndIf
cleanvars()
restartlevel()
edit_mode=0
SelectElement(sprites(),#vide)
CopyStructure(@sprites()\nfo,@level(player\x,player\y),board)
drawlevel(levelname,2)
live=3
score=0
EndIf
Repeat
If white>0
bgcolor=$ffffff
Else
bgcolor=0
EndIf
ClearScreen(bgcolor)
ev=WaitWindowEvent(0)
timetrigger2=0
timeserver()
If timer=0 And edit_mode=0
If leveltype=0 Or noload=1 ; normal
live -1
t=ElapsedMilliseconds()
Repeat
refreshkeyboard()
ClearScreen(0)
WaitWindowEvent(0)
timeserver()
drawlvl()
cleartimers();anim=0
animate()
SelectElement(locale(),#loc_timelimit)
displaytext(-1,-1,locale())
FlipBuffers()
anim2=0
Until ElapsedMilliseconds()-t>10000
If live=0
gameover=1: ProcedureReturn
Else
restartlevel()
SelectElement(sprites(),#exit)
CopyStructure(@sprites()\nfo,@level(player\x,player\y),board)
DRAWLEVEL("* ATTENTION !!! IL VOUS RESTE "+Str(LIVE)+" VIES *")
EndIf
Else ; intermission
nextlevel()
EndIf
EndIf
RefreshKeyboard()
drawlvl()
cleartimers();anim
If anim2=1
If ListSize(falling())=0
Select playeractive
Case 0
SelectElement(sprites(),#playerapear)
CopyStructure(@sprites()\nfo,level(player\x,player\y),board)
playeractive=1
Case 1
If level(player\x,player\y)\sprite=#player
playeractive=2
EndIf
EndSelect
EndIf
EndIf
animate()
;
If keypushed(#PB_Key_Escape)
If noload=1
exitnoload=0
EndIf
ProcedureReturn
EndIf
;
;
xd=WindowMouseX(main)/32
yd=(WindowMouseY(main)-16)/32
If noload=1
If keypushed(#PB_Key_F8)Or exitnoload=1
exitnoload=0
ProcedureReturn
EndIf
EndIf
If anim2=1
ply_key()
EndIf
light()
gameinfo()
FlipBuffers()
If playerkill<>0
If anim2=1
killcount+1
EndIf
If killcount=10
If leveltype=0 Or noload=1; normal
live -1
If live=0
gameover=1:ProcedureReturn
Else
restartlevel()
SelectElement(sprites(),#exit)
CopyStructure(@sprites()\nfo,@level(player\x,player\y),board)
DRAWLEVEL("* ATTENTION !!! IL VOUS RESTE "+Str(LIVE)+" VIES *")
EndIf
Else ;intermission
If noload=0
nextlevel()
EndIf
EndIf
killcount=0
EndIf
EndIf
anim2=0
cleartimers();anim=0
If ev=#PB_Event_CloseWindow
End
EndIf
ForEver
EndProcedure
Procedure displaytext(x,y,t$,fnt=1)
;
Dim tempchars(0)
If fnt=1
size=16
usefont=font
CopyArray(chars(),tempchars())
Else
usefont=bigfont
size=32
CopyArray(chars2(),tempchars())
EndIf
trame=1
If x=-1 ; centered
lt=Len(t$)*size
x=cen-(lt/2)
EndIf
If y<0
y=Abs(y)
bg=trame
EndIf
If Abs(Y)=999
lt=Len(t$)*size
y=cenv-(lt/2)
EndIf
;
For a = 1 To Len(t$)
If bg=trame
If y=0
ClipSprite(usefont,tempchars(Asc(" "))*size,0,*size,size)
DisplayTransparentSprite(usefont,x+a*size,y)
EndIf
ClipSprite(usefont,tempchars(Asc("`"))*size,0,size,size)
DisplayTransparentSprite(usefont,x+a*size,y)
EndIf
ClipSprite(usefont,tempchars(Asc(Mid(t$,a,1)))*size,0,size,size)
DisplayTransparentSprite(usefont,x+a*size,y)
Next
;
EndProcedure
Procedure cleanvars()
ClearList(falling())
ClearList(unstable())
ClearList(mobs())
ClearList(kaboom())
cleartimers();anim=0
anim2=0
Dim cantgrow(255)
turnmove=0
If criticalmass=0
criticalmass=200
EndIf
Dim slimecount(255)
playerkill=0
player=player_backup
magicwall=0
collected=0
playeractive=0
timer=leveltime
Dim liquid.liquid(maxx,maxy)
ClearList(snake())
ClearList(beam())
EndProcedure
Procedure vicinity(x,y)
If level(x+1,y)\poisoned>=0 And level(x,y)\poisoned<>level(x+1,y)\poisoned
ProcedureReturn 1
EndIf
If level(x,y+1)\poisoned>=0 And level(x,y)\poisoned<>level(x,y+1)\poisoned
ProcedureReturn 1
EndIf
If level(x,y-1)\poisoned>=0 And level(x,y)\poisoned<>level(x,y-1)\poisoned
ProcedureReturn 1
EndIf
If level(x-1,y)\poisoned>=0 And level(x,y)\poisoned<>level(x-1,y)\poisoned
ProcedureReturn 1
EndIf
EndProcedure
Procedure restartlevel()
CopyArray(level_backup(),level())
cleanvars()
EndProcedure
Procedure drawlevel(message$="",fnt=1,speed=10)
;time=ElapsedMilliseconds()
NewList todraw.coordones()
For x=0 To maxx
For y=0 To maxy
If level(x,y)\sprite=#remotecontrolbomb
AddElement(remotebomb())
remotebomb()\x=x
remotebomb()\y=y
EndIf
If level(x,y)\move=3; slime
If ListSize(slimes())=0
AddElement(slimes())
slimes()=level(x,y)\sprite
Else
found=0
ForEach slimes()
If slimes()=level(x,y)\sprite
found=1
Break
EndIf
Next
If found=0
AddElement(slimes())
slimes()=level(x,y)\sprite
Debug level(x,y)\name
EndIf
EndIf
EndIf
AddElement(todraw())
todraw()\x=x
todraw()\y=y
Next
Next
Repeat
ClearScreen(0)
drawlvl()
For a=1 To speed
SelectElement(todraw(),Random(ListSize(todraw())-1))
DeleteElement(todraw(),1)
Next
ForEach todraw()
SelectElement(sprites(),#vide)
SelectElement(sprites()\sprite(),0)
DisplaySprite(sprites()\sprite(),todraw()\x*32,16+todraw()\y*32)
Next
light()
If message$<>""
displaytext(-1,-999,message$,fnt)
EndIf
WaitWindowEvent(0)
FlipBuffers()
Until ListSize(todraw())=0
EndProcedure
Procedure loadlevel(filename.s="")
If filename=""
ReleaseMouse(1)
filename.s=OpenFileRequester("chargement du niveau","","niveaux|*.dsh",0)
ReleaseMouse(0)
ElseIf filename.s="nextlevel"
filename.s=niveaux()
EndIf
If FileSize(filename)>0
rd=OpenFile(#PB_Any,filename)
niveauactuel=filename
If rd
version.s=ReadString(rd)
Select version
Case "V2"
player_backup\x=ReadByte(rd)
player_backup\y=ReadByte(rd)
Case "V3"
player_backup\x=ReadByte(rd)
player_backup\y=ReadByte(rd)
leveltype =ReadByte(rd)
leveltime =ReadInteger(rd)
needed =ReadInteger(rd)
magicwalltimer= ReadInteger(rd)
diamvalue=ReadByte(rd)
diambonus=ReadByte(rd)
criticalmass=ReadByte(rd)
ReadByte(rd); reserved
ReadInteger(rd)
ReadInteger(rd)
ReadInteger(rd)
ReadInteger(rd)
ReadInteger(rd)
ReadInteger(rd)
ReadInteger(rd)
ReadInteger(rd)
ReadInteger(rd)
levelname=ReadString(rd)
Default
FileSeek(rd,0)
player_backup\x=ReadInteger(rd)
player_backup\y=ReadInteger(rd)
EndSelect
For x=0 To maxx
For y=0 To maxy
Select version
Case "V2","V3"
spr=ReadByte(rd)
Default
spr=ReadInteger(rd)
EndSelect
SelectElement(sprites(),spr)
If spr=#exit
exit\x=x
exit\y=y
EndIf
CopyStructure(@sprites()\nfo,@level(x,y),board)
CopyStructure(@sprites()\nfo,@level_backup(x,y),board)
CopyArray(level(),level_backup())
Next
Next
CloseFile(rd)
EndIf
EndIf
;Delay(500)
If criticalmass=0:criticalmass=200:EndIf
EndProcedure
Procedure makesprite(spritestart,spriteEnd,canfall,unstable,endanim,move,killedbyboulders,explosionsprite,activated,activate,timer,player,soundpick,soundstop,indestructible,name.s,regkey,radius,poison,ticks,type)
AddElement(sprites())
sprites()\nfo\frames=(spriteEnd-spritestart)+1
sprites()\nfo\frame=1
sprites()\nfo\canfall=canfall
sprites()\nfo\unstable=unstable
sprites()\nfo\endanim=endanim
sprites()\nfo\sprite=ListIndex(sprites())
sprites()\nfo\move=move
sprites()\nfo\heading=1
sprites()\nfo\killedbyboulders=killedbyboulders
sprites()\nfo\explosionsprite=explosionsprite
sprites()\nfo\activated=activated
sprites()\nfo\activate=activate
sprites()\nfo\timer=timer
sprites()\nfo\player=player
sprites()\nfo\soundpick=soundpick
sprites()\nfo\soundstop=soundstop
sprites()\nfo\indestructible=indestructible
sprites()\nfo\name=name
sprites()\nfo\radius=radius
sprites()\nfo\poisoned=poison
sprites()\nfo\animation_timer=create_timer(ticks)
sprites()\nfo\type=type
If regkey<>0
AddElement(shortcut())
shortcut()\id=regkey
shortcut()\sprite=ListIndex(sprites())
EndIf
For a=1 To sprites()\nfo\frames
AddElement(sprites()\sprite())
SelectElement(sprite(),spritestart+(a-1))
sprites()\sprite()=sprite()
Next
EndProcedure
Procedure chk(x,y)
If level(x,y)\canfall=1
If x>0 And x<maxx And y>0 And y<maxy
SelectElement(sprites(),level(x,y+1)\sprite)
If level(x,y+1)\sprite=#vide
AddElement(falling())
level(x,y)\falledlastturn=1
falling()\x=x
falling()\y=y
ElseIf sprites()\nfo\unstable=1
AddElement(unstable())
unstable()\x=x
unstable()\y=y
If IsSound(level(x,y)\soundstop) And level(x,y)\falledlastturn=1
snd=level(x,y)\soundstop
If level(x,y+1)\sprite=#magicwall
magicwall=magicwalltimer
SelectElement(sprites(),#activemagicwall)
CopyStructure(@sprites()\nfo,@level(x,y+1),board)
Select level(x,y)\sprite
Case #boulder
level(x,y+1)\milling=#diamond
Case #diamond
level(x,y+1)\milling=#boulder
EndSelect
SelectElement(sprites(),#vide)
CopyStructure(@sprites()\nfo,@level(x,y),board)
EndIf
If level(x,y+1)\sprite=#activemagicwall
If magicwall>0
Select level(x,y)\sprite
Case #boulder
level(x,y+1)\milling=#diamond
Case #diamond
level(x,y+1)\milling=#boulder
EndSelect
Else
level(x,y+1)\milling=#vide
EndIf
SelectElement(sprites(),#vide)
CopyStructure(@sprites()\nfo,@level(x,y),board)
EndIf
PlaySound(snd,#PB_Sound_MultiChannel,maxsndvolume)
Select level(x,y+1)\sprite
Case #bomb,#tnt,#activetnt
explode(x,y+1)
EndSelect
Select level(x,y)\sprite
Case #bomb
explode(x,y)
EndSelect
EndIf
level(x,y)\falledlastturn=0
ElseIf level(x,y)\falledlastturn=1
If sprites()\nfo\killedbyboulders=1
AddElement(falling())
level(x,y)\falledlastturn=1
falling()\x=x
falling()\y=y
Else
If IsSound(level(x,y)\soundstop)And level(x,y)\falledlastturn=1
PlaySound(level(x,y)\soundstop,#PB_Sound_MultiChannel,maxsndvolume)
Select level(x,y)\sprite
Case #bomb
explode(x,y)
EndSelect
EndIf
level(x,y)\falledlastturn=0
EndIf
EndIf
EndIf
EndIf
SelectElement(sprites(),level(x,y)\sprite)
If sprites()\nfo\move<>0
If sprites()\nfo\move=3 And slimecount(level(x,y)\sprite)>=0
slimecount(level(x,y)\sprite) +1
EndIf
If sprites()\nfo\move=5 And watercount>=0
watercount +1
EndIf
AddElement(mobs())
mobs()\x=x
mobs()\y=y
EndIf
EndProcedure
Procedure move(x,y,x2,y2)
If x>0 And x<maxx And y>0 And y<maxy
CopyStructure(@level(x,y),@level(x2,y2),board)
SelectElement(sprites(),0)
CopyStructure(@sprites()\nfo,@level(x,y),board)
EndIf
EndProcedure
Procedure chkfall(x,y)
If level(x,y)\canfall=1
If level(x,y+1)\unstable=1
If level(x-1,y)\sprite=#vide Or level(x+1,y)\sprite=#vide
If level(x-1,y)\sprite=#vide And level(x-1,y+1)\sprite=#vide And level(x+1,y)\sprite=#vide And level(x+1,y+1)\sprite=#vide
ProcedureReturn Random(1)+1
ElseIf level(x-1,y)\sprite=#vide And level(x-1,y+1)\sprite=#vide
ProcedureReturn 1 ; left
ElseIf level(x+1,y)\sprite=#vide And level(x+1,y+1)\sprite=#vide
ProcedureReturn 2 ; right
EndIf
EndIf
EndIf
EndIf
EndProcedure
Procedure convheading(dir)
If dir<1
dir=4-Abs(dir)
EndIf
If dir>4
dir=Abs(4-dir)
EndIf
ProcedureReturn dir
EndProcedure
Procedure mx(dir)
dir=convheading(dir)
Select dir
Case 1
ProcedureReturn 0
Case 2
ProcedureReturn 1
Case 3
ProcedureReturn 0
Case 4
ProcedureReturn -1
EndSelect
EndProcedure
Procedure my(dir)
dir=convheading(dir)
Select dir
Case 1
ProcedureReturn -1
Case 2
ProcedureReturn 0
Case 3
ProcedureReturn 1
Case 4
ProcedureReturn 0
EndSelect
EndProcedure
Procedure valid(x,y)
If x>=0 And y>=0 And x<=maxx And y<=maxy
ProcedureReturn 1
EndIf
EndProcedure
Procedure explode(x,y)
PlaySound(expl,#PB_Sound_MultiChannel,maxsndvolume)
AddElement(kaboom())
kaboom()\x=x
kaboom()\y=y
kaboom()\spr=level(x,y)\explosionsprite
kaboom()\radius=level(x,y)\radius
ForEach kaboom()
For ay=-kaboom()\radius To kaboom()\radius
For ax=-kaboom()\radius To kaboom()\radius
If valid(x+ax,y+ay)
If level(x+ax,y+ay)\killedbyboulders ; next explosioon
If snakenaturaldeath=0
If level(x+ax,y+ay)\sprite=#snakebody
ForEach snake()
found=0
SelectElement(sprites(),#deadsnakebody)
ForEach snake()\body()
If x+ax=snake()\body()\x And y+ay=snake()\body()\y
found=1
EndIf
If found=1
SelectElement(sprites(),#deadsnakebody)
CopyStructure(@sprites()\nfo,@level(snake()\body()\x,snake()\body()\y),board)
DeleteElement(snake()\body())
EndIf
Next
Next
EndIf
EndIf
ForEach kaboom()
fnd=0
If kaboom()\x=x+ax And kaboom()\y=ay+y
fnd=1
EndIf
If fnd=0
AddElement(kaboom())
PlaySound(expl,#PB_Sound_MultiChannel,maxsndvolume)
kaboom()\x=x+ax
kaboom()\y=y+ay
kaboom()\spr=level(x+ax,y+ay)\explosionsprite
kaboom()\radius=level(x+ax,y+ay)\radius
If x+ax=player\x And y+ay=player\y
playerkill=1
EndIf
EndIf
Next
EndIf
EndIf
Next
Next
Next
ForEach kaboom()
For ay=-kaboom()\radius To kaboom()\radius
For ax=-kaboom()\radius To kaboom()\radius
SelectElement(sprites(),kaboom()\spr)
If valid(x+ax,y+ay)
If level(kaboom()\x+ax,kaboom()\y+ay)\indestructible=0
If level(x+ax,y+ay)\sprite=#laseron
destroybeam(x+ax,y+ay)
EndIf
CopyStructure(@sprites()\nfo,@level(kaboom()\x+ax,kaboom()\y+ay),board)
EndIf
EndIf
Next
Next
DeleteElement(kaboom())
Next
EndProcedure
Procedure movemob(x,y,heading)
If vicinity(x,y)=0
heading=convheading(heading)
turnx=x+mx(heading)
turny=y+my(heading)
If valid(turnx,turny)
Select level(turnx,turny)\sprite
Case #vide
level(x,y)\heading=heading
move(x,y,turnx,turny)
ProcedureReturn 1
Case #boulder,#diamond
If level(turnx,turny)\falledlastturn=1 And heading=1
explode(x,y)
EndIf
Default
If level(x,y)\poisoned<>0
If level(turnx,turny)\poisoned >=0
If level(turnx,turny)\poisoned <> level(x,y)\poisoned
explode(x,y)
EndIf
EndIf
EndIf
EndSelect
EndIf
Else
explode(x,y)
EndIf
EndProcedure
Procedure playermove(x,y,shifted=0,dir=0)
Static push
what=level(x,y)\sprite
Select level(x,y)\type
Case #vide,#herb,#diamond,#water
If level(x,y)\sprite=#diamond
collected+1
If collected<=needed
score+diamvalue
Else
score+diambonus
EndIf
EndIf
If collected=needed And white=0
Debug "white=100"
white=100
EndIf
If IsSound(level(x,y)\soundpick)
PlaySound(level(x,y)\soundpick,#PB_Sound_MultiChannel,maxsndvolume)
EndIf
If shifted=0
move(player\x,player\y,x,y)
player\x=x
player\y=y
Else
SelectElement(sprites(),#vide)
CopyStructure(@sprites()\nfo,@level(x,y),board)
EndIf
Case #boulder
xdif=x-player\x
ydif=y-player\y
If level(x+xdif,y+ydif)\sprite=#vide And ydif=0 ; poussable seulement horizontalement
If push=3
push=0
If IsSound(level(x,y)\soundstop); And level(x,y)\falledlastturn=1
PlaySound(level(x,y)\soundstop,#PB_Sound_MultiChannel,maxsndvolume)
EndIf
move(x,y,x+xdif,y+ydif)
If shifted=0
move(player\x,player\y,x,y)
player\x=x
player\y=y
EndIf
ProcedureReturn
EndIf
If push<3
push +1
ProcedureReturn
EndIf
EndIf
Case #exit
If noload=0
If leveltype=1
live +1
EndIf
Repeat
timer -1
score +10
gameinfo()
Delay(5)
light()
FlipBuffers()
Until timer=0
nextlevel()
Else
exitnoload=1
EndIf
Case #tnt,#activetnt
xdif=x-player\x
ydif=y-player\y
If shifted=1 And what=#tnt
SelectElement(sprites(),#activetnt)
CopyStructure(@sprites()\nfo,@level(x,y),board)
EndIf
If level(x+xdif,y+ydif)\sprite=#vide And ydif=0 ; poussable seulement horizontalement shift arme le tnt
If push=5
push=0
If IsSound(level(x,y)\soundstop); And level(x,y)\falledlastturn=1
PlaySound(level(x,y)\soundstop,#PB_Sound_MultiChannel,maxsndvolume)
EndIf
move(x,y,x+xdif,y+ydif)
If shifted=0
move(player\x,player\y,x,y)
player\x=x
player\y=y
EndIf
ProcedureReturn
EndIf
If push<5
push +1
ProcedureReturn
EndIf
EndIf
Case #laseroff
If shifted=1
SelectElement(sprites(),#laseron)
CopyStructure(@sprites()\nfo,@level(x,y),board)
AddElement(beam())
level(x,y)\link=ListIndex(beam())
add=1
SelectElement(sprites(),#hbeam)
Repeat
If level(x+add,y)\sprite=#vide
CopyStructure(@sprites()\nfo,@level(x+add,y),board)
level(x+add,y)\source\x=x
level(x+add,y)\source\y=y
add+1
Else
Break
EndIf
ForEver
beam()\targetx=x+add
beam()\targety=y
beam()\x=x
beam()\y=y
EndIf
Case #laseron
If shifted=1
SelectElement(sprites(),#vide)
add=1
Repeat
If level(x+add,y)\sprite=#hbeam
CopyStructure(@sprites()\nfo,@level(x+add,y),board)
add+1
Else
Break
EndIf
ForEver
SelectElement(beam(),level(x,y)\link)
DeleteElement(beam(),1)
SelectElement(sprites(),#laseroff)
CopyStructure(@sprites()\nfo,@level(x,y),board)
EndIf
Case #remotecontrol
If shifted=1
If IsSound(level(x,y)\soundpick)
PlaySound(level(x,y)\soundpick,#PB_Sound_MultiChannel,maxsndvolume)
EndIf
ForEach(remotebomb())
explode(remotebomb()\x,remotebomb()\y)
DeleteElement(remotebomb())
Next
EndIf
EndSelect
EndProcedure
Procedure ply_key()
If playeractive=2 And playerkill=0
Static lastkey.i,ax,ay,spr
If keydown(#PB_Key_LeftShift) Or keydown(#PB_Key_RightShift)
shifted=1
EndIf
If keydown(#PB_Key_Down)=0 And keydown(#PB_Key_Left)=0 And keydown(#PB_Key_Up)=0 And keydown(#PB_Key_Right)=0 And playerkill=0 And JoystickAxisX(0)=0 And JoystickAxisY(0)=0
lastkey=0
If level(player\x,player\y)\sprite<>#playeridle
SelectElement(sprites(),#playeridle)
CopyStructure(@sprites()\nfo,@level(player\x,player\y),board)
EndIf
EndIf
If lastkey=#PB_Key_Up
k1=#PB_Key_Left
k2=#PB_Key_Right
k3=#PB_Key_Down
k4=#PB_Key_Up
EndIf
If lastkey=#PB_Key_Down
k1=#PB_Key_Left
k2=#PB_Key_Right
k3=#PB_Key_Up
k4=#PB_Key_Down
EndIf
If lastkey=#PB_Key_Left
k1=#PB_Key_Up
k2=#PB_Key_Down
k3=#PB_Key_Right
k4=#PB_Key_Left
EndIf
If lastkey=#PB_Key_Right
k1=#PB_Key_Up
k2=#PB_Key_Down
k3=#PB_Key_Left
k4=#PB_Key_Right
EndIf
If lastkey=0
k1=#PB_Key_Left
k2=#PB_Key_Right
k3=#PB_Key_Down
k4=#PB_Key_Up
EndIf
For i=1 To 4
Select i
Case 1
key=k1
Case 2
key=k2
Case 3
key=k3
Case 4
key=k4
EndSelect
Select key
Case #PB_Key_Up
spr=#player
ax=0:ay=-1
Case #PB_Key_Down
spr=#player
ax=0:ay=1
Case #PB_Key_Left
spr=#playerleft
ax=-1:ay=0
Case #PB_Key_Right
spr=#playerright
ax=1:ay=0
EndSelect
If JoystickAxisX(0)=0 And JoystickAxisY(0)=0
If keydown(key)
If turnmove=0
turnmove=01
If level(player\x,player\y)\sprite<>spr
SelectElement(sprites(),spr)
CopyStructure(@sprites()\nfo,@level(player\x,player\y),board)
EndIf
playermove(player\x+ax,player\y+ay,shifted)
lastkey=key
EndIf
EndIf
Else
If turnmove=0
turnmove=01
ax=0
ay=0
If JoystickAxisX(0)
ax=JoystickAxisX(0)
ElseIf JoystickAxisY(0)
ay=JoystickAxisY(0)
EndIf
Select ax
Case -1
spr=#playerleft
lastkey=#PB_Key_Left
Case 1
spr=#playerright
lastkey=#PB_Key_Right
EndSelect
Select ay
Case -1
spr=#player
lastkey=#PB_Key_Up
Case 1
spr=#player
lastkey=#PB_Key_Down
EndSelect
turnmove=01
If level(player\x,player\y)\sprite<>spr
SelectElement(sprites(),spr)
CopyStructure(@sprites()\nfo,@level(player\x,player\y),board)
EndIf
playermove(player\x+ax,player\y+ay,shifted)
EndIf
EndIf
Next i
EndIf
EndProcedure
Procedure cangrow(xt,yt)
If level(xt-1,yt)\sprite=#vide
ProcedureReturn 1
EndIf
If level(xt+1,yt)\sprite=#vide
ProcedureReturn 1
EndIf
If level(xt,yt-1)\sprite=#vide
ProcedureReturn 1
EndIf
If level(xt,yt+1)\sprite=#vide
ProcedureReturn 1
EndIf
If level(xt-1,yt)\sprite=#herb
ProcedureReturn 1
EndIf
If level(xt+1,yt)\sprite=#herb
ProcedureReturn 1
EndIf
If level(xt,yt-1)\sprite=#herb
ProcedureReturn 1
EndIf
If level(xt,yt+1)\sprite=#herb
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
Procedure savelevel(filename.s="")
If filename=""
ReleaseMouse(1)
filename=SaveFileRequester("sauvegarde du niveau","","niveaux|*.dsh",0)
ReleaseMouse(0)
If FileSize(filename)>=0
ReleaseMouse(1)
req=MessageRequester("LE FICHIER EXISTE DEJA","voulez vous vraiment remplacer le fichier ?",#PB_MessageRequester_YesNo)
ReleaseMouse(0)
EndIf
Else ; force save
req=#PB_MessageRequester_Yes
EndIf
;
If FileSize(filename)<=0 Or req=#PB_MessageRequester_Yes
If filename<>""
wr=CreateFile(#PB_Any,filename)
If wr
WriteStringN(wr,"V3")
WriteByte(wr,player_backup\x)
WriteByte(wr,player_backup\y)
WriteByte (wr,leveltype )
WriteInteger(wr,leveltime )
WriteInteger(wr,needed )
WriteInteger(wr,magicwalltimer)
WriteByte(wr,diamvalue)
WriteByte(wr,diambonus)
WriteByte(wr,criticalmass)
WriteByte(wr,0)
WriteInteger(wr,0) ; reserved
WriteInteger(wr,0) ; reserved
WriteInteger(wr,0) ; reserved
WriteInteger(wr,0) ; reserved
WriteInteger(wr,0) ; reserved
WriteInteger(wr,0) ; reserved
WriteInteger(wr,0) ; reserved
WriteInteger(wr,0) ; reserved
WriteInteger(wr,0) ; reserved
WriteStringN(wr,levelname)
For x=0 To maxx
For y=0 To maxy
WriteByte(wr,level_backup(x,y)\sprite)
Next
Next
CloseFile(wr)
EndIf
EndIf
EndIf
EndProcedure