Forth Sokoban pour VG5000
Publié : 26 avr. 2010 13:45
Bonjour à tous !
Voici le SOKOBAN avec son éditeur pour VG5000, totalement en Forth
http://forthretro.new.fr/download/VGSOKOBAN.zip
1 ° Charger la K7 comme habituellement sur l'émulateur de Daniel
CLOAD "SOKO"
Une fois chargé, vous avez deux options :
A) Ne charger aucun niveau - Vous allez les créer.
Faire simplement CALL &"5200"
Les écrans sont, je pense, autoexplicatifs.
Passer tout de suite à l'éditeur de niveau (voir comment les sauvegarder)
B) Charger un buffer de niveaux.
Vous en avez un, appelé "ORIG" composé des 6 premiers tableaux de la page
http://www.sourcecode.se/sokoban/levelg ... slc&page=0
Chargez ce niveau par
CLOAD "ORIG"
et allez au SOKO par CALL &"5200"
2 ° Après le retour au Basic, vous pouvez enregistrer vos NIVEAUX.
Le niveau 1 commence à $7800 (30720 décimal)et chaque niveau pèse $187 octet (391 décimal)
Par exemple pour enregistrer 10 niveaux faire
CSAVEM 30720, 3910
Bon jeu à tous.
*****PS m'informer SVP des bugs éventuels et toute suggestion sera la bien venue !
En particulier la définition des graphiques.
J'ai voulu faire un gars chaussé de lunettes de soleil rangeant des caddies ...
mais bon..
Voici le SOKOBAN avec son éditeur pour VG5000, totalement en Forth
http://forthretro.new.fr/download/VGSOKOBAN.zip
1 ° Charger la K7 comme habituellement sur l'émulateur de Daniel
CLOAD "SOKO"
Une fois chargé, vous avez deux options :
A) Ne charger aucun niveau - Vous allez les créer.
Faire simplement CALL &"5200"
Les écrans sont, je pense, autoexplicatifs.
Passer tout de suite à l'éditeur de niveau (voir comment les sauvegarder)
B) Charger un buffer de niveaux.
Vous en avez un, appelé "ORIG" composé des 6 premiers tableaux de la page
http://www.sourcecode.se/sokoban/levelg ... slc&page=0
Chargez ce niveau par
CLOAD "ORIG"
et allez au SOKO par CALL &"5200"
2 ° Après le retour au Basic, vous pouvez enregistrer vos NIVEAUX.
Le niveau 1 commence à $7800 (30720 décimal)et chaque niveau pèse $187 octet (391 décimal)
Par exemple pour enregistrer 10 niveaux faire
CSAVEM 30720, 3910
Bon jeu à tous.
*****PS m'informer SVP des bugs éventuels et toute suggestion sera la bien venue !
En particulier la définition des graphiques.
J'ai voulu faire un gars chaussé de lunettes de soleil rangeant des caddies ...
mais bon..
Code : Tout sélectionner
\*** S O K O B A N P O U R V G 5 0 0 0
\*** P A R D O M I N I Q U E C O N T A N T
\*** forthretro.new.fr
\*** 2010
\\\\\ DIVERS MOTS INDISPENSABLES ET ABSENTS DU NOYAU FORTH
: IMMEDIATE ENTRY DUP DUP C@ 1+ + DUP @ CURRENT @ ! COMPILER @ SWAP ! COMPILER ! ;
: DO 5ABB DO, ; IMMEDIATE : LOOP 5B0F END, ; IMMEDIATE
: BEGIN HERE ; IMMEDIATE : UNTIL *# *END END, ; IMMEDIATE
: WHILE *# *IF DO, 0 C, ; IMMEDIATE
: REPEAT SWAP *# *WHILE END, HERE OVER - SWAP C! ; IMMEDIATE
: FORGET CURRENT @ CONTEXT ! ' DUP BEGIN COMPILER @ OVER OVER < WHILE DUP C@ + 1+ @ COMPILER ! REPEAT DROP 2 - @ CURRENT @ ! DP @ C@ 3 + - DP ! ;
: DECIMAL 0A BASE ! ;
: HEX 10 BASE ! ;
: ." *# *( , 22 TOKEN HERE C@ 1+ DP +! ; IMMEDIATE
: / 0 SWAP D/MOD DROP ;
: #IN BEGIN 5000 DUP LBP ! INPUT BL TOKEN NUMBER UNTIL ;
CREATE OR D1E1 , B37D , 7C6F , 67B2 , E5 C, NEXT
CREATE BASIC CF0E , F706 , 213E , 8FD3 , 41ED , 8306 , 283E , 8FD3 , 41ED , CD C, 0286 , FB C, 7BED , 522A , C9E1 ,
\\\\\ REGISTRES – COMMANDES – ROUTINES UTILES
\\\\\\ Voir « Les astuces d’Alice » Chapitres 10/11/12 pages 79 et suivantes
\\\\\ OBS : FORTH INITIALISE VG5K EN COMMANDES LONGUES DU EF9345
\\\\\ Registres Directs
20 CONSTANT R0
21 CONSTANT R1
22 CONSTANT R2
23 CONSTANT R3
24 CONSTANT R4
25 CONSTANT R5
26 CONSTANT R6
27 CONSTANT R7
\\\Provoque et attend fin d’exécution
CREATE BUSY CD C, 0286 , NEXT
\Lecture d’un registre direct dans le TOS
CREATE REG@ (Reg Direct……Valeur) C5E1 , CF0E , 7D C, 8FD3 , 68ED , E5C1 , NEXT
\Ecriture d’une valeur dans un registre direct
CREATE REG! (Valeur, Reg Direct…) E1D1 , C5 C, CF0E , 7B C, 8FD3 , 69ED , C1 C, NEXT
\Commande en mode exécution
: EXEC 8 + ;
\Commande IND – Ecriture indirecte
: IND! 80 + ;
\Commande IND – Lecture indirecte
: IND@ 88 + ;
\\\\\Registres Indirects
1 CONSTANT TGS
2 CONSTANT MAT
3 CONSTANT PAT
4 CONSTANT DOR
7 CONSTANT ROR
\\\Lecture d’un registre indirect
: I-REG@ (Reg-ind …. Valeur)
IND@ \ Commande Lecture Indirecte de Reg-ind
R0 EXEC REG! \ Ecriture dans R0 + Execution
BUSY \ Provoque execution- Attend
R1 REG@ ; \ Lecture du resultat dans R1 - > TOS
\\\Ecriture dans un registre indirect
: I-REG! ( Valeur, Reg-ind ….)
SWAP \ Inversion de l’ordre de la pile
R1 REG! \ Valeur à ecrire (TOS) dans R1
IND! \ Commande Ecriture indirecte de Reg-ind
R0 EXEC REG! \ Ecriture commande dans R0 + Execution
BUSY \ Provoque execution - attend
;
\\\Constantes KRF-R (Read) KRF-W (Write)
8 CONSTANT KRF-R
0 CONSTANT KRF-W
\\\Commande Lecture KRF avec execution
: KRF@ KRF-R R0 EXEC REG! BUSY ;
\\\Commande Ecriture KRF avec execution
: KRF! KRF-W R0 EXEC REG! BUSY ;
\ Lecture ecran adresse X Y
: POINT@ (X,Y…. Valeur)
R6 REG! \ Y dans R6
R7 REG! \ X dans R7
KRF@ \ Commande Lecture KRF avec execution
R1 REG@ ; \ Lire R1 -> TOS
\ Ecriture ecran adresse X Y
: POINT! (Valeur, X, Y…) R6 REG! R7 REG! R1 REG! KRF! ;
\Constantes OCT-R (read) et OCT-W (write)
3C CONSTANT OCT-R
34 CONSTANT OCT-W
\Commande Lecture OCT + BUSY
: OCT@ OCT-R R0 EXEC REG! BUSY ;
\Commande Ecriture OCT + BUSY
: OCT! OCT-W R0 EXEC REG! BUSY ;
\\\ Couleurs
0 CONSTANT NOIR
1 CONSTANT ROUGE
2 CONSTANT VERT
3 CONSTANT JAUNE
4 CONSTANT BLEU
5 CONSTANT MAGENTA
6 CONSTANT CYAN
7 CONSTANT BLANC
\\\ Fonction MARGE pour changement de marge
\\\ Exemple : NOIR MARGE <cr>
: MARGE (Couleur…..)
MAT I-REG@ \ Lecture registre ind MAT
F8 AND \ AND 11111000 - Couleur mise à zero
+ \ Plus nouvelle couleur
MAT I-REG! ; \ remettre dans MAT
\\ Fonction FOND pour changement de fond ecran
\\ Toutes les routine 'impression écran' de Forth mettent adresse contenue à 523B dans R3
\\ Exemple : VERT FOND <cr> Optionnel : CLS pour tout l’écran
: FOND (Couleur…)
523B C@ \Lecture des 8 oct de 523B
F8 AND \ AND 11111000 - Couleur mise à zero
+ \ Plus nouvelle couleur
523B C! ; \Remettre dans 523B
\ Fonction COUL-CAR pour changement couleur de caractère
\ Toutes les routineS impression écran de Forth mettent adresse contenue à 523B dans R3
\ Exemple : ROUGE COUL-CAR <cr>
: COUL-CAR
10 * \déplacement des bits vers la gauche – bit0 - > bit4
523B C@ \ Lecture valeur à mettre dans R3 dès impression
8F AND \ Efface couleur – AND 10001111
+ \ajoute couleur
523B C! ; \ remet dans 523B
\\\ Jeu de caractères
\ Toutes les routines impression écran de Forth mettent adresse contenue à 523A dans R2
: G0 1 523A C! ;
: G10 21 523A C! ;
: G11 31 523A C! ;
: G20 41 523A C! ;
: G21 61 523A C! ;
\\\\\ SETET – Caractère programmable
\\ ***** Voir « Les astuces d’Alice » pages 114 et suivantes *****
\ Mise A Jour du Registre R5
: MAJR5 ( Caractère ….caractère-20)
20 – \ Caractère - 20
DUP \ duplique
3 AND \ and 00000011
C0 + \ or 11000000
R5 REG! ; \ Dans R5
\ Mise A Jour du Registre R4
: MAJR4 (caractère-20…)
FC AND \ and 11111100
4 / \ Divisé par 4 = 2 rotations droite
8 + \ OR 1000
R4 REG! ; \ Dans R4
\ LOOP d écriture des 10 tranches
: LOOP-OCT (a10,,,a1…..)
A 0 DO \ Equival : For I = 0 to 10décimal
R1 REG! \Chaque tranche dans R1
OCT! \ Commande écriture OCT
R5 REG@ 4 + R5 REG! \ R5 = R5 + 4
LOOP ; \ NEXT I
\\ LA COMMANDE SETET
\ Lors de la creation du mot (couloir, enbut etc) éxécution de ce qui est entre <BUILDS et DOES>
\ Lors de l’éxécution du mot (couloir, enbut etc) DOES> donne l’adresse des paramètres et exécute ce qui le suit
: SETET ( a10,,a0, caractère, couleur1, couleur2……)
<BUILDS \ s’exécute lors de la création du mot
10 * + C, \ Rotation gauche de la couleur 2, ajoute couleur1 et immerge dans les
\ paramètres
81 C, \ Immerge parametre R2 – Voir page 126
DUP C, \ Duplique Caractère, en immerge un et garde l’autre
MAJR5 MAJR4 LOOP-OCT \ Mise à jour de R5 et R4 et écrit les 10 tranches
DOES> \ Avec l’appel du mot, DOES> donne la première adresse de parametres et
\ execute ce qui suit
DUP C@ \ Duplique adresse pour ne pas la perdre et lit le premier paramètre (couleur
\ 1 et 2)
R3 REG! \ Dans R3
DUP 1+ C@ \ Duplique et lit le second parametre (Attribut 81)
R2 REG! \ dans R2
2 + C@ \ Lit le 3° parametre (Code du caractère)
R1 REG! \ dans R1
KRF! ; \ Exécute l’impression écran de ce caractère
\ Définition des caractères programmables(10 tranches+code caractère)
: CAR20 0 0 0 0 0 0 0 0 0 0 20 ;
: CAR21 81 42 42 24 18 18 24 42 42 81 21 ;
: CAR26 FF 81 BD BD BD BD BD BD 81 FF 26 ;
: CAR24 0 7E 2 4 8 10 20 40 7E 0 24 ;
: CAR25 81 42 42 24 18 18 24 42 42 81 25 ;
: CAR22 18 3C 7E E7 FF FF 5A 3C 18 0 22 ;
: CAR23 81 42 42 24 18 18 24 42 42 81 23 ;
CAR20 NOIR BLANC SETET COULOIR
CAR21 NOIR ROUGE SETET ENBUT
CAR26 NOIR BLEU SETET MUR
CAR24 JAUNE ROUGE SETET CAISSE
CAR25 JAUNE ROUGE SETET C+E
CAR22 NOIR BLANC SETET SOKO
CAR23 BLANC ROUGE SETET S+E
\ Parties 1 et 2 du mot SOKOBAN en caractère Graphique
: TXTSOKO ." nss@hWC}ju^A~CkTs{Dbs{T~CkT" ;
: TXTSOKO2 ." lpzEJup_jWmPopzEpzEopzE@jU" ;
\Imprime le texte SOKOBAN
: TEXTGR
CLS \ efface écran
G10 \Jeu de caractères G10
CR \ à la ligne
1 5 AT \Impression adresse 1 - 5
TXTSOKO \Première partie
2 5 AT \Impression adresse 2 - 5
TXTSOKO2 \ 2° Partie
CR CR \ deux lignes
G0 ; \ revient au jeu G0
\\\****** EDITEUR SOKOBAN******
\ CURSEUR ON ET OFF – Inverse les couleurs par le bit 7 de R3
: CURSEUR-ON
KRF@ \ lecture écran adresses R6 et R7
R3 REG@ \ lecture R3
80 + \ Bit 7 à 1
R3 REG! \ Dans R3
KRF! ; \ Re impression à l’écran
\ Idem mais bit 7 à 0
: CURSEUR-OFF KRF@ R3 REG@ 80 - R3 REG! KRF! ;
\ Change l’adresse écran par modification de R6 ou R7
: UP
R6 REG@ \ lire R6
1 – \ moins 1
0E MAX \Prendre le maximum entre R6-1 et 0E (borne supérieure)
R6 REG! ; \ Remettre dans R6
: DOWN R6 REG@ 1+ 1E MIN R6 REG! ;
: LEFT R7 REG@ 1 - 1 MAX R7 REG! ;
: RIGHT R7 REG@ 1+ 18 MIN R7 REG! ;
\Interprète le mouvement selon la touche
: MOUVEMENT (Touche… touche)
DUP 9 = IF \ Duplique pour ne pas perdre , = 9 ?
UP \ Si oui UP
ELSE \ sinon
DUP A = IF \ =A ?
DOWN \ si oui DOWN
ELSE DUP 8 = IF LEFT ELSE DUP 7 = IF RIGHT \ etc….
THEN THEN THEN THEN ; \ 4 fois ENDIF
\ Impression du caractère choisi
: DESSINE (car….car)
DUP 46 = IF COULOIR \ Si touche F alors COULOIR
ELSE DUP 45 = IF ENBUT \ Sinon si touche E alors embut
\ Etc…
ELSE DUP 43 = IF CAISSE
ELSE DUP 4F = IF C+E
ELSE DUP 53 = IF SOKO
ELSE DUP 5A = IF S+E
ELSE DUP 4d = IF MUR
THEN THEN THEN THEN THEN THEN THEN ; \7 fois ENDIF
\Variables Niveau et Début Buffer Niveaux enregistrés
1 VARIABLE NIVEAU#
7800 VARIABLE INITBUF
\ Imprime la valeur du niveau
: .NIVEAU#
5 1 AT ." NIVEAU "
NIVEAU# @ . BL ; \Lecture valeur niveau et impression
\Met toutes les colonnes dans le Buffer Niveaux
: INBUF-COL ( adresse-buffer….adresse-buffer)
19 01 DO \for I = 1 TO 19
I R7 REG! \ I dans R7
KRF@ \Lecture écran
R1 REG@ \ lire caractère dans R1
OVER \sous tirer adresse buffer
I + \ Adresse Buffer + I
C! \ Caractère dans BUFFER
LOOP ; \ NEXT I
\ Met tout l'écran dans le Buffer Niveaux
: INBUF-LIG (adresse-buffer...adresse-buffer)
1E 0E DO \for I = 0E TO 1E
I R6 REG! \ I dans R6
INBUF-COL \ Mettre toutes les colonnes dans le buffer
18 + \ Adresse BUFFER=BUFFER+18
LOOP ; \ NEXT
\ De l’écran vers le BUFFER
: SCR>BUF
INITBUFF @ \ adresse début BUFFER
187 NIVEAU# @ 1 - * \ (N° du Niveau-1)*187
+ \ Ajouter à l’adresse du Buffer
INBUF-LIG \ Mettre l’écran dans le buffer
DROP ; \ Rejeter l’adresse BUFFER
\Redéfinitions pour rendre les commande plus courtes….
: KR COUL-CAR ;
: JKR JAUNE KR ; \ Prochain caractère jaune etc…
: RKR ROUGE KR ;
: BKR BLANC KR ;
: BEKR BLEU KR ;
\IMPRESSION AIDE -
: .AIDE JKR TEXTGR BEKR 4 1 AT ." EDITEUR DE NIVEAU" 4 19 AT RKR ." FLECHES" RKR 6 19 AT ." S " BKR ." SOKOBAN" 7 19 AT RKR ." Z " BKR ." SOKO+EN-BUT" RKR 8 19 AT ." C " BKR ." CAISSE" 9 19 AT RKR ." O " BKR ." CAI.+EN-BUT" A 19 AT RKR ." E " BKR ." EN-BUT" B 19 AT RKR ." M " BKR ." MUR" C 19 AT RKR ." F " BKR ." FOND"D 19 AT RKR ." L " BKR ." CLS NIVEAU" F 19 AT RKR ." N " BKR ." NIV+1" 10 19 AT RKR ." P " BKR ." NIV-1" 11 19 AT RKR ." V " BKR ." SAUVEGARDE" 12 19 AT RKR ." Q " BKR ." QUITTER" 16 1 AT JKR ." PAR FORTHRETRO.NEW.FR (C) 2010" RKR .NIVEAU# BKR ;
\Interprétation des touches clavier
: CLAVIER-ED
MOUVEMENT \ Vérifie mouvements
DESSINE \ Vérifie si caractère à imprimer
DUP 4c = IF CLS .AIDE \ Si touche L, faire CLS et imprimer l’aide
ELSE DUP 4E = IF 1 NIVEAU# +! .NIVEAU# \ Si touche N, NIVEAU=NIVEAU+1 et imprimer
ELSE DUP 50 = IF -1 NIVEAU# +! RKR .NIVEAU# \ Si touche P, NIVEAU=NIVEAU-1 et imprimer
ELSE DUP 56 = IF SCR>BUF \ Si touche V, sauvegarde
THEN THEN THEN THEN
DROP ; \ eliminer la touche
\Impression du niveau
: PRNIV ( car….)
DUP 21 = IF ENBUT \ Si caractère 21 alors ENBUT etc….
ELSE DUP 26 = IF MUR ELSE DUP 24 = IF CAISSE ELSE DUP 25 = IF C+E ELSE DUP 22 = IF SOKO
ELSE DUP 23 = IF S+E ELSE RIEN THEN THEN THEN THEN THEN THEN
DROP ; \Eliminer le caractère dupliqué
\Lire les colonnes
: LI-COL (Adresse-buffer…. Adresse-buffer)
19 1 DO \ FOR I = 1 TO 19
I R7 REG! \ R7 = I
DUP I + \ AdresseBuffer+I
C@ \ Lire le caractère
PRNIV \ L’imprimer
LOOP ; \ NEXT I
\ Lire toutes les lignes
: LI-LIG (AdresseBuffer….)
1E 0E DO \ FOR I = 0E TO 1E
I R6 REG! \ R6=I
LI-COL \ Lire les colonnes
18 + \ AdresseBuffer=AdresseBuffer+18
LOOP ; \ NEXT I
\ Du Buffer au SCREEN
: BUF>SCR
INITBUFF @ \ Début Buffer
187 NIVEAU# @ 1 - * \ (N° du Niveau-1)*187
+ \ Somme pour trouver adresse début dans le BUFFER
LI-LIG \ Lire le BUFFER
DROP ; \ Rejeter l’adresse
\Mode EDITION
: EDIT
CLS \ Clear Screen
.AIDE \ Afficher l’aide
BUF>SCR \ Transfert du Buffer
F R6 REG! F R7 REG! \ Positionner le curseur
BEGIN
CURSEUR-ON \ Curseur ON
KEY \ Attendre une touche clavier
CURSEUR-OFF \ Curseur OFF
DUP 51 = NOT WHILE \ Tant que la touche n’est pas ‘Q’
CLAVIER-ED \ Interpréter le clavier Edition
REPEAT \ Retour à BEGIN
DROP \ Rejeter la touche dupliquée
SCR>BUF ; \ Enregistrer le niveau
\\\\*****ENTREE MODE EDITION *****
: EDITION
CLS NOIR MARGE NOIR FOND JKR TEXTGR \ Impression texte SOKOBAN
BKR B 1 AT . » CHOISIR LE NIVEAU A CREER » \ Texte en blanc
#IN \ saisir valeur au clavier
NIVEAU# ! \ Dans la variable
.NIVEAU# \ Imprimer
SCR>BUF \ Transfert du Buffer vers le SCR
EDIT ; \ Aller à l’Editeur
\\\\\************** LE JEU SOKOBAN ******
\Variables position du SOKOBAN
0 VARIABLE SOKX
0 VARIABLE SOKY
\Met les coordonnées du SOKOBAN dans la PILE
: SOKXY
SOKX C@ \Lire X
SOKY C@ ; \Lire Y
\ Lit caractère position pointée par SOKOBAN
: SOKXY@ (...car) SOKXY POINT@ ;
\ Ecrit un caractère dans la position du SOKOBAN
: SOKOXY! (car...) SOKXY POINT! ;
\Variables DELTA, fonction de la direction du SOKO
0 VARIABLE DELTAY 0 VARIABLE DELTAX
\ Fait SOKO UP
: S-UP (…..)
-1 DELTAY ! \ -1 dans DELTAX
DELTAX 0SET ; \ 0 dans DELTAY
: S-DOWN (….) \ IDEM
1 DIRY ! DIRX 0SET ;
: S-RIGHT DIRY 0SET 1 DIRX ! ;
: S-LEFT DIRY 0SET -1 DIRX ! ;
\ Augmente de 1 la valeur contenue dans l'adresse
: INC (Adresse…..)
1 SWAP +! \ Ajouter 1 à la valeur contenu dans Adresse
;
\ Diminue de 1 la valeur contenue dans l'adresse
: DEC -1 SWAP +! ; \ Retrancher 1
\Variables
0 VARIABLE #CAISSE 0 VARIABLE #DEPLACEMENT 0 VARIABLE #POUSSEE
\ Dupliquer les coordonnées
: DDUP (a,b….a,b,a,b) OVER OVER ;
\lecture du caractère pointé par direction déplacement.
: N-SOK>@
SOKOXY \Coordonnées du SOKOBAN
>R \Sauvegarde provisoire Y
DELTAX @ + \ X=X=DELTAX
R> \Récupère Y
DELTAY @ + \Y=Y+DELTAY
POINT@ ; \Lire caractère nouvelle adresse
\ Efface le SOKO de sa position
: SOKO-OUT
SOKOXY \ coordonnées du SOKO
POINT@ \ Lire caractère
22 = IF COULOIR \ S’il y avait SOKO alors - > COULOIR
ELSE ENBUT \ Sinon il y avait SOKO+ENBUT donc - > En-but
THEN ; \ END IF
\ Remettre le SOKO dans sa position
: SOKO-IN
SOKOXY \ Coordonnées du SOKO
POINT@ \ Lire caractère
20 = IF SOKO \ Si couloir alors - > SOKO
ELSE S+E \ Sinon il y avait EN-BUT - > SOKO + En-But
THEN ; \ END IF
\Déplacement du SOKO
: DEPLACE
SOKOOUT \ Efface le SOKO de sa position
SOKOXY \ Coordonnées du SOKO
>R \ Sauvegarde provisoire Y
DELTAX @ + \ X=X+DELTAX
R> \ Récupère Y
DELTAY @ + \ Y=Y+DELTAY
DDUP \ Duplique coordonnées
SOKY ! SOKX ! \ Mise à jour coordonnées SOKO
POINT@ \ Lire caractère
21 = IF S+E \ Si En-But alors - > Soko+Enbut
ELSE SOKO \ Sinon c’est COULOIR - > SOKO
THEN \ END IF
#DEPLACEMENT INC ; \ Déplacement=Déplacement+1
\Vérifie si poussée de caisse possible et l'effectue
: POUSSEE (….)
SOKOOUT \ Efface SOKO de sa position
SOKO> \ Coordonnées du SOKO
DDUP \ Dupliquer
>R \ Sauvegarde Y
DELTAx @ DUP + + \ X=X+DeltaX+DeltaX (Lire à deux cases du SOKO)
R> \ Récupère Y
DELTAY @ DUP + + \ Y=Y+DeltaY+DeltaY
POINT@ \ Lire le carcactère
DUP 21 > IF \ Si ce n’est ni Couloir, ni Enbut
DROP DROP DROP \ Alors ne rien faire et vider la pile
SOKOIN \ Remettre le SOKOBAN
ELSE \ Sinon
21 = IF #caisse DEC C+E \ Si c’est En-but alors 1 caisse en moins à rentrer, afficher caisse+enbut
ELSE CAISSE \ Sinon afficher caisse seule
THEN \ End IF
>R \ Sauvegarde Y SOKO
DELTAX @ + \ X=X+DELTA
R> DIRY @ + \ Y=Y+DELTA
DDUP SOKY ! SOKX ! \ Dupliquer pour mise à jour nouvelles coordonnées SOKO
POINT@ \ Lire la case
25 = IF #CAISSE INC S+E \ Si Caisse+Enbut alors caisse=caisse+1 (elle sort de l’enbut) et Soko+Enbut
ELSE SOKO \ Sinon COULOIR - > En-But
THEN
#POUSSEE INC #MOUVEMENT INC \ +1 Caisse poussée, +1 mouvement
THEN ;
\ Interpréter le mouvement à faire, s'il est possible
: INTERPRETER (key….)
NSOK>@ \Lire le caractère après X+DELTAX, Y+DELTAY
DUP 26 = IF DROP \Si c’est un mur ne rien faire, vider la pile
ELSE DUP 23 > IF \ Sinon, si Caisse ou caisse+Enbut voir ‘POUSSEE’
DROP POUSSE
ELSE \Sinon
DROP DEPLACE \C’est un couloir ou un en-But, déplacer SOKO
THEN THEN ;
\ Interprétation touches clavier avec déplacement
: CLAVIER-JEU (key…..KEY)
DUP 9 = IF S-UP INTERPRETER \ Si touche 9 faire SOKO UP et interpréter
ELSE DUP A = IF S-DOWN INTERPRETER \ sinon, si touché A faire SOKO DOWN et interpréter. ETC
ELSE DUP 8 = IF S-LEFT INTERPRETER
ELSE DUP 7 = IF S-RIGHT INTERPRETER
THEN THEN THEN THEN ; \ 4 * ENDIF
\ Imprime les résultats
: .SCORE
4 23 AT #CAISSE @ .
5 23 AT #MOUVEMENT @ .
6 23 AT #POUSSEE @ . ;
\ Imprime l'aide
: .AIDE-JEU
CLS JKR TEST
BEKR 4 1 AT ." VERSION 1"
RKB 4 19 AT ." CAISSES ? “
5 19 AT .” MOUVEMENTS “
6 19 AT .” POUSSEES “
8 19 AT RKR ." FLECHES"
A 19 AT RKR ." L " BKR ." CLS NIVEAU"
B 19 AT RKR ." N " BKR ." NIV+1"
C 19 AT RKR ." P " BKR ." NIV-1"
D 19 AT RKR ." A " BKR ." NIV ?"
E 19 AT RKR ." R” BKR ." RECOMMENCER"
F 19 AT RKR ." Q " BKR ." QUITTER"
16 1 AT JKR ." PAR FORTHRETRO.NEW.FR (C) 2010" ;
\Scan d’une ligne pour compter caisse et coordonnées SOKO
: SC-COL
19 01 DO \ FOR I = 1 TO 19
I R7 REG! KRF@ R1 REG@ \ Lecture ecran
DUP 22 = IF R7 REG@ SOKY ! \ Si Caractère SOKO - > X SOKO = R7
R6 REG@ SOKX ! \ Y SOKO = R6
ELSE DUP 24 = IF #CAISSE INC \ Sinon, si caisse, faire Caisse=caisse+1
THEN THEN \ END IF
DROP LOOP ; \ Vider pile, NEXT
\ SCAN de toutes les lignes du jeu
: SCAN
1E 0E DO \FOR I=0E TO 1E
I R6 REG! \ R6=I
SC-COL \Lire la ligne
LOOP ; \NEXT
\Initialisation des variables
: DEBUT ( …….)
#MOUVEMENT 0SET \ Mise à Zero
#POUSSEE 0SET
#CAISSE 0SET
.AIDE-JEU \Impression AIDE
BUF>SCR \ Transfert du BUFFER dans le SCR
SCAN ; \ Faire le SCAN
\ Verifie si la touche demande changement de tableau
: TABLEAU?
DUP 4E = IF 1 NIVEAU# +! \ Si touche N - > NIVEAU=NIVEAU+1
ELSE DUP 50 = IF -1 NIVEAU# +! \ Sinon si touche P - > NIVEAU=NIVEAU-1
THEN THEN \EndIF
DEBUT ; \ Initialise paramètres
\ DEBUT DU JEU
: JOUER
NOIR MARGE NOIR FOND \ Ecran
CLS A 1 AT .” CHOISIR LE NIVEAU” #IN \ Attend une valeur
#NIVEAU ! \ Dans la variable
DEBUT \ Efface Ecran, initialise
BEGIN
.SCORE \ Imprimer score
KEY \ Attendre une touche
CLAVIER-JEU \ Interpréter
TABLEAU? \ Vérifier si touche changement tableau
#CAISSE @ 0= IF 6 9 AT .” TERMINE” \ si Nombre de caisse restante =0 - > Termine
THEN \ END IF
51 = UNTIL \ Jusqu’à la touche Q
7 9 AT .” QUITTER” ; \ Quitter
\\\\ RE ECRIRURE DES CARACTERES DANS LA MEMOIRE du EF
: ECRITURE MAJR5 MAJR4 LOOP-OCT ;
: ECRIT-MEM
CAR20 ECRITURE
CAR21 ECRITURE
CAR22 ECRITURE
CAR23 ECRITURE
CAR24 ECRITURE
CAR25 ECRITURE
CAR26 ECRITURE ;
\\\\ DEBUT DU SOKOBAN
: SOKOBAN
HEX \ Mode Hexadecimal
ECRIT-MEM \ Définition des caractères
DECIMAL
BEGIN
NOIR MARGE NOIR FOND CLS \ Ecran
JKR TEXTGR \ Imprimer Texte SOKOBAN
BKR A 9 AT . » EDITEUR SOKOBAN –«
RKR . » 1 » BKR
C 9 AT . » JOUER AU SOKOBAN –«
RKR . » 2 » BKR
E 9 AT . » RETOURNER AU BASIC –«
RKR . » 3 »
KEY \ Attendre la touche
DUP 31 = IF EDITION \ Si touche 1 - > editeur
ELSE DUP 32 = IF JOUER \ Si Touche 2 - > Jouer
THEN THEN \ END IF
33 = UNTIL BASIC ; \ Jusqu’à touche 3 et retour au BASIC
\\\\ ***FIN ***