GFA Basic LOVEPOPA's UNIVERSE
of FREE Atari source listings !!
ACIDplus.BAS

'
'   Written in GfA-Basic v2.02
' Audio Cassette Image Designer
'   (C)opyright 8/21/1988, by
'               PKF
'       Ended on 9/18/1988
'    Last Revision: 2/10/1989
'
If Xbios(4)<>2
  Alert 3,"!!",1,"HI-REZ",Nr%
  End
Endif
Setcolor 0,0
Hidem
Acd%=Exist("ACIDPLUS.PKF")
Graphmode 2
Deftext ,1,,26
Cls
Text 49,151,"A"
Text 157,151,"C"
Text 317,151,"I"
Text 427,151,"D"
Deftext ,16,,
Text 67,150,"udio  assette  mage  esigner"
Graphmode 0
Deftext ,1,,13
Text 350,350,"PKF"
Deftext ,0,,
Text 150,350,"Idea & Programming by:"
Repeat
Until Mousek Or Inkey$<>""
Cls
Sdpoke &H4EE,&HFFFE !ALT+HELP
Showm
Setcolor 0,1
Openw 0
N%=59
Nn%=22
Dim M$(N%),Pm$(N%,1),Tt$(38,1)
For I%=0 To N%
  Read Pm$(I%,0)
  M$(I%)=Pm$(I%,0)
Next I%
For I%=0 To Nn%
  Read Pm$(I%,1)
Next I%
@Set_up
On Menu  Gosub Micio
Menu M$()
If Acd%=0
  Menu 18,2
Endif
@Video
P17%=0
Do
  On Menu
  If Lpeek(Menu(-1)+80) And Lpeek(Menu(-1)+368)>0 And Mousek=1
    P17%=1
  Endif
  If Menu(9)=32 And P17%=1
    P17%=2
  Endif
  If Menu(9)=34 And P17%=2
    Sget Scr$
    P17%=3
  Endif
  If Menu(9)=32 And P17%=3
    P17%=4
  Endif
  If Menu(9)=34 And P17%=4
    Sput Scr$
    P17%=0
  Endif
  If Hex$(Dpeek(&H4EE))="FFFF"
    @Get_scr
  Endif
Loop
End
Data Desk,  About ACID plus...,--------------------,1,2,3,4,5,6,
Data Options,  Load Image,  Save Image,  Print Image,-------------------
Data   Graphic Mode,  Insert 2nd Grid,-------------------,  Instructions
Data -------------------,  Quit,
Data Side A,  Dorse Titles,  Top Titles,  Song Titles,-------------------
Data   Counter,  Date,  Time,  Noise Reduction,  Dolby System,
Data Side B,  Dorse Titles,  Top Titles,  Song Titles,-------------------
Data   Counter,  Date,  Time,  Noise Reduction,  Dolby System,
Data Extras,  Image Riprist,  Leave Factor,  Margin Factor,---------------------
Data   Size Top Titles,  Size Dorse Titles,  Max Title,  Make Rear Titles
Data   Size Rear Titles,  Bottom String,  Delete Count Bar
Data ---------------------,  Greetings,,
Data Desk,  About ACID plus...,--------------------,1,2,3,4,5,6,
Data Options,  Draw a Line,  Draw a Box,  Draw a Circle,  Create Fill
Data   Set XOR mode,  Pen Width,  Create Text,  Clear Space,----------------
Data   Back,,
Procedure Video
  If Usp%=1
    Get 146+Mf%/4,40,349,328-Lf%,Cn$
  Endif
  Cls
  Box 50+Mf%,20,100+Mf%/2,310-Lf%
  Box 100+Mf%/2,20,145+Mf%/4,310-Lf%
  Box 145+Mf%/4,20,350,310-Lf%
  Box 350,20,555,310-Lf%
  Defline 3,,,
  Line 122+Mf%/2,40,122+Mf%/2,291-Lf%
  If Elct%=20
    Line 400,187-Lf%/2,554,187-Lf%/2
    Line 400,42,554,42
  Endif
  Defline 1,,,
  Line 350,165-Lf%/2,555,165-Lf%/2
  For A%=399 To 543 Step 12
    Line A%,20,A%,310-Lf%
  Next A%
  Line 351,310-Lf%,351,295-Lf%
  Line 351,165-Lf%,351,150-Lf%
  Graphmode 4
  Deftext ,,900,12
  Text 365,310-Lf%,"A"
  Text 365,165-Lf%/2,"B"
  Graphmode 0
  Deftext ,,,4
  Text 357,291-Lf%,Tt$(18,0)
  Text 366,291-Lf%,Tt$(19,0)
  Text 357,220-Lf%,"NR. "+Tt$(20,0)
  Text 366,220-Lf%,"DOLBY "+Tt$(34,0)
  Text 357,146-Lf%/2,Tt$(18,1)
  Text 366,146-Lf%/2,Tt$(19,1)
  Text 357,75-Lf%/2,"NR. "+Tt$(20,1)
  Text 366,75-Lf%/2,"DOLBY "+Tt$(34,1)
  If Max%=1
    Deftext ,,,13
    Text 385,309-Lf%,Tt$(16,0)
    Text 385,164-Lf%/2,Tt$(16,1)
    Deftext ,,,4
    Text 395,309-Lf%,Tt$(17,0)
    Text 395,164-Lf%/2,Tt$(17,1)
  Else
    Deftext ,,,6
    Text 379,309-Lf%,Tt$(16,0)
    Text 390,309-Lf%,Tt$(17,0)
    Text 379,164-Lf%/2,Tt$(16,1)
    Text 390,164-Lf%/2,Tt$(17,1)
  Endif
  Deftext ,,,4
  For I%=1 To 13
    Text 395+I%*12,163-Lf%/2,Tt$(I%,1)
    Text 395+I%*12,308-Lf%,Tt$(I%,0)
    Text 395+I%*12,39,Tt$(I%+20,1)
    Text 395+I%*12,184-Lf%/2,Tt$(I%+20,0)
  Next I%
  If Maxtit%=0
    If May%=1
      Deftext ,,2700,6
      Text 103+Mf%/2,25,Tt$(15,1)
      Text 125+Mf%/2,25,Tt$(15,0)
      Text 113+Mf%/2,25,Tt$(14,1)
      Text 135+Mf%/2,25,Tt$(14,0)
    Else
      If May%=2
        Deftext ,,2700,13
        Text 106+Mf%/2,25,Tt$(14,1)
        Text 128+Mf%/2,25,Tt$(14,0)
      Else
        Deftext ,,2700,12
        Text 105+Mf%/2,25,Tt$(14,1)
        Text 127+Mf%/2,25,Tt$(14,0)
      Endif
    Endif
  Else
    Deftext ,,2700,32
    Text 112+Mf%/2,22,Tt$(0,0)
  Endif
  If Rtmax%=1
    Deftext ,,,13
    Text 85+Mf%/2,25,Tt$(35,0)
    Text 70+Mf%/2,25,Tt$(35,1)
    Text 55+Mf%/2,25,Tt$(36,0)
  Else
    Deftext ,,,6
    Text 91+Mf%/2,25,Tt$(36,1)
    Text 82+Mf%/2,25,Tt$(37,0)
    Text 73+Mf%/2,25,Tt$(37,1)
    Text 64+Mf%/2,25,Tt$(38,0)
    Text 55+Mf%/2,25,Tt$(38,1)
  Endif
  If Usp%=2
    Put 146+Mf%/4,40,Mg$
  Else
    Put 146+Mf%/4,40,Cn$
  Endif
  Deftext ,,0,6
  Text 103+Mf%/2,308-Lf%,Tt$(0,1)
  Deftext ,,,13
Return
Procedure Micio
  Menu Off
  W%=1
  If M$(Menu(0))="  Quit"
    End
  Endif
  If Menu(0)=1
    Alert 0,"Audio Cassette Image Designer|"+Space$(11)+"P L U S | (C)opyright  21/ 8/1988, by|      PKF",1,"GREATER!",Nr%
    W%=0
  Endif
  If M$(Menu(0))="  Load Image"
    Scr$=String$(19456,Chr$(0))
    Fileselect "\*.ACD","",Pkf$
    Print Pkf$
    If Len(Pkf$)>1
      Cls
      Bload Pkf$,Varptr(Scr$)
      Put 49,39,Scr$
      W%=0
    Endif
  Endif
  If M$(Menu(0))="  Save Image"
    Scr$=""
    Get 49,39,556,331,Scr$
    Fileselect "\*.ACD","",Pkf$
    If Len(Pkf$)>1
      Pkf$=Left$(Pkf$,8)+".ACD"
      Bsave Pkf$,Varptr(Scr$),19456
    Endif
  Endif
  If M$(Menu(0))="  Print Image"
    If Out?(0)
      Hidem
      Hardcopy
      Showm
    Else
      Alert 3,"Printer not on line: |unable to print any|image but on screen.",1," SORRY ",Nr%
    Endif
    W%=0
  Endif
  If M$(Menu(0))="  Graphic Mode"
    @Graph
    W%=0
  Endif
  If M$(Menu(0))="  Insert 2nd Grid"
    Pkf%=Usp%
    Alert 3,"WARNING: choosing the �Title�|option will change the Image|Space way of using: you will|have to input all data again!",1,"IMAGE|TITLE",Usp%
    If Usp%=2
      For X%=0 To 1
        Alert 0,"Please enter all|data of grid #"+Str$(X%+1)+".|",1," OK ",Y%
        For Y%=0 To 1
          @Mk_dt(Y%)
          @Mk_tm(Y%)
          @Mk_nr(Y%)
          @Mk_dlb(Y%)
          @Top_tit(Y%)
          @Song_tit(Y%)
          @Coun_t(Y%)
        Next Y%
        If X%=0
          @Video
          Get 351,40,554,328-Lf%,Mg$
        Endif
      Next X%
      Menu 16,1
    Else
      If Usp%=1 And Pkf%<>1
        Deffill ,5,5
        Pbox 145,20,350,310-Lf%
        Deffill ,1,1
        Menu 16,0
      Else
        W%=0
      Endif
    Endif
  Endif
  If M$(Menu(0))="  Instructions"
    Sget Scr13$
    Cls
    Print
    Nr%=0
    Open "i",#1,"ACIDPLUS.PKF"
    Do
      Exit If Eof(#1)
      Line Input #1,A$
      Print Space$(4);A$
      Inc Nr%
      If Nr% Mod 21=0
        Repeat
        Until Mousek Or Inkey$<>""
        Cls
        Print
      Endif
    Loop
    Close #1
    Cls
    Sput Scr13$
  Endif
  If Menu(0)=23
    @Dor_tit(0)
  Endif
  If Menu(0)=24
    @Top_tit(0)
  Endif
  If Menu(0)=25
    @Song_tit(0)
  Endif
  If Menu(0)=27
    @Coun_t(0)
  Endif
  If Menu(0)=28
    @Mk_dt(0)
  Endif
  If Menu(0)=29
    @Mk_tm(0)
  Endif
  If Menu(0)=30
    @Mk_nr(0)
  Endif
  If Menu(0)=31
    @Mk_dlb(0)
  Endif
  If Menu(0)=34
    @Dor_tit(1)
  Endif
  If Menu(0)=35
    @Top_tit(1)
  Endif
  If Menu(0)=36
    @Song_tit(1)
  Endif
  If Menu(0)=38
    @Coun_t(1)
  Endif
  If Menu(0)=39
    @Mk_dt(1)
  Endif
  If Menu(0)=40
    @Mk_tm(1)
  Endif
  If Menu(0)=41
    @Mk_nr(1)
  Endif
  If Menu(0)=42
    @Mk_dlb(1)
  Endif
  If Menu(0)=46
    Alert 3,"WARNING: you are about to mo-|dify the Leave Factor! If you|go on, you will have to input|all your data again!",2,"CONTINUE|CANCEL",Nr%
    If Nr%=1
      Print At(1,1);Space$(79)
      Print At(1,1);"Choose Leave Factor [0..9] (actually ";Lf%/2;"): ";
      Form Input 1,Lf$
      Lf%=Val(Lf$)
      Lf%=Lf%*2
      @Top_tit(0)
      @Top_tit(1)
      @Song_tit(0)
      @Song_tit(1)
      @Dor_tit(0)
      @Dor_tit(1)
      @Mkr_tit
    Endif
  Endif
  If Menu(0)=47
    Alert 0,"Choose the Margin Factor |",1," 0 |2|4",Mf%
    Mf%=(Mf%-1)*2
  Endif
  If Menu(0)=49
    Alert 0,"Choose the size of Top Titles |",Max%,"LARGE|SMALL",Max%
  Endif
  If Menu(0)=50
    Nr%=May%
    Alert 0,"Choose size of Dorse Titles |",May%,"SMALL|MEDIUM|LARGE",May%
    If May%<>Nr%
      @Dor_tit(0)
      @Dor_tit(1)
    Endif
  Endif
  If Menu(0)=51
    Alert 0,"  Do you want to|display Max Title? |",2,"OK|CANCEL",Nr%
    If Nr%=1
      Print At(1,1);"Enter text of Max Title: ";
      Form Input 18-Int(Lf%/10),F$
      Tt$(0,0)=F$+Space$(18-Int(Lf%/10)-Len(F$))
      Maxtit%=1
      Menu 51,1
    Else
      Maxtit%=0
      Menu 51,0
    Endif
  Endif
  If Menu(0)=52
    @Mkr_tit
  Endif
  If Menu(0)=53
    Nr%=Rtmax%
    Alert 0,"Choose the size of Rear Titles|",Rtmax%,"LARGE|SMALL",Rtmax%
    If Rtmax%<>Nr%
      @Mkr_tit
    Endif
  Endif
  If Menu(0)=54
    Alert 0,"Do you want to display|  the Bottom String?",2,"OK|CANCEL",Bst%
    If Bst%=2
      W%=0
      Menu 54,0
    Else
      Print At(1,1);Space$(79)
      Print At(1,1);"Enter the Bottom String text (formatted): ";
      Form Input 5,Tt$(0,1)
      Menu 54,1
    Endif
  Endif
  If Menu(0)=55
    Alert 0,"Do you want to delete|the song count bars?|",2,"OK|CANCEL",Elct%
    If Elct%=2
      Elct%=20
      Menu 55,0
      Menu 27,3
      Menu 38,3
    Else
      Elct%=23
      Menu 55,1
      Menu 27,2
      Menu 38,2
    Endif
  Endif
  If Menu(0)=57
    Alert 0,"Program originally conceived|in English: very easy to use|with mouse interactive & GEM|functions. Special thanks to ",1," PKF ",Nr%
    W%=0
  Endif
  If M$(Menu(0))="  Create Fill"
    Alert 2,"Do you wish to use a built-in|pattern or do you wish to|create one by yourself?",1,"Built-in|Creating",Dummy%
    If Dummy%=2
      Sget Scr11$
      @Crea_pattern
      Sput Scr11$
      If Len(Fll$)>1
        Deffill ,Fll$
        Defmouse 0
        Repeat
          If Mousek=1 And Mousex>145 And Mousex<350 And Mousey>20 And Mousey<310-Lf%
            Fill Mousex,Mousey
          Endif
        Until Mousek=2
      Else
        Alert 3,"No valid filling string|is now available!",1," Ok ",Dummy%
      Endif
    Else
      @Video
      Defmouse 3
      For Zi%=0 To 24
        Deffill ,2,Zi%
        Pbox 0+Zi%*20,370,20+Zi%*20,390
      Next Zi%
      Deffill ,2,Fdd%
      Pbox 0,355,20,365
      Text 524,380,"Ok"
      Do
        Exit If Mousex>520 And Mousex<540 And Mousey>310
        If Mousek=1 And Mousey>310
          Fdd%=Mousex/20
          Deffill ,2,Fdd%
          Pbox 0,355,20,365
        Endif
      Loop
      Deffill ,2,Fdd%
      Defmouse 0
      Repeat
        If Mousek=1 And Mousex>145 And Mousex<350 And Mousey>20 And Mousey<310-Lf%
          Fill Mousex,Mousey
        Endif
      Until Mousek=2
    Endif
  Endif
  If M$(Menu(0))="  Set XOR mode"
    If Xrm%=0
      Xrm%=3
      Print At(1,1);"XOR mode ON "
    Else
      Xrm%=0
      Print At(1,1);"XOR mode OFF"
    Endif
    W%=0
  Endif
  If M$(Menu(0))="  Pen Width"
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter width of pen/brush (now ";Rgg%;"): ";
    Form Input 1,Rgg$
    Rgg%=Val(Rgg$)
  Endif
  If M$(Menu(0))="  Draw a Circle"
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter circle radius (now ";Crg%;"): ";
    Form Input 2,Crg$
    Crg%=Val(Crg$)
    Do
      Exit If Mousek=2
      If Mousek=1 And Mousex>145 And Mousex<350 And Mousey>20 And Mousey<310-Lf%
        Defmouse 7
        Do
          Exit If Mousek=2 Or Mousex<145 Or Mousex>350 Or Mousey<20 Or Mousey>310-Lf%
          Graphmode Xrm%
          Circle Mousex,Mousey,Crg%
        Loop
        Defmouse 0
      Endif
    Loop
    Graphmode 0
  Endif
  If M$(Menu(0))="  Draw a Box"
    Do
      Exit If Mousek=2
      If Mousek=1 And Mousex>145 And Mousex<350 And Mousey>20 And Mousey<310-Lf%
        Lx1%=Mousex
        Lx2%=Mousey
        Defmouse 7
        Do
          Exit If Mousex<145 Or Mousex>350 Or Mousey<20 Or Mousey>310-Lf%
          If Mousek=1 And Mousex>145 And Mousex<350 And Mousey>20 And Mousey<310-Lf%
            Graphmode Xrm%
            Box Lx1%,Lx2%,Mousex,Mousey
          Endif
        Loop
        Defmouse 0
      Endif
    Loop
    Graphmode 0
  Endif
  If M$(Menu(0))="  Draw a Line"
    Do
      Exit If Mousek=2
      If Mousek=1 And Mousex>145 And Mousex<350 And Mousey>20 And Mousey<310-Lf%
        Lx1%=Mousex
        Lx2%=Mousey
        Defmouse 7
        Do
          Exit If Mousex<145 Or Mousex>350 Or Mousey<20 Or Mousey>310-Lf%
          If Mousek=1 And Mousex>145 And Mousex<350 And Mousey>20 And Mousey<310-Lf%
            Graphmode Xrm%
            Line Lx1%,Lx2%,Mousex,Mousey
          Endif
        Loop
        Defmouse 0
      Endif
    Loop
    Graphmode 0
  Endif
  If M$(Menu(0))="  Clear Space"
    Deffill ,5,5
    Pbox 145+Mf%/4,20,350,310-Lf%
    Deffill ,1,1
  Endif
  If M$(Menu(0))="  Create Text"
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter text height in pixels (now ";Thp%;"): ";
    Form Input 2,Thp$
    Thp%=Val(Thp$)
    Do
      Print At(1,1);Space$(79)
      Print At(1,1);"Enter text rotation (now ";Trt%/900;"): ";
      Form Input 1,Trt$
      Trt%=Val(Trt$)*900
      Exit If Val(Trt$)<5
    Loop
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter text effect (now ";Tff%;"): ";
    Form Input 2,Tff$
    Tff%=Val(Tff$)
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter text string: ";
    Form Input 40,Tes$
    Deftext ,Tff%,Trt%,Thp%
    Graphmode Xrm%
    Do
      Exit If Mousek=2
      If Mousek=1 And Mousex>145 And Mousex<350 And Mousey>20 And Mousey<310-Lf%
        Text Mousex,Mousey,Tes$
      Endif
    Loop
    Deftext ,0,0,13
  Endif
  If W%=1
    @Video
  Endif
Return
Procedure Song_tit(S_t%)
  For I%=1 To 13
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Song Title #";I%;" of side ";Chr$(65+S_t%);": ";
    Form Input Elct%-Int(Lf%/9),F$
    Tt$(I%,S_t%)=Upper$(F$+Space$(Elct%-Int(Lf%/9)-Len(F$)))
  Next I%
Return
Procedure Coun_t(S_t%)
  For I%=21 To 33
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Count for Song #";I%-20;" of side ";Chr$(65+S_t%);": ";
    Form Input 3,F$
    If Len(F$)>0 And Len(F$)<3
      Tt$(I%,S_t%)=String$(3-Len(F$),"0")+F$
    Else
      Tt$(I%,S_t%)=F$
    Endif
  Next I%
Return
Procedure Top_tit(S_t%)
  For I%=16 To 17
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Top Title #";I%-15;" of side ";Chr$(65+S_t%);": ";
    Form Input 18-Int(Lf%/9),F$
    Tt$(I%,S_t%)=F$+Space$(18-Int(Lf%/9)-Len(F$))
  Next I%
Return
Procedure Dor_tit(S_t%)
  If May%=1
    For I%=14 To 15
      F$=""
      Print At(1,1);Space$(79)
      Print At(1,1);"Enter Dorse Title #";I%-13;" of side ";Chr$(65+S_t%);": ";
      Form Input 35-Int(Lf%/9),F$
      Tt$(I%,S_t%)=F$+Space$(35-Int(Lf%/9)-Len(F$))
    Next I%
  Else
    If May%=2
      F$=""
      Print At(1,1);Space$(79)
      Print At(1,1);"Enter Dorse Title of side ";Chr$(65+S_t%);": ";
      Form Input 35-Int(Lf%/6),F$
      Tt$(14,S_t%)=F$+Space$(35-Int(Lf%/6)-Len(F$))
    Else
      F$=""
      Print At(1,1);Space$(79)
      Print At(1,1);"Enter Dorse Title of side ";Chr$(65+S_t%);": ";
      Form Input 18-Int(Lf%/10),F$
      Tt$(14,S_t%)=F$+Space$(18-Int(Lf%/10)-Len(F$))
    Endif
  Endif
Return
Procedure Mkr_tit
  If Rtmax%=2
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Rear Title #1: ";
    Form Input 35-Int(Lf%/6),F$
    Tt$(36,1)=F$+Space$(35-Int(Lf%/6)-Len(F$))
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Rear Title #2: ";
    Form Input 35-Int(Lf%/6),F$
    Tt$(37,0)=F$+Space$(35-Int(Lf%/6)-Len(F$))
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Rear Title #3: ";
    Form Input 35-Int(Lf%/6),F$
    Tt$(37,1)=F$+Space$(35-Int(Lf%/6)-Len(F$))
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Rear Title #4: ";
    Form Input 35-Int(Lf%/6),F$
    Tt$(38,0)=F$+Space$(35-Int(Lf%/6)-Len(F$))
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Rear Title #5: ";
    Form Input 35-Int(Lf%/6),F$
    Tt$(38,1)=F$+Space$(35-Int(Lf%/6)-Len(F$))
  Else
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Rear Title #1: ";
    Form Input 35-Int(Lf%/9),F$
    Tt$(35,0)=F$+Space$(35-Int(Lf%/9)-Len(F$))
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Rear Title #2: ";
    Form Input 35-Int(Lf%/9),F$
    Tt$(35,1)=F$+Space$(35-Int(Lf%/9)-Len(F$))
    F$=""
    Print At(1,1);Space$(79)
    Print At(1,1);"Enter Rear Title #3: ";
    Form Input 35-Int(Lf%/9),F$
    Tt$(36,0)=F$+Space$(35-Int(Lf%/9)-Len(F$))
  Endif
Return
Procedure Mk_dt(S_t%)
  Print At(1,1);Space$(79)
  Print At(1,1);"Enter date (dd.mm.yyyy): ";
  Form Input 10,Tt$(18,S_t%)
Return
Procedure Mk_tm(S_t%)
  Print At(1,1);Space$(79)
  Print At(1,1);"Enter time (hh:mm:ss): ";
  Form Input 8,Tt$(19,S_t%)
Return
Procedure Mk_nr(S_t%)
  Alert 0,"Choose noise reduction |   |",2," ON | OFF ",Nr%
  If Nr%=1
    Tt$(20,S_t%)="ON"
  Else
    Tt$(20,S_t%)="OFF"
  Endif
Return
Procedure Mk_dlb(S_t%)
  Alert 0,"Choose Dolby type |   |",1,"NONE|B|C",Nr%
  If Nr%=2 Or Nr%=3
    Tt$(34,S_t%)=Chr$(64+Nr%)
  Else
    Tt$(34,S_t%)="�"
  Endif
Return
Procedure Set_up
  Tt$(18,0)=Date$
  Tt$(19,0)=Time$
  Tt$(20,0)="OFF"
  Tt$(18,1)=Tt$(18,0)
  Tt$(19,1)=Tt$(19,0)
  Tt$(20,1)=Tt$(20,0)
  Tt$(0,0)="Max Title"
  Tt$(17,0)="Top Title"
  Tt$(17,1)=Tt$(17,0)
  Tt$(16,0)=Tt$(17,0)
  Tt$(16,1)=Tt$(17,0)
  Tt$(15,0)="Dorse Title"
  Tt$(15,1)=Tt$(15,0)
  Tt$(14,0)=Tt$(15,0)
  Tt$(14,1)=Tt$(15,0)
  Tt$(34,0)="�"
  Tt$(34,1)=Tt$(34,0)
  Tt$(35,0)="Rear Title"
  Tt$(35,1)=Tt$(35,0)
  Tt$(36,0)=Tt$(35,0)
  Tt$(36,1)=Tt$(35,0)
  Tt$(37,0)=Tt$(35,0)
  Tt$(37,1)=Tt$(35,0)
  Tt$(38,0)=Tt$(35,0)
  Tt$(38,1)=Tt$(35,0)
  Usp%=1
  Lf%=0
  Mf%=0
  Max%=2
  May%=2
  Maxtit%=0
  Rtmax%=2
  Rgg%=0
  Xrm%=0
  Elct%=20
  Cn$=""
  Mg$=""
Return
Procedure Graph
  For I%=0 To N%
    M$(I%)=Pm$(I%,1)
  Next I%
  Menu M$()
  Do
    On Menu
    Exit If M$(Menu(0))="  Back"
    If Mousek And Mousex>(145+Rgg%) And Mousex<(350-Rgg%) And Mousey>(20+Rgg%) And Mousey<(310-Lf%-Rgg%)
      Deffill Abs(2-Mousek),,
      Pcircle Mousex,Mousey,Rgg%
    Endif
  Loop
  For I%=0 To N%
    M$(I%)=Pm$(I%,0)
  Next I%
  Menu M$()
  If Acd%=0
    Menu 18,2
  Endif
Return
Procedure Crea_pattern
  Closew 0
  Erase Sprite_vorn()
  Erase Sprite_hinten()
  Dim Sprite_vorn(15,15),Sprite_hinten(15,15)
  Deffill 1,2,4
  Pbox 0,0,639,399
  Deffill 1,2,8
  Pbox 55,15,595,55
  Pbox 35,75,625,290
  Pbox 55,305,605,395
  Deffill 1,0
  Pbox 50,10,590,50
  Pbox 30,70,620,285
  Pbox 50,300,600,390
  Box 440,100,600,260
  Deftext 1,6,0,32
  Text 128,42,"ACID plus PATTERN EDITOR"
  Graphmode 2
  Deftext 0,0,900,6
  Text 15,385,360," (C) 2/10/1989, PKF"
  Deftext 1,16
  Text 15,384,360," (C) 2/10/1989, PKF"
  Deftext 1,0,0,4
  Text 52,280,550,"PRESS LEFT MOUSE BUTTON TO DRAW A POINT, PRESS RIGHT MOUSE BUTTON TO DELETE IT"
  Line 30,270,620,270
  Box 150,352,500,378
  Graphmode 1
  For I%=0 To 16
    Line 50,100+I%*10,210,100+I%*10
    Line 250,100+I%*10,410,100+I%*10
    Line 50+I%*10,100,50+I%*10,260
    Line 250+I%*10,100,250+I%*10,260
  Next I%
  Deffill 1,2,8
  Rbox 450,110,515,250
  Prbox 525,110,590,250
  Deftext 1,16,0,13
  Text 68,90,"  Positive"
  Text 268,90,"  Negative"
  Text 450,90,"Pattern Design"
  Deftext 1,0
  Text 112,316,"F1 = Load Pattern"
  Text 112,338,"F2 = Save Pattern"
  Text 370,316,"F3 = Erase Pattern"
  Text 370,338,"F9 = Exit to Screen"
  Repeat
    Repeat
      Repeat
        If Mousek<>0 And Mousey>=100 And Mousey<259
          @Abfrage
        Endif
        Tasten$=Inkey$
      Until Len(Tasten$)=2
      Taste%=Asc(Right$(Tasten$))-58
      If Taste%>=1 And Taste%<=3
        On Taste% Gosub Sprite_laden,Ed_speichern,Loeschen
      Endif
    Until Taste%=9
    Alert 2,"Do you want to|leave this editor?",1,"Ok|Cancel",Taste%
  Until Taste%=1
  Color 1
  Fll$=""
  For X%=0 To 15
    Fll%=0
    For Y%=0 To 15
      If Sprite_vorn(Y%,X%)=1
        Fll%=Fll%+2^(15-Y%)
      Endif
    Next Y%
    Fll$=Fll$+Mki$(Fll%)
  Next X%
  Openw 0
  Menu M$()
Return
Procedure Sprite_laden
  Local A$,Vorn,Hinten
  Repeat
    Fileselect "\*.PAT",B$,A$
  Until Len(A$)<>1
  If Len(A$)>1
    If Exist(A$)
      B$=Right$(A$,Len(A$)-1)
      Open "I",#1,A$
      Input #1,A$
      If A$="\_"
        Fll$=""
        For Y%=0 To 15
          Input #1,Vorn,Hinten
          For X%=0 To 15
            If Vorn>=2^(15-X%)
              Vorn=Vorn-2^(15-X%)
              Sprite_vorn(X%,Y%)=1
            Else
              Sprite_vorn(X%,Y%)=0
            Endif
            If Hinten>=2^(15-X%)
              Hinten=Hinten-2^(15-X%)
              Sprite_hinten(X%,Y%)=1
            Else
              Sprite_hinten(X%,Y%)=0
            Endif
          Next X%
        Next Y%
      Else
        Alert 3,"Error in input string!",1," Ok ",Y%
      Endif
      Close #1
      For X%=0 To 15
        For Y%=0 To 15
          @Draw_sprite
        Next Y%
      Next X%
    Else
      Alert 1,"File does not exist!",1,"Cancel",Dummy%
    Endif
  Endif
Return
Procedure Ed_speichern
  Local A$,Vorn,Hinten
  Repeat
    Fileselect "\*.PAT",B$,A$
  Until Len(A$)<>1
  If Len(A$)>1
    B$=Right$(A$,Len(A$)-1)
    Open "O",#1,A$
    Print #1,"\_"
    For Y%=0 To 15
      Vorn=0
      Hinten=0
      For X%=0 To 15
        If Sprite_vorn(X%,Y%)=1
          Vorn=Vorn+2^(15-X%)
        Endif
        If Sprite_hinten(X%,Y%)=1
          Hinten=Hinten+2^(15-X%)
        Endif
      Next X%
      Print #1;Vorn
      Print #1;Hinten
    Next Y%
    Close #1
  Endif
Return
Procedure Loeschen
  Alert 2,"Do you wish to erase|this pattern?",1,"Ok|Cancel",Taste%
  If Taste%=1
    Text 280,374,"Working..."
    Fll$=""
    For X%=0 To 15
      For Y%=0 To 15
        Sprite_vorn(X%,Y%)=0
        Sprite_hinten(X%,Y%)=0
        @Draw_sprite
      Next Y%
    Next X%
    Text 280,374,Space$(20)
  Endif
Return
Procedure Abfrage
  If Mousex>=50 And Mousex<209
    X%=(Mousex-50)\10
    Y%=(Mousey-100)\10
    If Mousek=1 And Sprite_vorn(X%,Y%)=0
      Sprite_vorn(X%,Y%)=1
    Else
      If Mousek=2 And Sprite_vorn(X%,Y%)=1
        Sprite_vorn(X%,Y%)=0
      Endif
    Endif
    @Draw_sprite
  Else
    If Mousex>=250 And Mousex<409
      X%=(Mousex-250)\10
      Y%=(Mousey-100)\10
      If Mousek=1 And Sprite_hinten(X%,Y%)=0
        Sprite_hinten(X%,Y%)=1
      Else
        If Mousek=2 And Sprite_hinten(X%,Y%)=1
          Sprite_hinten(X%,Y%)=0
        Endif
      Endif
      @Draw_sprite
    Endif
  Endif
Return
Procedure Draw_sprite
  If Sprite_vorn(X%,Y%)=0
    If Sprite_hinten(X%,Y%)=0
      Deffill 0,2,8
      Pbox 51+X%*10,101+Y%*10,59+X%*10,109+Y%*10
      Pbox 251+X%*10,101+Y%*10,259+X%*10,109+Y%*10
      Color 1
      Plot 555+X%,172+Y%
    Else
      Deffill 1,2,2
      Pbox 50+X%*10,100+Y%*10,60+X%*10,110+Y%*10
      Pbox 250+X%*10,100+Y%*10,260+X%*10,110+Y%*10
      Color 0
      Plot 555+X%,172+Y%
    Endif
    Color 0
    Plot 475+X%,172+Y%
  Else
    If Sprite_hinten(X%,Y%)=0
      Deffill 1,2,8
      Pbox 50+X%*10,100+Y%*10,60+X%*10,110+Y%*10
      Deffill 1,2,8
      Pbox 250+X%*10,100+Y%*10,260+X%*10,110+Y%*10
      Color 1
      Plot 555+X%,172+Y%
    Else
      Deffill 1,2,8
      Pbox 50+X%*10,100+Y%*10,60+X%*10,110+Y%*10
      Deffill 1,2,2
      Pbox 250+X%*10,100+Y%*10,260+X%*10,110+Y%*10
      Color 0
      Plot 555+X%,172+Y%
    Endif
    Color 1
    Plot 475+X%,172+Y%
    Plot 555+X%,172+Y%
  Endif
Return
Procedure Get_scr
  Alert 2,"You pressed ALT+HELP key:|Screen will be dumped to",1,"Printer|Disk|Cancel",D%
  If D%=1
    Hardcopy
  Endif
  If D%=2
    Bsave "DUMP.SCR",Xbios(2),32000
  Endif
  Sdpoke &H4EE,&HFFFE
Return


- MAIL TO ME -

Web design by PKF - 2001 -
Hosted by www.Geocities.ws

1