home *** CD-ROM | disk | FTP | other *** search
/ RUN Flagazine Extra: Special 1 / run-special-1.zip / DOOLHOF.BAS < prev    next >
BASIC Source File  |  1990-07-06  |  3KB  |  46 lines
  1. 100 REM DRIE-D DOOLHOF GWBASIC CGA/EGA (C) MICHIEL DE BONDT
  2. 110 CLS:SCREEN 0:KEY OFF:RANDOMIZE TIMER:DEF SEG=0:POKE 1047,PEEK(1047) OR 32
  3. 120 LOCATE 14,22:INPUT"Geef breedte, diepte voor dit doolhof";X,Y
  4. 130 XD=2*X+2:YD=2*Y+2:D=-YD*(YD>XD)-XD*(XD>=YD):DIM D%(D,D):SCREEN 2:AH=.31
  5. 140 WINDOW(.3,.3)-(-.3,-.3):LOCATE 1,27:PRINT"Het doolhof wordt gemaakt..."
  6. 150 W$(0)="Noord":W$(1)="Oost ":W$(2)="Zuid ":W$(3)="West "
  7. 160 A=INT(XD/2) AND -2:D%(A,0)=16:D%(A,1)=1:D%(A,YD-1)=1:D%(A,YD)=16
  8. 170 FOR X=1 TO XD-1 STEP 2:D%(X,2)=2*(X>A)+1:NEXT
  9. 180 FOR Y=YD-2 TO 4 STEP-2:PRINT "*";:FOR X=2 TO XD-2 STEP 2
  10. 190 A=(INT(RND+.3)OR-(Y=YD-2))*(X<XD-2)*D%(X+1,2):IF A THEN D%(X+1,2)=-D%(X+1,2)
  11. 200 C=A=-1 OR B=1 OR -D%(X,Y+1):R=(INT(RND*(3+C))*2-1) MOD 3
  12. 210 IF R AND D%(X+R,2)=R THEN D%(X+R,Y)=1 ELSE D%(X,Y+1+2*C)=1
  13. 220 D%(X,Y)=1:B=A:NEXT X,Y:FOR X=2 TO XD-2:D%(X,2)=1:NEXT:D%(1,2)=0:D%(XD-1,2)=0
  14. 230 FOR Y=0 TO YD:PRINT "*";:FOR X=2 TO XD-2:A=D%(X,Y) AND 17:IF A=0 THEN 250
  15. 240 SWAP X,Y:X=D-X:FOR K=1 TO 3:A=A*2:D%(X,Y)=D%(X,Y)+A:SWAP X,Y:X=D-X:NEXT
  16. 250 NEXT X,Y:X=INT(XD/2) AND -2:Y=1
  17. 260 I$=INKEY$:I=VAL(I$):IF I$>"" THEN 360
  18. 270 CLS:LOCATE 25,38:PRINT W$(W);:FOR S=-1 TO 1 STEP 2:T=Y:A=2
  19. 280 IF (D%(X+S,T) AND 2^W)=0 AND (D%(X,T) AND 2^W) THEN 320
  20. 290 B=ABS(T-Y)+3:IF A=B THEN 320 ELSE FOR H=-1 TO 1 STEP 2
  21. 300 LINE(S/(A-1),H/A)-(S/A,H/A):LINE(S/A,H/A)-(S/B,H/B):NEXT
  22. 310 LINE(S/A,1/A)-(S/A,-1/A):LINE(S/B,1/B)-(S/B,-1/B):A=B+1
  23. 320 C=(D%(X,T) AND 2^W*17)/2^W:IF C AND 1 THEN T=T+1:GOTO 280
  24. 330 FOR H=-1 TO 1 STEP 2:P=H=(C>15):Q=-P*S/(B+9)
  25. 340 LINE(S/(A-1),H/B)-(Q,H/B*(P+1)-Q*S):NEXT H,S
  26. 350 I$=INKEY$:I=VAL(I$):IF I$="" THEN 350
  27. 360 IF I$="O" OR I$="o" THEN GOSUB 410:GOTO 260 ELSE IF I=0 THEN 260
  28. 370 K=((I-1) MOD 3)-1:L=CINT((I-5)/3):IF D%(X,Y+L) AND 2^W*17 THEN Y=Y+L
  29. 380 Y=Y+(ABS(K) AND Y):IF D%(X,Y) AND 2^W*16 THEN 460 ELSE IF K=0 THEN 400
  30. 390 W=(W+K+4) MOD 4:SWAP X,Y:IF K=1 THEN X=D-X ELSE Y=D-Y
  31. 400 GOTO 260
  32. 410 WINDOW(1,1)-(D,D):CLS:PAINT(D,D):FOR YT=1 TO YD-1:FOR XT=2 TO XD-2
  33. 420 IF D%(XT,YT) AND 1 THEN LINE(XT,YT)-(XT+1,YT+1),0,B:PAINT(XT+.5,YT+.5),0
  34. 430 NEXT XT,YT:XV=X:YV=Y:FOR K=1 TO W:SWAP XV,YV:YV=D-YV:NEXT
  35. 440 CIRCLE(XV+.5,YV+.5),.4,,,,AH:PAINT(XV+.5,YV+.5)
  36. 450 IF INKEY$="" THEN 450 ELSE WINDOW(-.3,-.3)-(.3,.3):RETURN
  37. 460 IF Y=YD AND W=0 OR Y=0 AND W=2 THEN Y=Y-1+W:GOTO 480 ELSE Y=Y+1-W
  38. 470 LOCATE 14,17:PRINT"Dit is de INgang. Je moet naar de UITgang.":GOTO 350
  39. 480 LOCATE 14,22:PRINT"Je hebt de uitgang gevonden! Proficiat!"
  40. 490 IF INKEY$="" THEN 490 ELSE GOSUB 410:DEF SEG:SCREEN 0
  41. 500 REM /* 39/.4460,4798,4287,4928,3470,3466,2552,3151,4199,2961
  42. 510 REM /*/....3125,4373,4010,4393,1879,2095,3414,2891,2912,3310
  43. 520 REM /*/....3100,3154,2424,2534,2093,3406,3738,3760,3087,0465
  44. 530 REM /*/....3956,4232,3921,2843,3228,3678,4987,4603,3024
  45. 540 REM Checksum...............:  132907
  46.