AMOS PD CD/amospdcd.iso/251-275/apd273/simon.amos/simon.amosSourceCode

AMOS Source Code | 1990-09-06 | 5KB | 260 lines

Global NOPLAYERS,NOBEEPS,DIFFICULTY
Procedure INITIALISE
   Break Off
   Show
   Rainbow 0,0,40,0
   Rainbow 1,0,40,0
   Rainbow 2,0,40,0
   DIFFICULTY=1
   NOPLAYERS=1
   Screen Open 0,320,256,8,0
   Curs Off
   Unpack 10
   Flash Off
   Colour 1,$333
   Colour 2,$555
   Colour 3,$777
   Colour 4,$700
   Colour 5,$70
   Colour 6,$770
   Colour 7,$7
   Ink 3
   Paper 0
   Locate 33,6
   Print NOPLAYERS
   Locate 33,16
   Print DIFFICULTY
   Limit Mouse 352,42 To 433,284
End Proc
Procedure PLY
   Ink 3
   Paper 0
   Dim LIST(20)
   Locate 0,0
   Print "          MY TURN"
   For N=1 To NOBEEPS
      X=(Rnd(3))+1
      LIST(N)=X
      If X=1
         Play $1111,25,0
         Colour 4,$F00
         Wait 25
         Colour 4,$700
      End If
      If X=2
         Play $1111,27,0
         Colour 5,$F0
         Wait 25
         Colour 5,$70
      End If
      If X=3
         Play $1111,29,0
         Colour 6,$FF0
         Wait 25
         Colour 6,$770
      End If
      If X=4
         Play $1111,30,0
         Colour 7,$F
         Wait 25
         Colour 7,$7
      End If
   Next N
   Locate 0,0
   Print "                       "
   Locate 0,0
   Print "         YOUR TURN"
   Clear Key
   For N=1 To NOBEEPS
   LIMIT=0
   TP:
      X$=""
      CHOOSE=0
      Do
         X$=Inkey$
         If X$<>"" Then Goto CHEESE
         Inc LIMIT
         If LIMIT=2500 Then Goto BT2
      Loop
   CHEESE:
      CHOOSE=0
      If X$="e"
         CHOOSE=3
      End If
      If X$="i"
         CHOOSE=1
      End If
      If X$="j"
         CHOOSE=2
      End If
      If X$="d"
         CHOOSE=4
      End If
      If X$="E"
         CHOOSE=3
      End If
      If X$="I"
         CHOOSE=1
      End If
      If X$="J"
         CHOOSE=2
      End If
      If X$="D"
         CHOOSE=4
      End If
      If CHOOSE=0 Then Goto TP
      If CHOOSE<>LIST(N) Then Goto BT1
      If CHOOSE=1
         Play $1111,25,0
         Colour 4,$F00
         Wait 25
         Colour 4,$700
      End If
      If CHOOSE=2
         Play $1111,27,0
         Colour 5,$F0
         Wait 25
         Colour 5,$70
      End If
      If CHOOSE=3
         Play $1111,29,0
         Colour 6,$FF0
         Wait 25
         Colour 6,$770
      End If
      If CHOOSE=4
         Play $1111,30,0
         Colour 7,$F
         Wait 25
         Colour 7,$7
      End If
   Next N
   Play $1,40,0
   Play $10,41,0
   Play $100,42,0
   Play $1000,43,0
   Locate 0,0
   Print "                     "
   Locate 0,0
   Print "          CORRECT"
   Wait 100
   Locate 0,0
   Print "                     "
   RESULT=1
   Goto FRED
   BT1:
      Play $1111,5,0
      Locate 0,0
      Print "                   "
      Locate 0,0
      Print "        WRONG ONE"
      Wait 100
      Locate 0,0
      Print "                   "
      RESULT=2
      Goto FRED
   BT2:
      Play $1111,7,0
      Locate 0,0
      Print "                     "
      Locate 0,0
      Print "       OUT OF TIME"
      Wait 100
      Locate 0,0
      Print "                     "
      RESULT=3
      Goto FRED
   FRED:
End Proc[RESULT]
Procedure GAME
   NOBEEPS=2+DIFFICULTY
   Dim LEFT(NOPLAYERS)
   Clear Key
   Rem Follow CURRENT,LEFT(CURRENT),Q,LEFT(N),FLAG
   TQ:
   CURRENT=1
   Do
   TV:
      If CURRENT>NOPLAYERS Then Goto BT
      If LEFT(CURRENT)=1
         Inc CURRENT
         Goto TV
      End If
      Locate 0,0
      Print "   PLAYER";CURRENT;" PRESS ANY KEY"
      Print "           TO BEGIN"
      Clear Key
      Wait Key
      Locate 0,0
      Print "                            "
      Print "                    "
      PLY
      Q=Param
      If Q=2 or Q=3
         LEFT(CURRENT)=1
      End If
      Inc CURRENT
   Loop
   BT:
   Rem Follow N,FLAG,LEFT(N)
   FLAG=0
   For N=1 To NOPLAYERS
      If LEFT(N)=0
         FLAG=1
      End If
   Next N
   If FLAG=1
      Inc NOBEEPS
      Goto TQ
   End If
   Locate 0,0
   Print "       GAME OVER"
   Wait 100
   Locate 0,0
   Print "                "
End Proc
Procedure MAIN
   Reserve Zone 4
   Set Zone 1,241,10 To 302,40
   Set Zone 2,241,77 To 302,101
   Set Zone 3,241,145 To 302,206
   Set Zone 4,241,216 To 300,240
   QW:
   Repeat
   Until Mouse Click=1
   X=X Screen(X Mouse)
   Y=Y Screen(Y Mouse)
   T=Zone(X,Y)
   If T=0 Then Goto QW
   If T=1
      Inc NOPLAYERS
      If NOPLAYERS=9
         NOPLAYERS=1
      End If
      Locate 33,6
      Print "  "
      Locate 33,6
      Print NOPLAYERS
   End If
   If T=2
      Inc DIFFICULTY
      If DIFFICULTY=10
         DIFFICULTY=1
      End If
      Locate 33,16
      Print "  "
      Locate 33,16
      Print DIFFICULTY
   End If
   If T=3
      GAME
   End If
   If T=4
      Cls 0
      Limit Mouse 128,40 To 128+320,40+256
      Run "mania1:autoexec.amos"
   End If
   Goto QW
End Proc
INITIALISE
MAIN