home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / games / basic-1.zip / HIQUE.BAS < prev    next >
BASIC Source File  |  1983-11-02  |  6KB  |  143 lines
  1. 1 '             *** HIQUE *** 
  2. 2 '             by Wes Meier (70215,1017) 
  3. 3 ' 
  4. 4 '             Written for IBM PC with 80 Column Color. 
  5. 5 '             Requires BASICA. 
  6. 6 '             Supports Light Pen Operation. 
  7. 7 ' 
  8. 8 SCREEN 0,1:KEY OFF:LOCATE ,,0,0,7:COLOR 6,1,1:CLS 
  9. 9 DEFINT B-Z:DEFSTR A:DIM P(33),L(33),T(33),L2T(33) 
  10. 10 DEF SEG=0:POKE &H417,96:DEF SEG 
  11. 11 A=STRING$(4,219)+STRING$(4,29)+CHR$(31)+STRING$(4,219)+CHR$(30)+"  " 
  12. 12 AB=CHR$(218)+STRING$(2,196)+CHR$(191)+STRING$(4,29)+CHR$(31) 
  13. 13 AB=AB+CHR$(192)+STRING$(2,196)+CHR$(217)+CHR$(30)+"  " 
  14. 14 MOVE=0:PEGS=32 
  15. 15 A(1)="       1  2  3" 
  16. 16 A(2)="       4  5  6" 
  17. 17 A(3)=" 7  8  9 10 11 12 13" 
  18. 18 A(4)="14 15 16 17 18 19 20" 
  19. 19 A(5)="21 22 23 24 25 26 27" 
  20. 20 A(6)="      28 29 30" 
  21. 21 A(7)="      31 32 33" 
  22. 22 A(8)="  Board Numbering" 
  23. 23 FULL=-1:EMPTY=NOT FULL 
  24. 24 GOSUB 25:GOTO 26 
  25. 25 FOR X=1 TO 33:P(X)=FULL:NEXT:P(17)=EMPTY:RETURN 
  26. 26 DATA 1,1,1,4,4,4,7,7,7,7,7,7,7,10,10,10,10,10,10,10,13,13,13,13,13,13,13 
  27. 27 DATA 16,16,16,19,19,19 
  28. 28 DATA 32,38,44,32,38,44,20,26,32,38,44,50,56,20,26,32,38,44,50,56,20,26,32 
  29. 29 DATA 38,44,50,56,32,38,44,32,38,44 
  30. 30 FOR X=1 TO 33:READ L(X):NEXT 
  31. 31 FOR X=1 TO 33:READ T(X):L2T(X)=L(X)^2-T(X):NEXT 
  32. 32 PEN ON 
  33. 33 ON PEN GOSUB 63 
  34. 34 USE.PEN=-1 
  35. 35 PRINT TAB(30);:COLOR 20,7:PRINT" *** HIQUE *** ":COLOR 6,1:PRINT 
  36. 36 PRINT"HIQUE is a puzzle that has 32 pegs or blocks arranged in a cross shape with the" 
  37. 37 PRINT"center position of the cross empty. Your task is to is to remove as many pegs" 
  38. 38 PRINT"as you can. A fantastic solution is one that has only one peg remaining." 
  39. 39 PRINT"The PERFECT game ends with the one peg remaining in the center position!" 
  40. 40 PRINT 
  41. 41 PRINT"Rules:" 
  42. 42 PRINT"     - Pegs are removed ONLY when they are JUMPED by another peg." 
  43. 43 PRINT"     - You may jump ONLY One peg at a time." 
  44. 44 PRINT"     - You may jump ONLY vertically or horizontally...NOT diagonally." 
  45. 45 PRINT"     - You may jump ONLY into an EMPTY space." 
  46. 46 PRINT 
  47. 47 PRINT"Don't worry about making a mistake, HIQUE won't let you!" 
  48. 48 PRINT:PRINT"Now, press any key to start the puzzle or, if you have a light pen," 
  49. 49 PRINT"touch the screen........";:COLOR 20,7:PRINT"   GOOD LUCK !!   "; 
  50. 50 PENFLAG=-1 
  51. 51 AX=INKEY$:IF AX="" THEN 51 
  52. 52 USE.PEN=0:PEN OFF 
  53. 53 GOTO 75 
  54. 54 'Draw the Cross Subroutine 
  55. 55 FOR X=1 TO 33 
  56. 56 LOCATE L(X),T(X) 
  57. 57 IF P(X)=FULL THEN PRINT A; ELSE PRINT AB; 
  58. 58 NEXT 
  59. 59 IF USE.PEN THEN RETURN 
  60. 60 LOCATE 1,1 
  61. 61 FOR X=1 TO 8:PRINT A(X);:PRINT:NEXT 
  62. 62 RETURN 
  63. 63 'Light Pen Subroutine 
  64. 64 IF PENFLAG THEN PENFLAG=0:RETURN 75 
  65. 65 IF PEN(8)=24 THEN MOVE=0:PEGS=32:GOSUB 25:CLS:RETURN 75 
  66. 66 L=0:FOR X=1 TO 33:IF PEN(8)=L(X) OR PEN(8)=L(X)+1 THEN L=L(X):X=34 
  67. 67 NEXT:IF L=0 THEN RETURN 
  68. 68 T=0:FOR X=1 TO 33 
  69. 69 IF PEN(9)>=T(X) AND PEN(9)<=T(X)+3 THEN T=T(X):X=34 
  70. 70 NEXT:IF T=0 THEN RETURN 
  71. 71 L2T=L^2-T 
  72. 72 FOR X=1 TO 33 
  73. 73 IF L2T=L2T(X) THEN PEN.MOVE=X:X=34 
  74. 74 NEXT:RETURN 
  75. 75 COLOR 6,1:CLS:GOSUB 55 
  76. 76 IF USE.PEN THEN 77 ELSE 80 
  77. 77 LOCATE 24,20:COLOR 4,7 
  78. 78 PRINT"     Touch This Area To Re-Start       "; 
  79. 79 GOTO 81 
  80. 80 LOCATE 24,32:PRINT"Enter 99 to Re-Start"; 
  81. 81 LOCATE 16,50:COLOR 4,7 
  82. 82 MOVE=MOVE+1 
  83. 83 PRINT" Move #"MOVE; 
  84. 84 LOCATE 17,50:PRINT" Pegs Remaining ="PEGS; 
  85. 85 COLOR 6,1 
  86. 86 LOCATE 22,32:PRINT STRING$(25,32); 
  87. 87 LOCATE 22,32:PRINT"Move from "; 
  88. 88 IF NOT USE.PEN THEN 92 
  89. 89 PRINT"(Touch Pen)";:PEN.MOVE=0 
  90. 90 IF PEN.MOVE=0 THEN 90 
  91. 91 MOVE.FROM=PEN.MOVE:GOTO 95 
  92. 92 INPUT MOVE.FROM:IF MOVE.FROM<>99 THEN 95 
  93. 93 MOVE=0:PEGS=32:GOSUB 25:GOTO 75 
  94. 94 SOUND 37,5:GOTO 86 
  95. 95 IF MOVE.FROM<1 OR MOVE.FROM>33 THEN 94 
  96. 96 IF P(MOVE.FROM)=EMPTY THEN 94 
  97. 97 COLOR 22:LOCATE L(MOVE.FROM),T(MOVE.FROM):PRINT A;:COLOR 6 
  98. 98 LOCATE 22,32:PRINT STRING$(25,32); 
  99. 99 LOCATE 22,32:PRINT"Move to "; 
  100. 100 IF NOT USE.PEN THEN 104 
  101. 101 PRINT"(Touch Pen)";:PEN.MOVE=0 
  102. 102 IF PEN.MOVE=0 THEN 102 
  103. 103 MOVE.TO=PEN.MOVE:GOTO 105 
  104. 104 INPUT MOVE.TO:IF MOVE.TO=99 THEN 93 
  105. 105 IF MOVE.TO>=1 AND MOVE.TO<=33 THEN 108 
  106. 106 COLOR 6:LOCATE L(MOVE.FROM),T(MOVE.FROM):PRINT A; 
  107. 107 GOTO 94 
  108. 108 IF P(MOVE.TO)=FULL THEN 106 
  109. 109 IF MOVE.FROM<4 THEN MF=MOVE.FROM-6:GOTO 114 
  110. 110 IF MOVE.FROM<7 THEN MF=MOVE.FROM-2:GOTO 114 
  111. 111 IF MOVE.FROM>30 THEN MF=MOVE.FROM+6:GOTO 114 
  112. 112 IF MOVE.FROM>27 THEN MF=MOVE.FROM+2:GOTO 114 
  113. 113 MF=MOVE.FROM 
  114. 114 IF MOVE.TO<4 THEN MT=MOVE.TO-6:GOTO 119 
  115. 115 IF MOVE.TO<7 THEN MT=MOVE.TO-2:GOTO 119 
  116. 116 IF MOVE.TO>30 THEN MT=MOVE.TO+6:GOTO 119 
  117. 117 IF MOVE.TO>27 THEN MT=MOVE.TO+2:GOTO 119 
  118. 118 MT=MOVE.TO 
  119. 119 IF ABS(MT-MF)<>2 AND ABS(MT-MF)<>14 THEN 106 
  120. 120 OP=(MF+MT)/2 
  121. 121 IF OP<2 THEN OP=OP+6:GOTO 125 
  122. 122 IF OP<7 THEN OP=OP+2:GOTO 125 
  123. 123 IF OP>32 THEN OP=OP-6:GOTO 125 
  124. 124 IF OP>27 THEN OP=OP-2 
  125. 125 IF P(OP)=EMPTY THEN 106 
  126. 126 P(MOVE.FROM)=EMPTY 
  127. 127 P(OP)=EMPTY 
  128. 128 P(MOVE.TO)=FULL 
  129. 129 PEGS=PEGS-1 
  130. 130 LOCATE L(MOVE.FROM),T(MOVE.FROM):PRINT AB; 
  131. 131 LOCATE L(OP),T(OP):PRINT AB; 
  132. 132 LOCATE L(MOVE.TO),T(MOVE.TO):PRINT A; 
  133. 133 IF PEGS>1 THEN 81 
  134. 134 LOCATE 22,30:PRINT STRING$(25,32); 
  135. 135 LOCATE 22,26:COLOR 20,7 
  136. 136 PRINT" **** You DID it !!! **** "; 
  137. 137 IF P(17)=EMPTY THEN 139 
  138. 138 LOCATE 23,24:PRINT" **** A PERFECT Game !!! **** "; 
  139. 139 COLOR 6,1 
  140. 140 FOR X=1 TO 3:FOR Y=20 TO 70:PLAY"MBT255L48N=Y;":NEXT:NEXT 
  141. 141 LOCATE 23,1 
  142. 142 END'of program.
  143.