home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 551-575 / apd558 / amoner1 / fortron.amos / fortron.amosSourceCode
AMOS Source Code  |  1993-11-29  |  7KB  |  281 lines
  1. Load "fortron.bank"
  2. Hide 
  3. Set Rainbow 2,0,300,"(150,0,1)(10,1,0)","(10,0,1)(20,1,0)","(20,1,0)"
  4. Set Rainbow 1,0,300,"(20,1,15)","(7,0,1)(20,1,15)","(14,0,1)(20,1,15)"
  5. Screen Close 0
  6. Randomize Timer
  7. Do 
  8.    TITLES
  9.    'COMPETITION 
  10.    TRON[$F22,$2F2]
  11.    'SCORE=Rnd(7) : SCORE1=Rnd(7)
  12.    SCORESHOW["Red","Green",SCORE,SCORE1]
  13. Loop 
  14. '
  15. '
  16. Procedure TRON[CLR1,CLR2]
  17.    II=0 : II1=0
  18.    Shared SCORE,SCORE1
  19.    Dim DX(4),DY(4)
  20.    For I=1 To 4 : Read DX(I),DY(I) : Next 
  21.    Data 0,-1,0,1,-1,0,1,0
  22.    SCORE=0 : SCORE1=0
  23.    GAME:
  24.    Screen Open 2,960,600,4,LORES
  25.    Screen Hide 2
  26.    Flash Off 
  27.    Cls 4
  28.    For A=0 To 960 Step 30
  29.       Ink 1
  30.       Draw A,0 To A,600
  31.    Next 
  32.    For A=0 To 600 Step 30
  33.       Draw 0,A To 960,A
  34.    Next 
  35.    Ink 2
  36.    Bar 0,0 To 960,10
  37.    Bar 0,590 To 960,600
  38.    Bar 0,0 To 10,600
  39.    Bar 950,0 To 960,600
  40.    Unpack 6 To 1
  41.    Palette $A,$25A,CLR1,CLR2
  42.    Colour Back $A
  43.    Gosub SCOREUP
  44.    Wait 40
  45.    Ink 0
  46.    Bar 10,10 To 150,150
  47.    Bar 170,10 To 310,150
  48.    Screen 1
  49.    Double Buffer 
  50.    Flash Off : Curs Off 
  51.    Gosub SCOREUP
  52.    Autoback 0
  53.    DR=Rnd(3)+1 : DR1=Rnd(3)+1
  54.    Repeat 
  55.       X=Rnd(250)+425 : Y=Rnd(100)+250 : X1=Rnd(250)+425 : Y1=Rnd(100)+250
  56.    Until(Abs(X-X1)>60) and(Abs(Y-Y1)>60)
  57.    SPD=5 : SPD1=5 : II=30 : II1=30
  58.    ITER:
  59.    DEAD=0
  60.    If Jdown(1) and DR<>1 Then DR=2 : Goto P1
  61.    If Jup(1) and DR<>2 Then DR=1 : Goto P1
  62.    If Jleft(1) and DR<>4 Then DR=3 : Goto P1
  63.    If Jright(1) and DR<>3 Then DR=4
  64.    P1:
  65.    If(Fire(1)) and(SPD<7) Then Inc SPD
  66.    If(Fire(0)) and(SPD1<7) Then Inc SPD1
  67.    If(Fire(1)=0) Then SPD=5
  68.    If(Fire(0)=0) Then SPD1=5
  69.    If Jdown(0) and DR1<>1 Then DR1=2 : Goto P2
  70.    If Jup(0) and DR1<>2 Then DR1=1 : Goto P2
  71.    If Jleft(0) and DR1<>4 Then DR1=3 : Goto P2
  72.    If Jright(0) and DR1<>3 Then DR1=4
  73.    P2:
  74.    '
  75.    D2=(X-X1)*(X-X1)+(Y-Y1)*(Y-Y1)
  76.    Volume %1010,Min(63,30000/D2)
  77.    ' as == approach speed 
  78.    XX=X-X1+DX(DR)-DX(DR1)
  79.    YY=Y-Y1+DY(DR)-DY(DR1)
  80.    _AS=Sqr((XX*XX+YY*YY)*200)
  81.    _AS=_AS-Sqr(D2*200)
  82.    Volume %101,20
  83.    Sam Raw %1,Start(10),Length(10),1000+II*20
  84.    Sam Raw %100,Start(10),Length(10),1200+II1*20
  85.    Sam Raw %1000,Start(10),Length(10),1200+II1*20-_AS*8
  86.    Sam Raw %10,Start(10),Length(10),1000+II*20-_AS*8
  87.    If SPD*10>II Then Inc II Else If SPD*10<II Then Add II,-4
  88.    If SPD1*10>II1 Then Inc II1 Else If SPD1*10<II1 Then Add II1,-4
  89.    Screen 2
  90.    Ink 2
  91.    If DR=1 Then Goto U1
  92.    If DR=2 Then Goto D1
  93.    If DR=3 Then Goto L1
  94.    If DR=4 Then Goto R1
  95.    NXT:
  96.    Ink 3
  97.    If DR1=1 Then Goto U2
  98.    If DR1=2 Then Goto D2
  99.    If DR1=3 Then Goto L2
  100.    If DR1=4 Then Goto R2
  101.    NXT1:
  102.    H=X : V=Y : H1=X1 : V1=Y1
  103.    If H<71 Then H=71
  104.    If V<71 Then V=71
  105.    If H1<71 Then H1=71
  106.    If V1<71 Then V1=71
  107.    If H>888 Then H=888
  108.    If H1>888 Then H1=888
  109.    If V>528 Then V=528
  110.    If V1>528 Then V1=528
  111.    Get Block 1,H-71,V-71,143,143
  112.    Get Block 2,H1-71,V1-71,143,143
  113.    Screen 1
  114.    Put Block 1,10,10
  115.    Put Block 2,170,10
  116.    Screen Swap 
  117.    Wait Vbl 
  118.    If DEAD>0 Then Goto TEST
  119.    Goto ITER
  120.    DEAD:
  121.    End 
  122.    U1:
  123.    Y=Y-SPD
  124.    If Point(X,Y)>1 or Point(X,Y+2)>1 Then DEAD=DEAD+1
  125. If(SPD=7) and(Rnd(20)=0) Then Goto NXT
  126.    Bar X-2,Y To X+2,Y+SPD
  127.    Goto NXT
  128.    D1:
  129.    Y=Y+SPD
  130.    If Point(X,Y)>1 or Point(X,Y-2)>1 Then DEAD=DEAD+1
  131. If(SPD=7) and(Rnd(20)=0) Then Goto NXT
  132.    Bar X-2,Y-SPD To X+2,Y : Goto NXT
  133.    Goto NXT
  134.    L1:
  135.    X=X-SPD
  136.    If Point(X,Y)>1 or Point(X+2,Y)>1 Then DEAD=DEAD+1
  137. If(SPD=7) and(Rnd(20)=0) Then Goto NXT
  138.    Bar X,Y-2 To X+SPD,Y+2 : Goto NXT
  139.    Goto NXT
  140.    R1:
  141.    X=X+SPD
  142.    If Point(X,Y)>1 or Point(X-2,Y)>1 Then DEAD=DEAD+1
  143. If(SPD=7) and(Rnd(20)=0) Then Goto NXT
  144.    Bar X-SPD,Y-2 To X,Y+2
  145.    Goto NXT
  146.    U2:
  147.    Y1=Y1-SPD1
  148.    If Point(X1,Y1)>1 or Point(X1,Y1+2)>1 Then DEAD=DEAD+2
  149. If(SPD1=7) and(Rnd(20)=0) Then Goto NXT1
  150.    Bar X1-2,Y1 To X1+2,Y1+SPD1
  151.    Goto NXT1
  152.    D2:
  153.    Y1=Y1+SPD1
  154.    If Point(X1,Y1)>1 or Point(X1,Y1-2)>1 Then DEAD=DEAD+2
  155. If(SPD1=7) and(Rnd(20)=0) Then Goto NXT1
  156.    Bar X1-2,Y1-SPD1 To X1+2,Y1
  157.    Goto NXT1
  158.    L2:
  159.    X1=X1-SPD1
  160.    If Point(X1,Y1)>1 or Point(X1+2,Y1)>1 Then DEAD=DEAD+2
  161. If(SPD1=7) and(Rnd(20)=0) Then Goto NXT1
  162.    Bar X1,Y1-2 To X1+SPD1,Y1+2
  163.    Goto NXT1
  164.    R2:
  165.    X1=X1+SPD1
  166.    If Point(X1,Y1)>1 or Point(X1-2,Y1)>1 Then DEAD=DEAD+2
  167. If(SPD1=7) and(Rnd(20)=0) Then Goto NXT1
  168.    Bar X1-SPD1,Y1-2 To X1,Y1+2
  169.    Goto NXT1
  170.    TEST:
  171.    If DEAD=1 Then SCORE1=SCORE1+1
  172.    If DEAD=2 Then SCORE=SCORE+1
  173.    Boom 
  174.    Gosub SCOREUP
  175.    Wait 50
  176.    If SCORE>6 or SCORE1>6 Then Goto FINITO
  177.    Goto GAME
  178.    SCOREUP:
  179.    Pen 1 : Paper 0
  180.    Locate 13,22 : Print SCORE
  181.    Locate 33,22 : Print SCORE1
  182.    Return 
  183.    FINITO:
  184.    Screen Close 1
  185.    Screen Close 2
  186.    Colour Back 0
  187. End Proc
  188. Procedure SCORESHOW[P1$,P2$,S1,S2]
  189.    Dim CR$(7)
  190.    Bank Swap 3,4
  191.    Music 1
  192.    Screen Open 1,320,200,2,Lowres
  193.    Cls 0
  194.    Curs Off 
  195.    Palette 0,$FFF
  196.    Rainbow 1,0,20,300
  197.    '
  198.    Print : Print : Print : Print 
  199.    Centre "Scores for previous round:" : Print : Print 
  200.    For I=0 To 7 : Read CR$(I) : Next 
  201.    Centre P2$+" "+CR$(S1)+"," : Print : Print 
  202.    Centre P1$+" "+CR$(S2)+"." : Print : Print : Print : Print 
  203.    If S1>S2
  204.       Centre P1$+" wins this round."
  205.    Else 
  206.       Centre P2$+" wins this round."
  207.    End If 
  208.    '
  209.    Clear Key 
  210.    Wait Key 
  211.    Screen Close 1
  212.    Music Off 
  213.    Bank Swap 3,4
  214.    Rainbow 1,0,0,0
  215.    Data "never crashed","crashed once","crashed twice","crashed 3 times"
  216.    Data "crashed 4 times","crashed 5 times","crashed 6 times","crashed 7 times"
  217. End Proc
  218. Procedure TITLES
  219.    Set Rainbow 2,0,300,"(150,0,1)(10,1,0)","(10,0,1)(20,1,0)","(20,1,0)"
  220.    Rainbow 2,0,40,300
  221.    Music 1
  222.    Unpack 7 To 1
  223.    Flash 1,"(fff,1)(222,2)"
  224.    Get Bob 1,1,0,127 To 283,166
  225.    Get Bob 1,2,0,167 To 283,209
  226.    Bar 0,0 To 11,6
  227.    Get Bob 1,3,0,0 To 5,2
  228.    Get Bob 1,4,0,0 To 10,5
  229.    Ink 0
  230.    Bar 0,0 To 11,6
  231.    Bar 0,127 To 283,209
  232.    Double Buffer 
  233.    Degree 
  234.    While A$="" : A$=Inkey$
  235.       I#=I#+4.0
  236.       X1=Cos(I#*2.0)*20+Sin(I#*0.5)*50-70
  237.       X2=Sin(I#*0.4)*50+Cos(I#)*20-70
  238.       Bob 12,X1,150,1
  239.       Bob 13,X2,155,2
  240.       Add I1,-10,0 To 320 : Bob 1,I1,155,3
  241.       Add I2,-12,0 To 320 : Bob 2,I2,165,3
  242.       Add I3,-35,0 To 320 : Bob 3,I3,190,4
  243.       '
  244.       Wait Vbl 
  245.    Wend 
  246.    If A$=Chr$(27)
  247.      Default 
  248.      Run "Start.Amos"
  249.    End If 
  250.    Screen Close 1
  251.    Rainbow 2,0,0,0
  252.    Music Off 
  253. End Proc
  254. Procedure COMPETITION
  255.    Dim F$(8)
  256.    Screen Open 1,320,200,16,Lowres
  257.    Paper 0 : Pen 1
  258.    Cls 
  259.    Palette 0,$FFF,$FF,$FF0,$F00,$F0,$33F,$0,$FFF,$FF0,$F0F,$FF
  260.    Rainbow 1,0,20,300
  261.    Centre "Enter the names of the players," : Print : Print 
  262.    Centre "Press return on a blank line to finish" : Print : Print 
  263.    I=0
  264.    Repeat 
  265.       Pen I+4
  266.       Input F$(I)
  267.       Inc I
  268.    Until(I>8) or(F$="")
  269.    Cls 
  270.    Pen 1
  271.    Print "Do you want to play a "
  272.    Print Paper$(6);"R";Paper$(0);"ound robin, or"
  273.    Print Paper$(6);"E";Paper$(0);"limination ?"
  274.    Repeat 
  275.       I$=Inkey$
  276.    Until(I$="r") or(I$="e")
  277.    If I$="r"
  278.       GAMES=I*(I-1)-I
  279.    End If 
  280.    Screen Close 1
  281. End Proc