home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 476-500 / apd483 / colourravedemo.amos / colourravedemo.amosSourceCode < prev    next >
AMOS Source Code  |  1993-05-28  |  7KB  |  193 lines
  1. '  VU Colour Rave Demo - By D.Piper 1993   
  2. ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~    
  3.  
  4. Screen Open 0,640,200,2,Hires : Palette $0,$0 : Curs Off : Hide On : Break Off : Amos Lock : Led Off 
  5. Dim X(3),Y(3),A(3),SCIM(17),SCB(17),T$(9),MS$(17)
  6. Global RCNT,STC,M$,T$(),MS$(),SCB(),A$
  7. SETMESSAGE : CHECKTUNES
  8. Screen Open 0,320,140,2,Lowres : Curs Off : Flash Off : Paper 0 : Pen 1 : Ink 1 : Cls 
  9. Screen Display 0,118,100,320,130 : Palette $0,$FFF
  10. Screen Open 1,320,256,2,Lowres : Paper 0 : Pen 1 : Curs Off : Unpack 5 To 1
  11. Shift Down 2,4,31,1 : Double Buffer : Screen To Front 0 : Screen 0
  12. Autoback 0 : Bob Update Off : Auto View Off : Track Loop On 
  13. Track Play 10 : Set Rainbow 1,1,151,"","",""
  14. For S=0 To 4
  15.   LEV=S : For C=0 To 29 : Read CC : Rain(1,LEV)=CC : LEV=LEV+5 : Next C
  16. Restore DAT : Next S
  17. Rainbow 1,1,100,135 : POWER=7 : SY#=100 : GRAV#=0.5 : MSPD=2
  18. YB=129 : Y(0)=YB : Y(1)=YB : Y(2)=YB : Y(3)=YB : Auto View On : View 
  19. For E=0 To 16
  20.   S=E*20
  21.   SCB(E+1)=12+S
  22. Next E
  23. Do 
  24.   Screen 1 : Inc SPD : If SPD<MSPD Then Goto SKIP2
  25.   If Key State(95)=True Then Goto SKIP2
  26.   For E=0 To 16
  27.     SCIM(E)=SCIM(E+1)
  28.   Next E
  29.   SKIP:
  30.   Inc RCNT : B$=Mid$(M$,RCNT,1)
  31.   A$=Lower$(B$) : STRINGPARSER : SCIM(17)=STC : If STC=50 Then RCNT=0 : Goto SKIP
  32.   If STC=60 and MSPD=2 Then MSPD=5 : Goto SKIP
  33.   If STC=60 and MSPD=5 Then MSPD=2 : Goto SKIP
  34.   SPD=0
  35.   For E=1 To 17
  36.     Bob E,SCB(E),219,SCIM(E)
  37.   Next E
  38.   SKIP2:
  39.   For D=0 To 3
  40.     Led Off 
  41.     A(D)=Vumeter(D)
  42.     If Not A(D)=0 Then Y(D)=YB-A(D)*2 Else Y(D)=Y(D)+8
  43.     If Y(D)>YB Then Y(D)=YB
  44.   Next D
  45.   SY#=SY#-POWER+G#
  46.   G#=G#+GRAV#
  47.   Screen Display 0,118,SY#,320,130 : Rainbow 1,1,SY#,135
  48.   If SY#>108 Then G#=0 : POWER=Rnd(2)+6
  49.   Screen 0 : Ink 1 : Cls 
  50.   For S=0 To 1
  51.     Polyline 0,YB+S To 60,YB+S To 85,Y(0)+S To 110,YB+S To 135,Y(1)+S To 160,YB+S To 185,Y(2)+S To 210,YB+S To 235,Y(3)+S To 260,YB+S To 320,YB+S
  52.   Next S
  53.   Screen 1 : Bob Update 
  54.   If Mouse Key=1 Then _DO_F : End 
  55.   If Mouse Key=2 Then _LOAD_TRACK
  56. Loop 
  57. DAT:
  58. Data $F00,$F10,$F20,$F40,$F50,$F60,$F70,$F80,$FA0,$FB0,$FC0,$FD0,$FF0,$BF0,$6F0,$1F0,$F4,$F8,$FD,$CF,$8F,$3F,$20F,$40F,$60F,$80F,$A0F,$C0F,$E0F,$F0E
  59. Procedure _DO_F
  60.   Screen 0 : Cls : Set Rainbow 1,32,16,"","","" : Rainbow 1,32,300,16 : Colour 1,$0
  61.   Fade 3 : Screen 1 : Shift Off 
  62.   Fade 3 : Wait 50 : Track Stop 
  63. End Proc
  64. Procedure _LOAD_TRACK
  65.   On Error Proc SAFE
  66.   Resume Label SKIP3
  67.   If Key State(80)=True Then F$=T$(1) : Goto SKIP1
  68.   If Key State(81)=True Then F$=T$(2) : Goto SKIP1
  69.   If Key State(82)=True Then F$=T$(3) : Goto SKIP1
  70.   If Key State(83)=True Then F$=T$(4) : Goto SKIP1
  71.   If Key State(84)=True Then F$=T$(5) : Goto SKIP1
  72.   If Key State(85)=True Then F$=T$(6) : Goto SKIP1
  73.   If Key State(86)=True Then F$=T$(7) : Goto SKIP1
  74.   If Key State(87)=True Then F$=T$(8) : Goto SKIP1
  75.   If Key State(88)=True Then F$=T$(9) : Goto SKIP1
  76.   If Key State(89)=True Then F$=T$(0) : Goto SKIP1
  77.   Pop Proc
  78.   SKIP1:
  79.   If Exist(F$)=0 Then S$="  No tune found  " : Goto SKIP2
  80.   If F$=T$(0) Then S$="Loading module 00"
  81.   If F$=T$(1) Then S$="Loading module 01"
  82.   If F$=T$(2) Then S$="Loading module 02"
  83.   If F$=T$(3) Then S$="Loading module 03"
  84.   If F$=T$(4) Then S$="Loading module 04"
  85.   If F$=T$(5) Then S$="Loading module 05"
  86.   If F$=T$(6) Then S$="Loading module 06"
  87.   If F$=T$(7) Then S$="Loading module 07"
  88.   If F$=T$(8) Then S$="Loading module 08"
  89.   If F$=T$(9) Then S$="Loading module 09"
  90.   SKIP2:
  91.   MESSAGEDISPLAY[S$]
  92.   If Exist(F$)=0 Then Pop Proc
  93.   Erase 10 : Track Load F$,10 : Track Play 10
  94.   SKIP3:
  95. End Proc
  96. Procedure STRINGPARSER
  97.   If A$="a" Then STC=1
  98.   If A$="b" Then STC=2
  99.   If A$="c" Then STC=3
  100.   If A$="d" Then STC=4
  101.   If A$="e" Then STC=5
  102.   If A$="f" Then STC=6
  103.   If A$="g" Then STC=7
  104.   If A$="h" Then STC=8
  105.   If A$="i" Then STC=9
  106.   If A$="j" Then STC=10
  107.   If A$="k" Then STC=11
  108.   If A$="l" Then STC=12
  109.   If A$="m" Then STC=13
  110.   If A$="n" Then STC=14
  111.   If A$="o" Then STC=15
  112.   If A$="p" Then STC=16
  113.   If A$="q" Then STC=17
  114.   If A$="r" Then STC=18
  115.   If A$="s" Then STC=19
  116.   If A$="t" Then STC=20
  117.   If A$="u" Then STC=21
  118.   If A$="v" Then STC=22
  119.   If A$="w" Then STC=23
  120.   If A$="x" Then STC=24
  121.   If A$="y" Then STC=25
  122.   If A$="z" Then STC=26
  123.   If A$="0" Then STC=27
  124.   If A$="1" Then STC=28
  125.   If A$="2" Then STC=29
  126.   If A$="3" Then STC=30
  127.   If A$="4" Then STC=31
  128.   If A$="5" Then STC=32
  129.   If A$="6" Then STC=33
  130.   If A$="7" Then STC=34
  131.   If A$="8" Then STC=35
  132.   If A$="9" Then STC=36
  133.   If A$="," Then STC=37
  134.   If A$="." Then STC=38
  135.   If A$="(" Then STC=39
  136.   If A$=")" Then STC=40
  137.   If A$="-" Then STC=41
  138.   If A$=" " Then STC=42
  139.   If A$="*" Then STC=50
  140.   If A$="^" Then STC=60
  141. End Proc
  142. Procedure SETMESSAGE
  143.   M$=" Welcome to Dels Colour Rave Demo                   "
  144.   M$=M$+"probably one of the most colourful and most eye-destroying demos ever "
  145.   M$=M$+"produced with amos.         (hold help key to pause scrolltext.)          "
  146.   M$=M$+"I was originally intending to have a number of tunes "
  147.   M$=M$+"built in but due to lack of chip ram (only 512K on my old A500) I have had to "
  148.   M$=M$+"assign them names on the disk and fix up a loader system.          This means that you can select "
  149.   M$=M$+"the music by holding the right mouse button down and pressing F1 - F10 "
  150.   M$=M$+"to select modules saved in the current directory under ^DelDemo00.mod etc.  ^, where 00 is the "
  151.   M$=M$+"tune number from 00 to 09. Where module 00 is F10 and module 01 is F1 etc.                     "
  152.   M$=M$+"N.B. only soundtracker or noisetracker modules should be used or the demo "
  153.   M$=M$+"may crash.   If the tunes are not available in the current dirctory or an error occurs then the music will not change.             "
  154.   M$=M$+"This demo was created on 26-1-93 on an a500 with 2.5 megs and 2 drives.                "
  155.   M$=M$+"contact me for any graphics for games or anything else (I have written 2 games and am writing a third.)        "
  156.   M$=M$+"Address.....^      Derek Piper      63, Hadley Road      New Barnet      Herts      EN5 5QU."
  157.   M$=M$+"           ^             Enjoy...                         del."
  158.   M$=M$+"                                   Press Left mouse button to quit.                                                      *"
  159.   T$(0)=Dir$+"DelDemo00.Mod"
  160.   T$(1)=Dir$+"DelDemo01.Mod"
  161.   T$(2)=Dir$+"DelDemo02.Mod"
  162.   T$(3)=Dir$+"DelDemo03.Mod"
  163.   T$(4)=Dir$+"DelDemo04.Mod"
  164.   T$(5)=Dir$+"DelDemo05.Mod"
  165.   T$(6)=Dir$+"DelDemo06.Mod"
  166.   T$(7)=Dir$+"DelDemo07.Mod"
  167.   T$(8)=Dir$+"DelDemo08.Mod"
  168.   T$(9)=Dir$+"DelDemo09.Mod"
  169. End Proc
  170. Procedure CHECKTUNES
  171.   For E=0 To 9
  172.     If Exist(T$(E))=True Then Inc TP
  173.   Next E
  174.   Fade 1,$0,$FFF : Cls : Locate 0,7 : Centre "ColourRave Demo V1.0 - By Del 1993"
  175.   If Ntsc=True Then Locate 0,12 : Centre "Sorry this demo is PAL only !!" : Wait 150 : Fade 1 : Wait 20 : End 
  176.   Locate 0,12 : Centre "Number of tunes found :"+Str$(TP)
  177.   Locate 0,17 : Centre "Chip Memory :"+Str$(Chip Free)+"   Fast Memory :"+Str$(Fast Free)
  178.   Wait 120 : Fade 1 : Wait 20
  179. End Proc
  180. Procedure SAFE
  181.   MESSAGEDISPLAY["  Error no."+Str$(Errn)+"    "]
  182.   Wait 100
  183.   Resume Label 
  184. End Proc
  185. Procedure MESSAGEDISPLAY[MES$]
  186.   Screen 1
  187.   For E=1 To 17
  188.     B$=Mid$(MES$,E,1)
  189.     A$=Lower$(B$) : STRINGPARSER
  190.     Bob E,SCB(E),219,STC
  191.   Next E
  192.   Bob Update : Wait 65
  193. End Proc