puredash

Programmation avancée de jeux en PureBasic
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Re: puredash

Message par kelebrindae »

Bravo, c'est très fidèle à l'original, tout en proposant quelques nouveautés bien sympa ! :D

Suggestion: Pourrais-tu proposer dans les options un réglage de la vitesse de déplacement du joueur ? Comme ça, chacun peut régler la réactivité de Rockford (c'est le nom du personnage, je crois) à sa convenance; il me semble qu'il y avait une option comme ça dans Fruity Frank...
Les idées sont le souvenir de choses qui ne se sont pas encore produites.
G-Rom
Messages : 3627
Inscription : dim. 10/janv./2010 5:29

Re: puredash

Message par G-Rom »

Marche pas sous wine :/
on peut avoir une version Linux ou tu utilises des api w32 en masse ?
Avatar de l’utilisateur
case
Messages : 1528
Inscription : lun. 10/sept./2007 11:13

Re: puredash

Message par case »

je vais voir ce que je peux faire pour toi :)
ImageImage
Avatar de l’utilisateur
SPH
Messages : 4727
Inscription : mer. 09/nov./2005 9:53

Re: puredash

Message par SPH »

Au level 4, il n'y a pas de diamants. Est ce normal ?? Comment finir le level ???
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
case
Messages : 1528
Inscription : lun. 10/sept./2007 11:13

Re: puredash

Message par case »

oui c'est normal :)

il n'y a pas de diamants mais il y a de quoi en fabriquer :)
ImageImage
Avatar de l’utilisateur
SPH
Messages : 4727
Inscription : mer. 09/nov./2005 9:53

Re: puredash

Message par SPH »

case a écrit :oui c'est normal :)

il n'y a pas de diamants mais il y a de quoi en fabriquer :)
comment ca ? :|
Il n'y a que des pierres, de l'herbe et 4 monstres !
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: puredash

Message par falsam »

Faits manger des pierres et de l'herbe aux monstres pour voir ce qui en ressort :p
Bon ok ..... c'est nul.
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
case
Messages : 1528
Inscription : lun. 10/sept./2007 11:13

Re: puredash

Message par case »

la réponse est dans ta question SPH. si je te dis que tu a de quoi en fabriquer, te reste plus qu'a déduire comment :)
ImageImage
Avatar de l’utilisateur
SPH
Messages : 4727
Inscription : mer. 09/nov./2005 9:53

Re: puredash

Message par SPH »

case a écrit :la réponse est dans ta question SPH. si je te dis que tu a de quoi en fabriquer, te reste plus qu'a déduire comment :)
envoyer une pierre sur un monstre?
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Re: puredash

Message par Le Soldat Inconnu »

J'ai toujours un peu de mal avec le temps de réaction du personnage.
La gestion de l'appui sur les touches est étrange. Il ne prend pas tous les évènements.


je serai tenté de te faire la même remarque qu'à Huitbit sur son sokoban. mais n'ayant pas le code, je m'avance peut-être :)
Sur le sokoban, j'avais modifié la gestion du clavier comme ceci

Code : Tout sélectionner

;-gestion du clavier
	If ElapsedMilliseconds()-chrono_keyboard>200
		ExamineKeyboard()
		;-appel de la macro clavier
		If KeyboardPushed(#PB_Key_Right)
			clavier(1, 0)
			chrono_keyboard=ElapsedMilliseconds()
		EndIf
		If KeyboardPushed(#PB_Key_Left)
			clavier(-1, 0)
			chrono_keyboard=ElapsedMilliseconds()
		EndIf
		If KeyboardPushed(#PB_Key_Down)
			clavier(0, 1)
			chrono_keyboard=ElapsedMilliseconds()
		EndIf
		If KeyboardPushed(#PB_Key_Up)
			clavier(0, -1)
			chrono_keyboard=ElapsedMilliseconds()
		EndIf
	EndIf
Pas d'évènement perdu, et la vitesse des touches est gérer par ElapsedMilliseconds()-chrono_keyboard>200

Après, je sais pas si c'est adaptable sur ton code.
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Avatar de l’utilisateur
case
Messages : 1528
Inscription : lun. 10/sept./2007 11:13

Re: puredash

Message par case »

merci pour le code je vais voir si je peux modifier en ce sens
ImageImage
Avatar de l’utilisateur
case
Messages : 1528
Inscription : lun. 10/sept./2007 11:13

Re: puredash

Message par case »

mise a jour 1.1
ImageImage
Avatar de l’utilisateur
case
Messages : 1528
Inscription : lun. 10/sept./2007 11:13

Re: puredash

Message par case »

code source en 2 posts car ça rentre pas ^^

attention ça pique les yeux :)

nécessite une version antérieure de purebasic, testé ok sur 1.61

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
Dernière modification par case le jeu. 09/juil./2015 21:57, modifié 1 fois.
ImageImage
Avatar de l’utilisateur
case
Messages : 1528
Inscription : lun. 10/sept./2007 11:13

Re: puredash

Message par case »

Code : Tout sélectionner

Procedure gameinfo()
   SelectElement(locale(),#loc_diamonds)
   string.s=locale()+" £:"+Str(collected)+"/"+Str(needed)
   If live>1
      SelectElement(locale(),#loc_lives)
   Else
      SelectElement(locale(),#loc_live)
   EndIf
   string+" "+locale()+" :"+LSet(RSet("",live,"*"),3," ")+" ¤:"+RSet(Str(timer),4," ")+" "
   SelectElement(locale(),#loc_score)
   string+locale()+" :"+Str(score)
   ;
   ClipSprite(font,chars(Asc(")"))*16,0,16,16)
   For a=0 To Len(string)-1
      DisplaySprite(font,a*16,0)
   Next
   displaytext(0,0,string)
EndProcedure
Procedure tileinfo()
   SelectElement(sprites(),Selected)
   SelectElement(locale(),#tileinfo)
   string.s=StringField(locale(),1,",")+LSet(sprites()\nfo\name,15," ")+StringField(locale(),2,",");" [F1] AIDE"
   displaytext(0,0,string)
   a=1
EndProcedure
Procedure help()
   SelectElement(locale(),#editor_help)
   For a=1 To CountString(locale(),",")+1
      displaytext(0,-(a*16),StringField(locale(),a,","))
   Next
EndProcedure

Procedure gameover()
   timedemo=0
   loadlevel("game_over.dsh")
   drawlevel()
   ypos=cenv*2
   SortStructuredList(hiscore(),#PB_Sort_Descending,OffsetOf(score\points),#PB_Sort_Long)
   ForEach hiscore()
      If score>hiscore()\points
         InsertElement(hiscore())
         hiscore()\name=""
         hiscore()\points=score
         hiscore()\level=levelname
         enterscore=ListIndex(hiscore())+1
         LastElement(hiscore())
         DeleteElement(hiscore())
         Break
      EndIf
   Next
   Repeat
      refreshkeyboard()
      ClearScreen($ff00ff)
      credits()
      WaitWindowEvent(0)
      timeserver()
      drawlvl()
      cleartimers();anim=0
      
      If ypos>176
         ypos-2
      Else
         If enterscore<>0 And ex=0
            ex=hi_score(enterscore-1)
            timedemo=0
            enterscore=0
            score=0
         EndIf
      EndIf
      FirstElement(hiscore())
      SelectElement(locale(),#hiscore)
      displaytext(-1,-(ypos-48) ,UCase(levelpack),2)
      
      displaytext(-1,-(ypos)   ,StringField(locale(),1,","),2)
      displaytext(-1,-(ypos+32)  ,StringField(locale(),2,","))
      For a=1 To 10
         displaytext(-1,-(ypos+48+(a*32))  ,LSet(hiscore()\name,15," ")+RSet(Str(hiscore()\points),8," ")+RSet(hiscore()\level,15," "))
         NextElement(hiscore())
      Next
      If timetrigger=1
         displaytext(-1,-(ypos+48+((a+1)*32))  ,StringField(locale(),3,","))
      Else
         displaytext(-1,-(ypos+48+((a+1)*32))  ,StringField(locale(),4,","))
      EndIf
      DisplayTransparentSprite(creditscroller,32,maxy*32)
      FlipBuffers()
      ;
      cleartimers();anim=0
      Dim cantgrow(255)
      
      animate()
      anim2=0
      
      
      If timedemo=50
         timedemo=0
         ProcedureReturn
      EndIf
      ;
      If keypushed(#PB_Key_Escape)
         ProcedureReturn
      EndIf
      
      If ev=#PB_Event_CloseWindow
         End
      EndIf
   Until  keypushed(#PB_Key_Space)
   playgame=1
EndProcedure
Procedure drawlvl()
   ForEach slimes();For a=0 To 255
      If slimecount(slimes())>=0
         If anim2=1
            slimecount(slimes())=0
         EndIf
      EndIf
   Next
   ForEach beam()
      beam()\damage+10
      beam()\heat+1
      x=beam()\x
      y=beam()\y
      SelectElement(sprites(),#explosion)
      Select level(beam()\targetx,beam()\targety)\sprite
         Case #vide
            beam()\damage=0
            add=1
            SelectElement(sprites(),#hbeam)
            Repeat
               If level(x+add,y)\sprite=#vide Or level(x+add,y)\sprite=#hbeam
                  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
         Case #herb
            If beam()\damage=>30
               destroy=1
            EndIf
         Case #boulder
            If beam()\damage=>900
               destroy=1
            EndIf
         Case #wall,#magicwall,#extendwall,#activemagicwall
            If beam()\damage=>2800
               destroy=1
            EndIf
         Case #tnt,#bomb,#activetnt,#papillon,#firefly
            If beam()\damage>=1
               destroy=1
            EndIf
         Case #titanium
         Case #water
         Case #snakebody
            If beam()\damage>=40
               destroy=1
            EndIf
         Default
            If beam()\damage>=1000
               destroy=1
            EndIf
            
      EndSelect
      
      
      If destroy=1
         explode(beam()\targetx,beam()\targety)
      EndIf
      If beam()\heat=>1000 ; overload
         level(x,y)\indestructible=0
         level(x,y)\radius=2
         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
         explode(x,y)
      EndIf
   Next
   
   
   
   If watercount>=0
      If anim2=1
         watercount=0
      EndIf
   EndIf
   
   
   
   For y=maxy To 0 Step-1;maxy
      For x=0 To maxx
         If level(x,y)\player=1 And player\x<>x Or player\y<>y
            SelectElement(sprites(),#vide)
            CopyStructure(@sprites()\nfo,@level(x,y),board)
         EndIf
         Select level(x,y)\sprite
            Case #activetnt
               If timetrigger2=1 And edit_mode=0
                  level(x,y)\timer -1
                  If level(x,y)\timer=0
                     explode(x,y)
                  EndIf
               EndIf
            Case #magicwall
               If magicwall<>0
                  SelectElement(sprites(),#activemagicwall)
                  Debug "copywall"
                  CopyStructure(@sprites()\nfo,@level(x,y),board)
                  level(x,y)\activated=300
               EndIf
            Case #activemagicwall
               If level(x,y)\milling<>0
                  If level(x,y+1)\sprite=#vide
                     SelectElement(sprites(),level(x,y)\milling)
                     CopyStructure(@sprites()\nfo,@level(x,y+1),board)
                     level(x,y+1)\falledlastturn=1
                  EndIf
                  If level(x,y+1)\sprite=#activemagicwall
                     If magicwall>0
                        Select level(x,y)\milling
                           Case #boulder
                              level(x,y+1)\milling=#diamond
                           Case #diamond
                              level(x,y+1)\milling=#boulder
                        EndSelect
                     Else
                        level(x,y+1)\milling=#boulder
                     EndIf
                  EndIf
                  level(x,y)\milling=0
               EndIf
            Case #EXIT
               If collected<needed And level(x,y)\sprite<>#door And edit_mode=0
                  SelectElement(sprites(),#door)
                  CopyStructure(@sprites()\nfo,@level(x,y),board)
               EndIf
            Case #door
               If collected=needed And level(x,y)\sprite<>#exit And edit_mode=0
                  SelectElement(sprites(),#exit)
                  CopyStructure(@sprites()\nfo,@level(x,y),board)
               EndIf
         EndSelect
         SelectElement(sprites(),level(x,y)\sprite)
         If checktimer(level(x,y)\animation_timer)=1
            level(x,y)\frame +1
            If level(x,y)\frame>sprites()\nfo\frames
               If level(x,y)\endanim=0 Or edit_mode=1
                  level(x,y)\frame=1
                  If magicwall>0
                     If level(x,y)\sprite=#activemagicwall
                     EndIf
                  EndIf
               Else
                  If edit_mode=0
                     SelectElement(sprites(),level(x,y)\endanim-1)
                     CopyStructure(@sprites()\nfo,@level(x,y),board)
                  EndIf
               EndIf
            EndIf
         EndIf
         ;
         If (x>player\x-lightsize And x<player\x+lightsize And y>player\y-lightsize And y<player\y+lightsize) Or play=0 Or lighton=0
            SelectElement(sprites()\sprite(),level(x,y)\frame-1)
            DisplayTransparentSprite(sprites()\sprite(),x*32,16+y*32)
            If level(x,y)\sprite=#activetnt And level(x,y)\timer<10
               displaytext((x*32),32+y*32,Str(level(x,y)\timer))
            EndIf
         Else
            DisplaySprite(realblack,x*32,16+y*32)
         EndIf
         If anim2=1
            If x>0 And y>0 And x<maxx And y<maxy
               chk(x,y)
            EndIf
         EndIf
      Next
   Next
EndProcedure
Procedure nextlevel()
   If NextElement(niveaux())=0
      FirstElement(niveaux())
   EndIf
   loadlevel("nextlevel")
   cleanvars()
   restartlevel()
   edit_mode=0
   SelectElement(sprites(),#exit)
   CopyStructure(@sprites()\nfo,@level(player\x,player\y),board)
   CopyStructure(@sprites()\nfo,@level(player_backup\x,player_backup\y),board)
   drawlevel(levelname,2)
EndProcedure
Procedure levelproperties()
   properties=OpenWindow(#PB_Any,640,450,640,480,"proprietes du niveau")
   TextGadget(#PB_Any,0,0,120,20,"nom du niveau")
   name=StringGadget(#PB_Any,0,20,120,20,levelname)
   intermission=CheckBoxGadget(#PB_Any,0,40,120,20,"intermission"):SetGadgetState(intermission,leveltype)
   TextGadget(#PB_Any,0,60,120,20,"diamonds to collect")
   need=StringGadget(#PB_Any,0,80,120,20,Str(needed),#PB_String_Numeric)
   TextGadget(#PB_Any,0,100,120,20,"level time")
   timer=StringGadget(#PB_Any,0,120,120,20,Str(leveltime),#PB_String_Numeric)
   TextGadget(#PB_Any,0,140,120,20,"magic wall timer"    )
   magic=StringGadget(#PB_Any,0,160,120,20,Str(magicwalltimer),#PB_String_Numeric)
   TextGadget(#PB_Any,0,180,120,20,"valeur diamants"    )
   diamv=StringGadget(#PB_Any,0,200,120,20,Str(diamvalue),#PB_String_Numeric)
   TextGadget(#PB_Any,0,220,220,20,"valeur diamants bonus"    )
   diamb=StringGadget(#PB_Any,0,240,120,20,Str(diambonus),#PB_String_Numeric)
   ok=ButtonGadget(#PB_Any,0,430,640,20,"OK")
   TextGadget(#PB_Any,0,260,220,20,"amoeba critical mass"    )
   crit=StringGadget(#PB_Any,0,280,120,20,Str(criticalmass),#PB_String_Numeric)
   Repeat
      ev=WaitWindowEvent()
   Until ev=#PB_Event_Gadget And EventGadget()=ok
   ;
   leveltype=GetGadgetState(intermission)
   leveltime=Val(GetGadgetText(timer))
   needed        =Val(GetGadgetText(need))
   magicwalltimer   =Val(GetGadgetText(magic))
   levelname=GetGadgetText(name)
   diambonus   =Val(GetGadgetText(diamb))
   diamvalue   =Val(GetGadgetText(diamv))
   criticalmass   =Val(GetGadgetText(crit))
   CloseWindow(properties)
   
EndProcedure
Procedure timeserver()
   ForEach animation_timer()
      If ElapsedMilliseconds()-animation_timer()\previous>=animation_timer()\interval
         animation_timer()\previous=ElapsedMilliseconds()
         animation_timer()\trigered=1
      EndIf
   Next
   
   If ElapsedMilliseconds()-timertime>=1066
      timetrigger=-timetrigger
      timetrigger2=1
      timertime=ElapsedMilliseconds()
      timer -1
      timedemo+1
      If magicwall>0
         magicwall -1
      EndIf
   EndIf
   If edit_mode=0
      If ElapsedMilliseconds()-time2>=130
         time2=ElapsedMilliseconds()
         anim2=1
         turnmove=0
      EndIf
   EndIf
   
   
   If white=100
      SelectElement(sprites(),#vide)
      SelectElement(sprites()\sprite(),0)
      TransparentSpriteColor(sprites()\sprite(),$0)
   EndIf
   ;
   If white>=0
      white -1
      If white=0:white=-1:EndIf
      If white=-1
         SelectElement(sprites(),#vide)
         SelectElement(sprites()\sprite(),0)
         TransparentSpriteColor(sprites()\sprite(),$ff00ff)
      EndIf
   EndIf
   
   
   
   
   
   
   
   
EndProcedure
Procedure animate()
   If ListSize(mobs())>0 And anim2=1
      Dim cantgrow(255)
      ForEach mobs()
         Select level(mobs()\x,mobs()\y)\move
            Case 1 ; move allway right
               If movemob(mobs()\x,mobs()\y,level(mobs()\x,mobs()\y)\heading+1)
               ElseIf movemob(mobs()\x,mobs()\y,level(mobs()\x,mobs()\y)\heading)
               Else
                  level(mobs()\x,mobs()\y)\heading -1
               EndIf
               If level(mobs()\x,mobs()\y)\heading<0 : level(mobs()\x,mobs()\y)\heading=3 : EndIf
            Case 2 ; move allway left
               If movemob(mobs()\x,mobs()\y,level(mobs()\x,mobs()\y)\heading-1)
               ElseIf movemob(mobs()\x,mobs()\y,level(mobs()\x,mobs()\y)\heading)
               Else
                  level(mobs()\x,mobs()\y)\heading +1
               EndIf
               If level(mobs()\x,mobs()\y)\heading>3 : level(mobs()\x,mobs()\y)\heading=0 : EndIf
            Case 3 ;  slime
               slimetype=level(mobs()\x,mobs()\y)\sprite
               If level(mobs()\x,mobs()\y)\poisoned>0
                  If vicinity(mobs()\x,mobs()\y)=1
                     explode(mobs()\x,mobs()\y)
                  EndIf
               EndIf
               If slimecount(slimetype)<0
                  SelectElement(sprites(),Abs(slimecount(slimetype)))
                  CopyStructure(@sprites()\nfo,@level(mobs()\x,mobs()\y),board)
               Else
                  If cangrow(mobs()\x,mobs()\y)=1
                     If Random(127)<3
                        dira=Random(3)
                        Select dira
                           Case 0 ; up
                              xa=0
                              ya=-1
                           Case 1 ; down
                              xa=0
                              ya=1
                           Case 2 ; left
                              xa=-1
                              ya=0
                           Case 3 ; right
                              xa=1
                              ya=0
                        EndSelect
                        gx=mobs()\x+xa
                        gy=mobs()\y+ya
                        Select level(gx,gy)\sprite
                           Case #vide,#herb
                              CopyStructure(@level(mobs()\x,mobs()\y),@level(gx,gy),board)
                              slimecount(slimetype) +1
                              If slimecount(slimetype)=>criticalmass
                                 slimecount(slimetype)=-#boulder
                              EndIf
                           Default
                              ; do nothing
                        EndSelect
                     EndIf
                  Else
                     cantgrow (slimetype)+1
                  EndIf
               EndIf
            Case 4 ; extend wall
               ext=1
               Repeat
                  If valid(mobs()\x+ext,mobs()\y)
                     If level(mobs()\x+ext,mobs()\y)\sprite=#vide
                        CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x+ext,mobs()\y),board)
                        PlaySound(rock,#PB_Sound_MultiChannel,maxsndvolume)
                        ext+1
                     Else
                        Break
                     EndIf
                  Else
                     Break
                  EndIf
               ForEver
               ext=-1
               Repeat
                  If valid(mobs()\x+ext,mobs()\y)
                     If level(mobs()\x+ext,mobs()\y)\sprite=#vide
                        CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x+ext,mobs()\y),board)
                        ext-1
                     Else
                        Break
                     EndIf
                  Else
                     Break
                  EndIf
               ForEver
            Case 5 ;->>>>>>>>>>>>>>>liquid
               If valid(mobs()\x,mobs()\y+1)
                  If level(mobs()\x,mobs()\y+1)\sprite=#vide Or (level(mobs()\x,mobs()\y+1)\sprite=#water And liquid(mobs()\x,mobs()\y+1)\blocked<>4)
                     If level(mobs()\x,mobs()\y+1)\sprite=#vide
                        CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x,mobs()\y+1),board)
                        moved=1
                     Else
                        water +1
                     EndIf
                     
                  Else
                     If valid(mobs()\x+1,mobs()\y)
                        If level(mobs()\x+1,mobs()\y)\sprite=#vide
                           CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x+1,mobs()\y),board)
                           right =1
                        Else
                           right =0
                        EndIf
                     EndIf
                     If valid(mobs()\x-1,mobs()\y)
                        If level(mobs()\x-1,mobs()\y)\sprite=#vide
                           CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x-1,mobs()\y),board)
                           left = 1
                        Else
                           left = 0
                        EndIf
                     EndIf
                     Select left+right
                        Case 0
                           water+1
                        Case 1,2
                           moved=1
                     EndSelect
                  EndIf
                  If full=1
                     Select level(mobs()\x,mobs()\y+1)\sprite
                        Case #water
                           If liquid(mobs()\x,mobs()\y+1)\blocked=4
                              If level(mobs()\x+1,mobs()\y)\sprite<>#vide And level(mobs()\x-1,mobs()\y)\sprite<>#vide
                                 liquid(mobs()\x,mobs()\y)\blocked=4
                              EndIf
                           EndIf
                        Default
                           liquid(mobs()\x,mobs()\y)\blocked=4
                     EndSelect
                     add=0
                     If valid(mobs()\x,mobs()\y+1) And valid(mobs()\x-1,mobs()\y) And valid(mobs()\x+1,mobs()\y)
                        If level(mobs()\x+1,mobs()\y+1)\sprite=#water And level(mobs()\x,mobs()\y+1)\sprite=#water
                           If level(mobs()\x+1,mobs()\y)\sprite=#vide
                              CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x+1,mobs()\y),board)
                              add+1
                              moved=1
                           EndIf
                        EndIf
                        If level(mobs()\x-1,mobs()\y+1)\sprite=#water And level(mobs()\x-1,mobs()\y)\sprite=#vide And level(mobs()\x,mobs()\y+1)\sprite=#water
                           add+1
                           moved=1
                           CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x-1,mobs()\y),board)
                        EndIf
                        If add<>0:full=0:EndIf
                     EndIf
                  EndIf
               EndIf
            Case 8 ;->>>>>>>>>>>>>>> fastgrowing herb
               If Random(130)<=1
                  If valid(mobs()\x,mobs()\y+1)
                     If level(mobs()\x,mobs()\y+1)\sprite=#vide
                        CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x,mobs()\y+1),board)
                     EndIf
                  EndIf
                  If valid(mobs()\x,mobs()\y-1)
                     If Random(80)<=1
                        If level(mobs()\x,mobs()\y-1)\sprite=#vide
                           CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x,mobs()\y-1),board)
                        EndIf
                     EndIf
                  EndIf
                  If valid(mobs()\x+1,mobs()\y)
                     If level(mobs()\x+1,mobs()\y)\sprite=#vide
                        CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x+1,mobs()\y),board)
                     EndIf
                  EndIf
                  If valid(mobs()\x-1,mobs()\y)
                     If level(mobs()\x-1,mobs()\y)\sprite=#vide
                        CopyStructure(@level(mobs()\x,mobs()\y),@level(mobs()\x-1,mobs()\y),board)
                     EndIf
                  EndIf
               EndIf
               
            Case 6 ;->>>>>>>>>>>>>>> snake
               nomove=0
               ClearList(mv())
               For a=1 To 4
                  xmv=mobs()\x+mx(a)
                  ymv=mobs()\y+my(a)
                  If valid(xmv,ymv)
                     Select level(xmv,ymv)\sprite
                        Case #vide,#herb ; move
                           AddElement(mv())
                           mv()=a
                        Default
                           nomove+1
                     EndSelect
                  EndIf
               Next
               ; explode
               If nomove=4
                  snakenaturaldeath=1
                  found=0
                  ForEach snake()
                     If snake()\head\x=mobs()\x And snake()\head\y=mobs()\y
                        found=1
                        Break
                     EndIf
                  Next
                  If found=1 ;
                     ForEach snake()\body()
                        explode(snake()\body()\x,snake()\body()\y)
                     Next
                     hedx=snake()\head\x
                     hedy=snake()\head\y
                     explode(hedx,hedy)
                     SelectElement(sprites(),#diamond)
                     CopyStructure(@sprites()\nfo,@level(snake()\head\x,snake()\head\y),board)
                  EndIf
                  snakenaturaldeath=0
               Else
                  ; can move
                  done=0
                  ForEach mv()
                     If mv()=level(mobs()\x,mobs()\y)\heading
                        newheading=mv()
                        done=1
                     EndIf
                  Next
                  If done=0
                     SelectElement(mv(),Random(ListSize(mv())-1))
                     newheading=mv()
                  EndIf
                  level(mobs()\x,mobs()\y)\heading=newheading
                  ;
                  xmv=mobs()\x+mx(newheading)
                  ymv=mobs()\y+my(newheading)
                  If valid(xmv,ymv)
                     Select level(xmv,ymv)\sprite
                        Case #vide,#herb ; move
                           found=0
                           ForEach snake()
                              If snake()\head\x=mobs()\x And snake()\head\y=mobs()\y
                                 found=1
                                 Break
                              EndIf
                           Next
                           If found=0
                              AddElement(snake())
                              snake()\head\x=mobs()\x
                              snake()\head\y=mobs()\y
                           EndIf
                           FirstElement(snake()\body())
                           InsertElement(snake()\body())
                           snake()\body()\x=mobs()\x
                           snake()\body()\y=mobs()\y
                           If level(xmv,ymv)\sprite=#herb
                              snake()\body()\spr +2
                           EndIf
                           heading=newheading
                           Select newheading
                              Case 1
                                 SelectElement(sprites(),#snakehead0)
                              Case 2
                                 SelectElement(sprites(),#snakehead3)
                              Case 3
                                 SelectElement(sprites(),#snakehead2)
                              Case 4
                                 SelectElement(sprites(),#snakehead1)
                           EndSelect
                           CopyStructure(@sprites()\nfo,@level(xmv,ymv),board) ; move the head
                           level(xmv,ymv)\heading=newheading
                           SelectElement(sprites(),#vide)
                           CopyStructure(@sprites()\nfo,@level(snake()\head\x,snake()\head\y),board)
                           SelectElement(sprites(),#snakebody)
                           ForEach(snake()\body())
                              If level(snake()\body()\x,snake()\body()\y)\sprite<>#snakebody
                                 CopyStructure(@sprites()\nfo,@level(snake()\body()\x,snake()\body()\y),board)
                              EndIf
                           Next
                           If snake()\body()\spr>0
                              snake()\body()\spr -1
                           Else
                              LastElement(snake()\body())
                              SelectElement(sprites(),#vide)
                              CopyStructure(@sprites()\nfo,@level(snake()\body()\x,snake()\body()\y),board)
                              DeleteElement(snake()\body())
                           EndIf
                           snake()\head\x=xmv
                           snake()\head\y=ymv
                           
                           
                     EndSelect
                  EndIf
               EndIf
         EndSelect
         DeleteElement(mobs(),0)
      Next
      full=0
      If water=watercount And watercount>0
         If moved=0
            ; Debug "full"
            full=1
         EndIf
      EndIf
      
      ForEach slimes()
         If slimecount(slimes())=criticalmass ; transform en pierres
            slimecount(slimes())=-#boulder
         EndIf
         If cantgrow(slimes())=slimecount(slimes()) And slimecount(slimes())>0; transform en diamants
            slimecount(slimes())=-#diamond
         EndIf
      Next
   EndIf
   If ListSize(falling())>0
      ForEach falling()
         If level(falling()\x,falling()\y+1)\sprite=#vide
            move(falling()\x,falling()\y,falling()\x,falling()\y+1)
            DeleteElement(falling(),0)
         ElseIf level(falling()\x,falling()\y+1)\killedbyboulders=1
            explode(falling()\x,falling()\y+1)
            If falling()\x=player\x  And falling()\y+1=player\y
               playerkill=1
            EndIf
            DeleteElement(falling(),0)
         ElseIf level(falling()\x,falling()\y+1)\sprite=#magicwall
            magicwall= magicwalltimer
         Else
            level(falling()\x,falling()\y)\falledlastturn=0
            DeleteElement(falling(),0)
         EndIf
      Next      
   EndIf
   If ListSize(unstable())>0
      ForEach unstable()
         x=unstable()\x
         y=unstable()\y
         Select chkfall(unstable()\x,unstable()\y)
            Case 0 ; ne tombe pas
            Case 1 ; tombe a gauche
               move(x,y,x-1,y)
            Case 2 ; tombe a droite
               move(x,y,x+1,y)
         EndSelect
         DeleteElement(unstable(),0)
      Next
   EndIf
EndProcedure
Procedure hi_score(pos=0)
   posa=1
   display.s=UCase("abcdefghijklmnopqrstuvwxyz0123456789 !*&$£")+"rpbfhswtm°?"
   Repeat
      refreshkeyboard()
      ClearScreen($ff00ff)
      credits()
      ev=WaitWindowEvent(0)
      timeserver()
      drawlvl()
      cleartimers();anim=0
      If posa>Len(display)
         posa=1
      EndIf
      If posa<1
         posa=Len(display)
      EndIf
      ypos=176
      FirstElement(hiscore())
      SelectElement(locale(),#hiscore)
      displaytext(-1,-(ypos-48) ,UCase(levelpack),2)      
      displaytext(-1,-(ypos)   ,StringField(locale(),1,","))
      displaytext(-1,-(ypos+32)  ,StringField(locale(),2,","))
      For a=1 To 10
         displaytext(-1,-(ypos+48+(a*32))  ,LSet(hiscore()\name,15," ")+RSet(Str(hiscore()\points),8," ")+RSet(hiscore()\level,15," "))
         NextElement(hiscore())
      Next
      If timetrigger=1
         displaytext(-1,-(ypos+48+((a+1)*32))  ,StringField(locale(),5,","))
      EndIf
      ypos=52
      
      displaytext(-1,-ypos,display)
      displaytext(-1,ypos+10,InsertString(Space(Len(display)-1),"-",posa))
      displaytext(-1,ypos-16,InsertString(Space(Len(display)-1),"-",posa))
      ;
      DisplayTransparentSprite(creditscroller,32,maxy*32)
      FlipBuffers()
      If anim2
         If keydown(#PB_Key_Right)
            posa+1
         EndIf
         If keydown(#PB_Key_Left)
            posa-1
         EndIf
         If keydown(#PB_Key_Down)
            Select posa
               Case Len(display) ; return
                  wr=CreateFile(#PB_Any,"levels\"+levelpack+"\"+"hiscore.txt")
                  If wr
                     ForEach(hiscore())
                        WriteStringN(wr,hiscore()\level+","+hiscore()\name+","+Str(hiscore()\points))
                     Next
                     CloseFile(wr)
                  EndIf
                  ProcedureReturn 1
               Case Len(display)-1 ; del
                  SelectElement(hiscore(),pos)
                  If Len(hiscore()\name)>0
                     hiscore()\name=Left(hiscore()\name,Len(hiscore()\name)-1)
                  EndIf
               Default
                  SelectElement(hiscore(),pos)
                  If Len(hiscore()\name)<15
                     hiscore()\name+Mid(display,posa,1)
                  EndIf
            EndSelect
         EndIf
      EndIf
      ;
      cleartimers();anim=0
      Dim cantgrow(255)
      animate()
      anim2=0
      
      
      ;
      If ev=#PB_Event_CloseWindow Or keypushed(#PB_Key_Escape)
         End
      EndIf
   ForEver
EndProcedure
Procedure title()
   musicplaying=PlaySound(music,#PB_Sound3D_Loop|#PB_Sound_MultiChannel,maxvolume)
   sw=SpriteWidth(logo)
   sh=SpriteHeight(logo)
   loadlevel("menu.dsh")
   drawlevel( )
   option=1
   timedemo=0
   r.f=0.1
   Repeat
      refreshkeyboard()
      ClearScreen($ff00ff)
      credits()
      ev= WaitWindowEvent(0)
      timeserver()
      drawlvl()
      cleartimers();anim=0
      SelectElement(locale(),#loc_mainmenu)
      For a= 1 To 4
         DISPLAYTEXT(276,184+(A-1)*96,StringField(locale(),A,","))
      Next
      If ypos>176
         ypos-2
      Else
         If enterscore<>0 And ex=0
            ex=hi_score(enterscore-1)
         EndIf
      EndIf
      If timedemo=50
         timedemo=0
         gameover()
         timedemo=0
         loadlevel("menu.dsh")
      EndIf
      If timetrigger=1
         DISPLAYTEXT(-1,-150  ,StringField(locale(),5,","))
      EndIf
      
      If keypushed(#PB_Key_Down)
         sel+1
         PlaySound(PLOP,#PB_Sound_MultiChannel)
      EndIf
      If keypushed(#PB_Key_Up)
         sel-1
         PlaySound(PLOP,#PB_Sound_MultiChannel)
      EndIf
      If keypushed(#PB_Key_Right) Or playgame=1
         If playgame=1
            sel=1
            playgame=0
         EndIf
         Select sel
            Case 1
               PlaySound(selection,#PB_Sound_MultiChannel)
               play=1
               If ingamemusic=0
                  StopSound(music,musicplaying)
               EndIf
               playgame()
               play=0
               If gameover=1
                  StopSound(music,musicplaying)
                  musicplaying2=PlaySound(music2,#PB_Sound_MultiChannel,maxvolume)
                  gameover=0
                  gameover()
                  timedemo=0
                  If playgame=0
                     loadlevel("menu.dsh")
                     drawlevel( )
                  EndIf
                  option=1
                  StopSound(music2,musicplaying2)
                  musicplaying=PlaySound(music,#PB_Sound3D_Loop|#PB_Sound_MultiChannel,maxvolume)
               Else ; echap
                  If ingamemusic=0
                     musicplaying=PlaySound(music,#PB_Sound3D_Loop|#PB_Sound_MultiChannel,maxvolume)
                  EndIf
                  loadlevel("menu.dsh")
                  drawlevel( )
                  timedemo=0
               EndIf
            Case 2
               PlaySound(selection,#PB_Sound_MultiChannel)
               editor()
               loadlevel("menu.dsh")
               drawlevel( )
               timedemo=0
               edit_mode=0
            Case 3
               PlaySound(selection,#PB_Sound_MultiChannel)
               options()
               loadlevel("menu.dsh")
               drawlevel( )
               timedemo=0
            Case 4
               PlaySound(selection,#PB_Sound_MultiChannel)
               Delay(20)
               End
         EndSelect
      EndIf
      If keypushed(#PB_Key_Escape)
         ProcedureReturn
      EndIf
      If sel>4:sel=4:EndIf
      If sel<1:sel=1:EndIf
      SelectElement(sprites(),#player)
      DisplaySprite(sprites()\sprite(),256,176+(sel-1)*96)
      br.f=r
      For h=1 To Sh
         ClipSprite(logo,0,h,sw,1)
         r.f + 0.01
         DisplayTransparentSprite(logo,(cen-(sw/2))+20*Sin(r),h)
      Next
      r =br +0.2
      DisplayTransparentSprite(creditscroller,32,maxy*32)
      FlipBuffers()
      ;
      cleartimers();anim=0
      Dim cantgrow (255)
      animate()
      anim2=0
      ;
      If ev=#PB_Event_CloseWindow
         End
      EndIf
   ForEver
EndProcedure
Procedure editor()
   niveauactuel=""
   For x=0 To maxx
      For y=0 To maxy
         If x=0 Or x=maxx Or y =0 Or y=maxy
            SelectElement(sprites(),#titanium)
            CopyStructure(@sprites()\nfo,@level(x,y),board)
            CopyStructure(@sprites()\nfo,@level_backup(x,y),board)
         Else
            SelectElement(sprites(),#vide)
            CopyStructure(@sprites()\nfo,@level(x,y),board)
            CopyStructure(@sprites()\nfo,@level_backup(x,y),board)
         EndIf
      Next
   Next
   editsprite$=Str(#vide)+","+Str(#herb)+","+Str(#boulder)+","+Str(#diamond)+","+Str(#titanium)+","+Str(#wall)+","+Str(#magicwall)+","+Str(#slime)+","+Str(#firefly)+","+Str(#papillon)+","+Str(#extendwall)+","+Str(#bomb)+","+Str(#tnt)+","+Str(#activetnt)+","+Str(#water)+","+Str(#killeramoeba)+","+Str(#snakehead0)+","+Str(#hbeam)+","+Str(#laseroff)+","+Str(#laseron)+","+Str(#fastherb)+","+Str(#remotecontrolbomb)+","+Str(#remotecontrol)
   sel=1
   mpos=CountString(editsprite$,",")+1
   aide=-1
   edit_mode=1
   time=ElapsedMilliseconds()
   timertime=ElapsedMilliseconds()
   time2=ElapsedMilliseconds()
   Repeat
      ClearScreen(0)
      ev=WaitWindowEvent(0)
      wh=0
      timeserver()
      RefreshKeyboard()
      drawlvl()
      If MouseWheel() <>0
         If MouseWheel()>0
            wh=-1
         Else
            wh=1
         EndIf
      EndIf
      cleartimers();anim=0
      If level_backup(player\x,player\y)\sprite=#vide
         SelectElement(sprites(),#player)
         CopyStructure(@sprites()\nfo,level_backup(player\x,player\y),board)
      EndIf
      If level(player\x,player\y)\sprite=#vide
         SelectElement(sprites(),#player)
         CopyStructure(@sprites()\nfo,level(player\x,player\y),board)
      EndIf
      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()
      ;
      xd=WindowMouseX(main)/32
      yd=(WindowMouseY(main)-16)/32
      If edit_mode=1
         If keypushed(#PB_Key_F12)
            If xd>=0 And xd=<maxx And yd>=0 And yd=<maxy
               If exit\x=0 Or exit\x=maxx Or exit\y=0 Or exit\y=maxy
                  exit_oldtile=#titanium
               EndIf
               SelectElement(sprites(),exit_oldtile) ; vide
               CopyStructure(@sprites()\nfo,@level_backup(exit\x,exit\y),board)
               CopyStructure(@sprites()\nfo,@level(exit\x,exit\y),board)
               ;
               exit\x=xd
               exit\y=yd
               exit_oldtile=level(xd,yd)\sprite
               SelectElement(sprites(),#exit) ; exit
               CopyStructure(@sprites()\nfo,@level_backup(xd,yd),board)
               CopyStructure(@sprites()\nfo,@level(xd,yd),board)
            EndIf
         EndIf
         ForEach shortcut()
            If keypushed(shortcut()\ID)
               selected=shortcut()\sprite
            EndIf
         Next
         SelectElement(sprites(),selected)
         DisplaySprite(sprites()\sprite(),xd*32,yd*32+16)
         DisplayTransparentSprite(marker,xd*32,yd*32+16)
         If keypushed(#PB_Key_Right) Or wh=1
            sel +1:If sel >mpos:sel=1:EndIf
            selected=Val(StringField(editsprite$,sel,","))
         EndIf
         If keypushed(#PB_Key_Left) Or wh=-1
            sel -1:If sel =0:sel=mpos:Debug mpos :EndIf
            selected=Val(StringField(editsprite$,sel,","))
         EndIf
         
         If MouseButton(#PB_MouseButton_Left)
            If xd>0 And xd<maxx And yd>0 And yd<maxy
               SelectElement(sprites(),selected)
               CopyStructure(@sprites()\nfo,@level_backup(xd,yd),board)
               CopyStructure(@sprites()\nfo,@level(xd,yd),board)
            EndIf
         EndIf
         If MouseButton(#PB_MouseButton_Middle)
            If xd>0 And xd<maxx And yd>0 And yd<maxy
               SelectElement(sprites(),selected)
               CopyStructure(@sprites()\nfo,@level_backup(xd,yd),board)
               CopyStructure(@sprites()\nfo,@level(xd,yd),board)
            EndIf
         EndIf
         If MouseButton(#PB_MouseButton_Right)
            For a= -1 To 1
               For b=-1 To 1
                  If xd+b>0 And xd+b<maxx And yd+a>0 And yd+a<maxy
                     SelectElement(sprites(),selected)
                     CopyStructure(@sprites()\nfo,@level_backup(xd+b,yd+a),board)
                     CopyStructure(@sprites()\nfo,@level(xd+b,yd+a),board)
                  EndIf
               Next
            Next
         EndIf
         If keypushed(#PB_Key_F1)
            aide=-aide
         EndIf
         If keypushed(#PB_Key_F2)
            If xd>0 And xd<maxx And yd>0 And yd<maxy
               If player\x>0 And player\y>0
                  SelectElement(sprites(),player_oldtile)
                  CopyStructure(@sprites()\nfo,@level(player\x,player\y),board)
                  CopyStructure(@sprites()\nfo,@level_backup(player\x,player\y),board)
               EndIf
               SelectElement(sprites(),#player) ; player start
               player_oldtile=level(xd,yd)\sprite
               CopyStructure(@sprites()\nfo,@level_backup(xd,yd),board)
               CopyStructure(@sprites()\nfo,@level(xd,yd),board)
               player\x=xd
               player\y=yd
               player_backup\x=xd
               player_backup\y=yd
               
            EndIf
         EndIf
         
         If keypushed(#PB_Key_F11)
            If xd>=0 And xd=<maxx And yd>=0 And yd=<maxy
               SelectElement(sprites(),#titanium) ; indestructable wall
               CopyStructure(@sprites()\nfo,@level_backup(xd,yd),board)
               CopyStructure(@sprites()\nfo,@level(xd,yd),board)
            EndIf
         EndIf
      EndIf
      
      If keypushed(#PB_Key_F4)
         If edit_mode=0
            CopyArray(level(),level_backup())
         EndIf
         savelevel()
      EndIf
      If keypushed(#PB_Key_F6)
         If edit_mode=0
            CopyArray(level(),level_backup())
         EndIf
         savelevel(niveauactuel)
      EndIf
      
      If keypushed(#PB_Key_F5)
         loadlevel()
         restartlevel()
      EndIf
      
      If keypushed(#PB_Key_F9)
         ReleaseMouse(1)
         levelproperties()
         ReleaseMouse(0)
      EndIf
      If keypushed(#PB_Key_F8)
         noload=1
         playgame()
         edit_mode=1
         CopyArray(level_backup(),level())
         
         player\x=player_backup\x
         player\y=player_backup\y
         noload=0
         
         
         
      EndIf
      tileinfo()
      If aide=1
         help()
      EndIf
      If keypushed(#PB_Key_Escape)
         ProcedureReturn
      EndIf
      
      
      FlipBuffers()
      anim2=0
      cleartimers();anim=0
      If   ev=#PB_Event_CloseWindow
         End
      EndIf
   ForEver
EndProcedure
Procedure light()
   If lighton=1 And  play=1
      Start3D()
      ZoomSprite3D(light3d,((lightsize*2)+1)*32,((lightsize*2)+1)*32)
      DisplaySprite3D(light3d,(player\x-lightsize)*32,16+(player\y-lightsize)*32,Random(50))
      DisplaySprite3D(light3d,(player\x-lightsize)*32,16+(player\y-lightsize)*32)
      Stop3D()
   EndIf
EndProcedure
Procedure options()
   spritepck.s=spritepack
   ForEach spritepack()
      If spritepack()=spritepck
         Break
      EndIf
   Next
   lvlpckbak.s=levelpack.s
   levelpck.s=levelpack.s
   ForEach levels()
      If levels()=levelpck
         Break
      EndIf
   Next
   menumax=11
   timedemo=0
   loadlevel("options.dsh")
   drawlevel()
   ypos=cenv*2
   Dim icon.s(1)
   icon(0)="n"
   icon(1)="y"
   urlmax=CountString(weburl$,",")+1
   Repeat
      
      refreshkeyboard()
      
      ClearScreen(0)
      WaitWindowEvent(0)
      timeserver()
      drawlvl()
      cleartimers();anim=0
      
      If timetrigger=1
         SelectElement(locale(),#loc_optionsnfo)
         
         Y=1
         DISPLAYTEXT(-1,-(Y)  ,StringField(locale(),1,",")):Y+16
         DISPLAYTEXT(-1,-(Y)  ,StringField(locale(),2,",")):Y+16
         DISPLAYTEXT(-1,-(Y)  ,StringField(locale(),3,",")):Y+16
      EndIf
      ypos=100
      SelectElement(locale(),#loc_options)
      DISPLAYTEXT(250,-(50+YPOS),LSet(StringField(locale(),1,","),35," ")+ICON(LIGHTON)):YPOS+16
      displaytext(250,-(50+YPOS),LSet(StringField(locale(),2,","),35," ")+Str(lightsize)):YPOS+16
      displaytext(250,-(50+YPOS),LSet(StringField(locale(),3,","),35," ")+UCase(SPRITEPCK.s)):YPOS+16
      displaytext(250,-(50+YPOS),LSet(StringField(locale(),12,","),35," ")+UCase(levelpck)):YPOS+16
      DISPLAYTEXT(250,-(50+YPOS),LSet(StringField(locale(),4,","),35," ")+ICON(scanline)):YPOS+16
      displaytext(250,-(50+YPOS),LSet(StringField(locale(),5,","),35," ")+Str(maxvolume)+"%"):YPOS+16
      displaytext(250,-(50+YPOS),LSet(StringField(locale(),6,","),35," ")+Str(maxsndvolume)+"%"):YPOS+16
      DISPLAYTEXT(250,-(50+YPOS),LSet(StringField(locale(),7,","),35," ")+ICON(ingamemusic)):YPOS+16
      displaytext(250,-(50+YPOS),LSet(StringField(locale(),8,","),35," ")+UCase(locales())):YPOS+16
      displaytext(250,-(50+YPOS),LSet(StringField(locale(),9,","),35," ")+StringField(weburl$,url,",")):YPOS+16
      DISPLAYTEXT(250,-(50+YPOS),LSet(StringField(locale(),10,","),35," ")+ICON(autocheckupdates)):YPOS+16
      DISPLAYTEXT(250,-(50+YPOS),LSet(StringField(locale(),11,","),35," ")):YPOS+16
      ypos=100
      DISPLAYTEXT(234,(50+YPOS+menupos*16),"r")
      
      FlipBuffers()
      ;
      cleartimers();anim=0
      Dim cantgrow(255)
      animate()
      If keypushed(#PB_Key_Return) Or jbutton=1
         Select menupos
            Case 0
               lighton=Abs(lighton-1)
               PlaySound(selection,#PB_Sound_MultiChannel)
            Case 2 ; load new spritepack
               If spritepack<>spritepck
                  spritepack=spritepck
                  FreeImage(graphics)
                  PlaySound(selection,#PB_Sound_MultiChannel)
                  graphics=LoadImage(#PB_Any,"sprites"+slash+""+spritepack+".png")
                  scanlines()
               EndIf
            Case 4
               scanline=Abs(scanline-1)
               FreeImage(graphics)
               graphics=LoadImage(#PB_Any,"sprites"+slash+""+spritepack+".png")
               scanlines()
               PlaySound(selection,#PB_Sound_MultiChannel)
            Case 7
               ingamemusic=Abs(ingamemusic-1)
               PlaySound(selection,#PB_Sound_MultiChannel)
            Case 8
               preferences()
               PlaySound(selection,#PB_Sound_MultiChannel)
            Case 9
               PlaySound(selection,#PB_Sound_MultiChannel)
               SelectElement(locale(),#wwwgo):url$=LCase(StringField(weburl$,url,","))
               RunProgram(url$)
            Case 10
               autocheckupdates=Abs(autocheckupdates-1)
               PlaySound(selection,#PB_Sound_MultiChannel)
            Case 11
               PlaySound(selection,#PB_Sound_MultiChannel)
               Debug "check"
               checkupdate()
         EndSelect
      EndIf
      If keypushed(#PB_Key_Up) Or jdir= 3
         menupos -1:If menupos<0:menupos=0:EndIf
         PlaySound(plop,#PB_Sound_MultiChannel)
      EndIf
      If keypushed(#PB_Key_Down)Or jdir=4
         menupos +1:If menupos>menumax:menupos=menumax:EndIf
         PlaySound(plop,#PB_Sound_MultiChannel)
      EndIf
      If anim2=1
         jdir=0
         jbutton=0
         If joysticks>0
            If JoystickAxisX(0)=-1
               jdir=1
            ElseIf JoystickAxisX(0)=1
               jdir=2
            ElseIf JoystickAxisY(0)=-1
               jdir=3
            ElseIf JoystickAxisY(0)=1
               jdir=4
            EndIf
            If JoystickButton(0,0)
               jbutton=1
            EndIf
         EndIf
         ;
         ;
         ; left/right arrows
         ;
         If keydown(#PB_Key_Left) Or jdir=1
            Select menupos
               Case 1 ; light radius
                  lightsize -1:If lightsize<4:lightsize=4:EndIf
               Case 2                  ; sprite pack
                  If PreviousElement(spritepack())=0:LastElement(spritepack()):EndIf
                  spritepck=(Left(spritepack(),Len(spritepack())-4))
               Case 3                  ; levels pack
                  If PreviousElement(levels())=0:LastElement(levels()):EndIf
                  levelpck=(levels())
               Case 5 ; MUSIC volume
                  maxvolume -1:If maxvolume<0:maxvolume=0:EndIf
                  SoundVolume(music,maxvolume,musicplaying)
               Case 6 ; SFX volums
                  maxsndvolume -1:If maxsndvolume<0:maxsndvolume=0:EndIf
                  PlaySound(herb,#PB_Sound_MultiChannel,maxsndvolume)
               Case 8 ; langue
                  If PreviousElement(locales())=0:LastElement(locales()):EndIf
                  loc=(locales())
               Case 9 ;www
                  url-1:If url=0:url=1:EndIf
            EndSelect
         EndIf
         If keydown(#PB_Key_Right) Or jdir=2
            Select menupos
               Case 1 ; light radius
                  lightsize +1:If lightsize>15:lightsize=15:EndIf
               Case 2 ; sprite pack
                  If NextElement(spritepack())=0:FirstElement(spritepack()):EndIf
                  spritepck=(Left(spritepack(),Len(spritepack())-4))
               Case 3 ; levels pack
                  If NextElement(levels())=0:FirstElement(levels()):EndIf
                  levelpck=(levels())
               Case 5 ; MUSIC volume
                  maxvolume +1:If maxvolume>100:maxvolume=100:EndIf
                  SoundVolume(music,maxvolume,musicplaying)
               Case 6 ; SFX volums
                  maxsndvolume +1:If maxsndvolume>100:maxsndvolume=100:EndIf
                  PlaySound(herb,#PB_Sound_MultiChannel,maxsndvolume)
               Case 8 ; langue
                  If NextElement(locales())=0:FirstElement(locales()):EndIf
                  loc=(locales())
               Case 9 ; www
                  url+1:If url>urlmax:url=urlmax:EndIf
            EndSelect
         EndIf
      EndIf
      If keypushed(#PB_Key_Escape) Or keypushed(#PB_Key_Space)
         
         levelpack=levelpck
         If lvlpckbak<>levelpack
            populatelevels()
            loadhiscore()
         EndIf
         ; save options
         CreatePreferences("puredash.prefs")
         WritePreferenceInteger("lightsize",lightsize)
         WritePreferenceString("spritepack",spritepack)
         WritePreferenceString("levelpack",levelpack)
         WritePreferenceInteger("soundlevel",maxsndvolume)
         WritePreferenceInteger("musicvolums",maxvolume)
         WritePreferenceString("language",loc)
         WritePreferenceInteger("light",lighton)
         WritePreferenceInteger("keepmusic",ingamemusic)
         WritePreferenceInteger("scanlines",scanline)
         WritePreferenceInteger("autocheckupdates",autocheckupdates)
         ClosePreferences()
         ProcedureReturn
      EndIf      
      If ev=#PB_Event_CloseWindow
         End
      EndIf
      anim2=0      
   Until  keypushed(#PB_Key_Space)
   playgame=1
EndProcedure
Procedure checkfolders()
   ; sprites
   folder.s="sprites"+slash+""
   exd=ExamineDirectory(#PB_Any,folder,"*.png")
   NextDirectoryEntry(exd)
   Repeat
      If DirectoryEntryName(exd)<>"" And DirectoryEntryType(exd)=#PB_DirectoryEntry_File
         AddElement(spritepack())
         spritepack()=DirectoryEntryName(exd)
      EndIf
   Until NextDirectoryEntry(exd)=0
   FinishDirectory(exd)
   ;locales
   folder.s="locale"+slash+""
   exd=ExamineDirectory(#PB_Any,folder,"*.txt")
   NextDirectoryEntry(exd)
   Repeat
      If DirectoryEntryName(exd)<>"" And DirectoryEntryType(exd)=#PB_DirectoryEntry_File
         AddElement(Locales())
         Locales()=Left((DirectoryEntryName(exd)),Len(DirectoryEntryName(exd))-4)
      EndIf
   Until NextDirectoryEntry(exd)=0
   FinishDirectory(exd)
   ;levelpacks
   folder.s="levels"+slash+""
   exd=ExamineDirectory(#PB_Any,folder,"*.*")
   NextDirectoryEntry(exd)
   Repeat
      If DirectoryEntryName(exd)<>"" And DirectoryEntryType(exd)=#PB_DirectoryEntry_Directory And DirectoryEntryName(exd)<>"."And DirectoryEntryName(exd)<>".."
         AddElement(levels())
         levels()=DirectoryEntryName(exd)
         Debug levels()
      EndIf
   Until NextDirectoryEntry(exd)=0
   FinishDirectory(exd)
   
   
   
EndProcedure
Procedure keypushed(key)             ; teste si une touche est poussée (instant)
   If KeyboardPushed(key)
      If PeekB(*buffer+key)=0
         PokeB(*buffer+key,1)
         ProcedureReturn 1
      EndIf
   Else
      PokeB(*buffer+key,0)
   EndIf
EndProcedure
Procedure keydown(key)             ; teste si une touche est poussée
   If KeyboardPushed(key)
      PokeB(*buffer+key,1)
      ProcedureReturn 1
   EndIf
EndProcedure
Procedure refreshkeyboard()
   ExamineKeyboard()
   ExamineMouse()
   ExamineJoystick(0)
   If joysticks>0
      ExamineJoystick(0)
   EndIf
EndProcedure
Procedure scanlines()
   ClearScreen(0)
   For ry=0 To 24
      StartDrawing(ScreenOutput())
      DrawImage(ImageID(graphics),0,(ry*-1)*32,ImageWidth(graphics),ImageHeight(graphics))
      StopDrawing()
      If scanline=1
         Start3D()
         For scany=0 To 1
            For scanx=0 To 15
               DisplaySprite3D(scanline3d,scanx*16,scany*16,150)
            Next
         Next
         Stop3D()
      EndIf
      For rx=0 To 7
         AddElement(newsprite())
         newsprite()=GrabSprite(#PB_Any,rx*32,0,32,32)
      Next
   Next
   ForEach sprite()
      SelectElement(newsprite(),ListIndex(sprite()))
      ;
      ForEach sprites()
         ;
         ForEach(sprites()\sprite())
            ;
            If sprites()\sprite()=sprite()
               sprites()\sprite()=newsprite()
               Break
            EndIf
         Next
      Next
   Next
   
   ForEach sprite()
      FreeSprite(sprite())
   Next
   CopyList(newsprite(),sprite())
   ClearList(newsprite())
   
EndProcedure
Procedure credits()
   SelectElement(locale(),#loc_credits)
   Static speed=2
   Static scrollcount
   Static stringpos = 1
   TransparentSpriteColor(font,$ff00ff)
   DisplayTransparentSprite(creditscroller,-speed,0)
   FreeSprite(creditscroller)
   scrollcount+speed
   If scrollcount=16
      scrollcount=0
      stringpos+1
      If stringpos>Len(locale())
         stringpos=1
      EndIf
   EndIf
   ClipSprite(font,chars(Asc(Mid(locale(),stringpos,1)))*16,0,16,16)
   DisplayTransparentSprite(font,((maxx-1)*32)-scrollcount,0)
   creditscroller= GrabSprite(#PB_Any,0,0,((maxx-1)*32),16   )
   TransparentSpriteColor(creditscroller,$ff00ff)
   ClearScreen(0)
EndProcedure
Procedure preferences()
   If ListSize(locale())>0:ClearList(locale()):EndIf
   keys.s="credits,time limit,lives left,live,lives,diamond,diamonds,score,menu,options,optionsnfo,tileinfo,edit_help,hiscore,wwwgo,askversion"
   OpenPreferences("locale"+slash+""+LCase(locales())+".txt")
   For a=1 To CountString(keys,",")+1
      AddElement(locale())
      locale()=ReadPreferenceString(StringField(keys,a,","),"")
   Next
   ClosePreferences()
   SelectElement(locale(),#wwwgo)
   weburl$=locale()
EndProcedure
Procedure loadprefs()
   OpenPreferences("puredash.prefs")
   lightsize=ReadPreferenceInteger("lightsize",8)
   spritepack=ReadPreferenceString("spritepack","default")
   levelpack=ReadPreferenceString("levelpack","default")
   maxsndvolume=ReadPreferenceInteger("soundlevel",60)
   maxvolume=ReadPreferenceInteger("musicvolums",60)
   loc=ReadPreferenceString("language","FRANCAIS")
   lighton=ReadPreferenceInteger("light",0)
   ingamemusic=ReadPreferenceInteger("keepmusic",0)
   scanline=ReadPreferenceInteger("scanlines",0)
   autocheckupdates=ReadPreferenceInteger("autocheckupdates",0)
   ClosePreferences()
   ForEach Locales()
      If locales()=loc
         Break
      EndIf
   Next
EndProcedure
Procedure checkupdate()
   If ReceiveHTTPFile("http://www.moonshade.org/puredash/patches/version.txt","updates"+slash+"version.txt")
      OpenPreferences("updates"+slash+"version.txt")
      ver$=ReadPreferenceString("version","")
      ClosePreferences()
      SelectElement(locale(),#askversion)
      local_value=Val(RSet(StringField(version$,1,"."),3,"0")+LSet(StringField(version$,2,"."),3,"0"))
      dist_value=Val(RSet(StringField(ver$,1,"."),3,"0")+LSet(StringField(ver$,2,"."),3,"0"))
      If local_value<dist_value
         updategame=1
      Else
         updategame=0
      EndIf
      If updategame=1
         ReleaseMouse(01)
         reply=MessageRequester(StringField(locale(),1,","),StringField(locale(),2,",")+ver$+StringField(locale(),3,","),#PB_MessageRequester_YesNo)
         If reply=#PB_MessageRequester_Yes
            CreatePreferences("updates"+slash+"localversion.txt")
            WritePreferenceString("loc",version$)
            ClosePreferences()
            RunProgram("patcher.exe","","")
            End
         EndIf
         ReleaseMouse(0)
      EndIf
   EndIf
EndProcedure
Procedure populatelevels()
   If ListSize(niveaux())>0:ClearList(niveaux()):EndIf
   rd=ReadFile(#PB_Any,"levels"+slash+levelpack+slash+"levels.lst")
   Debug "levels"+slash+levelpack+slash+"levels.lst"
   Debug rd
   If rd
      Repeat
         AddElement(niveaux())
         niveaux()="levels"+slash+levelpack+slash+ReadString(rd)
      Until Eof(rd)
      CloseFile(rd)
   EndIf
   ;
EndProcedure
Procedure create_timer(ticks.i)
   ForEach animation_timer()
      If animation_timer()\interval=ticks
         ProcedureReturn ListIndex(animation_timer())+1
      EndIf
   Next
   AddElement(animation_timer())
   animation_timer()\interval=ticks
   animation_timer()\previous=ElapsedMilliseconds()
   ProcedureReturn ListIndex(animation_timer())+1
EndProcedure
Procedure cleartimers()
   ForEach animation_timer()
      animation_timer()\trigered=0
   Next
EndProcedure
Procedure checktimer(timar)
   SelectElement(animation_timer(),timar-1)
   ProcedureReturn animation_timer()\trigered
EndProcedure
Procedure destroybeam(x,y)
   SelectElement(beam(),level(x,y)\link)
   level(x,y)\indestructible=0
   level(x,y)\radius=2
   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
   DeleteElement(beam(),1)
   
EndProcedure
Procedure loadhiscore()   
   ClearList(hiscore())
   rd=ReadFile(#PB_Any,"levels\"+levelpack+"\"+"hiscore.txt")
   
   If rd
      Repeat
         AddElement(hiscore())
         r$=ReadString(rd)
         hiscore()\name=StringField(r$,2,",")
         hiscore()\points=Val(StringField(r$,3,","))
         hiscore()\level=StringField(r$,1,",")
      Until Eof(rd)
      CloseFile(rd)
   Else
      For a=1 To 10
         AddElement(hiscore())
         hiscore()\name=RSet("",3,Chr(64+a))
         hiscore()\points=1000*a
      Next
   EndIf
   
EndProcedure
et voila :)
ImageImage
Avatar de l’utilisateur
case
Messages : 1528
Inscription : lun. 10/sept./2007 11:13

Re: puredash

Message par case »

necessite de telecharger l'archive du jeu dans le premier post pour les images et sons, niveaux etc...
ImageImage
Répondre