|
'
' 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
|