home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / subroutines / sample_bank_maker.amos / sample_bank_maker.amosSourceCode
AMOS Source Code  |  1999-12-25  |  8KB  |  331 lines
  1. '                            AMOS Sample Bank Maker  
  2. '
  3. '                      Original routine by Francois Lionet     
  4. '
  5. ' Altered to take Audiomaster samples and to eliminate header data   
  6. ' from other iff-samples (Sarv. Engelhardt, 1991)
  7. '
  8. ' You may increase the storage capacity of this program by changing
  9. ' the size of the text buffer
  10. Set Buffer 40
  11. Default 
  12. Close Editor 
  13. Dir$="df1:"
  14. Dim S$(20),F$(20),F(20),TYPE(20)
  15. Dim LINE$(5),BUTTON$(3)
  16. NSAM=0 : L0ADED_SAMPLES=False
  17. Global S$(),F$(),F(),LINE$(),BUTTON$(),NSAM,TYPE(),L0ADED_SAMPLES
  18. SET_UP_SCREEN
  19. On Menu Proc MENU_1,MENU_2
  20. Repeat 
  21.    On Menu On 
  22. Until False
  23. Procedure MAKE_AMOS_BANK
  24.    On Error Goto FATEL_ERROR1
  25.    Cls 
  26.    F$=Fsel$("*.*","Samples.Abk","Please pick a save name.....")
  27.    If F$<>""
  28.       Bell 
  29.       Centre At(,7)+Border$("Please wait while I convert the samples.....",1)
  30.       Print At(36,10);Border$("SAMPLE:    ",1)
  31.       TL=2 : TN=0
  32.       For N=1 To NSAM
  33.          If Len(S$(N))<>0
  34.             Inc TN
  35.             TL=TL+Len(S$(N))+4+14
  36.          End If 
  37.       Next 
  38.       Erase 10
  39.       Reserve As Work 10,TL+12+8
  40.       AD=Start(10)
  41.       A$="AmBk"
  42.       For X=1 To Len(A$)
  43.          Poke AD+X-1,Asc(Mid$(A$,X,1))
  44.       Next X
  45.       AD=AD+4
  46.       Doke AD,5
  47.       AD=AD+2
  48.       Doke AD,0
  49.       AD=AD+2
  50.       Loke AD,(TL+8) or $80000000
  51.       AD=AD+4
  52.       A$="Samples "
  53.       For X=1 To Len(A$)
  54.          Poke AD+X-1,Asc(Mid$(A$,X,1))
  55.       Next X
  56.       AD=AD+8
  57.       ACALC=AD
  58.       Doke AD,TN
  59.       AD=AD+2
  60.       AOFF=AD
  61.       APOKE=AOFF+TN*4
  62.       For N=1 To NSAM
  63.          If TYPE(N)=2
  64.             WEIGHTING=-128
  65.          Else 
  66.             WEIGHTING=0
  67.          End If 
  68.          If S$(N)<>""
  69.             Print At(44,10);N;
  70.             Loke AOFF,APOKE-ACALC
  71.             AOFF=AOFF+4
  72.             A$=Left$(F$(N),8)
  73.             AD=APOKE
  74.             For X=1 To Len(A$)
  75.                Poke AD+X-1,Asc(Mid$(A$,X,1))
  76.             Next X
  77.             FREQ=F(N)
  78.             Doke APOKE+8,FREQ
  79.             Loke APOKE+10,Len(S$(N))
  80.             APOKE=APOKE+14
  81.             A=Varptr(S$(N))
  82.             PP=Varptr(P)
  83.             For X=0 To Len(S$(N))-1
  84.                P=Peek(A+X)+WEIGHTING
  85.                Poke APOKE+X,Peek(PP+3)
  86.             Next X
  87.             APOKE=APOKE+Len(S$(N))
  88.             If Btst(0,APOKE)
  89.                Inc APOKE
  90.             End If 
  91.          End If 
  92.       Next N
  93.       Cls 
  94.       Bell 
  95.       If Right$(Upper$(F$),4)<>".ABK"
  96.          F$=F$+".Abk"
  97.       End If 
  98.       Centre At(,8)+Border$("Saving new sample bank.....",1)
  99.       Bsave F$,Start(10) To Start(10)+TL+12+8
  100.    End If 
  101.    RECOVER_1:
  102.    DISPLAY_SAMS
  103.    Pop Proc
  104.    FATEL_ERROR1:
  105.    For LOP=1 To 5
  106.       Bell 30-LOP
  107.       Wait 3
  108.    Next LOP
  109.    If Errn=26
  110.       Erase 10
  111.       LINE$(0)="I'm out of Memory!"
  112.    Else 
  113.       LINE$(0)="Woops, disc error!"
  114.    End If 
  115.    BUTTON$(0)="Never mind."
  116.    ALERT[21,7,0,1,1,1]
  117.    Resume RECOVER_1
  118. End Proc
  119. Procedure L0AD_SAMPLE
  120.    On Error Goto FATEL_ERROR2
  121.    Inc NSAM
  122.    F$(NSAM)=Fsel$("","","Please choose a sample to load")
  123.    If Not Exist(F$(NSAM))
  124.       For LOP=1 To 5
  125.          Bell 30-LOP
  126.          Wait 3
  127.       Next LOP
  128.       LINE$(0)="I cannot find that"
  129.       LINE$(1)="file on this disc!"
  130.       BUTTON$(0)="Woops......."
  131.       ALERT[21,7,0,1,1,2]
  132.       F$(NSAM)=""
  133.    Else 
  134.       Open In 1,F$(NSAM)
  135.       If Lof(1)<Free
  136.          S$(NSAM)=Input$(1,Lof(1))
  137.          Add MEM,-Lof(1)
  138.          Close 
  139.          If Left$(S$(NSAM),3)="JON"
  140.             F(NSAM)=Peek(Varptr(S$(NSAM))+3)
  141.             F(NSAM)=F(NSAM)*1000
  142.             S$(NSAM)=Mid$(S$(NSAM),4)
  143.             TYPE(NSAM)=2
  144.          Else 
  145.             Cls 
  146.             Clear Key : AFL=0
  147.             L=Len(S$(NSAM))
  148.             For I=1 To L
  149.                A$=Mid$(S$(NSAM),I,5)
  150.                If A$="Audio" : AFL=1 : Exit : End If 
  151.             Next I
  152.             If AFL=1
  153.                F(NSAM)=Deek(Varptr(S$(NSAM))+32)
  154.                TYPE(NSAM)=3
  155.             Else 
  156.                Input At(0,12)+"Please enter sampling frequency:";F(NSAM)
  157.                If F(NSAM)<1000 or F(NSAM)>32000
  158.                   F(NSAM)=15000
  159.                End If 
  160.                TYPE(NSAM)=1
  161.             End If 
  162.             For I=1 To L
  163.                A$=Mid$(S$(NSAM),I,4)
  164.                Exit If A$="BODY"
  165.             Next I
  166.             A$=Right$(S$(NSAM),L-I-7)
  167.             S$(NSAM)=A$
  168.             Cls 
  169.          End If 
  170.          If(1 and Len(S$(NSAM)))
  171.             S$(NSAM)=S$(NSAM)+Right$(S$(NSAM),1)
  172.          End If 
  173.          F$(NSAM)=Right$(F$(NSAM),Len(F$(NSAM))-4)
  174.          DISPLAY_SAMS
  175.          L0ADED_SAMPLES=True
  176.       Else 
  177.          LINE$(0)="Sorry, you do not have enough free"
  178.          LINE$(1)="    memory to load this sample.   "
  179.          BUTTON$(0)="Memory expansion time"
  180.          ALERT[40,7,0,1,1,2]
  181.       End If 
  182.    End If 
  183.    RECOVER_2:
  184.    Close 
  185.    Pop Proc
  186.    FATEL_ERROR2:
  187.    If FILE$<>""
  188.       For LOP=1 To 5
  189.          Bell 30-LOP
  190.          Wait 3
  191.       Next LOP
  192.       LINE$(0)="Woops, disc error!"
  193.       BUTTON$(0)="Never mind."
  194.       ALERT[21,7,0,1,1,1]
  195.       Dec NSAM
  196.       FILE$=""
  197.    End If 
  198.    Resume RECOVER_2
  199. End Proc
  200. Procedure DISPLAY_SAMS
  201.    Cls 
  202.    Curs Off 
  203.    Inverse On 
  204.    Print At(0,0);"| Sample |       Sample name      |   Length   |  Frequency  |  Sample Type  |";
  205.    Inverse Off 
  206.    Under On 
  207.    For LOP=1 To NSAM
  208.       Print At(0,LOP);"|        |                        |            |             |               |";
  209.       Print At(3,LOP);LOP;At(11,LOP);Left$(F$(LOP),21);At(36,LOP); Using "#######";Len(S$(LOP))
  210.       Print At(52,LOP); Using "#####";F(LOP)
  211.       If TYPE(LOP)=1
  212.          Print At(68,LOP);"RAW";
  213.       End If 
  214.       If TYPE(LOP)=2
  215.          Print At(63,LOP);"STOS  MAESTRO";
  216.       End If 
  217.       If TYPE(LOP)=3
  218.          Print At(63,LOP);"AUDIO MASTER";
  219.       End If 
  220.       If Inkey$<>""
  221.          Wait Key 
  222.       End If 
  223.    Next LOP
  224.    Under Off 
  225.    Print 
  226.    Inverse On 
  227.    Centre "Free memory:"+Str$(Free)
  228.    Inverse Off 
  229. End Proc
  230. Procedure SET_UP_SCREEN
  231.    Screen Open 1,640,200,2,Hires
  232.    Colour 1,$FFF : Flash Off : Curs Off : Cls 0
  233.    Paper 0
  234.    Pen 1
  235.    Menu$(1)=" AMOS  "
  236.    Menu$(1,1)=" About "
  237.    Menu$(1,2)="=======" : Menu Inactive(1,2)
  238.    Menu$(1,3)=" Quit  "
  239.    Menu$(2)=" Edit "
  240.    Menu$(2,1)=" Load sample.      "
  241.    Menu$(2,2)="===================" : Menu Inactive(2,2)
  242.    Menu$(2,3)=" Save sample bank. "
  243.    Menu$(2,4)="===================" : Menu Inactive(2,4)
  244.    Menu$(2,5)=" Erase all samples."
  245.    DEF_SETTING
  246.    Reserve Zone 1
  247.    Menu On 
  248. End Proc
  249. Procedure DEF_SETTING
  250.    Cls 
  251.    For LOP=1 To NSAM
  252.       S$(LOP)=""
  253.       F$(LOP)=""
  254.       F(LOP)=0
  255.       TYPE(LOP)=0
  256.    Next LOP
  257.    L0ADED_SAMPLES=False
  258.    NSAM=0
  259.    Centre At(,7)+"AMOS SAMPLE BANK MAKER"
  260.    Centre At(,9)+"By P.J.Hickman"
  261.    Inverse On 
  262.    Centre At(,12)+"Free memory:"+Str$(Free)
  263.    Inverse Off 
  264.    Centre At(,16)+Border$("Click right mouse button to display menu",1)
  265.    Repeat : Until Mouse Click
  266. End Proc
  267. Procedure ALERT[W,H,BACK_COL,LINE_COL,NB,NL]
  268.    Menu Off 
  269.    TEMP=0
  270.    W=W*8
  271.    H=H*8
  272.    X=(Screen Width/2)-W/2
  273.    Y=4
  274.    Get Block 241,0,Y-2,Screen Width,H+6
  275.    Ink BACK_COL
  276.    Bar X,Y-2 To X+W,Y+H
  277.    Ink LINE_COL
  278.    Box X+1,Y-2 To X+W-1,Y+H-1
  279.    S=W/8/(NB+1)+1
  280.    Paper BACK_COL
  281.    Pen LINE_COL
  282.    For LOP=0 To NL
  283.       Locate 0,Y Text(Y)+1+LOP
  284.       Centre LINE$(LOP)
  285.    Next LOP
  286.    TEMP=0
  287.    While TEMP<>NB
  288.       Locate X Text(X)+S/2+S*TEMP,Y Text(Y+H)-2
  289.       Print Border$(Zone$(BUTTON$(TEMP),TEMP+1),2);
  290.       Inc TEMP
  291.    Wend 
  292.    TEMP=0
  293.    Repeat 
  294.       Repeat : Until Mouse Click and Mouse Key=1
  295.       TEMP=Mouse Zone
  296.    Until TEMP>0
  297.    Put Block 241,0,Y-2
  298.    Del Block 241
  299.    Add TEMP,-96
  300.    For LOP=0 To NB
  301.       BUTTON$(LOP)=""
  302.    Next LOP
  303.    For LOP=0 To NL
  304.       LINE$(LOP)=""
  305.    Next LOP
  306.    Menu On 
  307. End Proc[TEMP]
  308. Procedure MENU_1
  309.    Shared LINE$(),BUTTON$()
  310.    If Choice(2)=1
  311.       For LOP=1 To 10
  312.          Bell 50+LOP
  313.          Wait 3
  314.       Next LOP
  315.       LINE$(0)="Sample Bank Maker"
  316.       LINE$(1)="~~~~~~~~~~~~~~~~~"
  317.       LINE$(2)=""
  318.       LINE$(3)=" By P.J.Hickman"
  319.       BUTTON$(0)="Have Fun!!!"
  320.       ALERT[22,9,0,1,1,4]
  321.    End If 
  322.    If Choice(2)=3
  323.       Default 
  324.       End 
  325.    End If 
  326. End Proc
  327. Procedure MENU_2
  328.    If Choice(2)=1 Then L0AD_SAMPLE
  329.    If L0ADED_SAMPLES and Choice(2)=3 Then MAKE_AMOS_BANK
  330.    If Choice(2)=5 Then DEF_SETTING
  331. End Proc