home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / MegaTron / MegaTron.AMOS / MegaTron.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1994-03-02  |  25.2 KB  |  1,038 lines
  1. ' *************************************
  2. ' *                                   *
  3. ' *          Mega Tron V1.0           *
  4. ' *      Written by Chris Hodges      *
  5. ' *                                   *
  6. ' *************************************
  7. '
  8. ' PL 
  9. ' 00: X,Y,RX,RY,CO 
  10. ' 05: STATUS (1=ALIVE/0=DEAD)
  11. ' 06: DEVICE (OFF/JOY1/JOY0/KEY1/KEY2/KEY3/COM)
  12. ' 07: SCORE,MONEY
  13. ' 09: AUTOMATIC ENABLED
  14. ' 10: WEAPON1,WEAPON2,WEAPON3
  15. ' 13: SHIELD 
  16. ' 14: LAST CONTACT COLOUR
  17. '
  18. ' CONF 
  19. ' 00: MUSIC,SOUND,AUTOPLOT,INTELLIGENCE,GAME SPEED,ROUNDS  
  20. '
  21. ' KEYS 
  22. ' 00: LEFT,RIGHT,UP,DOWN,WEAPON1,WEAPON2,WEAPON3 
  23. '
  24. ' EX 
  25. ' 00: X,Y,CO,RA
  26. '
  27. ' RO 
  28. ' 00: X,Y,CO,EN,FUEL,KC
  29. '
  30. Close Workbench 
  31. Global MXPL,MXEX,MXRO,CH,SO,FC
  32. MXPL=10 : MXEX=10 : MXRO=10
  33. Dim PL(MXPL-1,14),CONF(5),KEYS(4,6),DEV$(6),CO$(12),WEAP$(9),WP(9),EXTKEYS$(15)
  34. Dim EX(MXEX-1,3),RO(MXRO-1,5)
  35. Global PL(),CONF(),DEV$(),CO$(),WEAP$(),WP(),EX(),RO()
  36. Degree 
  37. Hide On 
  38.  Extension_16_0456 "MegaTron.mus",-3
  39.  Extension_16_008A 3
  40. Break Off 
  41. TITLE
  42. Load "MegaTron.sam",5
  43.  Extension_16_008A 5
  44. INIT
  45. Do 
  46.   MENU
  47.   Exit If Param=0
  48.   SO=CONF(1)
  49.   RAWRESET
  50.   GAMEON
  51. Loop 
  52. If CONF(0) Then Call Start(9)+8 : Call Start(9)+4
  53. End 
  54. Procedure TITLE
  55.   MXDR=49
  56.   Dim DR(MXDR,1),ST$(5,5)
  57.   Unpack 8 To 0 : Screen Hide 
  58.   Unpack 10 To 3 : Screen Hide 
  59.   Get Palette 0 : For A=0 To 15 : Colour A+16,$FFF : Next 
  60.   Screen 0
  61.   For A=0 To 15 : Colour A+16,Colour(A) : Next 
  62.   Screen Open 2,320,32,2,0 : Screen Hide 
  63.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  64.   LG=Logbase(0)
  65.   Screen Open 1,320,256,32,0 : Screen Hide 
  66.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  67.   For A=0 To 31 : Colour A,0 : Next 
  68.   Screen Copy 0 To 1
  69.   Screen 0 : Paste Bob 0,48,1 : Screen 1
  70.   Gosub DROPINIT
  71.   Double Buffer 
  72.   Autoback 0
  73.   ST=Start(9)
  74.   Loke ST+10,Start(3)
  75.   Call ST
  76.   Call ST+6
  77.   Screen Show 
  78.   Fade 2 To 0
  79.   Screen 2
  80.   Repeat 
  81.     Screen Swap 1 : Wait Vbl 
  82.     C=0
  83.     For A=0 To MXDR
  84.       If DR(A,1)<40
  85.         Inc C
  86.         Paste Bob DR(A,0)-7,DR(A,1)-16,2
  87.         Add DR(A,1),Rnd(1)+1
  88.       End If 
  89.     Next 
  90.      Extension_16_0882 0,16,48,304,80 To 1,16,48,LG-48*40
  91.   Until C=0
  92.   Screen 2 : Cls 
  93.   Restore TEX
  94.   For PG=0 To 5
  95.     For LI=0 To 5
  96.       Read A$
  97.       ST$(PG,LI)=A$
  98.       Exit If A$=""
  99.     Next 
  100.   Next 
  101.   Screen 1
  102.   PG=0
  103.   Do 
  104.     Screen Copy 0 To Logic(1)
  105.     Fill Logbase(4) To Logbase(4)+40*256,0
  106.     Gosub PASTMASK
  107.     Screen Swap 
  108.     Gosub WHITIN
  109.     Screen Copy Physic(1) To Logic(1)
  110.     Gosub PASTTEXT
  111.     Screen Swap 
  112.     Gosub FADIN
  113.     For A=0 To 99
  114.       Multi Wait 
  115.       Exit If Fire(1) or Mouse Key or(Inkey$<>""),2
  116.     Next 
  117.     Gosub WHITIN
  118.     Screen Swap 
  119.     Gosub FADIN
  120.     Add PG,1,0 To 5
  121.   Loop 
  122.   Gosub WHITIN
  123.   Screen Swap 
  124.   Gosub FADIN
  125.   Screen 3 : For A=0 To 15 : Colour A,$FFF : Next 
  126.   Screen 1
  127.   Fade 1 To 3 : Wait 16
  128.   Fade 1 : Wait 16
  129.   For A=0 To 3 : Screen Close A : Next 
  130. Pop Proc
  131. PASTMASK:
  132.   Y=104
  133.   For LI=0 To 5
  134.     Exit If ST$(PG,LI)=""
  135.     X=160-Len(ST$(PG,LI))*8
  136.     For A=1 To Len(ST$(PG,LI))
  137.       C=Asc(Mid$(ST$(PG,LI),A,1))-32
  138.       Screen Copy 3,(C mod 20)*16,(C/20)*16,(C mod 20)*16+16,(C/20)*16+16 To Logic(1),X,Y,%1100000
  139.       Add X,16
  140.     Next 
  141.     Add Y,24
  142.   Next 
  143. Return 
  144. WHITIN:
  145.   Fade 2 To 3
  146.   Wait 32
  147. Return 
  148. PASTTEXT:
  149.   Y=104
  150.   For LI=0 To 5
  151.     Exit If ST$(PG,LI)=""
  152.     X=160-Len(ST$(PG,LI))*8
  153.     For A=1 To Len(ST$(PG,LI))
  154.       C=Asc(Mid$(ST$(PG,LI),A,1))-29
  155.       Paste Bob X,Y,C
  156.       Add X,16
  157.     Next 
  158.     Add Y,24
  159.   Next 
  160. Return 
  161. FADIN:
  162.   Fade 1 To 0
  163.   Wait 16
  164. Return 
  165. DROPINIT:
  166.   Do 
  167.     X=16
  168.     For A=0 To MXDR
  169.       DR(A,0)=X : DR(A,1)=0
  170.       Add X,Rnd(4)+5
  171.       Exit If X>=312,2
  172.     Next 
  173.   Loop 
  174.   For A=A To MXDR
  175.     DR(A,1)=100
  176.   Next 
  177. Return 
  178. TEX:
  179.   Data " ","WELCOME TO MEGATRON"," ","WRITTEN BY","CHRIS HODGES",""
  180.   Data " ","THIS IS SHAREWARE","ENJOY IT...","AND IF YOU LIKE IT","SEND ME SOME MONEY",""
  181.   Data "WRITE TO"," ","CHRIS HODGES","KENNEDYSTR. 8","82178 PUCHHEIM","WEST GERMANY"
  182.   Data " "," ","& THANKS &",""
  183.   Data "GREETINGS"," ","HENDRIK H. HEIMER","MICHAEL BERCHTOLD","THOMAS NOELKER","RALF SCHWOEBEL"
  184.   Data "GREETINGS"," ","HANS PETER, TOBIAS","RALF, XAVER, TOBI","FLORIAN, MICHAEL","MICHI AND MARKUS"
  185. End Proc
  186. Procedure INIT
  187.   Shared EXTKEYS$(),KEYS()
  188.   Restore DEVS
  189.   For A=0 To 6
  190.     Read DEV$(A)
  191.   Next 
  192.   Restore WEAPONS
  193.   For A=0 To 9
  194.     Read WEAP$(A)
  195.   Next 
  196.   Restore PRICE
  197.   For A=0 To 9
  198.     Read WP(A)
  199.   Next 
  200.   Restore FARBEN
  201.   For A=1 To 11
  202.     Read CO$(A)
  203.   Next 
  204.   Restore KEYS
  205.   For A=0 To 4
  206.     For K=0 To 6
  207.       Read KEYS(A,K)
  208.     Next 
  209.   Next 
  210.   Restore EXTKEYS
  211.   For A=0 To 15
  212.     Read EXTKEYS$(A)
  213.   Next 
  214.   For A=0 To MXPL-1
  215.     For AA=0 To 13 : PL(A,AA)=0 : Next 
  216.     PL(A,6)=6
  217.     PL(A,4)=A+2 : PL(A,10)=Rnd(9) : PL(A,11)=Rnd(9) : PL(A,12)=Rnd(9)
  218.   Next 
  219.   PL(0,6)=1
  220.   CONF(0)=1 : CONF(1)=1 : CONF(2)=0 : CONF(3)=1
  221.   CONF(4)=20 : CONF(5)=10 : FC=3
  222. Pop Proc
  223. DEVS:
  224.   Data "disabl","joy  1","joy  2","keys 1","keys 2","keys 3","compu."
  225. WEAPONS:
  226.   Data "none","speed up","imploder","tunnel","autopilot","boxes","circle","rockets"
  227.   Data "shield","teleport"
  228. PRICE:
  229.   Data 0,2,250,500,300,600,750,500,1000,250
  230. FARBEN:
  231.   Data "white","red","green","blue","magenta","cyan","amber","yellow","grey","l-green","pink"
  232. EXTKEYS:
  233.   Data "joy 1 left","joy 1 right","joy 1 up","joy 1 down","joy 1 fire","","",""
  234.   Data "joy 2 left","joy 2 right","joy 2 up","joy 2 down","joy 2 fire","","",""
  235. KEYS:
  236.   Data $80,$81,$82,$83,$84,$65,$67
  237.   Data $88,$89,$8A,$8B,$8C,$64,$66
  238.   Data $4F,$4E,$4C,$4D,$46,$5F,$41
  239.   Data $2D,$2F,$3E,$1E,$2E,$43,$4A
  240.   Data $31,$32,$10,$20,$40,$42,$63
  241. End Proc
  242. Procedure RAWRESET
  243.   For A=0 To MXPL-1
  244.     PL(A,8)=0 : PL(A,7)=0 : PL(A,13)=0 : PL(A,9)=0
  245.   Next 
  246. End Proc
  247. Procedure PLAZERRESET
  248.   For A=0 To MXEX-1
  249.     EX(A,2)=0
  250.   Next 
  251.   For A=0 To MXRO-1
  252.     RO(A,4)=0
  253.   Next 
  254.   CO=0
  255.   For A=0 To MXPL-1
  256.     If PL(A,6)>0 Then Inc CO
  257.   Next 
  258.   P=0
  259.   For A=0 To MXPL-1
  260.     If PL(A,6)>0
  261.       PL(A,0)=160+Cos((P*360)/CO)*80
  262.       PL(A,1)=112+Sin((P*360)/CO)*80
  263.       If Abs(PL(A,0)-160)>Abs(PL(A,1)-112)
  264.         PL(A,2)=Sgn(160-PL(A,0)) : PL(A,3)=0
  265.       Else 
  266.         PL(A,3)=Sgn(112-PL(A,1)) : PL(A,2)=0
  267.       End If 
  268.       PL(A,5)=1
  269.       Inc P
  270.     Else 
  271.       PL(A,5)=0
  272.     End If 
  273.     PL(A,9)=0 : PL(A,13)=0
  274.   Next 
  275. End Proc[CO]
  276. Procedure MENU
  277.   Shared EXTKEYS$(),KEYS()
  278.   ACPL=0
  279.   Dim ST$(1,1)
  280.   ST$(0,0)="off" : ST$(1,0)="on"
  281.   ST$(0,1)="low" : ST$(1,1)="high"
  282.   Set Rainbow 0,0,182,"","",""
  283.   Screen Open 1,320,64,16,0 : Screen Hide 
  284.   Curs Off : Flash Off : Paper 0 : Pen 1
  285.   Screen Display 1,128,229,320,64
  286.   Ink 1,0 : Gr Writing 0
  287.   For A=0 To 15 : Colour A,0 : Next 
  288.   Gosub UPDATLASTSCORE
  289.   Wait Vbl 
  290.   Screen Show 
  291.   Fade 1,0,$FFF,$F00,$F0,$44F,$F0F,$FF,$F80,$FF0,$888,$8F8,$F8F
  292.   Wait 8
  293.   Screen Open 0,640,180,8,0 : Screen Hide 
  294.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  295.   Screen Display 0,128,40,320,256
  296.   Screen Offset 0,0,0
  297.   Ink 1,0 : Gr Writing 0
  298.   Palette 0,0,0,0,0,0,0,0
  299.   For A=0 To 199
  300.     C=Rnd(2)
  301.     If C=0 Then C=7
  302.     X=Rnd(319) : Y=Rnd(179)
  303.      Extension_16_0388 X,Y,C
  304.   Next 
  305.   T1["Welcome to Megatron by Chris Hodges",0,1]
  306.   T1["Start game",24,3]
  307.   T1["Player options menu / Load & Save",40,5]
  308.   T1["Redefine keys",56,5]
  309.   Gosub UPDATMAINMENU
  310.   T1["Quit game",168,3]
  311.   Wait Vbl 
  312.   Rainbow 0,0,40,182
  313.   Screen Show 
  314.   MXBS=9
  315.   Fade 2,0,$FFF,$444,$FF0,$440,$F0F,$404,$888
  316.   Gosub FADINRAIN
  317.   TM=10 : SM=10 : CH=FC
  318.   Do 
  319.     Gosub CHECKS
  320.     If MK=0 and RX=0 Then SM=0
  321.     If MK
  322.       If NCP=0 or NCP=9 : Exit : End If 
  323.       If NCP=1 : Gosub PLAZERMENU : End If 
  324.       If NCP=2 : Gosub REDEFINE : End If 
  325.     End If 
  326.     If MK Then RX=1
  327.     If(TM=0) and RX
  328.       If NCP>2 and NCP<9 : TM=10 : End If 
  329.       If NCP=3
  330.         CONF(0)=1-CONF(0)
  331.         If CONF(0)=0
  332.           Call Start(9)+8 : Call Start(9)+4
  333.           FC=0
  334.         Else 
  335.           Call Start(9) : Call Start(9)+6
  336.           FC=3 : CH=3
  337.         End If 
  338.         T1["Music: "+ST$(CONF(0),0),72,1]
  339.       End If 
  340.       If NCP=4
  341.         CONF(1)=1-CONF(1)
  342.         T1["Sound: "+ST$(CONF(1),0),88,1]
  343.       End If 
  344.       If NCP=5
  345.         CONF(3)=1-CONF(3)
  346.         T1["Computer intelligence: "+ST$(CONF(3),1),104,1]
  347.       End If 
  348.       If NCP=6
  349.         Add CONF(4),RX,1 To 20
  350.         T1["Game speed:"+Str$(CONF(4)),120,1]
  351.       End If 
  352.       If NCP=7
  353.         CONF(2)=1-CONF(2)
  354.         T1["Autoplot: "+ST$(CONF(2),0),136,1]
  355.       End If 
  356.       If NCP=8
  357.         Add CONF(5),RX,1 To 20
  358.         T1["Rounds per game:"+Str$(CONF(5)),152,1]
  359.       End If 
  360.     End If 
  361.   Loop 
  362.   Fade 2 : Timer=0
  363.   Gosub FADOUTRAIN
  364.   While Timer<32 : Multi Wait : Wend 
  365.   Screen Close 0 : Rainbow Del : View 
  366.   Screen 1 : Fade 1 : Wait 16
  367.   Screen Close 1
  368. Pop Proc[NCP=0]
  369. UPDATLASTSCORE:
  370.   Cls 
  371.   T["Last game's score table",-1,0,1]
  372.   Pen 1 : Locate 0,2 : Print "device score money  device score money"
  373.   Y=3 : X=0
  374.   For A=0 To MXPL-1
  375.     If PL(A,6)
  376.       Pen PL(A,4)
  377.       Locate X,Y
  378.       SC=PL(A,7)
  379.       SC$=String$("0",6-Len(Str$(SC)))+Mid$(Str$(SC),2)
  380.       MN=PL(A,8)
  381.       MN$=String$("0",6-Len(Str$(MN)))+Mid$(Str$(MN),2)
  382.       Print DEV$(PL(A,6));" ";SC$;" ";MN$;
  383.       Inc Y : If Y>7 : Y=3 : Add X,20 : End If 
  384.     End If 
  385.   Next 
  386. Return 
  387. UPDATMAINMENU:
  388.   T1["Music: "+ST$(CONF(0),0),72,1]
  389.   T1["Sound: "+ST$(CONF(1),0),88,1]
  390.   T1["Computer intelligence: "+ST$(CONF(3),1),104,1]
  391.   T1["Game speed:"+Str$(CONF(4)),120,1]
  392.   T1["Autoplot: "+ST$(CONF(2),0),136,1]
  393.   T1["Rounds per game:"+Str$(CONF(5)),152,1]
  394. Return 
  395. CHECKS:
  396.   Gosub ACTUALCURS
  397.   Multi Wait : View : I$=Inkey$
  398.   SC=Scancode : KS=Key Shift
  399.   If KS
  400.     Trap SC= Extension_16_0506(KS)+$60
  401.   End If 
  402.   RX=(I$=Cleft$)-(I$=Cright$)+Jleft(1)-Jright(1)
  403.   RY=(I$=Cup$)-(I$=Cdown$)+Jup(1)-Jdown(1)
  404.   MK=(I$=Chr$(13))+(I$=" ")+Fire(1)
  405.   If RY=0 and RX=0 and MK=0 Then TM=0
  406.   If TM=0 and RY Then Add NCP,RY,0 To MXBS : TM=10
  407.   If(MK or RX) and CONF(1) and(SM=0)
  408.     SM=10 : Sam Play Extension_16_04F8(CH),5 : Add CH,1,FC To 3
  409.   End If 
  410.   SM=Max(SM-1,0)
  411.   TM=Max(TM-1,0)
  412. Return 
  413. CHECK2:
  414.   Gosub ACTUALCURS
  415.   Multi Wait : View : I$=Inkey$
  416.   SC=Scancode : KS=Key Shift
  417.   If KS
  418.     Trap SC= Extension_16_0506(KS)+$60
  419.   End If 
  420.   If Fire(1) Then SC=$84
  421.   If Fire(0) Then SC=$8C
  422. Return 
  423. FADINRAIN:
  424.   If CONF(1) : Sam Play Extension_16_04F8(CH),9 : Add CH,1,FC To 3 : End If 
  425.   OCP=1 : NCP=0 : FL=0
  426.   For A=7 To 0 Step -1
  427.     For B=0 To MXBS
  428.       For AA=0 To 7
  429.         Rain(0,B*16+AA+20)=Max(AA-A,0)
  430.         Rain(0,B*16+34-AA)=Max(AA-A,0)
  431.       Next 
  432.     Next 
  433.     Multi Wait : View 
  434.   Next 
  435. Return 
  436. FADOUTRAIN:
  437.   For A=0 To 7
  438.     Rain(0,OCP*16+A+20)=A
  439.     Rain(0,OCP*16+34-A)=A
  440.   Next 
  441.   If CONF(1) : Sam Play Extension_16_04F8(CH),9 : Add CH,1,FC To 3 : End If 
  442.   For A=0 To 7
  443.     For B=0 To 181
  444.       Rain(0,B)=Max(Rain(0,B)-1,0)
  445.     Next 
  446.     Multi Wait : View 
  447.   Next 
  448. Return 
  449. PLAZERMENU:
  450.   Gosub FADOUTRAIN
  451.   Ink 0 : Bar 320,0 To 639,179
  452.   For A=0 To 99
  453.     C=Rnd(2)
  454.     If C=0 Then C=7
  455.     X=Rnd(319) : Y=Rnd(179)
  456.      Extension_16_0388 X+320,Y,C
  457.   Next 
  458.   T2["Player options menu",0,1]
  459.   T2["Return to main menu",24,5]
  460.   Gosub UPDATPLY
  461.   T2["Load old settings",136,3]
  462.   T2["Save new settings",152,3]
  463.   If CONF(1) Then Sam Play Extension_16_04F8(CH),6 : Add CH,1,FC To 3
  464.   For A=0 To 320 Step 8
  465.     Screen Offset 0,A,0
  466.     Wait Vbl 
  467.   Next 
  468.   MXBS=8
  469.   Gosub FADINRAIN
  470.   Do 
  471.     Gosub CHECKS
  472.     If MK
  473.       If NCP=0
  474.         CO=0
  475.         For A=0 To MXPL-1
  476.           If PL(A,6)>0 : Inc CO : End If 
  477.         Next 
  478.         If CO<2
  479.           If CONF(1) and(SM=0) : SM=10 : Sam Play Extension_16_04F8(CH),1 : Add CH,1,FC To 3 : End If 
  480.         Else 
  481.           Exit 
  482.         End If 
  483.       End If 
  484.       If NCP=7 : Gosub OPTSLOAD : End If 
  485.       If NCP=8 : Gosub OPTSSAVE : End If 
  486.     End If 
  487.     If MK Then RX=1
  488.     If(TM=0) and RX
  489.       If NCP : TM=10 : End If 
  490.       If NCP=1 : Add ACPL,RX,0 To MXPL-1 : Gosub UPDATPLY : End If 
  491.       If NCP=2
  492.         Add PL(ACPL,4),RX,2 To 11
  493.         T2["Player"+Str$(ACPL+1)+"s color: "+CO$(PL(ACPL,4)),56,1]
  494.       End If 
  495.       If NCP=3
  496.         Add PL(ACPL,6),RX,0 To 6
  497.         T2["Player"+Str$(ACPL+1)+"s device: "+DEV$(PL(ACPL,6)),72,1]
  498.       End If 
  499.       If NCP>3 and NCP<7
  500.         Add PL(ACPL,NCP+6),RX,0 To 9
  501.         A$="Player"+Str$(ACPL+1)+"s weapon"+Str$(NCP-3)+": "+WEAP$(PL(ACPL,NCP+6))
  502.         A$=A$+" ("+Mid$(Str$(WP(PL(ACPL,NCP+6))),2)+")"
  503.         T2[A$,24+NCP*16,1]
  504.       End If 
  505.     End If 
  506.   Loop 
  507.   Gosub FADOUTRAIN
  508.   MXBS=9
  509.   If CONF(1) Then Sam Play Extension_16_04F8(CH),6 : Add CH,1,FC To 3
  510.   For A=320 To 0 Step -8
  511.     Screen Offset 0,A,0
  512.     Wait Vbl 
  513.   Next 
  514.   Gosub FADINRAIN
  515. Return 
  516. OPTSSAVE:
  517.   A$=""
  518.   For A=0 To 5
  519.     A$=A$+Chr$(CONF(A))
  520.   Next 
  521.   For A=0 To 4
  522.     For K=0 To 6
  523.       A$=A$+Chr$(KEYS(A,K))
  524.     Next 
  525.     A$=A$+Chr$($FF)
  526.   Next 
  527.   For A=0 To MXPL-1
  528.     For B=0 To 14
  529.       A$=A$+Chr$(0)+Chr$(PL(A,B)/$10000)+Chr$(PL(A,B)/256)+Chr$(PL(A,B) mod 256)
  530.     Next 
  531.   Next 
  532.   Open Out 1,"MegaTron.cfg"
  533.     Print #1,A$;
  534.   Close 1
  535. Return 
  536. OPTSLOAD:
  537.   If Exist("MegaTron.cfg")=0 Then Return 
  538.   If CONF(0) Then Call Start(9)+8 : Call Start(9)+4
  539.   FC=0
  540.    Extension_16_0456 "MegaTron.cfg",15
  541.   ST=Start(15)
  542.   For A=0 To 5
  543.     CONF(A)=Peek(ST) : Inc ST
  544.   Next 
  545.   For A=0 To 4
  546.     For K=0 To 6
  547.       KEYS(A,K)=Peek(ST) : Inc ST
  548.     Next 
  549.     Inc ST
  550.   Next 
  551.   For A=0 To MXPL-1
  552.     Exit If ST=>Start(15)+Length(15)
  553.     For B=0 To 14
  554.       PL(A,B)=Leek(ST) : Add ST,4
  555.     Next 
  556.   Next 
  557.   Erase 15
  558.   If CONF(0) Then Call Start(9) : Call Start(9)+6 : FC=3
  559.   CH=FC
  560.   Gosub UPDATPLY
  561.   Gosub UPDATMAINMENU
  562.   Screen 1 : Fade 1
  563.   For B=0 To 15 : Gosub CHECK2 : Next 
  564.   Gosub UPDATLASTSCORE
  565.   Fade 1,0,$FFF,$F00,$F0,$44F,$F0F,$FF,$F80,$FF0,$888,$8F8,$F8F
  566.   Screen 0
  567. Return 
  568. UPDATPLY:
  569.   T2["Player selected:"+Str$(ACPL+1),40,1]
  570.   T2["Player"+Str$(ACPL+1)+"s color: "+CO$(PL(ACPL,4)),56,1]
  571.   T2["Player"+Str$(ACPL+1)+"s device: "+DEV$(PL(ACPL,6)),72,1]
  572.   For A=4 To 6
  573.     A$="Player"+Str$(ACPL+1)+"s weapon"+Str$(A-3)+": "+WEAP$(PL(ACPL,A+6))
  574.     A$=A$+" ("+Mid$(Str$(WP(PL(ACPL,A+6))),2)+")"
  575.     T2[A$,24+A*16,1]
  576.   Next 
  577. Return 
  578. REDEFINE:
  579.   Gosub FADOUTRAIN
  580.   Ink 0 : Bar 320,0 To 639,179
  581.   For A=0 To 199
  582.     C=Rnd(2)
  583.     If C=0 Then C=7
  584.     X=Rnd(319) : Y=Rnd(112)
  585.      Extension_16_0388 X+320,Y,C
  586.   Next 
  587.   T2["Redefine keys menu",0,1]
  588.   T2["Return to main menu",24,5]
  589.   T2["Define joystick 1 special keys",40,1]
  590.   T2["Define joystick 2 special keys",56,1]
  591.   T2["Define keys set 1",72,1]
  592.   T2["Define keys set 2",88,1]
  593.   T2["Define keys set 3",104,1]
  594.   If CONF(1) Then Sam Play Extension_16_04F8(CH),6 : Add CH,1,FC To 3
  595.   For A=0 To 320 Step 8
  596.     Screen Offset 0,A,0
  597.     Wait Vbl 
  598.   Next 
  599.   MXBS=5
  600.   Gosub FADINRAIN
  601.   Do 
  602.     Gosub CHECKS
  603.     If MK
  604.       If NCP=0 : Exit : End If 
  605.       If NCP=1 : PRT=1 : DEV=0 : Gosub DEFINEJOY : End If 
  606.       If NCP=2 : PRT=2 : DEV=1 : Gosub DEFINEJOY : End If 
  607.       If NCP=3 : PRT=1 : DEV=2 : Gosub DEFINEKEYS : End If 
  608.       If NCP=4 : PRT=2 : DEV=3 : Gosub DEFINEKEYS : End If 
  609.       If NCP=5 : PRT=3 : DEV=4 : Gosub DEFINEKEYS : End If 
  610.     End If 
  611.   Loop 
  612.   Gosub FADOUTRAIN
  613.   MXBS=9
  614.   If CONF(1) Then Sam Play Extension_16_04F8(CH),6 : Add CH,1,FC To 3
  615.   For A=320 To 0 Step -8
  616.     Screen Offset 0,A,0
  617.     Wait Vbl 
  618.   Next 
  619.   Gosub FADINRAIN
  620. Return 
  621. DEFINEJOY:
  622.   Ink 0 : Bar 320,120 To 639,179
  623.   T2["Press the keys for joystick"+Str$(PRT),120,5]
  624.   For K=0 To 6 : Gosub SHOKEY : Next 
  625.   For K=4 To 6
  626.     Repeat : Gosub CHECK2 : Until SC=0
  627.     Gosub DEFINE
  628.   Next 
  629.   Ink 0 : Bar 320,120 To 639,129
  630. Return 
  631. DEFINEKEYS:
  632.   Ink 0 : Bar 320,120 To 639,179
  633.   T2["Press the keys for keyset"+Str$(PRT),120,5]
  634.   For K=0 To 6 : Gosub SHOKEY : Next 
  635.   For K=0 To 6
  636.     Repeat : Gosub CHECK2 : Until SC=0
  637.     Gosub DEFINE
  638.   Next 
  639.   Ink 0 : Bar 320,120 To 639,129
  640. Return 
  641. SHOKEY:
  642.   Gosub GEDIR
  643.   T[A$,X,140+Y*8,1]
  644.   SC=KEYS(DEV,K)
  645.   If SC>$7F
  646.     A$=EXTKEYS$(SC-$80)
  647.   Else 
  648.     A$= Extension_16_08B4(SC)
  649.   End If 
  650.   T[A$,X+56,140+Y*8,5]
  651. Return 
  652. GEDIR:
  653.   If K=0 Then A$="Left :" : X=320 : Y=0
  654.   If K=1 Then A$="Right:" : X=320 : Y=1
  655.   If K=2 Then A$="Up   :" : X=320 : Y=2
  656.   If K=3 Then A$="Down :" : X=320 : Y=3
  657.   If K=4 Then A$="Weap1:" : X=480 : Y=0
  658.   If K=5 Then A$="Weap2:" : X=480 : Y=1
  659.   If K=6 Then A$="Weap3:" : X=480 : Y=2
  660. Return 
  661. DEFINE:
  662.   Gosub GEDIR
  663.   T[A$,X,140+Y*8,3]
  664.   Repeat 
  665.     Gosub CHECK2
  666.   Until SC>0
  667.   If SC=$45
  668.     SC=KEYS(DEV,K)
  669.   Else 
  670.     KEYS(DEV,K)=SC
  671.   End If 
  672.   T[A$,X,140+Y*8,1]
  673.   Ink 0 : Bar X+56,140+Y*8 To X+159,147+Y*8
  674.   If SC>$7F
  675.     A$=EXTKEYS$(SC-$80)
  676.   Else 
  677.     A$= Extension_16_08B4(SC)
  678.   End If 
  679.   T[A$,X+56,140+Y*8,3]
  680.   Repeat 
  681.     Gosub CHECK2
  682.   Until SC=0
  683. Return 
  684. ACTUALCURS:
  685.   If NCP<>OCP
  686.     If CONF(1) : Sam Play Extension_16_04F8(CH),4 : Add CH,1,FC To 3 : End If 
  687.     For A=0 To 7
  688.       Rain(0,OCP*16+A+20)=A
  689.       Rain(0,OCP*16+34-A)=A
  690.     Next 
  691.     FL=0 : OCP=NCP
  692.   End If 
  693.   For A=0 To 7
  694.     Rain(0,NCP*16+A+20)=Max(A-Abs(FL),0)+(Abs(FL*A)/4)*$10
  695.     Rain(0,NCP*16+34-A)=Max(A-Abs(FL),0)+(Abs(FL*A)/4)*$10
  696.   Next 
  697.   Add FL,1,-7 To 7
  698. Return 
  699. End Proc
  700. Procedure GAMEON
  701.   Screen Open 0,320,256,16,0 : Screen Hide 
  702.   Curs Off : Flash Off : Paper 0 : Pen 1
  703.   Gr Writing 0
  704.   For A=0 To 15 : Colour A,0 : Next 
  705.   Screen Show 
  706.   Clip 0,0 To 320,216
  707.   For ROUNDS=1 To CONF(5)
  708.     PLAZERRESET
  709.     NP=Param
  710.     Cls 
  711.     Ink 1 : Box 0,0 To 319,215
  712.     Box 1,1 To 318,214
  713.     Fade 2,0,$FFF,$F00,$F0,$44F,$F0F,$FF,$F80,$FF0,$888,$8F8,$F8F
  714.     For A=0 To MXPL-1
  715.       If PL(A,5) Then Gosub DRAPLAYERS
  716.     Next 
  717.     T["Round"+Str$(ROUNDS),-1,96,1]
  718.     Gosub UPDAT
  719.     UPP=0
  720.     For A=5 To 1 Step -1
  721.       Ink 1 : Text 156,108+Text Base,Mid$(Str$(A),2)
  722.       If SO Then Sam Play Extension_16_04F8(CH),4 : Add CH,1,FC To 3
  723.       Wait 25
  724.       Ink 0 : Bar 156,108 To 164,116
  725.     Next 
  726.     If SO Then Sam Play Extension_16_04F8(CH),8 : Add CH,1,FC To 3
  727.     T["Round"+Str$(ROUNDS),-1,96,0]
  728.     TIM=0
  729.     While NP>1
  730.       Wait Vbl 
  731.       Gosub UPDATMONEY
  732.       Inc TIM : If TIM=CONF(4) Then Multi Wait : TIM=0
  733.       I$=Inkey$ : SC=Scancode : KS=Key Shift
  734.       If I$=Chr$(27) Then Fade 2 : Wait 32 : Exit 2
  735.       If I$="p" Then While Inkey$="" : Multi Wait : Wend 
  736.       Gosub CONTROL
  737.       MOVEEXPLO
  738.       MOVEROCKET
  739.       MOVEROCKET
  740.       If Rnd(100)=0 and CONF(2) Then Extension_16_0388 Rnd(317)+1,Rnd(223)+1,Rnd(11)
  741.       Ink 1 : Box 0,0 To 319,215
  742.       Box 1,1 To 318,214
  743.       For A=0 To MXPL-1
  744.         If PL(A,5)
  745.           Gosub MOVE
  746.           Gosub DRAPLAYERS
  747.         End If 
  748.       Next 
  749.     Wend 
  750.     For A=0 To MXPL-1
  751.       If PL(A,5) Then Add PL(A,7),2 : Add PL(A,8),1000
  752.     Next 
  753.     Fade 2
  754.     For A=0 To 31
  755.       Multi Wait 
  756.       MOVEEXPLO
  757.       Ink 1 : Box 0,0 To 319,215
  758.       Box 1,1 To 318,214
  759.     Next 
  760.   Next 
  761.   Clip 
  762.   Screen Close 0
  763. Pop Proc
  764. UPDAT:
  765.   UY=27 : UX=0 : UPP=0
  766.   For D=0 To MXPL-1
  767.     If PL(D,6)
  768.       Pen PL(D,4)
  769.       SC=PL(D,7)
  770.       SC$=String$("0",6-Len(Str$(SC)))+Mid$(Str$(SC),2)
  771.       MN=PL(D,8)
  772.       MN$=String$("0",6-Len(Str$(MN)))+Mid$(Str$(MN),2)
  773.       Locate UX,UY : Print DEV$(PL(D,6));" ";SC$;" ";MN$;
  774.       Inc UY : If UY>31 : UY=27 : Add UX,20 : End If 
  775.     End If 
  776.   Next 
  777. Return 
  778. UPDATMONEY:
  779.   If UPP=0 Then UY=27 : UX=0
  780.   If PL(UPP,6)
  781.     Pen PL(UPP,4)
  782.     MN=PL(UPP,8)
  783.     MN$=String$("0",6-Len(Str$(MN)))+Mid$(Str$(MN),2)
  784.     Locate UX+13,UY : Print MN$;
  785.     Inc UY : If UY>31 : UY=27 : Add UX,20 : End If 
  786.   End If 
  787.   Add UPP,1,0 To MXPL-1
  788. Return 
  789. CONTROL:
  790.   If SC=0 Then OSC=SC
  791.   If SC and(SC<>OSC) Then OSC=SC : ACTION[SC]
  792.   If KS=0 Then OKS=KS
  793.   If KS and(KS<>OKS) Then OKS=KS : Trap ACTION[ Extension_16_0506(KS)+$60]
  794.   JX=Abs(Jleft(1)+Jright(1)*2)
  795.   JY=Abs(Jup(1)+Jdown(1)*2)
  796.   If JX
  797.     ACTION[$7F+JX]
  798.   Else 
  799.     If JY
  800.       ACTION[$81+JY]
  801.     End If 
  802.   End If 
  803.   JF1=Fire(1)
  804.   If JF1=0 Then OJF1=JF1
  805.   If JF1 and JF1<>OJF1 Then OJF1=JF1 : ACTION[$84]
  806.   JX=Abs(Jleft(0)+Jright(0)*2)
  807.   JY=Abs(Jup(0)+Jdown(0)*2)
  808.   If JX
  809.     ACTION[$87+JX]
  810.   Else 
  811.     If JY
  812.       ACTION[$89+JY]
  813.     End If 
  814.   End If 
  815.   JF0=Fire(0)
  816.   If JF0=0 Then OJF0=JF0
  817.   If JF0 and JF0<>OJF0 Then OJF0=JF0 : ACTION[$8C]
  818. Return 
  819. DRAPLAYERS:
  820.   If PL(A,13)
  821.     Dec PL(A,13)
  822.     Ink 0 : Draw PL(A,0)+(PL(A,3)+PL(A,2))*5,PL(A,1)+(PL(A,2)+PL(A,3))*5 To PL(A,0)+(PL(A,2)-PL(A,3))*5,PL(A,1)+(PL(A,3)-PL(A,2))*5
  823.   End If 
  824.   If PL(A,9) or PL(A,13)
  825.      Extension_16_0388 PL(A,0),PL(A,1),1
  826.   Else 
  827.      Extension_16_0388 PL(A,0),PL(A,1),PL(A,4)
  828.   End If 
  829. Return 
  830. MOVE:
  831.   If(PL(A,6)=6 and Rnd(100000)<PL(A,8)) and CONF(3) Then ACTION[-A]
  832.   P= Extension_16_039E(PL(A,0)+PL(A,2),PL(A,1)+PL(A,3))
  833.   If P>0 and PL(A,9)>0 Then Gosub COMPI
  834.   If PL(A,6)=6 and((Rnd(100)=0 and CONF(3)) or P) Then Gosub COMPI
  835.   If P
  836.     PL(A,5)=0 : Dec NP
  837.     SETEXPLO[PL(A,0),PL(A,1),PL(A,4)]
  838.     If P=PL(A,4) : P=PL(A,14) : End If 
  839.     For EN=0 To MXPL-1
  840.       If PL(EN,5) and(PL(EN,4)=P)
  841.         Inc PL(EN,7)
  842.         Add PL(EN,8),500
  843.         Gosub UPDAT
  844.       End If 
  845.     Next 
  846.   Else 
  847.     PL(A,9)=Max(PL(A,9)-1,0)
  848.     Add PL(A,0),PL(A,2)
  849.     Add PL(A,1),PL(A,3)
  850.     If Abs(PL(A,2))=1 or Abs(PL(A,3))=1 : Add PL(A,8),2 : End If 
  851.   End If 
  852. Return 
  853. COMPI:
  854.   If P and(P<>PL(A,4)) Then PL(A,14)=P
  855.   R=Rnd(3)
  856.   For T=0 To 4
  857.     If R=0 Then RX=-1 : RY=0
  858.     If R=1 Then RX=1 : RY=0
  859.     If R=2 Then RY=-1 : RX=0
  860.     If R=3 Then RY=1 : RX=0
  861.     P= Extension_16_039E(PL(A,0)+RX,PL(A,1)+RY)
  862.     If P and(P<>PL(A,4)) Then PL(A,14)=P
  863.     If P=0
  864.       PL(A,2)=RX : PL(A,3)=RY
  865.       If SO and(CONF(0)=0) : Sam Play Extension_16_04F8(CH),5 : Add CH,1,FC To 3 : End If 
  866.       Return 
  867.     End If 
  868.     If T>2 Then ACTION[-A] : P= Extension_16_039E(PL(A,0)+RX,PL(A,1)+RY)
  869.     Add R,1,0 To 3
  870.   Next 
  871. Return 
  872. End Proc
  873. Procedure SETEXPLO[XX,YY,C]
  874.   For A=0 To MXEX-1
  875.     If EX(A,2)=0
  876.       EX(A,0)=XX : EX(A,1)=YY : EX(A,2)=C : EX(A,3)=1
  877.       If SO : Sam Play Extension_16_04F8(CH),1 : Add CH,1,FC To 3 : End If 
  878.       Pop Proc[A]
  879.     End If 
  880.   Next 
  881. End Proc[-1]
  882. Procedure MOVEEXPLO
  883.   For A=0 To MXEX-1
  884.     If EX(A,2)
  885.       If EX(A,3)<11
  886.         Ink EX(A,2) : Extension_16_05E6 EX(A,0),EX(A,1),EX(A,3)
  887.         Inc EX(A,3)
  888.       Else 
  889.         If EX(A,3)=20
  890.           Ink 0 : Extension_16_05E6 EX(A,0),EX(A,1),10
  891.           EX(A,2)=0
  892.         Else 
  893.           Ink 0 : Circle EX(A,0),EX(A,1),21-EX(A,3)
  894.           Inc EX(A,3)
  895.         End If 
  896.       End If 
  897.     End If 
  898.   Next 
  899. End Proc
  900. Procedure SETROCKET[XX,YY,C,E]
  901.   For A=0 To MXRO-1
  902.     If RO(A,4)=0
  903.       RO(A,0)=XX : RO(A,1)=YY : RO(A,2)=C : RO(A,3)=E : RO(A,4)=150
  904.       RO(A,5)=-1
  905.       If SO : Sam Play Extension_16_04F8(CH),6 : Add CH,1,FC To 3 : End If 
  906.       Exit 
  907.     End If 
  908.   Next 
  909. End Proc
  910. Procedure MOVEROCKET
  911.   For A=0 To MXRO-1
  912.     If RO(A,4)
  913.       EN=RO(A,3)
  914.       RX=Sgn(PL(EN,0)-RO(A,0)) : RY=Sgn(PL(EN,1)-RO(A,1))
  915.       If RO(A,5)=>0 : Extension_16_0388 RO(A,0),RO(A,1),RO(A,5) : End If 
  916.       P= Extension_16_039E(RO(A,0)+RX,RO(A,1)+RY)
  917.       Dec RO(A,4)
  918.       If PL(EN,5)=0 or RO(A,4)=0 or(P>0 and P<>RO(A,2))
  919.         SETEXPLO[RO(A,0),RO(A,1),RO(A,2)]
  920.         If Param=>0 : EX(Param,3)=10 : End If 
  921.         RO(A,4)=0
  922.       Else 
  923.         RO(A,5)=P
  924.         Add RO(A,0),RX
  925.         Add RO(A,1),RY
  926.          Extension_16_0388 RO(A,0),RO(A,1),1
  927.       End If 
  928.     End If 
  929.   Next 
  930. End Proc
  931. Procedure ACTION[KEY]
  932.   Shared KEYS()
  933.   If KEY<=0 Then Gosub COMPACT Else Gosub HUMACT
  934. Pop Proc
  935. HUMACT:
  936.   For A=0 To MXPL-1
  937.     If PL(A,5)
  938.       D=PL(A,6)
  939.       If D>0 and D<6
  940.         For K=0 To 6
  941.           If KEYS(D-1,K)=KEY
  942.             On K+1 Gosub TLEFT,TRIGHT,TUP,TDOWN,WEAPON,WEAPON,WEAPON
  943.             Exit 
  944.           End If 
  945.         Next 
  946.       End If 
  947.     End If 
  948.   Next 
  949. Return 
  950. COMPACT:
  951.   K=Rnd(2)+4 : A=-KEY
  952.   Gosub WEAPON
  953. Return 
  954. TLEFT:
  955.   If PL(A,2)=0 Then PL(A,2)=-1 : PL(A,3)=0 : If SO Then Sam Play Extension_16_04F8(CH),5 : Add CH,1,FC To 3
  956. Return 
  957. TRIGHT:
  958.   If PL(A,2)=0 Then PL(A,2)=1 : PL(A,3)=0 : If SO Then Sam Play Extension_16_04F8(CH),5 : Add CH,1,FC To 3
  959. Return 
  960. TUP:
  961.   If PL(A,3)=0 Then PL(A,3)=-1 : PL(A,2)=0 : If SO Then Sam Play Extension_16_04F8(CH),5 : Add CH,1,FC To 3
  962. Return 
  963. TDOWN:
  964.   If PL(A,3)=0 Then PL(A,3)=1 : PL(A,2)=0 : If SO Then Sam Play Extension_16_04F8(CH),5 : Add CH,1,FC To 3
  965. Return 
  966. WEAPON:
  967.   WP=PL(A,K+6)
  968.   If PL(A,8)<WP(WP) Then Return 
  969.   C=0
  970.   For T=0 To MXPL-1
  971.     If PL(T,5) Then Inc C
  972.   Next 
  973.   If C=0 Then Return 
  974.   Repeat 
  975.     EN=Rnd(MXPL-1)
  976.   Until PL(EN,5) and A<>EN
  977.   Add PL(A,8),-WP(WP)
  978.   On WP Gosub SPEEDUP,IMPLODER,TUNNEL,AUTOPILOT,BOES,BIGBOX,ROCKETS,SHIELD,TELEPORT
  979. Return 
  980. SPEEDUP:
  981.   PL(A,2)=Sgn(PL(A,2))*2 : PL(A,3)=Sgn(PL(A,3))*2
  982. Return 
  983. IMPLODER:
  984.   If SO Then Sam Play Extension_16_04F8(CH),10 : Add CH,1,FC To 3
  985.   Ink 0 : Extension_16_05E6 PL(A,0),PL(A,1),10
  986. Return 
  987. TUNNEL:
  988.   If SO Then Sam Play Extension_16_04F8(CH),7 : Add CH,1,FC To 3
  989.   Ink PL(A,4)
  990.   Draw PL(EN,0)+PL(EN,3),PL(EN,1)+PL(EN,2) To PL(EN,0)+PL(EN,3)+PL(EN,2)*20,PL(EN,1)+PL(EN,2)+PL(EN,3)*20
  991.   Draw PL(EN,0)-PL(EN,3),PL(EN,1)-PL(EN,2) To PL(EN,0)-PL(EN,3)+PL(EN,2)*20,PL(EN,1)-PL(EN,2)+PL(EN,3)*20
  992. Return 
  993. AUTOPILOT:
  994.   If SO Then Sam Play Extension_16_04F8(CH),3 : Add CH,1,FC To 3
  995.   Add PL(A,9),250
  996. Return 
  997. BOES:
  998.   If SO Then Sam Play Extension_16_04F8(CH),2 : Add CH,1,FC To 3
  999.   Ink PL(A,4)
  1000.   Box PL(EN,0)-7,PL(EN,1)-7 To PL(EN,0)-2,PL(EN,1)-2
  1001.   Box PL(EN,0)+7,PL(EN,1)-7 To PL(EN,0)+2,PL(EN,1)-2
  1002.   Box PL(EN,0)-7,PL(EN,1)+7 To PL(EN,0)-2,PL(EN,1)+2
  1003.   Box PL(EN,0)+7,PL(EN,1)+7 To PL(EN,0)+2,PL(EN,1)+2
  1004. Return 
  1005. BIGBOX:
  1006.   If SO Then Sam Play Extension_16_04F8(CH),2 : Add CH,1,FC To 3
  1007.   Ink PL(A,4)
  1008.   Circle PL(EN,0),PL(EN,1),48
  1009. Return 
  1010. ROCKETS:
  1011.   SETROCKET[PL(A,0),PL(A,1),PL(A,4),EN]
  1012. Return 
  1013. SHIELD:
  1014.   Add PL(A,13),250
  1015. Return 
  1016. TELEPORT:
  1017.   If SO Then Sam Play Extension_16_04F8(CH),9 : Add CH,1,FC To 3
  1018.   PL(A,0)=Rnd(317)+1 : PL(A,1)=Rnd(213)+1
  1019.   Gosub IMPLODER
  1020. Return 
  1021. End Proc
  1022. Procedure T[T$,XX,Y,C]
  1023.   If XX<0 Then XX=160-Len(T$)*4
  1024.   YY=Y+Text Base
  1025.   Ink C : Text XX,YY,T$
  1026. End Proc
  1027. Procedure T1[T$,Y,C]
  1028.   XX=160-Len(T$)*4 : YY=Y+Text Base
  1029.   Ink 0 : Bar XX-8,Y To XX+Len(T$)*8+8,Y+9
  1030.   Ink C+1 : Text XX+1,YY+1,T$
  1031.   Ink C : Text XX,YY,T$
  1032. End Proc
  1033. Procedure T2[T$,Y,C]
  1034.   XX=480-Len(T$)*4 : YY=Y+Text Base
  1035.   Ink 0 : Bar XX-32,Y To XX+Len(T$)*8+32,Y+9
  1036.   Ink C+1 : Text XX+1,YY+1,T$
  1037.   Ink C : Text XX,YY,T$
  1038. End Proc