home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 501-525 / apd510 / def-pixel+.amos / def-pixel+.amosSourceCode < prev    next >
AMOS Source Code  |  1992-02-07  |  18KB  |  693 lines
  1. Set Buffer 100
  2. '
  3. ' Def-Pixel Jan '92 Final Version
  4. ' The First Production from TUF (ex SYSTEM 5)
  5. ' CODE : AngelDust  GFX : SHOCK G  MUSIC : Kbyte   
  6. ' Thanks to sausage and the others whose routines I used ..
  7. '
  8. PART_1
  9. PART_2
  10. PART_3
  11. PART_4
  12. PART_6
  13. PART_5
  14. PART_7
  15. Procedure PART_1
  16.    Hide On 
  17.    Screen Hide 0
  18.    Curs Off : Flash Off : Cls 0 : Double Buffer : Get Sprite Palette 
  19.    C$="L:M 0,2,4;M 0,2,2;M 0,4,2;M 0,12,4;"
  20.    C$=C$+"M 0,-12,4;M 0,-4,2;M 0,-2,2;M 0,-2,4"
  21.    C$=C$+"M 0,-1,5;M 0,1,5;P;J L;"
  22.    X=30
  23.    XX=70
  24.    Bob 1,100-X,100,16 : Bob 2,118-X,100,18 : Bob 3,136-X,100,15
  25.    Bob 4,154-X,100,4 : Bob 5,172-X,100,21 : Bob 6,190-X,100,3
  26.    Bob 7,208-X,100,20 : Bob 8,221-X,100,9 : Bob 9,235-X,100,15
  27.    Bob 10,253-X,100,14 : Bob 11,271-X,100,19
  28.    Bob 12,208-XX,50,20 : Bob 13,225-XX,50,21 : Bob 14,242-XX,50,6
  29.    C=1 : B=1
  30.    Repeat 
  31.       Channel C To Bob B
  32.       Amal C,C$
  33.       Wait 2 : Amal On C
  34.       Inc C : Inc B
  35.    Until B=12
  36.    C$="L:M 0,4,4;M 0,4,2;M 0,6,2;M 0,14,4;"
  37.    C$=C$+"M 0,-14,4;M 0,-6,2;M 0,-4,2;M 0,-4,4"
  38.    C$=C$+"M 0,-3,5;M 0,3,5;J L;"
  39.    Repeat 
  40.       Channel C To Bob B
  41.       Amal C,C$
  42.       Wait 2 : Amal On C
  43.       Inc C : Inc B
  44.    Until B=15
  45.    Screen To Front 0
  46.    Screen Show 0
  47.    '
  48.    Wait 200
  49.    Fade 2 : Wait 45
  50.    Amal Off 
  51.    Screen Close 0
  52. Music 1 : Tempo $17
  53. End Proc
  54. Procedure PART_2
  55.    Set Rainbow 0,0,100,"","","(1,1,15)(1,-1,15)"
  56.    Rainbow 0,0,40,30
  57.    Set Rainbow 1,0,100,"","","(1,1,15)(1,-1,15)"
  58.    Rainbow 1,0,245,30
  59.    Screen Open 1,320,200,8,Lowres
  60.    Double Buffer 
  61.    Curs Off : Flash Off : Cls 0
  62.    Fade 1 : Wait 10
  63.    Screen Open 2,320,200,4,Lowres
  64.    Curs Off : Flash Off : Cls 0
  65.    Screen Display 1,135,60,,
  66.    Screen Display 2,130,50,,
  67.    Wait Vbl 
  68.    Dual Playfield 1,2
  69.    Screen 1
  70.    Paper 0
  71.    Locate ,2
  72.    Centre "-------------"
  73.    Locate ,3
  74.    Centre "- Def Pixel -"
  75.    Locate ,4
  76.    Centre "-------------"
  77.    Locate ,8
  78.    Centre "Welcome to the First Production From TUF"
  79.    Locate ,10
  80.    Centre "Hopefully we will release many more"
  81.    Locate ,12
  82.    Centre "Productions in 1992"
  83.    Locate ,16
  84.    Centre "Next Release is"
  85.    Locate ,18
  86.    Centre "- Commune v0.01 -"
  87.    Locate ,20
  88.    Centre "An Answer Machine For SysOps"
  89.    Locate ,22
  90.    Centre "Left Mouse Button To Exit Any Part"
  91.    Fade 1 To -1 : Wait 50
  92.    Colour 9,$FFF
  93.    Palette ,,,,,,,,,,,,,,,,$0,$D,$B,$9,$7,$5,$4,$3,$0,$800,$B00,$F00,$0,$800,$B00,$F00 : Paper 0
  94.    Screen 2
  95.    STARS
  96.    X=1 : XX=360
  97.    COUNTER=3330
  98.    Degree 
  99.    Do 
  100.       For COUNT=X To XX Step 3.6
  101.          If Mouse Key=1 Then Goto ENND
  102.          X#=Cos(COUNT)
  103.          Y#=Cos(COUNTER)
  104.          Z#=Cos(COUNT+23)
  105.          W#=Cos(COUNTER+23)
  106.          A#=Cos(COUNT+45)
  107.          B#=Cos(COUNTER+45)
  108.          C#=Cos(COUNT+68)
  109.          D#=Cos(COUNTER+68)
  110.          E#=Cos(COUNT+90)
  111.          F#=Cos(COUNTER+90)
  112.          G#=Cos(COUNT+113)
  113.          H#=Cos(COUNTER+113)
  114.          I#=Cos(COUNT+135)
  115.          J#=Cos(COUNTER+135)
  116.          K#=Cos(COUNT+158)
  117.          L#=Cos(COUNTER+158)
  118.          X1#=Cos(COUNT+180)
  119.          Y1#=Cos(COUNTER+180)
  120.          Z1#=Cos(COUNT+203)
  121.          W1#=Cos(COUNTER+203)
  122.          A1#=Cos(COUNT+225)
  123.          B1#=Cos(COUNTER+225)
  124.          C1#=Cos(COUNT+248)
  125.          D1#=Cos(COUNTER+248)
  126.          E1#=Cos(COUNT+270)
  127.          F1#=Cos(COUNTER+270)
  128.          G1#=Cos(COUNT+293)
  129.          H1#=Cos(COUNTER+293)
  130.          I1#=Cos(COUNT+325)
  131.          J1#=Cos(COUNTER+325)
  132.          K1#=Cos(COUNT+338)
  133.          L1#=Cos(COUNTER+338)
  134.          Sprite 10,X Hard(G#*140+160),Y Hard(H#*80+118),4
  135.          Sprite 12,X Hard(I#*140+160),Y Hard(J#*80+118),5
  136.          Sprite 14,X Hard(K#*140+160),Y Hard(L#*80+118),6
  137.          Sprite 18,X Hard(Z1#*140+160),Y Hard(W1#*80+118),16
  138.          Sprite 20,X Hard(A1#*140+160),Y Hard(B1#*80+118),9
  139.          Sprite 22,X Hard(C1#*140+160),Y Hard(D1#*80+118),24
  140.          Sprite 24,X Hard(E1#*140+160),Y Hard(F1#*80+118),5
  141.          Sprite 26,X Hard(G1#*140+160),Y Hard(H1#*80+118),12
  142.          If Mouse Key=1 Then Goto ENND
  143.          SCOL
  144.          Add COUNTER,14.4
  145.       Next COUNT
  146.    Loop 
  147.    ENND:
  148.    Screen 1
  149.    Sprite Off 
  150.    Fade 1 : Wait 50
  151.    Screen Close 1 : Screen Close 2
  152.    Rainbow Del 
  153.    Bob Off 
  154.    Amal Off 
  155.    Wait 5
  156. End Proc
  157. Procedure PART_3
  158.    Unpack 7 To 1
  159.    Screen Hide 1
  160.    LASER_PAINTER
  161.    '
  162.    Screen Open 0,640,140,8,Lowres : Cls 0 : Curs Off : Flash Off 
  163.    Screen Display 0,140,150,320,135
  164.    Get Icon Palette 
  165.    Global PP$
  166.    SS=80
  167.    Set Rainbow 0,0,100,"","","(5,-1,125)"
  168.    Rainbow 0,0,267,70
  169.    A$="A:M 320,0,RB;L X=0;L RA=1;J A;"
  170.    Amreg(1)=SS
  171.    ' For a halt you have to use trial and error !!
  172.    M$=M$+"AM             MtufN              HN Bpresents ! def pixel ! the first of many productions flying out to you           C"
  173.    M$=M$+" the members of tuf are : MangeldustN (code ! gfx) .. Mshock gN (gfx ! music) .. MkbyteN(?) (music) "
  174.    M$=M$+" next is a full screen picture pixeled by Mshock gN ... "
  175.    M$=M$+" this demo turned out to be a bit larger than i expected (i originally planned a 2 part demo .. i guess i got carried away !!)"
  176.    M$=M$+"A     thanks to sausage for the smooth scroll routine (what do you think of the extras ?!) thanks also to those whose routines i borrowed .. C    "
  177.    M$=M$+""
  178.    M$=M$+" Mmouse to continueN   ..... !.scroll.restarts.! "
  179.    M$=M$+"C"
  180.    ' leave this empty 
  181.    M$=M$+"                           "
  182.    N$=" abcdefghijklmnopqrstuvwxyz!()?:.0123456789"
  183.    Screen To Front 1
  184.    Channel 0 To Screen Offset 0 : Amal 0,A$
  185.    Amal On 0
  186.    Do 
  187.       SP=0 : C=1
  188.       If Mouse Key=1 Then Goto ENND
  189.       For L=1 To Len(M$)
  190.          REAPEET:
  191.          PP$=Mid$(M$,L,1)
  192.          SPEEED
  193.          If(PP$="A") or(PP$="B") or(PP$="C") or(PP$="D") or(PP$="E")
  194.             Inc L : Goto REAPEET
  195.          End If 
  196.          If Mouse Key=1 Then Goto ENND
  197.          If PP$="H"
  198.             Amal Freeze 0 : Wait 100 : Amal On 0 : Inc L
  199.          End If 
  200.          If PP$="M"
  201.             FLAG=1 : Inc L
  202.          End If 
  203.          If PP$="N"
  204.             FLAG=0 : Inc L
  205.          End If 
  206.          S=Instr(N$,PP$) : If S=0 Then Goto REAPEET
  207.          Paste Icon SP+320,105,S
  208.          If FLAG=1
  209.             Paste Icon SP+320,105+18,$4000+S
  210.          End If 
  211.          SP=SP+16
  212.          If SP>304 Then Gosub SLEEP
  213.       Next L
  214.       Gosub QUICKCOPY
  215.    Loop 
  216.    QUICKCOPY:
  217.    If Mouse Key=1 Then Goto ENND
  218.    Screen Copy 0,320,136-40,640,136 To 0,0,136-40
  219.    Wait Vbl 
  220.    Cls 0,320,136-40 To 640,136
  221.    Amreg(0)=0 : SP=0
  222.    Return 
  223.    SLEEP:
  224.    If Mouse Key=1 Then Goto ENND
  225.    If Amreg(0)=1 Then Goto QUICKCOPY
  226.    Goto SLEEP
  227.    ENND:
  228.    Fade 1 : Wait 10 : Screen Close 0
  229.    Screen 1 : Fade 3 : Wait 45 : Screen Close 1
  230.    Rainbow Del 
  231. End Proc
  232. Procedure PART_4
  233.    Unpack 10 To 0
  234.    Screen Hide 0
  235.    Screen Open 1,320,256,64,Lowres : Curs Off : Cls 0 : Flash Off 
  236.    Get Palette 0
  237.    Appear 0 To 1,4001
  238.    Screen Close 0
  239.    Screen Open 0,320,10,2,Lowres : Curs Off : Cls 0
  240.    Colour 1,$FFF
  241.    Screen Display 0,,296,,
  242.    Centre "Mouse To Exit"
  243.    Repeat 
  244.    Until Mouse Key=1
  245.    ENND:
  246.    Screen Close 0
  247.    Screen 1
  248.    Fade 2 : Wait 70
  249.    Screen Close 1
  250. End Proc
  251. Procedure PART_5
  252.    Unpack 8 To 0
  253.    Screen Open 1,320,256,8,Lowres : Double Buffer 
  254.    Curs Off : Cls 0 : Flash Off 
  255.    Wait Vbl 
  256.    Dual Playfield 0,1
  257.    Wait Vbl 
  258.    Screen 0
  259.    Shift Up 4,2,7,1
  260.    Colour 1,$FFF
  261.    Colour 9,$888 : Colour 10,$999 : Colour 11,$AAA
  262.    Colour 12,$EEE : Colour 13,$DDD : Colour 14,$FFF
  263.    Screen 1
  264.    N=50
  265.    Dim C(N),X(N),Y(N),SX(N),SY(N)
  266.    Global DX,DY
  267.    For I#=0 To N
  268.       X(I#)=Rnd(320) : Y(I#)=Rnd(150) : C(I#)=Rnd(5)+1
  269.    Next I#
  270.    For I#=0 To N
  271.       STARSHIFT[X(I#),Y(I#)]
  272.       SX(I#)=DX : SY(I#)=DY
  273.    Next I#
  274.    Autoback 0
  275.    Screen Swap : Wait Vbl 
  276.    For I#=0 To N
  277.       Plot X(I#),Y(I#),C(I#)
  278.    Next I#
  279.    Do 
  280.       Cls 0 : 
  281.       For I#=0 To N
  282.          If X(I#)>320 or Y(I#)>150 or X(I#)<0 or Y(I#)<0
  283.             X(I#)=Rnd(120)+100 : Y(I#)=Rnd(120)+68
  284.             STARSHIFT[X(I#),Y(I#)]
  285.             SX(I#)=DX : SY(I#)=DY
  286.          End If 
  287.          Add X(I#),SX(I#) : Add Y(I#),SY(I#)
  288.          Plot X(I#),Y(I#),C(I#)
  289.          Inc COUNTR
  290.       Next I#
  291.       If Mouse Key=1 Then Goto ENND
  292.       If COUNTR=60 Then Goto ENND
  293.       Screen Swap 
  294.    Loop 
  295.    ENND:
  296.    Screen Close 0
  297.    Screen Close 1
  298. End Proc
  299. Procedure PART_6
  300.    Unpack 11 To 3
  301.    Screen Hide 3
  302.    Screen Open 4,320,150,32,Lowres
  303.    Curs Off : Cls 0 : Flash Off 
  304.    Get Palette 3
  305.    Appear 3 To 4,127
  306.    ADTLIZER
  307.    Double Buffer 
  308.    Autoback 0
  309.    Bob Update Off 
  310.    Screen Close 3
  311.    Screen Open 7,320,80,2,0
  312.    Palette $0,0,0,0,0,0,0,0,$C40,$310
  313.    Curs Off 
  314.    Flash Off 
  315.    Screen Open 1,320,80,2,0
  316.    Curs Off 
  317.    Flash Off 
  318.    Screen Display 7,,200,,60
  319.    Screen Display 1,,200,,60
  320.    Wait Vbl 
  321.    Dual Playfield 7,1
  322.    Screen 7
  323.    Palette $0,$FFF
  324.    Def Scroll 1,0,0 To 320,71,-2,-1
  325.    Def Scroll 2,0,0 To 320,71,-2,1
  326.    Def Scroll 3,0,8 To 320,52,0,-1
  327.    Def Scroll 4,0,8 To 320,52,0,1
  328.    Screen 7
  329.    Set Rainbow 1,1,64,"","",""
  330.    Restore RN
  331.    For F=0 To 63
  332.       Read A
  333.       Rain(1,F)=A
  334.    Next F
  335.    Screen 1
  336.    SC=250
  337.    Screen 7
  338.    Ink 1
  339.    TX=1
  340.    AD=1
  341.    TX$="Mouse to Journey to the Credits or read a while ... (sorry this didn't turn out to well once i compiled the demo :-)"
  342.    TX$=TX$+"Greetings to all persons i know .. (Short and Sweet due to this fucked scroller)"
  343.    TX$=TX$+"        Mouse to Continue                   !"
  344.    Rainbow 1,0,199,64
  345.    Do 
  346.       For GL=1 To 8
  347.          If Mouse Key=1 Then Goto FINITO
  348.          Screen 4
  349.          Bob Clear 
  350.          Bob Draw 
  351.          Screen Swap 
  352. Wait Vbl 
  353.          Screen 7
  354. '         Wait Vbl 
  355.          Scroll 1
  356.          Scroll 3
  357.          Screen 1
  358. 'Wait Vbl  
  359.          Scroll 2
  360.          Scroll 4
  361.          Screen Copy 7,0,0,300,1 To 1,0,0
  362.          Screen Copy 1,0,58,280,61 To 7,0,58
  363.          Wait Vbl 
  364.       Next GL
  365.       Screen 7
  366.       If Mid$(TX$,TX,1)="!"
  367.          TX=1
  368.       End If 
  369.       Text 310,68,Mid$(TX$,TX,1)
  370. '      Wait Vbl  
  371.       Inc TX
  372.    Loop 
  373.    RN:
  374.    Data $0,$101,$202,$313,$414,$525,$626,$737,$838,$949,$A4A,$B5B,$C5C,$D6D,$E6E,$F7F
  375.    Data $F7F,$F8F,$F8F,$F9F,$F9F,$FAF,$FAF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FAF,$FAF,$F9F,$F9F,$F9F,$F9F,$F8F
  376.    Data $F7F,$E6E,$D6D,$C5C,$B5B,$A4A,$949,$838,$737,$626,$525,$414,$313,$202,$101,$0,0,0,0
  377.    Data $100,$200,$300,$400,$500,$600,$700,$800,$900,$A00,$B00,$C00,$D00,$E00,$F00
  378.    FINITO:
  379.    Screen Close 7
  380.    Screen Close 1
  381.    Screen Close 4
  382.    Set Rainbow 2,0,16,"","",""
  383.    Rainbow 2,0,300,1
  384.    Update On 
  385.    Wait Vbl 
  386. End Proc
  387. Procedure PART_7
  388.    Screen Open 3,320,200,16,Lowres
  389.    Get Sprite Palette : Double Buffer 
  390.    Curs Off : Cls 0 : Flash Off 
  391.    Randomize Timer
  392.    Screen To Back 3
  393.    Screen Hide 3
  394.    B=1
  395.    Repeat 
  396.       X=Rnd(310) : Y=Rnd(200)
  397.       Bob B,X,Y,114
  398.       Inc B
  399.    Until B=15
  400.    C$="Anim 0,(115,2)(114,2)(113,2)(112,2)(111,2)(110,2)(109,2)(108,2)(107,2)(106,2)(105,2)(104,2);H:L X=Z(1000);L Y=Z(90);M 0,0,0;F RA=1 To 300;Next RA;J H;"
  401.    V$="Anim 0,(115,4)(114,4)(113,4)(112,4)(111,4)(110,4)(109,4)(108,4)(107,4)(106,4)(105,4)(104,4);J:L X=Z(1000);L Y=Z(90);M 0,0,0;F RB=1 To 500;Next RB;J J;"
  402.    B=1 : C=0
  403.    Repeat 
  404.       Channel C To Bob B
  405.       If B<8
  406.          Amal C,C$
  407.       Else 
  408.          Amal C,V$
  409.       End If 
  410.       Wait 2 : Amal On C
  411.       Inc C : Inc B
  412.    Until B=15
  413.    Unpack 9 To 1
  414.    Screen Open 0,320,200,2,Lowres
  415.    Screen Display 0,140,200,,100
  416.    Screen Display 1,135,240,,100
  417.    Wait Vbl 
  418.    Dual Playfield 0,1
  419.    Get Sprite Palette 
  420.    Colour 9,$BBB
  421.    Colour 10,$FFF
  422.    Colour 11,$777
  423.    Colour 12,$BF8
  424.    Colour 13,$9D6
  425.    Colour 14,$392
  426.    Colour 15,$BBB
  427.    Curs Off : Cls 0 : Flash Off 
  428.    Def Scroll 1,0,0 To 320,96+48,,-1
  429.    Def Scroll 2,0,20 To 320,60,,-1
  430.    Gosub RBOW
  431.    Screen Show 3
  432.    Rainbow 1,0,199,119
  433.    Restore TXT
  434.    Screen 0
  435.    '   No Mask  
  436.    Do 
  437.       Read TX$
  438.       If TX$="end" Then Restore TXT : Read TX$
  439.       MID=(Len(TX$)*16)/2 : MID=160-MID
  440.       For S=0 To 31
  441.          If Mouse Key=1 Then Goto ENND
  442.          If S<Len(TX$)
  443.             BN=Asc(Mid$(TX$,S+1,1))
  444.             BN=BN+12
  445.             Paste Bob S*16+MID,64-S+48,BN
  446.          End If 
  447.          Screen 0
  448.          Wait Vbl 
  449.          Scroll 1
  450.          Scroll 2
  451.          Wait Vbl 
  452.       Next S
  453.    Loop 
  454.    TXT:
  455.    Data "-------------"
  456.    Data "DEF PIXEL"
  457.    Data "-------------"
  458.    Data ""
  459.    Data "TUF PRODUCTIONS"
  460.    Data "---"
  461.    Data "HOPE YOU"
  462.    Data "ENJOYED"
  463.    Data "THIS DEMO"
  464.    Data ""
  465.    Data "! CREDITS !"
  466.    Data ""
  467.    Data "CODE AND"
  468.    Data "SOME GFX"
  469.    Data "ANGELDUST"
  470.    Data ""
  471.    Data "GRAPHICS"
  472.    Data "SHOCK G"
  473.    Data ""
  474.    Data "MUSIC"
  475.    Data "KBYTE"
  476.    Data ""
  477.    Data "WATCH"
  478.    Data "FOR"
  479.    Data "FUTURE"
  480.    Data "PRODUCTIONS"
  481.    Data ""
  482.    Data "WRITTEN IN"
  483.    Data "AMOS"
  484.    BYE:
  485.    Data "TUF"
  486.    Data "(C)1992"
  487.    Data ""
  488.    Data "end"
  489.    RBOW:
  490.    Set Rainbow 1,1,120,"","",""
  491.    Restore RN
  492.    For F=0 To 119
  493.       Read A
  494.       Rain(1,F)=A
  495.    Next F
  496.    Return 
  497.    RN:
  498.    Data $0,$101,$202,$313,$414,$525,$626,$737,$838,$949,$A4A,$B5B,$C5C,$D6D,$E6E,$F7F
  499.    Data $F7F,$F8F,$F8F,$F9F,$F9F,$FAF,$FAF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FAF,$FAF,$F9F,$F9F,$F9F,$F9F,$F8F
  500.    Data $F7F,$F8F,$F8F,$F9F,$F9F,$FAF,$FAF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FAF,$FAF,$F9F,$F9F,$F9F,$F9F,$F8F
  501.    Data $F7F,$F8F,$F8F,$F9F,$F9F,$FAF,$FAF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FAF,$FAF,$F9F,$F9F,$F9F,$F9F,$F8F
  502.    Data $F7F,$F8F,$F8F,$F9F,$F9F,$FAF,$FAF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FBF,$FAF,$FAF,$F9F,$F9F,$F9F,$F9F,$F8F
  503.    '   Data $F7F,$E6E,$D6D,$C5C,$B5B,$A4A,$949,$838,$737,$626,$525,$414,$313,$202,$101,$0,0,0,0 
  504.    Data $100,$200,$300,$400,$500,$600,$700,$800,$900,$A00,$B00,$C00,$D00,$E00,$F00
  505.    ENND:
  506.    Rainbow Del 
  507.    Fade 3 : Wait 50
  508.    Screen Close 0
  509.    Screen Close 1
  510.    Screen Close 3
  511. End Proc
  512. Procedure SPEEED
  513.    Shared PP$
  514.    If PP$="A"
  515.       Amreg(1)=30
  516.    End If 
  517.    If PP$="B"
  518.       Amreg(1)=40
  519.    End If 
  520.    If PP$="C"
  521.       Amreg(1)=80
  522.    End If 
  523.    If PP$="D"
  524.       Amreg(1)=100
  525.    End If 
  526.    If PP$="E"
  527.       Amreg(1)=120
  528.    End If 
  529. End Proc
  530. Procedure STARS
  531.    Def Scroll 1,1,0 To 339,16,-1,0
  532.    Def Scroll 2,1,16 To 339,32,-2,0
  533.    Def Scroll 3,1,32 To 339,48,-3,0
  534.    Def Scroll 4,1,48 To 339,64,-1,0
  535.    Def Scroll 5,1,64 To 339,80,-2,0
  536.    Def Scroll 6,1,80 To 339,96,-1,0
  537.    Def Scroll 7,1,96 To 339,112,-2,0
  538.    Def Scroll 8,1,112 To 339,128,-3,0
  539.    Def Scroll 9,1,128 To 339,144,-1,0
  540.    Def Scroll 10,1,144 To 339,160,-2,0
  541.    Def Scroll 11,1,160 To 339,176,-1,0
  542.    Def Scroll 12,1,176 To 339,192,-3,0
  543.    Def Scroll 13,1,192 To 339,200,-2,0
  544. End Proc
  545. Procedure SCOL
  546.    M=256-(B*2)
  547.    Y=Rnd(M)
  548.    Plot 315,(B+Y),1
  549.    Scroll 1 : Scroll 2 : Scroll 3 : Scroll 4 : Scroll 5 : Scroll 6
  550.    Scroll 7 : Scroll 8 : Scroll 9 : Scroll 10 : Scroll 11 : Scroll 12
  551.    Scroll 13
  552. End Proc
  553. Procedure LASER_PAINTER
  554.    Bank Swap 1,15
  555.    Screen 1
  556.    For A=0 To 199
  557.       Get Bob A+1,0,A To 320,A+1
  558.    Next : No Mask : Cls 0 : Screen Show 1
  559.    For A=1 To 199
  560.       Inc B
  561.       For C=200 To B Step True
  562.          Paste Bob 0,C,A
  563.       Next 
  564.    Next 
  565.    Erase 1 : Bank Swap 15,1
  566. End Proc
  567. Procedure ADTLIZER
  568. ' Simple Amal Driven Vu-Meter
  569.    A$=A$+"       AUtotest(Let R1=Vu(R0); If R1=0 eXit else Direct Start)"
  570.    A$=A$+"Start: Let R2=R1 Anim 1,(28,2)(29,2)(30,2)(31,2)(32,2)(33,2)(34,2)(35,2)(36,2)(37,2)(38,2)(39,2)(40,2)(41,2)(42,2)(43,2);Pause,1"
  571.    A$=A$+"Wait 1"
  572.    Amreg(0)=180 : Amreg(1)=25
  573. X=10
  574. Set Bob 1,0,%1,
  575.    Bob 1,110+X,100,43
  576.    Channel 4 To Bob 1
  577.    Amal 4,"Let R0="+Str$(1)+A$
  578.    Amal On 4
  579. Set Bob 2,0,%1,
  580.    Bob 2,135+X,100,43
  581.    Channel 5 To Bob 2
  582.    Amal 5,"Let R0="+Str$(2)+A$
  583.    Amal On 5
  584. Set Bob 3,0,%1,
  585.    Bob 3,160+X,100,43
  586.    Channel 6 To Bob 3
  587.    Amal 6,"Let R0="+Str$(3)+A$
  588.    Amal On 6
  589. Set Bob 4,0,%1,
  590.    Bob 4,185+X,100,43
  591.    Channel 7 To Bob 4
  592.    Amal 7,"let R0="+Str$(4)+A$
  593.    Amal On 7
  594. End Proc
  595. Procedure STARSHIFT[X,Y]
  596.    Shared DX,DY
  597.    DX=0 : DY=0
  598.    P1#=0.02 : P2#=0.48 : P3#=1.0 : P4#=2.2 : P5#=30.0
  599.    If X>155 and X<165 : Goto EX : End If 
  600.    If Y>123 and Y<133 : Goto EX : End If 
  601.    AX#=X-160.0 : AY#=Y-128.0
  602.    R#=AX#/AY#
  603.    EX:
  604.    CX=X-160 : CY=Y-128
  605.    If CX>=-5 and CX<=5 and Y>=128
  606.       DX=0 : DY=3
  607.       Pop Proc
  608.    End If 
  609.    If CY>=-5 and CY<=5 and X>=160
  610.       DX=3 : DY=0
  611.       Pop Proc
  612.    End If 
  613.    If CX>=-5 and CX<=5 and Y<128
  614.       DX=0 : DY=-3
  615.       Pop Proc
  616.    End If 
  617.    If CY>=-5 and CY<=5 and X<160
  618.       DX=-3 : DY=0
  619.       Pop Proc
  620.    End If 
  621.    If X>=160 and Y<=128
  622.       If R#>=-P2# and R#<-P1#
  623.          DX=1 : DY=-3
  624.          Pop Proc
  625.       End If 
  626.       If R#>=-P3# and R#<-P2#
  627.          DX=2 : DY=-2
  628.          Pop Proc
  629.       End If 
  630.       If R#>=-P4# and R#<-P3#
  631.          DX=3 : DY=-2
  632.          Pop Proc
  633.       End If 
  634.       If R#>-P5# and R#<-P4#
  635.          DX=3 : DY=-1
  636.          Pop Proc
  637.       End If 
  638.    End If 
  639.    If X>160 and Y>128
  640.       If R#>=P1# and R#<P2#
  641.          DX=1 : DY=3
  642.          Pop Proc
  643.       End If 
  644.       If R#>=P2# and R#<P3#
  645.          DX=2 : DY=2
  646.          Pop Proc
  647.       End If 
  648.       If R#>=P3# and R#<P4#
  649.          DX=3 : DY=2
  650.          Pop Proc
  651.       End If 
  652.       If R#>=P4# and R#<P5#
  653.          DX=3 : DY=1
  654.          Pop Proc
  655.       End If 
  656.    End If 
  657.    If X<160 and Y<128
  658.       If R#>=P1# and R#<P2#
  659.          DX=-1 : DY=-3
  660.          Pop Proc
  661.       End If 
  662.       If R#>=P2# and R#<P3#
  663.          DX=-2 : DY=-2
  664.          Pop Proc
  665.       End If 
  666.       If R#>=P3# and R#<P4#
  667.          DX=-3 : DY=-2
  668.          Pop Proc
  669.       End If 
  670.       If R#>=P4# and R#<P5#
  671.          DX=-3 : DY=-1
  672.          Pop Proc
  673.       End If 
  674.    End If 
  675.    If X<160 and Y>128
  676.       If R#>=-P2# and R#<-P1#
  677.          DX=-1 : DY=3
  678.          Pop Proc
  679.       End If 
  680.       If R#>=-P3# and R#<-P2#
  681.          DX=-2 : DY=2
  682.          Pop Proc
  683.       End If 
  684.       If R#>=-P4# and R#<-P3#
  685.          DX=-3 : DY=2
  686.          Pop Proc
  687.       End If 
  688.       If R#>=-P5# and R#<-P4#
  689.          DX=-3 : DY=1
  690.          Pop Proc
  691.       End If 
  692.    End If 
  693. End Proc