( Jeux de DEMINEUR pour coeur FORTH. Version 1.50 du 7 Decembre 2008. Ecrit par jpb.forth . ) DECIMAL START 2@ CONSTANT DEBUT_DEMINEUR 0 VARIABLE F_DEM 0 VARIABLE ETAT_DEM 0 VARIABLE M_ETAT_DEM 0 VARIABLE DX_DEM 0 VARIABLE DY_DEM 0 VARIABLE CNT_DEM 0 VARIABLE TEMPS_DEM 0 VARIABLE NB_DEM 0 VARIABLE CACHE_DEM 0 VARIABLE INDEX_DEM 0 VARIABLE COUV_DEM 0 COUV_DEM 2! 0 VARIABLE LIGNE_DEM 0 VARIABLE ADR_CLV_DEM 0 VARIABLE PRE_DEM 0 VARIABLE SX_DEM 0 VARIABLE SY_DEM 0 VARIABLE ACTION_DEM 0 VARIABLE TETE_DEM 0 VARIABLE TEMPO_DEM HERE 40 40 2 */ ALLOT CONSTANT ECRAN_DEM HERE 3 5+ ALLOT CONSTANT SCORES FEN_STRING" S_DESCRIPTIF DEMINEUR FORTH Version 1.50 du 07/12/2008 http://jpb.forth.free.fr/ jpb_forth@yahoogroups.com Que le FORTH soit avec TOI! " FORTH MINESWEEPER Version 1.50 in 12/07/2008 http://jpb.forth.free.fr/ jpb_forth@yahoogroups.com May the FORTH be with you! " FEN_STRING" S_TITRE DEMINEUR" MINESWEEPER" FEN_STRING" S_MENU NOUVEAU JEU....ESC G NOUVEAU FORMAT.ESC T SCORES.........ESC S FERMER.........ESC F MENU...........ESC N" NEW GAME.ESC G NEW SIZE.ESC T SCORES...ESC S CLOSE....ESC F MENU.....ESC N" FEN_STRING" S_JEU DEBUTANT INTERMEDIAIRE EXPERT PERSONNALISE" BEGINNING INTERMEDIATE EXPERT PERSONALIZED" FEN_STRING" S_LARGEUR Largeur :" Width :" FEN_STRING" S_HAUTEUR Hauteur :" Heigth :" FEN_STRING" S_NB_MINE Nombre de mines :" Number of mines :" FEN_STRING" S_SCORES Meilleurs TEMPS 999 s DEBUTANT 999 s INTERMEDIAIRE 999 s EXPERT 999 s PERSONNALISE" BETTER TIMES 999 s BEGINNING 999 s INTERMEDIATE 999 s EXPERT 999 s PERSONALIZED" FEN_STRING" S_MEILLEUR FELICITATIONS! Vous avez obtenu le meilleur temps." CONGRATULATIONS! You obtained best time." " APPLICATIONS/JEUX/demineur.scr" STRING S_FIC_SCORES S_FIC_SCORES COUNT CHEMIN_CONCATENE ?DUP [IF] : LNG ( adr --> adr,lng ) 0 BEGIN OVER OVER + C@ 4 < IF -1 ELSE 1+ 0 THEN UNTIL ; LNG FORGET LNG HERE OVER 2+ 2/ ALLOT OVER OVER C! 3 PICK OVER 1+ 4 ROLL CMOVE CONSTANT S_FIC_SCORES MEMOIRE_LIBERE DROP [THEN] BIN HERE 0000000000000000 , ( 0 ) 0000011111100000 , 0000101111010000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000000000010000 , 0000100000000000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000101111010000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 1 ) 0000000000000000 , 0000000000010000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000010000 , 0000000000000000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000010000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , ( 2 ) 0000011111100000 , 0000001111010000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000011111010000 , 0000101111100000 , 0000110000000000 , 0000110000000000 , 0000110000000000 , 0000110000000000 , 0000101111000000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 3 ) 0000011111100000 , 0000001111010000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000011111010000 , 0000001111100000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000001111010000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 4 ) 0000000000000000 , 0000100000010000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000011111010000 , 0000001111100000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000010000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , ( 5 ) 0000011111100000 , 0000101111000000 , 0000110000000000 , 0000110000000000 , 0000110000000000 , 0000110000000000 , 0000011111000000 , 0000001111100000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000001111010000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 6 ) 0000011111100000 , 0000101111000000 , 0000110000000000 , 0000110000000000 , 0000110000000000 , 0000110000000000 , 0000011111000000 , 0000101111100000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000101111010000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 7 ) 0000011111100000 , 0000101111010000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000000000010000 , 0000000000000000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000010000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , ( 8 ) 0000011111100000 , 0000101111010000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000011111010000 , 0000101111100000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000101111010000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 9 ) 0000011111100000 , 0000101111010000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000110000110000 , 0000011111010000 , 0000001111100000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000001111010000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 10 ) 0000000001000000 , 0000000100010000 , 0000000001000000 , 0000001011101000 , 0000000001000000 , 0000000010100000 , 0000000100010000 , 0000001011001000 , 0000010110000100 , 0000010100000100 , 0000010000000100 , 0000001000001000 , 0000000100010000 , 0000000011100000 , 0000000000000000 , 0000000001000000 , ( 11 ) 0000000110110000 , 0000001011101000 , 0000001110111000 , 0000010100010100 , 0000001010101000 , 0000000001000000 , 0000000011100000 , 0000000100110000 , 0000001001111000 , 0000001011111000 , 0000001111111000 , 0000000111110000 , 0000000011100000 , 0000000000000000 , 0000000000000000 , 0000001111000000 , ( 12 ) 0000111111110000 , 0001111111111000 , 0011111111111100 , 0111111111111110 , 0111111111111110 , 1111111111111111 , 1111111111111111 , 1111111111111111 , 1111111111111111 , 0111111111111110 , 0111111111111110 , 0011111111111100 , 0001111111111000 , 0000111111110000 , 0000001111000000 , 0000000000000000 , ( 13 ) 0000000000000000 , 0000000000000000 , 0000110000110000 , 0001001001001000 , 0001001001001000 , 0000110000110000 , 0000000000000000 , 0000000110000000 , 0000000000000000 , 0001000000001000 , 0000110000110000 , 0000001111000000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , ( 14 ) 0000000000000000 , 0000000000000000 , 0000010000100000 , 0000101001010000 , 0001001001001000 , 0000110000110000 , 0000000000000000 , 0000000110000000 , 0000000000000000 , 0000011111100000 , 0000100000010000 , 0000100110010000 , 0000011001100000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , ( 15 ) 0000000000000000 , 0000000000000000 , 0000000000000000 , 0000100000010000 , 0011111001111100 , 0000100000010000 , 0000000000000000 , 0000000110000000 , 0000000000000000 , 0000000000000000 , 0000010110100000 , 0000101001010000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , ( 16 ) 0000000000000000 , 0001110000111000 , 0011011001101100 , 0110111111011110 , 0011111001111100 , 0011111001111100 , 0001110000111000 , 0000000110000000 , 0000000000000000 , 0001000000001000 , 0000111111110000 , 0000010000100000 , 0000001111000000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , ( 17 ) 0000000110000000 , 0000001110000000 , 0000011110000000 , 0000110110000000 , 0000000110000000 , 0000000110000000 , 0000000110000000 , 0000000110000000 , 0000000110000000 , 0000000110000000 , 0000000110000000 , 0000000110000000 , 0000000110000000 , 0000111111110000 , 0000000000000000 , 0000000000000000 , ( 18 ) 0000011111100000 , 0001110000111000 , 0011000000001100 , 0011000000001100 , 0000000000001100 , 0000000000011000 , 0000000000110000 , 0000000011000000 , 0000001100000000 , 0000110000000000 , 0001100000000000 , 0011000000000000 , 0011000000000000 , 0011111111111100 , 0000000000000000 , 0000000000000000 , ( 19 ) 0000011111100000 , 0001110000111000 , 0011000000001100 , 0000000000001100 , 0000000000001100 , 0000000000011000 , 0000001111110000 , 0000000000011000 , 0000000000001100 , 0000000000001100 , 0000000000001100 , 0011000000001100 , 0001110000111000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 20 ) 0000000000110000 , 0000000001110000 , 0000000011110000 , 0000000110110000 , 0000001100110000 , 0000011000110000 , 0000110000110000 , 0001100000110000 , 0011000000110000 , 0011111111111100 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000000000000 , 0000000000000000 , ( 21 ) 0000111111111100 , 0000110000000000 , 0001100000000000 , 0001100000000000 , 0011000000000000 , 0011000000000000 , 0011111111100000 , 0000000000111000 , 0000000000001100 , 0000000000001100 , 0000000000001100 , 0011000000001100 , 0001110000111000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 22 ) 0000011111100000 , 0001110000111000 , 0011000000001100 , 0011000000000000 , 0011000000000000 , 0011000000000000 , 0011011111100000 , 0011110000111000 , 0011000000001100 , 0011000000001100 , 0011000000001100 , 0011000000001100 , 0001110000111000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 23 ) 0011111111111100 , 0011000000001100 , 0011000000001100 , 0000000000011000 , 0000000000011000 , 0000000000110000 , 0000000000110000 , 0000000001100000 , 0000000001100000 , 0000000011000000 , 0000000011000000 , 0000000110000000 , 0000000110000000 , 0000000110000000 , 0000000000000000 , 0000000000000000 , ( 24 ) 0000011111100000 , 0001110000111000 , 0011000000001100 , 0011000000001100 , 0011000000001100 , 0001110000111000 , 0000011111100000 , 0001110000111000 , 0011000000001100 , 0011000000001100 , 0011000000001100 , 0011000000001100 , 0001110000111000 , 0000011111100000 , 0000000000000000 , 0000000000000000 , ( 25 ) 0010001111000100 , 0110111111110110 , 0001111111111000 , 0011100111111100 , 0011000011111100 , 0111000011111110 , 0111100111111110 , 0111111111111110 , 0111111111111110 , 0011111111111100 , 0011111111111100 , 0001111111111000 , 0110111111110110 , 0010001111000100 , 0000000000000000 , 0000000000000000 , ( 26 ) 0000000000000000 , 0001000000000000 , 0001100000000000 , 0001111000000000 , 0001111110000000 , 0000111111100000 , 0000111111111000 , 0000111111000000 , 0000111000000000 , 0000010000000000 , 0000010000000000 , 0000010000000000 , 0000010000000000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , ( 27 ) 0000000000000000 , 0000000000001100 , 0000000000011100 , 0000000000111000 , 0000000001110000 , 0000000011100000 , 0000000111000000 , 0000001110000000 , 0000011100000000 , 0000111000000000 , 0001110000000000 , 0011100000000000 , 0011000000000000 , 0000000000000000 , 0000000000000000 , 0000000000000000 , ( 28 ) 0000000000000000 , 0000000000000000 , 0000000000110000 , 0000000000110000 , 0000000000110000 , 0000000110110000 , 0000010110110000 , 0000110110110100 , 0010111111110110 , 0011111111110110 , 0011111111111110 , 0011111111111110 , 0001111111111100 , 0000111111111000 , 0000000000000000 , 0000000000000000 , ( 29 ) 0000000000000000 , 0000000000110000 , 0000000001001000 , 0000000001001000 , 0000000111001000 , 0000011001001000 , 0000101001001100 , 0011001001001010 , 0101000000001001 , 0100000000001001 , 0100000000000001 , 0100000000000001 , 0010000000000010 , 0001000000000100 , 0000111111111000 , CONSTANT SYMBOLES_SOURIS DECIMAL ( Code d'une case du demineur: - bit 7: 1 pour case couverte - bit 6: 1 pour presence mine - bit 5: 1 pour fanion - bit 4: 1 pour case modifiee a raffraichir - bits 3..0: nombre de mines autour ) : AF_CAR_DEM ( ligne,fen --> - ) DX_DEM @ 0 DO OVER DX_DEM @ * ECRAN_DEM + I + C@ DUP 0< IF DUP 64 AND ETAT_DEM @ 3 = AND IF 252 I 20 * 3+ 5 PICK 20 * 23+ OVER 19+ OVER 19+ 7 PICK FEN_TRACE_REC 16 DUP 0 I 20 * 5+ 7 PICK 20 * 25+ [ SYMBOLES_SOURIS 25 5 LSH + LITERAL ] 8 PICK FEN_TRACE_MOTIF DROP DROP DROP DROP DROP ELSE COUV_DEM 2@ DUP 0= IF DUP DUP 95 127 160 255 DUP DUP 3 20 20 -1 DEGRADE_\ DUP COUV_DEM 2! THEN ?DUP IF I 20 * 3+ 5 PICK 20 * 23+ 5 PICK FEN_ECRIT_REC ELSE 170 I 20 * 3+ 5 PICK 20 * 23+ OVER 19+ OVER 19+ 7 PICK FEN_TRACE_REC THEN DUP 32 AND IF 16 DUP 195 I 20 * 5+ 7 PICK 20 * 25+ [ SYMBOLES_SOURIS 26 5 LSH + LITERAL ] 8 PICK FEN_TRACE_MOTIF 6 PICK 64 AND NOT ETAT_DEM @ 2- AND IF >R >R DROP 0 R> R> [ SYMBOLES_SOURIS 27 5 LSH + LITERAL ] 8 PICK FEN_TRACE_MOTIF THEN DROP DROP DROP DROP DROP THEN THEN ELSE DUP 64 AND IF 195 ELSE 252 THEN I 20 * 3+ 5 PICK 20 * 23+ OVER 19+ OVER 19+ 7 PICK FEN_TRACE_REC 16 DUP 0 I 20 * 5+ 7 PICK 20 * 25+ 6 PICK 64 AND IF [ SYMBOLES_SOURIS 25 5 LSH + LITERAL ] 8 PICK FEN_TRACE_MOTIF ELSE 6 PICK 15 AND ?DUP IF CASE 1 OF 10 [ SYMBOLES_SOURIS 17 5 LSH + LITERAL ] ENDOF 2 OF 34 [ SYMBOLES_SOURIS 18 5 LSH + LITERAL ] ENDOF 3 OF 42 [ SYMBOLES_SOURIS 19 5 LSH + LITERAL ] ENDOF 4 OF 130 [ SYMBOLES_SOURIS 20 5 LSH + LITERAL ] ENDOF 5 OF 138 [ SYMBOLES_SOURIS 21 5 LSH + LITERAL ] ENDOF 6 OF 162 [ SYMBOLES_SOURIS 22 5 LSH + LITERAL ] ENDOF 7 OF 170 [ SYMBOLES_SOURIS 23 5 LSH + LITERAL ] ENDOF 0 [ SYMBOLES_SOURIS 24 5 LSH + LITERAL ] ENDCASE >R >R ROT DROP R> ROT ROT R> 8 PICK FEN_TRACE_MOTIF THEN THEN DROP DROP DROP DROP DROP THEN DROP LOOP DROP DROP ; : INIT_DEM 0 CNT_DEM ! TEMPS 2@ TEMPS_DEM 2! ECRAN_DEM SCORES 6+ @ CASE 1 OF 8 8 10 ENDOF 2 OF 16 16 40 ENDOF 3 OF 30 16 99 ENDOF SCORES 8+ DUP >R @ R@ 2+ @ R> 4+ @ ENDCASE DUP >R NB_DEM ! DUP DY_DEM ! OVER DX_DEM ! * 128 FILL R> BEGIN NPA ABS DX_DEM @ DY_DEM @ * MOD ECRAN_DEM + DUP C@ DUP 64 AND IF DROP DROP ELSE 64 OR SWAP C! 1- THEN DUP 0> NOT UNTIL DROP DY_DEM @ 0 DO DX_DEM @ 0 DO I J DX_DEM @ * + ECRAN_DEM + C@ 64 AND IF I 0> J 0> AND IF I 1- J 1- DX_DEM @ * + ECRAN_DEM + DUP C@ 1+ SWAP C! THEN J 0> IF I J 1- DX_DEM @ * + ECRAN_DEM + DUP C@ 1+ SWAP C! THEN I DX_DEM @ 1- < J 0> AND IF I 1+ J 1- DX_DEM @ * + ECRAN_DEM + DUP C@ 1+ SWAP C! THEN I 0> IF I 1- J DX_DEM @ * + ECRAN_DEM + DUP C@ 1+ SWAP C! THEN I DX_DEM @ 1- < IF I 1+ J DX_DEM @ * + ECRAN_DEM + DUP C@ 1+ SWAP C! THEN I 0> J DY_DEM @ 1- < AND IF I 1- J 1+ DX_DEM @ * + ECRAN_DEM + DUP C@ 1+ SWAP C! THEN J DY_DEM @ 1- < IF I J 1+ DX_DEM @ * + ECRAN_DEM + DUP C@ 1+ SWAP C! THEN I DX_DEM @ 1- < J DY_DEM @ 1- < AND IF I 1+ J 1+ DX_DEM @ * + ECRAN_DEM + DUP C@ 1+ SWAP C! THEN THEN LOOP LOOP DX_DEM @ DY_DEM @ * NB_DEM @ - CACHE_DEM ! 0 TETE_DEM ! ; : SP_AF_CNT_DEM ( fen --> - ) >R 16 DUP 65 R@ FEN_TAILLE_? DROP 44- 4 [ SYMBOLES_SOURIS 8 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF >R >R DROP 195 R> R> SYMBOLES_SOURIS CNT_DEM @ 100 /MOD SWAP DROP 5 LSH + R@ FEN_TRACE_MOTIF >R >R DROP 65 R> 13+ R> [ SYMBOLES_SOURIS 8 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF >R >R DROP 195 R> R> SYMBOLES_SOURIS CNT_DEM @ 100 /MOD DROP 10 /MOD SWAP DROP 5 LSH + R@ FEN_TRACE_MOTIF >R >R DROP 65 R> 13+ R> [ SYMBOLES_SOURIS 8 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF >R >R DROP 195 R> R> SYMBOLES_SOURIS CNT_DEM @ 10 /MOD DROP 5 LSH + R> FEN_TRACE_MOTIF DROP DROP DROP DROP DROP ; FEN: AF_ANIMATION DUP >R FEN_TAILLE_? DUP 64 < IF 16 DUP 242 5 PICK 16- 2/ 5 PICK 16- 2/ [ SYMBOLES_SOURIS 12 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF >R >R DROP 0 R> R> SYMBOLES_SOURIS INDEX_DEM @ 3 AND 13+ 5 LSH + R@ FEN_TRACE_MOTIF DROP DROP DROP DROP DROP ELSE R@ SP_AF_CNT_DEM LIGNE_DEM @ ?DUP IF 1- R@ AF_CAR_DEM ELSE COUV_DEM 2@ ?DUP IF MEMOIRE_LIBERE DROP 0 COUV_DEM 2! THEN THEN THEN DROP DROP R> DROP ; : SP_AF_NB_DEM ( fen --> - ) >R 16 DUP 65 1 4 [ SYMBOLES_SOURIS 8 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF >R >R DROP 195 R> R> SYMBOLES_SOURIS NB_DEM @ 100 /MOD SWAP DROP 5 LSH + R@ FEN_TRACE_MOTIF >R >R DROP 65 R> 13+ R> [ SYMBOLES_SOURIS 8 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF >R >R DROP 195 R> R> SYMBOLES_SOURIS NB_DEM @ 100 /MOD DROP 10 /MOD SWAP DROP 5 LSH + R@ FEN_TRACE_MOTIF >R >R DROP 65 R> 13+ R> [ SYMBOLES_SOURIS 8 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF >R >R DROP 195 R> R> SYMBOLES_SOURIS NB_DEM @ 10 /MOD DROP 5 LSH + R> FEN_TRACE_MOTIF DROP DROP DROP DROP DROP ; : SP_AF_TETE ( fen --> - ) >R 16 DUP 242 R@ FEN_TAILLE_? DROP 16- 2/ 4 [ SYMBOLES_SOURIS 12 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF >R >R DROP 0 R> R> [ SYMBOLES_SOURIS 13 5 LSH + LITERAL ] TETE_DEM @ 3 AND 5 LSH + R@ FEN_TRACE_MOTIF >R DROP DROP 65 1 R> [ SYMBOLES_SOURIS 8 5 LSH + LITERAL ] R> FEN_TRACE_MOTIF DROP DROP DROP DROP DROP ; FEN: AFFICHE_DEM >R FEN_TEINTES_? DROP DROP DROP DROP >R DROP R> R@ FEN_TAILLE_? 3 PICK 0 0 16383 1 R@ FEN_TRACE_REC 3 PICK 0 2 1 5 PICK 3- R@ FEN_TRACE_REC 170 2 2 5 PICK 3- 2 R@ FEN_TRACE_REC 170 2 3 2 5 PICK 4- R@ FEN_TRACE_REC 64 3 3 41 20 R@ FEN_TRACE_REC R@ SP_AF_NB_DEM 170 42 3 5 PICK 43- 20 R@ FEN_TRACE_REC R@ SP_AF_TETE 64 3 PICK 42- 3 OVER 39+ 20 R@ FEN_TRACE_REC R@ SP_AF_CNT_DEM 170 3 21 5 PICK 4- 22 R@ FEN_TRACE_REC DY_DEM @ DX_DEM @ * ECRAN_DEM DUP >R + R> DO I C@ 16 OR I C! DX_DEM @ +LOOP 170 3 PICK 3- 3 OVER 5 PICK 4- R@ FEN_TRACE_REC 3 PICK 3 PICK 2- 2 16383 5 PICK 2- R@ FEN_TRACE_REC 170 2 3 PICK 3- 5 PICK 3- OVER R@ FEN_TRACE_REC 3 PICK 0 3 PICK 2- 16383 DUP R@ FEN_TRACE_REC DROP DROP DROP R> DROP ; FEN: ICONE_DEM >R FEN_TEINTES_? DROP DROP DROP DROP >R DROP R> R@ FEN_TAILLE_? >R 22- 2/ R> 22- 2/ OVER 21+ OVER 21+ R@ FEN_TRACE_REC 170 R@ FEN_TAILLE_? >R 18- 2/ R> 18- 2/ OVER 17+ OVER 17+ R@ FEN_TRACE_REC R> AF_ANIMATION EXECUTE ; FEN: FERME_DEM >R ICONE_DEM R> FEN_ICONE ; FEN: A_PROPOS_DEM >R S_DESCRIPTIF R> FEN_DIALOGUE_MESSAGE ; : DECOUVRE_DEM DX_DEM @ ECRAN_DEM BEGIN CACHE_DEM @ >R DY_DEM @ 0 DO OVER 0 DO OVER J * OVER + I + C@ -17 AND 0= IF OVER J 2+ DY_DEM @ MIN * 3 PICK J 1- 0 MAX * DO OVER J 2+ MIN J 1- 0 MAX DO DUP J + I + DUP C@ DUP 160 AND 128- IF DROP DROP ELSE 127 AND SWAP C! DUP J + DUP >R C@ 16 OR R> C! 1 CACHE_DEM -! THEN LOOP OVER +LOOP THEN LOOP LOOP CACHE_DEM @ R> = UNTIL DROP DROP ; FEN: CHRONO_DEM DUP >R FEN_TAILLE_? DROP 64 < IF 1 INDEX_DEM +! TEMPS 2@ CNT_DEM @ 1000 * - TEMPS_DEM 2! 499 ELSE ETAT_DEM @ 2 = IF TEMPS 2@ TEMPS_DEM 2@ - 1000 /MOD SWAP DROP DUP CNT_DEM @ - IF 999 MIN DUP CNT_DEM ! 999 = IF 3 ETAT_DEM ! R@ FEN_SELECTIONNE THEN ELSE DROP THEN THEN 0 DY_DEM @ 0 DO ECRAN_DEM I DX_DEM @ * + DUP C@ 16 AND IF >R 16 R> -C! DROP I 1+ LEAVE ELSE DROP THEN LOOP DUP LIGNE_DEM ! IF 1 ELSE 99 THEN THEN AF_ANIMATION CHRONO_DEM R> FEN_CHRONO ; FEN: MENU_DEM BEGIN 6 S_MENU 0 4 PICK FEN_DIALOGUE_CHOIX CASE 1 OF 7 ENDOF 2 OF 20 ENDOF 3 OF 19 ENDOF 4 OF 6 ENDOF 5 OF 0 ENDOF -1 ENDCASE DUP 0> IF DUP 3 PICK ADR_CLV_DEM 2@ EXECUTE THEN UNTIL DROP ; FEN: CLV_DEM >R DUP 27 = IF PRE_DEM OVER OVER @ = IF 0 SWAP ! DROP ELSE ! THEN 0 ELSE PRE_DEM DUP @ 27 = IF 0 SWAP ! 31 AND ELSE DROP THEN THEN DUP 6 = IF DROP R@ FERME_DEM EXECUTE 0 THEN DUP 7 = IF DROP INIT_DEM 2 ETAT_DEM ! R@ AFFICHE_DEM EXECUTE 0 THEN DUP 14 = IF DROP R@ MENU_DEM EXECUTE 0 THEN DUP 19 = IF DROP S_SCORES DUP 1+ 4 0 DO BEGIN DUP 1+ SWAP C@ 32 U< UNTIL SCORES I 3 < IF I 2* ELSE 14 THEN + @ DUP >R 99 > IF R@ 100 /MOD 48+ >R DROP R> ELSE 32 THEN OVER C! 1+ R@ 9 > IF R@ 100 MOD 10 /MOD 48+ >R DROP R> ELSE 32 THEN OVER C! 1+ R> 10 MOD 48+ OVER C! 1+ LOOP DROP OVER FEN_DIALOGUE_MESSAGE 0 THEN DUP 20 = IF DROP 5 S_JEU 0 R@ FEN_DIALOGUE_CHOIX DUP 0> OVER 5 < AND IF DUP 4 < IF SCORES 6+ ! ELSE DROP 0 DUP SCORES 6+ DUP >R ! R> 2+ DUP @ DUP 10 S_LARGEUR R@ FEN_DIALOGUE_NOMBRE 8 MAX 40 MIN SWAP OVER - IF OVER ! >R -1 OR R> ELSE DROP THEN 2+ DUP @ DUP 10 S_HAUTEUR R@ FEN_DIALOGUE_NOMBRE 8 MAX 40 MIN SWAP OVER - IF OVER ! >R -1 OR R> ELSE DROP THEN 2+ DUP @ DUP 10 S_NB_MINE R@ FEN_DIALOGUE_NOMBRE 1 MAX 999 MIN SWAP OVER - IF OVER ! >R -1 OR R> ELSE DROP THEN 2+ SWAP IF 999 SWAP ! ELSE DROP THEN THEN S_FIC_SCORES 1+ 0 FOPEN 0< NOT IF SCORES 16 3 PICK FWRITE DROP THEN FCLOSE DROP INIT_DEM 2 ETAT_DEM ! R@ FEN_POSITION_? >R 0 MAX R> 0 MAX R@ FEN_POSITION DX_DEM @ 20 * 6+ DY_DEM @ 1+ 20 * 6+ R@ FEN_TAILLE ELSE DROP THEN 0 THEN IF BELL THEN R> DROP ; CLV_DEM ADR_CLV_DEM 2! FEN: SOURIS_DEM >R OVER OVER OR IF SX_DEM @ SY_DEM @ OVER 0< OVER 0< OR IF ACTION_DEM @ 1+ 0= IF 7 R@ CLV_DEM EXECUTE 1 ACTION_DEM -! THEN ELSE ACTION_DEM @ 1+ ?DUP IF 1+ 0= IF TEMPS 2@ TEMPO_DEM 2@ - 333 > IF DUP DX_DEM @ * ECRAN_DEM + DUP 4 PICK + DUP >R C@ DUP 32 AND IF DROP R> DROP DROP ELSE 32+ R> C! DUP >R C@ 16 OR R> C! 1 NB_DEM -! R@ SP_AF_NB_DEM THEN 0 TETE_DEM ! R@ SP_AF_TETE 1 ACTION_DEM -! DROP DROP -1 DUP THEN THEN ELSE 1 TETE_DEM ! R@ SP_AF_TETE TEMPS 2@ TEMPO_DEM 2! 1 ACTION_DEM -! THEN THEN SY_DEM ! SX_DEM ! ELSE ACTION_DEM @ -2 = IF SX_DEM @ SY_DEM @ OVER 0< OVER 0< OR NOT IF DUP DX_DEM @ * ECRAN_DEM + DUP 4 PICK + DUP C@ DUP 32 AND IF 223 AND SWAP C! 1 NB_DEM +! R@ SP_AF_NB_DEM ELSE 111 AND DUP ROT C! DUP 64 AND IF DROP 3 ETAT_DEM ! R@ AFFICHE_DEM EXECUTE ELSE 1 CACHE_DEM -! 0= IF DECOUVRE_DEM THEN CACHE_DEM @ 0= IF 0 NB_DEM ! 4 ETAT_DEM ! DX_DEM @ DY_DEM @ * ECRAN_DEM DUP >R + R> DO I DX_DEM @ + I DO I C@ DUP 64 AND IF 32 OR I C! J C@ 16 OR J C! ELSE DROP THEN LOOP DX_DEM @ +LOOP 0 SCORES 6+ @ CASE 1 OF CNT_DEM @ SCORES @ < IF CNT_DEM @ SCORES ! 1- THEN ENDOF 2 OF CNT_DEM @ SCORES 2+ @ < IF CNT_DEM @ SCORES 2+ ! 1- THEN ENDOF 3 OF CNT_DEM @ SCORES 4+ @ < IF CNT_DEM @ SCORES 4+ ! 1- THEN ENDOF CNT_DEM @ SCORES 14+ @ < IF CNT_DEM @ SCORES 14+ ! 1- THEN ENDCASE IF S_FIC_SCORES 1+ 0 FOPEN 0< NOT IF SCORES 16 3 PICK FWRITE DROP THEN FCLOSE DROP THEN R@ SP_AF_NB_DEM THEN THEN THEN DUP >R C@ 16 OR R> C! THEN DROP DROP ETAT_DEM @ CASE 2 OF 0 ENDOF 3 OF 2 ENDOF 3 ENDCASE TETE_DEM ! R@ SP_AF_TETE THEN 4 PICK 3- DUP 0< IF DUP XOR ELSE 4 PICK 23- DUP 0< IF SWAP 3+ R@ FEN_TAILLE_? DROP 16- 2/ - SWAP 18+ OVER 0< OVER 0< OR >R >R 15 > R> 15 > OR R> OR IF 0 ELSE -1 DUP DUP SX_DEM ! SY_DEM ! THEN ELSE >R 20 /MOD SWAP DROP R> 20 /MOD SWAP DROP OVER DX_DEM @ < OVER DY_DEM @ < AND ETAT_DEM @ 2 = AND OVER DX_DEM @ * 4 PICK + ECRAN_DEM + C@ 0< AND IF SY_DEM ! SX_DEM ! -1 ELSE DROP DROP -1 DUP SX_DEM ! SY_DEM ! 0 THEN THEN THEN DUP IF [ SYMBOLES_SOURIS 28 5 LSH + LITERAL ] ELSE [ SYMBOLES_SOURIS 10 5 LSH + LITERAL ] THEN R@ FEN_MOTIF_SOURIS ACTION_DEM ! THEN DROP DROP DROP DROP R> DROP ; : DEMINEUR F_DEM @ ?DUP IF FEN_SELECTIONNE ELSE FEN_CREE ?DUP IF DUP >R F_DEM ! 2 ETAT_DEM ! 0 M_ETAT_DEM ! S_FIC_SCORES 1+ -1 FOPEN DUP 16 = IF SCORES SWAP 3 PICK FREAD ELSE 999 SCORES DUP >R ! 999 R@ 2+ ! 999 R@ 4+ ! 2 R@ 6+ ! 16 R@ 8+ ! 16 R@ 10+ ! 40 R@ 12+ ! 999 R> 14+ ! THEN DROP FCLOSE DROP INIT_DEM ECRAN 4+ @ DX_DEM @ 20 * 6+ - 2/ ECRAN 6+ @ DY_DEM @ 1+ 20 * 6+ - 2/ R@ FEN_POSITION DX_DEM @ 20 * 6+ DY_DEM @ 1+ 20 * 6+ R@ FEN_TAILLE S_TITRE R@ FEN_NOM FERME_DEM R@ FEN_FERME MENU_DEM R@ FEN_MENU A_PROPOS_DEM R@ FEN_A_PROPOS AFFICHE_DEM R@ FEN_AFFICHE CLV_DEM R@ FEN_CLAVIER SOURIS_DEM R@ FEN_SOURIS R@ FERME_DEM EXECUTE 1 AF_ANIMATION CHRONO_DEM R@ FEN_CHRONO R> FEN_ACTIVE ELSE ." IMPOSSIBLE de creer l'application DEMINEUR FORTH!" ABORT THEN THEN ; ' DEMINEUR 4- DUP DEBUT_DEMINEUR 4- - SWAP 2! DICO_INIT DEMINEUR ( FIN )