|
|
!
! uBASIC からの、移植。※原本は、ココにあります。(その他、多数同梱)
! アスキー・セーブ しなおしたもの。
! MAZE.UB
!---------------------------------
! 迷路を作る
! Pascal version from
! 奥村晴彦 コンピュータアルゴリズム事典（技術評論社） 349-350
! 〔付〕迷路を解く by 岩瀬順一
OPTION BASE 0
SET WINDOW 0,500, 500,0
!
LET Xmax=90
LET Ymax=90
LET MaxCan=INT(Xmax*Ymax/4) ! must Ymax<=Xmax
LET Bsize=4
LET Xoff=INT((500-Xmax*Bsize)/2)
LET Yoff=INT((500-Ymax*Bsize)/3) ! 20
DIM Map_(Xmax,Ymax)
DIM CanX_(MaxCan),CanY_(MaxCan),DirX_(MaxCan),DirY_(MaxCan)
RANDOMIZE
!
FOR I=0 TO 1
FOR J=0 TO Ymax
LET Map_(I,J)=1
LET Map_(Xmax-I,J)=1
NEXT J
NEXT I
FOR J=0 TO 1
FOR I=0 TO Xmax
LET Map_(I,J)=1
LET Map_(I,Ymax-J)=1
NEXT I
NEXT J
LET X=2
FOR Y=4 TO Ymax-2
CALL DOT_(X,Y)
NEXT Y
LET X=Xmax-2
FOR Y=2 TO Ymax-4
CALL DOT_(X,Y)
NEXT Y
LET Y=2
FOR X=2 TO Xmax-2
CALL DOT_(X,Y)
NEXT X
LET Y=Ymax-2
FOR X=2 TO Xmax-2
CALL DOT_(X,Y)
NEXT X
LET Ncan=0
FOR I=2 TO INT(Xmax/(2)) -2
CALL InsCan_(I*2,2)
CALL InsCan_(I*2,Ymax-2)
NEXT I
FOR J=2 TO INT(Ymax/(2)) -2
CALL InsCan_(2,J*2)
CALL InsCan_(Xmax-2,J*2)
NEXT J
LET Ndir=4
LET DirX_(1)=2
LET DirY_(1)=0
LET DirX_(2)=0
LET DirY_(2)=2
LET DirX_(3)=-2
LET DirY_(3)=0
LET DirX_(4)=0
LET DirY_(4)=-2
DO WHILE Ncan>0
CALL Selcan_(I,J)
DO
LET Ndir=4
DO
CALL SelDir_(DI,DJ)
LET Ok=1-Map_(I+DI,J+DJ)
LOOP UNTIL Ok<>0 OR Ndir=0
IF Ok<>0 THEN
CALL DOT_(I+INT(DI/(2)),J+INT(DJ/(2)) )
LET I=I+DI
LET J=J+DJ
CALL DOT_(I,J)
CALL InsCan_(I,J)
END IF
LOOP UNTIL NOT Ok<>0
LOOP
SUB DOT_(X,Y)
LET Map_(X,Y)=1
! SET AREA COLOR 5
PLOT AREA: Bsize*X+Xoff,Bsize*Y+Yoff;Bsize*X+Xoff+Bsize-1,Bsize*Y+Yoff;Bsize*X+Xoff+Bsize-1,Bsize*Y+Yoff+Bsize-1;Bsize*X+Xoff,Bsize*Y+Yoff+Bsize-1
END SUB
SUB InsCan_(I,J)
LET Ncan=Ncan+1
LET CanX_(Ncan)=I
LET CanY_(Ncan)=J
END SUB
SUB Selcan_(I,J)
local R
LET R=int(Ncan*rnd)+1
LET I=CanX_(R)
LET J=CanY_(R)
LET CanX_(R)=CanX_(Ncan)
LET CanY_(R)=CanY_(Ncan)
LET Ncan=Ncan-1
END SUB
SUB SelDir_(I,J)
local R
LET R=int(Ndir*rnd)+1
LET I=DirX_(R)
LET J=DirY_(R)
LET DirX_(R)=DirX_(Ndir)
LET DirY_(R)=DirY_(Ndir)
LET DirX_(Ndir)=I
LET DirY_(Ndir)=J
LET Ndir=Ndir-1
END SUB
!--------------------------------------------------
! この先は、岩瀬が書いた。
! 方針：袋小路があったら、ぬりつぶす
!
PLOT TEXT,AT Xoff*1.2,20 :"何かキーを押してください。迷路を解きます。"
PLOT TEXT,AT Xoff*1.2,40 :"Push any key to solve the maze."
CHARACTER INPUT s$
SET AREA COLOR 0
PLOT AREA :Xoff,0; 500,0; 500,40; Xoff,40
!
LET Map_(2,3)=0
LET Map_(Xmax-2,Ymax-3)=0 ! 出口、入口は０にする
FOR I=0 TO Xmax ! 迷路の外は１にする
FOR J=0 TO 1
LET Map_(I,J)=0
NEXT J
FOR J=Ymax-1 TO Ymax
LET Map_(I,J)=0
NEXT J
NEXT I
FOR J=0 TO Ymax
FOR I=0 TO 1
LET Map_(I,J)=0
NEXT I
FOR I=Xmax-1 TO Xmax
LET Map_(I,J)=0
NEXT I
NEXT J
!
!
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
!$$$$$$$$$ MAIN ROUTINE TO SOLVE THE MAZE $$$$$$$$$$$$$$$$$$$$$$$$$$$
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
!
FOR K=6 TO Ymax
FOR J=3 TO K-3
CALL Routine_
NEXT J
NEXT K
FOR K=Ymax+1 TO Xmax
FOR J=3 TO Ymax-3
CALL Routine_
NEXT J
NEXT K
FOR K=Xmax+1 TO Xmax+Ymax-6
FOR J=K-Xmax+3 TO Ymax-3
CALL Routine_
NEXT J
NEXT K
SUB Routine_
LET I=K-J
IF fnCheck(I,J)< 3 THEN EXIT SUB
LET Ii=I
LET Jj=J
DO
CALL Fil_(Ii,Jj)
IF Map_(Ii-1,Jj)=0 THEN
LET Ii=Ii-1
ELSEIF Map_(Ii,Jj+1)=0 THEN
LET Jj=Jj+1
ELSEIF Map_(Ii+1,Jj)=0 THEN
LET Ii=Ii+1
ELSEIF Map_(Ii,Jj-1)=0 THEN
LET Jj=Jj-1
END IF
LOOP UNTIL fnCheck(Ii,Jj)<>3
END SUB
SUB Fil_(X,Y)
LET Map_(X,Y)=1
SET AREA COLOR 4 !3
PLOT AREA: Bsize*X+Xoff,Bsize*Y+Yoff;Bsize*X+Xoff+Bsize-1,Bsize*Y+Yoff;Bsize*X+Xoff+Bsize-1,Bsize*Y+Yoff+Bsize-1;Bsize*X+Xoff,Bsize*Y+Yoff+Bsize-1
END SUB
FUNCTION fnCheck(I,J) ! 袋小路の時３をかえす
LET fnCheck=0
IF Map_(I,J)=1 THEN EXIT FUNCTION
LET fnCheck=Map_(I-1,J)+Map_(I,J+1)+Map_(I+1,J)+Map_(I,J-1)
END FUNCTION
END
|
|