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