home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AMOS PD CD
/
amospdcd.iso
/
551-575
/
apd560
/
amoner5
/
editor
/
amos_3d.asc
< prev
next >
Wrap
Text File
|
1993-11-29
|
24KB
|
855 lines
WARNING: NO BANKS ARE INCLUDED. YOU'LL NEED TO MODIFY THE CALLS TO THE
SPRITES, PAC.PICs AND SAMPLES. THIS IS JUST THE SOURCE
Rem AMOS 3D Demo by Nick Harper (c) 1991 Europress Software Ltd
Dir$="AMONER004 Extras:AMOS_3D_Demo" : Auto View Off
Global ANG
SETUP
SHAPES
PICCIES : Auto View On
While True
MESSAGE
OBJECTS
PAN1
PAN2
MONITOR
PANEL
AMOS
STARS
TDSHIP
PLUG
CAR_RACE
PLUG
TV
TV_BOOM
SMALL_BLOCK
OM
CREDITS
Wend
Procedure PAN1
Td Move 0,0,5000,0 : Td Cls : Td Redraw
Fade 1,0,$FFF,,,,,,,,$FFF,$F,$AAA,$BB9,0,$996
For Z=1 To 50
Td Cls
Td Face 0,1
Td Redraw
Screen Swap
Wait Vbl
Td Move Rel 0,55,-55,260
Next Z
Td Object 2,"disc",-4775,875,12100,-16380,-16380,0
For Z=1 To 27
Td Move Rel 2,209,-5,84
Td Face 0,1
Td Cls
Td Redraw
Screen Swap
Wait Vbl
Next Z
Restore DTA
For Z=1 To 53
Read A,B,C,D,E,F
Td Move Rel 2,A,B,C : Td Angle Rel 2,D,E,F
Td Face 0,2
Td Cls
Td Redraw
Screen Swap
Td Move Rel 0,-20,-20,0
Wait Vbl
Next Z
Td Kill 2 : Sam Play 1,2,8000
Td Cls
Td Redraw
Screen Swap
DTA:
Data 180,0,50,-2000,0,0
Data 130,10,30,-2000,0,0
Data 70,30,10,-2000,0,0
Data 20,60,0,-2000,0,0
Data 0,90,0,-2000,0,0
Data 0,130,0,-3000,0,0
Data 0,170,0,-3000,0,0
Data 0,160,0,0,0,0
Data 0,140,0,0,0,0
Data 0,110,0,0,0,0
Data 0,70,0,0,0,0
Data 0,20,0,0,0,0
Data 0,-20,0,0,0,2000
Data 0,-30,0,0,0,3000
Data 0,-40,0,0,0,3000
Data 0,-50,0,0,0,3000
Data 0,-60,0,0,0,3000
Data 0,-70,0,0,0,3000
Data 0,-80,0,0,0,3000
Data 0,-90,0,0,0,3000
Data 0,-100,0,0,0,3000
Data 0,-100,0,0,0,3000
Data 0,-100,0,0,0,3000
Data 10,-90,10,0,0,2000
Data 30,-80,20,0,0,2000
Data 50,-70,30,0,1500,2000
Data 70,-60,40,-1000,2000,2000
Data 80,-50,50,-1000,2000,2000
Data 90,-40,60,-1000,2000,1000
Data 80,-30,70,-1000,2000,1000
Data 70,-30,80,-1000,2000,500
Data 60,-30,90,-1000,2000,0
Data 50,-30,100,-1000,2000,-500
Data 40,-30,90,-1000,2000,-1000
Data 30,-30,90,-1000,1500,-1000
Data 20,-40,90,-2000,1000,-1000
Data 10,-50,90,-1000,100,-1000
Data 0,-60,80,-1000,1000,-1000
Data 0,-70,70,-1000,1000,-1000
Data 0,-50,60,-1000,1000,-1000
Data -20,-40,50,-1000,100,1000
Data -40,-30,40,-1000,1000,500
Data -50,-20,30,-750,750,0
Data -70,0,20,-750,500,-500
Data -40,0,10,-750,500,-500
Data -50,0,0,-500,500,-500
Data -60,0,0,0,750,-500
Data -70,0,0,0,1000,-500
Data -80,0,0,0,1000,-500
Data -90,0,0,0,1000,-250
Data -100,0,0,0,1000,0
Data -140,0,0,0,1000,0
Data -180,0,0,0,0,0
End Proc
Procedure PAN2
For Z=1 To 10
Td Angle Rel 0,294,-68,0
Td Cls
Td Redraw
Screen Swap
Wait Vbl
Next Z
For Z=1 To 40
Td Move Rel 0,-43,-10,60
Td Face 0,3
Td Cls
Td Redraw
Screen Swap
Wait Vbl
Next Z
For Z=1 To 20
Td Move Rel 0,0,0,60
Td Face 0,3
Td Cls
Td Redraw
Screen Swap
Wait Vbl
Next Z
Flash Off
End Proc
Procedure SHAPES
Td Clear All
Td Screen Height 200
Td Dir "AMONER004 Extras:AMOS_3D_Demo/objects"
Td Load "amiga"
Td Load "disc"
Td Load "monitor1"
Td Load "lettera"
Td Load "letterm"
Td Load "lettero"
Td Load "letters"
Td Load "ship1"
Td Load "car2"
Td Load "grid"
Td Load "racelights"
Td Load "car1"
Td Load "small_cube"
Td Load "tv"
Td Load "tv_anim"
Td Load "light_anim"
Td Load "cursor"
Td Load "umb"
Td Load "satellite"
Td Load "missile1"
Td Load "cursor2"
Td Load "voodoo"
End Proc
Procedure MESSAGE
Screen Hide 2 : Screen To Back 2
Screen Open 1,320,200,2,Lowres : Curs Off : Cls 0 : Palette 0,$FFF
Screen Open 0,320,200,16,Lowres : Screen To Front 0
Cls 0
Autoback 0 : Double Buffer
Ink 1,0
Dim A$(9)
A$(1)="All the hype on 3D can now be"
A$(2)="turned into reality with AMOS 3D."
A$(3)="Two years of development have"
A$(4)="resulted in this easy-to-use and"
A$(5)="comprehensive 3D extension to the"
A$(6)="already powerful AMOS - The Creator."
A$(7)=" "
A$(8)="This demo was written after only 3"
A$(9)="weeks of experience with AMOS 3D."
LINE=1 : LET=1 : RT=0 : YP=1400
Td Move 0,0,0,0 : Td Angle 0,0,0,0
Td Object 1,"cursor",-2800,1400,5000,0,0,0
Td Cls
Td Redraw
Screen Swap
Fade 1,0,$FFF,,,,,,,,$9F9,$F0,$80,$5F5,$C0,$A0 : Wait 20
Screen 1
Set Font 1
Repeat
XS=Td Position X(1) : YS=Td Position Y(1)
If RT=0 Then Goto MV
If YS>YP Then Td Move Rel 1,0,(YP-YS)/3,0
If XS>-2700 Then Td Move Rel 1,-300,0,0
If XS<-2699 Then RT=0
Goto MV2
MV:
Screen 1
XL=Td Screen X(XS,YS,5000) : YT=Td Screen Y(XS,YS,5000)
XT=Text Length(Mid$(A$(LINE),1,LET))
Ink 1,0
If XL>XT Then Text 8,YT+4,Mid$(A$(LINE),1,LET) : Inc LET
If LET>Len(A$(LINE)) Then RT=1 : Add YP,-300 : Inc LINE : LET=1
Screen 0
Td Move Rel 1,120,0,0
MV2:
Td Angle Rel 1,1600,-1800,1500
Td Cls
Td Redraw
Td Background 1,0,0,320,200 To 0,0
Screen Swap
Wait Vbl
Until LINE=10
For Z=1 To 50
Td Move Rel 1,-95,35,-Z*10 : Td Angle Rel 1,2000,-2700,2500
Td Cls
Td Redraw
Td Background 1,0,0,320,200 To 0,0
Screen Swap
Wait Vbl
If Z=20 Then Sam Play 1,1,6000
Next Z
Fade 2 : Wait 40 : Cls 0 : Screen Swap : Wait 20 : Td Kill 1
Screen 1 : Cls 0 : Screen 0
End Proc
Procedure MONITOR
Unpack 5 To 0 : Screen Swap
Fade 2,0,$FFF,$DDE,$CCD,$BBC,$99C,$88B,$77A,$669,$225,$124,$113,$DDF,$88E,$34D,$11D
Wait 160
Fade 2 : Wait 40 : Cls 0 : Screen Swap : Wait 20
Td Kill 1 : Td Kill 3
End Proc
Procedure PICCIES
Screen Open 2,320,38,8,Lowres : Set Font 1
Load Iff "text_panel.iff",2
Screen Display 2,128,50,320,38
Screen Hide 2
Load "modeller.abk",6
Load "perspective.abk",4
Load "intropac.abk",5
Load "plug.abk",7
Sam Bank 15 : Load "samples.abk",15
End Proc
Procedure SETUP
Hide On : Get Disc Fonts
Degree
Load "3dmusic.abk"
Load "pop.abk"
End Proc
Procedure OBJECTS
Td Object 1,"amiga",0,50,15000,0,32760,0
Td Object 3,"monitor1",0,650,18000,0,0,0
End Proc
Procedure PANEL
Screen 2 : Fade 1 : Wait 15
Screen To Front 2
Screen Show 2
End Proc
Procedure AMOS
Ink 4 : Bar 5,5 To 314,32 : Ink 1,4
Set Font 1
Text 10,15,"30 new AMOS commands and an amazing"
Text 6,28,"Object Modeller bring 3D to your Amiga"
Fade 2,0,$FFF,$CCC,$888,$5F,$F,$AF,$CF
Music 1 : Tempo 28 : Wait 30
Screen Open 1,320,200,8,Lowres : Screen Hide 1 : Screen 1 : Cls 0
Unpack 4 To 1 : Screen Hide 1 : Screen 0
Autoback 0 : Double Buffer
Td Move 0,0,0,0 : Td Angle 0,0,0,0
Td Object 1,"lettera",-1670,535,3000,0,0,0 : Td Object 2,"letterm",1670,535,3000,0,0,0
Td Object 3,"lettero",-1670,-700,3000,0,0,0 : Td Object 4,"letters",1670,-700,3000,0,0,
Flash Off
Td Cls
Td Redraw
Td Background 1,0,0,320,200 To 0,0
Screen Swap
Fade 2,0,$FFF,$DDD,$BBB,$888,$FF,$BF,$8F,,$7F,$F,$FFF
Wait 65
Dim X(4),Y(4),Z(4),XI(4),YI(4),ZI(4),XP(4),CI(4) : DN=0
Restore DTA1
For QZ=1 To 4 : Read X(QZ),Y(QZ),XP(QZ)
TT=Rnd(4)-2 : If TT=0 Then TT=2 : TT=TT*2
CI(QZ)=2500*TT : Z(QZ)=3000 : XI(QZ)=0 : YI(QZ)=0 : ZI(QZ)=0
Next QZ
DTA1:
Data -1670,535,-620,1670,535,-200,-1670,-700,200,1670,-700,640
Repeat
Td Cls
Td Redraw
Td Background 1,0,0,320,200 To 0,0
Screen Swap
Wait Vbl
For PQ=1 To 4
Td Angle Rel PQ,0,0,CI(PQ)
Add X(PQ),XI(PQ) : Add Y(PQ),YI(PQ) : Add Z(PQ),ZI(PQ)
Td Move PQ,X(PQ),Y(PQ),Z(PQ)
If Y(PQ)<-90 and YI(PQ)<1 Then Add YI(PQ),40
If Y(PQ)<-90 and YI(PQ)>0 Then Add YI(PQ),20
If Y(PQ)>-90 and YI(PQ)>0 Then Add YI(PQ),-40
If Y(PQ)>-90 and YI(PQ)<1 Then Add YI(PQ),-20
If X(PQ)<XP(PQ) and XI(PQ)<1 Then Add XI(PQ),40
If X(PQ)<XP(PQ) and XI(PQ)>0 Then Add XI(PQ),20
If X(PQ)>XP(PQ) and XI(PQ)>0 Then Add XI(PQ),-40
If X(PQ)>XP(PQ) and XI(PQ)<1 Then Add XI(PQ),-20
If Z(PQ)<3000 and ZI(PQ)<1 Then Add ZI(PQ),70
If Z(PQ)<3000 and ZI(PQ)>0 Then Add ZI(PQ),30
If Z(PQ)>3000 and ZI(PQ)>0 Then Add ZI(PQ),-70
If Z(PQ)>3000 and ZI(PQ)<1 Then Add ZI(PQ),-30
If Abs(Y(PQ)+90)<20 Then Y(PQ)=-90 : YI(PQ)=0
If Abs(X(PQ)-XP(PQ))<20 Then X(PQ)=XP(PQ) : XI(PQ)=0
If Abs(Z(PQ)-3000)<40 Then Z(PQ)=3000 : ZI(PQ)=0
If Y(PQ)=-90 and X(PQ)=XP(PQ) and Z(PQ)=3000 and Td Attitude C(PQ)<Abs(CI(PQ)) and CI(PQ)<>0 Then CI(PQ)=0 : Inc DN : Td Angle PQ,0,0,0
Next PQ
Tempo 28
Until DN=4
For Z=1 To 5
Td Angle Rel 0,-62,-132,0
Td Cls
Td Redraw
Td Background 1,0,0,320,200 To 0,0
Screen Swap
Wait Vbl
Tempo 28
Next Z
For Z=1 To 20
Td Move Rel 0,-90,20,180
For PQ=1 To 4
Td Angle Rel PQ,600,0,0
Next PQ
Td Face 0,2
Td Cls
Td Redraw
Td Background 1,0,0,320,200 To 0,0
Screen Swap
Wait Vbl
Tempo 28
Next Z
Wait 25
For Z=1 To 30
For PQ=1 To 4
Td Move Rel PQ,Z*150,0,0
Next PQ
Td Cls
Td Redraw
Td Background 1,0,0,320,200 To 0,0
Screen Swap
Wait Vbl
Tempo 28
Next Z
For Z=1 To 4 : Td Kill Z : Next Z
Fade 1 : Wait 15
End Proc
Procedure STARS
Fade 1 : Wait 15
Screen 2 : Fade 1 : Wait 15
Ink 4 : Bar 5,5 To 314,32
Ink 1,4 : Text 7,21,"Manipulate background scenes with ease"
Fade 2,0,$FFF,$CCC,$888,$5F,$F,$AF,$CF
Screen Open 1,640,400,2,Lowres : Screen Hide 1
Screen 1 : Cls 0
Ink 1 : For Z=1 To 500 : Plot Rnd(319),Rnd(199) : Next Z
Screen Copy 1,0,0,320,200 To 1,320,0 : Screen Copy 1,0,0,640,200 To 1,0,200
Screen Display 1,128,50,320,200
Screen 0 : Cls 0
Screen Copy 1,0,0,320,200 To 0,0,0
Screen Swap
Wait 30
Td Move 0,0,0,0 : Td Angle 0,0,0,0
End Proc
Procedure TDSHIP
Curs Off
Td Move 0,0,0,0 : Td Angle 0,0,0,0
SX=0 : SY=0
Td Object 1,"ship1",0,0,60000,0,0,32760
Td Object 2,"satellite",-1400,400,5000,0,0,0
Td Move 0,0,0,0
Td Cls
Td Redraw
Screen Swap
Hide On
Fade 3,0,$FFF,,,,,,,$3F,$8F,$F,$FFA,$AF,$AA5,$CC6
For Z=1 To 48
Td Forward 1,-1160
Td Angle Rel 1,0,0,2074
Td Angle Rel 2,100,100,600
Gosub FACE
Next Z
For Z=1 To 77
Gosub MOVEIT
Gosub FACE
Next Z
Td Object 3,"missile1",8000,9000,-8000,0,0,0
For Z=1 To 70
Gosub MOVEIT
Td Face 3,1 : Td Forward 3,500 : Td Angle Rel 3,0,400,0
Gosub FACE
Next Z
For Z=1 To 290
Gosub MOVEIT
Td Forward 3,500 : Td Angle Rel 3,0,400,0
Gosub FACE
Next Z
Goto GOAWAY
MOVEIT:
Td Forward 1,-300
Td Angle Rel 1,0,400,200
Td Angle Rel 2,100,100,600
Return
FACE:
Td Face 0,1
XF=Td Attitude B(0) : YF=65520-Td Attitude A(0)
XF=(XF*320)/65520 : YF=(YF*200)/65520
Td Cls
Td Redraw
Td Background 1,XF,YF,XF+320,YF+200 To 0,0
Screen Swap
Wait Vbl
Return
GOAWAY:
Screen 2 : Fade 1 : Wait 15
Screen 0 : Fade 1 : Wait 15 : Td Kill 1 : Td Kill 2 : Td Kill 3
End Proc
Procedure CAR_RACE
Screen 2 : Ink 4 : Bar 5,5 To 314,32
Ink 1,4 : Text 10,22,"Moving and viewing is simplicity itself"
Fade 2,0,$FFF,$CCC,$888,$5F,$F,$AF,$CF : Wait 30
Screen Open 1,320,200,2,Lowres : Screen Hide 1 : Screen Display 1,128,0,320,200
Cls 1
Set Rainbow 0,1,136,"","",""
Restore RDATA
For C=0 To 135 : Read CVA : Rain(0,C)=CVA
Next C
RDATA:
Data $0,$0,$0,$0,$0,$0,$0,$112
Data $112,$112,$0,$112,$112,$112,$112,$112
Data $112,$0,$112,$112,$112,$112,$112,$112
Data $113,$113,$114,$114,$115,$115,$116,$116
Data $117,$117,$118,$119,$119,$11A,$11B,$11B
Data $11C,$11D,$11D,$11E,$11E,$11E,$11E,$11F
Data $11F,$11F,$11F,$11F,$11F,$11F,$11F,$11F
Data $11F,$11F,$11F,$11F,$11F,$11F,$11F,$11F
Data $11F,$11F,$11F,$11F,$11F,$11F,$11F,$11F
Data $11F,$11F,$11F,$11F,$11F,$11F,$11F,$11F
Data $11F,$11F,$11F,$11F,$11F,$11F,$11F,$11F
Data $11F,$11F,$11F,$11F,$11F,$11F,$21F,$21F
Data $31F,$41F,$51F,$61F,$71F,$81F,$91F,$91F
Data $A1F,$B1E,$B1D,$C1C,$C1B,$C1A,$C19,$C18
Data $C17,$C16,$C15,$C14,$C13,$C12,$C11,$C11
Data $C21,$C31,$C41,$C51,$C61,$C71,$C81,$C81
Data $C91,$CA1,$CB1,$CC1,$CD1,$CE1,$CF1,$CF1
Data $CF2,$CF3,$CF4,$CF5,$CF6,$CF7,$CF8,$CF9
Screen 0
Td Object 3,"grid",0,-220,32500,-16380,0,0
Td Object 4,"racelights",0,600,31500,32760,0,0
Td Move 0,-2000,500,1000 : Td Face 0,3
Td Object 1,"car1",-500,0,35000,0,16380,0
Td Object 2,"car2",500,0,35000,0,16380,0
Fade 1,0,$500,$FFF,,,,,,$FFF,$C0,$AAA,$70
Td Surface "light_anim",0,3 To 4,0,3,0 : Gosub SKY
For Z=1 To 33
Td Move Rel 0,2,0,900
Td Face 0,3
Gosub SKY
Next Z
SPD=900
For Z=1 To 30
Td Move Rel 0,10,45,SPD
Td Face 0,3
Gosub SKY
SPD=SPD-30
Next Z
For Z=1 To 80
Td Move Rel 0,120,20,-220
Td Face 0,3
Gosub SKY
Next Z
Wait 50
Td Move 0,-1500,5000,31000
Td Angle 0,0,0,0
Td Face 0,3
For Z=1 To 50
Gosub SKY
Td Move Rel 0,0,-100,0
Td Face 0,3
Next Z
Wait 25
Td Move 0,2500,1500,34500
Td Angle 0,0,0,0
Td Face 0,3
Td Move Z 1,"(1,-80,25)"
Td Move Z 2,"(1,-40,50)"
For Z=1 To 55
Gosub SKY
Next Z
Wait 25
Td Move 0,0,2000,50000
Td Angle 0,0,32760,0
For Z=1 To 20
Td Move Rel 0,0,-100,-750
Td Face 0,4
Gosub SKY
Next Z
Screen 2 : Fade 1 : Wait 15 : Ink 4 : Bar 5,5 To 314,32
Ink 1,4 : Text 11,15,"3D car racing, dog fights or business" : Text 21,28,"graphics are all at your fingertips"
Fade 1,0,$FFF,$CCC,$888,$5F,$F,$AF,$CF : Wait 15 : Screen 0
For Z=1 To 25
Td Move Rel 0,0,0,200
Td Angle Rel 0,-70,27,0
Gosub SKY
Next Z
For Z=1 To 25
Td Move Rel 0,0,0,-200
Td Face 0,1 : Gosub SKY
Next Z
Wait 5
Td Surface "light_anim",0,1 To 4,0,3,0 : Gosub SKY : Wait 50
Td Surface "light_anim",0,0 To 4,0,3,0 : Gosub SKY : Wait 50
Td Surface "light_anim",0,2 To 4,0,3,0 : Gosub SKY
NICKS:
SPD1=0 : SPD2=0
FRM=0
SPD0=0
PAN6:
Gosub SKY
Td Face 0,1
Td Move Rel 1,0,0,-SPD1
Td Move Rel 2,0,0,-SPD2
Add SPD1,20
Add SPD2,30
If SPD1>605 Then SPD1=605
If SPD2>590 Then SPD2=590
If FRM>60 Then Gosub POON
Inc FRM
If Td Position Z(1)<-120000 Then SPD0=0 : BRK=0 : Goto PAN7
Goto PAN6
POON:
Td Move Rel 0,0,5,-SPD0
If Td Position Z(0)<-95000 Then Goto POONS
Add SPD0,50
If SPD0>1500 Then SPD0=1500
Return
POONS:
If SPD0>0 Then SPD0=SPD0-100
If Td Position X(0)<-1500 Then Return
Td Move Rel 0,-100,100,0
Return
PAN7:
Gosub SKY
Td Face 0,1
Td Move Rel 0,0,-10,-SPD0
Td Move Rel 2,0,0,-SPD2
Td Move Rel 1,0,0,-SPD1
If BRK=0 Then Add SPD0,58
If SPD0=0 Then Add SPD2,-5 : Add SPD1,-50 : Gosub TURN1
If Td Position Z(0)<-130000 Then Add SPD0,-30 : Inc BRK
If SPD0<0 Then SPD0=0
If SPD2<0 Then SPD2=0
If SPD1<0 Then SPD1=0
If BRK=58 Then Music Off : Sam Play 1,3,5000
If BRK=120 Then Goto FIN
Goto PAN7
TURN1:
Td Angle Rel 2,4000,2000,3000
If SPD1>0 Then Td Angle Rel 1,0,-3600,0
Return
FIN:
Wait 50
Fade 2 : Wait 50
Td Kill 1 : Td Kill 2 : Td Kill 3 : Td Kill 4
Goto FINI
SKY:
YS1=Td Screen Y(0,0,500000) : YS2=Td Screen Y(0,0,-500000)
If YS1>0 Then SKY=YS1 Else SKY=YS2
Add SKY,65
SKP=SKY-155 : SKH=150 : SKB=0
SKL=89
If SKP<SKL Then SKH=SKH+SKP-SKL : SKB=SKL-SKP : SKP=SKL
If SKY<65 Then SKH=15
Rainbow 0,SKB,SKP,SKH-15
Td Cls : Td Redraw
Td Background 1,0,0,320,200 To 0,0
Screen Swap : Wait Vbl
Return
FINI:
Screen 2
Fade 1 : Wait 15
Screen 1 : Rainbow Del
End Proc
Procedure TV
Screen 2 : Ink 4 : Bar 5,5 To 314,32
Ink 1,4 : Text 12,15,"Surface detail adds that professional" : Text 61,28,"touch to your 3D objects"
Fade 2,0,$FFF,$CCC,$888,$5F,$F,$AF,$CF : Wait 30
Screen 0 : Flash Off
Td Move 0,0,0,0
Td Object 1,"tv",0,500,2500,0,0,0
Fade 2,0,$FFF,$BBB,$888,$F80,,$F00,,,$EFE,$A0,$60
Restore TVDTA
FRM=0
ANG=0
For Z=1 To 126
If FRM=0 Then Read FC : Td Surface "tv_anim",0,FC To 1,0,0,2
Td Move 0,1000*Cos(ANG),0,0
Td Face 0,1
Td Cls
Td Redraw
Screen Swap
Wait Vbl
Inc FRM : FRM=FRM mod 3
Add ANG,5 : ANG=ANG mod 360
Next Z
TVDTA:
Data 3,3,3,3,3,3,3,2,2,2,3,0,0,0,3,2,2,2,3,0,0,0,3,3,3,1,4,4,4,1,3,3,0,0,0,3,2,2,2,3,3,3
Screen 2 : Fade 1 : Wait 15
End Proc
Procedure TV_BOOM
Screen 2 : Ink 4 : Bar 5,5 To 314,32
Ink 1,4 : Text 33,15," Flexible animation routines allow" : Text 18,28,"you to bring your character to life."
Fade 2,0,$FFF,$CCC,$888,$5F,$F,$AF,$CF : Wait 30
Screen 0
Td Surface "tv_anim",0,4 To 1,0,0,2
A=-40 : B=20 : C=-20
For Z=1 To 41
If Z=2 Then Sam Play 1,5,3000
Td Anim Rel 1,1,A,B,C,1
Add A,2 : Dec B : Inc C
Gosub SHIFTEM
Next Z
A=40 : B=20 : C=-60
For Z=1 To 21
If Z=2 Then Sam Play 1,4,3000
Td Anim Rel 1,2,A,B,C,1
Add A,-4 : Add B,-2 : Add C,6
Gosub SHIFTEM
Next Z
Dim A(7),B(7),C(7),AI(7),BI(7),CI(7)
For Z=0 To 7 : AI(Z)=0 : BI(Z)=0 : CI(Z)=0 : Next Z
Restore ADTA : For Z=0 To 3 : Read A(Z),B(Z),C(Z) : A(Z+4)=A(Z) : B(Z+4)=B(Z) : C(Z+4)=C(Z) : Next Z
ADTA: Data -32,-21,7,-22,43,-31,24,22,23,37,-31,-18
For Z=1 To 150
For Q=0 To 7
Td Anim Rel 1,Q,A(Q),B(Q),C(Q),0
Add AI(Q),A(Q) : Add BI(Q),B(Q) : Add CI(Q),C(Q)
If AI(Q)<0 Then Add A(Q),(Z+20)/3
If AI(Q)>0 Then Add A(Q),-(Z+20)/3
If BI(Q)<0 Then Add B(Q),(Z+20)/3
If BI(Q)>0 Then Add B(Q),-(Z+20)/3
If CI(Q)<0 Then Add C(Q),(Z+20)/3
If CI(Q)>0 Then Add C(Q),-(Z+20)/3
Next Q
Td Anim Rel 1,0,0,0,0,1
Gosub SHIFTEM
Next Z
For Z=0 To 7 : Td Anim Rel 1,Z,-AI(Z),-BI(Z),-CI(Z),0 : Next Z
Td Anim Rel 1,1,0,0,0,1
Restore ADTA1
For Z=1 To 57
Read A
Td Anim Rel 1,0,A,0,0,0
Td Anim Rel 1,1,A,0,0,0
Td Anim Rel 1,2,-A,0,0,0
Td Anim Rel 1,3,-A,0,0,1
Gosub SHIFTEM
If Z=2 Then Sam Play 1,4,3000
Next Z
Restore ADTA1
For Z=1 To 57
Read A
Td Anim Rel 1,1,0,-A,0,0
Td Anim Rel 1,2,0,-A,0,0
Td Anim Rel 1,0,0,A,0,0
Td Anim Rel 1,3,0,A,0,1
Gosub SHIFTEM
If Z=2 Then Sam Play 1,5,5000
Next Z
A=-240
For Z=1 To 26
Td Anim Rel 1,0,A,A,0,0
Td Anim Rel 1,4,A,A,0,0
Td Anim Rel 1,1,A,-A,0,0
Td Anim Rel 1,5,A,-A,0,0
Td Anim Rel 1,2,-A,-A,0,0
Td Anim Rel 1,6,-A,-A,0,0
Td Anim Rel 1,3,-A,A,0,0
Td Anim Rel 1,7,-A,A,0,1
Add A,20
Gosub SHIFTEM
If Z=2 Then Sam Play 1,4,5000
Next Z
ADTA1:
Data -200,-200,-200,-180,-180,-160,-160,-140,-120,-100,-80,-60,-40,-20,0,20,40,60,80,100,120,130,160,160
Data 180,180,200,200,200
Data -150,-130,-110,-90,-70,-50,-30,30,50,70,90,110,130,150
Data -70,-50,-30,30,50,70,-50,-30,30,50
Data -50,-30,30,50
Goto FINITO
SHIFTEM:
Td Move 0,1000*Cos(ANG),0,0
Td Face 0,1
Add ANG,5 : ANG=ANG mod 360
Td Cls : Td Redraw
Screen Swap
Wait Vbl
Return
FINITO:
Td Kill 1 : Td Cls : Td Redraw : Paste Bob 70,60,1 : Screen Swap : Wait Vbl
End Proc
Procedure SMALL_BLOCK
Td Cls : Td Redraw : Paste Bob 70,60,1 : Screen Swap : Wait Vbl
Dim X(4),Y(4),Z(4),XI(4),YI(4),ZI(4),D(4)
For Z=1 To 4 : Td Object Z,"small_cube",Rnd(600)-300,100+(Rnd(8)*20),2500,0,0,0 : X(Z)=Td Position X(Z) : Y(Z)=Td Position Y(Z) : Z(Z)=2500
XI(Z)=Rnd(120) : YI(Z)=(Rnd(4)+2)*20 : ZI(Z)=Rnd(80)-40
If Z<4 Then XI(Z)=-XI(Z)
Next Z
LAND=0
Repeat
For Q=1 To 4
Td Move Q,X(Q),Y(Q),Z(Q)
If XI(Q)<>0 and YI(Q)<>0 and ZI(Q)<>0 Then Td Angle Rel Q,0,(Q-3)*300,0
Add X(Q),XI(Q) : Add Y(Q),YI(Q) : Add Z(Q),ZI(Q)
If Y(Q)<-100 Then Y(Q)=-100 : YI(Q)=Abs(YI(Q))-20
If Y(Q)=-100 and YI(Q)=0 and D(Q)=0 Then Inc LAND : XI(Q)=0 : ZI(Q)=0 : YI(Q)=0 : D(Q)=1
If YI(Q)<>0 or Y(Q)<>-100 Then Add YI(Q),-20
Next Q
Td Cls : Td Redraw : Screen Swap : Wait Vbl
Until LAND=4
Wait 50
Fade 2 : Wait 30
For Z=1 To 4 : Td Kill Z : Next Z
Screen 2 : Fade 2 : Wait 30
End Proc
Procedure OM
Unpack 6 To 1 : Screen Hide 1
Screen 0 : Flash Off
Screen 2 : Ink 4 : Bar 5,5 To 314,32
Ink 1,4 : Text 29,15,"Create and edit objects with the" : Text 51,28,"easy-to-use object modeller"
Fade 2,0,$FFF,$CCC,$888,$5F,$F,$AF,$CF : Wait 30
Td Move 0,0,0,0 : Td Angle 0,0,0,0
Td Object 1,"umb",-600,200,2800,0,0,0
Screen 0 : Td Cls : Td Redraw : Td Background 1,0,0,320,64 To 0,136 : Screen Swap
Fade 2,0,$FFF,$CCC,$AAA,$888,$666,$CF,$8D,$6D,$4B,$F00,$90,$E40,$A10,$F0,$3A
Wait 30
For Z=1 To 300
Td Cls : Td Redraw : Td Background 1,0,0,320,64 To 0,136 : Screen Swap : Wait Vbl
Td Angle Rel 1,-1000,-850,700
Next Z
Fade 2 : Wait 30
Screen 2 : Fade 2 : Wait 30 : Td Kill 1
Screen 1 : Cls 0
End Proc
Procedure CREDITS
Screen Hide 2 : Screen To Back 2 : Screen 2
Screen Open 1,320,200,4,Lowres : Screen Hide 1 : Screen To Back 1
Screen 1 : Cls 0
Ink 1,0
Dim A$(10)
A$(1)="CREDITS"
A$(2)=" "
A$(3)="Programming and graphics"
A$(4)="Nick Harper"
A$(5)=" "
A$(6)="Music"
A$(7)="Allistair Brimble"
A$(8)=" "
A$(9)="Sound effects"
A$(10)="Len Tucker"
Screen 0
LINE=1
SET=0 : YD=0
Td Move 0,0,0,0 : Td Angle 0,0,0,0
Td Object 1,"cursor2",-2800,1400,5000,0,0,0
Td Object 2,"cursor2",2800,1400,5000,0,0,0
Td Cls
Td Redraw
Screen Swap
Fade 1,0,$FFF,,,,,,,$3F8,$9F9,$F0,$80,$5F5,$C0,$A0 : Wait 20
Gosub NEWLINE
Repeat
Td Angle Rel 1,1300,1500,-2000 : Td Angle Rel 2,1300,1500,2000
On SET+1 Gosub ROLL,ROLL1,ROLL2
Td Cls : Td Redraw : Td Background 1,0,0,320,200 To 0,0 : Screen Swap : Wait Vbl
If XS1>XS2 and SET=0 Then Gosub TXT
Until LINE=11
For Z=1 To 50
Td Angle Rel 1,1300,1500,-2000 : Td Angle Rel 2,1300,1500,2000
Td Move Rel 1,210,155,-300 : Td Move Rel 2,-210,155,-300
Td Cls : Td Redraw : Td Background 1,0,0,320,200 To 0,0 : Screen Swap : Wait Vbl
Next Z
Wait 100
Fade 2 : Wait 40 : Cls 0 : Td Kill 1 : Td Kill 2 : Screen 1 : Cls 0 : Set Font 1
Ink 1,0 : Text 64,20,"AMOS 3D was written by"
Text 115,35,"Tony Wilkes" : Text 148,50,"and" : Text 108,65,"Richard Lewis"
Text 151,80,"of" : Text 125,160,"software"
Screen 0
Td Move 0,0,0,0 : Td Angle 0,0,0,0 : Td Object 1,"voodoo",0,-200,10000,0,16000,0
Fade 1,0,$FFF,,,,,,,$3F8,$9F9,$F0,$80,$5F5,$C0,$A0
For Z=1 To 150
Td Cls : Td Redraw : Td Background 1,0,0,320,200 To 0,0 : Screen Swap : Wait Vbl
Td Move Rel 1,0,2,-58 : Td Angle Rel 1,0,-106,436
Next Z
Wait 100
Goto TADA
TXT:
Screen Copy 2,XS2,6,XS1,28 To 1,XS2,Y-12,224
Return
ROLL:
Td Move Rel 1,150,0,0 : Td Move Rel 2,-150,0,0
Gosub POS
If XS1>270 Then SET=1
Return
ROLL1:
Td Move Rel 1,100,YD,0 : Td Move Rel 2,-100,YD,0
Add YD,-30
Gosub POS
If YD=-150 Then YD=0 : SET=2
Return
ROLL2:
Gosub POS
Td Move 1,X2,Y1,5000 : Td Move 2,X1,Y1,5000
Gosub POS
SET=0
Inc LINE
If LINE<11 Then Gosub NEWLINE
Return
POS:
X1=Td Position X(1) : X2=Td Position X(2) : Y1=Td Position Y(1)
XS1=Td Screen X(X1,Y1,5000) : XS2=Td Screen X(X2,Y1,5000) : Y=Td Screen Y(0,Y1,5000)
Return
NEWLINE:
Screen 2
Ink 0 : Bar 5,5 To 314,32 : Ink 1,0
L=Text Length(A$(LINE)) : L=L/2
Text 160-L,22,A$(LINE) : Screen 0
Return
TADA:
Fade 2 : Wait 40 : Cls 0 : Screen Swap : Wait 20 : Td Kill 1
Screen 1 : Cls 0 : Screen 0
End Proc
Procedure PLUG
Unpack 7 To 0
Screen Swap
Fade 2,0,$FFF,$DDD,$BBB,$888,$FF,$BF,$8F,$FF9,$FF0,$FC0,$FA0,$F80,$F60,$F30,$F00
Wait 450
Fade 1 : Wait 15 : Cls 0
Autoback 0 : Double Buffer
Screen To Front 2
End Proc