home *** CD-ROM | disk | FTP | other *** search
/ Generous Efforts of Many / gemcd.zip / GEM.CD.B.po / GAMES:BASIC.4 / TOWERS2.bas < prev    next >
BASIC Source File  |  2010-05-14  |  9KB  |  152 lines
  1. 2  REM  *** TOWERS.TXT
  2. 100  REM  **    THIS VERSION DOES NOT NEED ARRAY TO SOLVE 'NEXT MOVE'-- SEE SUB 600-.
  3. 110  PRINT  CHR$(17): PRINT  CHR$(4);"PR#0": TEXT : HOME : PRINT ,"-- TOWERS OF HANOI --"
  4. 120  PRINT : DIM P(3,36)
  5. 130  PRINT "OBJECT IS TO GET ALL RINGS,","LEGALLY, ONTO FAR RIGHT PEG."
  6. 140  PRINT 
  7. 150  PRINT "YOU MOVE ONE RING AT A TIME,","AND MAY NOT STACK A LARGER RING","ONTO A SMALLER RING."
  8. 160  PRINT 
  9. 170  PRINT ,: INPUT "# OF RINGS ? (1-35) ?";RG: IF RG >35  OR RG <1  THEN  CALL  -1052: GOTO 170
  10. 180  PRINT : PRINT : PRINT : INPUT "WANT COMPUTER TO SOLVE PUZZLE ?                 -(Y/N) ?";CT$: PRINT : PRINT : PRINT 
  11. 200 L =  INT(35/RG)
  12. 210 W = 0:T = 0:WD =  INT(4/RG +1)
  13. 220  FOR N = 1 TO RG
  14. 230 P(1,N) = N:P(2,N) = 0:P(3,N) = 0
  15. 240  NEXT N
  16. 250 C = 5
  17. 260  GR 
  18. 270  FOR X = 1 TO 3
  19. 280  COLOR= C
  20. 290  HLIN 1,39 AT 40 -X
  21. 300  VLIN 0,39 AT 10 *X
  22. 310  FOR Y = 1 TO RG
  23. 320  IF P(X,Y) = 0  THEN 370
  24. 330 D = P(X,Y): IF D >9  THEN D = 9
  25. 340  COLOR= Y: IF Y = 16  OR Y = 32  THEN  COLOR= Y +1
  26. 350 BZ =  PEEK(49200) + PEEK(49200) + PEEK(49200)
  27. 360  HLIN 10 *X -WD *D,10 *X +WD *D AT L *P(X,Y)
  28. 370  NEXT Y
  29. 380  VTAB 21: PRINT  TAB( 11)"1" TAB( 21)"2" TAB( 31)"3"
  30. 390  NEXT X
  31. 400 T = T +1
  32. 410  FOR N = 1 TO RG
  33. 420  IF P(3,N) = 0  THEN 450
  34. 430  NEXT N
  35. 440 W = 1: GOTO 860
  36. 450  VTAB 21: HTAB 1: PRINT  TAB( 11)"1" TAB( 21)"2" TAB( 31)"3       "
  37. 460  IF CT$ >"NO"  THEN  GOSUB 690: VTAB 23: PRINT T" COMPUTER MOVE IS "A" TO "B":  -RETURN-";:BZ =  PEEK(49200): GOTO 550
  38. 470  VTAB 23: PRINT "MOVE FROM PEG # ? ";: GET A$: PRINT A$;:A =  VAL(A$)
  39. 480  VTAB 23: HTAB 20: PRINT "...TO PEG # ? ";: GET B$: PRINT B$:B =  VAL(B$)
  40. 490  PRINT "C=CHANGE  Q=QUIT  H=HELP RETURN=MOVE ";: GET A$: PRINT A$:BZ =  PEEK(49200) + PEEK(49200)
  41. 500  IF A$ = "C"  THEN  PRINT : PRINT : VTAB 21: HTAB 1: PRINT  TAB( 11)"1" TAB( 21)"2" TAB( 31)"3        ": GOTO 470
  42. 510  IF A$ = "Q"  THEN 860
  43. 520  IF A$ = "H"  THEN  PRINT : PRINT : PRINT : GOSUB 650: GOSUB 690: VTAB 23: PRINT "-I SUGGEST "A" TO "B" AS "T" MOVE: -RETURN- ";: GET B$:BZ =  PEEK(49200) + PEEK(49200)
  44. 530  PRINT : PRINT : PRINT : VTAB 21: HTAB 1: PRINT  TAB( 11)"1" TAB( 21)"2" TAB( 31)"3        "
  45. 540  IF A <1  OR A >3  OR B <1  OR B >3  THEN 600: REM  --ILLEGAL MOVE--
  46. 550 Q = 0: FOR N = 1 TO RG:Q = Q +P(B,N): IF P(A,N) = 0  OR Q >0  THEN  NEXT N: GOTO 600
  47. 560  REM   *** CLEAR JUMP TO 315             FOR MOVE.  ***
  48. 570  COLOR= 0: HLIN 10 *A -9,10 *A +9 AT L *P(A,N): COLOR= C: PLOT 10 *A,L *P(A,N): COLOR= N: IF N = 16  OR N = 32  THEN  COLOR= N +1
  49. 580 D = P(A,N): IF D >9  THEN D = 9
  50. 590  HLIN 10 *B -WD *D,10 *B +WD *D AT L *P(A,N):P(B,N) = P(A,N):P(A,N) = 0: GOTO 400
  51. 600  PRINT : INVERSE : PRINT ,"ILLEGAL  MOVE !": NORMAL : FOR N = 1 TO 200:BZ =  PEEK(49200): NEXT 
  52. 610  PRINT 
  53. 620  CALL  -1052
  54. 630  GOTO 470
  55. 640  REM  ** SUB TO NUMBER PEGS**
  56. 650  VTAB 21: HTAB 1: PRINT  TAB( 11)"1" TAB( 21)"2" TAB( 31)"3        ": RETURN 
  57. 660  REM  *********************
  58. 670  REM  * SUB TO GET MOVE-  *
  59. 680  REM  *********************
  60. 690  IF T = 1  THEN A = 1:B = 3: IF RG/2 =  INT(RG/2)  THEN B = 2: RETURN 
  61. 700  FOR R = 1 TO 3:S(R) = 0
  62. 710  FOR N = 1 TO RG
  63. 720  IF P(R,N) >0  THEN S(R) = N:N = RG
  64. 730  NEXT : IF S(R) = 0  THEN S(R) = RG +1
  65. 740  NEXT 
  66. 750  REM  --NOW, ON EVEN MOVES, WILL MOVE THE MIDDLE TO THE LOWER LEVEL; ON ODD MOVES MOVE UPPER RING TO MIDDLE (IFUPP-MID IS ODD),OR UPPER TO LOWER (IF UPP-MID IS EVEN.)
  67. 760 Q = 1
  68. 770  FOR R = 1 TO 3
  69. 780  IF S(R) = 1  THEN UP = R
  70. 790  IF S(R) >Q  THEN Q = S(R):LO = R
  71. 800  NEXT 
  72. 810 MI = 6 -UP -LO
  73. 820  IF T/2 =  INT(T/2)  THEN A = MI:B = LO: RETURN 
  74. 830  IF (S(MI) -S(UP))/2 =  INT((S(MI) -S(UP))/2)  THEN A = UP:B = LO: RETURN 
  75. 840 A = UP:B = MI: RETURN 
  76. 850  REM  ***********TO MAIN.*****
  77. 860  PRINT : PRINT : PRINT : IF W = 1  THEN  GOTO 880
  78. 870  PRINT "YOU MOVED "T -1,;: FLASH : PRINT " AND FAILED !": NORMAL :S = 49200: FOR BT = 1 TO 50:BZ =  PEEK(S) + PEEK(S) + PEEK(S) + PEEK(S): NEXT BT: GOTO 900: REM   BUZZ SOUND
  79. 880  INVERSE : PRINT "YOU SOLVED PUZZLE IN "T -1" MOVES!": NORMAL 
  80. 890  FOR BL = 1 TO RG: CALL  -1052: NEXT BL: REM   BELL SOUND
  81. 900 X = 2 ^RG -1
  82. 910  PRINT "-BEST SO FAR FOR "RG" RINGS IS "X" MOVES."
  83. 920  INPUT "WANT TO PLAY AGAIN? (Y/N) ";C$
  84. 930  IF C$ >"NO"  THEN  GOTO 160
  85. 940  TEXT : HOME : PRINT "E N D .": END 
  86. 2220  PRINT D$(T,VB(T) +N): NORMAL :S =  PEEK(SS): NEXT 
  87. 2230 SB$(T) = D$(T,VB(T) +W):VB(T) = VB(T) +W:VT(F) = VT(F) -1:VB(F) = VT(F):ST$(F) = D$(F,VT(F)):SB$(F) = ST$(F):A$ =  RIGHT$(ST$(F),1): IF A$ = "D"  OR A$ = "H"  THEN  INVERSE 
  88. 2240  IF VT(T) = 0  THEN VT(T) = 1:ST$(T) = D$(T,1)
  89. 2250  FOR N = 1 TO 200: NEXT : REM  ** PAUSE **
  90. 2260  IF VT(F) >0  THEN  VTAB 4 +VT(F): HTAB 5 *F -4: PRINT "    ": VTAB 4 +VT(F): HTAB 5 *F -4: PRINT ST$(F)
  91. 2270  NORMAL : RETURN 
  92. 2280  REM  ** NOW FROM REMAINDER PILE: **
  93. 2290  VTAB 23: HTAB 15: PRINT "                ":SB$(T) = R$(Q):D$(T,VB(T) +1) = R$(Q):VB(T) = VB(T) +1:A$ =  RIGHT$(R$(Q),1): IF A$ = "D"  OR A$ = "H"  THEN  INVERSE 
  94. 2300  IF VT(T) = 0  THEN VT(T) = 1:ST$(T) = D$(T,1)
  95. 2310  VTAB 4 +VB(T): HTAB 5 *T -4: PRINT R$(Q):RT = RT -1: FOR N = Q TO (RT):R$(N) = R$(N +1): NEXT :R$(RT +1) = "":Q = Q -1: IF Q = 0  THEN Q = 3
  96. 2320  IF Q >RT  THEN Q = RT
  97. 2330  NORMAL : IF Q = RT  THEN  VTAB 23: HTAB 10: PRINT "    "
  98. 2340 A$ =  RIGHT$(R$(Q),1): IF A$ = "D"  OR A$ = "H"  THEN  INVERSE 
  99. 2350  VTAB 23: HTAB 15: PRINT R$(Q): NORMAL : RETURN 
  100. 2360  REM  ***************************************
  101. 2999  REM  #3000 ****  SUB DEAL REMAINDER  *******
  102. 3000  VTAB 23: HTAB 10: PRINT "                         ": FOR N = 1 TO 100: NEXT 
  103. 3010  IF Q = RT  THEN Q = 0
  104. 3020 Q = Q +3: IF Q >RT  THEN Q = RT
  105. 3030  VTAB 23: HTAB 15:A$ =  RIGHT$(R$(Q),1): IF A$ = "D"  OR A$ = "H"  THEN  INVERSE 
  106. 3040  PRINT R$(Q): FOR N = Q TO (RT): VTAB 23: HTAB 10: INVERSE : PRINT "****":S =  PEEK(SS): FOR P = 1 TO 20: NEXT : VTAB 23: HTAB 10: NORMAL : PRINT "    ": NEXT 
  107. 3050  IF RT >1  THEN  VTAB 23: HTAB 10: INVERSE : PRINT "****": NORMAL 
  108. 3060  IF Q = RT  THEN  VTAB 23: HTAB 10: INVERSE : PRINT "    ": NORMAL 
  109. 3070  RETURN 
  110. 3080  REM  **************************************
  111. 3999  REM  #4000 ****  SUB TO QUIT GAME  ********
  112. 4000 Z = 0: FOR H = 1 TO 7: IF VT(H) >1  THEN Z = 1:H = 7: REM  ** LOSE **
  113. 4010  NEXT : IF RT >1  THEN Z = 1: REM  **LOSE **
  114. 4020 GP = GP +1: IF Z = 0  THEN  FOR N = 1 TO 3: CALL  -1052: NEXT :GW = GW +1: REM  **WIN **
  115. 4030  IF Z = 1  THEN  FOR N = 1 TO 200:S =  PEEK(SS) + PEEK(SS): NEXT : REM  **LOSE **
  116. 4040  TEXT : HOME : VTAB 10: HTAB 20: IF Z = 0  THEN  PRINT "Y O U    W I N !!!"
  117. 4050  IF Z = 1  THEN  PRINT "Y O U     L O S E !!!"
  118. 4060  VTAB 15: HTAB 10: PRINT GW" WON / "GP" PLAYED = " INT((GW/GP) *100 +.5)" %": RETURN 
  119. 4999  REM  #5000 ******  SUB TO FIX ERROR  ******
  120. 5000  FOR N = 1 TO 200:S =  PEEK(SS) + PEEK(SS): NEXT : VTAB 23: HTAB 20: PRINT "                 ": RETURN 
  121. 5999  REM  #6000 ****  JOYSTICK SUB  ********
  122. 6000  FOR JJ = 0 TO 1  STEP 0: INVERSE :H = (5 *X -3) *(Y = 3) +2 *(Y = 1) +(20 +13 *(X = 7)) *(Y = 23)
  123. 6010  IF CS  THEN V =  VAL(F$): IF V >0  AND V <8  THEN A$ =  LEFT$(ST$(V),1)
  124. 6020  IF CS  THEN  IF V = 0  THEN A$ = "?"
  125. 6030  IF CS  THEN  IF V = 8  THEN A$ =  LEFT$(R$(Q),1)
  126. 6040  IF CS  THEN  IF F$ = "Q"  THEN A$ = F$
  127. 6050  VTAB Y: HTAB H: PRINT "-";:X1 = X:Y1 = Y: IF CS  THEN  HTAB H: PRINT A$
  128. 6060  REM  *** ADJUST JOY HERE ****
  129. 6070  FOR PP = 0 TO 1  STEP 0
  130. 6080 PX =  PDL(0): IF  PEEK(49249) >140  THEN JJ = 1:SQ = 300:PP = 1
  131. 6090 PY =  PDL(1): IF (PX >140  OR PX <114)  OR (PY >150  OR PY <104)  THEN PP = 1
  132. 6100 M =  RND(1)
  133. 6110  NEXT PP: REM  ** LOOPS TILL CHANGED **
  134. 6120 X = X +(PX >140) -(PX <114):SQ = 1 + ABS(PX -127)/10:Y = Y +20 *(PY >150) -20 *(PY <104)
  135. 6130  IF X <1  THEN X = 1
  136. 6140  IF X >7  THEN X = 7
  137. 6150  IF Y <3  THEN Y = 1
  138. 6160  IF Y = 21  THEN Y = 3
  139. 6170  IF Y >3  THEN Y = 23
  140. 6180 BZ =  PEEK(SS) + PEEK(SS): NORMAL : VTAB Y1: HTAB H: PRINT " ": FOR P = 1 TO 200/SQ: NEXT 
  141. 6190  NEXT JJ
  142. 6200 W = X1 *(Y1 = 3) +8 *(Y1 = 23)
  143. 6210 TT$ =  STR$(W): IF X1 = 7  AND Y1 = 23  THEN TT$ = "Q"
  144. 6220  RETURN : REM  ** TO PLAYER SEQUENCE **
  145. 6230  REM  *********************************
  146. 6999  REM  #7000 *** SUB INSTRUCTIONS ******
  147. 7000  HOME : SPEED= 100: IF JS  THEN 7030
  148. 7010  PRINT "PICK UP AND PLACE CARDS BY": PRINT : PRINT "TYPING THE NUMBER OF A PILE.": PRINT : PRINT : PRINT "HIT   <ANY KEY>   TWICE": PRINT : PRINT "TO SORT PILE BY THREE'S."
  149. 7020  PRINT : PRINT : PRINT "HIT   <Q>   TWICE   TO  QUIT.": GOTO 7050
  150. 7030  PRINT : PRINT : PRINT "USE JOYSTICK TO POSITION CURSOR": PRINT : PRINT "TO DESIRED PILE,  THEN": PRINT : PRINT "PRESS FIRE BUTTON TO PICK UP": PRINT : PRINT "OR PLACE CARDS.": PRINT : PRINT : PRINT 
  151. 7040  PRINT "<FIRE BUTTON> TWICE TO SORT BY THREE'S.": PRINT : PRINT : PRINT "POSITION CURSOR BY 'QUIT' AND PRESS": PRINT : PRINT "TWICE TO QUIT."
  152. 7050  SPEED= 255: VTAB 23: HTAB 2: PRINT "<SPACE BAR>  TO  BEGIN  SOLITAIRE...";: GET A$: HOME : CALL  -1052: RETURN