home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / demos / birds-of-prey.amos / birds-of-prey.amosSourceCode
AMOS Source Code  |  1990-12-02  |  7KB  |  311 lines
  1. Rem ************************************ 
  2. Rem *                                  * 
  3. Rem *        BIRDS OF PREY DEMO        * 
  4. Rem *                                  * 
  5. Rem *           WRITTEN  FOR           * 
  6. Rem *                                  * 
  7. Rem *          SANDRA SHARKEY          * 
  8. Rem *                                  * 
  9. Rem ************************************ 
  10. Close Workbench 
  11. Close Editor 
  12. Dir$="df0:"
  13. Screen Close 0
  14. Auto View On 
  15. Rainbow 0,0,0,0
  16. Rainbow Del 0
  17. Get Disc Fonts 
  18. SETUP:
  19. Global MEG,PLACE,NO,T$
  20. If Fast Free>0 or Chip Free>500000 Then MEG=1 Else MEG=0
  21. Led Off 
  22. SSCROLL
  23. Erase 8
  24. INFO
  25. For V=60 To 0 Step -1
  26.    Volume V
  27.    Wait 2
  28. Next V
  29. If MEG=1 Then Erase 3
  30. Music Off 
  31. Volume 63
  32. If MEG=1 Then Load "BirdMusic.Abk"
  33. If MEG=0 Then Screen Close 0
  34. Screen Open 1,320,256,4096,Lowres
  35. Hide On 
  36. Colour 1,$0 : Curs Off 
  37. Load "Startpic.Abk",10
  38. If MEG=0 Then Unpack 10 To 1 Else Unpack 10 To 0
  39. Erase 10
  40. Music 1
  41. Wait 50
  42. MEGDISPLAY
  43. FINISH
  44. Goto SETUP
  45. '************************************* 
  46. '*         END OF PROGRAMME          * 
  47. '************************************* 
  48. Procedure DISPLAY
  49.    Do 
  50.       For COUNT=1 To 8
  51.          If Mouse Key=1 Then Pop Proc
  52.          Read A
  53.          T$="Birds/Bird"+Str$(A)+".Abk"
  54.          T$=T$-" "
  55.          Load T$,10
  56.          Unpack 10 To 1
  57.          Erase 10
  58.          Wait 50
  59.       Next COUNT
  60.       Data 1,2,3,4,6,7,8,9
  61.       If MEG=0
  62.          Load "StartPic.Abk",10
  63.          Unpack 10 To 1
  64.          Erase 10
  65.          Wait 50
  66.       End If 
  67.       Restore 
  68.    Loop 
  69. End Proc
  70. Procedure MEGDISPLAY
  71.    Do 
  72.       For COUNT=1 To 8
  73.          If Mouse Key=1 Then Pop Proc
  74.          Read A
  75.          T$="Birds/Bird"+Str$(A)+".Abk"
  76.          T$=T$-" "
  77.          Load T$,10
  78.          LIFT
  79.          Unpack 10 To 1
  80.          Screen Display 1,135,45-270,,
  81.          Erase 10
  82.          DROP
  83.          Wait 50
  84.       Next COUNT
  85.       If MEG=0
  86.          Load "StartPic.Abk",10
  87.          LIFT
  88.          Unpack 10 To 1
  89.          Screen Display 1,135,45-270,,
  90.          Erase 10
  91.          DROP
  92.          Wait 50
  93.       End If 
  94.       Restore 
  95.    Loop 
  96.    Data 1,2,3,4,6,7,8,9
  97. End Proc
  98. Procedure SSCROLL
  99.    Load "Winter.Abk"
  100.    Load "MegadethFont.Abk",8
  101.    Screen Open 0,320,256,32,Lowres
  102.    Colour 0,$0 : Colour 1,$0 : Colour 2,$0
  103.    Curs Off : Hide On 
  104.    Dim X$(48),X(48),Y(48),XX(20),YY(20),O(4)
  105.    SCNT=1
  106.    CNT=31
  107.    SC$="...........WELCOME TO ANOTHER DEMONSTRATION OF THE DIGITISING "
  108.    SC$=SC$+"SERVICE BY WEIRD SCIENCE..........CONTACT US ON THE ABOVE NUMBER "
  109.    SC$=SC$+"TO DISCUSS YOUR REQUIREMENTS.............A BRIEF RUNDOWN OF THE "
  110.    SC$=SC$+"SERVICE AND COSTS FOLLOWS, IF YOU WISH TO QUIT THIS SCREEN PRESS THE "
  111.    SC$=SC$+"LEFT MOUSE BUTTON !!!!......GOOD YOU ARE STILL WITH ME......."
  112.    SC$=SC$+"WEIRD SCIENCE CAN DIGITISE ANY PICTURES FROM ANY VIDEO OF YOUR "
  113.    SC$=SC$+"CHOICE IN 4096 COLOURS......ON EACH DISK WE PUT UPWARDS OF 10 "
  114.    SC$=SC$+"PICTURES IN COMPACTED MEMORY BANKS OR JUST IFF FORMAT......."
  115.    SC$=SC$+"SOUNDS OR MUSIC FROM THE VIDEOS CAN BE INCLUDED ON A SEPARATE "
  116.    SC$=SC$+"DISK..........FOR THIS WE CHARGE ONLY TWO POUNDS AND FIFTY "
  117.    SC$=SC$+"PENCE PER DISK !!!!!!!........THIS CHARGE IS FULLY INCLUSIVE FOR "
  118.    SC$=SC$+"ALL AREAS WITHIN THE UNITED KINGDOM..........SIT BACK AND ENJOY "
  119.    SC$=SC$+"BIRDS OF PREY................"
  120.    SC$=SC$+"                     "
  121.    Unpack 8 To 0
  122.    Screen Open 1,354,Screen Height,32,Lowres
  123.    Screen Display 1,134,43,319,256
  124.    Screen To Front 1
  125.    Def Scroll 1,1,223 To 353,255,-4,0
  126.    Curs Off 
  127.    Cls 0
  128.    Flash Off 
  129.    Get Palette 0
  130.    SCRL$="ABCDEFGHIJKLMNOPQRSTUVWXYZ.,-+!?()':;0123456789 "
  131.    Gosub PIXD
  132.    Wait Vbl 
  133.    Hide On 
  134.    Curs Off 
  135.    Music 1
  136.    Screen Copy 0,110,166,226,195 To 1,105,10
  137.    Screen Copy 0,234,170,302,189 To 1,135,40
  138.    Screen Copy 0,0,192,106,256 To 1,110,70
  139.    Screen Copy 0,115,197,278,215 To 1,80,120
  140.    TEL:
  141.    TEL$="0530 242233"
  142.    POS=100
  143.    For N=1 To 4
  144.       E$=Mid$(TEL$,N,1)
  145.       E=Instr(SCRL$,E$)
  146.       Screen Copy 0,X(E),Y(E),X(E)+31,Y(E)+31 To 1,POS,140
  147.       POS=POS+32
  148.    Next N
  149.    POS=38
  150.    For N=5 To Len(TEL$)
  151.       E$=Mid$(TEL$,N,1)
  152.       E=Instr(SCRL$,E$)
  153.       Screen Copy 0,X(E),Y(E),X(E)+31,Y(E)+31 To 1,POS,175
  154.       POS=POS+32
  155.    Next N
  156.    Wait 100
  157.    Goto STEXT
  158.    PIXD:
  159.    For F=1 To 48
  160.       Read X$(F),X(F),Y(F)
  161.    Next F
  162.    Return 
  163.    Data "A",0,0
  164.    Data "B",33,0
  165.    Data "C",66,0
  166.    Data "D",99,0
  167.    Data "E",132,0
  168.    Data "F",165,0
  169.    Data "G",198,0
  170.    Data "H",231,0
  171.    Data "I",264,0
  172.    Data "J",0,33
  173.    Data "K",33,33
  174.    Data "L",66,33
  175.    Data "M",99,33
  176.    Data "N",132,33
  177.    Data "O",165,33
  178.    Data "P",198,33
  179.    Data "Q",231,33
  180.    Data "R",264,33
  181.    Data "S",0,66
  182.    Data "T",33,66
  183.    Data "U",66,66
  184.    Data "V",99,66
  185.    Data "W",132,66
  186.    Data "X",165,66
  187.    Data "Y",198,66
  188.    Data "Z",231,66
  189.    Data ".",264,66
  190.    Data ",",0,99
  191.    Data "-",66,99
  192.    Data "+",99,99
  193.    Data "!",132,99
  194.    Data "?",165,99
  195.    Data "(",198,99
  196.    Data ")",231,99
  197.    Data "'",264,99
  198.    Data ":",0,132
  199.    Data ";",33,132
  200.    Data "0",66,132
  201.    Data "1",99,132
  202.    Data "2",132,132
  203.    Data "3",166,132
  204.    Data "4",198,132
  205.    Data "5",231,132
  206.    Data "6",264,132
  207.    Data "7",0,165
  208.    Data "8",33,165
  209.    Data "9",66,165
  210.    Data " ",285,224
  211.    Rem
  212.    Rem ********* SCROLL TEXT ROUTINE ********** 
  213.    STEXT:
  214.    Scroll 1
  215.    Add CNT,4
  216.    If CNT>31
  217.       E$=Mid$(SC$,SCNT,1)
  218.       E=Instr(SCRL$,E$)
  219.       Screen Copy 0,X(E),Y(E),X(E)+31,Y(E)+31 To 1,320,223
  220.       CNT=0 : Inc SCNT
  221.    End If 
  222.    If SCNT>Len(SC$) Then Goto EXIDEMO
  223.    If Mouse Key=1 Then Goto EXIDEMO
  224.    Wait Vbl 
  225.    Goto STEXT
  226.    EXIDEMO:
  227.    Screen Hide 0
  228.    XW=1 : YW=1 : XS=134 : YS=43
  229.    Amal Off 
  230.    DDD:
  231.    Screen Display 1,XS,YS,319-XW,256-YW
  232.    Rem YS=YS+1
  233.    Rem If XW<319 Then XW=XW+1 
  234.    If YW<255 Then YW=YW+1
  235.    If YW>=255 Then Goto FFF
  236.    Goto DDD
  237.    FFF:
  238.    Cls 0
  239.    Screen Close 1
  240.    Screen Close 0
  241. End Proc
  242. Procedure DROP
  243.    Channel 0 To Screen Display 1
  244.    Amal 0,"Move 0,268,134"
  245.    Amal On 
  246.    Wait 150
  247. End Proc
  248. Procedure LIFT
  249.    Channel 1 To Screen Display 1
  250.    Amal 1,"Move 0,-270,135"
  251.    Amal On 
  252.    Wait 150
  253. End Proc
  254. Procedure INFO
  255.    Screen Open 0,320,256,32,Lowres
  256.    Colour 0, : Colour 1,$0 : Colour 2,$FFF : Colour 4,$F00
  257.    Hide On : Curs Off : Flash Off 
  258.    Set Font 1
  259.    T$="HOLD LEFT" : PLACE=30 : NO=2
  260.    TYPE
  261.    T$="MOUSE BUTTON" : PLACE=70
  262.    TYPE
  263.    T$="DOWN TO" : PLACE=110
  264.    TYPE
  265.    T$="EXIT" : PLACE=180 : NO=4
  266.    TYPE
  267. End Proc
  268. Procedure FINISH
  269.    LIFT
  270.    If MEG=1
  271.       Channel 0 To Screen Display 0
  272.       Amal 0,"Move 0,-270,135"
  273.       Amal On 
  274.       Wait 150
  275.       Screen Close 0
  276.    End If 
  277.    Screen Close 1
  278.    For V=60 To 0 Step -1
  279.       Volume V
  280.       Wait 2
  281.    Next V
  282.    Erase 3
  283.    Erase 10
  284.    Volume 63
  285.    Screen Open 0,320,256,32,Lowres
  286.    Colour 0,$0 : Colour 1,$0 : Colour 2,$FFF : Colour 4,$F00
  287.    Curs Off : Hide On : Flash Off 
  288.    Set Font 1
  289.    T$="PLEASE" : PLACE=30 : NO=4
  290.    TYPE
  291.    T$="WAIT" : PLACE=60
  292.    TYPE
  293.    T$="Re-loading" : PLACE=100 : NO=2
  294.    TYPE
  295.    T$="Main Screen" : PLACE=130
  296.    TYPE
  297. End Proc
  298. Procedure TYPE
  299.    Ink NO
  300.    L=Text Length(T$)
  301.    Text 160-L/2,PLACE,T$
  302. End Proc
  303. Rem ********************************** 
  304. Rem *                                * 
  305. Rem *     WANT SOME HAM PICTURES     * 
  306. Rem *                                * 
  307. Rem *      TAKEN FROM ANY VIDEO      * 
  308. Rem *                                * 
  309. Rem *        RING 0530 242233        * 
  310. Rem *                                * 
  311. Rem **********************************