CLS:GOSUB screentitle:CLS
MENU 5,0,1,"Chinese Triangle"
MENU 5,1,1,"Credentials"
MENU 5,2,1,"Game Instructions"
MENU 5,3,1,"Game Example"
ON MENU GOSUB menuu
MENU ON
23 DIM a(15):DIM b(15):DIM c(50):DIM d(50):DIM e(50):DIM f(50):DIM g(15):DIM c1(12):DIM c2(19):DIM c3(19):DIM r(100)
DIM m(50):DIM n(50):DIM p(50)
RANDOMIZE TIMER
v=INT((15-1+1)*RND)+1:r=0
DATA 300,261,339,222,300,378,183,261,339,417,144,222,300,378,456
FOR i=1 TO 15:READ a(i):NEXT i 'a() is x-coordinate of circles
DATA 37,65,65,93,93,93,121,121,121,121,150,150,150,150,150
FOR t=1 TO 15:READ b(t):NEXT t 'b() is y-coordinate of circles
DATA 1,1,2,2,3,3,4,4,4,4,5,5,6,6,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13,13,13,14,14,15,15
FOR a1=1 TO 36:READ c(a1):NEXT a1 'column-1 of possible moves
DATA 2,3,4,5,5,6,2,7,8,5,8,9,3,5,9,10,4,8,5,9,5,8,6,9,7,12,8,13,12,8,9,14,9,13,10,14
FOR a2=1 TO 36:READ d(a2):NEXT a2 'column-2 of possible moves
DATA 4,6,7,9,8,10,1,11,13,6,12,14,1,4,13,15,2,9,3,10,2,7,3,8,4,13,5,14,11,4,6,15,5,12,6,13
FOR a3=1 TO 36:READ e(a3):NEXT a3:CLS 'column-3 of possible moves
12 CLS:PRINT:PRINT"The Player has the option of locating the empty hole or let the computer"
PRINT"select the location.":PRINT:PRINT
PRINT "Enter ' Y ' if player select or ' N ' and return if computer select."
INPUT gh$:CLS
IF gh$="Y" OR gh$="y" OR gh$="N" OR gh$="n" THEN 13 ELSE GOTO 12
13 GOSUB PAUL
CIRCLE (570,18),9,3:PAINT (570,18),3,3:GET (560,8)-(580,28),r
LOCATE 4.5,69:PRINT "Restart":LOCATE 5,71:PRINT "Game"
LINE (300,10)-(87,164):LINE (300,9)-(86,164):LINE (300,8)-(86,164):LINE (300,7)-(85,164)
LINE (87,164)-(513,164):LINE (85,165)-(516,165)
LINE (300,10)-(513,164):LINE (300,9)-(514,164):LINE (300,8)-(515,164):LINE (300,7)-(516,164)
PATTERN &H6666 'drawing of dotted lines between circles
LINE (295,41)-(266,61):LINE (305,41)-(334,61)
LINE (256,69)-(227,89):LINE (266,69)-(295,89)
LINE (334,69)-(305,89):LINE (344,69)-(373,89)
LINE (231,93)-(290,93):LINE (310,93)-(368,93)
LINE (188,117)-(217,97):LINE (227,97)-(256,117)
LINE (295,97)-(266,117):LINE (305,97)-(334,117)
LINE (373,97)-(344,117):LINE (383,97)-(412,117)
LINE (193,121)-(251,121):LINE (271,121)-(329,121):LINE (349,121)-(407,121)
LINE (149,146)-(178,125):LINE (188,125)-(217,146)
LINE (256,125)-(227,146):LINE (266,125)-(295,146)
LINE (334,125)-(305,146):LINE (344,125)-(373,146)
LINE (412,125)-(383,146):LINE (422,125)-(451,146)
LINE (154,150)-(212,150):LINE (232,150)-(290,150)
LINE (310,150)-(368,150):LINE (388,150)-(446,150):PATTERN -1
IF gh$="y" THEN LOCATE 23,3:PRINT "Select Black Hole location by hitting left mouse on an orange circle.";
IF gh$<>"y" THEN t1=TIMER:t2=0:LOCATE 23,32:PRINT "Play Time= ";
FOR n=1 TO 15:b1=3:g(n)=n 'loop for initial yellow circles
IF gh$="y" THEN b1=3
PUT (a(n)-10,b(n)-10),r
IF n=v AND gh$<>"y" THEN b1=2:CIRCLE (a(n),b(n)),9,b1:PAINT (a(n),b(n)),b1,b1
IF b1=2 THEN f(n)=0
IF b1=3 THEN f(n)=1
NEXT n
click:
WHILE MOUSE(0)=0
IF gh$<>"y" AND gh$<>"p" THEN t2=TIMER:LOCATE 23,42:PRINT t3;
IF gh$="p" THEN t2=TIMER:LOCATE 23,42:PRINT t3;
t3=INT(t2-t1)
IF MOUSE(0)<>0 THEN ppp
WEND
ppp:
FOR z=1 TO 15:j=ABS(a(z)-MOUSE(1)):k=ABS(b(z)-MOUSE(2))
IF MOUSE(1)>560 AND MOUSE(1)<580 AND MOUSE(2)>10 AND MOUSE(2)<30 AND POINT (301,7)=1 THEN GOSUB restart
IF gh$="y" AND j<9 AND k<9 AND f(z)=1 THEN GOSUB mio
IF j<9 AND k<9 AND f(z)=1 THEN r=g(z):GOTO click
IF j<9 AND k<9 AND f(z)=0 THEN GOTO pip
NEXT z:GOTO click
pip:
FOR s=1 TO 36
IF r=c(s) AND z<>e(s) THEN s=s+1
IF r=c(s) AND z=e(s) THEN GOTO lip
NEXT s:GOTO click
lip: 'see if yellow yellow black
IF f(c(s))=1 AND f(d(s))=1 AND f(e(s))=0 THEN GOTO hop
GOTO click
hop:
IF POINT (301,7)=0 THEN PSET (301,7)
CIRCLE (a(c(s)),b(c(s))),9,2
PAINT (a(c(s)),b(c(s))),2,2:f(c(s))=0 'change yellow to black on column 1
CIRCLE (a(d(s)),b(d(s))),9,2
PAINT (a(d(s)),b(d(s))),2,2:f(d(s))=0 'change yellow to black on column 2
CIRCLE (a(e(s)),b(e(s))),9,3
PAINT (a(e(s)),b(e(s))),3,3:f(e(s))=1 'change black to yellow on column 3
pm=0:FOR lr=1 TO 36
IF c(s)=c(lr) THEN m(lr)=2
IF c(s)=d(lr) THEN n(lr)=2
IF c(s)=e(lr) THEN p(lr)=2
IF d(s)=c(lr) THEN m(lr)=2
IF d(s)=d(lr) THEN n(lr)=2
IF d(s)=e(lr) THEN p(lr)=2
IF e(s)=c(lr) THEN m(lr)=3
IF e(s)=d(lr) THEN n(lr)=3
IF e(s)=e(lr) THEN p(lr)=3
IF m(lr)=3 AND n(lr)=3 AND p(lr)=2 THEN pm=pm+1
NEXT lr
IF pm=0 THEN GOSUB WIN:GOSUB restart
GOTO click
END
WIN: 'sub to determine user competence
LINE (190,73)-(410,113),2,bf
COLOR 3,2:LOCATE 12,32:PRINT "NO MORE MOVES"
FOR ttu=1 TO 13500:NEXT ttu:COLOR 1,0 'a dummy timer to keep screen
xm=0:FOR tv=1 TO 36
IF m(tv)=3 AND c(tv)>c(tv-1) THEN xm=xm+1 'determines # of orange circles
NEXT tv
CLS:PRINT:PRINT "This game was played with the abilities of a:"
PRINT " (You left";
COLOR 3
PRINT xm;
COLOR 1
PRINT "pegs on the board)"
LINE (409,35)-(409,175),2:LINE (410,35)-(410,175),2
LINE (430,35)-(430,175),2:LINE (431,35)-(431,175),2
LINE (409,35)-(431,35),2:LINE (409,175)-(431,175),2
LOCATE 6,24:PRINT "Rocket Scientist............"
LOCATE 8,24:PRINT "Neurosurgeon................"
LOCATE 10,24:PRINT "College Graduate............"
LOCATE 12,24:PRINT "College Student............."
LOCATE 16,24:PRINT "High School Student........."
LOCATE 18,24:PRINT "Elementary Student.........."
LOCATE 21,24:PRINT "Small Child................."
IF xm=8 THEN y=45 '8 pegs left on board
IF xm=1 THEN y=61 '1 peg left on board
IF xm=2 THEN y=77 '2 pegs left on board
IF xm=3 THEN y=94 '3 pegs left on board
IF xm=4 THEN y=126 '4 pegs left on board
IF xm=5 THEN y=142 '5 pegs on left board
IF xm=6 XOR xm=7 OR xm>8 THEN y=166 '6 or 7 or >8 pegs left on board
LINE (411,36)-(429,y-1),1,bf
LINE (411,y)-(429,174),3,bf
LOCATE 23,1:INPUT "Press Enter to continue";hju:CLS
RETURN
restart:
LOCATE 1,1:CLEAR:CLS:PATTERN &HFFFF
RESTORE:GOTO 23
RETURN
mio: 'sub for user select black hole
IF gh$="y" AND MOUSE(0)=1 THEN t1=TIMER ELSE RETURN
GOSUB PAUL
CIRCLE (a(z),b(z)),9,2:PAINT (a(z),b(z)),2,2:gh$="p"
f(z)=0:LOCATE 23,3:PRINT " ";
LOCATE 23,32:PRINT "Play Time= ";
RETURN
PAUL: 'sub for determining if col 1,2, 3 is orange or black
FOR dt=1 TO 36
m(dt)=3:n(dt)=3:p(dt)=3 'all columns are orange
IF gh$<>"y" AND v=c(dt) THEN m(dt)=2 'col-1 @ v is black
IF gh$<>"y" AND v=d(dt) THEN n(dt)=2 'col-2 @ v is black
IF gh$<>"y" AND v=e(dt) THEN p(dt)=2 'col-3 @ v is black
IF gh$="y" AND z=c(dt) THEN m(dt)=2 'col-1 @ v is black
IF gh$="y" AND z=d(dt) THEN n(dt)=2 'col-2 @ v is black
IF gh$="y" AND z=e(dt) THEN p(dt)=2 'col-3 @ v is black
NEXT dt
RETURN
menuu: 'subroutine FOR MENU
IF MENU(1)=1 THEN GOSUB Credentials
IF MENU(1)=2 THEN GOSUB Instructions
IF MENU(1)=3 THEN GOSUB Example
RETURN
Credentials: 'sub for displaying authors name and address
WINDOW 3,"Credentials",(0,100)-(300,180)
LOCATE 1,1:PRINT "This program was written for Public"
LOCATE 2,1:PRINT "Domain use by:"
LOCATE 3,16:PRINT "Russell Mason"
LOCATE 4,16:PRINT "5225 Old Hixson"
LOCATE 5,16:PRINT "Hixson, Tn."
LOCATE 7,16:PRINT "February, 1991"
LOCATE 8,16:PRINT "Release 1.1"
LOCATE 10,1:INPUT "Enter any key to continue";q2$
WINDOW CLOSE 3
RETURN
Instructions: 'sub for game instructions.
WINDOW 4,"Instructions",(0,10)-(615,186)
PRINT"Welcome to the world of the Chinese Triangle. This game is similar"
PRINT"to chinese checkers and can be found on many restaurant tables."
PRINT"The game consists of 14 pegs (represented by orange circles) and one"
PRINT"empty hole (represented by a black circle) in a triangular configuration.":PRINT
PRINT"The game is played like checkers, except in a triangular formation."
PRINT"A move is started by depressing the left mouse button once on a orange"
PRINT"circle and once on a black circle. The two circles must be connected"
PRINT"by a dotted line and separated by a orange circle.":PRINT
PRINT"The object is to leave only one peg on the board and in the original"
PRINT"empty hole. The ultimate challenge will be to have eight pegs on the"
PRINT"board and no possible moves. This is extremely difficult to accomplish."
PRINT"Leaving 2 or 3 pegs on the board can be considered to be average.":PRINT
INPUT "Enter any key to continue";gg$
WINDOW CLOSE 4:RETURN
Example: 'sub for game example
WINDOW 5,"Game Example",(0,0)-(580,186)
CLS:LINE (300,10)-(87,164):LINE (300,9)-(86,164):LINE (300,8)-(86,164):LINE (300,7)-(85,164)
LINE (87,164)-(513,164):LINE (85,165)-(516,165)
LINE (300,10)-(513,164):LINE (300,9)-(514,164):LINE (300,8)-(515,164):LINE (300,7)-(516,164)
PATTERN &H6666 'drawing of dotted lines between circles
LINE (295,41)-(266,61):LINE (305,41)-(334,61)
LINE (256,69)-(227,89):LINE (266,69)-(295,89)
LINE (334,69)-(305,89):LINE (344,69)-(373,89)
LINE (231,93)-(290,93):LINE (310,93)-(368,93)
LINE (188,117)-(217,97):LINE (227,97)-(256,117)
LINE (295,97)-(266,117):LINE (305,97)-(334,117)
LINE (373,97)-(344,117):LINE (383,97)-(412,117)
LINE (193,121)-(251,121):LINE (271,121)-(329,121):LINE (349,121)-(407,121)
LINE (149,146)-(178,125):LINE (188,125)-(217,146)
LINE (256,125)-(227,146):LINE (266,125)-(295,146)
LINE (334,125)-(305,146):LINE (344,125)-(373,146)
LINE (412,125)-(383,146):LINE (422,125)-(451,146)
LINE (154,150)-(212,150):LINE (232,150)-(290,150)
LINE (310,150)-(368,150):LINE (388,150)-(446,150)
PATTERN -1
FOR n=1 TO 15:b1=3:g(n)=n 'loop for initial yellow circles
IF n=1 THEN b1=2
CIRCLE (a(n),b(n)),9,b1
PAINT (a(n),b(n)),b1,b1
NEXT n
SAY TRANSLATE$("welcome to the world of the chinees triiangle.")
SAY TRANSLATE$("this game is similar to chi nees checkers and can be found on many restrant tables.")
SAY TRANSLATE$("the game consists of fore teen pegs, represented by orange circles,and one empty hole, represented by a black circle, in a triangle configuration.")
SAY TRANSLATE$("The game is played like checkers, except in a triiangular formation.")
SAY TRANSLATE$("A move is started by deepressing the left mouse button, once on a orange circle, and once on a black circle.")
SAY TRANSLATE$("The two circles, must be connected, by a dotted line, and separated, by a orange circle.")
DATA 4,11,13,15,6,13,4,6,1
DATA 2,7,12,14,10,9,8,5,3
DATA 1,4,11,13,15,6,13,4,6
FOR r1=1 TO 9:READ c1(r1):NEXT r1
FOR r2=1 TO 9:READ c2(r2):NEXT r2
FOR r3=1 TO 9:READ c3(r3):NEXT r3
FOR r4=1 TO 9 :r5=c1(r4):r6=c2(r4):r7=c3(r4)
CIRCLE (a(r5),b(r5)),9,2:PAINT (a(r5),b(r5)),2,2:CIRCLE (a(r6),b(r6)),9,2:PAINT (a(r6),b(r6)),2,2:CIRCLE (a(r7),b(r7)),9,3:PAINT (a(r7),b(r7)),3,3
FOR r8=1 TO 5500:NEXT r8:BEEP:NEXT r4
SAY TRANSLATE$("The object, is to leave only one peg on the board, and, in the original, empty hole.")
SAY TRANSLATE$("The ultimate challenge will be, to have eight pegs, on the board, and no, possible moves.")
SAY TRANSLATE$("This is extremely difficult, to accomplish.")
SAY TRANSLATE$("Leaving two or three pegs, on the board, can be considered, average.")
WINDOW CLOSE 5:RETURN
screentitle: 'sub for initial screen title
CLS:RANDOMIZE TIMER
SCREEN 3,320,200,3,1
WINDOW 7,,,1,3
WINDOW OUTPUT 7
FOR x=1 TO 30
FOR a=1 TO 3
PALETTE 4,RND(1),RND(1),RND(1)
COLOR 4,0
NEXT a
a=INT(RND(1)*20):b=INT(RND(1)*20):COLOR 3,4
IF a<5 THEN a=7
IF a>30 THEN a=28
IF b>19 THEN b=19
IF b<3 THEN b=3
LOCATE a,b:PRINT "Chinese Triangle"
FOR nit=1 TO 600:NEXT nit 'a dummy timer for compiler
COLOR 4,0:LINE (10,10)-(280,184),4,bf
NEXT x
COLOR 2,4:LOCATE 5,15:PRINT "Welcome"
LOCATE 6,13:PRINT "To The World"
LOCATE 7,16:PRINT "Of The"
LOCATE 8,11:PRINT "Chinese Triangle"
AREA (136,70):AREA (76,150):AREA (196,150):AREAFILL 1
LOCATE 23,3:INPUT"Enter any key to continue";kji$:CLS
WINDOW CLOSE 7:SCREEN CLOSE 3
RETURN
