Langage de programmation - Turbo Pascal - Jeux & Stratégies

La Patience, est un jeu de carte, dont il existe de très nombreuses variantes. Cette version repose sur 4 tas et un tas pour le reste des cartes dans lequel on tourne trois cartes à la fois afin d'offrir la possibilité au jour de faire avancé ses 4 mains. Le jeu se termine lorsque vos 4 mains sont pleins.

Contrairement à d'autres jeu, les symboles ASCII des cartes sont supportés (Coeur, Piques, Carreau, Trèfle) par la police de caractères. Ainsi, l'utilisation d'un écran de texte permettra d'afficher les cartes et leur jeu avec plus de clarté. Cependant, le valet, la reine et le roi n'auront pas de dessin car l'écran de texte le supporte pas. Malheureusement, bien que l'écran de texte soit excellente pour jouer a des jeux de cartes, la limite de 25 lignes est parfois assez pénible, il est donc préférable de faire passer le jeu en mode 80x43 ou 80x50 caractères pour avoir plus de place. Aussi, dans un jeu de carte pour ordinateur, le joueur ne pas fait que très peu d'action, ainsi, le trois/quatre du programme sont soit une validation que les coups sont possible et l'autre, c'est de se promener dans un tableau contenant l'ensemble des cartes à jouer.

Lorsqu'on tire une carte au hasard (à l'aide de la fonction XtrkCard), on ne choisis pas un nombre au hasard dans les 52 cartes, on choisit une position dans un jeu de carte indiqué par la chaîne de caractères (Card) contenant une chaîne de caractères avec les cartes restante. De cette façon, si par un curieux hasard, la fonction sortirait deux fois le même nombre, il n'y a pas de risque d'avoir deux fois la même carte à jouer.

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




Program Patience;

 
Uses Crt,Strings;

 
Function Left(Const Str:String;Num:Byte):String;Begin

 Left:=Copy(Str,1,Num);

End;

 
Procedure DelChrAt(Var S:String;P:Byte);Begin

 If P=1Then S:=Copy(S,2,255)

       Else S:=Left(S,P-1)+Copy(S,P+1,255)

End;

 
Procedure StrDel(Str:PChar;Start,Len:Word);

Var

 SL:Word;

Begin

 SL:=StrLen(Str);

 If(SL=0)or(Start>SL)Then Exit;

 If SL=1Then Str[0]:=#0

  Else

 Begin

  If(Start<>SL)Then Move(Str[Start+Len],Str[Start],SL-Start);

  Str[SL]:=#0;

 End;

End;

 
Procedure Play;

Const

 HomeX=4; HomeY=3;

 CardImg:Array[0..52,0..4]of String[5]=(

  ('     ','     ','     ','     ','     '),

  ('A    ','     ','  '#3'  ','     ','    A'),

  ('2 '#3'  ',#3'    ','     ','    '#3,'  '#3' 2'),

  ('3 '#3'  ',#3'    ','  '#3'  ','    '#3,'  '#3' 3'),

  ('4    ',' '#3' '#3' ','     ',' '#3' '#3' ','    4'),

  ('5    ',' '#3' '#3' ','  '#3'  ',' '#3' '#3' ','    5'),

  ('6    ',' '#3' '#3' ',' '#3' '#3' ',' '#3' '#3' ','    6'),

  ('7    ',' '#3' '#3' ',' '#3#3#3' ',' '#3' '#3' ','    7'),

  ('8    ',' '#3#3#3' ',' '#3#3#3' ',' '#3' '#3' ','    8'),

  ('9    ',' '#3#3#3' ',' '#3#3#3' ',' '#3#3#3' ','    9'),

  ('10   ',#3#3#3#3#3,'     ',#3#3#3#3#3,'   10'),

  ('J    ',#3'UUU ',' UUU ',' UUU'#3,'    J'),

  ('Q    ',#3'UUU ',' UUU ',' UUU'#3,'    Q'),

  ('K    ',#3'UUU ',' UUU ',' UUU'#3,'    K'),

  ('A    ','     ','  '#6'  ','     ','    A'),

  ('2 '#6'  ',#6'    ','     ','    '#6,'  '#6' 2'),

  ('3 '#6'  ',#6'    ','  '#6'  ','    '#6,'  '#6' 3'),

  ('4    ',' '#6' '#6' ','     ',' '#6' '#6' ','    4'),

  ('5    ',' '#6' '#6' ','  '#6'  ',' '#6' '#6' ','    5'),

  ('6    ',' '#6' '#6' ',' '#6' '#6' ',' '#6' '#6' ','    6'),

  ('7    ',' '#6' '#6' ',' '#6#6#6' ',' '#6' '#6' ','    7'),

  ('8    ',' '#6#6#6' ',' '#6#6#6' ',' '#6' '#6' ','    8'),

  ('9    ',' '#6#6#6' ',' '#6#6#6' ',' '#6#6#6' ','    9'),

  ('10   ',#6#6#6#6#6,'     ',#6#6#6#6#6,'   10'),

  ('J    ',#6'UUU ',' UUU ',' UUU'#6,'    J'),

  ('Q    ',#6'UUU ',' UUU ',' UUU'#6,'    Q'),

  ('K    ',#6'UUU ',' UUU ',' UUU'#6,'    K'),

  ('A    ','     ','  '#4'  ','     ','    A'),

  ('2 '#4'  ',#4'    ','     ','    '#4,'  '#4' 2'),

  ('3 '#4'  ',#4'    ','  '#4'  ','    '#4,'  '#4' 3'),

  ('4    ',' '#4' '#4' ','     ',' '#4' '#4' ','    4'),

  ('5    ',' '#4' '#4' ','  '#4'  ',' '#4' '#4' ','    5'),

  ('6    ',' '#4' '#4' ',' '#4' '#4' ',' '#4' '#4' ','    6'),

  ('7    ',' '#4' '#4' ',' '#4#4#4' ',' '#4' '#4' ','    7'),

  ('8    ',' '#4#4#4' ',' '#4#4#4' ',' '#4' '#4' ','    8'),

  ('9    ',' '#4#4#4' ',' '#4#4#4' ',' '#4#4#4' ','    9'),

  ('10   ',#4#4#4#4#4,'     ',#4#4#4#4#4,'   10'),

  ('J    ',#4'UUU ',' UUU ',' UUU'#4,'    J'),

  ('Q    ',#4'UUU ',' UUU ',' UUU'#4,'    Q'),

  ('K    ',#4'UUU ',' UUU ',' UUU'#4,'    K'),

  ('A    ','     ','  '#5'  ','     ','    A'),

  ('2 '#5'  ',#5'    ','     ','    '#5,'  '#5' 2'),

  ('3 '#5'  ',#5'    ','  '#5'  ','    '#5,'  '#5' 3'),

  ('4    ',' '#5' '#5' ','     ',' '#5' '#5' ','    4'),

  ('5    ',' '#5' '#5' ','  '#5'  ',' '#5' '#5' ','    5'),

  ('6    ',' '#5' '#5' ',' '#5' '#5' ',' '#5' '#5' ','    6'),

  ('7    ',' '#5' '#5' ',' '#5#5#5' ',' '#5' '#5' ','    7'),

  ('8    ',' '#5#5#5' ',' '#5#5#5' ',' '#5' '#5' ','    8'),

  ('9    ',' '#5#5#5' ',' '#5#5#5' ',' '#5#5#5' ','    9'),

  ('10   ',#5#5#5#5#5,'     ',#5#5#5#5#5,'   10'),

  ('J    ',#5'UUU ',' UUU ',' UUU'#5,'    J'),

  ('Q    ',#5'UUU ',' UUU ',' UUU'#5,'    Q'),

  ('K    ',#5'UUU ',' UUU ',' UUU'#5,'    K'));

 BackKr=$2B;

Var

 Card:String;

 H,I,J,Y,StackPos:Byte;

 Stack4:Array[0..3,0..2]of Byte;

 Bank4:Array[0..3,0..13]of Byte;

 Stack:Array[0..39]of Byte;

 K:Char;

 B:Word;

 MX,MY:Byte;

 
 Function XtrkCard:Byte;Var R:Byte;Begin

  R:=Random(Length(Card))+1;

  XtrkCard:=Byte(Card[R]);

  DelChrAt(Card,R);

 End;

 
 Procedure PutCard(X,Y:Byte;Card:Byte);Var J,Kr:Byte;Begin

  If Card>52Then Begin Card:=0; Kr:=$10;End Else

  If Card=0Then Kr:=BackKr Else

  If Card in[1..13,27..39]Then Kr:=$FC Else Kr:=$F0;

  For J:=0to 4do Begin

   TextBackground(Kr shr 4);

   TextColor(Kr and $F);

   GotoXY(HomeX+X,HomeY+Y+J);

   Write(CardImg[Card,J]);

  End;

 End;

 
 Function Sort(Card:Byte):Byte;Begin

  If Card=0Then Sort:=$FF Else Sort:=(Card-1)div 13;

 End;

 
 Function Num(Card:Byte):Byte;Begin

  If Card=0Then Num:=$FF Else Num:=(Card-1)mod 13;

 End;

 
 Procedure UpDateStack4;Begin

  Stack4[Y,I]:=0;

  If I>0Then Dec(I);

  PutCard(2,Y*6,Stack4[Y,I]);

 End;

 
 Procedure Stack42Bank4;Var H:Byte;Begin

  H:=0; While Bank4[J,H]<>0do Inc(H);

  Bank4[J,H]:=Stack4[Y,I];

  PutCard(10+H*4,J*6,Bank4[J,H]);

  UpdateStack4;

 End;

 
 Procedure UpdateStack;Var I,J:Byte;Begin

  If StackPos<3Then J:=0 Else J:=StackPos-3;

  For I:=0to 2do PutCard(27+I shl 2,25,Stack[J+I]);

  If I<2Then Begin

   TextBackground(BackKr shr 4);

   Window(HomeX+28+(I+1)shl 2,HomeY+25,79,HomeY+30);

   ClrScr;

   Window(1,1,Lo(WindMax),Hi(WindMax));

  End;

 End;

 
 Procedure Stack2Bank4;Var H:Byte;Begin

  H:=0; While Bank4[J,H]<>0do Inc(H);

  Bank4[J,H]:=Stack[I];

  StrDel(@Stack,I,1);

  PutCard(10+H*4,J*6,Bank4[J,H]);

  If StackPos>0Then Dec(StackPos);

  UpdateStack;

 End;

 
Begin

 Card[0]:=#52;

 For I:=1to 52do Card[I]:=Char(I);

 For J:=0to 2do For I:=0to 3do Stack4[I,J]:=XtrkCard;

 FillChar(Bank4,SizeOf(Bank4),0);

 Bank4[0,0]:=XtrkCard;

 StackPos:=0;

 For I:=0to 38do Stack[I]:=XtrkCard;

 Stack[39]:=0;

 GotoXY(30,1);

 TextColor($F);

 Write('Aux Cartes - La Patience');

 TextBackground(BackKr shr 4);

 Window(1+0,1+2,1+Lo(WindMax),1+Hi(WindMax)-7);

 ClrScr;

 Window(1,1,Lo(WindMax),Hi(WindMax));

 For I:=0to 3do Begin

  TextBackground(BackKr shr 4);

  GotoXY(HomeX,HomeY+2+I*6);

  Write(Chr(I+49));

  PutCard(2,I*6,Stack4[I,2]);

 End;

 PutCard(10,0,Bank4[0,0]);

 PutCard(20,25,$FF);

 For I:=0to 1do Begin

  TextBackground(BackKr shr 4);

  GotoXY(HomeX+22+I*7,HomeY+32);

  Write(Chr(I+53));

 End;

 Repeat

  K:=ReadKey;

  Case K of

   '1'..'4':Begin

    Y:=Byte(K)-49;

    For I:=2downto 0do If Stack4[Y,I]<>0Then Break;

    If Stack4[Y,I]<>0Then Begin

    If Num(Stack4[Y,I])=Num(Bank4[0,0])Then Begin

     For J:=0to 3do If Bank4[J,0]=0Then Begin

      Bank4[J,0]:=Stack4[Y,I];

      PutCard(10,J*6,Bank4[J,0]);

      UpdateStack4;

      Break;

     End;

    End

     Else

    Begin

     For J:=0to 3do If Sort(Bank4[J,0])=Sort(Stack4[Y,I])Then Begin

      If J=0Then Stack42Bank4 Else

      For H:=0to 12do If Num(Bank4[J-1,H])=Num(Stack4[Y,I])Then Begin

       Stack42Bank4;

       Break;

      End;

     End;

    End;

    End;

   End;

   '5':Begin

    If Stack[StackPos]=0Then StackPos:=0;

    For I:=0to 2do Begin

     If Stack[StackPos]=0Then Break;

     PutCard(27+I shl 2,25,Stack[StackPos]);

     Inc(StackPos);

    End;

    If I<2Then Begin

     TextBackground(0);

     TextColor(7);

     Window(HomeX+28+(I+1)shl 2,HomeY+25,79,HomeY+30);

     ClrScr;

     Window(1,1,Lo(WindMax),Hi(WindMax));

    End;

   End;

   '6':Begin

    I:=StackPos;

    If I>0Then Dec(I);

    If Stack[I]<>0Then Begin

    If Num(Stack[I])=Num(Bank4[0,0])Then Begin

     For J:=0to 3do If Bank4[J,0]=0Then Begin

      Bank4[J,0]:=Stack[I];

      StrDel(@Stack,I,1);

      PutCard(10,J*6,Bank4[J,0]);

      If StackPos>0Then Dec(StackPos);

      UpdateStack;

      Break;

     End;

    End

     Else

    Begin

     For J:=0to 3do If Sort(Bank4[J,0])=Sort(Stack[I])Then Begin

      If J=0Then Stack2Bank4 Else

      For H:=0to 12do If Num(Bank4[J-1,H])=Num(Stack[I])Then Begin

       Stack2Bank4;

       Break;

      End;

     End;

    End;

    End;

   End;

  End;

  If(Bank4[0,12]>0)and(Bank4[1,12]>0)and(Bank4[2,12]>0)and(Bank4[3,12]>0)Then Begin

   GotoXY(24,24);

   Write('Vous avez gagnez!!!!!!!!');

   Break;

  End;

 Until K in[#27,'q','Q'];

End;

 
BEGIN

 TextMode(C80+Font8x8);

 Randomize;

 ClrScr;

 Play;

END.

Code source

Voici le code source du jeu sur GitHub :

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

PARTAGER CETTE PAGE SUR

Dernière mise à jour : Jeudi, le 28 juillet 2022

	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)

	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

	CIL
	Jasmin
	LLVM
	MSIL
	Parrot
	P-Code (PCode)
	SWEET16

	ASP 1.0
	ASP 2.0
	ASP 3.0
	ASP.NET

	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

Section courante

A propos

Section administrative du site

Code source

	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

	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++

	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)

	Btrieve
	Cassandra
	Clipper
	CouchDB
	dBASE
	Hbase
	Hypertable
	MongoDB
	Redis

	Access
	BigQuery
	DB2
	H2
	Interbase
	MySQL
	Oracle
	PostgreSQL
	SAP HANA
	SQL Server
	Sybase
	U-SQL

	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

	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)

	GNAT
	SMALLAda
	VHDL

	ASSEMBLER/MONITOR 64
	Micol Assembler

	A86
	MASM (Macro Assembler)
	TASM (Turbo Assembler)

	BeckerBASIC
	SIMONS' BASIC

	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

	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

	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

	Année bissextile
	Calendrier
	Date de la Pâque
	FirstDayOfMonth
	Horloge à aiguille

	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

	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

	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