home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frostbyte's 1980s DOS Shareware Collection
/
floppyshareware.zip
/
floppyshareware
/
USCX
/
DOSUT-03.ZIP
/
HIQUE.BAS
< prev
next >
Wrap
BASIC Source File
|
1983-07-20
|
5KB
|
143 lines
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.