Section courante

A propos

Section administrative du site

 Langage  Installation  Elément  Tutoriel  Programmation  Bibliothèque  Cadre d'application  GUI  Projet  Jeux  Outils  Emulateur  Annexe  Aide 
ABAP/4
Ada
Assembleur
Assembly & bytecode
ASP (Active Server Pages)
Basic
C
C++
C# (C Sharp)
Cobol
ColdFusion
Fortran
HTML
Java
JavaScript
LISP
Logo
LotusScript
Oberon
Pascal
Perl
PHP
PL/1
Prolog
Python
Rebol
REXX
Ruby
SAS
NoSQL
SQL
Swift
X++ (Axapta)
GNAT
SMALLAda
VHDL
Assembleur 370
Assembleur 1802
Assembleur 4004
Assembleur 6502
Assembleur 6800
Assembleur 68000
Assembleur 8080 et 8085
Assembleur 8089
Assembleur 80x86
Assembleur AGC4
Assembleur ARM
Assembleur DPS 8000
Assembleur i860
Assembleur Itanium
Assembleur MIPS
Assembleur PDP-11
Assembleur PowerPC
Assembleur RISC-V
Assembleur SPARC
Assembleur SuperH
Assembleur UNIVAC I
Assembleur VAX
Assembleur Z80
Assembleur Z8000
Assembleur z/Architecture
ASSEMBLER/MONITOR 64
Micol Assembler
GFA Assembler
A86
MASM (Macro Assembler)
TASM (Turbo Assembler)
CIL
Jasmin
LLVM
MSIL
Parrot
P-Code (PCode)
SWEET16
G-Pascal
ASP 1.0
ASP 2.0
ASP 3.0
ASP.NET
ASP.NET Core
ABasiC (Amiga)
Adam SmartBASIC
Altair BASIC
AmigaBASIC (Amiga)
AMOS Basic (Amiga)
Atari Basic (Atari 400, 600 XL, 800, 800XL)
Basic Apple II (Integer BASIC/APPLESOFT)
Basic Commodore 64 (CBM-BASIC)
Basic Commodore 128 (BASIC 7.0)
Basic Commodore VIC-20 (CBM-BASIC 2.0)
Basic Coco 1 (Color Basic)
Basic Coco 2 (Extended Color Basic)
Basic Coco 3 (Extended Color Basic 2.0)
BASICA (PC DOS)
Basic Pro
BBC BASIC
Blitz BASIC (Amiga)
DarkBASIC
Dartmouth BASIC
GFA-Basic (Atari ST/Amiga)
GWBASIC (MS-DOS)
Liberty BASIC
Locomotive BASIC (Amstrad CPC)
MSX-Basic
Omikron Basic (Atari ST)
Oric Extended Basic
Power Basic
Quick Basic/QBasic (MS-DOS)
Sinclair BASIC (ZX80, ZX81, ZX Spectrum)
ST BASIC (Atari ST)
Turbo Basic
Vintage BASIC
VBScript
Visual Basic (VB)
Visual Basic .NET (VB .NET)
Visual Basic pour DOS
Yabasic
BeckerBASIC
SIMONS' BASIC
Basic09 d'OS-9
Disk Extended Color Basic
Basic09 d'OS-9
Disk Extended Color Basic
Access
Excel
Visual Basic pour Windows
Visual Basic .NET pour Windows
C Shell Unix (csh)
C pour Amiga
C pour Atari ST
C pour DOS
C pour Falcon030
C pour GEMDOS (Atari ST)
C pour Linux
C pour PowerTV OS
C pour OS/2
C pour Unix
C pour Windows
Aztec C
CoCo-C
GNU C
HiSoft C
IBM C/2
Introl-C
Lattice C
Microsoft C
MinGW C
MSX-C
Open Watcom C
OS-9 C Compiler
Pure C
Quick C
Turbo C
HiSoft C for Atari ST
HiSoft C for CP/M (Amstrad CPC)
C++ pour OS/2
C++ pour Windows
Borland C++
C++Builder
IBM VisualAge C++
Intel C++
MinGW C++
Open Watcom C++
Symantec C++
Turbo C++
Visual C++
Visual C++ .NET
Watcom C++
Zortech C++
C# (C Sharp) pour Windows
Apple III Cobol
Microsoft Cobol
BlueDragon
Lucee
OpenBD
Railo
Smith Project
Microsoft Fortran
WATFOR-77
CSS
FBML
Open Graph
SVG
XML
XSL/XSLT
LESS
SASS
GCJ (GNU)
JSP
Jython
Visual J++
Node.js
TypeScript
AutoLISP
ACSLogo
LotusScript pour Windows
Amiga Oberon
Oberon .NET
Apple Pascal
Delphi/Kylix/Lazarus
Free Pascal
GNU Pascal
HighSpeed Pascal
IBM Personal Computer Pascal
Lisa Pascal
Maxon Pascal
MPW Pascal
OS-9 Pascal
OSS Personal Pascal
Pascal-86
Pascal du Cray Research
Pascal/VS
Pascal-XT
PURE Pascal
QuickPascal
RemObjets Chrome
Sun Pascal
THINK Pascal
Tiny Pascal (TRS-80)
Turbo Pascal
UCSD Pascal
VAX Pascal
Virtual Pascal
Turbo Pascal for CP/M-80
Turbo Pascal for DOS
Turbo Pascal for Macintosh
Turbo Pascal for Windows
CodeIgniter (Cadre d'application)
Drupal (Projet)
Joomla! (Projet)
Phalanger (PHP .NET)
phpBB (Projet)
Smarty (balise)
Twig (balise)
Symfony (Cadre d'application)
WordPress (Projet)
Zend (Cadre d'application)
PL360
PL/M-80
PL/M-86
Turbo Prolog
CPython
IronPython
Jython
PyPy
AREXX
Regina REXX
JMP
Btrieve
Cassandra
Clipper
CouchDB
dBASE
Hbase
Hypertable
MongoDB
Redis
Access
BigQuery
DB2
H2
Interbase
MySQL
Oracle
PostgreSQL
SAP HANA
SQL Server
Sybase
U-SQL
Turbo Pascal 5
Turbo Pascal 5.5
Turbo Pascal 6
Turbo Pascal 7
Introduction
Les remarques
Les opérateurs
Les instructions conditionnelles
Les instructions de boucles
Type de données
Référence des unités
Références de mots réservés (mots clefs)
Définition de procédure et fonction
Référence de procédures et fonctions
Référence des directives de compilation
CRT
DOS
GRAPH
OBJECTS
OVERLAY
PRINTER
STRINGS
SYSTEM
TURBO3
WINDOS
Catégorie
Prototype
ASCIZ
Date
Ensemble
Fichier
Mémoire
Temps
Trigonométrie
Les premiers pas
Les jetons
Les constantes
Les types
Variables et constantes typées
Les expressions
Les instructions
Blocs, localité et étendue
Procédures et fonctions
Programmes et unités
Vue d'ensemble de la bibliothèque d'exécution
Procédures et fonctions standard
Entrée et sortie
Utilisation du 80x87
Interfaçage avec DOS
Utilisation de chaînes de caractères terminées par NULL
Utilisation de l'interface graphique Borland
Utilisation de recouvrement
Problèmes de mémoire
Problèmes de contrôle
Optimiser votre code
L'assembleur intégré
Liaison de code assembleur
Programmation orientée objet (POO)
Les fichiers
Les périphériques logiques
Files d'attente, piles, listes liées et arborescences
Bonjour
Affichage
Astronomie
Biochimie
Chimie
Conversion
Électrotechnique
Emulateur
Fichiers
Finance
Géographie
Géophysique
Géométrie
Histoire
Jeux & stratégies
Mathématique
Matrice
Médicale
Météorologie
Océanographie
Onirologie
Sport
Temps
Tri
Trigonométrie
Validation
«DRAW» du BASIC
Phase lunaire
Calcul du calcium corrigé
Calcul le taux d'alcoolémie
Bin,Hex,Base62,...
Emulateur de microprocesseur 6502
Texte séquentiel
IPaymt/Interet
NPer
PPaymt/Principal
Distance en Km entre deux longitudes et latitudes
Méridien de Paris
Triangulation d'une position (trilateration,...)
Aire d'un cercle
Aire d'une surface de prisme rectangulaire
Aire d'un triangle
Distance entre deux points
Treillis
Chiffre romain
Méthode du chiffre César (code César)
Asteroids
Bowling
Breakout
Lode Runner
Missile Command
Pac-Man
Patience
Peg Leap
Soko-Ban
Space Invaders
Space Jockey
Tetris
Tic-Tac-Toe
Tours d'Hanois
Ackermann
Exp
Factoriel
Fibonacci
Log
Nombre premier
Odd
Random
Sqrt
Triangle Pascal
Sommation
Hauteur utérine
Calcul de votre poids santé (IMC)
Unité de mesure
Fréquence des vagues
Hockey
Année bissextile
Calendrier
Date de la Pâque
FirstDayOfMonth
Horloge à aiguille
Tri à bulle (Bubble Sort)
Tri Shell Sort
ArcCos
ArcSin
Atn/ATan/ArcTan/ArcTangente
Cos
Sin
Courriel
AMDEKSYSTEM88LIB-TP
APMLIB-TP
BASICSTRLIB-TP
BIOSLIB-TP
COLORIMETRYLIB-TP
CSVLIB-TP
CYRIXLIB-TP
DRDOSLIB-TP
ELECTRICLIB-TP
ERLOGLIB-TP
FINANCIALLIB-TP
GEOLIB-TP
GRAPHICSSOLUTIONLIB-TP
HDLLIB-TP
HISTORICLIB-TP
HTMLLIB-TP
IALIB-TP
INTLLIB-TP
JSONLIB-TP
K8042LIB-TP
LETTRESLIB-TP
LOTUSSCRIPTSTRLIB-TP
METEOLIB-TP
OCEANOGRAPHICLIB-TP
OS2LIB-TP
OSSPASCALLIB-TP
POSIX-TP
PYTHONLIB-TP
SANE-TP
SNOBOLLIB-TP
SVGLIB-TP
TPW4TPLIB-TP
TSENGLABSET4000LIB-TP
VGALIB-TP
WINDOWS9XLIB-TP
XMLLIB-TP
Turbo Vision
UNITEST
MOS
AlimBase
AMIGADOS-0
AXTRO
Colorix
Corail
COREUTILS-0
DEV-COOLS
EDUX
FLEX-0
GEO-COMMANDER
HISTORIK
lettrex
LINUX-0
MATHIX
METEOPOLIS
Micro Calc
MYSTIX
Monsterbook
MSDOS-0
MSXDOS-0
OS9-0
Renegade BBS
Système Information
TRSDOS-0
Turbo Calc
UNIX-0
VIE
7iles
Arkanoid
Digger
Mario and Luigi
Turbo Assembler
Turbo Debugger
DOSBox
PCE - PC Emulator
PCem
Base de connaissances
Table ASCII
Table de codes ANSI et page de codes
RAM de l'IBM PC
Code d'erreur
Génération du code en interne du Turbo Pascal 3
Code source du Turbo Pascal 6
TPU
OBJ
Archives de paquet
Alternative
Bibliographie
Turbo Pascal à FreeDOS/FreePascal
Turbo Pascal à Linux/FreePascal
Turbo Pascal à FreeBSD/FreePascal
Turbo Pascal à eComStation/FreePascal
Préface
Notes légal
Dictionnaire
Recherche

Le jeu Pac-Man est un jeu offrant la possibilité à Pac-Man de se déplacer dans un labyrinthe afin de manger des pastilles. Bien que le jeu est normalement écran dans un écran graphique, il est possible de produire un jeu acceptable dans un écran de texte. De plus, l'affichage dans l'écran de texte est beaucoup plus rapide.

Sachant que le jeu Pac-Man est un labyrinthe, la tendance nature, c'est immédiatement réfléchir une représentation d'un labyrinthe. Nous allons avoir besoin d'une structure de mémoire pour l'affichage à l'écran. Un tableau conviendra parfaitement a avoir un cette représentation. Nous aurons alors une procédure, nommé DisplayNewBoard affichant l'écran contenu dans le tableau «Screen» pour avoir une représentation de ce labyrinthe.

Nous devons également concevoir des graphiques pour chacune des cellules de ce labyrinthes ou tableau en mémoire. Étant données que le jeu doit fonctionner dans un écran de texte ou un terminal, nous n'avons pas vraiment le choix, nous allons devoir utiliser des caractères de texte correspondant le mieux à la présentation du jeu. Le Free Pascal n'est pas fameux avec sa police de caractères texte, il ne supporte correctement que les codes ASCII 32 à 127 jusqu'au Free Pascal 3.2 et l'utilisation de la procédure SetUseACP, tandis qu'avec le Turbo Pascal, on peut utilisé les codes ASCII de 128 à 255, lesquelles contient les caractères graphiques permettant de dessiner le cadre du labyrinthe. Aussi, il est possible avec les cartes vidéo VGA de reprogrammer l'aspect de certains caractères, ainsi, on utilisera la procédure LoadFont (Interruption 10h, Fonction 11h, Sous-Fonction 00h) pour changer l'apparence du caractère 234 de façon à ce qu'il ressemble beaucoup plus à un fantôme. Voici la liste des cellules du tableau :

Valeur Description Caractère ASCII
0 Noir, aucune image #32
1 Pastille ou point #250 ()
2 Pilule de puissance #249 ()
3 Mur horizontal #205 ()
4 Mur vertical #186 ()
5 Coin inférieur gauche du mur #200 ()
6 Coin inférieur droit du mur #188 ()
7 Coin supérieur gauche du mur #201 ()
8 Coin supérieur droit du mur #187 ()
9 Extrémité gauche du mur #222 ()
10 Extrémité droite du mur #221 ()
11 Extrémité supérieure du mur #220 ()
12 Extrémité inférieure du mur #223 ()
13 Jonction murale en T Droite #185 ()
14 Jonction murale en T Gauche #204 ()
15 Jonction murale en T vers le bas #202 ()
16 Jonction du mur en T vers le haut #203 ()
17 La porte de la maison des fantômes -

On aura également les cellules suivantes sous-entendu :

Variable Description
PlayerX, PlayerY, PlayerDirection Pac-Man vue de gauche
PlayerX, PlayerY, PlayerDirection Pac-Man vue de droite
PlayerX, PlayerY, PlayerDirection Pac-Man vue vers le haut
PlayerX, PlayerY, PlayerDirection Pac-Man vue vers le bas
Ghosts Fantôme (Nous tricherons et utiliserons le même)

Données initiale

Lorsque le Pac-Man se déplace et qu'il y a une pastille, il remplace la cellule mémoire et met un zéro. Ainsi, il est possible grâce à cette technique de savoir exactement où les pastilles sont présentes même si fantôme passe dessus et qu'il est effacer par accident. L'ennui, c'est que lorsqu'on modifie le tableau, il n'est plus utilisable pour le niveau suivant. Ainsi, pour résoudre le problème, nous devons copier le tableau origine à chaque InitialScreen dans la variable Screen à chaque changement de niveau. De plus à chaque fois que Pac-Man perd une vie ou qu'il change de niveau, il faut initialiser certaines données initiales sauf bien sur le pointage, le nombre de pilule mangé et le niveau.

Faire jouer Pac-Man et les fantômes

Cette partie est la plus complexe, nous devons perpétuellement faire bouger le personnage Pac-Man et les fantômes. Mais en même temps, nous devons vérifier les mouvements demander par le joueur sur le clavier (cette fonction KeyPressed si une touche est enfoncé et ReadKey permet de lire une touche sur le clavier). Pour arriver au résultat voulu, nous devons impérativement avoir un traitement de déplacement des fantômes et continuer de déplacer le personnage Pac-Man en chaque déplacement. Sauf, que si vous cela à chaque fois, plus la machine sera rapide, plus le Pac-Man et les fantômes se déplaceront rapidement et ils ont le temps d'attraper votre Pac-Man avant même que vous n'ayez bougé ! Pour résoudre se problème, on doit obligatoirement faire attendre le programme 1/4 de secondes (soit 250 millièmes de secondes indiquer par la procédure Delay(250)). Aussi, par le fait même, étant donné qu'on attend pas après l'utilisateur pour déplacer le personnage Pac-Man, est fait juste prendre en note la direction vers lequel le joueur souhaite déplacer le personnage Pac-Man et provoquer le déplacement dans la boucle KeyPressed.

On veut également donner un semblant d'impression d'animation à notre personnage Pac-Man. Pour y arriver, un déplacement sur deux, on change l'image ou le caractère affiché, cette technique donne l'impression au joueur que le personnage à une démarche comme un être humain. Le principe est le même pour déplacer des personnages dans un écran graphique, on fait une rotation entre 2 ou plusieurs images pour donner l'impression que le personnage bouge jusqu'à 60 différentes par secondes dans les jeux les plus réalistes. Mais dans le cas d'un écran de texte, comme cette exemple de jeu, nous nous contentons de 2 seulement.

Surveillance des actions

Le jeux ne se content pas de déplacer des personnages, le but de Pac-Man est de manger toutes les pastilles avant que l'un des 4 fantômes ne l'attrape. Il faut donc compter le nombre de pastille manger par Pac-Man à chaque déplacement avec la variable CountPilule, vérifier si les 212 pilules ont été manger et si c'est le cas changer de niveau. Aussi, si Pac-Man se fait attraper par l'un des 4 fantômes, on doit enlever une vie et déplacer Pac-Man et les fantômes à sa position de départ en réinitialisant les données initiales (InitData).

Le jeu complet

L'exemple de jeu Pac-Man suivant est développé en Turbo Pascal 7 et fonctionne également sous Free Pascal. Voici le code source en Turbo Pascal du jeu :

  1. Program PacMan;
  2.  
  3. Uses CRT,DOS;
  4.  
  5. Const
  6.  {Code de touche clavier renvoyee par ReadKey}
  7.  kbNoKey=0;{Pas de touche}
  8.  kbEsc=$011B;{Escape}
  9.  kbUp=$4800;{Up}
  10.  kbLeft=$4B00;{Fleche de gauche (Left)}
  11.  kbKeypad5=$4CF0;{5 du bloc numerique}
  12.  kbRight=$4D00;{Fleche de droite (Right)}
  13.  kbDn=$5000;{Fleche du bas (Down)}
  14.  
  15. Type
  16.  ScreenArray=Array[0..23] of Array[0..30] of Byte;
  17.  
  18. Const
  19.  InitialScreen:ScreenArray = (
  20.   (00,00,07,03,03,03,03,03,03,03,03,03,03,03,03,16,03,03,03,03,03,03,03,03,03,03,03,03,08,00,00),
  21.   (00,00,04,01,01,01,01,01,01,01,01,01,01,01,01,04,01,01,01,01,01,01,01,01,01,01,01,01,04,00,00),
  22.   (00,00,04,01,07,03,03,08,01,07,03,03,03,08,01,04,01,07,03,03,03,08,01,07,03,03,08,01,04,00,00),
  23.   (00,00,04,02,05,03,03,06,01,05,03,03,03,06,01,12,01,05,03,03,03,06,01,05,03,03,06,02,04,00,00),
  24.   (00,00,04,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,04,00,00),
  25.   (00,00,04,01,09,03,03,10,01,11,01,09,03,03,03,16,03,03,03,10,01,11,01,09,03,03,10,01,04,00,00),
  26.   (00,00,04,01,01,01,01,01,01,04,01,01,01,01,01,04,01,01,01,01,01,04,01,01,01,01,01,01,04,00,00),
  27.   (00,00,05,03,03,03,03,08,01,14,03,03,03,10,00,12,00,09,03,03,03,13,01,07,03,03,03,03,06,00,00),
  28.   (00,00,00,00,00,00,00,04,01,04,00,00,00,00,00,00,00,00,00,00,00,04,01,04,00,00,00,00,00,00,00),
  29.   (00,00,00,00,00,00,00,04,01,04,00,07,03,03,10,17,09,03,03,08,00,04,01,04,00,00,00,00,00,00,00),
  30.   (09,03,03,03,03,03,03,06,01,12,00,04,00,00,00,00,00,00,00,04,00,12,01,05,03,03,03,03,03,03,10),
  31.   (00,00,00,00,00,00,00,00,01,00,00,04,00,00,00,00,00,00,00,04,00,00,01,00,00,00,00,00,00,00,00),
  32.   (09,03,03,03,03,03,03,08,01,11,00,04,00,00,00,00,00,00,00,04,00,11,01,07,03,03,03,03,03,03,10),
  33.   (00,00,00,00,00,00,00,04,01,04,00,05,03,03,03,03,03,03,03,06,00,04,01,04,00,00,00,00,00,00,00),
  34.   (00,00,00,00,00,00,00,04,01,04,00,00,00,00,00,00,00,00,00,00,00,04,01,04,00,00,00,00,00,00,00),
  35.   (00,00,07,03,03,03,03,06,01,12,00,09,03,03,03,16,03,03,03,10,00,12,01,05,03,03,03,03,08,00,00),
  36.   (00,00,04,01,01,01,01,01,01,01,01,01,01,01,01,04,01,01,01,01,01,01,01,01,01,01,01,01,04,00,00),
  37.   (00,00,04,01,09,03,03,08,01,09,03,03,03,10,01,12,01,09,03,03,03,10,01,07,03,03,10,01,04,00,00),
  38.   (00,00,04,02,01,01,01,04,01,01,01,01,01,01,01,00,01,01,01,01,01,01,01,04,01,01,01,02,04,00,00),
  39.   (00,00,14,03,03,10,01,12,01,11,01,09,03,03,03,16,03,03,03,10,01,11,01,12,01,09,03,03,13,00,00),
  40.   (00,00,04,01,01,01,01,01,01,04,01,01,01,01,01,04,01,01,01,01,01,04,01,01,01,01,01,01,04,00,00),
  41.   (00,00,04,01,09,03,03,03,03,15,03,03,03,10,01,12,01,09,03,03,03,15,03,03,03,03,10,01,04,00,00),
  42.   (00,00,04,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,01,04,00,00),
  43.   (00,00,05,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,03,06,00,00)
  44. );
  45.  
  46. Type
  47.  DirectionType=(pLeft,pRight,pUp,pDown);
  48.  
  49. Var
  50.  MouthOpen:Boolean;
  51.  Screen:ScreenArray;
  52.  ChaseTimer:Byte;
  53.  ChaseGhost:Byte;
  54.  CountPilule:Byte;
  55.  Level,Live,Score,HiScore:LongInt;
  56.  PlayerX,PlayerY:Byte;
  57.  PlayerDirection:DirectionType;
  58.  Ghosts:Array[0..3]of Record
  59.   X,Y:Byte;
  60.   Direction:DirectionType;
  61.   Status:(Scatter,Chase);
  62.   IsFrightened:Boolean;
  63.   IsHome:Boolean;
  64.   DotCount:Boolean;
  65.   Speed:Byte;
  66.  End;
  67.  
  68. {$IFNDEF FPC}
  69.  Procedure CursorOff;
  70.  Var
  71.   Regs:Registers;
  72.  Begin
  73.   Regs.AH:=1;
  74.   Regs.CH:=32;
  75.   Regs.CL:=0;
  76.   Intr($10,Regs);
  77.  End;
  78.  
  79.  Procedure CursorOn;
  80.  Var
  81.   Regs:Registers;
  82.  Begin
  83.   Regs.AX:=$0100;
  84.   Regs.CX:=(7 shl 8)+9;
  85.   Intr($10,Regs);
  86.  End;
  87.  
  88.  Procedure LoadFont(AscII:Word;Table,Matrice,Nombre:Byte;Buffer:Pointer);
  89.  Var
  90.   Registre:Registers;
  91.  Begin
  92.   With Registre do Begin
  93.    AX:=$1100;
  94.    BH:=Matrice;
  95.    BL:=Table;
  96.    CX:=Nombre;
  97.    DX:=AscII;
  98.    BP:=Ofs(Buffer^);
  99.    ES:=Seg(Buffer^);
  100.    Intr($10,Registre);
  101.   End;
  102.  End;
  103.  
  104.  Procedure Font234;Assembler;ASM
  105.    { 234 }
  106.   DB 00011100b
  107.   DB 01111110b
  108.   DB 11111111b
  109.   DB 10011001b
  110.   DB 10011001b
  111.   DB 11111111b
  112.   DB 11111111b
  113.   DB 11111111b
  114.   DB 11111111b
  115.   DB 11111111b
  116.   DB 11111111b
  117.   DB 11111111b
  118.   DB 11111111b
  119.   DB 10111011b
  120.   DB 10011001b
  121.   DB 10011001b
  122.  END;
  123. {$ENDIF}
  124.  
  125. Procedure InitData;
  126. Var
  127.  I:Byte;
  128. Begin
  129.  Score:=0;
  130.  PlayerX:=15;
  131.  PlayerY:=18;
  132.  PlayerDirection:=pLeft;
  133.  Ghosts[0].X:=15;Ghosts[0].Y:=12;Ghosts[0].DotCount:=False;
  134.  Ghosts[1].X:=10;Ghosts[1].Y:=14;Ghosts[1].DotCount:=True;
  135.  Ghosts[2].X:=10;Ghosts[2].Y:=16;Ghosts[2].DotCount:=True;
  136.  Ghosts[3].X:=10;Ghosts[3].Y:=9;Ghosts[3].DotCount:=True;
  137.  For I:=0 to 3 do Begin
  138.   Ghosts[I].Direction:=pLeft;
  139.   Ghosts[I].Status:=Scatter;
  140.   Ghosts[I].IsFrightened:=False;
  141.   Ghosts[I].IsHome:=True;
  142.  End;
  143. End;
  144.  
  145. Function Distance(X1,Y1,X2,Y2:Byte):Byte;
  146. Var
  147.  A,B:Byte;
  148. Begin
  149.  A:=Abs(X1-X2);
  150.  B:=Abs(Y1-Y2);
  151.  Distance:=Byte(Trunc(Sqrt(A*A+B*B)));
  152. End;
  153.  
  154. Function AvailableLeft(X,Y:Byte):Boolean;Begin
  155.  AvailableLeft:=Screen[Y,X-1]<=2;
  156. End;
  157.  
  158. Function AvailableRight(X,Y:Byte):Boolean;Begin
  159.  AvailableRight:=Screen[Y,X+1]<=2;
  160. End;
  161.  
  162. Function AvailableUp(X,Y:Byte):Boolean;Begin
  163.  AvailableUp:=Screen[Y-1,X]<=2;
  164. End;
  165.  
  166. Function AvailableDown(X,Y:Byte):Boolean;Begin
  167.  AvailableDown:=Screen[Y+1,X]<=2;
  168. End;
  169.  
  170. Procedure FindDirection(I:Byte);Begin
  171.  If PlayerX < Ghosts[I].X Then Begin
  172.   If AvailableLeft(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pLeft
  173.    Else
  174.   Begin
  175.    If PlayerY < Ghosts[I].Y Then Begin
  176.     If AvailableUp(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pUp Else
  177.     If AvailableDown(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pDown
  178.                                              Else Ghosts[I].Direction:=pRight
  179.    End;
  180.   End;
  181.  End
  182.   Else
  183.  If PlayerX > Ghosts[I].X Then Begin
  184.   If AvailableRight(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pRight
  185.    Else
  186.   Begin
  187.    If PlayerY < Ghosts[I].Y Then Begin
  188.     If AvailableUp(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pUp Else
  189.     If AvailableDown(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pDown
  190.                                              Else Ghosts[I].Direction:=pLeft;
  191.    End;
  192.   End;
  193.  End
  194.   Else
  195.  If PlayerY < Ghosts[I].Y Then Begin
  196.   If AvailableUp(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pUp
  197.    Else
  198.   Begin
  199.    If PlayerX < Ghosts[I].X Then Begin
  200.     If AvailableLeft(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pLeft Else
  201.     If AvailableRight(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pRight
  202.                                               Else Ghosts[I].Direction:=pDown;
  203.    End;
  204.   End;
  205.  End
  206.   Else
  207.  Begin
  208.   If AvailableDown(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pDown
  209.    Else
  210.   Begin
  211.    If PlayerX < Ghosts[I].X Then Begin
  212.     If AvailableLeft(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pLeft Else
  213.     If AvailableRight(Ghosts[I].X,Ghosts[I].Y)Then Ghosts[I].Direction:=pRight
  214.                                              Else Ghosts[I].Direction:=pUp;
  215.    End;
  216.   End;
  217.  End;
  218. End;
  219.  
  220. Procedure RemovePacMan;Begin
  221.  GotoXY(1+PlayerX,1+PlayerY);
  222.  Write(' ');
  223. End;
  224.  
  225. Procedure RemoveGhost(I:Byte);Begin
  226.  GotoXY(1+Ghosts[I].X,1+Ghosts[I].Y);
  227.  Case Screen[Ghosts[I].Y,Ghosts[I].X]of
  228.   1:Begin
  229.    TextColor(12);
  230.    Write('.');
  231.   End;
  232.   2:Begin
  233.    TextColor(13);
  234.    Write('O');
  235.   End;
  236.   Else Write(' ');
  237.  End;
  238. End;
  239.  
  240. Function CheckCell:Boolean;
  241. Var
  242.  I:Byte;
  243. Begin
  244.  CheckCell:=False;
  245.  Case Screen[PlayerY,PlayerX]of
  246.   1:Begin
  247.    Inc(Score,10);
  248.    Inc(CountPilule);
  249.    If CountPilule>=212Then CheckCell:=True;
  250.   End;
  251.   2:Begin
  252.    Inc(Score,50);
  253.    For I:=0 to 3do Ghosts[I].Status:=Chase;
  254.    ChaseTimer:=100;
  255.    ChaseGhost:=0;
  256.   End;
  257.  End;
  258.  Screen[PlayerY,PlayerX]:=0;
  259.  GotoXY(1,25);
  260.  TextColor(15);
  261.  Write('Niveau : ',Level,' Pointage : ',Score,' Vie : ',Live);
  262.  ClrEol;
  263.  GotoXY(30,1);
  264.  If ChaseTimer>0Then Write('Temps : ',ChaseTimer)
  265.                 Else ClrEol;
  266.  GotoXY(30,2);
  267.  If ChaseTimer>0Then Write('Attr. : ',ChaseGhost)
  268.                 Else ClrEol;
  269. End;
  270.  
  271. Procedure DisplayNewBoard;
  272. Var
  273.  X,Y:Byte;
  274. Begin
  275.  TextBackground(0);
  276.  For Y:=0 to 23 do Begin
  277.   For X:=0 to 30 do Begin
  278.    GotoXY(X+1,Y+1);
  279.    Case Screen[Y,X]of
  280.     1:Begin
  281.      TextColor(12);
  282.      Write({$IFDEF FPC}'.'{$ELSE}Chr(250){$ENDIF});
  283.     End;
  284.     2:Begin
  285.      TextColor(13{$IFNDEF FPC}+BLINK{$ENDIF});
  286.      Write({$IFDEF FPC}'O'{$ELSE}Chr(249){$ENDIF});
  287.     End;
  288.     3:Begin
  289.      TextColor((8+Level)and $F);
  290.      Write({$IFDEF FPC}'='{$ELSE}Chr(205){$ENDIF});
  291.     End;
  292.     4:Begin
  293.      TextColor((8+Level)and $F);
  294.      Write({$IFDEF FPC}'I'{$ELSE}Chr(186){$ENDIF});
  295.     End;
  296.     5:Begin
  297.      TextColor((8+Level)and $F);
  298.      Write({$IFDEF FPC}'+'{$ELSE}Chr(200){$ENDIF});
  299.     End;
  300.     6:Begin
  301.      TextColor((8+Level)and $F);
  302.      Write({$IFDEF FPC}'+'{$ELSE}Chr(188){$ENDIF});
  303.     End;
  304.     7:Begin
  305.      TextColor((8+Level)and $F);
  306.      Write({$IFDEF FPC}'+'{$ELSE}Chr(201){$ENDIF});
  307.     End;
  308.     8:Begin
  309.      TextColor((8+Level)and $F);
  310.      Write({$IFDEF FPC}'+'{$ELSE}Chr(187){$ENDIF});
  311.     End;
  312.     9:Begin
  313.      TextColor((8+Level)and $F);
  314.      Write({$IFDEF FPC}'+'{$ELSE}Chr(222){$ENDIF});
  315.     End;
  316.     10:Begin
  317.      TextColor((8+Level)and $F);
  318.      Write({$IFDEF FPC}'+'{$ELSE}Chr(221){$ENDIF});
  319.     End;
  320.     11:Begin
  321.      TextColor((8+Level)and $F);
  322.      Write({$IFDEF FPC}'+'{$ELSE}Chr(220){$ENDIF});
  323.     End;
  324.     12:Begin
  325.      TextColor((8+Level)and $F);
  326.      Write({$IFDEF FPC}'+'{$ELSE}Chr(223){$ENDIF});
  327.     End;
  328.     13:Begin
  329.      TextColor((8+Level)and $F);
  330.      Write({$IFDEF FPC}'+'{$ELSE}Chr(185){$ENDIF});
  331.     End;
  332.     14:Begin
  333.      TextColor((8+Level)and $F);
  334.      Write({$IFDEF FPC}'+'{$ELSE}Chr(204){$ENDIF});
  335.     End;
  336.     15:Begin
  337.      TextColor((8+Level)and $F);
  338.      Write({$IFDEF FPC}'+'{$ELSE}Chr(202){$ENDIF});
  339.     End;
  340.     16:Begin
  341.      TextColor((8+Level)and $F);
  342.      Write({$IFDEF FPC}'+'{$ELSE}Chr(203){$ENDIF});
  343.     End;
  344.     17:Begin
  345.      TextColor(15);
  346.      Write('-');
  347.     End;
  348.     Else Write(' ');
  349.    End;
  350.   End;
  351.  End;
  352. End;
  353.  
  354. Procedure Play;
  355. Var
  356.  K:Word;
  357.  I:Byte;
  358. Begin
  359.  GotoXY(1+PlayerX,1+PlayerY);
  360.  TextColor(14);
  361.  Write(')');
  362.  Repeat
  363.   Repeat
  364.    If ChaseTimer>0Then Dec(ChaseTimer);
  365.    Case PlayerDirection of
  366.     pUp:If AvailableUp(PlayerX,PlayerY)Then Begin
  367.      RemovePacman;
  368.      PlayerY:=PlayerY-1;
  369.      If CheckCell Then Begin
  370.       CountPilule:=0;
  371.       Write('NIVEAU COMPLETE !!');
  372.       Delay(2000);
  373.       Inc(Level);
  374.       Screen:=InitialScreen;
  375.       InitData;
  376.       DisplayNewBoard;
  377.      End;
  378.      GotoXY(1+PlayerX,1+PlayerY);
  379.      If ChaseTimer>0Then TextBackground(10)
  380.                     Else TextBackground(0);
  381.      TextColor(14);
  382.      MouthOpen:=Not MouthOpen;
  383.      If(MouthOpen)Then Write('U')
  384.                   Else Write('o');
  385.      TextBackground(0);
  386.     End;
  387.     pDown:If AvailableDown(PlayerX,PlayerY)Then Begin
  388.      RemovePacman;
  389.      PlayerY:=PlayerY+1;
  390.      If CheckCell Then Begin
  391.       CountPilule:=0;
  392.       Write('NIVEAU COMPLETE !!');
  393.       Delay(2000);
  394.       Inc(Level);
  395.       Screen:=InitialScreen;
  396.       InitData;
  397.       DisplayNewBoard;
  398.      End;
  399.      GotoXY(1+PlayerX,1+PlayerY);
  400.      If ChaseTimer>0Then TextBackground(10)
  401.                     Else TextBackground(0);
  402.      TextColor(14);
  403.      MouthOpen:=Not MouthOpen;
  404.      If(MouthOpen)Then Write({$IFDEF FPC}'A'{$ELSE}Chr(239){$ENDIF})
  405.                   Else Write('o');
  406.      TextBackground(0);
  407.     End;
  408.     pLeft:If AvailableLeft(PlayerX,PlayerY)Then Begin
  409.      RemovePacman;
  410.      If PlayerX<2 Then PlayerX:=28
  411.                   Else PlayerX:=PlayerX-1;
  412.      If CheckCell Then Begin
  413.       CountPilule:=0;
  414.       Write('NIVEAU COMPLETE !!');
  415.       Delay(2000);
  416.       Inc(Level);
  417.       Screen:=InitialScreen;
  418.       InitData;
  419.       DisplayNewBoard;
  420.      End;
  421.      If ChaseTimer>0Then TextBackground(10)
  422.                     Else TextBackground(0);
  423.      GotoXY(1+PlayerX,1+PlayerY);
  424.      TextColor(14);
  425.      MouthOpen:=Not MouthOpen;
  426.      If(MouthOpen)Then Write(')')
  427.                   Else Write('o');
  428.      TextBackground(0);
  429.     End;
  430.     pRight:If AvailableRight(PlayerX,PlayerY)Then Begin
  431.      RemovePacman;
  432.      If PlayerX>28 Then PlayerX:=2
  433.                    Else PlayerX:=PlayerX+1;
  434.                         If ChaseTimer>0Then TextBackground(10)
  435.                     Else TextBackground(0);
  436.      If CheckCell Then Begin
  437.       CountPilule:=0;
  438.       Write('NIVEAU COMPLETE !!');
  439.       Delay(2000);
  440.       Inc(Level);
  441.       Screen:=InitialScreen;
  442.       InitData;
  443.       DisplayNewBoard;
  444.      End;
  445.      GotoXY(1+PlayerX,1+PlayerY);
  446.      TextColor(14);
  447.      MouthOpen:=Not MouthOpen;
  448.      If(MouthOpen)Then Write('(')
  449.                   Else Write('o');
  450.      TextBackground(0);
  451.     End;
  452.    End;
  453.    For I:=0 to 3 do Begin
  454.     Case Ghosts[I].Direction of
  455.      pLeft:If AvailableLeft(Ghosts[I].X,Ghosts[I].Y)Then Begin
  456.       RemoveGhost(I);
  457.       Ghosts[I].X:=Ghosts[I].X-1;
  458.       {CheckCellGhost;}
  459.       GotoXY(1+Ghosts[I].X,1+Ghosts[I].Y);
  460.       TextColor(10+I);
  461.       Write({$IFDEF FPC}'f'{$ELSE}Chr(234){$ENDIF});
  462.      End
  463.       Else
  464.      FindDirection(I);
  465.      pRight:If AvailableRight(Ghosts[I].X,Ghosts[I].Y)Then Begin
  466.       RemoveGhost(I);
  467.       Ghosts[I].X:=Ghosts[I].X+1;
  468.       {CheckCellGhost;}
  469.       GotoXY(1+Ghosts[I].X,1+Ghosts[I].Y);
  470.       TextColor(10+I);
  471.       Write({$IFDEF FPC}'f'{$ELSE}Chr(234){$ENDIF});
  472.      End
  473.       Else
  474.      FindDirection(I);
  475.      pUp:If AvailableUp(Ghosts[I].X,Ghosts[I].Y)Then Begin
  476.       RemoveGhost(I);
  477.       Ghosts[I].Y:=Ghosts[I].Y-1;
  478.       {CheckCellGhost;}
  479.       GotoXY(1+Ghosts[I].X,1+Ghosts[I].Y);
  480.       TextColor(10+I);
  481.       Write({$IFDEF FPC}'f'{$ELSE}Chr(234){$ENDIF});
  482.      End
  483.       Else
  484.      FindDirection(I);
  485.      pDown:If AvailableDown(Ghosts[I].X,Ghosts[I].Y)Then Begin
  486.       RemoveGhost(I);
  487.       Ghosts[I].Y:=Ghosts[I].Y+1;
  488.       {CheckCellGhost;}
  489.       GotoXY(1+Ghosts[I].X,1+Ghosts[I].Y);
  490.       TextColor(10+I);
  491.       Write({$IFDEF FPC}'f'{$ELSE}Chr(234){$ENDIF});
  492.      End
  493.       Else
  494.      FindDirection(I);
  495.     End;
  496.     If((Ghosts[I].X-1=PlayerX)and(Ghosts[I].Y=PlayerY))or
  497.       ((Ghosts[I].X+1=PlayerX)and(Ghosts[I].Y=PlayerY))or
  498.       ((Ghosts[I].X=PlayerX)and(Ghosts[I].Y-1=PlayerY))or
  499.       ((Ghosts[I].X=PlayerX)and(Ghosts[I].Y+1=PlayerY))or
  500.       ((Ghosts[I].X=PlayerX)and(Ghosts[I].Y=PlayerY))Then Begin
  501.      If ChaseTimer>0 Then Begin
  502.       Inc(ChaseGhost);
  503.       Inc(Score,200*ChaseGhost);
  504.       Ghosts[I].X:=18;
  505.       Ghosts[I].Y:=9;
  506.      End
  507.       Else
  508.      If Live=1Then Begin
  509.       Write('PARTIE TERMINER !');
  510.       Exit;
  511.      End
  512.       Else
  513.      Begin
  514.       Write('ATTRAPPER !');
  515.       Delay(2000);
  516.       Dec(Live);
  517.       InitData;
  518.       DisplayNewBoard;
  519.      End;
  520.     End;
  521.    End;
  522.    Delay(250);
  523.   Until Keypressed;
  524.   K:=Byte(ReadKey);
  525.   If K=0Then K:=K or (Byte(ReadKey)shl 8);
  526.   If Chr(Lo(K))='2'Then K:=kbDn;
  527.   If Chr(Lo(K))='4'Then K:=kbLeft;
  528.   If Chr(Lo(K))='6'Then K:=kbRight;
  529.   If Chr(Lo(K))='8'Then K:=kbUp;
  530.   Case K of
  531.    kbUp:If AvailableUp(PlayerX,PlayerY)Then PlayerDirection:=pUp;
  532.    kbDn:If AvailableDown(PlayerX,PlayerY)Then PlayerDirection:=pDown;
  533.    kbLeft:If AvailableLeft(PlayerX,PlayerY)Then PlayerDirection:=pLeft;
  534.    kbRight:If AvailableRight(PlayerX,PlayerY)Then PlayerDirection:=pRight;
  535.   End;
  536.  Until(K=kbEsc)or(Chr(Lo(K))in['q','Q']);
  537. End;
  538.  
  539. BEGIN
  540.  TextMode(CO40);
  541.  ClrScr;
  542.  CursorOff;
  543.  {$IFNDEF FPC}
  544.   LoadFont(234,0,16,1,@Font234);
  545.  {$ENDIF}
  546.  Screen:=InitialScreen;
  547.  HiScore:=0;
  548.  Live:=4;
  549.  Level:=1;
  550.  CountPilule:=0;
  551.  InitData;
  552.  DisplayNewBoard;
  553.  Play;
  554.  TextMode(CO80);
  555.  ClrScr;
  556.  CursorOn;
  557. END.

Code source

Voici le code source du jeu sur GitHub :

Lien Langage de programmation Projet
https://github.com/gladir/7iles/blob/main/PACMAN.PAS Turbo Pascal, Free Pascal 7iles


PARTAGER CETTE PAGE SUR
Dernière mise à jour : Jeudi, le 28 juillet 2022