Pascal backup

README

Backup of some of my first attempts at programming

CODETECL.PAS

Program Codigo_Tecla;

Uses Crt;

Var
Ch:Char;
I,tam :Integer;
Key:Integer;

Begin
ClrScr;
Tam:=50;
Repeat

If Keypressed Then
Begin
Ch:=readkey;
If Ch =#0 Then
Begin
Ch:=Readkey;
TextColor(9);
Writeln('Tecla de C¢digo : #',Ord(CH));
End {If CH}
Else
Begin TextColor(12); Writeln(Ord(CH)); End;



End; {If Keypressed}


Until Ch=#27;
END.

COR.PAS

program cor;

uses crt;

var x,y :byte;
i:byte;
BEGIN
randomize;
repeat
y:=random(45);
if y = 0 then
 begin y:=1 end;
repeat
x:=random(80);
until x <> 0;
i:=random(10);
gotoxy(x,y); textcolor(i); write('Û');
until keypressed
END.

CORES.PAS

Program Cores;

Uses CRt;

Var I, f :Integer; { Cor de Texto Fundo}
X,Y: Integer; {Cursores}
Ch:Char;





Begin
Repeat
ClrScr;
X:=1;
Y:=0;
F:=0;
Textbackground(f);
ClrScr;
For i:=0 to (63) do
Begin
TextColor(i);
Inc(Y);
If Y = 17 Then
Begin
Y:=1; X:=X+19; inc(f);
End; {If Y}
Textbackground(f);
GotoXY( X , Y );
Writeln('Textcolor(', I ,' ',f, ' )' );
end; {For I}

ch:=Readkey;

X:=1;
Y:=0;
Inc(f);
For i:=0 to (63) do
Begin
TextColor(i);
Inc(Y);
If Y = 17 Then
Begin
Y:=1; X:=X+19; inc(f);
End; {If Y}
Textbackground(f);
GotoXY( X , Y );
Writeln('Textcolor(', I ,' ',f, ' )' );
end; {For I}
Ch:=Readkey;

Until ch = #27;

END.

HANOY3.PAS

Program Hanoy;

Uses Crt;

Var Disco: Array[1..7] Of Byte;     {Nos Discos Contem a Posi‡ao que ocupa Nos Pinos}
     Pino: Array[1..37] of Byte;    { Contem os Discos }
        X: Array[1..37] of Byte;    { Contem As Posi‡oes X Predefinidas }
        Y: Array[1..37] of Byte;    { Contem As Posi‡oes Y Predefinidas }
    CorPinos : Byte;                {Cor Dos Pinos}
   DiscoMover: Byte;                {Qual disco ser  selecionado e movido}
           cd: Array[1..7] of Byte; {Cor dos Discos}
    Xp,Yp, Xi,Yi    : Byte;         {Posi‡ao Variavel dos Pinos}
   Jogo    :String;                 {Contem o Andamento do Jogo}
   Ch               :String;                   {Leitura das Teclas}



Procedure PegaPosicao(posicao:Byte); {Conforme o disco}
Var Pxy:Integer; {Pega a Posi‡ao interna do Disco}
     Pt:Byte; {Posi‡ao Tempor ria}
Begin
Case posicao of
  1:Begin Pxy:=Disco[1] End;
  2:Begin Pxy:=Disco[2] End;
  3:Begin Pxy:=Disco[3] End;
  4:Begin Pxy:=Disco[4] End;
  5:Begin Pxy:=Disco[5] End;
  6:Begin Pxy:=Disco[6] End;
End; {Case Posicao}
Pt:=10; {Posi‡ao do Disco Selecionado Antes de Ser Solto}
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End; {Cordenadas}
Pt:=11;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End; {Cordenadas}
Pt:=12;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End; {Cordenadas}
Pt:=13;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End; {Cordenadas..}
Pt:=14;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=15;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=16;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;

Pt:=21;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=22;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=23;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=24;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=25;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=26;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;

Pt:=31;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=32;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=33;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=34;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=35;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;
Pt:=36;
     If Pt = Pxy Then     Begin Xp:=X[Pt]; Yp:=Y[Pt]  End;

End; {Procedure PegaPosicao}

Procedure DesenhaPinos;
Begin
TextColor(CorPinos);
GotoXY(Xi,Yi-7);  Write('                ²²                 ²²                 ²²            ');
GotoXY(Xi,Yi-6);  Write('                ²²                 ²²                 ²²            ');
GotoXY(Xi,Yi-5);  Write('                ²²                 ²²                 ²²            ');
GotoXY(Xi,Yi-4);  Write('                ²²                 ²²                 ²²            ');
GotoXY(Xi,Yi-3);  Write('                ²²                 ²²                 ²²            ');
GotoXY(Xi,Yi-2);  Write('                ²²                 ²²                 ²²            ');
GotoXY(Xi,Yi-1);  Write('                ²²                 ²²                 ²²            ');
GotoXY(Xi,Yi+0);  Write('±±±±±±±±±±±±±±±±²²±±±±±±±±±±±±±±±±±²²±±±±±±±±±±±±±±±±±²²±±±±±±±±±±±±±±±±');
{                        123456789012345678901234567890123456789012345678901234567890123456790123
                                  1         2         3         4         5         6         7
                                         17                36                 55
}
GotoXY(Xi,Yi+1);  Write('                1                  2                  3                ');

PegaPosicao(1);
{Disco 1} TextColor(cd[1]); GotoXY(Xp-1,Yp);      Write('ÛÛÛÛ');
PegaPosicao(2);                                         {1234}
{Disco 2} TextColor(cd[2]); GotoXY(Xp-2,Yp);     Write('ÛÛÛÛÛÛ');
PegaPosicao(3);                                        {123456}
{Disco 3} TextColor(cd[3]); GotoXY(Xp-3,Yp);    Write('ÛÛÛÛÛÛÛÛ');
PegaPosicao(4);                                       {12345678}
{Disco 4} TextColor(cd[4]); GotoXY(Xp-4,Yp);   Write('ÛÛÛÛÛÛÛÛÛÛ');
PegaPosicao(5);                                      {1234567890}
{Disco 5} TextColor(cd[5]); GotoXY(Xp-5,Yp);  Write('ÛÛÛÛÛÛÛÛÛÛÛÛ');
PegaPosicao(6);                                     {123456789012}
{Disco 6} TextColor(cd[6]); GotoXY(Xp-6,Yp); Write('ÛÛÛÛÛÛÛÛÛÛÛÛÛÛ');
                                                   {12345678901234}
End; {Procedure DesenhaPinos}
{
GotoXY(Pi,Yi+6);  Write('            ÛÛ             ÛÛ             ÛÛ            ');
GotoXY(Pi,Yi+6);  Write('            16             26             36            ');
GotoXY(Pi,Yi+5);  Write('            15             25             35            ');
GotoXY(Pi,Yi+4);  Write('            14             24             34            ');
GotoXY(Pi,Yi+3);  Write('            13             23             33            ');
GotoXY(Pi,Yi+2);  Write('            12             22             32            ');
GotoXY(Pi,Yi+1);  Write('            11             21             31            ');
GotoXY(Pi,Yi+0);  Write('±±±±±±±±±±±±²²±±±±±±±±±±±±±²²±±±±±±±±±±±±±²²±±±±±±±±±±±±');
                         12345678901234567890123456789012345678901234567890123456
                                  1         2         3         4         5
                         X +        13             28             43
GotoXY(Pi,Yi-1);  Write('     .              .              .              .');
}

Procedure PosicaoDosDiscos;    {Posicsao para desenhar discos com GotoXY}
Var Pdiscos:Byte;
Begin
Pdiscos:=16;
X[11]:=Xi+Pdiscos; Y[11]:=Yi-1;
X[12]:=Xi+Pdiscos; Y[12]:=Yi-2;
X[13]:=Xi+Pdiscos; Y[13]:=Yi-3;
X[14]:=Xi+Pdiscos; Y[14]:=Yi-4;
X[15]:=Xi+Pdiscos; Y[15]:=Yi-5;
X[16]:=Xi+Pdiscos; Y[16]:=Yi-6;

Pdiscos:=35;
X[21]:=Xi+Pdiscos; Y[21]:=Yi-1;
X[22]:=Xi+Pdiscos; Y[22]:=Yi-2;
X[23]:=Xi+Pdiscos; Y[23]:=Yi-3;
X[24]:=Xi+Pdiscos; Y[24]:=Yi-4;
X[25]:=Xi+Pdiscos; Y[25]:=Yi-5;
X[26]:=Xi+Pdiscos; Y[26]:=Yi-6;

Pdiscos:=54;
X[31]:=Xi+Pdiscos; Y[31]:=Yi-1;
X[32]:=Xi+Pdiscos; Y[32]:=Yi-2;
X[33]:=Xi+Pdiscos; Y[33]:=Yi-3;
X[34]:=Xi+Pdiscos; Y[34]:=Yi-4;
X[35]:=Xi+Pdiscos; Y[35]:=Yi-5;
X[36]:=Xi+Pdiscos; Y[36]:=Yi-6;

X[10]:=Xi+35;     Y[10]:=Yi-11; {Posi‡ao que o Disco Fica At‚ ser Solto}
End;{Procedure Posi‡ao Dos Discos}



Procedure LargaColuna;
Var i:Byte; {Contador}
   Pn, Code:Integer;{Conversao de texto para int}
Begin
  Repeat
   GotoXY(Xi + 8, Yi + 5); Write('Informe a Coluna … Largar o Disco: ');
   GotoXy(Xi + 8 + 35, Yi + 5); Write('');
    ReadLn(Ch);

 Until (Ch='1') or (Ch='2') or (Ch='3') or (Ch=#27);
Val(Ch,Pn,Code); {Converte Ch em Numero}
i:=0;
While I < 7  Do  {Le posicoes de Baixo para Cima em busca de Lugar para Soltar o Disco}
Begin
Inc(I);
If (Pino[ (Pn*10)+i ] = 0) And  (  (Pino[(Pn*10)+i] < Pino[(Pn*10)+i-1]) or (i = 1) )     Then
 Begin Pino[ (Pn*10)+i ]:=DiscoMover;
       Disco[DiscoMover]:= (Pn * 10) + i;
       Jogo:='PegaColuna'; {Segue o Jogo}
       I:=7;{Finaliza While pq ja achou lugar para Soltar o Disco}
 End;{If Pino[i] }
End; {While I}
DesenhaPinos;
End; {Procedure largaColuna}



Procedure PegaColuna;
Var i:Byte; {Contador}
   Pn, Code:Integer;{Conversao de texto para int}
Begin

  Repeat
   GotoXY(Xi + 8, Yi + 5); Write('Informe a Coluna … Pegar o Disco:    ');
   GotoXy(Xi + 8 + 35, Yi + 5); Write('');
    ReadLn(Ch);

 Until (Ch='1') or (Ch='2') or (Ch='3') or (Ch=#27);

Val(Ch,Pn,Code); {Converte Ch em Numero}
i:=7;
While I > 0 Do  {Le posicoes de cima para baixo em busca de Disco}
Begin
Dec(i);
If Pino[ (Pn*10)+i ] <> 0 Then
 Begin DiscoMover:=pino[ (Pn*10)+i ]; {Informa qual Disco encontrado}
       Disco[ DiscoMover ]:=10; {Posicao de mudar no disco escolhido}
       Pino[ (Pn*10)+i ]:=0; {Retira Informa‡ao de disco no Pino}
       Jogo:='LargaColuna'; {Segue o Jogo}
       I:=0;{Finaliza While pq ja encontrou um Disco}
 End;{If Pino[i] }

End; {While I}
DesenhaPinos;
End; {Procedure PegaColuna}


BEGIN
   Xi:=7;
   Yi:=15;
   CorPinos:=15;
   cd[1]:=1; cd[2]:=2; cd[3]:=3;cd[4]:=4; cd[5]:=5; cd[6]:=6;
   PosicaodosDiscos;
   {Disco 1} Disco[1]:=16;  Pino[16]:=1;
   {Disco 2} Disco[2]:=15;  Pino[15]:=2;
   {Disco 3} Disco[3]:=14;  Pino[14]:=3;
   {Disco 4} Disco[4]:=13;  Pino[13]:=4;
   {Disco 5} Disco[5]:=12;  Pino[12]:=5;
   {Disco 6} Disco[6]:=11;  Pino[11]:=6;

Jogo:='PegaColuna'; {Inicia o Jogo}
repeat
   ClrScr;
   DesenhaPinos;
   If Jogo='PegaColuna' Then
    PegaColuna;
   If Jogo='LargaColuna' Then
    LargaColuna;

until ch = #27;
END.