home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d4xx / d469 / triangle.lha / Triangle / ChineseTriangle < prev    next >
Text File  |  1991-03-09  |  13KB  |  283 lines
  1. CLS:GOSUB screentitle:CLS
  2. MENU 5,0,1,"Chinese Triangle"
  3. MENU 5,1,1,"Credentials"
  4. MENU 5,2,1,"Game Instructions"
  5. MENU 5,3,1,"Game Example"
  6. ON MENU GOSUB menuu
  7. MENU ON                        
  8.  
  9. 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)
  10.   DIM m(50):DIM n(50):DIM p(50)
  11. RANDOMIZE TIMER
  12. v=INT((15-1+1)*RND)+1:r=0
  13.   DATA 300,261,339,222,300,378,183,261,339,417,144,222,300,378,456
  14. FOR i=1 TO 15:READ a(i):NEXT i         'a() is x-coordinate of circles
  15.   DATA 37,65,65,93,93,93,121,121,121,121,150,150,150,150,150
  16. FOR t=1 TO 15:READ b(t):NEXT t         'b() is y-coordinate of circles
  17.   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
  18. FOR a1=1 TO 36:READ c(a1):NEXT a1      'column-1 of possible moves
  19.   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
  20. FOR a2=1 TO 36:READ d(a2):NEXT a2       'column-2 of possible moves
  21.   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
  22. FOR a3=1 TO 36:READ e(a3):NEXT a3:CLS      'column-3 of possible moves
  23. 12 CLS:PRINT:PRINT"The Player has the option of locating the empty hole or let the computer"
  24. PRINT"select the location.":PRINT:PRINT
  25. PRINT "Enter ' Y ' if player select or ' N ' and return if computer select."
  26. INPUT gh$:CLS
  27. IF gh$="Y" OR gh$="y" OR gh$="N" OR gh$="n" THEN 13 ELSE GOTO 12
  28. 13  GOSUB PAUL
  29. CIRCLE (570,18),9,3:PAINT (570,18),3,3:GET (560,8)-(580,28),r
  30. LOCATE 4.5,69:PRINT "Restart":LOCATE 5,71:PRINT "Game"
  31. LINE (300,10)-(87,164):LINE (300,9)-(86,164):LINE (300,8)-(86,164):LINE (300,7)-(85,164)
  32. LINE (87,164)-(513,164):LINE (85,165)-(516,165)
  33. LINE (300,10)-(513,164):LINE (300,9)-(514,164):LINE (300,8)-(515,164):LINE (300,7)-(516,164)
  34. PATTERN &H6666                    'drawing of dotted lines between circles
  35. LINE (295,41)-(266,61):LINE (305,41)-(334,61)
  36. LINE (256,69)-(227,89):LINE (266,69)-(295,89)
  37. LINE (334,69)-(305,89):LINE (344,69)-(373,89)
  38. LINE (231,93)-(290,93):LINE (310,93)-(368,93)
  39. LINE (188,117)-(217,97):LINE (227,97)-(256,117)
  40. LINE (295,97)-(266,117):LINE (305,97)-(334,117)
  41. LINE (373,97)-(344,117):LINE (383,97)-(412,117)
  42. LINE (193,121)-(251,121):LINE (271,121)-(329,121):LINE (349,121)-(407,121)
  43. LINE (149,146)-(178,125):LINE (188,125)-(217,146)
  44. LINE (256,125)-(227,146):LINE (266,125)-(295,146)
  45. LINE (334,125)-(305,146):LINE (344,125)-(373,146)
  46. LINE (412,125)-(383,146):LINE (422,125)-(451,146)
  47. LINE (154,150)-(212,150):LINE (232,150)-(290,150)
  48. LINE (310,150)-(368,150):LINE (388,150)-(446,150):PATTERN -1
  49. IF gh$="y" THEN LOCATE 23,3:PRINT "Select Black Hole location by hitting left mouse on an orange circle.";
  50. IF gh$<>"y" THEN t1=TIMER:t2=0:LOCATE 23,32:PRINT "Play Time=                                                ";
  51. FOR n=1 TO 15:b1=3:g(n)=n        'loop for initial yellow circles
  52.   IF gh$="y" THEN b1=3
  53.   PUT (a(n)-10,b(n)-10),r
  54.   IF n=v AND gh$<>"y" THEN b1=2:CIRCLE (a(n),b(n)),9,b1:PAINT (a(n),b(n)),b1,b1
  55.   IF b1=2 THEN f(n)=0
  56.   IF b1=3 THEN f(n)=1
  57. NEXT n
  58.  
  59. click:
  60.   WHILE MOUSE(0)=0
  61.   IF gh$<>"y" AND gh$<>"p" THEN t2=TIMER:LOCATE 23,42:PRINT t3;
  62.   IF gh$="p" THEN t2=TIMER:LOCATE 23,42:PRINT t3;
  63.   t3=INT(t2-t1)
  64.   IF MOUSE(0)<>0 THEN ppp                  
  65. WEND
  66. ppp:
  67.   FOR z=1 TO 15:j=ABS(a(z)-MOUSE(1)):k=ABS(b(z)-MOUSE(2))
  68.   IF MOUSE(1)>560 AND MOUSE(1)<580 AND MOUSE(2)>10 AND MOUSE(2)<30 AND POINT (301,7)=1  THEN GOSUB restart
  69.   IF gh$="y" AND j<9 AND k<9 AND f(z)=1 THEN GOSUB mio
  70.   IF j<9 AND k<9 AND f(z)=1 THEN r=g(z):GOTO click
  71.   IF j<9 AND k<9 AND f(z)=0 THEN GOTO pip
  72.   NEXT z:GOTO click
  73. pip:
  74.   FOR s=1 TO 36
  75.   IF r=c(s) AND z<>e(s) THEN s=s+1
  76.   IF r=c(s) AND z=e(s) THEN GOTO lip
  77. NEXT s:GOTO click
  78. lip:            'see if yellow yellow black
  79.   IF f(c(s))=1 AND f(d(s))=1 AND f(e(s))=0 THEN GOTO hop
  80.   GOTO click
  81. hop:
  82.   IF POINT (301,7)=0 THEN PSET (301,7)
  83.   CIRCLE (a(c(s)),b(c(s))),9,2
  84.   PAINT  (a(c(s)),b(c(s))),2,2:f(c(s))=0    'change yellow to black on column 1
  85.   CIRCLE (a(d(s)),b(d(s))),9,2
  86.   PAINT  (a(d(s)),b(d(s))),2,2:f(d(s))=0   'change yellow to black on column 2
  87.   CIRCLE (a(e(s)),b(e(s))),9,3
  88.   PAINT (a(e(s)),b(e(s))),3,3:f(e(s))=1    'change black to yellow on column 3
  89.   pm=0:FOR lr=1 TO 36
  90.   IF c(s)=c(lr) THEN m(lr)=2
  91.   IF c(s)=d(lr) THEN n(lr)=2
  92.   IF c(s)=e(lr) THEN p(lr)=2
  93.   IF d(s)=c(lr) THEN m(lr)=2
  94.   IF d(s)=d(lr) THEN n(lr)=2
  95.   IF d(s)=e(lr) THEN p(lr)=2
  96.   IF e(s)=c(lr) THEN m(lr)=3
  97.   IF e(s)=d(lr) THEN n(lr)=3
  98.   IF e(s)=e(lr) THEN p(lr)=3
  99.   IF m(lr)=3 AND n(lr)=3 AND p(lr)=2 THEN pm=pm+1
  100.   NEXT lr
  101.   IF pm=0 THEN GOSUB WIN:GOSUB restart
  102.   GOTO click
  103. END
  104.  
  105. WIN:              'sub to determine user competence
  106.   LINE (190,73)-(410,113),2,bf
  107.   COLOR 3,2:LOCATE 12,32:PRINT "NO MORE MOVES"
  108.   FOR ttu=1 TO 13500:NEXT ttu:COLOR 1,0     'a dummy timer to keep screen
  109.   xm=0:FOR tv=1 TO 36
  110.   IF m(tv)=3 AND c(tv)>c(tv-1) THEN xm=xm+1     'determines # of orange circles
  111.   NEXT tv
  112.   CLS:PRINT:PRINT  "This game was played with the abilities of a:"
  113.   PRINT             "   (You left";
  114.   COLOR 3
  115.   PRINT xm;
  116.   COLOR 1
  117.   PRINT  "pegs on the board)" 
  118.   LINE (409,35)-(409,175),2:LINE (410,35)-(410,175),2
  119.   LINE (430,35)-(430,175),2:LINE (431,35)-(431,175),2
  120.   LINE (409,35)-(431,35),2:LINE (409,175)-(431,175),2
  121.   LOCATE 6,24:PRINT  "Rocket Scientist............"
  122.   LOCATE 8,24:PRINT  "Neurosurgeon................"
  123.   LOCATE 10,24:PRINT "College Graduate............"
  124.   LOCATE 12,24:PRINT "College Student............."
  125.   LOCATE 16,24:PRINT "High School Student........."
  126.   LOCATE 18,24:PRINT "Elementary Student.........."
  127.   LOCATE 21,24:PRINT "Small Child................."
  128.   IF xm=8 THEN y=45                           '8 pegs left on board
  129.   IF xm=1 THEN y=61                           '1 peg left on board
  130.   IF xm=2 THEN y=77                           '2 pegs left on board
  131.   IF xm=3 THEN y=94                           '3 pegs left on board
  132.   IF xm=4 THEN y=126                          '4 pegs left on board
  133.   IF xm=5 THEN y=142                          '5 pegs on left board
  134.   IF xm=6 XOR xm=7 OR xm>8 THEN y=166         '6 or 7 or >8 pegs left on board
  135.   LINE (411,36)-(429,y-1),1,bf
  136.   LINE (411,y)-(429,174),3,bf
  137.   LOCATE 23,1:INPUT  "Press Enter to continue";hju:CLS
  138.   RETURN
  139.   
  140.   
  141.  
  142.  
  143. restart:
  144.   LOCATE 1,1:CLEAR:CLS:PATTERN &HFFFF
  145.   RESTORE:GOTO 23
  146.   RETURN
  147.   
  148. mio:           'sub for user select black hole
  149.   IF gh$="y" AND MOUSE(0)=1 THEN t1=TIMER ELSE RETURN
  150.   GOSUB PAUL
  151.   CIRCLE (a(z),b(z)),9,2:PAINT (a(z),b(z)),2,2:gh$="p"
  152.   f(z)=0:LOCATE 23,3:PRINT "                                                        ";
  153.   LOCATE 23,32:PRINT "Play Time=                                            ";
  154.   RETURN
  155.   
  156. PAUL:         'sub for determining if col 1,2, 3 is orange or black
  157.   FOR dt=1 TO 36
  158.   m(dt)=3:n(dt)=3:p(dt)=3           'all columns are orange
  159.   IF gh$<>"y" AND v=c(dt) THEN m(dt)=2        'col-1 @ v is black
  160.   IF gh$<>"y" AND v=d(dt) THEN n(dt)=2         'col-2 @ v is black
  161.   IF gh$<>"y" AND v=e(dt) THEN p(dt)=2         'col-3 @ v is black
  162.   IF gh$="y" AND z=c(dt) THEN m(dt)=2         'col-1 @ v is black
  163.   IF gh$="y" AND z=d(dt) THEN n(dt)=2         'col-2 @ v is black
  164.   IF gh$="y" AND z=e(dt) THEN p(dt)=2         'col-3 @ v is black
  165.   NEXT dt
  166.   RETURN
  167.   
  168.  
  169.   menuu:     'subroutine FOR MENU
  170.      IF MENU(1)=1 THEN  GOSUB Credentials
  171.      IF MENU(1)=2 THEN GOSUB Instructions
  172.      IF MENU(1)=3 THEN GOSUB Example
  173.      RETURN
  174.   Credentials:  'sub for displaying authors name and address   
  175.      WINDOW 3,"Credentials",(0,100)-(300,180)
  176.      LOCATE 1,1:PRINT "This program was written for Public"
  177.      LOCATE 2,1:PRINT "Domain use by:"
  178.      LOCATE 3,16:PRINT "Russell Mason"
  179.      LOCATE 4,16:PRINT "5225 Old Hixson"
  180.      LOCATE 5,16:PRINT  "Hixson, Tn."
  181.      LOCATE 7,16:PRINT "February, 1991"
  182.      LOCATE 8,16:PRINT "Release 1.1"
  183.      LOCATE 10,1:INPUT "Enter any key to continue";q2$
  184.      WINDOW CLOSE 3
  185.      RETURN
  186.      
  187.      
  188.    Instructions:      'sub for game instructions.
  189.      WINDOW 4,"Instructions",(0,10)-(615,186)
  190.      PRINT"Welcome to the world of the Chinese Triangle.  This game is similar"
  191.      PRINT"to chinese checkers and can be found on many restaurant tables."
  192.      PRINT"The game consists of 14 pegs (represented by orange circles) and one"
  193.      PRINT"empty hole (represented by a black circle) in a triangular configuration.":PRINT
  194.       
  195.      PRINT"The game is played like checkers, except in a triangular formation."
  196.      PRINT"A move is started by depressing the left mouse button once on a orange"
  197.      PRINT"circle and once on a black circle.  The two circles must be connected"
  198.      PRINT"by a dotted line and separated by a orange circle.":PRINT
  199.      PRINT"The object is to leave only one peg on the board and in the original"
  200.      PRINT"empty hole.  The ultimate challenge will be to have eight pegs on the"
  201.      PRINT"board and no possible moves.  This is extremely difficult to accomplish."
  202.      PRINT"Leaving 2 or 3 pegs on the board can be considered to be average.":PRINT
  203.      INPUT "Enter any key to continue";gg$
  204.      WINDOW CLOSE 4:RETURN
  205.      
  206.    Example:          'sub for game example  
  207.      WINDOW 5,"Game Example",(0,0)-(580,186)
  208.      CLS:LINE (300,10)-(87,164):LINE (300,9)-(86,164):LINE (300,8)-(86,164):LINE (300,7)-(85,164)
  209.      LINE (87,164)-(513,164):LINE (85,165)-(516,165)
  210.      LINE (300,10)-(513,164):LINE (300,9)-(514,164):LINE (300,8)-(515,164):LINE (300,7)-(516,164)
  211.      PATTERN &H6666                    'drawing of dotted lines between circles
  212.       LINE (295,41)-(266,61):LINE (305,41)-(334,61)
  213.       LINE (256,69)-(227,89):LINE (266,69)-(295,89)
  214.       LINE (334,69)-(305,89):LINE (344,69)-(373,89)
  215.       LINE (231,93)-(290,93):LINE (310,93)-(368,93)
  216.       LINE (188,117)-(217,97):LINE (227,97)-(256,117)
  217.       LINE (295,97)-(266,117):LINE (305,97)-(334,117)
  218.       LINE (373,97)-(344,117):LINE (383,97)-(412,117)
  219.       LINE (193,121)-(251,121):LINE (271,121)-(329,121):LINE (349,121)-(407,121)
  220.       LINE (149,146)-(178,125):LINE (188,125)-(217,146)
  221.       LINE (256,125)-(227,146):LINE (266,125)-(295,146)
  222.       LINE (334,125)-(305,146):LINE (344,125)-(373,146)
  223.       LINE (412,125)-(383,146):LINE (422,125)-(451,146)
  224.       LINE (154,150)-(212,150):LINE (232,150)-(290,150)
  225.       LINE (310,150)-(368,150):LINE (388,150)-(446,150)
  226.       PATTERN -1
  227.      FOR n=1 TO 15:b1=3:g(n)=n        'loop for initial yellow circles
  228.        IF n=1 THEN b1=2     
  229.        CIRCLE (a(n),b(n)),9,b1
  230.        PAINT  (a(n),b(n)),b1,b1
  231.        NEXT n                        
  232.     SAY TRANSLATE$("welcome to the world of the chinees triiangle.")
  233.     SAY TRANSLATE$("this game is similar to chi nees checkers and can be found on many restrant tables.")
  234.     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.")
  235.     SAY TRANSLATE$("The game is played like checkers, except in a triiangular formation.")
  236.     SAY TRANSLATE$("A move is started by deepressing the left mouse button, once on a orange circle, and once on a black circle.")
  237.     SAY TRANSLATE$("The two circles, must be connected, by a dotted line, and separated, by a orange circle.")
  238.     
  239.       DATA 4,11,13,15,6,13,4,6,1
  240.       DATA 2,7,12,14,10,9,8,5,3
  241.       DATA 1,4,11,13,15,6,13,4,6
  242.     FOR r1=1 TO 9:READ c1(r1):NEXT r1
  243.     FOR r2=1 TO 9:READ c2(r2):NEXT r2
  244.     FOR r3=1 TO 9:READ c3(r3):NEXT r3
  245.     FOR r4=1 TO 9 :r5=c1(r4):r6=c2(r4):r7=c3(r4)
  246.     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
  247.     FOR r8=1 TO 5500:NEXT r8:BEEP:NEXT r4
  248.     SAY TRANSLATE$("The object, is to leave only one peg on the board, and, in the original, empty hole.")
  249.     SAY TRANSLATE$("The ultimate challenge will be, to have eight pegs, on the board, and no, possible moves.")
  250.     SAY TRANSLATE$("This is extremely difficult, to accomplish.")
  251.     SAY TRANSLATE$("Leaving two or three pegs, on the board, can be considered, average.")
  252.     WINDOW CLOSE 5:RETURN
  253.     
  254. screentitle:      'sub for initial screen title
  255. CLS:RANDOMIZE TIMER
  256. SCREEN 3,320,200,3,1
  257. WINDOW 7,,,1,3
  258. WINDOW OUTPUT 7
  259. FOR x=1 TO 30
  260. FOR a=1 TO 3
  261. PALETTE 4,RND(1),RND(1),RND(1)
  262. COLOR 4,0
  263. NEXT a
  264. a=INT(RND(1)*20):b=INT(RND(1)*20):COLOR 3,4
  265. IF a<5 THEN a=7
  266. IF a>30 THEN a=28
  267. IF b>19 THEN b=19
  268. IF b<3 THEN b=3
  269. LOCATE a,b:PRINT "Chinese Triangle"
  270. FOR nit=1 TO 600:NEXT nit           'a dummy timer for compiler
  271. COLOR 4,0:LINE (10,10)-(280,184),4,bf
  272. NEXT x
  273. COLOR 2,4:LOCATE 5,15:PRINT "Welcome"
  274. LOCATE 6,13:PRINT "To The World"
  275. LOCATE 7,16:PRINT "Of The"
  276. LOCATE 8,11:PRINT "Chinese Triangle"
  277. AREA (136,70):AREA (76,150):AREA (196,150):AREAFILL 1
  278. LOCATE 23,3:INPUT"Enter any key to continue";kji$:CLS
  279. WINDOW CLOSE 7:SCREEN CLOSE 3
  280. RETURN
  281.  
  282.  
  283.