home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 351-375 / apd361 / source.amos / source.amosSourceCode
AMOS Source Code  |  1991-06-13  |  25KB  |  978 lines
  1. Set Buffer 30
  2. Load "demo:P4.abk",6
  3. Screen Open 0,320,256,32,Lowres
  4. Hide On : Curs Off : Flash Off 
  5. Unpack 6 To 0
  6. For I=1 To 16
  7.    Colour I,0
  8. Next 
  9. Colour 1,$555
  10. Shift Up 1,1,16,1
  11. For I=17 To 25
  12.    Colour I,0
  13. Next 
  14. Screen Show 
  15. Wait 100
  16. Fade 2,,,,,,,,,,,,,,,,,,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
  17. Wait 2*16
  18. Fade 2,,,,,,,,,,,,,,,,,,$F00,$D00,$A00,$900,$700,$5,$4,$3,$2
  19. Wait 2*16
  20. Timer=0
  21. Repeat 
  22. Until Timer>500
  23. Shift Off 
  24. Fade 7,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
  25. Wait 7*16
  26. '
  27. Repeat 
  28.    S:
  29.    For I=63 To 0
  30.       Volume I : Wait Vbl 
  31.    Next 
  32.    Volume 63
  33.    For I=1 To 8
  34.       Erase I
  35.    Next 
  36.    Screen Open 0,320,256,32,Lowres
  37.    Curs Off : Flash Off 
  38.    Load "demo:P5.abk",7
  39.    Unpack 7 To 0
  40.    Show On 
  41.    Shift Up 3,23,31,1
  42.    Reserve Zone 3
  43.    Set Zone 1,2,75 To 106,178
  44.    Set Zone 2,106,75 To 212,178
  45.    Set Zone 3,212,75 To 318,178
  46.    SS:
  47.    If Mouse Key
  48.       If Mouse Zone=1
  49.          Hide On 
  50.          Colour 9,$F0
  51.          For I=1 To 8
  52.             Erase I
  53.          Next 
  54.          _INTERFERENCE
  55.          Goto S
  56.       End If 
  57.       If Mouse Zone=3
  58.          Hide On 
  59.          Colour 9,$F0
  60.          For I=1 To 8
  61.             Erase I
  62.          Next 
  63.          _END
  64.          Goto S
  65.       End If 
  66.       If Mouse Zone=2
  67.          Hide On 
  68.          Colour 9,$F0
  69.          For I=1 To 8
  70.             Erase I
  71.          Next 
  72.          Screen Open 0,320,256,32,Lowres
  73.          Load "demo:P6.abk",6
  74.          Unpack 6 To 0
  75.          Wait 100
  76.          _3D
  77.          Goto S
  78.       End If 
  79.    End If 
  80.    Goto SS
  81. Until False
  82. '
  83. Procedure _END
  84.    Bob Update On 
  85.    Load "demo:p7.abk",6
  86.    Load "demo:p8.abk",7
  87.    Load "demo:p9.abk",8
  88.    Load "demo:drip.abk",1
  89.    Load "demo:music3.abk"
  90.    Dim CHAR(200,2)
  91.    Gosub WORDS
  92.    A$="   WELL WHAT DO YOU THINK OF MY DEMOS?  AND WHAT DO YOU THINK OF THIS FONT ISNT IT SICKLY ?!! ITS TIME TO BORE YOU WITH A FEW GREETZ. FIRSTLY THE MUSIC FOR THIS DEMO AND THE THREE DEE DEMO IS BY THE CRYPTOBURNERS. I HATE HAVING TO RIP MUSIC "
  93.    A$=A$+"BUT I HAVE NO MUSICAL TALENT!!. HI TO .....   LITTLE.M    THE FUGITIVE    LEE V.   GRIM DEATH      MR. LOGIC    GUM DROP    KEZO    GAVIN     THE TROUT       T.S.I.      RUBICON       THE ARC ANGEL     SYNTEX       DEJA VU SOFT.    "
  94.    A$=A$+"THE CRUSADERS       AND A BIG HELLO TO AMOS USERS AND DEMO CREATORS ACROSS THE GLOBE. WATCH OUT FOR THE NEXT DR.STRANGE DEMO ........    ONE SHORT NOTE    THERE ARE STILL SOME PEOPLE WHO ARE INSISTING ON LOCKING THEIR AMOS CODE SO THAT "
  95.    A$=A$+"NO ONE CAN HAVE A LOOK   AMOS PD SHOULD BE A HELP TO NEW AMOS USERS WHO WANT TO SEE HOW DEMOS ARE CODED. THEY DONT JUST WANT TO SEE WHAT CAN BE DONE BUT ALSO HOW ITS DONE           ON THAT NOTE THIS SCROLL DOTH END !!!!!                  "
  96.    Screen Open 3,320,256,16,Lowres
  97.    Screen Hide 3
  98.    Flash Off : Curs Off : Unpack 8 To 3
  99.    Screen Open 1,640,256,2,Lowres
  100.    Curs Off : Flash Off : Hide On 
  101.    Unpack 7 To 1
  102.    Colour 1,0
  103.    Screen Open 2,640,256,2,Lowres
  104.    Screen Hide : Paper 1 : Cls 
  105.    Curs Off : Flash Off 
  106.    Screen Open 4,700,30,16,Lowres
  107.    Curs Off : Flash Off : Hide On : Paper 0 : Cls 
  108.    Fade 1 To 3
  109.    Screen Open 0,320,256,8,Lowres
  110.    Curs Off : Flash Off : Hide On 
  111.    Unpack 6 To 0
  112.    Colour 1,0
  113.    Double Buffer 
  114.    Screen Display 4,,270,,
  115.    Screen To Front 4
  116.    Y=0 : IN=True : POS=1
  117.    Music 1
  118.    For X=-250 To 0
  119.       Screen Copy 1,0,0,640,256 To 0,Y,X,%1100000
  120.       Screen Swap : Wait Vbl 
  121.       If IN=True
  122.          Y=Y+1
  123.          If Y>10 : IN=False : End If 
  124.       End If 
  125.       If IN=False
  126.          Y=Y-1
  127.          If Y<-50 : IN=True : End If 
  128.       End If 
  129.       Screen Copy 2,0,0,640,256 To 0,0,0
  130.    Next 
  131.    Palette 0,0,$F10,$F10,$C00,$C00,$800,$800
  132.    Screen Swap 
  133.    Palette 0,0,$F10,$F10,$C00,$C00,$800,$800
  134.    Screen Copy 2,0,0,320,256 To 0,0,0
  135.    Set Rainbow 1,1,32,"(2,1,15)","",""
  136.    For I=300 To 238 Step -1
  137.       Rainbow 1,0,I,32 : Wait Vbl 
  138.    Next 
  139.    '
  140.    Repeat 
  141.       Add PS,1,1 To 4
  142.       If PS=1
  143.          X=110 : YY=0
  144.       End If 
  145.       If PS=2
  146.          X=30 : YY=0
  147.       End If 
  148.       If PS=3
  149.          X=187 : YY=85
  150.       End If 
  151.       If PS=4
  152.          X=257 : YY=85
  153.       End If 
  154.       For Y=10 To 73
  155.          Bob 1,X,Y+YY,1 : Gosub SCRL : Gosub SCRL
  156.       Next 
  157.       For Y=74 To 81
  158.          Bob 1,X,Y+YY,9-(Y-74)
  159.          For I=1 To 7
  160.             Gosub SCRL
  161.          Next 
  162.       Next 
  163.       For Y=83 To 88
  164.          Bob 1,X-1,Y+YY,(Y-83)+10
  165.          For I=1 To 3
  166.             Gosub SCRL
  167.          Next 
  168.       Next 
  169.       Y#=89
  170.       IN#=1
  171.       Repeat 
  172.          Bob 1,X-1,Y#+YY,1 : Gosub SCRL
  173.          Y#=Y#+IN#
  174.          IN#=IN#+0.05
  175.       Until Y#+YY>200
  176.       For N=16 To 25
  177.          Bob 1,X-1,Y#+YY+N-16,N : Gosub SCRL
  178.       Next 
  179.    Until Mouse Key
  180.    Goto ND
  181.    '
  182.    SCRL:
  183.    If Mouse Key Then Goto ND
  184.    Add NO,1,0 To 14
  185.    If NO=0
  186.       Add POS,1,1 To Len(A$)
  187.       NN=Asc(Mid$(A$,POS,1))
  188.       XXS=CHAR(NN,1)
  189.       YYS=CHAR(NN,2)
  190.    End If 
  191.    Screen Copy 3,XXS+(NO*2),YYS,XXS+(NO*2)+2,YYS+30 To 4,XS+330,0
  192.    Screen Copy 3,XXS+(NO*2),YYS,XXS+(NO*2)+2,YYS+30 To 4,XS,0
  193.    Add XS,2,0 To 328
  194.    Screen Offset 4,XS,0
  195.    Wait Vbl 
  196.    Return 
  197.    '
  198.    WORDS:
  199.    For I=1 To 30
  200.       Read B$,A,B
  201.       CHAR(Asc(B$),1)=A
  202.       CHAR(Asc(B$),2)=B
  203.    Next 
  204.    Data "A",0,0
  205.    Data "B",30,0
  206.    Data "C",60,0
  207.    Data "D",90,0
  208.    Data "E",120,0
  209.    Data "F",150,0
  210.    Data "G",180,0
  211.    Data "H",210,0
  212.    Data "I",240,0
  213.    Data "J",270,0
  214.    Data "K",0,30
  215.    Data "L",30,30
  216.    Data "M",60,30
  217.    Data "N",90,30
  218.    Data "O",120,30
  219.    Data "P",150,30
  220.    Data "Q",180,30
  221.    Data "R",210,30
  222.    Data "S",240,30
  223.    Data "T",270,30
  224.    Data "U",0,60
  225.    Data "V",30,60
  226.    Data "W",60,60
  227.    Data "X",90,60
  228.    Data "Y",120,60
  229.    Data "Z",150,60
  230.    Data "?",180,60
  231.    Data " ",210,60
  232.    Data ".",240,60
  233.    Data "!",270,60
  234.    Return 
  235.    '
  236.    ND:
  237.    Fade 7,0,0,0,0,0,0,0,0
  238.    For I=240 To 300 Step 1
  239.       Rainbow 1,0,I,32 : Wait Vbl 
  240.    Next 
  241.    For I=0 To 4
  242.       Screen Close I
  243.    Next 
  244. End Proc
  245. Procedure _INTERFERENCE
  246.    Load "demo:music2.abk"
  247.    Load "demo:sprites.abk",1
  248.    Load "demo:p1.abk",6
  249.    Load "demo:p2.abk",7
  250.    Load "demo:p3.abk",8
  251.    A$="   INTERFERENCE ,  WILD AND GROOVY ???!!!!             WELCOME TO THE DR.STRANGE INTERFERENCE DEMO, PROGRAMMED TOTALLY IN AMOS. "
  252.    A$=A$+"THANKS TO LITTLE.M.  FOR THE WICKED FONT, THANKS TO PHENOMENA FOR THE MUSIC, AND THANKS TO THE FUGITIVE FOR HAVING THE PATIENCE TO SIT AND WATCH ME CODE"
  253.    A$=A$+" THIS DEMO THAT IS NOW AT LAST FINISHED !!! I HAVE TRIED TO MAKE THIS SELECTION OF DEMOS SLIGHTLY DIFFERENT FROM THE USUAL RUN OF THE MILL BORING SCROLLY TEXT DEMO, SEE THE THREE DEE DEMO"
  254.    A$=A$+" MUCH THANKS HAS TO GO TO FRANCOIS LOINET FOR THE COMPILER AND AMOS THREE DEE, A COUPLE OF EXCELLENT PRODUCTIONS. WITHOUT THE COMPILER THESE DEMOS WOULD BE SO SLOW. WATCH OUT FOR MY SOON TO BE RELEASED FRACTAL GENERATOR, FRACTALPLOT, IT "
  255.    A$=A$+" GENERATES MANY DIFFERENT FRACTALS AT LIGHTENING SPEED, IT THEN PLOTS THEM IN THREE DEE !!!! THE FRACTAL TYPES I HAVE CURRENTLY ADDED ARE MANDELBROTS, WARPED MANDELBROTS, JULIA SETS AND PLASMA CLOUDS. "
  256.    A$=A$+" IT FEATURES MAY USEFULL FEATURES LIKE PALETTE EDITING, AND SOME USELESS ONES LIKE COLOUR CYCLING AND ORBIT PLOTTING. FOR ALL THOSE INTERESTED IN AMOS CODING THE FULL SOURCE CODE WITH NO PROCEDURES LOCKED CAN BE FOUND ON THIS DISK. "
  257.    A$=A$+"IF YOU DO USE ANY PART OF MY CODE I WOULD LIKE TO BE CREDITED, BUT FEEL FREE TO HAVE A GOOD NOSE AROUND, YOU MAY HAVE DIFFICULTY FINDING WHAT YOU WANT, BECAUSE WHEN I WRITE DEMOS STRUCTURED PROGRAMMING DOES NOT EXIST!   END OF MESSAGE,"
  258.    A$=A$+" GOOD NIGHT ONE AND ALL !!!!                       "
  259.    Dim CHAR(130,2)
  260.    Screen Open 0,400,256+180,2,Lowres
  261.    Curs Off : Paper 0 : Cls : Flash Off 
  262.    Hide On 
  263.    Unpack 6 To 0
  264.    Screen Hide 0
  265.    Screen Open 1,320,256,16,Lowres
  266.    Unpack 7 To 1
  267.    Colour 1,0
  268.    Screen Open 2,700,80,2,Lowres
  269.    Colour 1,0
  270.    Screen Display 2,,270,,
  271.    Paper 1 : Cls 
  272.    For I=3 To 7
  273.       Screen Open I,320,230,8,Lowres
  274.       Curs Off : Paper 0 : Cls : Flash Off 
  275.       Unpack 8 To I
  276.       Screen Display I,,45,,
  277.    Next 
  278.    '
  279.    Degree 
  280.    Z=55
  281.    Dim BALLS(720,6)
  282.    Dim LINES(4,39)
  283.    For I=0 To 720
  284.       BALLS(I,1)=(Cos(I)*Z)
  285.       BALLS(I,2)=((Sin(I*2)-Cos(I/2))*Z)
  286.       BALLS(I,3)=((Cos(I*2)-Sin(I*2))*Z)
  287.       BALLS(I,4)=((Sin(I/2)-Cos(I*2))*Z)
  288.       BALLS(I,5)=((Cos(I*2)-Sin(I/2))*Z)
  289.       BALLS(I,6)=(Cos(I/2)*Z)
  290.       BALLS(I,0)=((Sin(I*2)-Cos(I))*Z)
  291.    Next 
  292.    Music 1
  293.    Z=40 : I=0 : X=0 : Y=0 : NO=12
  294.    Set Rainbow 1,0,567,"(1,1,15)(1,-1,15)","(1,1,11)(1,-1,11)","(1,1,13)(1,-1,13)"
  295.    Gosub WORDS
  296.    SCR=4 : I#=0 : Z#=60 : BALL=1 : TYPE=1
  297.    Timer=0
  298.    '
  299.    Repeat 
  300.       N1=2 : N2=1
  301.       Gosub MEGABOBS
  302.       N1=4 : N2=3
  303.       Gosub MEGABOBS
  304.       Gosub MEGALINES
  305.       N1=2 : N2=5
  306.       Gosub MEGABOBS
  307.       N1=0 : N2=6
  308.       Gosub MEGABOBS
  309.       Gosub MEGALINES2
  310.       N1=0 : N2=3
  311.       Gosub MEGABOBS
  312.       N1=0 : N2=5
  313.       Gosub MEGABOBS
  314.       N1=1 : N2=3
  315.       Gosub MEGABOBS
  316.       Gosub MEGALINES2
  317.    Until Mouse Key
  318.    Goto EN
  319.    '
  320.    MEGABOBS:
  321.    Timer=0
  322.    D=0 : C=160
  323.    Rainbow 1,0,370,1
  324.    Repeat 
  325.       If Mouse Key Then Exit 
  326.       Rem **************** scroll ***************
  327.       Add NO,1,0 To 5
  328.       If NO=0
  329.          Add POS,1,0 To Len(A$)
  330.          N=Asc(Mid$(A$,POS,1))
  331.          XX=CHAR(N,1)
  332.          YY=CHAR(N,2)
  333.       End If 
  334.       Rainbow 1,Y,270+SY,26
  335.       Screen Copy 1,XX+(NO*4),YY,XX+(NO*4)+4,YY+26 To 2,X+330,0
  336.       Screen Copy 1,XX+(NO*4),YY,XX+(NO*4)+4,YY+26 To 2,X,0
  337.       Add X,4,0 To 328
  338.       Add Y,1,0 To 567
  339.       Add I,3,0 To 720
  340.       Add J,2,0 To 720
  341.       Rem ************* bobs+interference ********************     
  342.       If Timer>1000 and Timer<1010
  343.          Screen 7 : Fade 10,,,,,,,$0,$F
  344.       End If 
  345.       If Timer>1250
  346.          Screen 7 : Fade 1,,,,,,,$FF,$FF0
  347.       End If 
  348.       Add D,4,0 To 720
  349.       Add C,4,0 To 720
  350.       Add SCR,1,3 To 7
  351.       Screen SCR
  352.       Paste Bob BALLS(D,N1)+160,BALLS(D,N2)+128,4
  353.       Screen Copy 0,0,0,400,256+180 To SCR,(BALLS(J,1)/2)-40,(BALLS(J,2)/2)-70
  354.       If Timer<1150
  355.          Paste Bob BALLS(C,N1)+160,BALLS(C,N2)+128,1
  356.       End If 
  357.       Screen Copy 0,0,0,400,256+180 To SCR,(BALLS(I,1)/2)-40,(BALLS(I,2)/2)-70,%1100000
  358.       For Q=6 To 7
  359.          Screen 7
  360.          CL=Colour(Q)
  361.          Screen SCR
  362.          Colour Q,CL
  363.       Next 
  364.       Screen To Front SCR
  365.       Screen Offset 2,X,0
  366.       Screen To Front 2 : Multi Wait 
  367.    Until Timer>1300
  368.    Return 
  369.    '
  370.    MEGALINES:
  371.    X1=150 : X2=150
  372.    Y1=90 : Y2=100
  373.    Timer=0
  374.    XT1=4 : XT2=4
  375.    YT1=-4 : YT2=4
  376.    Rainbow 1,0,370,1
  377.    Repeat 
  378.       If Mouse Key Then Exit 
  379.       Rem **************** scroll ***************
  380.       Add NO,1,0 To 5
  381.       If NO=0
  382.          Add POS,1,0 To Len(A$)
  383.          N=Asc(Mid$(A$,POS,1))
  384.          XX=CHAR(N,1)
  385.          YY=CHAR(N,2)
  386.       End If 
  387.       Rainbow 1,Y,270+SY,26
  388.       Screen Copy 1,XX+(NO*4),YY,XX+(NO*4)+4,YY+26 To 2,X+330,0
  389.       Screen Copy 1,XX+(NO*4),YY,XX+(NO*4)+4,YY+26 To 2,X,0
  390.       Add X,4,0 To 328
  391.       Add Y,1,0 To 567
  392.       Add I,3,0 To 720
  393.       Add J,2,0 To 720
  394.       Add L,1,0 To 39
  395.       Rem ************* lines+interference ********************    
  396.       Add SCR,1,3 To 7
  397.       Screen SCR
  398.       Ink 0
  399.       Draw LINES(1,L),LINES(2,L) To LINES(3,L),LINES(4,L)
  400.       Screen Copy 0,0,0,400,256+180 To SCR,(BALLS(J,1)/2)-40,(BALLS(J,2)/2)-70
  401.       Ink 6
  402.       If X1<0 Then XT1=Rnd(4)+1
  403.       If X1>320 Then XT1=-Rnd(4)+1
  404.       If Y1>200 Then YT1=-Rnd(4)+1
  405.       If Y1<50 Then YT1=Rnd(4)+1
  406.       If X2<0 Then XT2=Rnd(4)+1
  407.       If X2>320 Then XT2=-Rnd(4)+1
  408.       If Y2>200 Then YT2=-Rnd(4)+1
  409.       If Y2<50 Then YT2=Rnd(4)+1
  410.       X1=X1+XT1
  411.       Y1=Y1+YT1
  412.       X2=X2+XT2
  413.       Y2=Y2+YT2
  414.       LINES(1,L)=X1
  415.       LINES(2,L)=Y1
  416.       LINES(3,L)=X2
  417.       LINES(4,L)=Y2
  418.       If Timer<1800
  419.          Draw LINES(1,L),LINES(2,L) To LINES(3,L),LINES(4,L)
  420.       End If 
  421.       Screen Copy 0,0,0,400,256+180 To SCR,(BALLS(I,1)/2)-40,(BALLS(I,2)/2)-70,%1100000
  422.       Screen To Front SCR
  423.       Screen To Front 2
  424.       Screen Offset 2,X,0 : Wait Vbl 
  425.    Until Timer>2000
  426.    Return 
  427.    '
  428.    MEGALINES2:
  429.    X1=150 : X2=150
  430.    Y1=90 : Y2=100
  431.    Timer=0
  432.    XT1=4 : XT2=4
  433.    YT1=-4 : YT2=4
  434.    Rainbow 1,0,370,1
  435.    Repeat 
  436.       If Mouse Key Then Exit 
  437.       Rem **************** scroll ***************
  438.       Add NO,1,0 To 5
  439.       If NO=0
  440.          Add POS,1,0 To Len(A$)
  441.          N=Asc(Mid$(A$,POS,1))
  442.          XX=CHAR(N,1)
  443.          YY=CHAR(N,2)
  444.       End If 
  445.       Rainbow 1,Y,270+SY,26
  446.       Screen Copy 1,XX+(NO*4),YY,XX+(NO*4)+4,YY+26 To 2,X+330,0
  447.       Screen Copy 1,XX+(NO*4),YY,XX+(NO*4)+4,YY+26 To 2,X,0
  448.       Add X,4,0 To 328
  449.       Add Y,1,0 To 567
  450.       Add I,3,0 To 720
  451.       Add J,2,0 To 720
  452.       Add L,1,0 To 39
  453.       Rem ************* lines+interference ********************    
  454.       Add SCR,1,3 To 7
  455.       Screen SCR
  456.       Ink 0
  457.       Draw 320-LINES(1,L),LINES(2,L) To 320-LINES(3,L),LINES(4,L)
  458.       Draw LINES(1,L),LINES(2,L) To LINES(3,L),LINES(4,L)
  459.       Screen Copy 0,0,0,400,256+180 To SCR,(BALLS(J,1)/2)-40,(BALLS(J,2)/2)-70
  460.       Ink 6
  461.       If X1<0 Then XT1=Rnd(2)+1
  462.       If X1>320 Then XT1=-Rnd(2)+1
  463.       If Y1>200 Then YT1=-Rnd(2)+1
  464.       If Y1<50 Then YT1=Rnd(2)+1
  465.       If X2<0 Then XT2=Rnd(2)+1
  466.       If X2>320 Then XT2=-Rnd(2)+1
  467.       If Y2>200 Then YT2=-Rnd(2)+1
  468.       If Y2<50 Then YT2=Rnd(2)+1
  469.       X1=X1+XT1
  470.       Y1=Y1+YT1
  471.       X2=X2+XT2
  472.       Y2=Y2+YT2
  473.       LINES(1,L)=X1
  474.       LINES(2,L)=Y1
  475.       LINES(3,L)=X2
  476.       LINES(4,L)=Y2
  477.       If Timer<1800
  478.          Ink 2
  479.          Draw 320-LINES(1,L),LINES(2,L) To 320-LINES(3,L),LINES(4,L)
  480.          Ink 6
  481.          Draw LINES(1,L),LINES(2,L) To LINES(3,L),LINES(4,L)
  482.       End If 
  483.       Screen Copy 0,0,0,400,256+180 To SCR,(BALLS(I,1)/2)-40,(BALLS(I,2)/2)-70,%1100000
  484.       Screen To Front SCR
  485.       Screen To Front 2
  486.       Screen Offset 2,X,0 : Wait Vbl 
  487.    Until Timer>2000
  488.    Return 
  489.    '
  490.    WORDS:
  491.    For I=1 To 31
  492.       Read B$,A,B
  493.       CHAR(Asc(B$),1)=A
  494.       CHAR(Asc(B$),2)=B
  495.    Next 
  496.    Data "A",0,0
  497.    Data "B",25,0
  498.    Data "C",50,0
  499.    Data "D",75,0
  500.    Data "E",100,0
  501.    Data "F",125,0
  502.    Data "G",150,0
  503.    Data "H",175,0
  504.    Data "I",200,0
  505.    Data "J",215,0
  506.    Data "K",0,25
  507.    Data "L",25,25
  508.    Data "M",50,25
  509.    Data "N",75,25
  510.    Data "O",100,25
  511.    Data "P",125,25
  512.    Data "Q",150,25
  513.    Data "R",175,25
  514.    Data "S",200,25
  515.    Data "T",225,25
  516.    Data "U",0,50
  517.    Data "V",25,50
  518.    Data "W",50,50
  519.    Data "X",75,50
  520.    Data "Y",100,50
  521.    Data "Z",125,50
  522.    Data "?",150,50
  523.    Data ",",175,50
  524.    Data ".",200,50
  525.    Data "!",225,50
  526.    Data " ",250,50
  527.    Return 
  528.    EN:
  529.    For I=0 To 7
  530.       Screen Close I
  531.    Next 
  532. End Proc
  533. Procedure _3D
  534. Load "demo:music.abk"
  535. Dim PLINES(2)
  536. Dim LINES(2)
  537. Dim X(2,35),Y(2,35),Z(2,35)
  538. Dim X2D(2,35),Y2D(2,35),X2D2(2,35)
  539. Dim XX(2,35),YY(2,35),ZZ(2,35)
  540. Dim S(2,35),E(2,35),SN#(360),CN#(360)
  541. Degree 
  542. For I=0 To 360
  543.    CN#(I)=Cos(I)
  544.    SN#(I)=Sin(I)
  545. Next 
  546. Fade 7,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
  547. Wait 7*16
  548. Music 1
  549. Rem ************ SHIT TETRAHEDON ********************  
  550. Data 5,500,500,-250,500,-500,-250,-500,-500,-250,-500,500,-250
  551. Data 0,0,250
  552. Data 8,1,2,2,3,3,4,4,1
  553. Data 1,5,2,5,3,5,4,5
  554. Rem ***************** Boring Cube ********************         
  555. Data 8,500,500,500,500,-500,500,-500,-500,500,-500,500,500
  556. Data 500,500,-500,500,-500,-500,-500,-500,-500,-500,500,-500
  557. Data 12,1,2,2,3,3,4,4,1
  558. Data 5,6,6,7,7,8,8,5
  559. Data 1,5,2,6,3,7,4,8
  560. Rem ***************** Diamond  **********************    
  561. Data 6,500,500,0,500,-500,0,-500,-500,0,-500,500,0
  562. Data 0,0,500,0,0,-500
  563. Data 12,1,2,2,3,3,4,4,1
  564. Data 1,5,2,5,3,5,4,5
  565. Data 1,6,2,6,3,6,4,6
  566. Rem ************** Dunno? ********************   
  567. Data 9,-500,0,0,500,100,0,500,-100,0,500,0,100
  568. Data 500,500,0,500,-500,0,500,0,-100,500,0,500,500,0,-500
  569. Data 16,1,2,3,1,1,4,4,3,4,2
  570. Data 1,5,5,2,1,6,6,3
  571. Data 1,7,7,2,7,3
  572. Data 1,8,8,4,1,9,9,7
  573. Rem *********** Not quite so boring Cube *************         
  574. Data 18,-300,300,0,0,300,0,-300,0,0,0,0,0,-300,-300,0,0,-300,0
  575. Data 50,300,0,300,200,0,300,-200,0,50,-300,0
  576. Data 500,500,300,500,-500,300,-500,-500,300,-500,500,300
  577. Data 500,500,-300,500,-500,-300,-500,-500,-300,-500,500,-300
  578. Data 20,1,2,3,4,5,6,2,6,7,8,8,9,9,10,10,7
  579. Data 11,12,12,13,13,14,14,11
  580. Data 15,16,16,17,17,18,18,15
  581. Data 11,15,12,16,13,17,14,18
  582. Rem ******************* Disk ***************************       
  583. Data 26,-440,460,15,440,460,15,440,-460,15,-440,-460,15
  584. Data -440,460,-15,440,460,-15,440,-460,-15,-440,-460,-15
  585. Data -360,460,15,360,460,15,360,-80,15,-360,-80,15
  586. Data 360,-460,15,360,-160,15,-240,-160,15,-240,-460,15
  587. Data 240,-460,15,240,-160,15
  588. Data -50,-420,15,-50,-180,15,-160,-180,15,-160,-420,15
  589. Data 130,0,15,-130,0,15,0,130,15,0,-130,15
  590. Data 25,1,2,2,3,3,4,4,1,5,6,6,7,7,8,8,5,1,5,2,6,3,7,4,8
  591. Data 10,11,11,12,12,9,13,14,14,15,15,16,17,18
  592. Data 19,20,20,21,21,22,22,19,23,24,25,26
  593. Rem  *************** X-Wing Fighter **********************   
  594. Data 22,200,-150,-150,200,150,-150,-400,150,-150,-400,-150,-150
  595. Data 200,-150,150,200,150,150,-400,150,150,-400,-150,150
  596. Data 1000,-100,-150,1000,100,-150
  597. Data 50,-1000,-400,-400,-1000,-400
  598. Data 50,-1000,400,-400,-1000,400
  599. Data 50,1000,-400,-400,1000,-400
  600. Data 50,1000,400,-400,1000,400
  601. Data 800,-1000,-400,800,-1000,400
  602. Data 800,1000,-400,800,1000,400
  603. Data 33,1,2,2,3,3,4,4,1
  604. Data 5,6,6,7,7,8,8,5
  605. Data 1,5,2,6,3,7,4,8
  606. Data 1,9,2,10,5,9,6,10,9,10
  607. Data 1,11,4,12,11,12
  608. Data 5,13,8,14,13,14
  609. Data 2,15,3,16,15,16
  610. Data 6,17,7,18,17,18
  611. Data 19,11,20,14
  612. Data 21,15,22,18
  613. Rem ************* Sails **********************         
  614. Data 8,100,-500,200,-100,-500,200,100,500,200,-100,500,200
  615. Data 500,100,200,500,-100,200,-500,100,200,-500,-100,200
  616. Data 8,1,2,2,3,3,4,4,1
  617. Data 5,6,6,7,7,8,8,5
  618. Rem ************* Windmill *******************       
  619. Data 17,200,800,200,200,800,-200,-200,800,-200,-200,800,200
  620. Data 100,-100,100,100,-100,-100,-100,-100,-100,-100,-100,100
  621. Data 0,-200,0
  622. Data 100,-400,200,-100,-400,200,100,500,200,-100,500,200
  623. Data 500,100,200,500,-100,200
  624. Data -500,100,200,-500,-100,200
  625. Data 16,1,2,2,3,3,4,4,1
  626. Data 5,6,6,7,7,8,8,5
  627. Data 1,5,2,6,3,7,4,8
  628. Data 9,5,9,6,9,7,9,8
  629. Rem  ************* Turret **********************   
  630. Data 16,200,150,0,200,-150,0,-200,-150,0,-200,150,0
  631. Data 200,150,100,200,-150,100,-200,-150,100,-200,150,100
  632. Data 600,20,25,600,-20,25,200,-20,25,200,20,25
  633. Data 600,20,65,600,-20,65,200,-20,65,200,20,65
  634. Data 24,1,2,2,3,3,4,4,1
  635. Data 5,6,6,7,7,8,8,5
  636. Data 1,5,2,6,3,7,4,8
  637. Data 9,10,10,11,11,12,12,9
  638. Data 13,14,14,15,15,16,16,13
  639. Data 9,13,10,14,11,15,12,16
  640. Rem ************* Tank ******************* 
  641. Data 16,500,250,0,500,-250,0,-500,-250,0,-500,250,0
  642. Data 550,250,-100,550,-250,-100,-550,-250,-100,-550,250,-100
  643. Data 500,220,-100,500,-220,-100,-500,-220,-100,-500,220,-100
  644. Data 450,220,-200,450,-220,-200,-450,-220,-200,-450,220,-200
  645. Data 24,1,2,2,3,3,4,4,1
  646. Data 5,6,6,7,7,8,8,5
  647. Data 1,5,2,6,3,7,4,8
  648. Data 9,10,10,11,11,12,12,9
  649. Data 13,14,14,15,15,16,16,13
  650. Data 9,13,10,14,11,15,12,16
  651. '
  652. Screen Open 1,320,256,2,Lowres
  653. Curs Off : Flash Off : Paper 0 : Cls 
  654. Palette 0,$F
  655. '
  656. Screen Open 0,320,256,4,Lowres
  657. Paper 0
  658. Cls 
  659. Curs Off : Flash Off : Hide On 
  660. Double Buffer : Bob Update Off : Autoback 0
  661. Fade 1,0,0,0,0
  662. Wait 1*16
  663. Fade 1,0,$F00,$F0F,$F
  664. Wait 1*16
  665. '
  666. Rem ********************* Boring Objects Anim. **********
  667. T$="Prepare for some stunning 3D .....   Get them speccys on !!!!"
  668. Gosub SCRL
  669. OBJ=0
  670. Repeat 
  671.    A=1 : B=90 : C=0
  672.    Inc OBJ
  673.    Gosub DDIM1
  674.    DISTANCE=80000
  675.    SSTEP=0
  676.    ANGLE=0
  677.    Repeat 
  678.       If SSTEP>126 Then DISTANCE=DISTANCE+3000
  679.       If SSTEP<13 Then DISTANCE=DISTANCE-4700
  680.       Inc SSTEP
  681.       ROT=1
  682.       Add A,1,0 To 359
  683.       Add B,1,0 To 359
  684.       Add C,2,0 To 358
  685.       Gosub ARRAY
  686.       SPHI#=SN#(A) : CPHI#=CN#(A)
  687.       Gosub XROT
  688.       SPHI#=SN#(B) : CPHI#=CN#(B)
  689.       Gosub YROT
  690.       SPHI#=SN#(C) : CPHI#=CN#(C)
  691.       Gosub ZROT
  692.       Gosub CONV_2D
  693.       Gosub ODRAW
  694.    Until SSTEP=150
  695.    If OBJ=1 Then T$=" A Simple Tetrahedron, how Boring ...."
  696.    If OBJ=2 Then T$=" A Cube, not much better ......"
  697.    If OBJ=3 Then T$=" "
  698.    If OBJ=4 Then T$=" "
  699.    If OBJ=5 Then T$=" If these objects look a bit slow, Remember everything is being drawn twice  "
  700.    If OBJ=6 Then T$=" Now for something really Impressive, Go Luke Skywalker !! "
  701.    Gosub SCRL
  702. Until OBJ=6
  703. '
  704. Rem ****************** X-Wing Anim. ********** 
  705. A=0 : B=80 : C=90
  706. Gosub DDIM1
  707. DISTANCE=80000
  708. SSTEP=0
  709. ANGLE=0
  710. Repeat 
  711.    If SSTEP>70 Then DISTANCE=DISTANCE+1000
  712.    If SSTEP<12 Then DISTANCE=DISTANCE-5000
  713.    Inc SSTEP
  714.    ROT=1
  715.    If SSTEP>13 and SSTEP<70
  716.       Add A,6,0 To 354
  717.       Add B,4,0 To 356
  718.       Add C,2,0 To 358
  719.    End If 
  720.    If SSTEP>70
  721.       DX=DX-15
  722.       DY=DY-5
  723.    End If 
  724.    Gosub ARRAY
  725.    SPHI#=SN#(A) : CPHI#=CN#(A)
  726.    Gosub XROT
  727.    SPHI#=SN#(B) : CPHI#=CN#(B)
  728.    Gosub YROT
  729.    SPHI#=SN#(C) : CPHI#=CN#(C)
  730.    Gosub ZROT
  731.    Gosub CONV_2D
  732.    Gosub ODRAW
  733. Until SSTEP=90
  734. T$="  And now, an amazing Windwill ......."
  735. Gosub SCRL
  736. '  
  737. DX=0 : DY=0
  738. Rem ********************** Windmill Anim. *******************  
  739. DISTANCE=80000
  740. Gosub DDIM2
  741. A=0
  742. SSTEP=0
  743. Repeat 
  744.    If SSTEP>270 Then DISTANCE=DISTANCE+3000
  745.    If SSTEP<13 Then DISTANCE=DISTANCE-5000
  746.    Inc SSTEP
  747.    Add A,4,0 To 356
  748.    CPHI#=CN#(A)
  749.    SPHI#=SN#(A)
  750.    For NO=1 To PLINES(1)
  751.       XX(1,NO)=X(1,NO)
  752.       YY(1,NO)=Y(1,NO)
  753.       ZZ(1,NO)=Z(1,NO)
  754.    Next 
  755.    ROT=1
  756.    Gosub ZROT
  757.    Gosub ZROT
  758.    If SSTEP>178
  759.       Gosub XROT
  760.    End If 
  761.    If SSTEP>89
  762.       Gosub YROT
  763.    End If 
  764.    If SSTEP>178
  765.       Gosub ZROT
  766.    End If 
  767.    For NO=1 To PLINES(2)
  768.       XX(2,NO)=X(2,NO)
  769.       YY(2,NO)=Y(2,NO)
  770.       ZZ(2,NO)=Z(2,NO)
  771.    Next 
  772.    ROT=2
  773.    If SSTEP>178
  774.       Gosub XROT
  775.    End If 
  776.    If SSTEP>89
  777.       Gosub YROT
  778.    End If 
  779.    If SSTEP>178
  780.       Gosub ZROT
  781.    End If 
  782.    Gosub CONV_2D
  783.    Gosub ODRAW
  784. Until SSTEP=300
  785. T$=" And now the Finale ......"
  786. Gosub SCRL
  787. '
  788. Rem ****************** Tank Anim. **********   
  789. A=0 : B=80 : C=90 : T=0
  790. Gosub DDIM2
  791. DISTANCE=80000
  792. SSTEP=0
  793. ANGLE=0
  794. Repeat 
  795.    If SSTEP<13 Then DISTANCE=DISTANCE-5000
  796.    Inc SSTEP
  797.    If SSTEP>138
  798.    For NO=1 To PLINES(1)
  799.       X(1,NO)=X(1,NO)+Rnd(100)
  800.       Y(1,NO)=Y(1,NO)+Rnd(100)
  801.       Z(1,NO)=Z(1,NO)+Rnd(100)
  802.    Next 
  803.    For NO=1 To PLINES(2)
  804.       X(2,NO)=X(2,NO)+Rnd(100)
  805.       Y(2,NO)=Y(2,NO)+Rnd(100)
  806.       Z(2,NO)=Z(2,NO)+Rnd(100)
  807.    Next 
  808.    End If 
  809.    For NO=1 To PLINES(1)
  810.       XX(1,NO)=X(1,NO)
  811.       YY(1,NO)=Y(1,NO)
  812.       ZZ(1,NO)=Z(1,NO)
  813.    Next 
  814.    ROT=1
  815.    If SSTEP>13 and SSTEP<102
  816.       Add A,4,0 To 356
  817.       Add B,4,0 To 356
  818.       Add C,4,0 To 356
  819.    End If 
  820.    If SSTEP>102 and SSTEP<138
  821.      Add T,2
  822.    End If 
  823.    CPHI#=CN#(T) : SPHI#=SN#(T) : Gosub ZROT
  824.    CPHI#=CN#(A) : SPHI#=SN#(A) : Gosub XROT
  825.    CPHI#=CN#(B) : SPHI#=SN#(B) : Gosub YROT
  826.    CPHI#=CN#(C) : SPHI#=SN#(C) : Gosub ZROT
  827.    For NO=1 To PLINES(2)
  828.       XX(2,NO)=X(2,NO)
  829.       YY(2,NO)=Y(2,NO)
  830.       ZZ(2,NO)=Z(2,NO)
  831.    Next 
  832.    ROT=2
  833.    CPHI#=CN#(A) : SPHI#=SN#(A) : Gosub XROT
  834.    CPHI#=CN#(B) : SPHI#=SN#(B) : Gosub YROT
  835.    CPHI#=CN#(C) : SPHI#=SN#(C) : Gosub ZROT
  836.    Gosub CONV_2D
  837.    Gosub ODRAW
  838. Until SSTEP=160
  839. Goto ND
  840. '
  841. CONV_2D:
  842. For I=1 To 2
  843.    For NO=1 To PLINES(I)
  844.       X2D(I,NO)=(XX(I,NO)*2500)/(DISTANCE-ZZ(I,NO))
  845.       Y2D(I,NO)=(YY(I,NO)*2500)/(DISTANCE-ZZ(I,NO))
  846.       X2D2(I,NO)=X2D(I,NO)-ZZ(I,NO)/100-(4-(DISTANCE/4000))
  847.    Next 
  848. Next 
  849. Return 
  850. '
  851. ODRAW:
  852. Screen 1
  853. Cls 
  854. Screen 0
  855. Cls 
  856. D=15-((DISTANCE/5000)-3)
  857. If D>15 Then D=15
  858. If D<0 Then D=0
  859. Colour 3,(D/2)*256
  860. Colour 2,((D/2)*256)+D
  861. Colour 1,D
  862. For I=1 To 2
  863.    For NO=1 To LINES(I)
  864.       Ink 3
  865.       S=S(I,NO) : E=E(I,NO)
  866.       Draw X2D(I,S)+150+DX,Y2D(I,S)+100+DY To X2D(I,E)+150+DX,Y2D(I,E)+100+DY
  867.       Screen 1
  868.       Ink 1
  869.       Draw X2D2(I,S)+150+DX,Y2D(I,S)+100+DY To X2D2(I,E)+150+DX,Y2D(I,E)+DY+100
  870.       Screen 0
  871.    Next 
  872. Next 
  873. Screen Copy 1,0,0,320,256 To 0,0,0,%1100000
  874. Ink 0 : Plot 150+DX,100+DY
  875. Screen Swap 
  876. Return 
  877. '
  878. XROT:
  879. For NO=1 To PLINES(ROT)
  880.    Y=YY(ROT,NO) : Z=ZZ(ROT,NO)
  881.    YY(ROT,NO)=Y*CPHI#-Z*SPHI#
  882.    ZZ(ROT,NO)=Z*CPHI#+Y*SPHI#
  883. Next 
  884. Return 
  885. '
  886. YROT:
  887. For NO=1 To PLINES(ROT)
  888.    X=XX(ROT,NO) : Z=ZZ(ROT,NO)
  889.    XX(ROT,NO)=X*CPHI#-Z*SPHI#
  890.    ZZ(ROT,NO)=Z*CPHI#+X*SPHI#
  891. Next 
  892. Return 
  893. '  
  894. ZROT:
  895. For NO=1 To PLINES(ROT)
  896.    X=XX(ROT,NO) : Y=YY(ROT,NO)
  897.    XX(ROT,NO)=X*CPHI#-Y*SPHI#
  898.    YY(ROT,NO)=Y*CPHI#+X*SPHI#
  899. Next 
  900. Return 
  901. '  
  902. DDIM2:
  903. Read P
  904. For NO=1 To P
  905.    Read X(1,NO),Y(1,NO),Z(1,NO)
  906. Next 
  907. PLINES(1)=P
  908. Read L
  909. For NO=1 To L
  910.    Read S(1,NO),E(1,NO)
  911. Next 
  912. LINES(1)=L
  913. Read P
  914. For NO=1 To P
  915.    Read X(2,NO),Y(2,NO),Z(2,NO)
  916. Next 
  917. PLINES(2)=P
  918. Read L
  919. For NO=1 To L
  920.    Read S(2,NO),E(2,NO)
  921. Next 
  922. LINES(2)=L
  923. Return 
  924. '
  925. DDIM1:
  926. Read P
  927. For NO=1 To P
  928.    Read X(1,NO),Y(1,NO),Z(1,NO)
  929. Next 
  930. PLINES(1)=P
  931. Read L
  932. For NO=1 To L
  933.    Read S(1,NO),E(1,NO)
  934. Next 
  935. LINES(1)=L
  936. PLINES(2)=0 : LINES(2)=0
  937. Return 
  938. '
  939. ARRAY:
  940. For NO=1 To PLINES(1)
  941.    XX(1,NO)=X(1,NO)
  942.    YY(1,NO)=Y(1,NO)
  943.    ZZ(1,NO)=Z(1,NO)
  944. Next 
  945. Return 
  946. '  
  947. ANGLES:
  948. S#=(0.111111-0.1)/360
  949. S#=0.1+(S#*ANGLE)
  950. CPHI#=Cos(Pi#/S#)
  951. SPHI#=Sin(Pi#/S#)
  952. Return 
  953. '  
  954. SCRL:
  955. Ink 2
  956. Cls : Screen Swap : Cls 
  957. Colour 2,$F0F
  958. Def Scroll 1,0,220 To 320,240,-4,0
  959. T$=T$+"                                            "
  960. For POS=1 To Len(T$)
  961.    Locate 39,29
  962.    Print Mid$(T$,POS,1)
  963.    Scroll 1
  964.    Screen Swap 
  965.    Locate 39,29
  966.    Print Mid$(T$,POS,1)
  967.    Scroll 1
  968.    Screen Swap 
  969.    Scroll 1 : Screen Swap : Wait Vbl 
  970.    Scroll 1 : Screen Swap : Wait Vbl 
  971. Next 
  972. Return 
  973. '
  974. ND:
  975. Screen Close 0
  976. Screen Close 1
  977. Erase 3
  978. End Proc