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