home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / gam / pentos.ba < prev    next >
Text File  |  2006-10-19  |  6KB  |  88 lines
  1. 0 ' PENTOS.BA - by Bob Delbourgo
  2. 1 ' Club 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  3. 2 CLS:CLEAR500:DEFINT A-Z:PRINTCHR$(27)"p";:PRINT@11,"PENTO";:PRINT@18,"MIN";:PRINT@23,"   ";:PRINT@60,"OS";:PRINT@63,"BY";:PRINT@94," ";:PRINT@97,"D";:PRINT@132,"BOB";:PRINT@137,"ELB";:PRINT@141,"OURG";:PRINT@174," ";:PRINT@178," ";:PRINT@184,"O";
  4. 3 PRINT@203," NOW";:PRINT@208,"P";:PRINT@210,"S";:PRINT@213," ";:PRINT@216," ";:PRINT@220,"TO ";:PRINT@226,"ST";:PRINT@245," ";:PRINT@248,"RES";:PRINT@252,"ANY";:PRINT@256,"KEY";:PRINT@260," ";:PRINT@267,"AR";
  5. 4 PRINT@293," ";:PRINT@298," ";:PRINT@300," ";:PRINT@308,"T";
  6. 5 IFINKEY$=""THENR=RND(1):GOTO5
  7. 6 CLS:PRINTCHR$(27)"q";" CHOOSE :-":PRINT" (1) Checkerboard (8x8) puzzles":PRINT" (2) Pentomino triplication":PRINT" (3) Checkerboard (8x8) game"
  8. 7 I$=INKEY$:IFVAL(I$)<1ORVAL(I$)>3THEN7
  9. 8 ONVAL(I$)GOTO9,17,21
  10. 9 DIMB(11,11)
  11. 10 PRINT@161,"<S>ymmetrical or <R>andom";:INPUTI$:IFI$="S"ORI$="s"THEN13
  12. 11 IFI$="R"ORI$="r"THEN16
  13. 12 GOTO10
  14. 13 PRINT@202,"X-coordinate (1-4)";:INPUTX0:X0=INT(X0):IFX0<1ORX0>4THEN13
  15. 14 PRINT@242,"Y-coordinate (1-4)";:INPUTY0:Y0=INT(Y0):IFY0<1ORY0>4THEN14
  16. 15 CLS:GOTO24
  17. 16 PRINT@202,"Setting it up..":R1=INT(4*RND(1)+1):S1=INT(4*RND(1)+1):R2=INT(4*RND(1)+5):S2=INT(4*RND(1)+1):R3=INT(4*RND(1)+1):S3=INT(4*RND(1)+5):R4=INT(4*RND(1)+5):S4=INT(4*RND(1)+5):CLS:GOTO24
  18. 17 PRINT@162,"Choose the pentomino # (1-12)";:INPUTN:N=INT(N):IFN<1ORN>12THENBEEP:GOTO17
  19. 18 IFN=1THENDIMB(18,9)
  20. 19 IFN>1THENDIMB(18,12)
  21. 20 NN=3:PRINT@202,"Here the object is to fill the triply   scaled area with any NINE pentominos.":FORTT=1TO35:GOSUB76:NEXTTT:CLS:I$="Q":GOTO24
  22. 21 PRINT@162,"First player name";:INPUTP$(1):IFLEN(P$(1))>11THENBEEP:GOTO21
  23. 22 PRINT@202,"Second player name";:INPUTP$(2):IFLEN(P$(2))>11THENBEEP:GOTO22
  24. 23 PRINT"  Now insert the pentominos alternately   The last to enter successfully wins..";:DIMB(11,11):I$="P":FORTT=1TO35:GOSUB76:NEXTTT:CLS
  25. 24 DIMA$(12):A$(1)="0000000000111110000000000":A$(2)="0000000000011110100000000":A$(3)="0000000000111100010000000":A$(4)="0000001100001110000000000":A$(5)="0000001000011100001000000":A$(6)="0000001000011100010000000":A$(7)="0000000100111000010000000"
  26. 25 A$(8)="0000000111001000010000000":A$(9)="0000000000011100110000000":A$(10)="0000000100011100010000000":A$(11)="0000001010011100000000000":A$(12)="0000001100001100001000000":H$="111111111111"
  27. 26 IFI$="r"ORI$="R"ORI$="S"ORI$="s"ORI$="P"THENFORI=2TO9:FORJ=2TO9:B(I,J)=1:NEXTJ,I
  28. 27 IFI$="s"ORI$="S"THENBX=X0+1:BY=Y0+1:GOSUB75:BX=10-Y0:BY=X0+1:GOSUB75:BX=Y0+1:BY=10-X0:GOSUB75:BX=10-X0:BY=10-Y0:GOSUB75:GOTO31
  29. 28 IFI$="r"ORI$="R"THENBX=R1+1:BY=S1+1:GOSUB75:BX=R2+1:BY=S2+1:GOSUB75:BX=R3+1:BY=S3+1:GOSUB75:BX=R4+1:BY=S4+1:GOSUB75:GOTO31
  30. 29 FORI=1TO5:FORJ=1TO4:IFMID$(A$(N),I+5*J,1)="1"THENFORP=0TO2:FORQ=0TO2:B(3*I+P-1,3*J+Q-1)=1:LINE(90+12*I+4*P,-3+12*J+4*Q)-(91+12*I+4*P,-2+12*J+4*Q),1,B:NEXTQ,P
  31. 30 NEXTJ,I
  32. 31 GOSUB77:LINE(90,0)-(90,63):PRINT@256,"U,D,L,R -- left cursor";:PRINT@296,"Arrows -- board cursor";:IFI$="Q"THEN32ELSEFORI=1TO8:FORJ=1TO8:LINE(98+4*I,5+4*J)-(99+4*I,6+4*J),1,B:NEXTJ,I
  33. 32 PRINT@27,"<Q>uit";:PRINT@67,"<I>nsert";:PRINT@107,"<A>nticlock.";:PRINT@147,"<C>lockwise";:PRINT@187,"<M>irror";:XC=10:YC=9:HC=1:BX=5:BY=5:PP=1:IFI$="Q"THENBX=8
  34. 33 W=0:XB=4*BX+94:YB=1+4*BY:PRINT@227,CHR$(27)"p";P$(PP);CHR$(27)"q";
  35. 34 LINE(XB,YB)-(XB+1,YB+1),0,BF:LINE(XC,YC)-(XC+1,YC+1),1,B:GOSUB76:GOSUB76:LINE(XB,YB)-(XB+1,YB+1),1,BF:LINE(XC,YC)-(XC+1,YC+1),0,B:K$=INKEY$:IFK$=""THENGOSUB76:GOTO34
  36. 35 K=INSTR("QqIiAaCcMmRrLlUuDd"+CHR$(28)+CHR$(29)+CHR$(30)+CHR$(31),K$):IFK=0THEN33
  37. 36 ONK GOTO37,37,38,38,44,44,42,42,46,46,47,47,52,52,57,57,61,61,65,67,69,71
  38. 37 RUN
  39. 38 PRINTCHR$(27)"p";:PRINT@227,"CHECKING";CHR$(27)"q";:GOSUB84:PRINT@227,SPACE$(11);:IFW=1THENBEEP:GOTO33
  40. 39 U=1:GOSUB81:NN=NN+1:LINE(XC-9,YC-9)-(XC+10,YC+10),0,BF:MID$(H$,HC,1)="0":A$(HC)=STRING$(15,"0"):PRINT@227,SPACE$(8);:IFNN=12THEN73
  41. 40 PP=PP+1:IFPP=3THENPP=1
  42. 41 GOTO33
  43. 42 A1$="":A2$="":A3$="":A4$="":A5$="":FORJ=21TO1STEP-5:A1$=A1$+MID$(A$(HC),J,1):A2$=A2$+MID$(A$(HC),J+1,1):A3$=A3$+MID$(A$(HC),J+2,1):A4$=A4$+MID$(A$(HC),J+3,1):A5$=A5$+MID$(A$(HC),J+4,1):NEXTJ:A$(HC)=A1$+A2$+A3$+A4$+A5$
  44. 43 LINE(XC-9,YC-9)-(XC+10,YC+10),0,BF:X=XC-9:Y=YC-9:U=0:GOSUB82:GOTO33
  45. 44 A1$="":A2$="":A3$="":A4$="":A5$="":FORJ=5TO25STEP5:A1$=A1$+MID$(A$(HC),J,1):A2$=A2$+MID$(A$(HC),J-1,1):A3$=A3$+MID$(A$(HC),J-2,1):A4$=A4$+MID$(A$(HC),J-3,1):A5$=A5$+MID$(A$(HC),J-4,1):NEXTJ:LINE(XC-9,YC-9)-(XC+10,YC+10),0,BF
  46. 45 A$(HC)=A1$+A2$+A3$+A4$+A5$:X=XC-9:Y=YC-9:U=0:GOSUB82:GOTO33
  47. 46 A1$=LEFT$(A$(HC),5):A5$=RIGHT$(A$(HC),5):A2$=MID$(A$(HC),6,5):A4$=MID$(A$(HC),16,5):A$(HC)=A5$+A4$+MID$(A$(HC),11,5)+A2$+A1$:LINE(XC-9,YC-9)-(XC+10,YC+10),0,BF:X=XC-9:Y=YC-9:U=0:GOSUB82:GOTO33
  48. 47 XC=XC+22:IFXC>88THENXC=XC-88:YC=YC+21
  49. 48 IFYC>63THENYC=YC-63
  50. 49 HC=HC+1:IFHC>12THENHC=1
  51. 50 IFMID$(H$,HC,1)="0"THEN47
  52. 51 GOTO33
  53. 52 XC=XC-22:IFXC<0THENXC=XC+88:YC=YC-21
  54. 53 IFYC<0THENYC=YC+63
  55. 54 HC=HC-1:IFHC<1THENHC=12
  56. 55 IFMID$(H$,HC,1)="0"THEN52
  57. 56 GOTO33
  58. 57 YC=YC-21:HC=HC-4:IFYC<0THENYC=YC+63:XC=XC-22:HC=HC+11
  59. 58 IFXC<0THENXC=XC+88:HC=12
  60. 59 IFMID$(H$,HC,1)="0"THEN57
  61. 60 GOTO33
  62. 61 YC=YC+21:HC=HC+4:IFYC>63THENYC=YC-63:XC=XC+22:HC=HC-11
  63. 62 IFXC>88THENXC=XC-88:YC=9:HC=1
  64. 63 IFMID$(H$,HC,1)="0"THEN61
  65. 64 GOTO33
  66. 65 BX=BX+1:IFB(BX,BY)=0THENBEEP:BX=BX-1
  67. 66 GOTO33
  68. 67 BX=BX-1:IFB(BX,BY)=0THENBEEP:BX=BX+1
  69. 68 GOTO33
  70. 69 BY=BY-1:IFB(BX,BY)=0THENBEEP:BY=BY+1
  71. 70 GOTO33
  72. 71 BY=BY+1:IFB(BX,BY)=0THENBEEP:BY=BY-1
  73. 72 GOTO33
  74. 73 PRINT@227,"SUCCESS!";:FORT=1TO20:NEXTT:PRINT@227,"        ";:FORT=1TO15:NEXTT:I$=INKEY$:IFI$=""THEN73
  75. 74 IFINSTR("Qq",I$)=0THEN73ELSERUN
  76. 75 LINE(4*BX+93,4*BY)-(4*BX+96,4*BY+3),1,B:B(BX,BY)=2:RETURN
  77. 76 FORT=1TO20:NEXTT:RETURN
  78. 77 X=1:Y=0:FORI=1TO12:IFMID$(H$,I,1)="0"THEN80
  79. 78 FORJ=0TO24:JJ=INT(J/5):IFMID$(A$(I),J+1,1)="1"THENLINE(X+4*J-20*JJ,Y+4*JJ)-(X+4*J-20*JJ+3,Y+4*JJ+3),1,B
  80. 79 NEXTJ:X=X+22:IFX>88THENX=X-88:Y=Y+21
  81. 80 NEXTI:RETURN
  82. 81 X=XB-9:Y=YB-9
  83. 82 FORJ=0TO24:JJ=INT(J/5):IFMID$(A$(HC),J+1,1)="1"THENLINE(X+4*J-20*JJ,Y+4*JJ)-(X+4*J-20*JJ+3,Y+4*JJ+3),1,B:IFU=1THENB(BX-2+J-5*JJ,BY-2+JJ)=2
  84. 83 NEXTJ:RETURN
  85. 84 W=0:FORI=1TO5:FORJ=0TO4:IFMID$(A$(HC),I+5*J,1)="0"THEN86
  86. 85 XX=BX-3+I:YY=BY-2+J:IFB(XX,YY)=0ORB(XX,YY)=2THENW=1:I=6:J=5:NEXTJ,I:RETURN
  87. 86 NEXTJ,I:RETURN
  88.