puredash
-
- Messages : 579
- Inscription : ven. 11/mai/2007 15:21
Re: puredash
Bravo, c'est très fidèle à l'original, tout en proposant quelques nouveautés bien sympa !
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...
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.
Re: puredash
Marche pas sous wine :/
on peut avoir une version Linux ou tu utilises des api w32 en masse ?
on peut avoir une version Linux ou tu utilises des api w32 en masse ?
Re: puredash
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
!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
Re: puredash
comment ca ?case a écrit :oui c'est normal
il n'y a pas de diamants mais il y a de quoi en fabriquer
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
!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
- falsam
- Messages : 7244
- Inscription : dim. 22/août/2010 15:24
- Localisation : IDF (Yvelines)
- Contact :
Re: puredash
Faits manger des pierres et de l'herbe aux monstres pour voir ce qui en ressort :p
Bon ok ..... c'est nul.
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%
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Re: puredash
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
Re: puredash
envoyer une pierre sur un monstre?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
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
!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
-
- Messages : 4312
- Inscription : mer. 28/janv./2004 20:58
- Localisation : Clermont ferrand OU Olsztyn
- Contact :
Re: puredash
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
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.
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
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)]
[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Re: puredash
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
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.
Re: puredash
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
Re: puredash
necessite de telecharger l'archive du jeu dans le premier post pour les images et sons, niveaux etc...