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

Vous vous savez du fabuleux jeux soviétique «Tetris», succès incroyable des années 1980, où il faut placer des cubes afin de faire disparaître des lignes. Voici la version que j'avais inclus dans le MonsterBook et que j'ai adapté pour Turbo Pascal et son unité «Crt». Ainsi, il n'est nullement nécessaire de développer se jeu dans un écran graphique, tout peut être fait en écran de texte avec les performances nettement plus élevé que cela offre.

Lors du développement de la version original de ma version de jeu Tetris, que j'avais effectué sur mon Amdek System/88, afin d'avoir le délai le plus proche de la réalité, lors des mouvements des pièces, j'ai définit la procédure WaitRetrace. J'utilisais un délai de 1/60 de seconde définit par le signal de rafraîchissement retourner par le port 03DAh par les écrans et le standard des cartes vidéos CGA, MDA, EGA, VGA, toutefois avec les systèmes d'exploitation 32 bits comme OS/2 et Windows 95, cette possibilité de calculer l'intervalle de temps de façon fiable à disparu. J'ai donc remplacer l'appel de l'électronique beaucoup plus rapide et fiable par l'appel de la fonction DELAY fournit avec l'unité CRT. L'ennui sous DOS, c'est que a la procédure avec les machines anciennes (PC et XT), c'est que le temps ne peut pas être précisé avec plus de 1/18,2 par seconde, le problème en résultat que sur les vieilles machines, le mouvements du déplacements des pièces est toujours assez lent et que finalement lorsqu'on atteint un certain niveau, le temps d'attente en chaque pièce est toujours le même et que donc, plus le jeu est lent plus c'est facile d'augmenter son pointage et de résister longtemps à des niveau élevé.

La lecture des touches du clavier se faisait à l'origine avec l'interruption 16h, fonction 00h, car je voulais supporté la touche 5 du bloc numérique du clavier pour faire la rotation des pièces, et la fonction ReadKey de l'unité du Crt ne le supportait puisqu'elle est appelait l'interruption 21h du système d'exploitation MS-DOS de Microsoft. Ainsi, afin de rester au compatible avec les restrictions sous-évolutives futurs et le Free Pascal, j'ai dû me résigner à abandonner cette possibilité.

Par soucis de performance, les déplacements de bloc de mémoire utilisaient des routines MoveLeft ou MoveRight en langages machines de langage Assembleur 8086. Bien qu'il existait une routine Move dans le Turbo Pascal 7, dans les versions plus anciennes, il ne vérifiait pas si la copie des données étaient effectué à partir du début (MoveLeft) ou à partir de la fin (MoveRight). Cette technique étaient inspiré des routines MoveLeft et MoveRight du Apple Pascal pour les Apple II.

Le déplacement des zones des pièces (soit le défilement de l'écran), utilisait à l'origine la procédure MoveText proposé dans la bibliothèque de code que j'avais inclus dans le MonsterBook, lequel permettant également de faire des défilements autant horizontale que verticale, ne sont plus supporté. Malheureusement, les techniques utilisés dans cette routine passait directement par l'électronique et se de se fait, n'était plus compatible avec la technique proposé par les autres compilateurs Pascal, j'ai donc modifié la procédure pour qu'elle soit uniquement compatible avec l'unité Crt et ce jeu et elle ne supporte pas le défilement horizontale.

Le jeu est construit en quatre sections : soit l'initialisation (TetrisInit), le démarrage (TetrisStart), le rafraîchissement des données (TetrisRefresh) et le la partie jeu (TetrisPlay). Cette structure est essentiel, car, à l'origine, je voulais que le jeu soit intégrable dans un environnement avec de la programmation événementielle.

La partie TetrisPlay contient le moteur de jeu. Elle contient un tableau BlkFormat mémorisant la forme de chacune des pièces du jeu, soit les coordonnées de chacune des 4 parties d'une pièces. Afin de facilité le travaille de repérage, les tableaux BlkLength et BlkHeight contiennent respectivement la largeur et la hauteur de chacune des pièces du jeu. Une fois qu'on connaît les pièces du jeu, on les mettra dans le tableau «Q.Tbl» allant contenir chacune des pièces occupés dans le jeu Tetris. On sait déjà que le tableau du jeu contient 10 colonnes et 20 lignes et que chaque pièces contient 4 emplacements. Au bout d'un certain temps spécifié par WaitRetrace, on descend la pièce jusqu'à ce qu'elle touche un emplacement dans le tableau. Le délai WaitRetrace n'est pas diminuer par cette procédure mais par la variable Q.Speed, étant une simple boucle allant diminuer au furent et à mesure que le niveau augmente. Lorsqu'elle touche un emplacement, on doit parcourir les 20 lignes et tester chacune des lignes si les 10 emplacements sont occupés et si oui, on élimine toutes les lignes concerné et en déplace vers le bas chacune des pièces résultants. S'il n'est pas possible de descendre une pièce et que la fonction UpdateDate retourne FALSE, la partie est terminé. Lorsqu'on élimine les lignes, on additionne également le ligne accumulé, indiqué par la variable Q._Bar, et à chaque plateau de 16 lignes (calculer avec SHR 4 plutôt que DIV 16, car avec une machine fonctionnant à 4,77 Mhz, 200 cycles d'horloge de plus sur une puce Intel 8088, ça paraissait beaucoup), on augmente le niveau.

A l'aide du code source Pascal suivant pour le Turbo Pascal, vous trouvez la réponse que vous souhaitez :

  1. Program Tetris;
  2.  
  3. Uses Crt;
  4.  
  5. Const
  6.  {Code de touche clavier renvoy‚e par ReadKey}
  7.  kbNoKey=0;{Pas de touche}
  8.  kbEsc=$011B;{Escape}
  9.  kbUp=$4800;{Up}
  10.  kbLeft=$4B00;{FlŠche de gauche (Left)}
  11.  kbKeypad5=$4CF0;{5 du bloc num‚rique}
  12.  kbRight=$4D00;{FlŠche de droite (Right)}
  13.  kbDn=$5000;{FlŠche du bas (Down)}
  14.  
  15. Type
  16.  TetrisGame=Record
  17.   Mode:(tmNone,tmStart,tmPlay,tmGameOver);
  18.   Level:Byte;
  19.   Score:LongInt;
  20.   _Bar,SLevel:Word;
  21.   Tbl:Array[0..20,0..9]of Boolean;
  22.   Form,_Move,X,Y,Sleep:Byte;
  23.   Touch,Ok:Boolean;
  24.   SleepDelay:Byte;
  25.   FBar:Word;
  26.   UpDate:Boolean;
  27.  End;
  28.  
  29. Function  TetrisInit(Var Q:TetrisGame):Boolean;Forward;
  30. Procedure TetrisStart(Var Q:TetrisGame);Forward;
  31. Procedure TetrisRefresh(Var Q:TetrisGame);Forward;
  32. Function  TetrisPlay(Var Q:TetrisGame):Word;Forward;
  33.  
  34. Const
  35.  HomeX=15;
  36.  HomeY=2;
  37.  
  38. Procedure WaitRetrace;Begin
  39.  Delay(1000 div 60);
  40. End;
  41.  
  42. Procedure MoveRight(Const Source;Var Dest;_Length:LongInt);Begin
  43.  Move(Source,Dest,_Length);
  44. End;
  45.  
  46. Procedure TextAttr(Attr:Byte);Begin
  47.  TextColor(Attr and $F);
  48.  TextBackground(Attr shr 4);
  49. End;
  50.  
  51. Procedure MoveText(X1,Y1,X2,Y2,X3,Y3:Byte);Begin
  52.  Window(X1,Y1,X2,Y2+1);
  53.  If(Y3>Y1)Then Begin
  54.   GotoXY(1,1);
  55.   InsLine;
  56.  End
  57.   Else
  58.  Begin
  59.   GotoXY(1,1);
  60.   DelLine;
  61.  End;
  62.  Window(1,1,40,25);
  63. End;
  64.  
  65. Procedure BarSpcHor(X1,Y,X2:Byte);Begin
  66.  Window(X1,Y,X2,Y);
  67.  ClrScr;
  68.  Window(1,1,40,25);
  69. End;
  70.  
  71. Function TetrisInit(Var Q:TetrisGame):Boolean;Begin
  72.  FillChar(Q,SizeOf(Q),0);
  73.  Q.Level:=1;
  74.  Q.Mode:=tmStart;
  75. End;
  76.  
  77. Procedure TetrisStart(Var Q:TetrisGame);
  78. Var
  79.  I:Byte;
  80. Begin
  81.  FillChar(Q.Tbl,SizeOf(Q.Tbl),0);
  82.  FillChar(Q.Tbl[20],SizeOf(Q.Tbl[20]),Byte(True));
  83.  Q.Score:=0;Q._Bar:=0;Q.SleepDelay:=25;Q.Level:=Q.SLevel;
  84.  For I:=0to(Q.SLevel)do If Q.SleepDelay>6Then Dec(Q.SleepDelay,2);
  85.  Q.FBar:=Q.Level shl 4;
  86.  Q.Mode:=tmStart;
  87. End;
  88.  
  89. Procedure TetrisRefresh(Var Q:TetrisGame);
  90. Var
  91.  I,J:Byte;
  92. Begin
  93.  TextBackground(1+Q.Level);
  94.  ClrScr;
  95.  GotoXY(3,2);Write('Niveau:');
  96.  GotoXY(4,3);Write(Q.Level);
  97.  GotoXY(3,5);Write('Pointage:');
  98.  GotoXY(4,6);Write('0');
  99.  GotoXY(3,8);Write('Ligne:');
  100.  GotoXY(4,9);Write(Q._Bar);
  101.  Window(HomeX,HomeY,HomeX+9,HomeY+19);
  102.  TextBackground(Black);
  103.  ClrScr;
  104.  Window(1,1,40,25);
  105.  If(Q.Mode)in[tmPlay,tmGameOver]Then Begin
  106.   For J:=0to 19do For I:=0to 9do If Q.Tbl[J,I]Then Begin
  107.    GotoXY(HomeX+I,HomeY+J);Write('þ');
  108.   End;
  109.  End;
  110. End;
  111.  
  112. Function TetrisPlay(Var Q:TetrisGame):Word;Label _Exit;Const
  113.       BlkHeight:Array[0..6,0..3]of Byte=(
  114.        (4,1,4,1), { Barre }
  115.        (2,2,2,2), { BoŒte }
  116.        (3,2,3,2), { V }
  117.        (3,2,3,2), { L gauche }
  118.        (3,2,3,2), { L droite }
  119.        (3,2,3,2), { Serpent romain }
  120.        (3,2,3,2));{ Serpent arabe }
  121.       BlkLength:Array[0..6,0..3]of Byte=( {Largeur des objets:}
  122.        (1,4,1,4), { Barre }
  123.        (2,2,2,2), { BoŒte }
  124.        (2,3,2,3), { V }
  125.        (2,3,2,3), { L gauche }
  126.        (2,3,2,3), { L droite }
  127.        (2,3,2,3), { Serpent romain }
  128.        (2,3,2,3));{ Serpent arabe }
  129.       BlkFormat:Array[0..6,0..3,0..3]of Record X,Y:Byte;End=(
  130.        (((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:0;Y:3)),   { þþþþ }
  131.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0)),
  132.         ((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:0;Y:3)),
  133.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0))),
  134.        (((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),   { þþ }
  135.         ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),   { þþ }
  136.         ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),
  137.         ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1))),
  138.        (((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),   { þþþ }
  139.         ((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:2;Y:1)),   { þ }
  140.         ((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),
  141.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:1;Y:1))),
  142.        (((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:1;Y:2)),
  143.         ((X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:2;Y:0)),   { þ }
  144.         ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:1;Y:2)),   { þ }
  145.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:0;Y:1))),  { þþ }
  146.        (((X:1;Y:0),(X:1;Y:1),(X:1;Y:2),(X:0;Y:2)),
  147.         ((X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:0;Y:0)),   { þ }
  148.         ((X:1;Y:0),(X:0;Y:0),(X:0;Y:1),(X:0;Y:2)),   { þ }
  149.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:2;Y:1))),  { þþ }
  150.        (((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),
  151.         ((X:1;Y:0),(X:2;Y:0),(X:0;Y:1),(X:1;Y:1)),
  152.         ((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),
  153.         ((X:1;Y:0),(X:2;Y:0),(X:0;Y:1),(X:1;Y:1))),
  154.        (((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),
  155.         ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:2;Y:1)),
  156.         ((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),   {þþ }
  157.         ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:2;Y:1)))); { þþ }
  158. Var
  159.  I,J,H,XT:Byte;
  160.  XJ,YJ,K:Word;
  161.  Touch,Ok,NoAction:Boolean;
  162.  
  163.  Procedure PutForm(Clr:Boolean);
  164.  Var
  165.   Chr:Char;
  166.   I,Attr,X,Y:Byte;
  167.  Begin
  168.   X:=HomeX+Q.X;
  169.   Y:=HomeY+Q.Y;
  170.   If(Clr)Then Begin
  171.    Chr:=' ';Attr:=7;
  172.   End
  173.    Else
  174.   Begin
  175.    Chr:='þ';Attr:=$71+Q.Form;
  176.   End;
  177.   For I:=0to 3do Begin
  178.    GotoXY(HomeX+Q.X+BlkFormat[Q.Form,Q._Move,I].X,
  179.                             HomeY+Q.Y+BlkFormat[Q.Form,Q._Move,I].Y);
  180.    TextAttr(Attr);
  181.    Write(Chr);
  182.    TextAttr(7);
  183.   End;
  184.  End;
  185.  
  186.  Procedure Init;Begin
  187.   Q.Form:=Random(6);
  188.   If Q.Form=5Then Inc(Q.Form,Random(2));
  189.   Q.X:=5;Q.Y:=0;
  190.   Q._Move:=0;Q.Sleep:=0;
  191.   PutForm(False);
  192.  End;
  193.  
  194.  Function UpDateData:Boolean;
  195.  Var
  196.   H,I,J,JK:Byte;
  197.   Bonus:Byte;
  198.   LnChk:Boolean;
  199.  Begin
  200.   UpDateData:=True;Q.Sleep:=0;
  201.   PutForm(False);
  202.   Touch:=False;Ok:=False;
  203.   PutForm(True);
  204.   Inc(Q.Y);
  205.   For I:=0to 3do Begin
  206.    Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,Q._Move,I].Y,Q.X+BlkFormat[Q.Form,Q._Move,I].X];
  207.   End;
  208.   If(Touch)Then Dec(Q.Y);
  209.   PutForm(False);
  210.   If(Touch)Then Begin
  211.    While(Q.Sleep>Q.SleepDelay)do Dec(Q.Sleep);
  212.    Q.Sleep:=0;Ok:=True;
  213.    For I:=0to 3do Q.Tbl[Q.Y+BlkFormat[Q.Form,Q._Move,I].Y,Q.X+BlkFormat[Q.Form,Q._Move,I].X]:=True;
  214.    If Q.Level>7Then Begin
  215.     Inc(Q.Score,LongInt(5)*Q.Level);
  216.     GotoXY(4,6);Write(Q.Score);
  217.    End;
  218.    Bonus:=0;
  219.    For J:=0to 19do Begin
  220.     Touch:=True;
  221.     For I:=0to 9do Touch:=Touch and Q.Tbl[J,I];
  222.     If(Touch)Then Inc(Bonus);
  223.    End;
  224.    If Bonus>0Then Dec(Bonus);
  225.    Touch:=False;
  226.    For JK:=0to 7do Begin
  227.     For J:=0to 19do Begin
  228.      LnChk:=True;
  229.      For I:=0to 9do LnChk:=LnChk and Q.Tbl[J,I];
  230.      If(LnChk)Then Begin
  231.       If Not(Touch)Then Begin
  232.        Touch:=True;
  233.       End;
  234.       If JK and 1=0Then TextAttr($FF)
  235.                    Else TextAttr(7);
  236.       BarSpcHor(HomeX,HomeY+J,HomeX+9);
  237.      End;
  238.     End;
  239.     WaitRetrace;WaitRetrace;WaitRetrace;
  240.    End;
  241.    For J:=0to 19do Begin
  242.     Touch:=True;
  243.     For I:=0to 9do Touch:=Touch and Q.Tbl[J,I];
  244.     If(Touch)Then Begin
  245.      MoveRight(Q.Tbl[0,0],Q.Tbl[1,0],10*J);
  246.      FillChar(Q.Tbl[0,0],10,0);
  247.      MoveText(HomeX,HomeY,HomeX+9,HomeY+J-1,HomeX,HomeY+1);
  248.      Inc(Q.Score,LongInt(5)+(Bonus*4)*(Q.Level+1)+10*Q.Level); Inc(Q._Bar);
  249.      GotoXY(4,6);Write(Q.Score);
  250.      GotoXY(4,9);Write(Q._Bar);
  251.      I:=(Q._Bar+Q.FBar)shr 4;
  252.      If(Q.Level<>I)Then Begin
  253.       Q.Level:=I;
  254.       GotoXY(4,3);Write(Q.Level+1);
  255.       If Q.SleepDelay>6Then Dec(Q.SleepDelay,2);
  256.      End;
  257.     End;
  258.    End;
  259.    If Q.Y<=1Then Begin
  260.     UpDateData:=False;
  261.     Exit;
  262.    End;
  263.    Init;
  264.   End;
  265.  End;
  266.  
  267.  Function GameOver:Word;Begin
  268.   GotoXY(10,7);Write('Partie Terminer');
  269.   If(Q.UpDate)Then Begin
  270.    Q.UpDate:=False;
  271.   End;
  272.   GameOver:=kbEsc;
  273.  End;
  274.  
  275. Begin
  276.  TextMode(CO40);
  277.  TetrisRefresh(Q);
  278.  K:=0;
  279.  Repeat
  280.   Case(Q.Mode)of
  281.    tmStart:Begin
  282.     TetrisStart(Q);
  283.     TetrisRefresh(Q);
  284.     Init;
  285.     Q.Mode:=tmPlay;Q.UpDate:=True;
  286.    End;
  287.    tmPlay:Repeat
  288.     Begin
  289.      Repeat
  290.       If(Q.Sleep>Q.SleepDelay)Then If Not(UpDateData)Then Begin
  291.        Q.Mode:=tmGameOver;
  292.        Goto _Exit;
  293.       End;
  294.       WaitRetrace;
  295.       Inc(Q.Sleep);
  296.      Until KeyPressed;
  297.      K:=Byte(ReadKey);
  298.      If K=0Then K:=K or (Byte(ReadKey)shl 8);
  299.     End;
  300.     If Chr(K)='2'Then K:=kbDn;
  301.     If Chr(K)='4'Then K:=kbLeft;
  302.     If Chr(K)='6'Then K:=kbRight;
  303.     NoAction:=False;
  304.     Case(K)of
  305.      kbLeft:If Q.X>0Then Begin
  306.       Touch:=False;
  307.       For I:=0to 3do Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,Q._Move,I].Y,Q.X+BlkFormat[Q.Form,Q._Move,I].X-1];
  308.       If Not(Touch)Then Begin
  309.        PutForm(True);
  310.        Dec(Q.X);
  311.        PutForm(False);
  312.       End;
  313.      End;
  314.      kbRight:If Q.X+BlkLength[Q.Form,Q._Move]-1<9Then Begin
  315.       Touch:=False;
  316.       For I:=0to 3do Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,Q._Move,I].Y,Q.X+BlkFormat[Q.Form,Q._Move,I].X+1];
  317.       If Not(Touch)Then Begin
  318.        PutForm(True);
  319.        Inc(Q.X);
  320.        PutForm(False);
  321.       End;
  322.      End;
  323.      kbDn:While(True)do Begin
  324.       If Not(UpDateData)Then Begin
  325.        Q.Mode:=tmGameOver;
  326.        Goto _Exit;
  327.       End;
  328.       If(Ok)Then Break;
  329.      End;
  330.      Else NoAction:=True;
  331.     End;
  332.     If(NoAction)Then Begin
  333.      If(K=kbKeyPad5)or(Char(K)in[' ','5'])Then Begin
  334.       Touch:=False;
  335.       For I:=0to 3do Begin
  336.        XT:=Q.X+BlkFormat[Q.Form,(Q._Move+1)and 3,I].X; Touch:=Touch or(XT>9);
  337.        Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,(Q._Move+1)and 3,I].Y,XT];
  338.       End;
  339.       If Not(Touch)Then Begin
  340.        PutForm(True);
  341.        Q._Move:=(Q._Move+1)and 3;
  342.        PutForm(False)
  343.       End
  344.        Else
  345.       Begin
  346.        Touch:=False;
  347.        For I:=0to 3do Begin
  348.         XT:=Q.X;
  349.         If XT>0Then Dec(XT);
  350.         Inc(XT,BlkFormat[Q.Form,(Q._Move+1)and 3,I].X); Touch:=Touch or(XT>9);
  351.         Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,(Q._Move+1)and 3,I].Y,XT];
  352.        End;
  353.        If Not(Touch)Then Begin
  354.         PutForm(True);
  355.         Dec(Q.X); Q._Move:=(Q._Move+1)and 3;
  356.         PutForm(False);
  357.        End;
  358.       End;
  359.      End
  360.       Else
  361.      Break;
  362.     End;
  363.    Until(K=kbEsc)or(Chr(K)='Q');
  364.    tmGameOver:K:=GameOver;
  365.   End;
  366. _Exit:
  367.   If K<>0Then Break;
  368.  Until False;
  369.  TetrisPlay:=K;
  370. End;
  371.  
  372. Var
  373.  Game:TetrisGame;
  374.  
  375. BEGIN
  376.  TetrisInit(Game);
  377.  TetrisPlay(Game);
  378. END.

Code source

Voici le code source du jeu sur GitHub :

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


PARTAGER CETTE PAGE SUR
Dernière mise à jour : Dimanche, le 17 janvier 2016