home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 551-575 / apd559 / amoner3 / pegs.amos / pegs.amosSourceCode
AMOS Source Code  |  1993-11-29  |  6KB  |  302 lines
  1. '
  2. ' Pegs - By Gal-on Broner. 
  3. ' BarBarian Minds 1991 
  4. '
  5. Default : Curs Off 
  6. Dim CROSS(7,7),FROM(76),MIDDLE(76),DEST(76),PEGS(33)
  7.   Gosub FIND_CROSS_ARRAY
  8. BEGIN:
  9.   SCORE=0
  10.   GAME
  11. '
  12. ' Game over. Give score, ask for another game. 
  13. '
  14.   Ink 2,0
  15.   Text 10,20,"You got"+Str$(SCORE)
  16.   Text 10,35,"pegs left."
  17.   Text 10,50,"Press <return>"
  18.   A$=""
  19.   Repeat : A$=Inkey$ : Until A$=Chr$(13)
  20.   Ink 0
  21.   Text 10,20,"            "
  22.   Text 10,35,"          "
  23.   Text 10,50,"              "
  24.   Ink 2,0
  25.   RANK$="A fool."
  26.   If SCORE<10 and SCORE=>5 Then RANK$="Avarage."
  27.   If SCORE<5 and SCORE>1 Then RANK$="Good."
  28.   If SCORE=1 Then RANK$="Master."
  29.   Text 10,20,"Your rank is:"
  30.   Text 10,35,RANK$
  31.   Text 10,50,"Press <return>"
  32.   A$=""
  33.   Repeat : A$=Inkey$ : Until A$=Chr$(13)
  34.   Ink 0
  35.   Text 10,20,"            "
  36.   Text 10,35,"              "
  37.   Text 10,50,"              "
  38.   Ink 4
  39.   Text 10,20,"Another Game (Y/N)"
  40. YORN:
  41.   A$=""
  42.   Repeat : A$=Inkey$ : Until A$<>""
  43.   A$=Upper$(A$)
  44.   If A$="Y" Then Goto BEGIN
  45.   If A$="N" Then Run "Autoexec.Amos"
  46. Goto YORN
  47. End 
  48. FIND_CROSS_ARRAY:
  49.   For LOO=1 To 7
  50.     For LOO1=1 To 7
  51.       Read CROSS(LOO1,LOO)
  52.     Next LOO1
  53.   Next LOO
  54.   For LOO=1 To 7
  55.     For LOO1=1 To 7
  56.       If CROSS(LOO1,LOO)<>0
  57.         If LOO>2
  58.           Gosub CHECKUP
  59.         End If 
  60.         If LOO<6
  61.           Gosub CHECKDOWN
  62.         End If 
  63.         If LOO1>2
  64.           Gosub CHECKLEFT
  65.         End If 
  66.         If LOO1<6
  67.           Gosub CHECKRIGHT
  68.         End If 
  69.       End If 
  70.     Next LOO1
  71.   Next LOO
  72. ' Print COUNT
  73. Return 
  74. '
  75. CHECKUP:
  76.   FROM=CROSS(LOO1,LOO)
  77.   MIDDLE=CROSS(LOO1,LOO-1)
  78.   DEST=CROSS(LOO1,LOO-2)
  79.   Gosub CHECKPRINT
  80. Return 
  81. CHECKDOWN:
  82.   FROM=CROSS(LOO1,LOO)
  83.   MIDDLE=CROSS(LOO1,LOO+1)
  84.   DEST=CROSS(LOO1,LOO+2)
  85.   Gosub CHECKPRINT
  86. Return 
  87. CHECKLEFT:
  88.   FROM=CROSS(LOO1,LOO)
  89.   MIDDLE=CROSS(LOO1-1,LOO)
  90.   DEST=CROSS(LOO1-2,LOO)
  91.   Gosub CHECKPRINT
  92. Return 
  93. CHECKRIGHT:
  94.   FROM=CROSS(LOO1,LOO)
  95.   MIDDLE=CROSS(LOO1+1,LOO)
  96.   DEST=CROSS(LOO1+2,LOO)
  97.   Gosub CHECKPRINT
  98. Return 
  99. CHECKPRINT:
  100.   If DEST>0
  101.     Inc COUNT
  102.     FROM(COUNT)=FROM
  103.     MIDDLE(COUNT)=MIDDLE
  104.     DEST(COUNT)=DEST
  105.   End If 
  106. Return 
  107. '
  108. ' The Cross coord array. 
  109. '
  110. Data 0,0,1,2,3,0,0
  111. Data 0,0,4,5,6,0,0
  112. Data 7,8,9,10,11,12,13
  113. Data 14,15,16,17,18,19,20
  114. Data 21,22,23,24,25,26,27
  115. Data 0,0,28,29,30,0,0
  116. Data 0,0,31,32,33,0,0
  117. Procedure GAME
  118.   Shared FROM(),MIDDLE(),DEST(),PEGS(),SCORE
  119. '
  120. ' Set up pegs array. 
  121. '
  122.   For LOO=1 To 33
  123.     PEGS(LOO)=1
  124.   Next LOO
  125.   PEGS(17)=0
  126.   CROSS
  127. '
  128. ' Make a move. 
  129. '
  130. MOVE:
  131.   Ink 2,0
  132.   Text 10,30,"Choose a peg"
  133.   Text 10,45,"to move."
  134.   Repeat : Until Mouse Click
  135.   Ink 0
  136.   Text 10,30,"            "
  137.   Text 10,45,"        "
  138.   CHOOSEN=Mouse Zone
  139. '
  140. ' First we check if the player choosed a peg.
  141. '
  142.   If CHOOSEN=0 Then Goto MOVE
  143. '
  144. ' Now we check if a peg exists in that posiotion.
  145. '
  146.   If PEGS(CHOOSEN)=0
  147.     Ink 4,0
  148.     Text 10,20,"No peg in"
  149.     Text 10,35,"this hole."
  150.     Text 10,50,"Press <return>"
  151.     A$=""
  152.     Repeat : A$=Inkey$ : Until A$=Chr$(13)
  153.     Ink 0
  154.     Text 10,20,"         "
  155.     Text 10,35,"          "
  156.     Text 10,50,"              "
  157.     Goto MOVE
  158.   End If 
  159. '  
  160. ' Mark the choosen peg.
  161. '
  162.   MARK_PEG[CHOOSEN,"choosen"]
  163. '  
  164. ' Can this peg move? 
  165. '  
  166.   CAN_MOVE=False
  167.   For LOO=1 To 76
  168.     If FROM(LOO)=CHOOSEN
  169.       If(PEGS(DEST(LOO))=0) and(PEGS(MIDDLE(LOO))=1)
  170.         CAN_MOVE=True
  171.       End If 
  172.     End If 
  173.   Next LOO
  174.   If CAN_MOVE=False : Rem can not move.
  175.     Ink 4,0
  176.     Text 10,20,"This peg have"
  177.     Text 10,35,"nowhere to go."
  178.     Text 10,50,"Press <return>"
  179.     A$=""
  180.     Repeat : A$=Inkey$ : Until A$=Chr$(13)
  181.     Ink 0
  182.     Text 10,20,"             "
  183.     Text 10,35,"              "
  184.     Text 10,50,"              "
  185.     MARK_PEG[CHOOSEN,"full"]
  186.     Goto MOVE
  187.   End If 
  188. '
  189. ' Ok, now get destination. 
  190. '
  191. MOVE_INTO:
  192.   Ink 2,0
  193.   Text 10,30,"Choose a hole"
  194.   Text 10,45,"to move into."
  195.   Repeat : Until Mouse Click
  196.   Ink 0
  197.   Text 10,30,"             "
  198.   Text 10,45,"             "
  199.   DESTINATION=Mouse Zone
  200. '
  201. ' Check if destination exsist. 
  202. '  
  203.   If DESTINATION=0 Then Goto MOVE_INTO
  204. '
  205. ' Check if move legal
  206. '
  207.   LEGAL=False
  208.   For LOO=1 To 76
  209.     If FROM(LOO)=CHOOSEN and DEST(LOO)=DESTINATION
  210.       If PEGS(DESTINATION)=0 and PEGS(MIDDLE(LOO))=1
  211.         LEGAL=True
  212.         MIDDLEPEG=MIDDLE(LOO)
  213.       End If 
  214.     End If 
  215.   Next LOO
  216.   If LEGAL=False : Rem move illegal 
  217.     Ink 4,0
  218.     Text 10,20,"Illegal move!"
  219.     Text 10,35,"Press <return>"
  220.     A$=""
  221.     Repeat : A$=Inkey$ : Until A$=Chr$(13)
  222.     Ink 0
  223.     Text 10,20,"             "
  224.     Text 10,35,"              "
  225.     MARK_PEG[CHOOSEN,"full"]
  226.     Goto MOVE
  227.   End If 
  228. '  
  229. ' The move is ok! make move. 
  230. '
  231.   PEGS(CHOOSEN)=0
  232.   MARK_PEG[CHOOSEN,"empty"]
  233.   PEGS(DESTINATION)=1
  234.   MARK_PEG[DESTINATION,"full"]
  235.   PEGS(MIDDLEPEG)=0
  236.   MARK_PEG[MIDDLEPEG,"empty"]
  237. '
  238. ' Check if game finished.
  239. '
  240.   For LOO=1 To 76
  241.     If(PEGS(FROM(LOO))=1) and(PEGS(MIDDLE(LOO))=1) and(PEGS(DEST(LOO))=0)
  242.       Goto MOVE
  243.     End If 
  244.   Next LOO
  245.   For LOO=1 To 33
  246.     If PEGS(LOO)=1 Then Inc SCORE
  247.   Next LOO
  248. End Proc
  249. Procedure CROSS
  250.   Shared CROSS()
  251.   Reserve Zone 
  252. '
  253. ' There are 33 holes.
  254. '  
  255.   Reserve Zone 33
  256.   Cls 0
  257. '
  258. ' Draw Cross 
  259. '
  260.   Ink 8
  261.   Bar 90,70 To 230,130
  262.   Bar 130,30 To 190,170
  263.   Ink 2
  264. '
  265. ' Draw pegs and set the zones. 
  266. '
  267.   COUNT=0 : Rem count is the current zone number 
  268.   For LOO=1 To 7
  269.     For LOO1=1 To 7
  270.       If CROSS(LOO1,LOO)<>0
  271.         Circle 100+(LOO1-1)*20,40+(LOO-1)*20,7
  272.          If CROSS(LOO1,LOO)=17
  273.            Ink 7
  274.          Else 
  275.            Ink 6
  276.          End If 
  277.          Paint 100+(LOO1-1)*20,40+(LOO-1)*20 : Ink 2
  278.          Inc COUNT
  279.          Set Zone COUNT,93+(LOO1-1)*20,33+(LOO-1)*20 To 107+(LOO1-1)*20,47+(LOO-1)*20
  280.       End If 
  281.     Next LOO1
  282.   Next LOO
  283. End Proc
  284. Procedure MARK_PEG[PEG_NUMBER,STATE$]
  285.   Shared CROSS()
  286. '
  287. ' Find the pegs coords 
  288. '
  289.   For LOO=1 To 7
  290.     For LOO1=1 To 7
  291.       If CROSS(LOO1,LOO)=PEG_NUMBER Then Goto FOUND
  292.     Next LOO1
  293.   Next LOO
  294. FOUND:
  295. '
  296. ' Set the pegs color according to State. 
  297. '  
  298.   If STATE$="choosen" Then Ink 3
  299.   If STATE$="empty" Then Ink 7
  300.   If STATE$="full" Then Ink 6
  301.   Paint 100+(LOO1-1)*20,40+(LOO-1)*20 : Ink 2
  302. End Proc