( Jeux de PACMAN pour coeur FORTH.
  Version 2.00 du 11 Decembre 2011.
  Ecrit par jpb.forth .
)

DECIMAL

START 2@ CONSTANT DEBUT_PACMAN

" PACMAN"                STRING S_PACMAN
FEN_STRING" S_DESCRIPTIF

      PACMAN    FORTH

Version 2.00  du 11/12/2011

 http://jpb.forth.free.fr/
 jpb_forth@yahoogroups.com

Que le FORTH soit avec TOI!
"

      FORTH   PACMAN

Version 2.00 in 12/11/2011

 http://jpb.forth.free.fr/
 jpb_forth@yahoogroups.com

May the FORTH be with you!
"
FEN_STRING" S_MENU
NOUVEAU JEU..ESC G
FERMER.......ESC F
MENU.........ESC N"
NEW GAME..ESC G
CLOSE.....ESC F
MENU......ESC N"
FEN_STRING" S_NIVEAU
Niveau :     0"
Level  :     0"
" Score  :     0" STRING S_SCORE
FEN_STRING" S_NOTICE1
Le glouton se deplace sans arret
dans  la direction donnee par la
derniere touche flechee activee."
The glouton moves without stop
in  the  direction   given  by
the  last arrow key activated."
FEN_STRING" S_NOTICE2
   Glouton, on en gagne 1
    tous les 2000 points.
   Pastille, rapporte
    5 points.
   Carotte, rapporte
    10 points et rend les
    fantomes commestibles."
   Glouton, you win 1 of
    it each 2000 points.
   Dot, allows to
    win 5 points.
   Carott, allows to
    win 10 points and makes
    ghosts edible."
FEN_STRING" S_NOTICE3
   Fantome dangereux.
   Fantome commestible,
    rapporte 20 points.
   Fantome digere.

ESC G pour lancer le jeu."
   Dangerous ghost.
   Edible ghost, allows
    to win 20 points.
   Digests ghost.

ESC G to launch the game."
FEN_STRING" S_FINI
 FIN DU JEU ! "
 GAME  OVER ! "
FEN_STRING" S_SCORES
Meilleurs  SCORES:
"
Better     SCORES:
" "
NEMO..........4000
NEMO..........2000
NEMO..........1000
NEMO...........500
NEMO...........250
NEMO        .....0" STRING S_SCORES+
FEN_STRING" S_NOM_RECORD
FELICITATION!
 Votre nom :"
CONGRATULATION!
  Your name :"
FEN_STRING" S_PB_SCORES
Probleme pendant l'enregistrement des scores !"
Problem during the recording of the scores!"
FEN_STRING" S_BAD_SCORE
Desole, votre score n'est
pas suffisamment brillant
 pour etre memorise  :-( "
Sorry, your score is not
sufficiently   brilliant
   to be records  :-(   "
" APPLICATIONS/JEUX/pacman.scr"
                          STRING S_FIC_SCORES

0 VARIABLE F_PAC
0 VARIABLE ETAT
0 VARIABLE PRECED
0 VARIABLE NUM_ICONE
0 VARIABLE RECORD
0 VARIABLE DIR_GLOUTON
0 VARIABLE CNT_PAC
0 VARIABLE NOMBRE_PAC
0 VARIABLE SCORE_PAC
0 VARIABLE DSCORE_PAC
0 VARIABLE NIVEAU_PAC
0 VARIABLE NBPAST_PAC
0 VARIABLE MSQ_PAC
0 VARIABLE TEMPS_PAC
0 VARIABLE SON_PAC

HERE 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 0 ,
CONSTANT VITESSE_01,00
HERE 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 2 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 0 ,
CONSTANT VITESSE_01,06
HERE 1 , 1 , 1 , 1 , 1 , 2 , 1 , 1 , 1 , 1 , 1 , 1 , 2 , 1 , 1 , 1 , 0 ,
CONSTANT VITESSE_01,13
HERE 1 , 1 , 2 , 1 , 1 , 1 , 1 , 2 , 1 , 1 , 1 , 1 , 2 , 1 , 1 , 0 ,
CONSTANT VITESSE_01,20
HERE 1 , 2 , 1 , 1 , 1 , 2 , 1 , 1 , 2 , 1 , 1 , 1 , 2 , 1 , 0 ,
CONSTANT VITESSE_01,29
HERE 1 , 2 , 1 , 2 , 1 , 1 , 2 , 1 , 2 , 1 , 1 , 2 , 1 , 0 ,
CONSTANT VITESSE_01,38
HERE 2 , 1 , 2 , 1 , 2 , 1 , 2 , 1 , 2 , 1 , 2 , 1 , 0 ,
CONSTANT VITESSE_01,50
HERE 2 , 1 , 2 , 2 , 1 , 2 , 1 , 2 , 2 , 1 , 2 , 0 ,
CONSTANT VITESSE_01,64
HERE 2 , 2 , 1 , 2 , 2 , 2 , 2 , 1 , 2 , 2 , 0 ,
CONSTANT VITESSE_01,80
HERE 2 , 2 , 2 , 2 , 2 , 2 , 2 , 2 , 2 , 0 ,
CONSTANT VITESSE_02,00
HERE 2 , 3 , 2 , 2 , 2 , 3 , 2 , 2 , 0 ,
CONSTANT VITESSE_02,25
HERE 3 , 2 , 3 , 2 , 3 , 2 , 3 , 0 ,
CONSTANT VITESSE_02,57
HERE 3 , 3 , 3 , 3 , 3 , 3 , 0 ,
CONSTANT VITESSE_03,00
HERE 4 , 3 , 4 , 3 , 4 , 0 ,
CONSTANT VITESSE_03,60
HERE 5 , 4 , 5 , 4 , 0 ,
CONSTANT VITESSE_04,50
HERE 6 , 6 , 6 , 0 ,
CONSTANT VITESSE_06,00
HERE 9 , 9 , 0 ,
CONSTANT VITESSE_09,00
HERE 18 , 0 ,
CONSTANT VITESSE_10,00

HERE 30 , 250 , 30 , 500 , 30 , 750 , 30 , 1000 , 0 ,
CONSTANT SON_MANGE_FANTOME
HERE 10 , 1000 , 0 ,
CONSTANT SON_MANGE_PASTILLE
HERE 10 , 750 , 0 ,
CONSTANT SON_MANGE_CAROTTE
HERE 30 , 1000 , 30 , 750 , 30 , 500 , 30 , 250 , 0 ,
CONSTANT SON_MANGE_GLOUTON
HERE 400 , 1000 , 600 , 750 , 800 , 500 , 1000 , 250 , 0 ,
CONSTANT SON_FIN_DU_JEU

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 )
0000001111000000 ,
0000111111110000 ,
0001011111111000 ,
0010011111111100 ,
0010111111111100 ,
0111111100000010 ,
0111100000000000 ,
0110000000000000 ,
0110111100111000 ,
0010111111011100 ,
0011011111111100 ,
0001100111111000 ,
0000111000000000 ,
0000001111000000 ,
0000000000000000 ,

0000001111000000 , ( 1 )
0000110000110000 ,
0001000000001000 ,
0010100000000100 ,
0101100000000010 ,
0101000000000010 ,
1000000011111101 ,
1000011111111111 ,
1001111111111111 ,
1001000011000111 ,
0101000000100010 ,
0100100000000010 ,
0010011000000100 ,
0001000111111000 ,
0000110000110000 ,
0000001111000000 ,

0000001111000000 , ( 2 )
0000110000110000 ,
0001000000001000 ,
0010100000000100 ,
0101100000000010 ,
0101000000000010 ,
1000000001111001 ,
1000001111111111 ,
1001111111111111 ,
1001000011000111 ,
0100100000100010 ,
0100010000000010 ,
0010001100000100 ,
0001000011111000 ,
0000110000110000 ,
0000001111000000 ,

0000001111000000 , ( 3 )
0000110000110000 ,
0001000000001000 ,
0010100000000100 ,
0101100000000010 ,
0101000000000010 ,
1000000000000001 ,
1000000111111001 ,
1001111111111111 ,
1001000011000111 ,
0100100000100010 ,
0100011000000110 ,
0010000111111100 ,
0001000000001000 ,
0000110000110000 ,
0000001111000000 ,

0000001111000000 , ( 4 )
0000110000110000 ,
0001000000001000 ,
0010100000000100 ,
0101100000000010 ,
0101000000000010 ,
1000000000000001 ,
1000000000000001 ,
1001111111111111 ,
1000100000100111 ,
0100011100000110 ,
0100000011111010 ,
0010000000000100 ,
0001000000001000 ,
0000110000110000 ,
0000001111000000 ,

0000001111000000 , ( 5 )
0000110000110000 ,
0001000000001000 ,
0010100000000100 ,
0101100000000010 ,
0101000000000010 ,
1000000000000001 ,
1000000000000001 ,
1001100000000011 ,
1000011111111101 ,
0100001100001010 ,
0100000011110010 ,
0010000000000100 ,
0001000000001000 ,
0000110000110000 ,
0000001111000000 ,

0000001111000000 , ( 6 )
0000110000110000 ,
0001000000001000 ,
0010100000000100 ,
0101100000000010 ,
0101000000000010 ,
1000000000000001 ,
1000000000000001 ,
1001100000000011 ,
1000011000000101 ,
0100000111111010 ,
0100000000000010 ,
0010000000000100 ,
0001000000001000 ,
0000110000110000 ,
0000001111000000 ,

0000001111000000 , ( 7 )
0000111111110000 ,
0001111111111000 ,
0011111111111100 ,
0111111111111110 ,
0111111111111110 ,
1111111111111111 ,
1111111111111111 ,
1111111111111111 ,
1111111111111111 ,
0111111111111110 ,
0111111111111110 ,
0011111111111100 ,
0001111111111000 ,
0000011111110000 ,
0000001111000000 ,

0000001111000000 , ( 8 )
0000111111110000 ,
0001111111111000 ,
0011100111111100 ,
0111101111111110 ,
0111111111111110 ,
1111111111111111 ,
0100110011111111 ,
1011001111111111 ,
1111111111111111 ,
0111111111111110 ,
0111111111111110 ,
0011111111111100 ,
0001111111111000 ,
0000111111110000 ,
0000001111000000 ,

0000001101000000 , ( 9 )
0000111011110000 ,
0001111101111000 ,
0011111101111100 ,
0111111011111110 ,
0111111011100110 ,
1111111101110111 ,
1111111101111111 ,
1111111111111111 ,
1111111111111111 ,
0111111111111110 ,
0111111111111110 ,
0011111111111100 ,
0001111111111000 ,
0000111111110000 ,
0000001111000000 ,

0000001111000000 , ( 10 )
0000111111110000 ,
0001111111111000 ,
0011111110011100 ,
0111111111011110 ,
0111111111111110 ,
1111111111111111 ,
1111111100110010 ,
1111111111001101 ,
1111111111111111 ,
0111111111111110 ,
0111111111111110 ,
0011111111111100 ,
0001111111111000 ,
0000111111110000 ,
0000001111000000 ,

0000001111000000 , ( 11 )
0000111111110000 ,
0001111111111000 ,
0011111111111100 ,
0111111111111110 ,
0111111111111110 ,
1111111111111111 ,
1111111111111111 ,
1111111101111111 ,
1111111101110111 ,
0111111011100110 ,
0111111011111110 ,
0011111101111100 ,
0001111101111000 ,
0000111011110000 ,
0000001101000000 ,

0000011111000000 , ( 12 )
0001111111110000 ,
0111111111111000 ,
1111110011111100 ,
0111111011111110 ,
0001111111111110 ,
0000011111111111 ,
0000000011111111 ,
0000000011111111 ,
0000011111111111 ,
0001111111111110 ,
0111111111111110 ,
1111111111111100 ,
0111111111111000 ,
0001111111110000 ,
0000011111000000 ,

0001000000001000 , ( 13 )
0011100000011100 ,
0011100000011100 ,
0111110000111110 ,
0111110000111110 ,
1111111001111111 ,
1111111001110111 ,
1111111001100111 ,
1111111111111111 ,
1111111111111111 ,
0111111111111110 ,
0111111111111110 ,
0011111111111100 ,
0001111111111000 ,
0000111111110000 ,
0000001111000000 ,

0000001111100000 , ( 14 )
0000111111111000 ,
0001111111111110 ,
0011111100111111 ,
0111111101111110 ,
0111111111111000 ,
1111111111100000 ,
1111111100000000 ,
1111111100000000 ,
1111111111100000 ,
0111111111111000 ,
0111111111111110 ,
0011111111111111 ,
0001111111111110 ,
0000111111111000 ,
0000001111100000 ,

0000001111000000 , ( 15 )
0000111111110000 ,
0001111111111000 ,
0011111111111100 ,
0111111111111110 ,
0111111111111110 ,
1111111111111111 ,
1111111111111111 ,
1111111001100111 ,
1111111001110111 ,
1111111001111111 ,
0111110000111110 ,
0111110000111110 ,
0011100000011100 ,
0011100000011100 ,
0001000000001000 ,

0000000000000000 , ( 16 )
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0011100001110000 ,
0010100001010000 ,
0011100001110000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

0000000000000000 , ( 17 )
0000000000000000 ,
0001100000011000 ,
0001010000101000 ,
0001110000111000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

0000000000000000 , ( 18 )
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000111000011100 ,
0000101000010100 ,
0000111000011100 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

0000000000000000 , ( 19 )
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0001110000111000 ,
0001010000101000 ,
0001110000111000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

0001100000011000 , ( 20 )
0011110000111100 ,
0110011001100110 ,
0100001111000010 ,
0100000110000010 ,
1100000110000011 ,
1100000110000011 ,
1110001111000111 ,
1111111111111111 ,
1001111111111001 ,
1100000000000011 ,
1111000000001111 ,
1111110000111111 ,
1111111111111111 ,
1110111011101110 ,
0100010001000100 ,

0001100000011000 , ( 21 )
0011110000111100 ,
0110011001100110 ,
0100001111000010 ,
0100000110000010 ,
1100000110000011 ,
1100000110000011 ,
1110001111000111 ,
1111111111111111 ,
1001111111111001 ,
1100000000000011 ,
1111000000001111 ,
1111110000111111 ,
1111111111111111 ,
0111011101110111 ,
0010001000100010 ,

0000000000000000 , ( 22 )
0000000000000000 ,
0001100000011000 ,
0011110000111100 ,
0011111001111100 ,
0011111001111100 ,
0011111001111100 ,
0001110000111000 ,
0000000000000000 ,
0000000000000000 ,
0000010000100000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

0000000000000000 , ( 23 )
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000001111000000 ,
0000011100100000 ,
0000100011110000 ,
0000111111110000 ,
0000010000100000 ,
0000001111000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

0000111000000000 , ( 24 )
0001010100000000 ,
0010101100000000 ,
0111010110000000 ,
1111101011000000 ,
1111110101000000 ,
1111111010100000 ,
0111111101010000 ,
0001111110110000 ,
0000111111011000 ,
0000001111101100 ,
0000000111110100 ,
0000000001111010 ,
0000000000111101 ,
0000000000001111 ,
0000000000000111 ,

0000000000000000 , ( 25 )
0000000000000000 ,
0010101001010100 ,
0100000000000010 ,
0000100000010000 ,
0000100000010000 ,
0011111001111100 ,
0000100000010000 ,
0000100000010000 ,
0000000000000000 ,
0000000000000000 ,
0110000110000110 ,
1001001001001001 ,
0000110000110000 ,
0000000000000000 ,
0000000000000000 ,

0000001111000000 , ( 26 )
0000111111110000 ,
0001001111001000 ,
0010000110000100 ,
0100000110000010 ,
0100000110000010 ,
1100000110000011 ,
1110001111000111 ,
1111111111111111 ,
1111110000111111 ,
1111000000001111 ,
1100000000000011 ,
1001111111111001 ,
1111111111111111 ,
1110111011101110 ,
0100010001000100 ,

0000001111000000 , ( 27 )
0000111111110000 ,
0001001111001000 ,
0010000110000100 ,
0100000110000010 ,
0100000110000010 ,
1100000110000011 ,
1110001111000111 ,
1111111111111111 ,
1111110000111111 ,
1111000000001111 ,
1100000000000011 ,
1001111111111001 ,
1111111111111111 ,
0111011101110111 ,
0010001000100010 ,

0000000000000000 , ( 28 )
0000000000000000 ,
0000110000110000 ,
0001111001111000 ,
0011111001111100 ,
0011111001111100 ,
0011111001111100 ,
0001110000111000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

0000000000000000 , ( 29 )
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0011100001110000 ,
0010100001010000 ,
0011100001110000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

0000000000000000 , ( 30 )
0000000000000000 ,
0000110000110000 ,
0001010000101000 ,
0001110000111000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

0000000000000000 , ( 31 )
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000111000011100 ,
0000101000010100 ,
0000111000011100 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

0000000000000000 , ( 32 )
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0001110000111000 ,
0001010000101000 ,
0001110000111000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,
0000000000000000 ,

1111111111110000 , ( 33 )
1111111111111100 ,
0111000000001110 ,
0111000000000111 ,
0111000000000111 ,
0111000000000111 ,
0111000000000111 ,
0111000000001110 ,
0111111111111100 ,
0111111111110000 ,
0111000000000000 ,
0111000000000000 ,
0111000000000000 ,
0111000000000000 ,
1111100000000000 ,
1111100000000000 ,

0000000110000000 , ( 34 )
0000001111000000 ,
0000011111100000 ,
0000011111100000 ,
0000111001110000 ,
0000111001110000 ,
0001110000111000 ,
0001110000111000 ,
0011100000011100 ,
0011100000011100 ,
0011111111111100 ,
0111111111111110 ,
0111000000001110 ,
0111000000001110 ,
1111100000011111 ,
1111100000011111 ,

0000011111110011 , ( 35 )
0001111111111111 ,
0011100000001111 ,
0111000000000111 ,
0111000000000011 ,
1110000000000000 ,
1110000000000000 ,
1110000000000000 ,
1110000000000000 ,
1110000000000000 ,
1110000000000000 ,
0111000000000011 ,
0111000000000111 ,
0011100000001111 ,
0001111111111111 ,
0000011111110011 ,

1111100000011111 , ( 36 )
1111100000011111 ,
0111000000001110 ,
0111100000011110 ,
0111110000111110 ,
0111111001111110 ,
0111011111101110 ,
0111001111001110 ,
0111000110001110 ,
0111000000001110 ,
0111000000001110 ,
0111000000001110 ,
0111000000001110 ,
0111000000001110 ,
1111100000011111 ,
1111100000011111 ,

1111100000011111 , ( 37 )
1111100000011111 ,
0111000000001110 ,
0111100000001110 ,
0111110000001110 ,
0111111000001110 ,
0111011100001110 ,
0111001110001110 ,
0111000111001110 ,
0111000011101110 ,
0111000001111110 ,
0111000000111110 ,
0111000000011110 ,
0111000000001110 ,
1111100000011111 ,
1111100000011111 ,

0000001111000000 , ( 38 )
0000110000110000 ,
0001000000001000 ,
0010000000000100 ,
0100100000010010 ,
0101110000111010 ,
1000100000010001 ,
1000000000000001 ,
1000000000000001 ,
1010011001100101 ,
0101100110011010 ,
0100000000000010 ,
0010000000000100 ,
0001000000001000 ,
0000110000110000 ,
0000001111000000 ,
CONSTANT SYMBOLES

HERE
11111111111111111111111111111111 2,
11111111111100000000111111111111 2,
11000000001100000000000000000011 2,
11011111111100000000111111111011 2,
11011111111111011111111111111011 2,
10000000001111011000000000000011 2,
10000000000000011011111111111111 2,
10000000001111111011111111111111 2,
10000000001111000000000000000001 2,
10000000001111000000000000000001 2,
10000000001111000000000000000001 2,
11111111111111000000000000000001 2,
11111111111111000000000000000001 2,
11000000000111000000000000000001 2,
11011111110111000000000000000001 2,
11010000010111000000000000000001 2,
11010111010111000000000000000001 2,
11010100010111000000000000000001 2,
11010111110111000000000000000001 2,
11010000000111000000000000000001 2,
11011111111111000000000000000001 2,
11000000000000000000000000000001 2,
11111111111111000000000000000001 2,
11111111111111111111111111111111 2,
CONSTANT NOTICE

HERE
11111111111101111110111111111111 2,
10000001000100000010100010100001 2,
10111101011101111010101010100101 2,
10000101000101000010101010100101 2,
11110101010101011110101010111101 2,
00000100010001000000001000000000 2,
10101111010111111111111110111101 2,
10100000010000000000000000100001 2,
10101111110111111111101111110101 2,
10101000000100000000100010010101 2,
10101011111100000000101000010101 2,
10101000000100000000101111010101 2,
10101011110100000000100000010101 2,
10101000010100000000111111010101 2,
10101001000100000000100000010101 2,
10101111110111111111101111110101 2,
10000100000000000000001000000101 2,
10111101110111111110101011110101 2,
00000001000000000010101010000000 2,
10111101111101111010101010101111 2,
10100101000001000010000010100001 2,
10100101011111011110111010111101 2,
10000101000001000000100010000001 2,
11111111111101111110111111111111 2,
CONSTANT LABYRINTHE

DECIMAL

: DEGRADE_PAC ( adr_degrade --> - )
 : CREATE
  DUP HERE OVER 2+ @ 3 PICK 4+ @ + 4* 2* 64+ DUP 2/ ALLOT CMOVE
  MEMOIRE_LIBERE DROP
 DOES>
;

95 95 95 47 47 47 95 0 95 0 0 95 0 95 0 95 95 0 95 77 0 95 0 0
47 0 0 0 0 0 95 95 95 11 24 24 -1 DEGRADE_\ DEGRADE_PAC FOND_ICONE

95 95 95 47 47 47 95 0 95 0 0 95 0 95 0 95 95 0 95 77 0 95 0 0
47 0 0 0 0 0 95 95 95 11  576 432 -1 DEGRADE_\ DEGRADE_PAC FOND_SOMBRE

255 255 255 127 127 127 255 0 255 0 0 255 0 255 0 255 255 0 255 127 0 255 0 0
127 0 0 0 0 0 255 255 255 11 576 432 -1 DEGRADE_\ DEGRADE_PAC FOND_CLAIR

HERE 8 ALLOT ( x,y,dir,etat,adr_vitesse,x-1,y-1 ) CONSTANT GLOUTON
HERE 8 ALLOT ( x,y,dir,etat,adr_vitesse,x-1,y-1 ) CONSTANT FANTOME_1
HERE 8 ALLOT ( x,y,dir,etat,adr_vitesse,x-1,y-1 ) CONSTANT FANTOME_2
HERE 8 ALLOT ( x,y,dir,etat,adr_vitesse,x-1,y-1 ) CONSTANT FANTOME_3
HERE 8 ALLOT ( x,y,dir,etat,adr_vitesse,x-1,y-1 ) CONSTANT FANTOME_4

HERE 32 24 2 */ ALLOT CONSTANT ECRAN_PAC

TACHE: T_SON_PAC
 SON_PAC DUP >R 2@ DUP @ DUP
 IF
  >R 2+ DUP @ 246 CW! R> T_SON_PAC T_ACTIVE 2+ R> 2!
 ELSE
  DUP 246 CW! R> 2! DROP
 THEN
;

: LANCE_SON_PAC ( adr_son --> - )
 SON_PAC 2! 0 T_SON_PAC T_ACTIVE
;

: VITESSE_? ( niveau --> adr_vitesse )
 CASE
  0 OF
   VITESSE_01,50
  ENDOF
  1 OF
   VITESSE_01,64
  ENDOF
  2 OF
   VITESSE_01,80
  ENDOF
  3 OF
   VITESSE_02,00
  ENDOF
  4 OF
   VITESSE_02,25
  ENDOF
  5 OF
   VITESSE_02,57
  ENDOF
  6 OF
   VITESSE_03,00
  ENDOF
  7 OF
   VITESSE_03,60
  ENDOF
  8 OF
   VITESSE_04,50
  ENDOF
  9 OF
   VITESSE_06,00
  ENDOF
  10 OF
   VITESSE_09,00
  ENDOF
  VITESSE_10,00
 ENDCASE
;

: COMESTIBLE_? ( niveau --> duree en centaine de ms )
 200 SWAP CASE
  0 OF
   150 150
  ENDOF
  1 OF
   150 164
  ENDOF
  2 OF
   150 180
  ENDOF
  3 OF
   150 200
  ENDOF
  4 OF
   150 225
  ENDOF
  5 OF
  150 257
  ENDOF
  6 OF
   150 300
  ENDOF
  7 OF
   150 360
  ENDOF
  8 OF
   150 450
  ENDOF
  9 OF
   150 600
  ENDOF
  10 OF
   150 900
  ENDOF
  150 1000
 ENDCASE
 */
;

: INIT_POSITIONS
 ECRAN_PAC DUP >R 768+ R> DO
  I C@ 7 AND I C!
 LOOP
 [ 16 18 * 1+ 16 LSH 16 18 * 1+ + LITERAL ] DUP GLOUTON 2! GLOUTON 12+ 2!
 [ 1 16 LSH LITERAL ] GLOUTON 4+ 2! 1 DIR_GLOUTON !
 [ 16 5 LSH 16+ ECRAN_PAC + LITERAL ] DUP >R C@ 32 OR R> C!
 [ 15 18 * 1+ 16 LSH 7 18 * 1+ + LITERAL ] DUP FANTOME_1 2! DUP FANTOME_1 12+ 2!
 DUP FANTOME_2 2! DUP FANTOME_2 12+ 2! DUP FANTOME_3 2! DUP FANTOME_3 12+ 2!
 DUP FANTOME_4 2! FANTOME_4 12+ 2! CNT_PAC @ 0 = NOT 2 AND 1+
 DUP FANTOME_1 4+ 2! DUP FANTOME_2 4+ 2! DUP FANTOME_3 4+ 2! FANTOME_4 4+ 2!
 [ 7 5 LSH 15+ ECRAN_PAC + LITERAL ] DUP >R C@ 16 OR R> C!
 NIVEAU_PAC @ DUP VITESSE_?
 BEGIN
  DUP @
 WHILE
  2+
 REPEAT
 DUP FANTOME_1 8+ 2! DUP FANTOME_2 8+ 2!
 DUP FANTOME_3 8+ 2! FANTOME_4 8+ 2!
 1+ VITESSE_?
 BEGIN
  DUP @
 WHILE
  2+
 REPEAT
 GLOUTON 8+ 2!
;

: INIT_PAC
 ( bit 0 : mur
   bit 1 : pastille
   bit 2 : carotte
   bit 4 : fantome
   bit 5 : glouton
 )
 ETAT @ 1 =
 IF
  NOTICE ECRAN_PAC DUP 768+ SWAP DO
   DUP 2@ I DUP 32+ SWAP DO
    1 ROL DUP 1 AND I C!
   LOOP
   DROP 4+
  32 +LOOP
  DROP 2 [ 17 13 5 LSH + ECRAN_PAC + LITERAL ] C!
  4 [ 17 15 5 LSH + ECRAN_PAC + LITERAL ] C!
  [ 17 18 * 1+ 16 LSH 12 18 * 1+ + LITERAL ] DUP GLOUTON 2! GLOUTON 12+ 2!
  [ 2 16 LSH LITERAL ] GLOUTON 4+ 2! 1 DIR_GLOUTON !
  [ 17 5 LSH 12+ ECRAN_PAC + LITERAL ] DUP >R C@ 32 OR R> C!
  [ 17 18 * 1+ 16 LSH 17 18 * 1+ + LITERAL ] DUP FANTOME_1 2! FANTOME_1 12+ 2!
  [ 2 16 LSH 1+ LITERAL ] FANTOME_1 4+ 2!
  [ 17 5 LSH 17+ ECRAN_PAC + LITERAL ] DUP >R C@ 16 OR R> C!
  [ 17 18 * 1+ 16 LSH 18 18 * 1+ + LITERAL ] DUP FANTOME_2 2! FANTOME_2 12+ 2!
  [ 2 16 LSH 3+ LITERAL ] FANTOME_2 4+ 2!
  [ 17 5 LSH 18+ ECRAN_PAC + LITERAL ] DUP >R C@ 16 OR R> C!
  [ 17 18 * 1+ 16 LSH 19 18 * 1+ + LITERAL ] DUP FANTOME_3 2! FANTOME_3 12+ 2!
  [ 2 16 LSH 5+ LITERAL ] FANTOME_3 4+ 2!
  [ 17 5 LSH 19+ ECRAN_PAC + LITERAL ] DUP >R C@ 16 OR R> C!
  [ 9 18 * 1+ 16 LSH 2 18 * 1+ + LITERAL ] DUP FANTOME_4 2! FANTOME_4 12+ 2!
  [ 2 16 LSH 1+ LITERAL ] FANTOME_4 4+ 2!
  [ 9 5 LSH 2+ ECRAN_PAC + LITERAL ] DUP >R C@ 16 OR R> C!
  3 NOMBRE_PAC ! 0 DUP NIVEAU_PAC ! SCORE_PAC 2! 2000 DSCORE_PAC 2!
 ELSE
  LABYRINTHE ECRAN_PAC DUP 768+ SWAP DO
   DUP 2@ I DUP 32+ SWAP DO
    1 ROL DUP 1 AND I C!
   LOOP
   DROP 4+
  32 +LOOP
  DROP 0 NBPAST_PAC ! ECRAN_PAC 24 0 DO
   DUP I 32 * + 32 0 DO
    I 10 > I 21 < AND J 7 > J 16 < AND AND NOT
    IF
     DUP I + C@ 1 = NOT
     IF
      1 NBPAST_PAC +! 2 OVER I + C!
     THEN
    THEN
   LOOP
   DROP
  LOOP
  DROP
  4 [ 10  1 5 LSH + ECRAN_PAC + LITERAL ] C!
  4 [ 16  3 5 LSH + ECRAN_PAC + LITERAL ] C!
  4 [ 28  3 5 LSH + ECRAN_PAC + LITERAL ] C!
  4 [ 17  7 5 LSH + ECRAN_PAC + LITERAL ] C!
  4 [  1 16 5 LSH + ECRAN_PAC + LITERAL ] C!
  4 [  3 20 5 LSH + ECRAN_PAC + LITERAL ] C!
  4 [ 15 20 5 LSH + ECRAN_PAC + LITERAL ] C!
  4 [ 21 22 5 LSH + ECRAN_PAC + LITERAL ] C!
  INIT_POSITIONS NIVEAU_PAC @ 65535 AND 10000 /MOD ?DUP
  IF
   48+ S_NIVEAU 10+ C! 1000 /MOD 48+ S_NIVEAU 11+ C!
   100 /MOD 48+ S_NIVEAU 12+ C! 10 /MOD 48+ S_NIVEAU 13+ C!
  ELSE
   32 S_NIVEAU 10+ C! 1000 /MOD ?DUP
   IF
    48+ S_NIVEAU 11+ C! 100 /MOD 48+ S_NIVEAU 12+ C!
    10 /MOD 48+ S_NIVEAU 13+ C!
   ELSE
    32 S_NIVEAU 11+ C! 100 /MOD ?DUP
    IF
     48+ S_NIVEAU 12+ C! 10 /MOD 48+ S_NIVEAU 13+ C!
    ELSE
     32 S_NIVEAU 12+ C! 10 /MOD ?DUP
     IF
      48+
     ELSE
      32
     THEN
     S_NIVEAU 13+ C!
    THEN
   THEN
  THEN
  48+ S_NIVEAU 14+ C!
 THEN
;

: SP_AF_CAR_PAC ( X,Y,fen --> - )
 >R >R DUP 18 * SWAP R@ 5 LSH + R> 18 * SWAP ECRAN_PAC + C@ DUP 1 AND
 IF
  FOND_CLAIR
 ELSE
  FOND_SOMBRE
 THEN
 4 PICK 4 PICK OVER 17+ OVER 17+ R@ FEN_TAPISSE_REC 6 AND ?DUP
 IF
  2/ 1- >R 16 DUP R@
  IF
   211
  ELSE
   255
  THEN
  5 PICK 1+ 5 PICK 1+ R> 23+ 5 LSH SYMBOLES + R@ FEN_TRACE_MOTIF
  DROP DROP DROP DROP DROP
 THEN
 R> DROP DROP DROP
;

: SP_AF_PACMAN ( x,y,fen_devant,fen --> - )
 >R >R 16 DUP 162 R>
 IF
  DUP 2/ +
 THEN
 5 ROLL 5 ROLL [ SYMBOLES 33 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF_RELIEF
 >R 18+ R> [ SYMBOLES 34 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF_RELIEF
 >R 18+ R> [ SYMBOLES 35 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF_RELIEF
 >R 18+ R> [ SYMBOLES 36 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF_RELIEF
 >R 18+ R> [ SYMBOLES 34 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF_RELIEF
 >R 18+ R> [ SYMBOLES 37 5 LSH + LITERAL ] R> FEN_TRACE_MOTIF_RELIEF
 DROP DROP DROP DROP DROP
;

: SP_AF_TEXTE ( x,y,adr_s,fen --> - )
 >R >R >R >R 255 CARACTERES_GRAPHIQUES R> R> R> COUNT
 BEGIN
  0 SWAP
  BEGIN
   1- >R OVER OVER + C@ 255 AND 31 >
   IF
    1+ R> DUP 0=
   ELSE
    R> -1
   THEN
  UNTIL
  R@ SWAP >R FEN_TRACE_CHAINE 1+ >R 14+ R> R> DUP 0=
 UNTIL
 DROP DROP DROP DROP DROP DROP R> DROP
;

: SP_AF_GLOUTON ( x,y,num,fen --> - )
 >R 16 DUP 162 R@ FEN_DEVANT_?
 IF
  DUP 2/ +
 THEN
 6 ROLL 6 ROLL [ SYMBOLES 7 5 LSH + LITERAL ] R@ FEN_TRACE_MOTIF
 >R >R DUP XOR R> R> 6 ROLL DUP 5 >
 IF
  11- NEGATE
 THEN
 1+ 5 LSH SYMBOLES + R> FEN_TRACE_MOTIF DROP DROP DROP DROP DROP
;

: AFFICHE_FANTOMES ( fen --> - )
 4 0 DO
  FOND_SOMBRE I CASE
   0 OF
    FANTOME_1
   ENDOF
   1 OF
    FANTOME_2
   ENDOF
   2 OF
    FANTOME_3
   ENDOF
   FANTOME_4
  ENDCASE
  DUP >R 12+ @ R@ 14+ @ OVER 15+ OVER 15+ OVER [ 32 18 * 1- LITERAL ] >
  IF
   5 PICK 5 PICK 5 PICK 5 PICK 5 PICK 11 PICK FEN_TAPISSE_REC
   >R >R >R [ 32 18 * LITERAL ] - R> R> [ 32 18 * LITERAL ] - R>
  ELSE
   DUP [ 24 18 * 1- LITERAL ] >
   IF
    5 PICK 5 PICK 5 PICK 5 PICK 5 PICK 11 PICK FEN_TAPISSE_REC
    >R >R [ 24 18 * LITERAL  ] - R> R> [ 24 18 * LITERAL  ] -
   THEN
  THEN
  6 PICK FEN_TAPISSE_REC DUP R@ 12+ @ 1- 18 /MOD R@ 14+ @ 1- 18 /MOD SWAP
  IF
   >R >R DROP R> R> 3 PICK 3 PICK 3 PICK 1+ DUP 23 > -24 AND + 2
  ELSE
   ROT
   IF
    3 PICK 3 PICK 1+ 31 AND 3 PICK 2
   ELSE
    1
   THEN
  THEN
  0 DO
   OVER OVER 5 LSH + ECRAN_PAC + C@ 6 AND ?DUP
   IF
    >R 16 DUP R@ 2 AND
    IF
     255
    ELSE
     211
    THEN
    5 ROLL 18 * 1+ 5 ROLL 18 * 1+ R> 2 AND
    IF
     [ 23 5 LSH SYMBOLES + LITERAL ]
    ELSE
     [ 24 5 LSH SYMBOLES + LITERAL ]
    THEN
    7 ROLL FEN_TRACE_MOTIF DROP DROP
   THEN
   DROP DROP DROP
  LOOP
  16 DUP R@ 6+ @ 6 AND ?DUP
  IF
   4 <
   IF
    51
   ELSE
    255
   THEN
  ELSE
   R> I CASE
    0 OF
     195
    ENDOF
    1 OF
     223
    ENDOF
    2 OF
     63
    ENDOF
    227
   ENDCASE
   SWAP >R
  THEN
  R@ @ R@ 2+ @ 3 PICK 255 =
  IF
   [ SYMBOLES 25 5 LSH + LITERAL ]
  ELSE
   3 PICK 51 =
   IF
    [ SYMBOLES 26 5 LSH + LITERAL ] R@ 6+ @ 1 AND 5 LSH +
    7 PICK FEN_TRACE_MOTIF >R >R 255 OR R> R> [ SYMBOLES 28 5 LSH + LITERAL ]
    7 PICK FEN_TRACE_MOTIF >R >R DUP XOR R> R> [ SYMBOLES 29 5 LSH + LITERAL ]
    R@ 4+ @ 5 LSH +
   ELSE
    [ SYMBOLES 20 5 LSH + LITERAL ] R@ 6+ @ 1 AND 5 LSH +
    7 PICK FEN_TRACE_MOTIF >R >R 255 OR R> R> [ SYMBOLES 22 5 LSH + LITERAL ]
    7 PICK FEN_TRACE_MOTIF >R >R DUP XOR R> R> [ SYMBOLES 16 5 LSH + LITERAL ]
    R@ 4+ @ 5 LSH +
   THEN
  THEN
  7 PICK FEN_TRACE_MOTIF R> DROP DROP DROP DROP DROP DROP
 LOOP
 DROP
;

: AFFICHE_GLOUTON ( fen --> - )
 FOND_SOMBRE GLOUTON DUP >R 12+ @ R@ 14+ @ OVER 15+ OVER 15+
 OVER [ 32 18 * 1- LITERAL ] >
 IF
  5 PICK 5 PICK 5 PICK 5 PICK 5 PICK 11 PICK FEN_TAPISSE_REC
  >R >R >R [ 32 18 * LITERAL ] - R> R> [ 32 18 * LITERAL ] - R>
 ELSE
  DUP [ 24 18 * 1- LITERAL ] >
  IF
   5 PICK 5 PICK 5 PICK 5 PICK 5 PICK 11 PICK FEN_TAPISSE_REC
   >R >R [ 24 18 * LITERAL  ] - R> R> [ 24 18 * LITERAL  ] -
  THEN
 THEN
 6 PICK FEN_TAPISSE_REC 16 DUP 242 R@ @ R@ 2+ @ ETAT @ 3 =
 IF
  >R >R DROP 255 R> R> [ SYMBOLES 38 5 LSH + LITERAL ]
 ELSE
  [ SYMBOLES 8 5 LSH + LITERAL ] R@ 4+ @ 5 LSH + R@ 6+ @ 7 LSH +
 THEN
 7 PICK FEN_TRACE_MOTIF R> DROP DROP DROP DROP DROP DROP DROP
;

: SP_AF_NIVEAU_SCORE ( fen --> - )
 >R CNT_PAC @ ?DUP
 IF
  200 MIN 51 [ 32 18 * 100- 2/ LITERAL ] 196
  3 PICK 3 PICK 3 PICK OVER 99+ OVER R@ FEN_TRACE_REC 1+
  3 PICK 3 PICK 3 PICK OVER 8 PICK 2/ 1- 0 MAX + OVER 9+
  OVER [ 32 18 * 100- 2/ 99 + LITERAL ] <
  IF
   FOND_SOMBRE 3 PICK 5 PICK [ 32 18 * 100- 2/ 99 + LITERAL ] 5 PICK
   R@ FEN_TAPISSE_REC
  THEN
  R@ FEN_TRACE_REC 10+ OVER 99+ OVER R@ FEN_TRACE_REC DROP
 ELSE
  FOND_SOMBRE [ 32 18 * 100- 2/ LITERAL ] 196
  OVER 99+ OVER 11+ R@ FEN_TAPISSE_REC
 THEN
 FOND_SOMBRE [ 32 18 * 14 7 * - 2/ 9 7 * + LITERAL ] 212
 OVER [ 5 7 * 1- LITERAL ] + OVER 23+ R@ FEN_TAPISSE_REC
 [ 32 18 * 14 7 * - 2/ LITERAL ] 212 S_NIVEAU R@ SP_AF_TEXTE
 [ 32 18 * 14 7 * - 2/ LITERAL ] 224 S_SCORE R> SP_AF_TEXTE
;

FEN: SP_AFFICHE_PAC
 DUP >R FEN_TAILLE_? DROP 64 <
 IF
  R@ FEN_TAILLE_? >R 24- 2/ R> 24- 2/
  FOND_ICONE 3 PICK 3 PICK R@ FEN_ECRIT_REC
  >R 4+ R> 4+ NUM_ICONE @ R@ SP_AF_GLOUTON
 ELSE
  MSQ_PAC 2@ 0 OVER
  IF
   24 0 DO
    2 OVER LSH 3 PICK AND
    IF
     LEAVE
    ELSE
     1+
    THEN
   LOOP
   R> 32 0 DO
    I 3 PICK 3 PICK SP_AF_CAR_PAC
   LOOP
   >R 18 * ETAT @ 1 =
   IF
    DUP 36 =
    IF
     [ 13 18 * 1+ LITERAL ] 37 R@ FEN_DEVANT_? R@ SP_AF_PACMAN
    ELSE
     DUP 180 =
     IF
      36 106 S_SCORES R@ SP_AF_TEXTE
      R> 255 CARACTERES_GRAPHIQUES 36 120 S_SCORES+ 5 0 DO
       1+ 18 7 PICK FEN_TRACE_CHAINE >R 14+ R>
      LOOP
      DROP DROP DROP DROP DROP >R
      292 156 S_NOTICE1 R@ SP_AF_TEXTE
     ELSE
      DUP 288 =
      IF
       [ 18 18 * LITERAL ] 212 S_NOTICE2 R@ SP_AF_TEXTE
      ELSE
       DUP 414 =
       IF
        [ 18 18 * LITERAL ] 310 S_NOTICE3 R@ SP_AF_TEXTE
       THEN
      THEN
     THEN
    THEN
   ELSE
    DUP 198 =
    IF
     [ 13 18 * 1+ LITERAL ] 172 R@ FEN_DEVANT_? R@ SP_AF_PACMAN
    ELSE
     DUP 234 =
     IF
      R@ SP_AF_NIVEAU_SCORE
     THEN
    THEN
   THEN
  THEN
  ETAT @ 1 =
  IF
   [ 6 18 * LITERAL 17 18 * LITERAL ] NUM_ICONE @ R@ SP_AF_GLOUTON
  ELSE
   ETAT @ 2 =
   IF
    OVER 0= OVER [ 13 18 * 9+ LITERAL ] > OR
    IF
     NOMBRE_PAC @ NUM_ICONE @ [ 13 18 * 9+ LITERAL ] 244 4 PICK
     IF
      OVER OVER 5 PICK R@ SP_AF_GLOUTON
     ELSE
      FOND_SOMBRE 3 PICK 3 PICK OVER 35+ OVER 17+ R@ FEN_TAPISSE_REC
     THEN
     >R >R 3+ 11 MOD R> 36+ R> 4 PICK 1 >
     IF
      OVER OVER 5 PICK R@ SP_AF_GLOUTON
     ELSE
      FOND_SOMBRE 3 PICK 3 PICK OVER 35+ OVER 17+ R@ FEN_TAPISSE_REC
     THEN
     >R >R 6+ 11 MOD R> 36+ R> 4 PICK 2 >
     IF
      OVER OVER 5 PICK R@ SP_AF_GLOUTON
     ELSE
      FOND_SOMBRE 3 PICK 3 PICK OVER 17+ OVER 17+ R@ FEN_TAPISSE_REC
     THEN
     DROP DROP DROP DROP
    THEN
   ELSE
    [ 13 18 * 5+ LITERAL ] 248 S_FINI R@ SP_AF_TEXTE
   THEN
   R@ SP_AF_NIVEAU_SCORE
  THEN
  R@ AFFICHE_FANTOMES R@ AFFICHE_GLOUTON DROP DROP
 THEN
 R> DROP
;

FEN: CHRONO_PAC
 NUM_ICONE DUP >R @ 1+ 11 MOD R> ! DUP >R FEN_TAILLE_? DROP 64 <
 IF
  99
 ELSE
  MSQ_PAC 2@
  IF
   MSQ_PAC DUP >R 2@ DUP + R> 2! 1
  ELSE
   TEMPS 2@ DUP TEMPS_PAC 2@ - 99 >
   IF
    CNT_PAC @ ?DUP
    IF
     1- DUP CNT_PAC ! 0=
     IF
      FANTOME_1 6+ DUP >R @ @ -7 AND R> !
      FANTOME_2 6+ DUP >R @ @ -7 AND R> !
      FANTOME_3 6+ DUP >R @ @ -7 AND R> !
      FANTOME_4 6+ DUP >R @ @ -7 AND R> !
     THEN
    THEN
    ETAT @ 1 =
    IF
     NPA 3 AND FANTOME_1 4+ !
     NPA 3 AND FANTOME_2 4+ !
     NPA 3 AND FANTOME_3 4+ !
     NPA 3 AND FANTOME_4 4+ !
    THEN
    FANTOME_1 6+ DUP >R @ 1 XOR R> !
    FANTOME_2 6+ DUP >R @ 1 XOR R> !
    FANTOME_3 6+ DUP >R @ 1 XOR R> !
    FANTOME_4 6+ DUP >R @ 1 XOR R> !
    GLOUTON 6+ DUP >R @ 1 XOR R> !
    TEMPS_PAC 2!
   ELSE
    DROP
   THEN
   49 ETAT @ 2 = R@ FEN_DEVANT_? AND
   IF
    4 0 DO
     I CASE
      0 OF
       FANTOME_1
      ENDOF
      1 OF
       FANTOME_2
      ENDOF
      2 OF
       FANTOME_3
      ENDOF
      FANTOME_4
     ENDCASE
     DUP >R @ GLOUTON DUP >R @ - ABS [ 18 32 * LITERAL ] MOD 9 <
     R> 2+ @ R@ 2+ @ - ABS [ 18 24 * LITERAL ] MOD 9 < AND
     IF
      CNT_PAC @
      IF
       R@ 6+ @ DUP 6 AND 4 <
       IF
        -7 AND 4 OR R@ 6+ ! SON_MANGE_FANTOME LANCE_SON_PAC 20 SCORE_PAC +2!
       ELSE
        DROP
       THEN
      ELSE
       NOMBRE_PAC @ ?DUP
       IF
        1- NOMBRE_PAC ! SON_MANGE_GLOUTON LANCE_SON_PAC INIT_POSITIONS
        -1 MSQ_PAC 2!
        BEGIN
         SON_PAC 2@ 0=
        UNTIL
       ELSE
        -1 ETAT ! SON_FIN_DU_JEU LANCE_SON_PAC
       THEN
      THEN
     THEN
     R@ 2@ R@ 12+ 2! R@ @ R@ 2+ @ R@ 8+ 2@ @ ?DUP
     IF
      2 R@ 8+ +2! R@ 4+ @ DUP 1 >
      IF
       2 >
       IF
        + DUP [ 24 18 * 1- LITERAL ] > [ 24 18 * LITERAL ] AND -
       ELSE
        >R SWAP R> + DUP [ 32 18 * 1- LITERAL ] > [ 32 18 * LITERAL ] AND - SWAP
       THEN
      ELSE
       0>
       IF
        - DUP 0< [ 24 18 * LITERAL ] AND +
       ELSE
        >R SWAP R> - DUP 0< [ 32 18 * LITERAL ] AND + SWAP
       THEN
      THEN
     ELSE
      OVER 1- 18 / OVER 1- 18 /
      OVER OVER 1+ DUP 24 < AND 5 LSH + ECRAN_PAC + C@ 17 AND 0= NOT 8 AND >R
      OVER 1+ 31 AND OVER 5 LSH + ECRAN_PAC + C@ 17 AND 0= NOT 4 AND R> OR >R
      OVER OVER 1- DUP 0< 24 AND + 5 LSH + ECRAN_PAC + C@ 17 AND 0= NOT 2 AND R> OR >R
      OVER 1- 31 AND OVER 5 LSH + ECRAN_PAC + C@ 17 AND 0= NOT 1 AND R> OR
      1 R@ 4+ @ LSH OVER 15 XOR DUP 0=
      IF
       DROP
      ELSE
       DUP 1 = OVER 2 = OR OVER 4 = OR OVER 8 = OR
       IF
        >R DROP R>
       ELSE
        DUP 3 = OVER 6 = OR OVER 9 = OR OVER 12 = OR
        IF
         >R 4* DUP 8 >
         IF
          4/ 4/
         THEN
         R> XOR
        ELSE
         OVER OVER OR DUP 5 = >R 10 = R> OR
         IF
          DROP
         ELSE
          DROP DROP 15 XOR GLOUTON DUP >R @ 6 PICK - DUP [ 18 4 LSH LITERAL ] >
          IF
           [ -18 5 LSH LITERAL ] +
          ELSE
           DUP [ -18 4 LSH LITERAL ] <
           IF
            [ 18 5 LSH LITERAL ] +
           THEN
          THEN
          R> 2+ @ 6 PICK - DUP [ 18 12 * LITERAL ] >
          IF
           [ -18 24 * LITERAL ] +
          ELSE
           DUP [ -18 12 * LITERAL ] <
           IF
            [ 18 24 * LITERAL ] +
           THEN
          THEN
          OVER ABS OVER ABS > >R >R 0<
          IF
           1
          ELSE
           4
          THEN
          R> 0<
          IF
           2
          ELSE
           8
          THEN
          R> R@ 6+ @ 6 AND
          IF
           >R >R 5 XOR R> 10 XOR R>
          THEN
          IF
           >R OVER OVER AND
           IF
            R> DROP OVER AND
           ELSE
            OVER R@ AND
            IF
             DROP DUP R> AND
            ELSE
             R> OR 15 XOR OVER AND
            THEN
           THEN
          ELSE
           >R OVER R@ AND
           IF
            DROP DUP R> AND
           ELSE
            OVER OVER AND
            IF
             R> DROP OVER AND
            ELSE
             R> OR 15 XOR OVER AND
            THEN
           THEN
          THEN
         THEN
        THEN
       THEN
      THEN
      >R DROP OVER OVER 5 LSH + ECRAN_PAC + 0 R> 4 0 DO
       2/ ?DUP
       IF
        >R 1+ R>
       ELSE
        LEAVE
       THEN
      LOOP
      DUP R@ 4+ ! SWAP >R DUP 1 >
      IF
       2 >
       IF
        1+ DUP 23 > 24 AND -
       ELSE
        >R 1+ 31 AND R>
       THEN
      ELSE
       0>
       IF
        1- DUP 0< 24 AND +
       ELSE
        >R 1- 31 AND R>
       THEN
      THEN
      5 LSH + ECRAN_PAC + DUP >R C@ DUP 17 AND
      IF
       R> R> DROP DROP DROP
      ELSE
       16 OR R> C! R@ C@ 239 AND R> C!
       NIVEAU_PAC @ VITESSE_? DUP >R @ R> 2+ R@ 8+ 2! R@ 4+ @ DUP 1 >
       IF
        2 >
        IF
         + DUP [ 24 18 * 1- LITERAL ] > [ 24 18 * LITERAL ] AND -
        ELSE
         >R SWAP R> + DUP [ 32 18 * 1- LITERAL ] > [ 32 18 * LITERAL ] AND - SWAP
        THEN
       ELSE
        0>
        IF
         - DUP 0< [ 24 18 * LITERAL ] AND +
        ELSE
         >R SWAP R> - DUP 0< [ 32 18 * LITERAL ] AND + SWAP
        THEN
       THEN
      THEN
     THEN
     R@ 2+ ! R> !
    LOOP
    NPA DROP GLOUTON DUP >R 2@ R@ 12+ 2! R@ @ R@ 2+ @ R@ 8+ 2@ @ ?DUP
    IF
     2 R@ 8+ +2! R@ 4+ @ DUP 1 >
     IF
      2 >
      IF
       + DUP [ 24 18 * 1- LITERAL ] > [ 24 18 * LITERAL ] AND -
      ELSE
       >R SWAP R> + DUP [ 32 18 * 1- LITERAL ] > [ 32 18 * LITERAL ] AND - SWAP
      THEN
     ELSE
      0>
      IF
       - DUP 0< [ 24 18 * LITERAL ] AND +
      ELSE
       >R SWAP R> - DUP 0< [ 32 18 * LITERAL ] AND + SWAP
      THEN
     THEN
    ELSE
     OVER 1- 18 / OVER 1- 18 / OVER OVER 5 LSH + ECRAN_PAC +
     DIR_GLOUTON @ DUP R@ 4+ ! SWAP DUP >R C@ DUP 2 AND
     IF
      2 XOR SON_MANGE_PASTILLE LANCE_SON_PAC 1 NBPAST_PAC -! 5 SCORE_PAC +2!
     THEN
     DUP 4 AND
     IF
      4 XOR SON_MANGE_CAROTTE LANCE_SON_PAC 1 NBPAST_PAC -! 10 SCORE_PAC +2!
      NIVEAU_PAC @ COMESTIBLE_? CNT_PAC DUP >R @ 0=
      IF
       FANTOME_1 6+ DUP >R @ -7 AND 2 OR R> !
       FANTOME_2 6+ DUP >R @ -7 AND 2 OR R> !
       FANTOME_3 6+ DUP >R @ -7 AND 2 OR R> !
       FANTOME_4 6+ DUP >R @ -7 AND 2 OR R> !
      THEN
      R> !
     THEN
     SCORE_PAC 2@ 65535 AND 10000 /MOD ?DUP
     IF
      48+ S_SCORE 10+ C! 1000 /MOD 48+ S_SCORE 11+ C!
      100 /MOD 48+ S_SCORE 12+ C! 10 /MOD 48+ S_SCORE 13+ C!
     ELSE
      32 S_SCORE 10+ C! 1000 /MOD ?DUP
      IF
       48+ S_SCORE 11+ C! 100 /MOD 48+ S_SCORE 12+ C!
       10 /MOD 48+ S_SCORE 13+ C!
      ELSE
       32 S_SCORE 11+ C! 100 /MOD ?DUP
       IF
        48+ S_SCORE 12+ C! 10 /MOD 48+ S_SCORE 13+ C!
       ELSE
        32 S_SCORE 12+ C! 10 /MOD ?DUP
        IF
         48+
        ELSE
         32
        THEN
        S_SCORE 13+ C!
       THEN
      THEN
     THEN
     48+ S_SCORE 14+ C! R@ C! DUP 1 >
     IF
      2 >
      IF
       1+ DUP 23 > 24 AND -
      ELSE
       >R 1+ 31 AND R>
      THEN
     ELSE
      0>
      IF
       1- DUP 0< 24 AND +
      ELSE
       >R 1- 31 AND R>
      THEN
     THEN
     5 LSH + ECRAN_PAC + DUP C@ 1 AND 0=
     IF
      DUP >R C@ 32 OR R> C! R@ C@ 32 XOR R> C!
      NIVEAU_PAC @ 1+ VITESSE_? DUP >R @ R> 2+ R@ 8+ 2! R@ 4+ @ DUP 1 >
      IF
       2 >
       IF
        + DUP [ 24 18 * 1- LITERAL ] > [ 24 18 * LITERAL ] AND -
       ELSE
        >R SWAP R> + DUP [ 32 18 * 1- LITERAL ] > [ 32 18 * LITERAL ] AND - SWAP
       THEN
      ELSE
       0>
       IF
        - DUP 0< [ 24 18 * LITERAL ] AND +
       ELSE
        >R SWAP R> - DUP 0< [ 32 18 * LITERAL ] AND + SWAP
       THEN
      THEN
     ELSE
      DROP R> DROP
     THEN
    THEN
    R@ 2+ ! R> ! SCORE_PAC 2@ DSCORE_PAC 2@ < NOT
    IF
     2000 DSCORE_PAC +2! NOMBRE_PAC @ 3 <
     IF
      1 NOMBRE_PAC +! SON_MANGE_FANTOME LANCE_SON_PAC
     THEN
    THEN
    NBPAST_PAC @ 0=
    IF
     1 NIVEAU_PAC +! INIT_PAC -1 MSQ_PAC 2!
    THEN
    NIVEAU_PAC @ 63 AND 10 /MOD ?DUP
    IF
     48+
    ELSE
     32
    THEN
    S_NIVEAU 13+ C! 48+ S_NIVEAU 14+ C!
   ELSE
    FANTOME_1 DUP >R 2@ R> 12+ 2!
    FANTOME_2 DUP >R 2@ R> 12+ 2!
    FANTOME_3 DUP >R 2@ R> 12+ 2!
    FANTOME_4 DUP >R 2@ R> 12+ 2!
    GLOUTON DUP >R 2@ R> 12+ 2!
   THEN
  THEN
 THEN
 SP_AFFICHE_PAC CHRONO_PAC R@ FEN_CHRONO ETAT @ 0<
 IF
  3 ETAT ! SCORE_PAC 2@ 65535 AND S_SCORES+ COUNT DUP 1+ 6 / >R + 5 0 DO
   1- OVER
   IF
    >R 10 /MOD R> ROT 48+
   ELSE
    46
   THEN
   OVER C!
  LOOP
  >R DROP R> R> 0 5 0 DO
   ( adr_nbr,decalage,index_nbr )
   3 PICK 5 OVER 5 PICK I 1+ * - OVER STRCMP 0>
   IF
    1+
   ELSE
    LEAVE
   THEN
  LOOP
  ?DUP
  IF
   3 PICK 3 PICK - 6+ DUP 12 S_NOM_RECORD R@ FEN_DIALOGUE_TEXTE
   ( adr_nbr,decalage,index_nbr,adr_nom,nbc )
   DUP 0>
   IF
    OVER 5 PICK 5 PICK * - 3 PICK 6 PICK - OVER - ?DUP
    IF
     >R DUP 6 PICK OVER + R> CMOVE
    THEN
    DUP 6 PICK 1- 46 FILL DUP >R SWAP CMOVE DROP R> + 6- 5 CMOVE
    S_FIC_SCORES 1+ 0 FOPEN 0< NOT
    IF
     S_SCORES COUNT 3 PICK FWRITE DROP
     S_SCORES+ COUNT 3 PICK FWRITE DROP
    THEN
    FCLOSE
    IF
     S_PB_SCORES R@ FEN_DIALOGUE_MESSAGE
    THEN
   ELSE
    DROP DROP DROP DROP DROP
   THEN
  ELSE
   DROP DROP S_BAD_SCORE R@ FEN_DIALOGUE_MESSAGE
  THEN
  1 ETAT ! INIT_PAC -1 MSQ_PAC 2!
 THEN
 R> DROP
;

FEN: AFFICHE_PAC
 -1 MSQ_PAC 2! SYMBOLES SWAP FEN_MOTIF_SOURIS
;

FEN: SORT_PAC
 >R [ 13 18 * 1+ LITERAL ] ETAT @ 1 =
 IF
  37
 ELSE
  172
 THEN
 0 R> SP_AF_PACMAN
;

FEN: A_PROPOS_PAC
 >R S_DESCRIPTIF R> FEN_DIALOGUE_MESSAGE
;

FEN: ICONE_PAC
 SP_AFFICHE_PAC EXECUTE
;

FEN: FERME_PAC
 >R ICONE_PAC R> FEN_ICONE
;

FEN: MENU_PAC
 BEGIN
  4 S_MENU 0 4 PICK FEN_DIALOGUE_CHOIX CASE
   1 OF
    2 ETAT ! INIT_PAC DUP AFFICHE_PAC EXECUTE -1
   ENDOF
   2 OF
    DUP FERME_PAC EXECUTE -1
   ENDOF
   3 OF
    0
   ENDOF
   -1
  ENDCASE
 UNTIL
 DROP
;

FEN: CLV_PAC
 SWAP PRECED DUP >R @ 27 =
 IF
  31 AND 0
 ELSE
  DUP 27 =
  IF
   0 SWAP
  ELSE
   0
  THEN
 THEN
 R> !

 DUP 6 = ( fermeture )
 IF
  DROP DUP FERME_PAC EXECUTE 0
 THEN

 DUP 7 = ( nouveau jeu )
 IF
  DROP 2 ETAT ! INIT_PAC DUP AFFICHE_PAC EXECUTE 0
 THEN

 ETAT @ 1 >
 IF
  DUP 8 =
  IF
   DROP 0 DUP DIR_GLOUTON !
  THEN

  DUP 9 =
  IF
   DROP 0 2 DIR_GLOUTON !
  THEN

  DUP 10 =
  IF
   DROP 0 3 DIR_GLOUTON !
  THEN

  DUP 11 =
  IF
   DROP 0 1 DIR_GLOUTON !
  THEN
  ( Reserve pour test
  DUP 42 = ( * pour changer le niveau de jeu ) (
  IF
   NIVEAU_PAC @ 9 <
   IF
    1 NIVEAU_PAC +! DUP XOR
   THEN
  THEN

  DUP 43 = ( + pour ajouter un glouton ) (
  IF
   DROP ETAT @ 3 =
   IF
    1 ETAT -!
   ELSE
    NOMBRE_PAC DUP >R @ 1+ 3 MIN R> ! SON_MANGE_FANTOME LANCE_SON_PAC
   THEN
   0
  THEN

  DUP 45 = ( - pour retirer un glouton ) (
  IF
   DROP NOMBRE_PAC DUP >R @ ?DUP
   IF
    1- R> ! SON_MANGE_GLOUTON LANCE_SON_PAC
   ELSE
    R> DROP ETAT @ 2 =
    IF
     -1 ETAT ! SON_FIN_DU_JEU LANCE_SON_PAC
    ELSE
     1 ETAT ! INIT_PAC DUP AFFICHE_PAC EXECUTE
    THEN
   THEN
   0
  THEN
  )
 THEN

 DUP 14 = ( menu )
 IF
  DROP DUP MENU_PAC EXECUTE 0
 THEN

 IF
  BELL
 THEN
 DROP
;

: PACMAN
 F_PAC @ ?DUP
 IF
  FEN_SELECTIONNE
 ELSE
  FEN_CREE ?DUP
  IF
   DUP >R F_PAC ! 1 ETAT ! INIT_PAC S_FIC_SCORES 1+ -1 FOPEN
   DUP 0< NOT
   IF
    S_SCORES+ 1+ 19 4 PICK FREAD DROP 19- S_SCORES+ 1+ SWAP 3 PICK FREAD
   THEN
   DROP FCLOSE DROP 0 S_SCORES+ COUNT 1+ 6 / + 1- DUP 6- DO
    10 * I C@ 48- DUP 0<
    IF
     DROP
    ELSE
     +
    THEN
   LOOP
   RECORD !
   ECRAN 4+ @ [ 32 18 * LITERAL ] - 2/
   ECRAN 6+ @ [ 24 18 * LITERAL ] - 2/ R@ FEN_POSITION
   [ 32 18 * LITERAL ] [ 24 18 * LITERAL ] R@ FEN_TAILLE
   S_PACMAN R@ FEN_NOM
   FERME_PAC R@ FEN_FERME
   MENU_PAC R@ FEN_MENU
   A_PROPOS_PAC R@ FEN_A_PROPOS
   AFFICHE_PAC R@ FEN_AFFICHE
   SORT_PAC R@ FEN_SORT
   CLV_PAC R@ FEN_CLAVIER
   R@ FERME_PAC EXECUTE
   1 SP_AFFICHE_PAC CHRONO_PAC R@ FEN_CHRONO
   49152 T_SON_PAC T_AJOUTE
   R> FEN_ACTIVE
  ELSE
   ." IMPOSSIBLE de creer l'application PACMAN FORTH!" ABORT
  THEN
 THEN
;

' PACMAN 4- DUP DEBUT_PACMAN 4- - SWAP 2! DICO_INIT

PACMAN

( FIN
)