Forum Liberty Basic France

Le 27/07/2012 à 15h05

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2199
Reprise du message précédent

Soit prudent....Ce jeu est super....
____________________
Roro

   
Le 27/07/2012 à 15h34

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
J'y suis peut-être arrivé sans trop casser :siffle :lol

bd_jb.zip

@+

Edit: tu as réussi le niveau 01 Roland ? ;) :siffle



Edité par cassiope01 Le 27/07/2012 à 16h17
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 27/07/2012 à 16h55

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2199
J'ai réussi ton niveau de la mort, mais j'ai eu du mal. :s
Dis-donc, c'est pas si facile de générer un niveau malin...il faut jongler avec les sauvegardes.
hey ! tu n'a pas dit qu'on pouvait avancer à la souris....C'est top ! :top :top



Edité par Roland Le 27/07/2012 à 17h04
____________________
Roro

   
Le 27/07/2012 à 17h16

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Oui mais pour une fois, je trouve ça moins sympa à jouer à la souris ;)

il y a aussi la touche Entrée = New, Eff = Undo, L ou l = Levels,
et bien sûr Espace et R ou r pour le mode éditeur.

@+



Edité par cassiope01 Le 27/07/2012 à 17h18
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 27/07/2012 à 18h43

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2199
La chasse n'a pas été fameuse, je ramène une bestiole, mais manque de pot; elle doit vivre dans le sable; à voir son pelage.
Au marché, pareil; tout ce qui est rond ressemble trop à une bille.
J'ai grossit la carotte N°1 et changé la fourchette ( elle était sous copyright...la fourchette...faux pas déconner avec ça...)
3 carottes.zip
J'avais une superbe image du marsupilami. J'ai envoyé un mail pour savoir ce qu'on pouvait en faire
c'est simple--> RIEN
Franquin, il a pas du gagner assez de fric avec son dessin...ou alors il a que celui-là ?
____________________
Roro

   
Le 27/07/2012 à 23h03

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2199
Tu dis que le champs entier tiens dans une chaine. Pourquoi ne pas pouvoir charger un tableau à chaque modif dans l'éditor, avec 10 ou 15 pas ça serait déjà bien. Si le tableau est trop gros (15x300), on peut peut-etre faire 10 ou 15 tableaux, ou tout simplement 15 chaines numérotées, rappellées l'une aprés l'autre au clic sur undo, et vidées au save, avec un compte à rebours des undo's restants affiché.......ou révais-je ?



Edité par Roland Le 27/07/2012 à 23h05
____________________
Roro

   
Le 28/07/2012 à 07h52

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
C'est exactement ce que je fait avec les undo ! sauf qu'une nouvelle chaine est mémorisée uniquement lorsqu'une carrotte est ramassée.
Le undo restitue donc l'état au moment de la prise de carrotte.
Si je devais enregistrer chaque déplacement du lapin ça deviendrait vide énorme vu que le joueur peut faire à peu près ce qu'il veut avec le lapin !
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 28/07/2012 à 10h10

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Derniers petits BUG débusqués par ci par là :siffle , du moins j'espère ;)

bd_jb.zip
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 28/07/2012 à 11h02

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2199
Mais dans l'éditor (c'est là que ça manque) n'est-il pas possible de générer une chaine à chaque action.
Disons une dizaine, avec un affichage du N° de chaine en cours.
Qui seraient vidées soit par un bouton, ou/et au save.
L'intérét majeur de ce jeu réside dans la conception des niveaux.
Ce qui serait le top, ce serait que les chaines ne soient pas rappelées par des pressions successives sur "undo", mais que chaque chaine soit accessible par un bouton dédié.
Quitte à mettre dans le bas de la fenetre une dizaine de boutons dans lesquels s'affiche le N° de chaine en cours.
Je peux te dire que je suis dessus comme la misère sur les pauvres............à+
____________________
Roro

   
Le 28/07/2012 à 11h48

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Roland:
Mais dans l'éditor (c'est là que ça manque) n'est-il pas possible de générer une chaine à chaque action.
Disons une dizaine, avec un affichage du N° de chaine en cours.
Qui seraient vidées soit par un bouton, ou/et au save.
L'intérét majeur de ce jeu réside dans la conception des niveaux.
Ce qui serait le top, ce serait que les chaines ne soient pas rappelées par des pressions successives sur "undo", mais que chaque chaine soit accessible par un bouton dédié.
Quitte à mettre dans le bas de la fenetre une dizaine de boutons dans lesquels s'affiche le N° de chaine en cours.
Je peux te dire que je suis dessus comme la misère sur les pauvres............à+


Pourquoi faire simple quand on peut faire compliqué n'est-ce pas Roland ;) ;)
Je ne comprend pas vraiment ton soucis !?
En mode éditeur, l'icône du sable peut te servir de gomme !
Si tu as peur d'oublier ce que tu faisais tu n'as qu'à enregistrer le niveau !
Tu as accès à la touche "L" pour charger un niveau même en mode éditeur. D'ailleurs fait attention parce que tu peux facilement écraser le niveau que tu es en train de fabriquer...! Je peux l'empêcher si tu veux !?
Tu peux même faire des copies d'écran ;)

@+



Edité par cassiope01 Le 28/07/2012 à 11h49
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 28/07/2012 à 14h10

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2199
Pour l'instant, je fais effectivement avec des copies d'écran, en traçant les chemins au log de dessin.
Le pb, c'est que au "save" tu prend le jeu dans son dernier état.
Si aprés avoir fait des modifs, tu passe en mode test. Le undo te rammène à l'état d'avant les modifs.
Si tu "save" aprés avoir testé, il y a forcément des éléments qui ont bougés, du fait du test.
Le fait que tu ne soit pas soumis à ces contraintes, prouve que tu a généré le niveau en une seule fois, sans avoir besoin de le tester ( CQFD du post de chez Atomose)
____________________
Roro

   
Le 28/07/2012 à 14h30

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Roland:
Le fait que tu ne soit pas soumis à ces contraintes, prouve que tu a généré le niveau en une seule fois, sans avoir besoin de le tester ( CQFD du post de chez Atomose)


Comme d'hab tu me prêtes plus de capacité que je n'ai en réalité.
J'ai simplement ajouté des trucs dans le niveau en testant au fur et à mesure que je le dessinais.

@+



Edité par cassiope01 Le 28/07/2012 à 14h32
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 29/07/2012 à 00h58

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2199
La sub replace string$ a l'air d'etre fort intérréssante, dommage qu'elle ne soit pas trés commentée.
Le tableau record$ stocke t-il des game$ ?
Il y a une chose assez mystérieuse (si y'en avait qu'une...) Ce tableau record$ est utilisé sans avoir été rempli de quoi que se soit nulle part... :heink



Edité par Roland Le 29/07/2012 à 01h13
____________________
Roro

   
Le 29/07/2012 à 07h17

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Roland:
La sub replace string$ a l'air d'etre fort intérréssante, dommage qu'elle ne soit pas trés commentée.
Le tableau record$ stocke t-il des game$ ?
Il y a une chose assez mystérieuse (si y'en avait qu'une...) Ce tableau record$ est utilisé sans avoir été rempli de quoi que se soit nulle part... :heink

Traduction :
La sub replace string$ a l'air d'etre fort intérréssante, je vais de ce pas regarder de plus près ce qu'elle fait pas à pas ;)
Le tableau record$() stocke quoi exactement ? Ah mais oui, j'utilise la fonction recherche de l'éditeur JB pour trouver où se trouve la ligne où est écrit record$( ) = ...
Il y a une chose assez mystérieuse (si y'en avait qu'une...) Ce tableau record$ est utilisé sans avoir été rempli de quoi que se soit nulle part... :heink mais vu que c'est pas possible et vu la petite recherche que j'ai fait juste avant et qui m'a permis de trouver où record$() est rempli, je peux dire que [record] est très simple en effet !

...



Edité par cassiope01 Le 29/07/2012 à 07h19
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 29/07/2012 à 08h20

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Correction de petits bug + ajout de 3 niveaux supplémentaires pas "piqués des vers", issus du forum anglophone (NJames).

bd_jb.zip

@+



Edité par cassiope01 Le 29/07/2012 à 08h20
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 29/07/2012 à 08h56

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2199
Tu peux bien faire le malin...mais pendant que ton "undo" rammène invariablement à la case départ,
le mien qui ne fait que cinq pas, car il est encore "jeune" permet de revenir indifférament au pas N° 3 puis au N°1 puis au N°4 .puis au N°2..et pourtant, je n'ai toujours pas compris comment fonctionne la sub replace string$.
Et je vois que je vais devoir me passer de tes explications...Bon...il en faudra plus pour m'arreter. :miam
____________________
Roro

   
Le 29/07/2012 à 09h29

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Petite surprise...

bd_jb.zip

@+

PS: Roland:
Et je vois que je vais devoir me passer de tes explications...
arrête toi un peu Roland. Je ne fais que ça t'expliquer des tas de trucs tu ne peux pas dire le contraire, mais tu sais bien que je n'y suis jamais parvenu. De plus mes codes ne sont pas forcément TOUS des tutoriels pour Roland.



Edité par cassiope01 Le 29/07/2012 à 10h50
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 29/07/2012 à 10h36

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Encore quelques améliorations et corrections de BUGs suite au sujet sur le forum anglophone...

bd_jb.zip

Ce devrait être la dernière en principe...! à part l'ajout de niveaux supplémentaires :top

@+
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 29/07/2012 à 22h26

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2199
A L'AIDE ! AU SECOURS ! HELP !
Je me suis cassé la tete à mettre au point un P....n de undo (10 pas indépendants/ marche avant/marche arrièrre/moon walking/Game/Editor) qui fonctionne nickel avec les niveaux 1 ET 4 et qui plante avec les niveaux 2 ET 3 de ta dernière version avec les explosions.
Caisse qui ce passe ? Les niveaux 2 et 3 sont ..corrompus....COR-ROM-PUS...!

PS: Quand le niveau a été sauvé par l'éditor, mon undo marche bien dans le niveau rappelé .



Edité par Roland Le 29/07/2012 à 23h21
____________________
Roro

   
Le 30/07/2012 à 07h29

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Bon sang Roland combien de fois devrais-je te le répéter : sans ton code comment veux-tu que je trouve ce qui ne va pas ????????

En plus tu l'as déjà très justement fait remarqué à Alex !!!!!!!

:@
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 30/07/2012 à 09h23

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2199
D'un geste auguste , je livre le code au fauve.
Je t'averti, il y a des lignes en trop...je m'en fout, c'est pas moi qui les execute...
Note: pour passer de éditor à game, il faut faire game-->editor-->game pour que le bazar se remette à zéro
Si tu a une map noire, il faut charger un niveau. Les 2 et 3 font planter à partir du sixième pas.
.....Hey ! je commente...moi......
Ps: j'ai mis des: §§§§ aux endroits que j'ai touchés

Code JB :
 
 
 
    ' http://libertybasic.fr/forum/topic-177+besoin-d-imagination-pour-creer-les-niveaux-de-ce-jeu.php
    ' cassiope01 jul, 26 2012
 
  'ATTENTION: Pour passer de éditor à game, faire: Game-->Editor-->Game
       '...pour remise à zéro myrecord$
    nomainwin
 
    GLOBAL ncx, ncy, dc, oldcurX, oldcurY, curX, curY, nb
 
    ncx = 24   ' nbr of cells X
    ncy = 16    ' nbr of cells Y
    dc = 42    ' size of a cell in pixels
    MapWidth = ncx*dc+int(dc/ncx)
    MapHeight = ncy*dc+int(dc/ncy)
 
    WindowWidth  = MapWidth + 15+90 '§§§§§§§§§§§§§§§§§
    WindowHeight = MapHeight + 75
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 2
 
   ' mois$ = "January February March April May June July August September October November December"
    mois$ = "Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre"   ' french
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
   ' jsem$ = word$("Tuesday Wednesday Thursday x Friday Saturday x Sunday Monday",int((j/7-int(j/7))*10)+1)
    jsem$ = word$("Mardi Mercredi Jeudi x Vendredi Samedi x Dimanche Lundi",int((j/7-int(j/7))*10)+1)   ' french
    date$ = jsem$+" "+mid$(today$,4,2)+" "+word$(mois$, val(today$))+" "+right$(today$,4)+"  "+left$(time$(),5)
 
    DIM info$(10,10)
    DIM cell(ncx,ncy)
    DIM mem(ncx,ncy) ' for "undo"
    DIM dirX(4), dirY(4)
    DIM record$(20)
    DIM myrecord$(20)  '§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
    DIM level$(30)
    dirX(1) = 0  : dirY(1) = -1  'up
    dirX(2) = 1  : dirY(2) = 0   'right
    dirX(3) = 0  : dirY(3) = 1   'down
    dirX(4) = -1 : dirY(4) = 0   'left
 
    loadbmp "billes",  "Billes.bmp"
    loadbmp "bille21", "Bille21.bmp"
    loadbmp "mur2",    "Mur2.bmp"
    loadbmp "mur3",    "Mur3.bmp"
    loadbmp "sable1",  "Sable1.bmp"
    loadbmp "lapin",   "Lapin.bmp"
    list$ = "lapin sable1 mur2 b1 b2 b3 b4 b5 b6 b7 b8 bille21"
    for ex = 1 to 5 :loadbmp "explose";ex, "explosion";ex;".bmp" :next
 
       button #w.bta "Action N°",[undo],UL, WindowWidth-90, 50, 80, 25
       button #w.bt1 "1",[undo1],UL, WindowWidth-90, 80, 80, 25
       button #w.bt2 "2",[undo2],UL, WindowWidth-90, 110, 80, 25
       button #w.bt3 "3",[undo3],UL, WindowWidth-90, 140, 80, 25
       button #w.bt4 "4",[undo4],UL, WindowWidth-90, 170, 80, 25
       button #w.bt5 "5",[undo5],UL, WindowWidth-90, 200, 80, 25
       button #w.bt6 "6",[undo6],UL, WindowWidth-90, 230, 80, 25
       button #w.bt7 "7",[undo7],UL, WindowWidth-90, 260, 80, 25
       button #w.bt8 "8",[undo8],UL, WindowWidth-90, 290, 80, 25
       button #w.bt9 "9",[undo9],UL, WindowWidth-90, 320, 80, 25
       button #w.bt10 "10",[undo10],UL, WindowWidth-90, 350, 80, 25
 
       TEXTBOX #w.testa, WindowWidth-90, 400, 80, 25
    statictext #w.txt "",5,10,270,25
    statictext #w.txt2 "SPACE = On/Off Editor",280,10,200,25
    button #w.lev "Levels",[loadlevel],UL,555,6,65,27
    button #w.bck "Undo",[undo],UL,MapWidth-130,6,60,27
    button #w.new "New",[new],UL,MapWidth-55,6,60,27
    graphicbox #w.gsc1, MapWidth-380,6,86,28
    graphicbox #w.gsc2, MapWidth-290,6,146,28
    graphicbox #w.map, 5, 40, MapWidth, MapHeight
    OPEN "    Boulder Dash JB... "+space$(15)+date$ for window_nf as #w  'graphics_nf_nsb
    #w "trapclose [quit]"
    #w.txt "!font Comic_Sans_MS 12 bold"
    #w.txt2 "!font Comic_Sans_MS 12"
    #w.lev "!font Comic_Sans_MS 12 bold"
    #w.bck "!font Comic_Sans_MS 12 bold"
    #w.new "!font Comic_Sans_MS 12 bold"
    #w.map "down; backcolor black; fill black"
    #w.gsc1 "down; backcolor lightgray ; fill lightgray"
    #w.gsc2 "down; backcolor lightgray ; fill lightgray"
    #w.gsc1 "font Courier_New 19 bold"
    #w.gsc2 "font Courier_New 18 bold"
 
    #w.map "getbmp p0 0 0 ";dc;" ";dc  ' empty cell for deleting
    #w.map "drawbmp billes 0 0"
    for b = 1 to 8
        d = val(word$("0 45 89 133 177 221 266 311",b))  ' exact pixels in the bmp...
        #w.map "getbmp b";b;" ";d;" 0 ";dc;" ";dc  ' make bmps needed
    next
 
    for y = 1 to ncy        ' murs externes et sable
        for x = 1 to ncx
            if y=1 or y=ncy or x=1 or x=ncx then
                #w.map "drawbmp mur3 ";(x-1)*dc;" ";(y-1)*dc
                cell(x,y) = 11
            else
                #w.map "drawbmp sable1 ";(x-1)*dc;" ";(y-1)*dc
                cell(x,y) = 10
            end if
        next
    next
 
    [new]
    if rec > 0 and nbD > 0 then  ' re-init current level.
        call replace record$(1)
        goto [game]
    end if
    if fileExist(defaultDir$, "saved.ini") and first = 0 then
        open "saved.ini" for input as #lev
        line input #lev, game$
        close #lev
        call replace game$
        first = 1
        LVname$ = left$(info$(1,0),len(info$(1,0))-4)
        goto [game]
    else
        if fileExist(DefaultDir$, "level_01.lev") then
            open "level_01.lev" for input as #lev
            line input #lev, game$
            close #lev
            call replace game$
            first = 1
            LVname$ = left$(info$(1,0),len(info$(1,0))-4)
            goto [game]
        end if
    end if
 
    [game]
        editor = 0
        curIM = 1  'rabbit by default in editor mode
        nbD = nbBilles()  'nb of things to catch
        nb = nbD
        gosub [dispNB]
        gosub [dispLVname]
        #w.map "drawbmp lapin ";(curX-1)*dc;" ";(curY-1)*dc
        #w.map "flush ; discard"
        gosub [currentXY] 'rabbit coordonates
        #w.txt ""
        rec = 0
        FIN = 0
        redim record$(nbD)  're-init for undo
        gosub [record]  ' first record for undo
            redim myrecord$(20) '§§§§§§§§§§§§§§§§§
            reco=0              '§§§§§§§§§§§§§§§§§
            print #w.bta, "Action N°";reco '§§§§§§§§
        #w.map "setfocus"
        #w.map "when leftButtonDown [mouse]"    ' x,y cell
        #w.map "when characterInput [keyboard]"    ' x,y cell
       ' #w.map "when mouseMove [infos]"    ' x,y cell
    WAIT
 
    [dispNB]
        #w.gsc1 "fill lightgray ; color red ; place 8 21 ;|";nb
        #w.gsc1 "flush ;discard"
        if nb = 0 then  #w.txt "   Bravo ! c'est Gagné." :gosub [explosion]
    return
 
    [dispLVname]
        #w.gsc2 "fill lightgray ; color blue ; place 8 21 ;|";LVname$
        #w.gsc2 "flush ;discard"
    return
 
    [explosion]
        #w.map "when leftButtonDown"
        #w.map "when characterInput"
        for y=2 to ncy-1
            for x=2 to ncx-1
                if cell(x,y)>0 and cell(x,y)<10 and FIN = 1 then  ' lost !!
                    [good]
                    #w.map "drawbmp p0 ";(x-1)*dc;" ";(y-1)*dc
                    for ex = 1 to 5
                        #w.map "drawbmp explose";ex;" ";6+(x-1)*dc;" ";6+(y-1)*dc
                        timer 10, [tmp1] : wait
                        [tmp1]
                        timer 0
                    next
                    for ex = 5 to 1 step -1
                        #w.map "drawbmp explose";ex;" ";6+(x-1)*dc;" ";6+(y-1)*dc
                        timer 10, [tmp2] : wait
                        [tmp2]
                        timer 0
                    next
                    cell(x,y) = 0
                else
                    if cell(x,y) = 12 and FIN = 0 then [good]
                end if
            next
        next
        FIN = 1
        #w.map "when leftButtonDown [mouse]"    ' x,y cell
        #w.map "when characterInput [keyboard]"    ' x,y cell
    return
 
    [keyboard]
        dir = 0
        codeT = asc(right$(Inkey$,1))
        select case codeT
        case _VK_UP    :dir = 1  ' arrows
        case _VK_RIGHT :dir = 2
        case _VK_DOWN  :dir = 3
        case _VK_LEFT  :dir = 4
        case 8  :goto [undo]  ' DELETE
        case 13 :gosub [new]  ' ENTER
        case 32 :gosub [editor]  ' on/off level editor
        case 114 :gosub [reclevel] ' r
        case 82  :gosub [reclevel] ' R
        case 108 :goto [loadlevel] ' l
        case 76  :goto [loadlevel] ' L
        end select
        if dir>0 and editor = 0 then gosub [action]
    wait
 
    [mouse]
        dir = 0
        mx = int(MouseX/dc)+1
        my = int(MouseY/dc)+1
    if my >1 then           '§§§§§§§§§§§§§§§ Saute la ligne de selection
       gosub [myrecord]    '§§§§§§§§§§§§§§§§§ Le mien record$
       print #w.bta, "Action N°";reco  '§§§§§§§§§§ Affichage dans bouton
    end if    '§§§§§§§§§§§§§§§§§§§§§§§§§§
        select case
        case editor > 0 :if my = 1 and mx > 5 and mx < 18 then curIM = mx-5  'select element
        case oldcurX-mx = 0 and my < oldcurY :dir = 1  ' up
        case oldcurY-my = 0 and mx > oldcurX :dir = 2  ' right
        case oldcurX-mx = 0 and my > oldcurY :dir = 3  ' down
        case oldcurY-my = 0 and mx < oldcurX :dir = 4  ' left
        end select
        if dir > 0 and editor = 0 then gosub [action]   ' gestion des évènements suite à ce déplacement du lapin...
        if dir = 0 and editor > 0 then   ' on est en mode éditeur
            if mx > 1 and mx < ncx and my > 1 and my < ncy then
                #w.map "drawbmp ";word$(list$,curIM);" ";(mx-1)*dc;" ";(my-1)*dc
                cell(mx,my) = val(word$("9 10 11 1 2 3 4 5 6 7 8 12",curIM))
                #w.map "flush ; discard"
                gosub [currentXY] 'rabbit coordonates
                nbD = nbBilles()  'nb of things to catch
                nb = nbD
                gosub [dispNB]
            end if
        end if
    wait
 
    [currentXY] ' the first cell() with 9 => rabbit and so the starting position
        out = 0
        for y=2 to ncy-1
            for x=2 to ncx-1
                if cell(x,y) = 9 then
                    curX = x :oldcurX = curX
                    curY = y :oldcurY = curY
                    out = 1
                    exit for
                end if
            next
            if out then exit for
        next
    return
 
    function nbBilles()  'nb of things to catch
        for y=2 to ncy-1
            for x=2 to ncx-1
                if cell(x,y)>0 and cell(x,y)<9 then nbBilles = nbBilles + 1
            next
        next
    end function
 
    [editor]
        rec = 0  ' disactivate 'undo'
        if editor = 0 then   ' editor ON
            #w.txt " EDITOR"
            redim myrecord$(20) '§§§§§§§§§§§§§§§§§§§   ' Coup de torchon
            reco=0              '§§§§§§§§§§§§§§§§§§           +
            print #w.bta, "Action N°";reco '§§§§§§§§      Affichage
            for im = 1 to 20
                #w.map "drawbmp ";word$("p0 p0 p0 "+list$+" p0 p0 p0 p0 p0",im);" ";(im+1)*dc;" ";0
            next
            #w.map "color yellow ; font Comic_Sans_MS 14 bold"
            #w.map "place ";2*dc+10;" 28 ;|Select -->"
            #w.map "place ";17*dc+16;" 28 ;|R -> Record Level"
            #w.map "flush ; discard"
            editor = 1
            #w.map "when leftButtonMove [draw]"
        else                 ' editor OFF
            gosub [record]
      gosub [myrecord]  '§§§§§§§§§§§§§§§ Le mien [record]
            #w.map "when leftButtonMove"
            #w.txt "" :curIM = 1
            for im = 1 to 20
                #w.map "drawbmp mur3 ";(im+1)*dc;" ";0
            next
            #w.map "flush ; discard"
            #w.map "color black"
            editor = 0
        end if
    return
 
    [draw]
    if editor then
        mx = int(MouseX/dc)+1
        my = int(MouseY/dc)+1
        if mx > 1 and mx < ncx and my > 1 and my < ncy then
            #w.map "drawbmp ";word$(list$,curIM);" ";(mx-1)*dc;" ";(my-1)*dc
            #w.map "flush ; discard"
            cell(mx,my) = val(word$("9 10 11 1 2 3 4 5 6 7 8 12",curIM))
            gosub [currentXY] 'rabbit coordonates
            nbD = nbBilles()  'nb of things to catch
            nb = nbD
            gosub [dispNB]
        end if
    end if
    wait
 
    [action]  ' player game
        if FIN = 1 then [new]
        ok = 0 :record = 0
        curX = oldcurX + dirX(dir)  ' new rabbit's coord.
        curY = oldcurY + dirY(dir)
        if cell(curX,curY) < 11 then
            #w.map "drawbmp p0 ";(oldcurX-1)*dc;" ";(oldcurY-1)*dc
            cell(oldcurX,oldcurY) = 0
            #w.map "drawbmp lapin ";(curX-1)*dc;" ";(curY-1)*dc
            if cell(curX,curY) > 0 and cell(curX,curY) < 9 then  ' element kept
                nb = nb - 1
                gosub [dispNB]
                record = 1  ' ok to record for 'undo'
            end if
            cell(curX,curY) = 9
            if cell(oldcurX,oldcurY-1) = 12 then
                ' si curY - 1 = 12 : PERDU ! car curY - 1 = 12 tombe sur le lapin !
                if dir = 3 then
                    #w.map "drawbmp p0 ";(oldcurX-1)*dc;" ";(oldcurY-2)*dc
                    #w.map "drawbmp bille21 ";(curX-1)*dc;" ";(curY-1)*dc
                    cell(oldcurX,oldcurY-1) = 0
                    cell(oldcurX,oldcurY) = 12
                    FIN = 1
                    #w.txt "  PERDU !"
                    gosub [explosion]
                else
                  ' si oldcurY-1 = 12 elle doit tomber avec celle(s) du dessus
                    call fall oldcurX,oldcurY
                end if
            end if
            ok = 1
        end if
        if cell(curX,curY) = 12 and dir > 1 and (oldcurX+2*dirX(dir)<=ncx and oldcurY+2*dirY(dir)<=ncy) then
            if cell(oldcurX+2*dirX(dir),oldcurY+2*dirY(dir)) = 0 then  ' elle est poussée si la cellule de derrière est vide
                #w.map "drawbmp p0 ";(oldcurX-1)*dc;" ";(oldcurY-1)*dc
                cell(oldcurX,oldcurY) = 0
                #w.map "drawbmp bille21 ";(curX+dirX(dir)-1)*dc;" ";(curY+dirY(dir)-1)*dc
                #w.map "drawbmp lapin ";(curX-1)*dc;" ";(curY-1)*dc
                if cell(curX,curY) > 0 and cell(curX,curY) < 9 then  ' element kept
                    nb = nb - 1
                    gosub [dispNB]
                    record = 1  ' ok to record for 'undo'
                end if
                cell(curX,curY) = 9
                cell(curX+dirX(dir),curY+dirY(dir)) = 12
                ok = 1
                call fall oldcurX,oldcurY
                call fall curX+dirX(dir),curY+dirY(dir)+1
            end if
        end if
        if ok then
            oldcurX = curX
            oldcurY = curY
            if record then gosub [record]
        end if
    wait
 
    [reclevel]      ' record this level (from editor)
        if editor then
            confirm "Record this new level ?"; answer$
            if answer$ = "yes" then
                filedialog "Save As...", "level_**.lev", filename$
                ' care if already exist filename$ !!!!
                if filename$ <> "" then
                    level$ = "" :rabbit = 0
                    for y=2 to ncy-1
                        for x=2 to ncx-1
                            if cell(x,y) = 9 then rabbit = rabbit + 1
                            level$ = level$+using("##",cell(x,y))
                        next
                        if rabbit > 1 then notice "WRONG LEVEL !"+chr$(13)+"It can exist only 1 Rabbit !" :exit for
                    next
                    if rabbit = 1 then
                        open filename$ for output as #lv
                        #lv, level$
                        close #lv
                        notice filename$+" recorded."
                        nbD = nbBilles()
                        nb = nbD
                        rec = 0
                        first = 1
                        files DefaultDir$, filename$, info$(
                        LVname$ = left$(info$(1,0),len(info$(1,0))-4)
                        gosub [dispLVname]
                        gosub [record]
                        'goto [game]
                    end if
                end if
            end if
        end if
    return
 
    [loadlevel]    ' load a level file
        filedialog "Load level file :", "level_*.lev", filename$
        if filename$ <> "" and fileExist(DefaultDir$, filename$) then
            open filename$ for input as #lev
            line input #lev, game$
            close #lev
            redim myrecord$(20) '§§§§§§§§§§§§§§§§§§§§§§ Coup de balai
            reco=0              '§§§§§§§§§§§§§§§§§§§§§      +
            print #w.bta, "Action N°";reco '§§§§§§§§     Affichage
            call replace game$
            first = 1
            LVname$ = left$(info$(1,0),len(info$(1,0))-4)
            goto [game]
        end if
    wait
 
    [myrecord]    ' only for undo  ' My Record whith my variables
        reco = reco + 1               ' And my array
        if reco=11 then reco=1
        if reco <= nbD then
            for y=2 to ncy-1
                for x=2 to ncx-1
                    myrecord$(reco) = myrecord$(reco)+using("##",cell(x,y))
                next
            next
        end if
    return
    [record]    ' only for undo
        rec = rec + 1
        if rec <= nbD then
            for y=2 to ncy-1
                for x=2 to ncx-1
                    record$(rec) = record$(rec)+using("##",cell(x,y))
                next
            next
        end if
    return
 
    [undo1]             ' Démmarrage de la fonction copié/collé de Windows
        reco=1                            ' Tour de chauffe
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo2]
        reco=2
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo3]
        reco=3                            ' Montée en régime
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo4]
       reco=4
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo5]
       reco=5                               ' 9500 RPM
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo6]
        reco=6
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo7]
        reco=7
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo8]
        reco=8
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo9]
       reco=9
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait
    [undo10]
       reco=10
            call replace myrecord$(reco)
            if nb < nbD then nb = nb + 1
            gosub [dispNB]
        #w.map "setfocus"
    wait                                 ' Extinction/Refroidissement
 
    [undo]
        if rec > 0 and editor = 0 then
            on error goto [no]
            call replace record$(rec)
            rec = rec - 1
            nb = nbBilles()  'nb of things to catch
            gosub [dispNB]
            [no]
        end if
        #w.map "setfocus"
    wait
 
    sub replace string$
        list2$ = "b1 b2 b3 b4 b5 b6 b7 b8 lapin sable1 mur2 bille21"
        cel = 1 :nb = 0
        for y = 2 to ncy-1
            for x = 2 to ncx-1
               value = val(mid$(string$,cel,2))
               if cell(x,y) <> value then
                  cell(x,y) = value
                  if value = 0 then
                      #w.map "drawbmp p0 ";(x-1)*dc;" ";(y-1)*dc
                  else
                      on error goto [bug]
                      #w.map "drawbmp ";word$(list2$,cell(x,y));" ";(x-1)*dc;" ";(y-1)*dc
                      [bug]
                  end if
                  if cell(x,y) = 9 then
                     curX = x :oldcurX = curX
                     curY = y :oldcurY = curY
                  end if
               end if
               cel = cel + 2
            next
        next
        #w.map "flush ; discard"
    end sub
 
    sub fall cx,cy  ' falling down ( cx,cy = coord. of the cell under )
        dy = cy
        while cell(cx,dy-1) = 12
            fy = dy
            while cell(cx,fy) = 0
                call fallstep (cx-1)*dc, (fy-2)*dc, (fy-1)*dc   ' slow down fall...
                cell(cx,fy-1) = 0
                cell(cx,fy) = 12
                fy = fy + 1
            wend
            dy = dy - 1
        wend
        #w.map "flush ; discard"
    end sub
 
    sub fallstep dx, dy, ay   ' slow down fall...
         stp = int(dc/16)
         nstp = int(dc/stp)
         fy = dy
         for p = 1 to nstp
              #w.map "place ";dx;" ";fy;" ;boxfilled ";dx+dc;" ";fy+stp
              fy = fy + stp
              #w.map "drawbmp bille21 ";dx;" ";fy
         next
         #w.map "drawbmp bille21 ";dx;" ";ay
         #w.map "flush ; discard"
    end sub
 
    [infos]  ' only for debug
        cx = int(MouseX/dc)+1 :if cx>ncx then cx=ncx
        cy = int(MouseY/dc)+1 :if cy>ncy then cy=ncy
        #w.txt "cell(";cx;",";cy;") = ";cell(cx,cy)
    wait
 
    function fileExist(path$, filename$)
        files path$, filename$, info$()
        fileExist = val(info$(0, 0))
    end function
 
    [quit]
        CONFIRM "QUIT THE GAME ?"; answer$
        if answer$ = "yes" then
            level$ = ""
            for y=2 to ncy-1
               for x=2 to ncx-1
                   level$ = level$+using("##",cell(x,y))
               next
            next
            open "saved.ini" for output as #clv   ' save current game
            #clv, level$
            close #clv
            unloadbmp "mur3"
            for im = 1 to 12 :unloadbmp word$(list$,im) :next
            for ex = 1 to 5  :unloadbmp "explose";ex :next
            close #w
            END
        end if
    wait
 
 




Edité par Roland Le 30/07/2012 à 09h25
____________________
Roro

   

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie