Package PacMan

Uses KbdCRT,Runtime,PacLib,Timer

Sub HLine ( L , C0 , C1 , Char as Word )
  C as Word
Enter
  C = C0 : While C <= C1 Do Plot L , C , Char : C += 1 ;
Leave

Sub VLine ( L0 , L1 , C , Char as Word )
  L as Word
Enter
  L = L0 : While L <= L1 Do Plot L , C , Char : L += 1 ;
Leave

Sub Carre ( L0 , C0 , L1 , C1 , Char as Word )
Enter
  HLine L0 , C0 , C1 , Char
  HLine L1 , C0 , C1 , Char
  VLine L0 , L1 , C0 , Char
  VLine L0 , L1 , C1 , Char
Leave

Sub CarrePlein(L0,C0,L1,C1,Char as Word)
  L,C as Word
Enter
  L=L0:While L<=L1 Do C=C0:While C<=C1 Do Plot L,C,Char:C+=1;:L+=1;
Leave

Const
     Cerises=&H0100|''
     Murs=&H0400|'Û'

Sub DessineTableau
  L,C as Word
Enter
  Locate 1,1:PutCar 'ä':PutCar '=':PutCar '0'
  CarrePlein 2,1,25,40,Cerises
  Carre 2,1,25,40,Murs
  HLine 2,20,21,&H0720
  HLine 25,20,21,&H0720
  VLine 13,14,1,&H0720
  VLine 13,14,40,&H0720
  Carre 6,5,21,36,Murs
  HLine 6,12,13,&H0720
  HLine 21,12,13,&H0720
  HLine 6,28,29,&H0720
  HLine 21,28,29,&H0720
  VLine 17,18,5,&H0720
  VLine 9,10,5,&H0720
  VLine 9,10,36,&H0720
  VLine 17,18,36,&H0720
  Carre 10,22,17,32,Murs
  Carre 10,9,17,19,Murs
  VLine 13,14,22,Cerises
  VLine 13,14,32,&H0720
  VLine 13,14,9,&H0720
  VLine 13,14,19,Cerises
  VLine 13,14,14,Murs
  VLine 13,14,27,Murs
Leave

Old as Word

Def MoveLeft(L,C,O,Char as Word) as Word
  C0 as Word
Enter
  C0=C:Result=1
  If C=1 Then C=40
  Else
    If Low(Point(L,C-1))<>&H07 And Low(Point(L,C-1))<>&H20 Then Result=0
    Else
      C-=1
      ;
  Old=Point(L,C)
  If Result Then Plot L,C0,O:Plot L,C,Char;
Leave

Def MoveRight(L,C,O,Char as Word) as Word
  C0 as Word
Enter
  C0=C:Result=1
  If C=40 Then C=1
  Else
    If Low(Point(L,C+1))<>&H07 And Low(Point(L,C+1))<>&H20 Then Result=0
    Else
      C+=1
      ;
  Old=Point(L,C)
  If Result Then Plot L,C0,O:Plot L,C,Char;
Leave

Def MoveDown(L,C,O,Char as Word) as Word
  L0 as Word
Enter
  L0=L:Result=1
  If L=25 Then L=2
  Else
    If Low(Point(L+1,C))<>&H07 And Low(Point(L+1,C))<>&H20 Then Result=0
    Else
      L+=1
      ;
  Old=Point(L,C)
  If Result Then Plot L0,C,O:Plot L,C,Char;
Leave

Def MoveUp(L,C,O,Char as Word) as Word
  L0 as Word
Enter
  L0=L:Result=1
  If L=2 Then L=25
  Else
    If Low(Point(L-1,C))<>&H07 And Low(Point(L-1,C))<>&H20 Then Result=0
    Else
      L-=1
      ;
  Old=Point(L,C)
  If Result Then Plot L0,C,O:Plot L,C,Char;
Leave

Def Dead(L0,C0,L1,C1 as Word) as Word
  DL,DC as Word
Enter
  DL=L1-L0:DC=C1-C0
  If (DL=-1 Or DL=0 Or DL=1) And (DC=-1 Or DC=0 Or DC=1) Then Result=1
                                                         Else Result=0;
Leave

Sub ThisIsTheEnd
Enter
  Locate 1,38:PutCar '':PutCar '':PutCar ''
  While GetCar<>27 Do;
Leave

Sub YouWin
Enter
  Locate 1,38:PutCar 12:PutCar '':PutCar ''
  While GetCar<>27 Do;
Leave

Sub Arrachos
Enter
  SetCursShape &H0607
  SetCRTMode 1
Leave

Const
     NbMaxTops=\10000\600000
     Pac=&H0E00|''
     Fa1=&H0C00|''
     Fa2=&H0D00|''
     Fa3=&H0A00|''
Var
   LPac,CPac,OldPac,Touche,Score,Scratch as Word
   LFa1,CFa1,OldFa1 as Word
   LFa2,CFa2,OldFa2 as Word
   LFa3,CFa3,OldFa3 as Word
   NbTops as LongWord

Enter
  InitScr
  SetCursShape &H0700
  DessineTableau
  LPac=23:CPac=3:OldPac=' '
  Plot LPac,CPac,Pac:Score=0
  LFa1=4:CFa1=3:OldFa1=Cerises
  Plot LFa1,CFa1,Fa1
  LFa2=4:CFa2=38:OldFa2=Cerises
  Plot LFa2,CFa2,Fa2
  LFa3=23:CFa3=38:OldFa3=Cerises
  Plot LFa3,CFa3,Fa3
  Touche=NbTops=0
  While Touche<>27 Do
    If KeyPressed Then
      Touche=GetCar
      If High(Touche)=T_LEFT Or High(Touche)=T_RIGHT Then
        If High(Touche)=T_LEFT Then
        Begin
          If MoveLeft(LPac,CPac,OldPac,Pac) Then CPac-=1:OldPac=Old;
        Else
        Begin
          If MoveRight(LPac,CPac,OldPac,Pac) Then CPac+=1:OldPac=Old;
      Else
        If High(Touche)=T_DOWN Then
        Begin
          If MoveDown(LPac,CPac,OldPac,Pac) Then LPac+=1:OldPac=Old;
        Else
          If MoveUp(LPac,CPac,OldPac,Pac) Then LPac-=1:OldPac=Old;
    End
    If LPac>25 Then LPac=2;
    If LPac<2 Then LPac=25;
    If CPac>40 Then CPac=1;
    If CPac<1 Then CPac=40;
    If OldPac=Cerises Then
      Score+=1:Locate 1,3:PrintD Score:OldPac=' '
      If Score=675 Then YouWin:Goto Cassos;
    End
    If NbTops=0 Then
    \ Test Fa1 \
      If Dead(LPac,CPac,LFa1,CFa1) Then ThisIsTheEnd:Goto Cassos
      Else
        Scratch=0
        If LFa1<>LPac Then
          If LFa1>LPac Then
            Scratch=MoveUp(LFa1,CFa1,OldFa1,Fa1)
            If Scratch Then LFa1-=1:OldFa1=Old;
          Else
            Scratch=MoveDown(LFa1,CFa1,OldFa1,Fa1)
            If Scratch Then LFa1+=1:OldFa1=Old;
          End
        End
        If Scratch=0 And CFa1<>CPac Then
          If CFa1>CPac Then
          Begin
            If MoveLeft(LFa1,CFa1,OldFa1,Fa1) Then CFa1-=1:OldFa1=Old;
          Else
            If MoveRight(LFa1,CFa1,OldFa1,Fa1) Then CFa1+=1:OldFa1=Old;
      End
      If LFa1>25 Then LFa1=2;
      If LFa1<2 Then LFa1=25;
      If CFa1>40 Then CFa1=1;
      If CFa1<1 Then CFa1=40;
    \ Test Fa2 \
      If Dead(LPac,CPac,LFa2,CFa2) Then ThisIsTheEnd:Goto Cassos
      Else
        Scratch=0
        If CFa2<>CPac Then
          If CFa2>CPac Then
            Scratch=MoveLeft(LFa2,CFa2,OldFa2,Fa2)
            If Scratch Then CFa2-=1:OldFa2=Old;
          Else
            Scratch=MoveRight(LFa2,CFa2,OldFa2,Fa2)
            If Scratch Then CFa2+=1:OldFa2=Old;
          End
        End
        If Scratch=0 And LFa2<>LPac Then
          If LFa2>LPac Then
          Begin
            If MoveUp(LFa2,CFa2,OldFa2,Fa2) Then LFa2-=1:OldFa2=Old;
          Else
            If MoveDown(LFa2,CFa2,OldFa2,Fa2) Then LFa2+=1:OldFa2=Old;
      End
      If LFa2>25 Then LFa2=2;
      If LFa2<2 Then LFa2=25;
      If CFa2>40 Then CFa2=1;
      If CFa2<1 Then CFa2=40;
    \ Test Fa3 \
      If Dead(LPac,CPac,LFa3,CFa3) Then ThisIsTheEnd:Goto Cassos
      Else
        Scratch=Random(4)
        If Scratch<2 Then
          If Scratch=0 Then
            If LFa3<LPac Then
              If MoveDown(LFa3,CFa3,OldFa3,Fa3) Then LFa3+=1:OldFa3=Old End
            Else
              If MoveUp(LFa3,CFa3,OldFa3,Fa3) Then LFa3-=1:OldFa3=Old End
          Else
            If Random(2) Then
              If MoveDown(LFa3,CFa3,OldFa3,Fa3) Then LFa3+=1:OldFa3=Old End
            Else
              If MoveUp(LFa3,CFa3,OldFa3,Fa3) Then LFa3-=1:OldFa3=Old End
        Else
          If Scratch=2 Then
            If CFa3>CPac Then
              If MoveLeft(LFa3,CFa3,OldFa3,Fa3) Then CFa3-=1:OldFa3=Old End
            Else
              If MoveRight(LFa3,CFa3,OldFa3,Fa3) Then CFa3+=1:OldFa3=Old End
          Else
            If Random(2) Then
              If MoveLeft(LFa3,CFa3,OldFa3,Fa3) Then CFa3-=1:OldFa3=Old End
            Else
              If MoveRight(LFa3,CFa3,OldFa3,Fa3) Then CFa3+=1:OldFa3=Old End
            End
          End
        End
      End
      If LFa3>25 Then LFa3=2;
      If LFa3<2 Then LFa3=25;
      If CFa3>40 Then CFa3=1;
      If CFa3<1 Then CFa3=40;
    End
    If NbTops=NbMaxTops Then NbTops=0 Else NbTops+=1;
  Wend
Cassos:
  Arrachos
Leave