DataMuseum.dk

top - metrics - download

    Length: 4096 (0x1000)
    Types: TextFile
    Names: »OPG3.PAS«

└─⟦b301b5c1d⟧ Bits:30003931/GEM_Develop_disk_2_CDOS.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline)
    └─⟦this⟧ »OPG3.PAS« 

TextFile

program labyrint;

(*$i gempcon.i*)
(*$i gemptype.i*)
(*$i gempvar.i*)
(*$i vdibnd.pas*)

Type
  sider  = (nord,oest,syd,vest);
  celler = Set Of sider;
  rotte = record
             xkoor,
             ykoor : integer
             retning : sider
             end;

Const
  maxside = 50;
  hel:celler = (.nord,oest,syd,vest.);
  tom:celler = (..);
  xmax = 5;
  ymax = 5;
  
Var
  labyrint : Array (.0..maxside,0..maxside.) Of celler;
  mig : rotte;
  retur,handler:integer;
  intptsout : array_57;
  
Procedure danlabyrint(xmax,ymax:integer);
Var
  kandidat : Array (.1..4.) Of sider;
  i,j,n    : Integer;
  x,y      : Integer;
  dx       : Integer;
  trin     : Integer;
  slut     : Boolean;

Begin
  (* Initialisering af labyrint *)
  For j:=1 to ymax do
  Begin
    labyrint(.0,j.)   :=(.oest.);
    labyrint(.xmax+1,j.):=(.vest.);
  End;  
  
  For i:=1 to xmax do
  Begin
    labyrint(.i,0.)     :=(.nord.);
    labyrint(.i,ymax+1.):=(.syd.);
    For j:=1 to ymax do labyrint(.i,j.):=hel;
  End;
  
  labyrint(.0,0.):=tom;
  labyrint(.xmax+1,0.):=tom;
  labyrint(.0,ymax+1.):=tom;
  labyrint(.xmax+1,ymax+1.):=tom;
  
  (* Vælg midtpunkt hvorudfra labyrint dannes *)
  x:= xmax div 2 + 1;
  y:= ymax div 2 + 1;
  n:= xmax*ymax - 1;
  dx := 1;
  
  For trin:=1 to n do
  begin
    repeat
      slut:=false;
      i:=0;
      If labyrint(.x-1,y.)=hel then begin i:=i+1;kandidat(.i.):=vest; end;
      If labyrint(.x+1,y.)=hel then begin i:=i+1;kandidat(.i.):=oest; end;
      If labyrint(.x,y-1.)=hel then begin i:=i+1;kandidat(.i.):=syd;  end;
      If labyrint(.x,y+1.)=hel then begin i:=i+1;kandidat(.i.):=nord; end;

      If i<>0 then
      Begin
        (* Vælg en retning *)
        If i<>1 then i:=random(i)+1;
        Case kandidat(.i.) Of
        vest:
            Begin
              labyrint(.x,y.):=labyrint(.x,y.)-(.vest.);
              x:=x-1;
              labyrint(.x,y.):=labyrint(.x,y.)-(.oest.);
            End;
        nord:
            Begin
              labyrint(.x,y.):=labyrint(.x,y.)-(.nord.);
              y:=y+1;
              labyrint(.x,y.):=labyrint(.x,y.)-(.syd.);
            End;
        oest:
            Begin
              labyrint(.x,y.):=labyrint(.x,y.)-(.oest.);
              x:=x+1;
              labyrint(.x,y.):=labyrint(.x,y.)-(.vest.);
            End;
        syd:
            Begin
              labyrint(.x,y.):=labyrint(.x,y.)-(.syd.);
              y:=y-1;
              labyrint(.x,y.):=labyrint(.x,y.)-(.nord.);
            End;
        End;
        slut:=TRUE;
      end
      else
      begin
        repeat
          x:=x+dx ;
          If x>xmax then begin y:=y+1; x:=xmax; dx :=-1; end;
          If x<1    then begin y:=y+1; x:=1; dx :=1; end;
          If y>ymax then begin y:=1; end;
        until labyrint(.x,y.)<>hel;      
      end;
    until slut;
  end;
  (* Lav en udgang ved sydmuren *)
  x:=random(xmax)+1;
  labyrint(.x,1.):=labyrint(.x,1.)-(.syd.);
  labyrint(.x,0.):=labyrint(.x,0.)-(.nord.);
End;

procedure init(xmax,ymax:integer);
begin
        mig.xkoor:=random(xmax)+1;
        mig.ykoor:=ymax;
        mig.retning:=sider(random(4));
end;

procedure hdrej;
begin
        if mig.retning=vest then mig.retning:=nord
                            else mig.retning:=succ(mig.retning);
end;

procedure vdrej;
begin
        if mig.retning=nord then mig.retning:=vest
                            else mig.retning:=pred(mig.retning);
end;

procedure gfrem;
begin
        case mig.retning of
        nord: mig.ykoor:=mig.ykoor+1;
        oest: mig.xkoor:=mig.xkoor+1;
        syd : mig.ykoor:=mig.ykoor-1;
        vest: mig.xkoor:=mig.xkoor-1;
end;

begin
        
        intin(.0.):=1;
        intin(.10.):=2;
        retur:=v_opnwk(intin,handler,intptsout);
        if handler > 0 then begin
           danlabyrint(xmax,ymax);
           init(xmax,ymax);