Procedure HidTxtCur;
 Begin InLine($cd/$fc5a/$bb7e); End;

{ =================================================
   UGraph : Unite graphique CPC6128 v0.1 - GC 2020
  ------------------------------------------------- }

Const TagFlag : Boolean = False;
      TagAddr : Integer = 0;
Var BGraph:Byte; IGraph1,IGraph2:Integer;

Procedure SetTxtCur(X,Y:Byte);
Begin InLine($3a/X/$67/$3a/Y/$6f/$cd/$fc5a/$bb75); End;

Procedure GetTxtCur(Var X,Y:Byte);
Begin InLine($cd/$fc5a/$bb78/$7c/$32/X/$7d/$32/Y); End;

Procedure DspTxtCur;
Begin InLine($cd/$fc5a/$bb7b); End;

Procedure HidTxtCur;
Begin InLine($cd/$fc5a/$bb7e); End;

Procedure SetTxtPap(Paper:byte);
Begin InLine($3a/Paper/$cd/$fc5a/$bb96); End;

Procedure SetTxtPen(Pen:byte);
Begin InLine($3a/Pen/$cd/$fc5a/$bb90); End;

Procedure IniGra;
Begin InLine($cd/$fc5a/$bbba);End;

Procedure SetMod(Mode:Byte);
Begin InLine($3a/Mode/$cd/$fc5a/$bc0e); End;

Function EncInk(InkNumber:Byte):Byte;
Begin
 InLine($3a/InkNumber/$cd/$fc5a/$bc2c/$32/BGraph);
 EncInk:=BGraph;
End;

Procedure SetInk(Ink,C1,C2:Byte);
Begin InLine($3a/C1/$47/$3a/C2/$4f/$3a/Ink/$cd/$fc5a/$bc32); End;

Procedure SetBdr(C1,C2:Byte);
Begin InLine($3a/C1/$47/$3a/C2/$4f/$cd/$fc5a/$bc38); End;

Procedure DrwScrFldBox(EncodedInk:Byte; Adr:Integer; WidthBytes,Height:Byte);
Begin
 InLine($3a/EncodedInk/$4f/$2A/Adr/$3a/WidthBytes/$57/$3a/Height/$5f/$cd/$fc5a/$bc47);
End;

Procedure DrwScrHorLin(EncodedInk:Byte; XStart,XEnd,Y:Integer);
Begin
 Inline($3a/EncodedInk/$ed/$5b/XStart/$ed/$4b/XEnd/$2a/Y/$cd/$fc5a/$bc5f);
End;

Procedure DrwScrVerLin(EncodedInk:Byte; YStart,YEnd,X:Integer);
Begin
 Inline($3a/EncodedInk/$ed/$5b/X/$ed/$4b/YEnd/$2a/YStart/$cd/$fc5a/$bc62);
End;

Procedure GetScrDotAdr(X,Y:Integer; Var Addr:Integer; Var Mask:Byte);
Begin
 InLine($ed/$5b/X/$2a/Y/$cd/$fc5a/$bc1d/$22/IGraph1/$79/$32/BGraph);
 Addr:=IGraph1; Mask:=BGraph;
End;

Procedure MovAbs(x,y:Integer);
Begin InLine($2a/x/$eb/$2a/y/$cd/$fc5a/$bbc0) End;

Procedure MovRel(x,y:Integer);
Begin InLine($2a/x/$eb/$2a/y/$cd/$fc5a/$bbc3) End;

Procedure SetOrg(x,y:Integer);
Begin InLine($2a/x/$eb/$2a/y/$cd/$fc5a/$bbc9) End;

Procedure SetWinWdt(x1,x2:Integer);
Begin inline($2a/x2/$eb/$2a/x1/$cd/$fc5a/$bbcf) End;

Procedure SetWinHht(y1,y2:Integer);
Begin InLine($2a/y2/$eb/$2a/y1/$cd/$fc5a/$bbd2) End;

Procedure DrwLinAbs(x,y:Integer);
Begin InLine($2a/x/$eb/$2a/y/$cd/$fc5a/$bbf6) End;

Procedure DrwLinRel(x,y:Integer);
Begin InLine($2a/x/$eb/$2a/y/$cd/$fc5a/$bbf9) End;

Procedure DrwPntAbs(x,y:Integer);
Begin InLine($00/$ed/$ff/$2A/x/$eb/$2A/y/$cd/$fc5a/$bbea/$ed/$ff) End;

Procedure DrwPntRel(x,y:Integer);
Begin InLine($2A/x/$eb/$2a/y/$cd/$fc5a/$bbed) End;

Function GetPntAbs(x,y:Integer):Byte;
Begin InLine($2a/x/$eb/$2a/y/$cd/$fc5a/$bbf0/$32/BGraph);
      GetPntAbs:=BGraph;
End;

Function GetPntRel(x,y:Integer):Byte;
Begin InLine($2a/x/$eb/$2a/y/$cd/$fc5a/$bbf3/$32/BGraph);
      GetPntRel:=BGraph;
End;

Procedure SetGraPen(Pen:Byte);
Begin InLine($3a/Pen/$cd/$fc5a/$bbde) End;

Procedure SetGraPap(Paper:Byte);
Begin InLine($3A/Paper/$cd/$fc5a/$bbe4) End;

Procedure GetGraCur(Var X,Y:Integer);
Begin
 InLine($cd/$fc5a/$bbc6/$22/IGraph2/$eb/$22/IGraph1);
 X:=IGraph1; Y:=IGraph2;
End;

Procedure ClrGraWin;
Begin InLine($cd/$fc5a/$bbdb) End;

Procedure DrwGraChr(Ch:char);
Begin InLine($3a/Ch/$cd/$fc5a/$bbfc) End;

Procedure SetLinMsk(Mask:Byte);
Begin InLine($3A/Mask/$cd/$fc5a/$bd4c) End;

Procedure SetPalMod1(c0,c1,c2,c3:Byte);
Begin
 SetInk(0,c0,c0);SetInk(1,c1,c1);SetInk(2,c2,c2);SetInk(3,c3,c3);
End;

Procedure DrwScrRec(E:Byte; x1,y1,x2,y2:Integer);
Begin
 DrwScrHorLin(E,x1,x2,y1);
 DrwScrHorLin(E,x1,x2,y2);
 DrwScrVerLin(E,y1,y2,x1);
 DrwScrVerLin(E,y1,y2,x2);
End;

Procedure SetTxtWin(c1,c2,l1,l2:Byte);
Begin
 InLine($3a/c1/$67/$3a/c2/$57/$3a/l1/$6f/$3a/l2/$5f/$cd/$fc5a/$bb66);
End;

Procedure GrafOut(ch:Char);
Begin
  InLine($3a/ch/$cd/$fc5a/$bbfc);
End;

Procedure SetTag;
Begin
  If Not TagFlag Then Begin
   TagAddr:=ConOutPtr; TagFlag:=True; ConOutPtr:=Addr(GrafOut);
  End;
End;

Procedure RmvTag;
Begin
  If TagFlag Then Begin
    ConOutPtr:=TagAddr; TagFlag:=False;
  End;
End;

Program Cavalcade;
{$i Ugraph.inc}

Type TCoord=Record
        x,y: Integer;
      End;

Const Dep: Array[1..8] Of TCoord =
           ((x: 1;y: 2),(x: 2;y: 1),(x: 2;y:-1),(x: 1;y:-2),
            (x:-1;y:-2),(x:-2;y:-1),(x:-2;y: 1),(x:-1;y: 2));

Var x,y,i,j,Adr,Err: Integer;
    b,E0,E1,E2,E3,Mini,iMini,Total: Byte;
    PCav, nPCav: TCoord;
    Echiquier:Array[-1..10,-1..10] Of Boolean;
    Rep : String[2];

Begin
 PCav.x:=0;
 Repeat
  For i:=-1 To 10 Do
   For j:=-1 To 10 Do
    If (i In [1..8]) And (j In [1..8])
     Then Echiquier[i,j]:=True
     Else Echiquier[i,j]:=False;

  {Dessin de l'echiquier et fenetre resultat}
  SetPalMod1(1,1,1,1);
  SetBdr(1,1); SetMod(1);
  E0:=EncInk(0);E1:=EncInk(1); E2:=EncInk(2); E3:=EncInk(3);
  DrwScrRec(E3,19,20,180,181); DrwScrRec(E3,18,19,181,182);
  GetScrDotAdr(20,180,Adr,b); DrwScrFldBox(E1,Adr,40,160);
  For y:=1 To 8 Do
   For x:=1 To 8 Do Begin
    GetScrDotAdr(20*x,200-20*y,Adr,b);
    If (x Mod 2<>y Mod 2) Then DrwScrFldBox(E2,Adr,5,20)
   End;
  SetPalMod1(1,13,26,0);
  SetTag;
   SetGraPen(2);
   For x:=1 To 8 Do Begin
     MovAbs(16+x*40,30); Write(Char(x+64));
     MovAbs(14,30+x*40); Write(x);
   End;
  RmvTag;
  HidTxtCur;

  SetTxtWin(24,39,2,20); GotoXY(1,1);
  IF PCav.x<>0 Then Begin

  {Resolution}

   Echiquier[PCav.x,PCav.y]:=False;
   DrwScrRec(E3,7+20*PCav.x, 7+20*PCav.y,13+20*PCav.x,13+20*PCav.y);
   SetGraPen(3); SetGraPap(0);
   Repeat
    Mini:=9; iMini:=0;
    For i:=1 To 8 Do Begin
     nPCav.x:=PCav.x+Dep[i].x; nPCav.y:=PCav.y+Dep[i].y;
     Total:=0;
     If Echiquier[nPCav.x,nPCav.y] Then Begin
      For j:=1 To 8 Do
       If Echiquier[nPCav.x+Dep[j].x,nPCav.y+Dep[j].y] Then Total:=Total+1;
      If  (Total<Mini) Or ((Total=Mini) And (Random(10)>5)) Then Begin
       Mini:=Total; iMini:=i
      End;
     End;
    End;
    If iMini<>0 Then Begin
     DrwScrRec(E3,9+20*PCav.x, 9+20*PCav.y,11+20*PCav.x,11+20*PCav.y);
     MovAbs(20+40*PCav.x,20+40*PCav.y);
     PCav.x:=PCav.x+Dep[iMini].x;PCav.y:=PCav.y+Dep[iMini].y;
     Echiquier[PCav.x,PCav.y]:=False;
     DrwLinAbs(20+40*PCav.x,20+40*PCav.y);
    End;
   Until iMini=0;
   DrwScrRec(E3,8+20*PCav.x, 8+20*PCav.y,12+20*PCav.x,12+20*PCav.y);

   WriteLn('Entree : Repete');
   WriteLn('Q : Quitte');
  End Else Begin
   PCav.x:=1; PCav.y:=1;
  End;
  WriteLn('Position? Ex:C3');
  DspTxtCur; ReadLn(Rep);
  Case UpCase(Rep[1]) Of
    'A'..'H' :  Begin
      PCav.x:=Ord(UpCase(Rep[1]))-64;
      If Not(Pcav.x In [1..8]) Then PCav.x:=1;
      Val(Rep[2],PCav.y,Err);
      If Not(PCav.y In [1..8]) Then PCav.y:=1;
    End;
  End;
 Until UpCase(Rep[1])='Q';
 SetMod(2); SetInk(1,26,26);
End.

{=============================================
  USound : Unite son, CPC6128, v0.1 GC 2020
  --------------------------------------------}
Const ChnA=$1;  ChnB= $2;  ChnC=$4;
      RdvA=$8;  RdvB=$10;  RdvC=$20;
      Hold=$40; Flush=$80;

Type

 TSound = Record
   Channel, EnvVol, EnvTon: Byte;
   Period: Integer;
   Noise, Volume: Byte;
   Duration: Integer;
 End;

 TSection = Record
   Cnt, Siz, Tim: Byte;
 End;

 TEnv = Record
   NbrSec: Byte;
   Sec: Array[1..5] Of TSection;
 End;

Procedure RazSnd;
 Begin InLine($cd/$fc5a/$bca7); End;

Procedure AddSndQue(Sound:TSound);
 Begin
  InLine($21/Sound/$cd/$fc5a/$bcaa);
 End;

Function TstSndQue(Chn:Byte):Byte;
 Var bSnd:Byte;
 Begin
  InLine($3a/Chn/$cd/$fc5a/$bcad/$32/bSnd);
  TstSndQue:=bSnd;
 End;

Procedure SetEnvVol(EnvNbr:Byte; Env:TEnv);
 Begin InLine($3a/EnvNbr/$21/Env/$cd/$fc5a/$bcbc);End;

Procedure SetEnvTon(EnvNbr: Byte; Env: TEnv);
 Begin InLine($3a/EnvNbr/$21/Env/$cd/$fc5a/$bcbf) End;

Procedure RlsChn(Channel:Byte);
 Begin InLIne($3a/Channel/$cd/$fc5a/$bcb3) End;

Program Son;
{$i USound.inc}

Var Sound,Sound2 : Tsound; Env,Env2: TEnv;

Begin

 WriteLn('-> Debut du prgramme');
 RazSnd;

 With Env Do Begin
  NbrSec:=3 Or $80; { 'Or $80' permet la repetition de l'enveloppe}
  Sec[1].Cnt:=50;  Sec[1].Siz:=-3; Sec[1].Tim:=1;
  Sec[2].Cnt:=1;   Sec[2].Siz:=0;  Sec[2].Tim:=40;
  Sec[3].Cnt:=150; Sec[3].Siz:=1;  Sec[3].Tim:=1;
 End;
 SetEnvTon(1,Env);

 With Env Do Begin
  NbrSec:=2 Or $80;
  Sec[1].Cnt:=10; Sec[1].Siz:= 4; Sec[1].Tim:=2;
  Sec[2].Cnt:=5;  Sec[2].Siz:=-8; Sec[2].Tim:=2;
 End;
 SetEnvTon(2,Env);

 With Env Do Begin
  NbrSec:=2 Or $80;
  Sec[1].Cnt:=20; Sec[1].Siz:= 4; Sec[1].Tim:=6;
  Sec[2].Cnt:=10; Sec[2].Siz:=-8; Sec[2].Tim:=2;
 End;
 SetEnvTon(3,Env);

 With Env Do Begin
  NbrSec:=1;
  Sec[1].Cnt:=1; Sec[1].Siz:=0; Sec[1].Tim:=240;
 End;
 SetEnvVol(1,Env);

 Env.Sec[1].Tim:=100;
 SetEnvVol(2,Env);

 Env.Sec[1].Siz:=1; Env.Sec[1].Cnt:=12; Env.Sec[1].Tim:=60;
 SetEnvVol(5,Env);

 With Env2 Do Begin
  NbrSec:=3;
  Sec[1].Cnt:=14; Sec[1].Siz:=1;  Sec[1].Tim:=50;
  Sec[2].Cnt:=1;  Sec[2].Siz:=1;  Sec[2].Tim:=2500;
  Sec[3].Cnt:=15; Sec[3].Siz:=-1; Sec[3].Tim:=100;
 End;
 SetEnvVol(3,Env2);

 With Sound Do Begin
  Channel:=ChnA; EnvVol:=5; EnvTon:=1; Period:=230;
  Noise:=0; Volume:=0; Duration:=-1;
 End;
 AddSndQue(Sound);

 Sound.EnvVol:=1; Sound.Volume:=12;Sound.Duration:=-2;
 AddSndQue(Sound);

 Sound.Channel:=ChnA Or RdvC; Sound.Duration:=-2;
 AddSndQue(Sound);

 Sound.Channel:=ChnA Or RdvB; Sound.Duration:=-5;
 AddSndQue(Sound);

 With Sound2 Do Begin
  Channel:=ChnC Or RdvA; EnvVol:=2; EnvTon:=2; Period:=110;
  Noise:=0; Volume:=15; Duration:=-15;
 End;
 AddSndQue(Sound2);

 With Sound2 Do Begin
  Channel:=ChnB Or RdvA; EnvVol:=3; EnvTon:=3;
  Noise:=12; Duration:=2650; Period:=8000; Volume:=0;
 End;
 AddSndQue(Sound2);

 Env.Sec[1].Siz:=-1;
 SetEnvVol(4,Env); Sound.EnvVol:=4; Sound.Channel:=ChnA;
 Sound.Duration:=0;
 AddSndQue(Sound);

 WriteLn('-> Fin du programme. Le Turbo Pascal ne fait deja plus rien!');
 WriteLn('   Les bruitages s''effectuent en tache de fond');
 WriteLn('    - 3 canaux stereos, enveloppes de volumes, de tons, bruits, repetitions.');
 WriteLn('    - Gestion des ''rendez-vous'' entre canaux');
 Repeat Until KeyPressed;

 RazSnd;

End.

Mode mem #0000#4000 #8000 #C000
0 0 1 2 3
1 0 1 2 7
2 4 5 6 7
3 0 3 2 7
4 0 4 2 3
5 0 5 2 3
6 0 6 2 3
7 0 7 2 3

{ Unité KeyBoard, UKbd.inc}

Const Up=$1; Down=$2;Left=$4;Right=$8;Fire2=$10;Fire1=$20;

Var KbdChr, Car:Char;
    KbdByt : Byte;

Function GetChr:Char; { Touche 'au vol'}
 Begin
  InLine($cd/$fc5a/$da/$00/$79/$32/KbdChr);
  GetChr:=KbdChr;
 End;

Function StpChr:Char; { Attend une touche }
 Begin
  Inline($cd/$fc5a/$bb06/$32/KbdChr);
  StpChr:=KbdChr;
 End;

Function TstKey(Key:Byte):Boolean;
 Begin
  InLine($3a/Key/$cd/$fc5a/$bb1e/$3e/$00/$28/$02/$3e/$ff/$32/KbdByt);
  If KbdByt=0 Then TstKey:=False Else TstKey:=True;
 End;

Function GetJoyA:Byte;
 Begin
  InLine($cd/$fc5a/$bb24/$32/KbdByt);
  GetJoyA:=KbdByt;
 End;

Function GetJoyB:Byte;
 Begin
  InLine($cd/$fc5a/$bb24/$7d/$32/KbdByt);
  GetJoyB:=KbdByt;
 End;

{ ---------------------------------------------------------------
  Unite USprite. Gestion des Sprite hardware CPC+ v0.1  GC-2020
 ----------------------------------------------------------------}
Type
 TSpr =  Array[0..$ff] Of Byte;
 TSprPos = Record x,y: Integer; z: Byte; Bazar : Integer; End;

Const
 Zy1=1; Zy2=2; Zy4=3; Zx1=4; Zx2=8; Zx4=12;

Var
 TbSpr:      Array[0..15] Of TSpr    Absolute $4000;
 TbSprPos: Array[0..15] Of TPoSpr  Absolute $6000;
 TbPal:      Array[1..15] Of Integer Absolute $6422;

Procedure DlkAsic; { Delock ASIC }
 Type TCode = Array[1..17] Of Byte;
 Const Code:TCode=(255,0,255,119,179,81,168,212,98,57,156,70,43,21,138,205,238);
 Var b:Byte;
 Begin For b:=1 To 17 Do Port[$bc00]:=Code[b]; End;

Procedure OpnAsic; Begin Port[$7f00]:=$b8 End;

Procedure CloAsic; Begin Port[$7f00]:=$a0 End;

Procedure SetSprPal(n,r,v,b:Byte);
 Begin TbPal[n]:=v*256+16*r+b; End;

Program Sprite;
{$i UGraph.inc}
{$i UKbd.inc}
{$i USprite.inc}
{$i pacman.spr}
Var r,v,b:Byte;
Begin
 HidTxtCur; SetMod(1); SetBdr(0,0);
 DlkAsic; OpnAsic;
 SetSprPal(1,0,0,15);  SetSprPal(2,1,1,1);
 SetSprPal(3,15,15,15);SetSprPal(4,0,0,0);
 TbSpr[0]:=Fantome;
 With TbSprPos[0] Do Begin x:=160; y:=100; z:=Zx2+Zy1 End;
 Repeat
  With TbSprPos[0] Do
   Case GetJoyA of
    Up   : y:=y-1;
    Down : y:=y+1;
    Right: x:=x+2;
    Left : x:=x-2;
   End;
 Until GetJoyA=Fire1;

 TbSprPos[0].z:=Zx4+Zy2;
 For r:=3 to 15 Do
  For v:=3 To 15 Do
   For b:=3 To 15 Do
    SetSprPal(3,r,v,b);
 TbSprPos[0].z:=0;
 CloAsic;
 RazKbdBuf; SetInk(0,0,0); SetMod(2);
End.

TbSpr[15]:=TbSpr[0] copie le dessin du sprite 0 en sprite 15.
Idem pour les coordonnées et zoom
TbSprPos[15]:=TbSprPos[0]

Pour 'swapper' deux sprites (juste les images) :

Procedure SwpSpr(Var Spr1, Spr2 : TSpr);
 Var Tmp : TSpr
 Begin Tmp:=Spr1; Spr1:=Spr2; Spr2:=Tmp End;

 For i:=1 To 100 Do            {100 tours de l'ellipse}
  For j:=1 To 100 Do Begin     {Ellipse précalculée de 100 positions xy}
   TbSprPos[0].xy:=Ellipse[j]; {Force position du sprite hard n°0}
   TbSpr[0]:=Tableau[j Mod 16];{Change l'image du sprite, animation de 16 images dans Tableau[0..15] Of TSpr}
  End;