home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AMOS PD CD
/
amospdcd.iso
/
376-400
/
apd396
/
demo.asc
< prev
next >
Wrap
Text File
|
2000-04-01
|
9KB
|
434 lines
Break Off
Hide
Load "demo.abk"
Unpack 14 To 1
Screen Open 0,320,256,32,Lowres : Curs Off : Flash Off
Get Palette 1 : Screen Copy 1 To 0
Double Buffer : Autoback 0
Degree
Colour 31,$F0 : Ink 31
Flash 10,"(fff,6)(ddd,6)(f00,6)(e00,6)(d00,6)"
Do
Inc S : Inc S
X=Sin(S)*74 : Y=Cos(S)*74
Ink 31 : Draw 155,115 To 155+X,115+Y
Screen Swap : Wait Vbl
Screen Copy 1 To 0
If C>3 Then Ink 10 : Plot 230-A,40+B : If Y=-59 and X=43 Then Colour 14,$FFF : Bell 60 : Fade 1,,,,,,,,,,,,,,,3840
If S>360 Then Inc C
If D=8 Then Inc A : Inc B : D=0 : If A=76 Then Exit
Inc D
Loop
Flash Off
Fade 4,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
Boom
Wait 60
Fade 4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Wait 60
'
Volume 0 : Music 1
For V=0 To 63
Volume V
Wait 2
Next
Unpack 2 To 3
For SN=4 To 7
Unpack SN To 1
Screen Hide 1
Screen Open 0,320,200,32,Lowres : Curs Off : Flash Off : Get Palette 1 : Cls 0
Screen Display 0,,90,,
Screen To Front 3
'
'Size Of Square
S=6
SH=Screen Height(1)
'
X=0 : Y=0 : D=S
Do
REP:
If X>320 Then Y=Y+S : F=1
If X<-20 Then Y=Y+S : F=0
Screen Copy 1,X,Y,X+D,Y+D To 0,X,Y
If F=0 Then X=X+S
If F=1 Then X=X-S
If Y>SH Then Exit
Loop
'
Next
'
Unpack 13 To 0
Screen To Front 3
Screen 0
Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Wait 20
Fade 1,,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
Wait 20
'
Fade 1,$0,$FFF,$600,$820,$A40,$C62,$E84,$EA6,$ECA,$4,$4,$15,$115,$126,$126,$237,$247,$248,$358,$368,$469,$479,$58A,$69A,$69B,$7AB,$8BC,$8BC,$9CD,$ADD,$BDD,$CEE
'
Wait 200
Screen 0 : Fade 8
'
'
2
'Screen Hide 3
Cls 0
A$="************* WELCOME TO THE FIRST PURPLE HAZE DEMO**** TO START THIS DEMO HERE ARE*** SOME CYCLE PICS**** ......"
Gosub TYPEWRITER
'
'
3
Screen Open 2,320,48,32,Lowres : Screen Display 2,,256,, : Curs Off : Flash Off
Palette $0,$AAA,$555,$FFF,$808,$E00,$F,$E,$D,$C,$B,$A,$9,$7,$7,$A,$EE0,$FC0,$C00,$222,$333,$444,$555,$666,$777,$888,$999,$AAA,$CCC,$DDD,$EEE,$FFF
'
Double Buffer
Cls 0
Bob 1,-160,0,1
Channel 1 To Bob 1
Anim 1,"(1,6)(2,6)(3,6)(4,6)L"
Anim On
'Screen Show 3
For L=9 To 12
Unpack L To 0
Screen To Front 3
Shift Up 1,1,31,1
Screen Hide 0
Screen Display 0,,,,0
Screen Show 0
For Y=50 To 213
Screen Display 0,,,,Y
Wait Vbl
Next
Wait 120
For X=-160 To 360 Step 2
Wait Vbl : Bob 1,X,,
Next X
If F=0 Then Anim 1,"(5,6)(6,6)(7,6)(8,6)L" : F=1 : Anim On : Goto NS
If F=1 Then Anim 1,"(1,6)(2,6)(3,6)(4,6)L" : F=0 : Anim On
NS:
For Y=213 To 50 Step -1
Screen Display 0,,,,Y
Wait Vbl
Next
Next
Screen Close 2
Screen Close 3
'
'
'
4
Cls 0
A$="************* WELL WHAT DID YOU THINK OF THOSE ??**** AND NOW FOR SOME VECTORS !!**** ......."
Gosub TYPEWRITER
'
'
5
'VECKTOR PART
Td Dir "objects"
Cls 0
Screen Open 0,320,200,16,Lowres : Curs Off : Flash Off : Cls 0
Double Buffer
Autoback 0
Td Screen Height 200
Td Keep On
Td Load "spunt"
Td Load "minicube"
Td Object 1,"spunt",0,0,10000,0,0,0
Td Object 2,"minicube",0,0,1000,0,0,0
Palette ,,,,,,,,,$5F,$0,$7F,$80F,,$50F
C=0
Repeat
Td Forward 1,-60
Colour 10,C
Rem Move your objects here
Cls 0
Td Redraw
Rem You can draw on top of the 3D objects here
Screen Swap
Rem Sync with screen display
Wait Vbl
If C<15 and P=10 Then Inc C : P=0
P=P+1
If Td Position Z(1)<980 Then Exit
Until False
Timer=0
Repeat
Td Angle 1,X,Y,Z
Td Angle 2,X,Y,
Rem Move your objects here
Cls 0
Td Redraw
Rem You can draw on top of the 3D objects here
Screen Swap
Rem Sync with screen display
Wait Vbl
X=X+1000 : Y=Y+1000 : Z=Z+200
If Timer>500 or Mouse Key=1 Then Fade 10
If Colour(10)=$0 Then Exit
Until False
Td Kill 1 : Td Kill 2
'
'
6
A$="************* NOW FOR THE NEXT PART......***** NEW MUSIC FOR THIS PART....."
Gosub TYPEWRITER
For V=63 To 0 Step -1
Volume V
Wait 2
Next
Music Off
Volume 63
'
'6
'EQUALIZERS PART
Load "equal.abk"
Timer=0
Music 1
Unpack 6 To 1
Unpack 5 To 2
Unpack 4 To 3
Unpack 2 To 4
Screen Open 0,320,256,32,Lowres : Curs Off : Flash Off : Cls 0
Screen Open 5,320,50,32,Lowres
Screen Display 5,,231,,
Curs Off : Flash Off : Get Sprite Palette : Cls 0
Set Rainbow 0,1,60,"(3,-1,15)","(3,1,15)",""
Rainbow 0,1,230,50
Double Buffer
EQUAL
'
'
Screen 0 : S=1
Repeat
Inc C
Cls 0
Wait Vbl
Screen To Front S : Screen To Front 5
Wait 15
Inc S : If S>4 Then S=1
If C>20 Then Unpack 7 To 0 : FLSH : C=0 : EQUAL
Until Mouse Key=1 or Timer>6000
Screen To Front 4
Screen 4 : Fade 6
Screen To Front 5
For V=63 To 0 Step -1
Volume V
Wait 3
Next
Amal Off : Bob Off : Music Off : Rainbow Del
For S=2 To 5
Screen Close S
Next
'
Procedure FLSH
Amal Off
For L=0 To 4000
V0=Vumeter(0) : V1=Vumeter(1) : V2=Vumeter(2) : V3=Vumeter(3)
If V0>0 Then Colour 0,$FFF
If V1>0 Then Colour 1,$F
If V2>0 Then Colour 2,$F0
If V3>0 Then Colour 3,$F00
Fade 1,$0,$0,$0,$0
Next
End Proc
'
Procedure EQUAL
A$=A$+" AUtotest(Let R1=Vu(R0)/5; If R1=0 eXit else Direct Start)"
A$=A$+"Start: Anim 1,(10,1)(9,1)(8,1)(7,1)(6,1)(5,1)(4,1)(3,1)(2,1)(1,1); pause; Wait"
For N=0 To 3
Bob N,50+(N*64),0,1
Channel N To Bob N
Amal N,"Let R0="+Str$(N)+A$
Next N
Amal On
End Proc
'
'
A$="************ AND NOW ITS TIME FOR*** THE CREDITS"
Gosub TYPEWRITER
'
7
'CREDITS PART
Load "credits.abk"
Volume 63 : Music 1
Curs Off : Flash Off
Get Sprite Palette : Cls 0
Unpack 4 To 0
Double Buffer
'
Bob 1,34,130,1 : Bob 2,279,130,1
For N=1 To 2
Channel N To Bob N
Amal N,"Anim 0,(1,8)(2,8)(3,8)(4,8)(5,8)(6,8)"
Amal On N
Next
P=70 : Rem LENGTH OF DELAY BETWEEN CREDITS
For L=1 To 2
I=L+8
Bob 3,133,146,12
Wait P
Bob 4,117,86,I-2
Wait P
Bob 3,,,11
Wait P
Bob 5,147,170,I
Wait P
Bob Off 5
Next
Bob 3,,,12
Bob Off 4
'
Y=256
Repeat
Dec Y
Wait Vbl
Screen Display 0,,,,Y
If Y=200 Then Fade 14
Until Y=0
'
'
A$="**************** NEXT PART IS MY NEW BOB ROUTINE"
Gosub TYPEWRITER
'
8
'BOB ROUTINE PART
'
Load "bobsprites.abk"
Screen Open 1,320,30,32,Lowres : Unpack 2 To 1
Screen Display 1,,,,30
Screen Open 0,320,256,32,Lowres : Screen Display 0,,30,,
Get Sprite Palette : Curs Off : Flash Off : Cls 0
Colour 3,$F00
Screen To Front 1
'
Set Rainbow 0,0,22,"(1,1,11)(1,-1,11)","","(1,1,11)(1,-1,11)"
Rainbow 0,1,70,22
'
Set Rainbow 1,0,22,"","(1,1,11)(1,-1,11)","(1,1,11)(1,-1,11)"
Rainbow 1,1,270,22
'
Set Rainbow 2,2,180,"","(6,1,15)(6,-1,15)",""
Rainbow 2,1,90,177
'
Double Buffer
Degree
N=55 : XE=2 : YE=4 : I=2
Repeat
Timer=0
Do
For B=1 To 8
Wait Vbl
Bob B,Int(Cos(S*XE)*(N*2)+160),Int(Sin(S*YE)*N+130),1
S=S+I
Next
If Mouse Key>0 or Timer>500 Then Fade 5
If Colour(10)=$0 Then Exit
Loop
'
Bob Off
Fade 3,,,,$F00,,,,,,224,192,160,112,80,48
Inc XE : If XE>5 Then Inc YE
If XE=5 Then I=1
Until XE>7
UY=70 : DY=270 : SY=30
Repeat
Dec UY : Inc DY : Dec SY
Wait Vbl
Rainbow 0,,UY,
Rainbow 1,,DY,
Screen Display 1,,,,SY : If SY<0 Then Screen Display 1,,0,,0
Until UY<-20
Rainbow Del
'
'
A$="************* AND NOW FOR A QUICK MESSAGE*** TO MARK THE END OF THIS DEMO."
Gosub TYPEWRITER
'
9
'MESSAGE PART
Load "messagesprite.abk"
Unpack 5 To 0 : Screen Display 0,,,,0
Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Fade 15,$0,$FE0,$FC0,$FA0,$F80,$F60,$F40,$F20,$F00,$D00,$B00,$900,$700,$500,$300,$0,$204,$306,$408,$50A,$60C,$70E,$92F,$A4F,$B6F,$C8F,$DAF,$ECF,$FEF,$FFF,$FFE,$FE7
For Y=0 To 256
Wait Vbl
Screen Display 0,,,,Y
Next
Shift Up 1,1,31,1
'
Set Rainbow 0,0,16,"","(1,1,8)(1,-1,8)",""
Rainbow 0,1,100,16
Set Rainbow 1,0,16,"","(1,1,8)(1,-1,8)",""
Rainbow 1,1,270,16
'
Synchro Off
Double Buffer
For Z=8 To 45
Sprite Z,131+Rnd(350),140+Rnd(110),1
Next Z
'
For Z=8 To 45
X=1+Rnd(10)
S$=Str$(X)
A$="L: L X=X+"
A$=A$+S$
A$=A$+" ; P ; J L"
Channel Z To Sprite Z
Amal Z,A$
Next Z
Amal On
'
Repeat
Synchro
Wait Vbl
Until Mouse Key
'
DY=50
For Y=256 To 0 Step -2
Inc DY
Wait Vbl
Screen Display 0,,DY,,Y
Next
Sprite Off
Rainbow Del
Wait Vbl
Amal Off
Screen Close 0
Synchro On
Update Every 1
For V=63 To 0 Step -1
Wait 2 : Volume V
Next
Stop
'
'
'
TYPEWRITER:
Load "typewriter.abk",15
R=0 : E=0
Screen Open 0,320,200,32,Lowres : Colour 1,$0 : Colour 2,$FFF : Colour 3,$F00 : Flash 3,"(f00,15)(0f0,15)(00f,15)"
For C=0 To 255
Set Curs C,C,C,C,C,C,C,0
Next
Screen Open 1,268+188+30,75,16,Lowres : Curs Off : Flash Off
Unpack 15 To 1
Channel 0 To Screen Offset 1
Amal 0,"L: M 134,0,67 M -134,0,67 J L"
Amal On 0
Degree
Screen 0
Repeat
R=R+1
If R>Len(A$) Then E=1
P$=Mid$(A$,R,1)
Y=Int((Cos(R)*35)) : Y=Y+25
For L=0 To 30 : Next
Screen Display 1,,Y,,
If P$="*" Then Print
If E=0 Then If P$<>"*" Then Wait Vbl : Print P$;
Until R=Len(A$)+1600
Screen Close 1
Amal Off
Return
'