Das ist der Basic-Code von einem Schallplatten etc.-Programm für den AtariST,
das ich irgendwann 1986(?) oder so geschrieben habe. Die Assembler-Routinen stecken
in den INLINE's, die sind primär für die Beschleunigung von dauernd wiederkehrenden
Vorgängen gedacht.
Leider ist das wenig kommentiert, vielleicht findet's der eine oder
andere trotzdem ganz lustig.
Hermann Ludwig
' koptest gesperrt
' als: E_Crash1.GFA
'
' ASC__06.GFA
' asc__05, neu gelistet, Variablen reduziert
' 19.12.91
' Basis Neo__30,Eng_13
' Mai 1991
' Absturz bei Serienl”schen durch FRE(0) weg
' Korrektur bei langsamen Import
'
version$="Version 3.10"
REM einfarbig&=1
REM puffer%=30000 ! wird nicht gemalloct
REM puffer%=0 ! wird nicht gemalloct
REM
REM
start
laufkontrolle:
REM
IF ziel%=0
CLR a$,b$,a%,b%,a&,b&,c&
CLR schreib1$,schreib2$,schreib$,sternchen|,wrt&,nichtschreibend!
CLR kein_merker&,eintrag|,dummy|
CLR mitspieler|,land|,verliehen|,marke&
CLR sortieren|,sltime%,zeit%
CLR aex_kennung%,aex_regel%,zeilen%,kurze_zeile%,ax$,laengenzaehler%
CLR nummer|,filterdummy&
sa_loeschen
fvar_loeschen
plattenbild
MENU leiste$()
menuecheck
IF modus&<>lieblingsmodus&
modus&=lieblingsmodus&
kopf_bild(modus&)
ENDIF
ziel%=1
ENDIF
DO
ON MENU
ON MENU KEY GOSUB schreiben
ON MENU GOSUB menue
ON ERROR GOSUB fehler
CLR makro_aus&
IF ziel%
CLR bst%,zet$
CLR schreib1$,schreib2$,schreib$
ENDIF
IF ziel%<>5 ! Dateneintrag
CLR mitspieler|,land|,verliehen|,nummer|
ENDIF
SELECT ziel%
CASE 1
interpreteneintrag
CASE 12
plattentiteleintrag
CASE 10
IF modus&=1
orchestereintrag
ENDIF
CASE 11
IF modus&=1
leitungeintrag
ENDIF
CASE 2
jahreintrag
CASE 3
arteintrag
CASE 4
profileintrag
CASE 5
dateneintrag
ENDSELECT
' in_den_keller
LOOP
REM _____________________________________________________________________Eintr„ge
PROCEDURE titelzweig
hier%=1
REM * LPRINT "titelzweig"
titel|=1
SELECT wrt&
CASE 10
titel(TRUE,30)
DEFAULT
titel(0,30)
ENDSELECT
schliessen
CLR titel|
RETURN
PROCEDURE interpreteneintrag
hier%=2
REM * LPRINT "interpreteneintrag"
~XBIOS(35,6,3) ! Tastatur (Delay 6,repeat 3) (unstimmig)
DEFMOUSE 0
eintrag|=1
ata&=22-2*modus&
atb&=4-modus&
IF FRE(0)<1000
ruecksprung(0)
ENDIF
pfeil(1,5,55/yt&-modus&*16/yt&,25,55/yt&-modus&*16/yt&)
schreib2$=sainterpret$
PRINT AT(ata&,atb&);
hinschreiben(50)
DO
freitest
sternchen|=1
warten1
SELECT bst%
CASE 20480,7181,18432
vor_sprung
ziel%=12
SELECT bst%
CASE 18432
ziel%=5
ENDSELECT
EXIT IF TRUE
CASE 29197
titelzweig
ziel%=1
EXIT IF TRUE
ENDSELECT
PRINT AT(ata&,atb&);RIGHT$(schreib1$,50);
sainterpret$=schreib$
CLR draus!
hinschreiben(50)
LOOP
RETURN
PROCEDURE orchestereintrag
hier%=3
REM * LPRINT "orchestereintrag"
DEFMOUSE 0
eintrag|=10
IF modus&=1
sternchen|=1
pfeil(1,5,71/yt&,25,71/yt&)
schreib2$=saorchester$
PRINT AT(20,5);
hinschreiben(50)
DO
freitest
warten1
SELECT bst%
CASE 20480,7181,18432
vor_sprung
ziel%=11
SELECT bst%
CASE 18432
ziel%=12
ENDSELECT
EXIT IF TRUE
CASE 29197
titelzweig
ziel%=10
EXIT IF TRUE
ENDSELECT
PRINT AT(20,5);RIGHT$(schreib1$,50);
saorchester$=schreib$
CLR draus!
hinschreiben(50)
LOOP
ENDIF
RETURN
PROCEDURE leitungeintrag
hier%=4
REM * LPRINT "leitungeintrag"
DEFMOUSE 0
eintrag|=11
IF modus&=1
sternchen|=1
pfeil(1,5,87/yt&,25,87/yt&)
schreib2$=saleitung$
PRINT AT(20,6);
hinschreiben(45)
DO
freitest
warten1
SELECT bst%
CASE 20480,7181,18432
vor_sprung
ziel%=2
SELECT bst%
CASE 18432
ziel%=10
ENDSELECT
EXIT IF TRUE
CASE 29197
titelzweig
ziel%=11
EXIT IF TRUE
ENDSELECT
PRINT AT(20,6);RIGHT$(schreib1$,45);
saleitung$=schreib$
CLR draus!
hinschreiben(45)
LOOP
ENDIF
RETURN
PROCEDURE plattentiteleintrag
hier%=5
REM * LPRINT "plattentiteleintrag"
DEFMOUSE 0
eintrag|=12
ata&=16+4*modus&
atb&=6-modus&*2
sternchen|=1
pfeil(1,5,85/yt&-32/yt&*modus&,25,85/yt&-32/yt&*modus&)
schreib2$=saplatte$
PRINT AT(ata&,atb&);
hinschreiben(50)
DO
freitest
warten1
SELECT bst%
CASE 20480,7181,18432
vor_sprung
SELECT bst%
CASE 20480,7181
ziel%=2
IF modus&=1
ziel%=10
ENDIF
EXIT IF TRUE
CASE 18432
ziel%=1
EXIT IF TRUE
ENDSELECT
CASE 29197
titelzweig
ziel%=12
EXIT IF TRUE
ENDSELECT
PRINT AT(ata&,atb&);RIGHT$(schreib1$,50);
saplatte$=schreib$
CLR draus!
hinschreiben(50)
LOOP
RETURN
PROCEDURE jahreintrag
hier%=6
REM * LPRINT "jahreintrag"
DEFMOUSE 0
eintrag|=2
freitest
sternchen|=1
makro_aus&=1
pfeil(1,630,88/yt&,605,88/yt&)
DEFTEXT 1,17,0,8-2*yt&
TEXT 559+4*yt&,88/yt&+yt&,"Jahr"
sajahr$=STR$(sajahr&)
schreib2$=sajahr$
IF sajahr&=0
CLR sajahr$,schreib2$
ENDIF
PRINT AT(71,6);''''''
PRINT AT(71,6);';sajahr$;';
DO
warten1
SELECT bst%
CASE 20480,18432,7181
vor_sprung
CLR sternchen|
ziel%=3
SELECT bst%
CASE 18432
ziel%=12
IF modus&=1
ziel%=11
ENDIF
ENDSELECT
EXIT IF TRUE
CASE 29197
titelzweig
ziel%=2
EXIT IF TRUE
ENDSELECT
IF wrt&<>10
IF LEN(schreib$)>4
schreib$=LEFT$(schreib$,4)
schreib1$=LEFT$(schreib1$,LEN(schreib1$)-1)
ENDIF
sajahr$=schreib$
CLR draus!
PRINT AT(71,6);''''''
PRINT AT(71,6);';schreib1$;
hinschreiben(4)
sajahr&=VAL(sajahr$)
ENDIF
LOOP
RETURN
PROCEDURE arteintrag
hier%=7
REM * LPRINT "arteintrag"
IF yt&<2
DEFMOUSE eckmaus$
ENDIF
eintrag|=3
freitest
sternchen|=1
pfeil(1,5,110/yt&,25,110/yt&)
DO
CLR draus!
warten2
IF MOUSEK=1
IF wrt&<>10
SELECT MOUSEY*yt&
CASE 100 TO 114 ! Erste Reihe
b_pl&=100
xx&=MOUSEX
CLR schluessel!,a_pl&,art_a&
SELECT xx&
CASE 50 TO 80 ! LP=1
art_a&=1
a_pl&=50
CASE 116 TO 146 ! DoLP=3
art_a&=3
a_pl&=116
CASE 166 TO 196 ! EP=9
art_a&=9
a_pl&=166
CASE 232 TO 262 ! Maxi=5
art_a&=5
a_pl&=232
CASE 289 TO 319 ! Box=10
art_a&=10
a_pl&=289
CASE 338 TO 368 ! CD=2
art_a&=2
a_pl&=338
CASE 404 TO 434 ! DoCD=4
art_a&=4
a_pl&=404
CASE 478 TO 508 ! CD-EP=11
art_a&=11
a_pl&=478
CASE 565 TO 595 ! CD-Maxi=12
art_a&=12
a_pl&=565
ENDSELECT
CASE 114 TO 128 ! Zweite Reihe
b_pl&=114
xx&=MOUSEX
CLR schluessel!,a_pl&,art_a&
SELECT xx&
CASE 83 TO 113 ! Single=6
art_a&=6
a_pl&=83
CASE 151 TO 181 ! Cass=8
art_a&=8
a_pl&=151
CASE 226 TO 256 ! Buch=13=> Video 14
art_a&=14
a_pl&=226
CASE 434 TO 464 ! CD-Single=7
art_a&=7
a_pl&=434
CASE 515 TO 545 ! Video=14: CD-Box
art_a&=13
a_pl&=515
CASE 558 TO 588 ! ?=15
art_a&=15
a_pl&=558
ENDSELECT
ENDSELECT
IF a_pl&
farbe|=1
SELECT wrt&
CASE 5 TO 7,11,13,14
IF BTST(f_art&,art_a&-1)
CLR farbe|
ENDIF
f_art&=BCHG(f_art&,art_a&-1)
DEFAULT
schluessel!=TRUE
artloeschen
saart&=art_a&
DEFFILL 1,2,8
ENDSELECT
IF farbe|
PUT a_pl&,b_pl&/yt&,dunkel$,3
ELSE
PUT a_pl&,b_pl&/yt&,hell$,3
ENDIF
ENDIF
CLR xx&,a_pl&,art_a&,farbe|,b_pl&
ENDIF
ENDIF
SELECT bst%
CASE 20480,18432,7181
vor_sprung
ziel%=4
SELECT bst%
CASE 18432
ziel%=2
ENDSELECT
EXIT IF TRUE
CASE 29197
titelzweig
ziel%=3
EXIT IF TRUE
ENDSELECT
LOOP
RETURN
PROCEDURE artloeschen ! slow
hier%=8
REM * LPRINT "artloeschen"
RESTORE art_text
b&=100/yt&
FOR schr&=1 DOWNTO 0
FOR schritt&=8 DOWNTO 0
READ a&,c&,a$
EXIT IF a&=0
PUT c&,b&,hell$,3
NEXT schritt&
b&=114/yt&
NEXT schr&
RETURN
PROCEDURE profileintrag
hier%=9
REM * LPRINT "profileintrag"
IF yt&<2
DEFMOUSE eckmaus$
ENDIF
eintrag|=4
freitest
sternchen|=1
pfeil(1,160,140/yt&,160,160/yt&)
sauebergabe$=@uebergabe$
DO
warten2
SELECT bst%
CASE 20480,19712,18432,19200,7181
vor_sprung
SELECT bst%
CASE 20480,19712,7181
ziel%=5
EXIT IF TRUE
CASE 18432,19200
ziel%=3
EXIT IF TRUE
ENDSELECT
CASE 29197
titelzweig
ziel%=4
EXIT IF TRUE
ENDSELECT
IF MOUSEK=1
IF wrt&<>10
xx&=MOUSEX
yy&=MOUSEY*yt&
kr&=PTST(MOUSEX,MOUSEY)
SELECT xx&
CASE 100 TO 220
CLR a$
SELECT yy&
CASE 191 TO 383
j&=MIN(19,INT((yy&-63)/(16)))
jl&=MIN(12,j&-7)
jr&=MIN(24,j&+5)
SELECT xx&
CASE 100 TO 160
ls&=100
CASE 161 TO 220
ls&=160
ENDSELECT
IF kr&=0
SELECT xx&
CASE 100 TO 160
klein$(jl&)=UPPER$(klein$(jl&))
CASE 161 TO 220
klein$(jr&)=UPPER$(klein$(jr&))
ENDSELECT
a$=profil_dunkel$
ELSE IF kr&>0
SELECT xx&
CASE 100 TO 160
BYTE{V:klein$(jl&)}=BSET(BYTE{V:klein$(jl&)},5) ! LOWER$
CASE 161 TO 220
BYTE{V:klein$(jr&)}=BSET(BYTE{V:klein$(jr&)},5) ! LOWER$
ENDSELECT
a$=profil_hell$
ENDIF
c&=j&*16
DIV c&,yt&
a&=63/yt&
ADD a&,c&
PUT ls&,a&,a$
CLR a$,a&,c&
sauebergabe$=""
FOR schritt&=1 TO 24
IF ASC(klein$(schritt&))<91
sauebergabe$=sauebergabe$+klein$(schritt&)
ENDIF
NEXT schritt&
ENDSELECT
ENDSELECT
REPEAT
UNTIL MOUSEK=0
ENDIF
ENDIF
LOOP
RETURN
PROCEDURE profilkasten
hier%=10
REM * LPRINT "profilkasten"
FOR schritt&=191 TO 367 STEP 16
PUT 100,schritt&/yt&,profil_hell$
PUT 160,schritt&/yt&,profil_hell$
NEXT schritt&
RETURN
PROCEDURE dateneintrag
hier%=11
REM * LPRINT "dateneintrag"
IF yt&<2
DEFMOUSE eckmaus$
ENDIF
eintrag|=5
sternchen|=1
pfeil(1,470,140/yt&,470,160/yt&)
CLR zet$,bst%
IF land|
IF wrt&<>10
land
ENDIF
ELSE IF mitspieler|
mitspieler
ELSE IF verliehen|
verliehen
ELSE IF nummer|
nummer
ENDIF
DO
freitest
warten2
SELECT bst%
CASE 20480,19712
vor_sprung
ziel%=1
EXIT IF TRUE
CASE 18432,19200
vor_sprung
ziel%=4
EXIT IF TRUE
CASE 7181
CLR schreib1$,schreib2$,schreib$,sternchen|
ziel%=5
EXIT IF TRUE
CASE 29197
titelzweig
ziel%=5
EXIT IF TRUE
ENDSELECT
IF MOUSEK=1
xx&=MOUSEX
yy&=MOUSEY*yt&
kr&=PTST(MOUSEX,MOUSEY)
SELECT yy&
CASE 179 TO 239
SELECT xx&
CASE 588 TO 625
wert
ENDSELECT
ENDSELECT
SELECT yy&
CASE 370 TO 384 !******* Zusatzkasten z1&,z2&,z3& *****
CLR a_pl&,a&
SELECT xx&
CASE 365 TO 415
a_pl&=365
SELECT saz1&
CASE 1
CLR saz1&,a&
CASE 0
saz1&=1
a&=1
ENDSELECT
CASE 440 TO 485
a_pl&=440
SELECT saz2&
CASE 1
CLR saz2&,a&
CASE 0
saz2&=1
a&=1
ENDSELECT
CASE 515 TO 555
a_pl&=515
SELECT saz3&
CASE 1
CLR saz3&,a&
CASE 0
saz3&=1
a&=1
ENDSELECT
ENDSELECT
IF a_pl&
SELECT a&
CASE 1
PUT a_pl&,370/yt&,profil_dunkel$
CASE 0
PUT a_pl&,370/yt&,profil_hell$
ENDSELECT
ENDIF
CLR a_pl&,a&
CASE 204 TO 220 !******* Besitzer ************
IF wrt&<>10
IF wrt&<>4 OR (wrt&=4 AND sabesitzer&=0)
SELECT xx&
CASE 455 TO 485,500 TO 530,545 TO 575
DEFFILL 1,0,0
PUT 455,204/yt&,hell$,3 ! fr Besitzer1
PUT 500,204/yt&,hell$,3 ! fr Besitzer2
PUT 545,204/yt&,hell$,3 ! fr Besitzer3
SELECT xx&
CASE 455 TO 485
IF sabesitzer&<>1
sabesitzer&=1
ELSE
CLR sabesitzer&
ENDIF
CASE 500 TO 530
IF sabesitzer&<>2
sabesitzer&=2
ELSE
CLR sabesitzer&
ENDIF
CASE 545 TO 575
IF sabesitzer&<>3
sabesitzer&=3
ELSE
CLR sabesitzer&
ENDIF
ENDSELECT
IF sabesitzer&
PUT 455-45+45*sabesitzer&,204/yt&,dunkel$,3
ENDIF
ENDSELECT
ENDIF
ENDIF
CASE 223 TO 239 ! ******* Land ******
IF wrt&<>10
SELECT xx&
CASE 395 TO 425
land
CASE 500 TO 577
nummer
ENDSELECT
ENDIF
CASE 258 TO 274
IF wrt&<>10
SELECT xx&
CASE 545 TO 575 ! **** Zustand ***
IF sazustand& !kr&>0
PUT 545,258/yt&,hell$,3 ! fr Zustand
CLR sazustand&
ELSE
PUT 545,258/yt&,dunkel$,3
sazustand&=1
ENDIF
REPEAT
UNTIL MOUSEK=0
ENDSELECT
ENDIF
CASE 241 TO 257 ! **** Verliehen an ****
SELECT xx&
CASE 455 TO 485
REPEAT
UNTIL MOUSEK=0
verliehen
ENDSELECT
CASE 287 TO 367 ! ***** Mitspieler *****
SELECT xx&
CASE 350 TO 600
mitspieler
ENDSELECT
DEFAULT
ziel%=5
EXIT IF TRUE
ENDSELECT
CLR schreib1$,schreib2$,schreib$ !,sternchen|
ENDIF !(Mousek=1, ganz oben in Dateneintrag)
LOOP
RETURN
PROCEDURE mitspieler
hier%=12
REM * LPRINT "mitspieler"
SELECT yy&
CASE 287 TO 302 ! ***** Mitspieler *****
bvr&=1
CASE 303 TO 318
bvr&=2
CASE 319 TO 334
bvr&=3
CASE 335 TO 350
bvr&=4
CASE 351 TO 366
bvr&=5
DEFAULT
bvr&=1
ENDSELECT
mitspieler|=1
CLR schreib1$,schreib2$,schreib$
DEFLINE 1,1,0,0
BOX 348,285/yt&,602,369/yt& ! fr Mitspieler (Aktivbox)
schreib2$=samitspieler$(bvr&)
PRINT AT(48,(18+bvr&));
hinschreiben(27)
spieler_linie
REPEAT
UNTIL MOUSEK=0
DO
REPEAT
freitest
DEFFILL 0,0,0 ! Pfeil verscchwinden
PBOX 322,287/yt&,340,367/yt&
DEFLINE 1,6/yt&,2,1
a&=bvr&-1
MUL a&,16
ADD a&,295
DIV a&,yt&
DRAW 326,a& TO 340,a&
CLR a&
DEFLINE 1,1*yt&,0,0
DO
CLR draus!
IF wrt&=13 ! Serienl”schen
sltime%=TIMER
ENDIF
REPEAT
IF wrt&=13
IF sltime%<=TIMER-50
sltime%=TIMER
alarm
ENDIF
ENDIF
versch_menues
IF MOUSEK>1
check
ENDIF
EXIT IF MOUSEK=1
UNTIL draus!
EXIT IF MOUSEK
SELECT bst%
CASE 18432,20480,29197,7181 ! neue Zeile,Titelfeld
EXIT IF TRUE
ENDSELECT
PRINT AT(48,(18+bvr&));RIGHT$(schreib1$,27);
samitspieler$(bvr&)=schreib$
CLR draus!
hinschreiben(27)
spieler_linie
LOOP
CLR schreib1$,schreib2$,schreib$
schreib2$=samitspieler$(bvr&)
a%=MIN(27,LEN(samitspieler$(bvr&)))
PRINT AT(48,(18+bvr&));LEFT$(samitspieler$(bvr&),a%);';
IF LEN(samitspieler$(bvr&))>27
PUT 608,(18+bvr&-1)*16+2/yt&,pfeil_rechts$
ENDIF
spieler_linie
EXIT IF MOUSEK
SELECT bst%
CASE 29197,18432,20480,7181
EXIT IF TRUE
ENDSELECT
UNTIL bvr&=6
EXIT IF MOUSEK
EXIT IF bst%=29197 ! Titelfeld
SELECT bst%
CASE 20480,18432,7181 ! Zeilenwechsel
SELECT bst%
CASE 18432
DEC bvr&
bvr&=MAX(bvr&,1)
CASE 20480,7181
EXIT IF bvr&=5
INC bvr&
bvr&=MIN(bvr&,5)
ENDSELECT
schreib2$=samitspieler$(bvr&)
PRINT AT(48,(18+bvr&));
hinschreiben(27)
spieler_linie
ENDSELECT
LOOP
REM Ausgang: (Zeile schon durch Zeilenwechsel)
COLOR 0
BOX 348,285/yt&,602,369/yt&
COLOR 1
DEFFILL 0,0,0 ! Pfeil verscchwinden
PBOX 322,287/yt&,340,367/yt&
DEFLINE 1,1*yt&,0,0
CLR mitspieler|
IF bst%=29197
titelzweig
ruecksprung(5)
ENDIF
RETURN
PROCEDURE nummer
hier%=13
REM * LPRINT "nummer"
nummer|=1
HIDEM
SETMOUSE 550,250/yt&
SHOWM
DEFFILL 1,0,0
PBOX 500,223/yt&,577,239/yt&
DEFTEXT 1,1,0,9-yt&
TEXT 435,237/yt&-yt&,"Nummer"
CLR sanummer%
a$=""
REPEAT
warten2
l$=UPPER$(zet$)
EXIT IF MOUSEK
EXIT IF ASC(l$)=13
SELECT ASC(l$)
CASE 13
EXIT IF TRUE
CASE 48 TO 57
a$=a$+l$
ENDSELECT
sanummer%=VAL(a$)
PRINT AT(64,15);USING "#########",sanummer%
BOX 500,223/yt&,577,239/yt&
EXIT IF LEN(a$)>=9
UNTIL MOUSEK
CLR a$
CLR l$,nummer|,a$
DEFTEXT 0,1,0,9-yt&
TEXT 435,237/yt&-yt&,"Nummer"
DEFTEXT 1,17,0,8-2*yt&
TEXT 435,237/yt&-yt&,"Nummer"
RETURN
PROCEDURE wert
hier%=14
REM * LPRINT "wert"
IF MOUSEK=1
xx&=MOUSEX
yy&=MOUSEY*yt&
kr&=PTST(MOUSEX,MOUSEY)
ENDIF
CLR dummy|
SELECT xx&
CASE 613 TO 628
SELECT yy&
CASE 179 TO 246
a&=yy&-177 !(0-60)
sawert1&=(65-a&)/6
sawert1&=MIN(MAX(sawert1&,0),10)
dummy|=1
ENDSELECT
CASE 588 TO 611
SELECT yy&
CASE 205 TO 225
SELECT wrt&
CASE 5,6,7,11,13,14 ! Filterf„lle
sawert2&=sawert1&
dummy|=1
ENDSELECT
CASE 190 TO 208 ! Pfeil rauf
sawert1&=MIN(sawert1&+1,10)
dummy|=1
CASE 223 TO 241 ! Pfeil runter
sawert1&=MAX(sawert1&-1,0)
dummy|=1
ENDSELECT
ENDSELECT
SELECT dummy|
CASE 1
DEFFILL 1,0,0
VSYNC
PBOX 613,179/yt&,623,239/yt& ! fr Wert
DEFFILL 1,2,8
SELECT wrt&
CASE 5,6,7,11,13,14 ! Filterf„lle
a&=MIN(239,(239+6-MIN(sawert1&,sawert2&)*6))/yt&
b&=MIN(239,(239+6-MAX(sawert1&+1,sawert2&+1)*6))/yt&
PBOX 613,b&,623,a&
DEFAULT
PBOX 613,(239-sawert1&*6)/yt&,623,239/yt&
ENDSELECT
PRINT AT(75,14);USING "##",sawert1&
CLR dummy|
ENDSELECT
RETURN
PROCEDURE land
hier%=15
REM * LPRINT "land"
land|=1
HIDEM
SETMOUSE 450,240/yt&
SHOWM
DEFFILL 1,0,0
PBOX 395,223/yt&,425,239/yt&
DEFTEXT 1,1,0,9-yt&
TEXT 350,237/yt&-yt&,"Land"
saland$=""
REPEAT
warten2
l$=UPPER$(zet$)
EXIT IF MOUSEK
EXIT IF ASC(l$)<14
saland$=saland$+l$
PRINT AT(51,15);saland$
BOX 395,223/yt&,425,239/yt&
EXIT IF LEN(saland$)>=3
UNTIL MOUSEK
CLR l$,land|
DEFTEXT 0,1,0,9-yt&
TEXT 350,237/yt&-yt&,"Land"
DEFTEXT 1,17,0,8-2*yt&
TEXT 350,237/yt&-yt&,"Land"
RETURN
PROCEDURE verliehen
hier%=16
REM * LPRINT "verliehen"
verliehen|=1
IF sverliehen&>0
IF wrt&<>10
CLR sverliehen&,sverliehen$
PRINT AT(67,16);''''''''''''';';
DRAW 635,240/yt& TO 635,255/yt& ! Lcke schliežen
PUT 455,241/yt&,hell$,3 ! fr verliehen
CLR schreib1$,schreib2$,schreib$ !,sternchen|
ENDIF
ENDIF
IF kr&=0 OR wrt&=10 ! Verliehen wird eingeschaltet
IF wrt&<>10
sverliehen&=1
PUT 455,241/yt&,dunkel$,3
ENDIF
DEFTEXT 1,17,0,8-2*yt&
TEXT 485+5*yt&,251/yt&+yt&,"an:"
DEFTEXT 1,1,0,9-yt&
TEXT 485+5*yt&,251/yt&+yt&,"an:"
IF sverliehen&=2
schreib2$=sverliehen$
PRINT AT(67,16);LEFT$(sverliehen$,MIN(11,LEN(sverliehen$)));';
IF LEN(sverliehen$)>11
PRINT ';
OUT 5,3
ELSE
DRAW 635,240/yt& TO 635,255/yt& ! Lcke schliežen
ENDIF
ENDIF
DO
freitest
CLR draus!
REPEAT
versch_menues
IF MOUSEK>1
check
ENDIF
EXIT IF MOUSEK=1
UNTIL draus!
EXIT IF MOUSEK>0
SELECT bst%
CASE 7181,18432,20480,29197
EXIT IF TRUE
ENDSELECT
PRINT AT(67,16);RIGHT$(schreib1$,11);
IF wrt&<>10
sverliehen$=schreib$
sverliehen&=2
ENDIF
CLR draus!
hinschreiben(11)
IF sverliehen$=""
sverliehen&=1
ELSE IF sverliehen$>""
sverliehen&=2
ENDIF
LOOP
IF sverliehen&=2 OR wrt&=10
PRINT AT(67,16);LEFT$(sverliehen$,MIN(11,LEN(sverliehen$)));';
IF LEN(sverliehen$)>11
PRINT ';
OUT 5,3
ELSE
DRAW 635,240/yt& TO 635,255/yt& ! Lcke schliežen
ENDIF
ENDIF
DEFTEXT 0,1,0,9-yt&
TEXT 485+5*yt&,251/yt&+yt&,"an:"
DEFTEXT 1,17,0,8-2*yt&
TEXT 485+5*yt&,251/yt&+yt&,"an:"
CLR verliehen|
ENDIF
CLR verliehen|
CLR schreib1$,schreib2$,schreib$ !,sternchen|
IF bst%=29197
titelzweig
ziel%=5
ENDIF
RETURN
PROCEDURE spieler_linie ! slow
hier%=17
REM * LPRINT "spieler_linie"
FOR schritt&=303 TO 367 STEP 16
PUT 350,schritt&/yt&,strich$
NEXT schritt&
IF mitspieler|
DEFLINE 1,1
DRAW 600,287/yt& TO 600,367/yt&
DRAW 602,287/yt& TO 602,367/yt& ! rechte Kante
ELSE
DRAW 600,287/yt& TO 600,367/yt& ! rechte Kante
ENDIF
DEFLINE 1,1
RETURN
PROCEDURE titel(nichtschreibend!,bildbreite&)
hier%=18
REM * LPRINT "titel(nichtschreibend!,bildbreite&)"
ON MENU BUTTON 1,1,1 GOSUB dummy
CLR filter&,makro_aus&
SELECT wrt&
CASE 5 TO 7,11,13
filter&=TRUE
CASE 10
makro_aus&=1
ENDSELECT
INC bildbreite&
freitest
LOCAL fz&,zz&
IF nichtschreibend!
grosser_dateisatz
CLR tth&,anz&
ERASE safenster$()
DIM safenster$(100)
DO
EXIT IF tth&=101 ! zur Sicherheit
EXIT IF LEN(dsatz$(12))<=1
anz&=INSTR(stelle&,dsatz$(12),CHR$(244))-1
safenster$(tth&)=LEFT$(dsatz$(12),anz&)
IF LEN(dsatz$(12))>LEN(safenster$(tth&))+1
dsatz$(12)=RIGHT$(dsatz$(12),LEN(dsatz$(12))-LEN(safenster$(tth&))-1)
INC tth&
ELSE
dsatz$(12)=""
ENDIF
LOOP
CLR anz&,stelle&
ENDIF
DEFFILL 0,0,0
a&=320*bildbreite&
DIV a&,30
PRBOX 3,145/yt&,a&,390/yt& ! fr Schallplattentitel
RBOX 3,145/yt&,a&,390/yt& ! fr Schallplattentitel
a&=318*bildbreite&
DIV a&,30
RBOX 5,147/yt&,a&,388/yt& ! fr Schallplattentitel
CLR a&
PUT 315,369/yt&,merker_hell$ ! Stckefeld
DEFTEXT 1,0,0,13
TEXT 328,388/yt&,"X"
IF nichtschreibend!
IF dmerker&=1
PUT 602,369/yt&,merker_dunkel$
ELSE
PUT 602,369/yt&,merker_hell$
ENDIF
ENDIF
REPEAT ! Tastenloslassen
ON MENU
{XBIOS(14,1)+6}=0
UNTIL ASC(RIGHT$(MKI$(MENU(14))))<>13 AND ASC(LEFT$(MKI$(MENU(14))))<>114 !( CR Ziffernblock)
SETMOUSE MOUSEX,MOUSEY,0
PAUSE 10
CLR sternchen|
CLR schreib1$,schreib2$,schreib$
fz&=1
CLR zz&
a$=" 1."
IF filter&
a$=" F:"
ENDIF
PRINT AT(2,11+zz&);a$;
IF NOT filter& ! Eingangsbild
FOR zz&=0 TO 13
PRINT AT(2,11+zz&);USING "###",1+zz&;
PRINT ". ";
IF safenster$(1+zz&)>""
PRINT LEFT$(safenster$(1+zz&),bildbreite&);
IF LEN(safenster$(fz&+zz&))>bildbreite&
PRINT '';
OUT 5,3
ENDIF
ENDIF
EXIT IF zz&+1=tth& ! Werden nur existente Nummern angezeigt
NEXT zz&
CLR zz&
ENDIF
CLR tth&
schreib2$=safenster$(fz&)
PRINT AT(7,11);
hinschreiben(bildbreite&)
DO
IF FRE(0)<1000
ruecksprung(0)
ENDIF
freitest
CLR draus!
REPEAT
versch_menues
EXIT IF draus!
IF MOUSEK=1
SELECT MOUSEY*yt&
CASE 369 TO 398
SELECT MOUSEX
CASE 315 TO 348 ! Stcke Schiežfeld
bst%=29197
draus!=TRUE
CASE 602 TO 638 ! Merker
IF wrt&>0 AND nichtschreibend!
merker_eintrag
ELSE
samerker_eintrag
ENDIF
ENDSELECT
ENDSELECT
ENDIF
UNTIL draus!
EXIT IF bst%=29197
SELECT bst%
CASE 20992 ! Insert
IF NOT nichtschreibend!
hfz&=fz&
INSERT safenster$(fz&)=""
CLR schreib1$,schreib2$,schreib$
fz&=fz&-zz&
FOR schritt&=zz& TO 13
IF fz&+schritt&<=100
PRINT AT(2,11+schritt&);USING "###",fz&+schritt&;
PRINT ". ";
a$=SPACE$(bildbreite&)
LSET a$=safenster$(fz&+schritt&)
PRINT a$;'';
IF LEN(safenster$(fz&+schritt&))>=bildbreite&
OUT 5,3
ELSE
PRINT ';
ENDIF
ENDIF
NEXT schritt&
fz&=hfz&
PRINT CHR$(27);"p";
PRINT AT(7,11+zz&);SPACE$(1);
PRINT CHR$(27);"q";
ENDIF
CASE 7181,20480,18432
IF NOT filter&
safenster$(fz&)=schreib$
PRINT AT(2,11+zz&);USING "###",fz&;
PRINT ". ";LEFT$(safenster$(fz&),bildbreite&);'';
IF LEN(safenster$(fz&))>=bildbreite&
OUT 5,3
ELSE
PRINT ';
ENDIF
IF bst%=18432 ! Cursor hoch
IF zz&>0
SUB fz&,2
SUB zz&,2
ELSE IF zz&=0 AND fz&=1
DEC fz&
DEC zz&
ELSE IF zz&=0 AND fz&<>0 ! wird durch eben null
SUB fz&,14
fz&=MAX(1,fz&)
FOR zz&=0 TO 13
PRINT AT(2,11+zz&);USING "###",fz&+zz&;
a$=SPACE$(bildbreite&)
LSET a$=safenster$(fz&+zz&)
PRINT ". ";a$;'';
IF LEN(safenster$(fz&+zz&))>=bildbreite&
OUT 5,3
ELSE
PRINT ';
ENDIF
NEXT zz&
fz&=fz&+12
zz&=12
ENDIF
ENDIF
IF fz&<100 ! Maximalzahl
INC zz&
INC fz&
ENDIF
IF zz&>13
IF bst%<>18432
FOR zz&=0 TO 13
a&=fz&+zz&
IF a&<101
PRINT AT(2,11+zz&);USING "###",a&;
a$=SPACE$(bildbreite&)
LSET a$=safenster$(a&)
PRINT ". ";a$;'';
IF LEN(safenster$(a&))>=bildbreite&
OUT 5,3
ELSE
PRINT ';
ENDIF
ELSE
PRINT AT(3,11+zz&);SPACE$(bildbreite&+4)
ENDIF
NEXT zz&
CLR zz&,a&
ENDIF
ENDIF
CLR schreib1$,schreib$
schreib2$=safenster$(fz&)
ENDIF
IF NOT filter&
PRINT AT(2,11+zz&);USING "###",fz&;
PRINT ". ";
hinschreiben(bildbreite&)
ENDIF
DEFAULT
IF NOT filter&
PRINT AT(2,11+zz&);USING "###",fz&;
ENDIF
PRINT AT(5,11+zz&);". ";RIGHT$(schreib1$,bildbreite&);
IF NOT nichtschreibend!
safenster$(fz&)=schreib$
ENDIF
hinschreiben(bildbreite&)
ENDSELECT
CLR draus!
LOOP
CLR filter&
RETURN
PROCEDURE schliessen !slow
hier%=19
REM * LPRINT "schliessen"
DIM ffa%(6),ffb%(6),ffc%(9)
ffa%(0)=V:bild$
ffa%(1)=640
ffa%(2)=400/yt&
ffa%(3)=640/16
ffa%(4)=0
ffa%(5)=1*yt&
ffb%(0)=XBIOS(2)
ffb%(1)=640
ffb%(2)=400/yt&
ffb%(3)=640/16
ffb%(4)=0
ffb%(5)=1*yt&
ffc%(0)=3
ffc%(1)=145/yt&
ffc%(2)=330
ffc%(3)=390/yt&
ffc%(4)=ffc%(0)
ffc%(5)=ffc%(1)
ffc%(6)=ffc%(2)
ffc%(7)=ffc%(3)
ffc%(8)=3
BITBLT ffa%(),ffb%(),ffc%()
ERASE ffa%(),ffb%(),ffc%()
DEFFILL 1,0,0
DEFTEXT 1,0,0,13/yt&
DEFLINE 1,4,2,2
CLR a&,b&,a$
SELECT wrt&
CASE 5,6,7,11,13,14,15
DEFLINE 1,4,2,2
BOX 250,145/yt&,380,165/yt&
DEFTEXT 1,17,0,13/yt&
TEXT 270,161/yt&," Filter "
IF klassikfilter&=1
PUT 70,148/yt&,dunkel$,3 ! fr E-Musik Filteranklick
ELSE
PUT 70,148/yt&,hell$,3 ! fr E-Musik Filteranklick
ENDIF
SELECT wrt&
CASE 5
a$="L "
CASE 6
a$="Z "
CASE 7
a$="D "
CASE 11
a$="E "
CASE 13
a$="SerieL”schen"
CASE 14,15
a$="Serie-Žndern"
ENDSELECT
TEXT 255,161/yt&,a$
CASE 1,3,4
REM b&=270
a$=" Žndern "
CASE 9
REM b&=270
a$=" Doppel "
CASE 2,8
REM b&=270
a$=" L”schen! "
CASE 10
REM b&=270 !255
a$=" Lesen "
ENDSELECT
SELECT wrt&
CASE 1,2,3,4,8,9,10
BOX 250,145/yt&,380,165/yt&
DEFTEXT 1,17,0,13/yt&
TEXT 270,161/yt&,a$
ENDSELECT
CLR a&,a$
IF weiss|
CLR weiss|
DEFFILL 1,0,0
PBOX 250,145/yt&,380,165/yt& ! leeres Feld
ENDIF
DEFLINE 1,1*yt&,0,0
IF modus&=1
BOX 7,147/yt&,68,163/yt&! fr Klassik
ENDIF
IF sauebergabe$>""
DEFFILL 1,2,8
FOR schritt&=1 TO LEN(sauebergabe$)
a$=MID$(sauebergabe$,schritt&,1)
IF ASC(a$)<77
ls&=100
os&=ASC(a$)
SUB os&,65
MUL os&,16
ADD os&,191
PUT ls&,os&/yt&,profil_dunkel$
ELSE IF ASC(a$)>=77
ls&=160
os&=ASC(a$)
SUB os&,77
MUL os&,16
ADD os&,191
PUT ls&,os&/yt&,profil_dunkel$
ENDIF
NEXT schritt&
ENDIF
DEFTEXT 1,0,0,13
TEXT 323,388/yt&,"St" !Stckefeld
adj_schreiben(0) ! schreibt nur die W”rter
CLR schreib1$,schreib2$,schreib$,sternchen|,us&,os&,ls&,a$
SETMOUSE MOUSEX,MOUSEY,0
REPEAT
UNTIL MOUSEK=0
REPEAT
UNTIL INKEY$=""
RETURN
REM ____________________________________________________________________Schreiben
PROCEDURE pfeil(col&,p1x&,p2y&,p3x&,p3y&)
hier%=20
REM * LPRINT "pfeil(col&,p1x&,p2y&,p3x&,p3y&)"
~FRE(0)
IF p1x&>0
COLOR col&
DEFLINE col&,6,2,2
DRAW 320,140/yt& TO p1x&,140/yt& TO p1x&,p2y&
DEFLINE col&,6,2,1
DRAW TO p3x&,p3y&
DEFLINE 1,1*yt&,0,0
COLOR 1
alt1x&=p1x&
alt1x&=p1x&
alt2y&=p2y&
alt3x&=p3x&
alt3y&=p3y&
ENDIF
RETURN
PROCEDURE warten1
hier%=21
REM * LPRINT "warten1"
CLR draus!
sltime%=TIMER
REPEAT
ON MENU BUTTON 1,1,1 GOSUB mod_check
IF wrt&=13
IF sltime%<=TIMER-50
sltime%=TIMER
alarm
ENDIF
ENDIF
versch_menues
IF MOUSEK=2
check
ENDIF
UNTIL draus!
RETURN
PROCEDURE warten2
hier%=22
REM * LPRINT "warten2"
REPEAT
UNTIL MOUSEK=0
CLR draus!
sltime%=TIMER
REPEAT
ON MENU BUTTON 1,1,1 GOSUB mod_check
IF wrt&=13
IF sltime%<=TIMER-50
sltime%=TIMER
alarm
ENDIF
ENDIF
versch_menues
IF MOUSEK=2
check
ENDIF
EXIT IF MOUSEK=1
UNTIL draus!
RETURN
PROCEDURE vor_sprung
hier%=23
REM * LPRINT "vor_sprung"
CLR dummy|,a$,a&,b&
SELECT eintrag|
CASE 1 ! Interpre
dummy|=50
a&=ata&
b&=atb&
a$=sainterpret$
CASE 10
dummy|=50
a&=20
b&=5
a$=saorchester$
CASE 11
dummy|=45
a&=20
b&=6
a$=saleitung$
CASE 12
dummy|=50
a&=ata&
b&=atb&
a$=saplatte$
CASE 2 ! Jahr
PRINT AT(71,6);''''''
PRINT AT(71,6);';sajahr&;'
CLR schreib1$,schreib2$,schreib$,sternchen|,sajahr$
IF sajahr&=0
PRINT AT(71,6);SPC(5)
DEFTEXT 1,17,0,8-2*yt&
TEXT 559+4*yt&,88/yt&+yt&,"Jahr"
ENDIF
CASE 3 ! Art
CLR schluessel!,sternchen|
CASE 4 ! Profil
CLR ls&,sternchen|,j&,jr&,jl&
sauebergabe$=@uebergabe$
CASE 5 ! Daten
CLR schreib1$,schreib2$,schreib$,sternchen|
ENDSELECT
IF dummy|
PRINT AT(a&,b&);LEFT$(a$,MIN(dummy|,LEN(a$)));';
IF LEN(a$)>dummy|
PRINT ';
OUT 5,3
ENDIF
CLR schreib1$,schreib2$,schreib$,sternchen|
ENDIF
CLR dummy|,a$,a&,b&
pfeil(0,alt1x&,alt2y&,alt3x&,alt3y&)
RETURN
PROCEDURE mod_check
hier%=24
REM * LPRINT "mod_check"
IF NOT titel|
IF titel_fenster_geoeffnet|=0
CLR marke&
SELECT MOUSEY*yt&
CASE 30 TO 99
SELECT MOUSEX
CASE 25 TO 560 ! eintrag|<>1=Interpreteneintrag
IF modus&=0
SELECT MOUSEY*yt&
CASE 40 TO 70 ! interpreteneintrag
SELECT eintrag|
CASE 0,1
DEFAULT
marke&=1
ENDSELECT
CASE 70 TO 100 ! plattentiteleintrag
SELECT eintrag|
CASE 0,12
DEFAULT
marke&=12
ENDSELECT
ENDSELECT
ELSE IF modus&=1
SELECT MOUSEY*yt&
CASE 30 TO 45 ! interpreteneintrag
SELECT eintrag|
CASE 0,1
DEFAULT
marke&=1
ENDSELECT
CASE 46 TO 61 ! plattentiteleintrag
SELECT eintrag|
CASE 0,12
DEFAULT
marke&=12
ENDSELECT
CASE 62 TO 78 ! orchestereintrag
SELECT eintrag|
CASE 0,10
DEFAULT
marke&=10
ENDSELECT
CASE 78 TO 90 ! leitungeintrag
SELECT eintrag|
CASE 0,11
DEFAULT
marke&=11
ENDSELECT
ENDSELECT
ENDIF
CASE 560 TO 605 ! Jahreintrag
SELECT eintrag|
CASE 0,2
DEFAULT
SELECT MOUSEY*yt&
CASE 70 TO 100
marke&=2
ENDSELECT
ENDSELECT
ENDSELECT
CASE 100 TO 128 ! arteintrag
SELECT eintrag|
CASE 0
CASE 3
SELECT wrt&
CASE 5 TO 7,11,13,14
DEFAULT
ENDSELECT
DEFAULT
marke&=3
ENDSELECT
CASE 170 TO 398 ! unterer Bereich
SELECT MOUSEX
CASE 3 TO 320 ! Profileintrag
SELECT eintrag|
CASE 0,4
DEFAULT
marke&=4
ENDSELECT
CASE 320 TO 635 ! eintrag|<>5=Dateneintrag und Merker
SELECT MOUSEY*yt&
CASE 369 TO
SELECT MOUSEX
CASE 602 TO
IF kein_merker&=0 OR wrt&=10
IF wrt&=10
CLR bst%,zet$
merker_eintrag
ELSE
CLR bst%,zet$
samerker_eintrag
ENDIF
ENDIF
CASE 315 TO 348 ! Stckefeld
SETMOUSE MOUSEX,MOUSEY,0
bst%=29197
draus!=TRUE
DEFAULT ! Zusatzk„stchen
SELECT eintrag|
CASE 0,5
DEFAULT
marke&=5
ENDSELECT
ENDSELECT
DEFAULT ! dateneintrag ohne merker
SELECT eintrag|
CASE 0,5
DEFAULT
marke&=5
ENDSELECT
ENDSELECT
ENDSELECT
CASE 142 TO 168 ! Modus
IF wrt&<>10
SELECT MOUSEX
CASE 7 TO 68
modus(TRUE)
CASE 70 TO 100 ! Klassik als Filter
SELECT wrt&
CASE 5,6,7,11,13,14
IF klassikfilter&=1
PUT 70,148/yt&,hell$,3
CLR klassikfilter&
ELSE
PUT 540,148/yt&,hell$,3
PUT 70,148/yt&,dunkel$,3
klassikfilter&=1
ENDIF
ENDSELECT
REPEAT
UNTIL MOUSEK=0
CASE 540 TO 570 ! U-Musik als Filter
SELECT wrt&
CASE 5,6,7,11,13,14
IF klassikfilter&=2
PUT 540,148/yt&,hell$,3
CLR klassikfilter&
ELSE
PUT 70,148/yt&,hell$,3
PUT 540,148/yt&,dunkel$,3
klassikfilter&=2
ENDIF
ENDSELECT
REPEAT
UNTIL MOUSEK=0
CASE 571 TO 638
modus(TRUE)
ENDSELECT
ENDIF
ENDSELECT
IF marke&
REM * LPRINT "Marke gesetzt und ruecksprung(marke&)"
vor_sprung
CLR bst%,zet$
ruecksprung(marke&)
ENDIF
ENDIF
ENDIF
RETURN
PROCEDURE samerker_eintrag
hier%=25
REM * LPRINT "samerker_eintrag"
IF samerker&=0
samerker&=1
PUT 602,369/yt&,merker_dunkel$
ELSE
CLR samerker&
PUT 602,369/yt&,merker_hell$
ENDIF
REPEAT
UNTIL MOUSEK=0
RETURN
PROCEDURE schreiben
hier%=26
REM * LPRINT "schreiben"
bst%=MENU(14)
bst$=MKI$(bst%)
REM PRINT AT(12,12);USING "########",bst% !,',RIGHT$(bst$);
IF BYTE(bst%)=0
funk&=ASC(LEFT$(bst$))
SELECT funk&
CASE 84 TO 93
SUB funk&,73
CLR zet$,bst%
menue
CASE 59 TO 68
SUB funk&,58
CLR zet$,bst%
menue
ENDSELECT
zet$=CHR$(0)+LEFT$(bst$)
ENDIF
IF LEFT$(bst$)<"@" ! schaltet Ziffernblock aus
zet$=RIGHT$(bst$)
IF nichtschreibend!
IF zet$<>CHR$(13)
CLR zet$
ENDIF
ENDIF
ENDIF
SELECT bst%
CASE 283 ! Escape (1 27)
CLR zet$,bst%
IF BTST(BIOS(11,-1),2)
fvar_loeschen
sa_loeschen
CLR bild$
plattenbild1(FALSE)
ruecksprung(0)
ENDIF
CASE 3592 ! Backspace
IF NOT nichtschreibend!
a&=LEN(schreib1$)
IF a&>=1
schreib1$=LEFT$(schreib1$,a&-1)
ENDIF
ENDIF
CASE 24832 ! Control + Undo
IF makro_aus&=0
IF wrt&<>10
schreib1$=zeilenloesch$
ENDIF
ENDIF
CASE 21279 ! Control + Delete
zeilenloesch$=schreib1$+schreib2$
zeile_geloescht&=1
CLR schreib1$,schreib2$
CASE 21375 ! Delete
zet$=CHR$(127)
IF NOT nichtschreibend!
IF LEN(schreib2$)>=1
schreib2$=RIGHT$(schreib2$,LEN(schreib2$)-1)
ENDIF
ENDIF
CASE 19200 ! Cursor links
IF LEN(schreib1$)>=1
schreib2$=RIGHT$(schreib1$)+schreib2$
schreib1$=LEFT$(schreib1$,LEN(schreib1$)-1)
ENDIF
CASE 19712 ! Cursor rechts
IF LEN(schreib2$)>=1
schreib1$=schreib1$+LEFT$(schreib2$)
schreib2$=RIGHT$(schreib2$,LEN(schreib2$)-1)
ENDIF
CASE 29440 ! Cursor Control links
IF LEN(schreib1$)>=11
schreib2$=RIGHT$(schreib1$,11)+schreib2$
schreib1$=LEFT$(schreib1$,LEN(schreib1$)-11)
ELSE
schreib2$=schreib1$+schreib2$
schreib1$=""
ENDIF
CASE 29696 ! Cursor Control rechts
IF LEN(schreib2$)>=11
schreib1$=schreib1$+LEFT$(schreib2$,11)
schreib2$=RIGHT$(schreib2$,LEN(schreib2$)-11)
ELSE
schreib1$=schreib1$+schreib2$
schreib2$=""
ENDIF
CASE 3849 ! Makro-Output (Tabulator)
IF NOT nichtschreibend!
IF makro_aus&=0
schreib1$=schreib1$+makro$
ENDIF
ENDIF
CASE 5897,6159,9226,9740,12813,9483,7955,5140,26154,6416,8196,7681,5653,4613,12054,12558,4375
IF titel|
schliessen
ENDIF
IF eintrag|
IF nummer|
CLR l$,nummer|,a$
DEFTEXT 0,1,0,9-yt&
TEXT 435,237/yt&-yt&,"Nummer"
DEFTEXT 1,17,0,8-2*yt&
TEXT 435,237/yt&-yt&,"Nummer"
ENDIF
IF land|
CLR land|,l$
DEFTEXT 0,1,0,9-yt&
TEXT 350,237/yt&-yt&,"Land"
DEFTEXT 1,17,0,8-2*yt&
TEXT 350,237/yt&-yt&,"Land"
ENDIF
IF mitspieler|
CLR mitspieler|
CLR schreib1$,schreib2$,schreib$,sternchen|
PRINT AT(48,(18+bvr&));LEFT$(samitspieler$(bvr&),MIN(27,LEN(samitspieler$(bvr&))));';
IF LEN(samitspieler$(bvr&))>27
PUT 608,(18+bvr&-1)*16+2/yt&,pfeil_rechts$ !(Das gleiche wie OUT 5,3)
ENDIF
spieler_linie
COLOR 0
DEFLINE 0,3,0,0
BOX 348,285/yt&,602,369/yt&
COLOR 1
DEFLINE 1,1,0,0
BOX 350,287/yt&,600,367/yt& ! fr Mitspieler
DEFFILL 0,0,0 ! Pfeil verscchwinden
PBOX 322,287/yt&,340,367/yt&
DEFLINE 1,1*yt&,0,0
ENDIF
IF verliehen|
CLR verliehen|
CLR schreib1$,schreib2$,schreib$,sternchen|
PRINT AT(67,16);LEFT$(sverliehen$,MIN(11,LEN(sverliehen$)));';
IF LEN(sverliehen$)>11
PRINT ';
OUT 5,3
ELSE
DRAW 635,240/yt& TO 635,255/yt& ! Lcke schliežen
ENDIF
DEFTEXT 0,1,0,9-yt&
TEXT 485+5*yt&,251/yt&+yt&,"an:"
DEFTEXT 1,17,0,8-2*yt&
TEXT 485+5*yt&,251/yt&+yt&,"an:"
ENDIF
CLR dummy|
SELECT bst%
CASE 26154 ! Mul-Taste Ziffernblock (42 102)
IF wrt&<>10
IF sternchen|
modus(TRUE)
ENDIF
ENDIF
CASE 5897,9483 ! Ctrl+i,k
dummy|=1
ziel%=1
CASE 8196 ! Ctrl+d
dummy|=1
ziel%=5
CASE 7681 ! Ctrl+a
dummy|=1
ziel%=3
CASE 5653,4613 ! Ctrl u,e
IF sternchen|
IF NOT nichtschreibend!
modus(TRUE)
ENDIF
ENDIF
CASE 12054 ! CTRL + v
dummy|=1
verliehen|=1
CLR kr&
ziel%=5
CASE 6416 ! Ctrl+p fr Profil
dummy|=1
ziel%=4
CASE 5140 ! Ctrl+t fr Titel
dummy|=1
ziel%=12
CASE 6159 ! Ctrl+o
CLR bst%
IF modus&=1
vor_sprung
ziel%=10
ENDIF
CASE 9226 ! Ctrl+j
dummy|=1
ziel%=2
CASE 12813,7955 ! Ctrl+m,s
dummy|=1
mitspieler|=1
ziel%=5
CASE 12558 ! Ctrl+n
dummy|=1
nummer|=1
ziel%=5
CASE 9740 ! Ctrl+l
dummy|=1
land|=1
ziel%=5
ENDSELECT
IF dummy|=1
vor_sprung
CLR bst%,dummy|
ENDIF
ruecksprung(ziel%)
ENDIF
ENDSELECT
IF ASC(RIGHT$(bst$))>13
IF zet$<>CHR$(127)
IF ASC(LEFT$(bst$))<60
schreib1$=schreib1$+zet$
ENDIF
ENDIF
ENDIF
IF NOT nichtschreibend!
IF bst%=24638
schreib1$=schreib1$+">"
ELSE IF bst%=24636
schreib1$=schreib1$+"<"
ENDIF
ENDIF
schreib$=schreib1$+schreib2$
draus!=TRUE
CLR bst$
SELECT bst%
CASE 29197 ! CR Ziffernblock (13 114)
k%=MAX(4,k%)
wo%={start2%+k%}
zet$=CHR$(13)+CHR$(114)
CASE 20992 ! Insert (0 82)
zet$=CHR$(0)+CHR$(82)
CASE 20011 ! + Ziffernblock (43 78)
zwischendruck(1)
CLR draus!,zet$,bst%
CASE 18989 ! - Ziffernblock (45 74)
zwischendruck(0)
CLR draus!,zet$,bst%
CLR draus!,zet$,bst%
ENDSELECT
RETURN
PROCEDURE hinschreiben(a%)
hier%=27
REM * LPRINT "hinschreiben(a%)"
schreib$=schreib1$+schreib2$ ! damit Pfeilchen erhalten bleibt wenn
REM man frisch in die Zeile kommt
IF zeile_geloescht&
CLR zeile_geloescht&
b%=CRSCOL
c%=CRSLIN
PRINT SPACE$(a%+3); ! +3, um die Pfeile zu loeschen
LOCATE b%,c%
hinschreiben(1)
ELSE
PRINT CHR$(27);"p";
PRINT LEFT$(schreib2$);
IF LEN(schreib2$)>1
a$=MID$(schreib2$,2)
b%=MAX(a%-LEN(schreib1$),0)
IF b%>0
PRINT CHR$(27);"q";LEFT$(a$,MAX(0,b%-1));';
ENDIF
IF b%=0
PRINT CHR$(27);"q";LEFT$(a$,MAX(0,b%-1));
ENDIF
ENDIF
IF schreib2$=""
PRINT ';
ENDIF
PRINT CHR$(27);"q";
IF LEN(schreib$)>a% !AND schreib2$>""
PRINT ';
OUT 5,3
ELSE
PRINT '';
ENDIF
ENDIF
CLR a$
RETURN
PROCEDURE versch_menues
hier%=28
REM * LPRINT "versch_menues"
ON MENU
ON ERROR GOSUB fehler
ON MENU KEY GOSUB schreiben
ON MENU GOSUB menue
RETURN
REM _________________________________________________________________________Bild
PROCEDURE plattenbild1(flag!)
hier%=29
REM * LPRINT "plattenbild1(flag!)"
~FRE(0)
IF NOT flag!
CLS
DEFFILL 1,2,4
PBOX 10,10/yt&,630,390/yt&
ENDIF
einrichten
IF flag!
CLIP 0,0,640,400/yt&
DEFFILL 1,2,8
PBOX 0,0,640,400/yt&
SWAP lo%,ph%
wechsel
signet
ENDIF
wechsel
CLS
menueleiste
CLIP 0,0,640,400/yt&
LOCATE 1,1
GET 0,2/yt&,7,12/yt&,pfeil_loeschen$
OUT 5,1 ! pfeil_hoch
OUT 5,2 ! pfeil_runter
OUT 5,3 ! pfeil_rechts
OUT 5,4 ! pfeil_links
GET 0,2/yt&,7,12/yt&,pfeil_hoch$
GET 8,2/yt&,15,12/yt&,pfeil_runter$
GET 16,2/yt&,23,12/yt&,pfeil_rechts$
GET 24,2/yt&,31,12/yt&,pfeil_links$
PRINT AT(1,1)'''''
DEFFILL 1,2,4
DEFTEXT 1,0,0,6
TEXT 9,158/yt&,"E-Musik"
TEXT 574,158/yt&,"U-Musik"
b&=214/yt&
FOR schritt&=1 TO 3
a&=schritt&*45
ADD a&,445-45
TEXT a&,b&,UPPER$(LEFT$(debes$(schritt&),1))
NEXT schritt&
IF NOT flag!
adj_schreiben(0) ! ist auch in modus-proc
ENDIF
DEFTEXT 1,17,0,8-2*yt&
TEXT 335+15*yt&,214/yt&,"Besitzer"
TEXT 350,237/yt&-yt&,"Land"
TEXT 570,186/yt&,"Wert"
TEXT 435,237/yt&-yt&,"Nummer"
TEXT 365+15*yt&,269/yt&-yt&,"Zustand schlecht"
TEXT 335+15*yt&,251/yt&+yt&,"Verliehen?"
TEXT 485+5*yt&,251/yt&+yt&,"an:"
TEXT 335+15*yt&,282/yt&,"Mitspieler/Solisten:"
DEFTEXT 1,0,0,4
TEXT 265,135/yt&,"rechte Maustaste"
DEFTEXT 1,17,0,13/yt&
TEXT 270,161/yt&,"šbernahme"
DEFLINE 1,1*yt&,0,0
DRAW 350,303/yt& TO 600,303/yt&
GET 350,303/yt&,600,302/yt&+1*yt&,strich$
a&=145/yt&
b&=165/yt&
BOX 250,a&,380,b& ! fr šbernahme
BOX 5,a&,70,b&! fr Klassik
BOX 570,a&,635,b& ! fr U-Musik
RBOX 3,170/yt&,320,390/yt& ! fr Profil
RBOX 320,170/yt&,635,390/yt& ! fr Daten
BOX 350,287/yt&,600,367/yt& ! fr Mitspieler
BOX 613,179/yt&,623,239/yt& ! fr Wert
BOX 611,179/yt&,625,239/yt& ! fr Wertumrandung
BOX 588,205/yt&,611,225/yt& ! fr Wert (Zahl)
BOX 588,225/yt&,611,239/yt& ! Pfeilk„stchen runter
BOX 588,191/yt&,611,205/yt& ! Pfeilk„stchen rauf
PUT 596,227/yt&,pfeil_runter$
PUT 596,193/yt&,pfeil_hoch$
PRINT AT(76,14);0
spieler_linie
a&=100/yt& ! Grundk„stchen
b&=114/yt&
DEFFILL 1,2,8
PBOX 50,a&,80,b&
COLOR 0
BOX 52,a&+2/yt&,78,b&-2/yt&
COLOR 1
GET 50,a&,80,b&,dunkel$
DEFFILL 1,0,0
PBOX 50,a&,80,b& ! fr Lp
BOX 52,a&+2/yt&,78,b&-2/yt&
GET 50,a&,80,b&,hell$ ! fr Lp
DEFFILL 1,2,4 ! Merker
PBOX 602,369/yt&,635,396/yt&
DEFTEXT 1,0,0,13
TEXT 615,388/yt&,"!"
GET 602,369/yt&,635,396/yt&,merker_dunkel$
DEFFILL 1,0,0
PBOX 602,369/yt&,635,396/yt&
BOX 604,371/yt&,633,394/yt&
DEFTEXT 1,0,0,13
TEXT 615,388/yt&,"!"
GET 602,369/yt&,635,396/yt&,merker_hell$
PUT 315,369/yt&,merker_hell$ ! Stckefeld
TEXT 323,388/yt&,"St"
PBOX 100,191/yt&,160,207/yt&
DEFFILL 1,2,4 ! Profilmuster
PBOX 102,193/yt&,158,205/yt&
GET 100,191/yt&,160,207/yt&,profil_muster$
DEFFILL 1,2,8
PBOX 100,191/yt&,160,207/yt&
COLOR 0
BOX 102,193/yt&,158,205/yt&
COLOR 1
GET 100,191/yt&,160,207/yt&,profil_dunkel$
DEFFILL 1,0,0
PBOX 100,191/yt&,160,207/yt&
BOX 102,193/yt&,158,205/yt&
GET 100,191/yt&,160,207/yt&,profil_hell$
DEFTEXT 1,17,0,4
RESTORE art_text
IF yt&=2
BOX 0,20/yt&,639,399/yt&
ENDIF
b&=110/yt&
FOR schr&=1 DOWNTO 0
FOR schritt&=8 DOWNTO 0
READ a&,c&,a$
EXIT IF a&=0
TEXT a&,b&,a$
NEXT schritt&
b&=124/yt&
NEXT schr&
art_text:
REM obere Reihe:
DATA 35,50,LP
DATA 85,116,DoLP
DATA 151,166,EP
DATA 202,232,Maxi
DATA 266,289,Box
DATA 323,338,CD
DATA 373,404,DoCD
DATA 439,478,CD-EP
DATA 512,565,CD-Maxi
REM untere Reihe:
DATA 36,83,Single
DATA 119,151,Cass
DATA 186,226,Video
DATA 363,434,CD-Single
DATA 468,515,CD-Box
DATA 550,558,?
DATA 0,0," "
artloeschen
a&=223/yt&
BOX 395,223/yt&,425,239/yt& ! fr Land
BOX 500,223/yt&,577,239/yt& ! fr Nummer
RESTORE vollbild_leeren ! Besitzer, Zustand, Verliehen, Mitspieler
DO
READ a&,b&
EXIT IF a&=0
PUT a&,b&/yt&,hell$,3
LOOP
DEFTEXT 1,0,0,6 ! Zusatzkasten 1,2,3
CLR a%
FOR schritt&=365 TO 515 STEP 75
INC a%
TEXT schritt&-10,381/yt&,STR$(a%)
PUT schritt&,370/yt&,profil_hell$
NEXT schritt&
CLR a%
REM DEFTEXT 1,17,0,32/yt&
REM TEXT 108,185/yt&,"Profil"
REM TEXT 425,185/yt&,"Daten"
REM CLR a&
profilkasten
modus&=lieblingsmodus&
kopf_bild(modus&)
IF flag!
kopf_bild(modus&)
REPEAT
UNTIL INKEY$="" AND MOUSEK=0
PRINT CHR$(7);
REPEAT
a$=INKEY$
EXIT IF a$>""
UNTIL MOUSEK
ENDIF
CLR flag!,a$
restaurieren
kopf_bild|=lieblingsmodus&
RETURN
PROCEDURE plattenbild
hier%=30
REM * LPRINT "plattenbild"
~FRE(0)
CLIP 0,0,640,400/yt&
VSYNC
IF LEN(bild$)<32000
plattenbild1(FALSE)
ENDIF
BMOVE VARPTR(bild$),XBIOS(3),32000
IF wrt&>0
DEFLINE 1,4,2,2
BOX 250,145/yt&,380,165/yt&
DEFTEXT 1,17,0,13/yt&
SELECT wrt&
CASE 5,6,7,11,13,14,15
SELECT wrt&
CASE 5,6,7,11
TEXT 270,161/yt&," Filter "
CONT
CASE 13,14
PUT 70,148/yt&,hell$,3 ! fr E-Musik Filteranklick
PUT 540,148/yt&,hell$,3 ! fr U-Musik Filteranklick
ENDSELECT
SELECT wrt&
CASE 5
a$="L "
CASE 6
a$="Z "
CASE 7
a$="D "
CASE 11
a$="E "
CASE 13
a$="SerieL”schen"
CASE 14,15
a$="Serie-Žndern"
ENDSELECT
TEXT 255,161/yt&,a$
CASE 1,3,4
a$=" Žndern "
CASE 9
a$=" Doppel "
CASE 2,8
DEFTEXT 1,17,0,13/yt&
a$=" L”schen! "
CASE 10
DEFTEXT 1,17,0,13/yt&
a$=" Lesen "
CASE 101
a$=SPACE$(9)
ENDSELECT
SELECT wrt&
CASE 1,2,3,4,8,9,10,101
TEXT 270,161/yt&,a$
ENDSELECT
ENDIF
CLR a$,a&,b&
DEFLINE 1,1*yt&,0,0
DEFTEXT 1,0,0,13/yt&
kopf_bild|=lieblingsmodus&
RETURN
PROCEDURE kleines_bild
hier%=31
REM * LPRINT "kleines_bild"
IF yt&=2
BOX 0,20/yt&,639,399/yt&
ENDIF
MENU leiste$()
menuecheck
DEFFILL 1,2,4
PRBOX 15,30/yt&,615,125/yt&
DEFFILL 1,0,0
PRBOX 25,40/yt&,605,70/yt&
PRBOX 25,70/yt&,605,115/yt&
DEFTEXT 1,0,0,6 ! Zusatzkasten 1,2,3
CLR a%
FOR schritt&=365 TO 515 STEP 75
INC a%
TEXT schritt&-10,137/yt&,STR$(a%)
PUT schritt&,125/yt&,profil_hell$
NEXT schritt&
CLR a%
RBOX 25,125/yt&,110,146/yt& ! fr Nummer-Anzeige
freitest
RETURN
PROCEDURE modus(schalter!)
hier%=32
REM * LPRINT "modus(schalter!)"
CLR schreib1$,schreib2$,schreib$,sternchen|
IF schalter!
IF modus&=1
CLR modus&
ELSE IF modus&=0
modus&=1
ENDIF
ENDIF
DEFLINE 1,1*yt&,0,0
pfeil(0,alt1x&,alt2y&,alt3x&,alt3y&)
kopf_bild(modus&)
IF modus&=1
IF saorchester$>""
PRINT AT(20,5);LEFT$(saorchester$,50)+SPACE$(1);
IF LEN(saorchester$)>50
PRINT ';
OUT 5,3
ENDIF
ENDIF
IF saleitung$>""
PRINT AT(20,6);LEFT$(saleitung$,45)+SPACE$(1);
IF LEN(saleitung$)>45
PRINT ';
OUT 5,3
ENDIF
ENDIF
ENDIF
IF sainterpret$>""
PRINT AT(22-2*modus&,4-modus&);LEFT$(sainterpret$,50);';
IF LEN(sainterpret$)>50
PRINT ';
OUT 5,3
ENDIF
ENDIF
IF saplatte$>""
PRINT AT(16+4*modus&,6-modus&*2);LEFT$(saplatte$,50);';
IF LEN(saplatte$)>50
PRINT ';
OUT 5,3
ENDIF
ENDIF
IF sajahr&>0
PRINT AT(71,6);';sajahr&;';
ENDIF
adj_schreiben(0)
IF schalter!
ruecksprung(1)
ENDIF
RETURN
PROCEDURE kopf_bild(b%)
hier%=33
REM * LPRINT "kopf_bild(b%)"
' IF alt1x&>0
' pfeil(0,alt1x&,alt2y&,alt3x&,alt3y&)
' ENDIF
DEFFILL 0,0,0
COLOR 0
PRBOX 25,30/yt&,605,100/yt&! fr Interpret
DEFTEXT 1,17,0,8-2*yt&
SELECT b%
CASE 1
BOX 572,147/yt&,633,163/yt& ! fr U-Musik
DEFFILL 1,0,0
COLOR 1
BOX 7,147/yt&,68,163/yt&! fr Klassik
PRBOX 25,30/yt&,605,100/yt&! fr Interpret
RBOX 560,75/yt&,605,100/yt&! fr Jahr
TEXT 40,44/yt&,"Komponist:"
TEXT 40,59/yt&," Titel:"
TEXT 40,74/yt&,"Orchester:"
TEXT 40,90/yt&," Leitung:"
kopf_bild|=1
DEFAULT
BOX 7,147/yt&,68,163/yt&! fr Klassik
DEFFILL 1,0,0
COLOR 1
BOX 572,147/yt&,633,163/yt& ! fr U-Musik
RBOX 25,40/yt&,605,70/yt&! fr Interpret
RBOX 25,70/yt&,605,100/yt&! fr Plattentitel
RBOX 560,75/yt&,605,100/yt&! fr Jahr
TEXT 40,59/yt&,"Interpret"
TEXT 40,90/yt&,"Titel"
kopf_bild|=0
ENDSELECT
TEXT 559+4*yt&,88/yt&+yt&,"Jahr"
adj_schreiben(0)
RETURN
PROCEDURE adj_schreiben(fuellen!)
hier%=34
REM * LPRINT "adj_schreiben(fuellen!)"
dummy|=24*modus&
FOR schritt&=1 TO 12
b$=SPACE$(11)
RSET b$=adj$(schritt&+dummy|)
PRINT AT(2,12+schritt&);b$;
IF fuellen!
IF adj$(schritt&+dummy|)>""
a$=profil_muster$
ELSE
a$=profil_hell$
ENDIF
a&=schritt&+7
MUL a&,16
ADD a&,63
PUT 100,a&/yt&,a$
ENDIF
NEXT schritt&
FOR schritt&=13 TO 24
b$=SPACE$(11)
LSET b$=adj$(schritt&+dummy|)
PRINT AT(29,schritt&);b$;
IF fuellen!
IF adj$(schritt&+dummy|)>""
a$=profil_muster$
ELSE
a$=profil_hell$
ENDIF
a&=schritt&-5
MUL a&,16
ADD a&,63
PUT 160,a&/yt&,a$
ENDIF
NEXT schritt&
CLR fuellen!,b$,schritt&,dummy|
RETURN
REM _________________________________________________________Dateisatz + Ausgaben
PROCEDURE kleiner_dateisatz
hier%=35
REM * LPRINT "kleiner_dateisatz"
c%=start%+wo%
IF BYTE{c%+12}=255
IF {start%}<>{start2%+schluss_k%}
SUB k%,4
ENDIF
wo%={start2%+k%}
ENDIF
IF k%<=0 ! kein else if !!
IF {start%}={start2%+schluss_k%}
ruecksprung(0)
ENDIF
ENDIF
x|=BYTE{c%+7}
dmodus&=ABS(BTST(x|,7))
dzustand&=ABS(BTST(x|,6))
dverliehen&=(x| AND &X110000)/16
dart&=(x| AND &X1111)
x|=BYTE{c%+13}
dbesitzer&=(x| AND &X11000000)/64
dmerker&=ABS(BTST(x|,0)) ! Merker
dz1&=ABS(BTST(x|,1))
dz2&=ABS(BTST(x|,2))
dz3&=ABS(BTST(x|,3))
dleer%=CARD{c%+8}
djahr&=CARD{c%+10}
sss&=BYTE{c%+6}
SELECT sss&
CASE 20
dnummer%={start%+wo%+14}
dwert&=BYTE{start%+wo%+18}
DEFAULT
CLR dnummer%,dwert&
ENDSELECT
IF BYTE{c%+sss&}=0
dsatz$(0)=CHAR{c%+sss&+1}
sss&=sss&+LEN(dsatz$(0))+2
ELSE
dsatz$(0)="-"
ENDIF
IF BYTE{c%+sss&}=1
dsatz$(1)=CHAR{c%+sss&+1}
ELSE
dsatz$(1)=""
ENDIF
CLR sss&,x|
RETURN
PROCEDURE grosser_dateisatz
hier%=36
REM * LPRINT "grosser_dateisatz"
c%=start%+wo%
IF BYTE{c%+12}=255
IF {start%}<>{start2%+schluss_k%}
SUB k%,4
ENDIF
wo%={start2%+k%}
ENDIF
IF k%<=0 ! kein else if !! bei l”schen
IF {start%}={start2%+schluss_k%}
ruecksprung(0)
ENDIF
ENDIF
ERASE dsatz$()
DIM dsatz$(20)
x|=BYTE{c%+7}
dmodus&=ABS(BTST(x|,7))
modus&=dmodus&
dzustand&=ABS(BTST(x|,6))
dverliehen&=(x| AND &X110000)/16
dart&=(x| AND &X1111)
x|=BYTE{c%+13}
dbesitzer&=(x| AND &X11000000)/64
dmerker&=ABS(BTST(x|,0)) ! Merker
dz1&=ABS(BTST(x|,1))
dz2&=ABS(BTST(x|,2))
dz3&=ABS(BTST(x|,3))
dleer%=CARD{c%+8}
djahr&=CARD{c%+10}
sss&=BYTE{c%+6}
SELECT sss&
CASE 20
dnummer%={start%+wo%+14}
dwert&=BYTE{start%+wo%+18}
DEFAULT
CLR dnummer%,dwert&
ENDSELECT
DO
hol&=BYTE{c%+sss&}
EXIT IF hol&>20
EXIT IF hol&=254
dsatz$(hol&)=CHAR{c%+sss&+1}
sss&=sss&+LEN(dsatz$(hol&))+2
LOOP
CLR sss&,hol&
RETURN
PROCEDURE vollbild_leeren
hier%=37
REM * LPRINT "vollbild_leeren"
CLR a&
IF alt_uebergabe$>""
FOR schritt&=1 TO LEN(sauebergabe$)
a$=MID$(alt_uebergabe$,schritt&,1)
SELECT BYTE{V:a$}
CASE TO 76
ls&=100
a&=65
CASE 77 TO
ls&=160
a&=77
ENDSELECT
IF a&
os&=ASC(a$)
SUB os&,a&
MUL os&,16
ADD os&,191
PUT ls&,os&/yt&,profil_hell$
CLR a&
ENDIF
NEXT schritt&
ENDIF
artloeschen
DEFFILL 1,0,0
PBOX 395,223/yt&,425,239/yt& ! fr Land
PBOX 500,223/yt&,577,239/yt& ! fr Nummer
PUT 365,370/yt&,profil_hell$ ! saz1&
PUT 440,370/yt&,profil_hell$ ! saz2&
PUT 515,370/yt&,profil_hell$ ! saz3&
RESTORE vollbild_leeren
DO
READ a&,b&
EXIT IF a&=0
PUT a&,b&/yt&,hell$
LOOP
vollbild_leeren:
DATA 455,241,545,258,455,204,500,204,545,204,0,0
RETURN
PROCEDURE grosse_ausgabe
hier%=38
REM * LPRINT "grosse_ausgabe"
~FRE(0)
freitest
IF NOT aus_dem_keller&
SELECT wrt&
CASE 5,6,7,11,13,14 ! Testen (Export?)
DEFAULT
sa_gleich_d
ENDSELECT
ENDIF
CLR aus_dem_keller&
IF modus&<>kopf_bild|
kopf_bild(modus&)
ENDIF
'
'
IF wiederholung!
IF fmodus&<>kopf_bild|
kopf_bild(fmodus&)
ENDIF
ENDIF
alt_uebergabe$=sauebergabe$
IF modus&=1
a$=SPACE$(50)
LSET a$=saorchester$
PRINT AT(20,5);a$;
IF LEN(saorchester$)>50
PRINT '';
OUT 5,3
ELSE
PRINT ''';
ENDIF
a$=SPACE$(45)
LSET a$=saleitung$
PRINT AT(20,6);a$;
IF LEN(saleitung$)>45
PRINT '';
OUT 5,3
ELSE
PRINT ''';
ENDIF
ENDIF
a$=SPACE$(50)
LSET a$=sainterpret$
PRINT AT(22-2*modus&,4-modus&);a$;
IF LEN(sainterpret$)>50
PRINT SPACE$(2);
OUT 5,3
ELSE
PRINT SPACE$(3);
ENDIF
a$=SPACE$(50)
LSET a$=saplatte$
PRINT AT(16+4*modus&,6-modus&*2);a$;
IF LEN(saplatte$)>50
PRINT SPACE$(2);
OUT 5,3
ELSE
PRINT SPACE$(3);
ENDIF
IF sajahr&=0
PRINT AT(71,6);SPACE$(5);
DEFTEXT 1,17,0,8-2*yt&
TEXT 559+4*yt&,88/yt&+yt&,"Jahr"
ELSE
PRINT AT(71,6);';sajahr&
ENDIF
IF samerker&=1 ! Merker
PUT 602,369/yt&,merker_dunkel$
ELSE
PUT 602,369/yt&,merker_hell$
ENDIF
CLR a_pl&,a&
SELECT saart&
CASE 1 TO 5,9 TO 12
a&=100/yt&
CASE 6 TO 8,13 TO 15
a&=114/yt&
ENDSELECT
SELECT saart&
CASE 1
a_pl&=50
CASE 2
a_pl&=338
CASE 3
a_pl&=116
CASE 4
a_pl&=404
CASE 5
a_pl&=232
CASE 6
a_pl&=83
CASE 7
a_pl&=434
CASE 8
a_pl&=151
CASE 9
a_pl&=166
CASE 10
a_pl&=289
CASE 11
a_pl&=478
CASE 12
a_pl&=565
CASE 13
a_pl&=515
CASE 14
a_pl&=226
CASE 15
a_pl&=558
ENDSELECT
IF a_pl&
PUT a_pl&,a&,dunkel$,3
ENDIF
IF sanummer%
PRINT AT(64,15);USING "#########",sanummer%
BOX 500,223/yt&,577,239/yt&
ENDIF
DEFFILL 1,0,0 ! sawert1&
VSYNC
PBOX 613,179/yt&,623,239/yt& ! fr Wert
DEFFILL 1,2,8
IF wrt&=5 ! Filterlesen
a&=MIN(239,(239+6-MIN(sawert1&,sawert2&)*6))/yt&
b&=MIN(239,(239+6-MAX(sawert1&+1,sawert2&+1)*6))/yt&
PBOX 613,b&,623,a&
ELSE
PBOX 613,(239-sawert1&*6)/yt&,623,239/yt&
ENDIF
PRINT AT(75,14);USING "##",sawert1&
CLR dummy|
CLR a_pl&,a&,b&
IF wiederholung!
CLR wiederholung!
IF BTST(f_art&,0)
PUT 50,100/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,1)
PUT 338,100/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,2)
PUT 116,100/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,3)
PUT 404,100/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,4)
PUT 232,100/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,5)
PUT 83,114/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,6)
PUT 434,114/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,7)
PUT 151,114/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,8)
PUT 166,100/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,9)
PUT 289,100/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,10)
PUT 478,100/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,11)
PUT 565,100/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,12)
PUT 515,114/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,13)
PUT 226,114/yt&,dunkel$,3
ENDIF
IF BTST(f_art&,14)
PUT 558,114/yt&,dunkel$,3
ENDIF
IF klassikfilter&=1
PUT 70,148/yt&,dunkel$,3
ELSE IF klassikfilter&=2
PUT 540,148/yt&,dunkel$,3
ENDIF
ENDIF
IF saz1&
PUT 365,370/yt&,profil_dunkel$
ENDIF
IF saz2&
PUT 440,370/yt&,profil_dunkel$
ENDIF
IF saz3&
PUT 515,370/yt&,profil_dunkel$
ENDIF
SELECT sabesitzer&
CASE 1,2,3
a&=sabesitzer&*45
ADD a&,455-45
PUT a&,204/yt&,dunkel$,3
ENDSELECT
IF saland$>""
PRINT AT(51,15);saland$
ENDIF
IF sazustand&=1
PUT 545,258/yt&,dunkel$,3
ENDIF
IF sverliehen&=1 OR sverliehen&=2
PUT 455,241/yt&,dunkel$,3 ! fr verliehen
ENDIF
a$=SPACE$(11)
LSET a$=sverliehen$
PRINT AT(67,16);a$;
IF LEN(sverliehen$)>11
PRINT SPACE$(2);
OUT 5,3
ELSE
PRINT SPACE$(3);
DRAW 635,240/yt& TO 635,255/yt& ! Lcke schliežen
ENDIF
FOR schritt&=1 TO 5
IF LEN(samitspieler$(schritt&))<=27
a$=SPACE$(27)
LSET a$=samitspieler$(schritt&)
PRINT AT(48,18+schritt&);a$;SPACE$(3);
ELSE
a$=SPACE$(27)
LSET a$=samitspieler$(schritt&)
PRINT AT(48,18+schritt&);a$;SPACE$(2);
OUT 5,3
ENDIF
NEXT schritt&
spieler_linie
IF sauebergabe$>""
FOR schritt&=1 TO LEN(sauebergabe$)
a$=MID$(sauebergabe$,schritt&,1)
IF ASC(a$)<77
ls&=100
os&=ABS(ASC(a$)-65)*16+191
PUT ls&,os&/yt&,profil_dunkel$
ELSE IF ASC(a$)>=77
ls&=160
os&=ABS(ASC(a$)-77)*16+191
PUT ls&,os&/yt&,profil_dunkel$
ENDIF
NEXT schritt&
ENDIF
CLR os&,us&,ls&,a$
freitest
RETURN
PROCEDURE kleine_ausgabe
hier%=39
REM * LPRINT "kleine_ausgabe"
SELECT wrt&
CASE 12,13,7 ! Import,Serienl”schen,Filterdrucken
DEFAULT
DEFMOUSE 0
ENDSELECT
a$=SPACE$(60)
LSET a$=dsatz$(0)
PRINT AT(8,4);a$;
IF LEN(dsatz$(0))>60
PRINT ';
OUT 5,3
ELSE
PRINT '';
ENDIF
a$=SPACE$(60)
LSET a$=dsatz$(1)
ljahr$=SPACE$(4)
IF djahr&>0
LSET ljahr$=STR$(djahr&)
ENDIF
PUT 365,125/yt&,profil_hell$
PUT 440,125/yt&,profil_hell$
PUT 515,125/yt&,profil_hell$
IF dz1&
PUT 365,125/yt&,profil_muster$
ENDIF
IF dz2&
PUT 440,125/yt&,profil_muster$
ENDIF
IF dz3&
PUT 515,125/yt&,profil_muster$
ENDIF
IF LEN(dsatz$(1))<60
PRINT AT(8,6);a$;''';ljahr$;
ELSE
PRINT AT(8,6);a$;';
OUT 5,3
PRINT ';ljahr$;
ENDIF
a$=SPACE$(24)
IF dbesitzer&>0
LSET a$=" ("+debes$(dbesitzer&)+")"
ENDIF
PRINT AT(20,7);a$
SELECT dzustand&
CASE 0
PRINT AT(45,7);SPACE$(20)
CASE 1
PRINT AT(45,7);"(schlechter Zustand)"
ENDSELECT
SELECT dverliehen&
CASE 0
PRINT AT(65,7);SPACE$(11)
DEFAULT
PRINT AT(65,7);"(verliehen)"
ENDSELECT
PRINT AT(8,7);zaart$(dart&)
PRINT AT(5,9);USING "#########",dnummer%
IF kein_merker&=0
IF dmerker&
PUT 602,369/yt&,merker_dunkel$
ELSE
PUT 602,369/yt&,merker_hell$
ENDIF
ENDIF
CLR a$,ljahr$
freitest
RETURN
PROCEDURE lesen
hier%=40
REM * LPRINT "lesen"
ON MENU BUTTON 1,1,1 GOSUB dummy
freitest
LOCAL teil,xx&,yy&
IF wrt&=0
wrt&=10
ENDIF
k%=MIN(k%,schluss_k%-8)
k%=MAX(k%,4)
teil=580/(schluss_k%-4)
teil=ROUND(teil,3)
CLS
MENU leiste$()
menuecheck
kleines_bild
lesebild
DO
a&=INT(k%*teil)
ADD a&,25
SPRITE slide$,a&,305/yt&
a&=k%
DIV a&,4
PRINT AT(37,12);USING "#####",a&
wo%={start2%+k%}
kleiner_dateisatz
kleine_ausgabe
IF dmerker&
PUT 602,369/yt&,merker_dunkel$ ! Merker
ELSE
PUT 602,369/yt&,merker_hell$
ENDIF
DEFTEXT 1,0,0,13
PUT 315,369/yt&,merker_hell$ ! Stckefeld
TEXT 323,388/yt&,"St"
CLR zet$,bst%
REPEAT
REPEAT
versch_menues
CLR a&
SELECT bst%
CASE 29696
k%=ADD(k%,40)
a&=TRUE
CASE 29440
k%=SUB(k%,40)
a&=TRUE
CASE 19712
ADD k%,4
a&=TRUE
CASE 19200
SUB k%,4
a&=TRUE
CASE 14624 ! Leerzeichen
l_wrt&=wrt&
ON MENU KEY GOSUB dummy
grosser_dateisatz
wrt&=101
plattenbild
grosse_ausgabe
DO
tail%=CARD{XBIOS(14,1)+8} ! Tail: Zeiger auf n„chstes Zeichen
~GEMDOS(6,255)
PAUSE 10
head%=CARD{XBIOS(14,1)+6} ! Head
EXIT IF tail%=CARD{XBIOS(14,1)+8} !AND head%=tail%
LOOP
REPEAT
ON MENU
~GEMDOS(6,255)
a%=MENU(14)
UNTIL a%=0
wrt&=l_wrt&
CLR bst%,zet$,head%,tail%,a%,l_wrt&
ON MENU KEY GOSUB schreiben
lesen
CASE 29197
titel(TRUE,58)
DEFFILL 0,0,0
PRBOX 3,145/yt&,640,390/yt& ! fr Schallplattentitel
lesebild
a&=TRUE
ENDSELECT
EXIT IF a&
EXIT IF bst%=7181
CLR dummy|
IF MOUSEK=1
SELECT MOUSEY*yt&
CASE 280 TO 330
SELECT MOUSEX
CASE 25 TO 605
dummy|=5 ! Spriteklick
ENDSELECT
CASE 369 TO 398 ! Merker
SELECT MOUSEX
CASE 602 TO 638
merker_eintrag
CASE 315 TO 348 ! Stckefeld
SETMOUSE MOUSEX,MOUSEY,0
bst%=29197
draus!=TRUE
ENDSELECT
ENDSELECT
ENDIF
EXIT IF dummy|=5 ! Spriteklick
UNTIL MOUSEK=2
EXIT IF a&
xx&=MOUSEX
yy&=MOUSEY*yt&
IF MOUSEK=2
SELECT xx&
CASE 250 TO 380
SELECT yy&
CASE 245 TO 265
bst%=7181
ENDSELECT
ENDSELECT
ENDIF
IF bst%=7181
SELECT wrt&
CASE 2
wrt&=8 ! ganzloeschen
IF schluss_k%=8
ruecksprung(0)
ENDIF
grosser_dateisatz
aendern_loeschen_vollbild
CASE 9,1
IF wrt&=1
wrt&=4
ENDIF
grosser_dateisatz
aendern_loeschen_vollbild
CASE 10
IF wrt&=10
~FRE(0)
plattenbild
grosser_dateisatz
grosse_ausgabe
nichtschreibend!=TRUE
ruecksprung(1)
ENDIF
ENDSELECT
ENDIF
IF dummy|=5 ! Spriteklick
a%=schluss_k%-4
b&=xx&
SUB b&,25
MUL a%,b&
DIV a%,2320
MUL a%,4
a%=MAX(a%,4)
k%=MIN(a%,schluss_k%-8)
SPRITE slide$,xx&,305/yt&
CLR xx&
draus!=TRUE
ENDIF
EXIT IF dummy|=5
EXIT IF draus!
UNTIL MOUSEK=1
k%=MIN(k%,schluss_k%-8)
k%=MAX(k%,4)
CLR zet$,bst%,draus!,dummy|
LOOP
RETURN
PROCEDURE lesebild
hier%=41
REM * LPRINT "lesebild"
PRINT AT(30,15);
OUT (5),4
PRINT AT(32,15);"links rechts ";
OUT (5),3
PRINT AT(40,22);"oder"
PRINT AT(36,23);"Maussteuerung"
DEFFILL 1,0,0
RBOX 25,280/yt&,605,330/yt& ! fr slide
RBOX 23,278/yt&,607,332/yt&
SELECT wrt&
CASE 1,2,9,10
BOX 250,245/yt&,380,265/yt&
DEFTEXT 1,17,0,13/yt&
SELECT wrt&
CASE 2
a&=270
a$=" L”schen "
CASE 1
a&=270
a$=" Žndern"
CASE 9
a&=270
a$=" Doppel"
CASE 10
a&=273
a$="Vollbild"
ENDSELECT
TEXT a&,260/yt&,a$
DEFTEXT 1,0,0,4
TEXT 264,272/yt&,"(rechte Maustaste)"
DEFTEXT 1,0,0,13
ENDSELECT
IF dmerker&=1 ! Merker
PUT 602,369/yt&,merker_dunkel$
ELSE
PUT 602,369/yt&,merker_hell$
ENDIF
DEFTEXT 1,0,0,13
PUT 315,369/yt&,merker_hell$ ! Stckefeld
TEXT 323,388/yt&,"St"
RETURN
PROCEDURE aendern_loeschen_vollbild
hier%=42
REM * LPRINT "aendern_loeschen_vollbild"
freitest
k%=MAX(k%,4)
grosser_dateisatz
plattenbild
DO ! kein EXIT
vollbild_leeren
IF dmodus&<>kopf_bild|
kopf_bild(modus&)
ENDIF
grosse_ausgabe
CLR draus!,zet$,bst%
REPEAT
UNTIL MOUSEK=0
REPEAT
versch_menues
IF MOUSEK=1
SELECT MOUSEY*yt&
CASE 369 TO 398 ! Merker
SELECT MOUSEX
CASE 602 TO 638
merker_eintrag
CASE 315 TO 348 ! Stckefeld
SETMOUSE MOUSEX,MOUSEY,0
bst%=29197
draus!=TRUE
ENDSELECT
ENDSELECT
ENDIF
IF MOUSEK=2
REPEAT
UNTIL MOUSEK=0
xx&=MOUSEX
yy&=MOUSEY*yt&
SELECT yy&
CASE 145 TO 165
SELECT xx&
CASE 250 TO 380
SELECT wrt&
CASE 3,4,9
bst%=7181
CASE 8
DEFFILL 1,2,8
PBOX 250,145/yt&,380,165/yt&
loeschen
IF {start%}={start2%+schluss_k%}
ruecksprung(0)
ENDIF
a%={start2%}
IF CARD{start%+a%}=999 OR BYTE{start%+{start%}+12}=255
ruecksprung(0)
ENDIF
funk&=3
menue
ENDSELECT
ENDSELECT
ENDSELECT
REPEAT
UNTIL MOUSEK=0
ENDIF
SELECT bst%
CASE 29197
titel(TRUE,30)
schliessen
CLR draus!,bst%,zet$
CASE 19712
IF k%4
SUB k%,4
wo%={start2%+k%}
grosser_dateisatz
ENDIF
CASE 7181
SELECT wrt&
CASE 3,4
wrt&=4
CLR nichtschreibend!
ruecksprung(1)
CASE 9
DEFFILL 1,2,8
PBOX 250,145/yt&,380,165/yt&
grosser_dateisatz
abgabe
CASE 8 ! ganzloeschen
CLR draus!
ENDSELECT
DEFAULT
CLR draus!
ENDSELECT
UNTIL draus!
REPEAT
UNTIL MOUSEK=0
LOOP
RETURN
PROCEDURE merker_eintrag
hier%=43
REM * LPRINT "merker_eintrag"
merker_stand%=1
wo%={start2%+k%}
BYTE{start%+wo%+13}=BCHG(BYTE{start%+wo%+13},0)
IF BTST(BYTE{start%+wo%+13},0)=TRUE
PUT 602,369/yt&,merker_dunkel$
ELSE IF BTST(BYTE{start%+wo%+13},0)=FALSE
PUT 602,369/yt&,merker_hell$
ENDIF
REPEAT
UNTIL MOUSEK=0
PAUSE 5
RETURN
REM ____________________________________________________________________Variablen
PROCEDURE sa_loeschen
hier%=44
REM * LPRINT "sa_loeschen"
CLR saorchester$,saleitung$,saplatte$,sajahr&,saart&,sauebergabe$,sabesitzer&
CLR saland$,sazustand&,sverliehen&,sverliehen$,sainterpret$
ERASE samitspieler$(),klein$(),safenster$()
DIM samitspieler$(6),klein$(24),safenster$(100)
ERASE fragezaehler&(),fragebreite&(),fragehoch&() ! aus platten_pro_besitzer
CLR schreib1$,schreib2$,schreib$
CLR samerker&,saz1&,saz2&,saz3&
CLR sanummer%,sawert1&,sawert2&
RETURN
PROCEDURE sa_gleich_d
hier%=45
REM * LPRINT "sa_gleich_d"
sa_loeschen
modus&=dmodus&
sainterpret$=dsatz$(0)
saplatte$=dsatz$(1)
saorchester$=dsatz$(2)
saleitung$=dsatz$(3)
sajahr&=djahr&
saart&=dart&
sverliehen&=dverliehen&
sauebergabe$=dsatz$(4)
sabesitzer&=dbesitzer&
samerker&=dmerker& ! Merker
saz1&=dz1&
saz2&=dz2&
saz3&=dz3&
saland$=dsatz$(5)
sazustand&=dzustand&
sverliehen$=dsatz$(6)
sawert1&=dwert&
sanummer%=dnummer%
samitspieler$(1)=dsatz$(7)
samitspieler$(2)=dsatz$(8)
samitspieler$(3)=dsatz$(9)
samitspieler$(4)=dsatz$(10)
samitspieler$(5)=dsatz$(11)
IF dsatz$(12)>""
CLR anz&,stelle&,tth&
WHILE INSTR(dsatz$(12),CHR$(244),stelle&)>0
anz&=INSTR(stelle&,dsatz$(12),CHR$(244))-stelle&
safenster$(tth&)=MID$(dsatz$(12),stelle&,anz&)
stelle&=stelle&+anz&
INC stelle&
INC tth&
WEND
CLR anz&,stelle&,tth&
ENDIF
RETURN
PROCEDURE fvar_loeschen
hier%=46
REM * LPRINT "fvar_loeschen"
ERASE fsatz$()
DIM fsatz$(20)
CLR fjahr&,fart&,fbesitzer&,fzustand&,fverliehen&,fmodus&,f_art&,fprofl&
CLR klassikfilter&,fmerker&,fz1&,fz2&,fz3& ! Merker
CLR fnummer%,fwert1&,fwert2&
RETURN
REM _________________________________________________________________________Men
PROCEDURE check
hier%=47
REM * LPRINT "check"
xx&=MOUSEX
yy&=MOUSEY*yt&
~FRE(0)
IF MOUSEK=2
SELECT xx&
CASE 250 TO 380
SELECT yy&
CASE 145 TO 165
REPEAT
UNTIL MOUSEK=0
CLR xx&,yy&
DEFFILL 1,2,8
PBOX 250,145/yt&,380,165/yt&
SELECT wrt&
CASE 5,6 ! filterlisten und filterzahl
CLR abnehmen! ! im Filtervergleich "wo%" zunimmt(abnehmen! aus filterlesen)
filtervergleich
CASE 14 ! Serie-Žndern
CLR abnehmen!
filtervergleich
CASE 15 ! weiter Serie-Žndern
loeschen
abgabe_wandeln
abgabe
a%=C:k22_finden%(L:start%,L:start2%)
wo%={start2%+a%}
IF a%0
SELECT menu|
CASE 11 TO 17,26,34,38
IF alt_katalog$>""
SELECT menu|
CASE 11 TO 17 ! Erster Menblock (Eingabe)
ALERT 0," -Die Datei ist umsortiert- |Diese Aktion verhindert die | M”glichkeit der schnellen | Rckstellung",1,"zurck|weiter",dummy|
CASE 26,34,38 ! Export, Zwischenspeichern, Sicherheitskopie
ALERT 0," -Die Datei ist umsortiert- | | Die Datei wird daher | umsortiert abgespeichert ",1,"zurck|weiter",dummy|
ENDSELECT
IF dummy|=1
GOTO menu_ende
ENDIF
CLR dummy|
ENDIF
ENDSELECT
ENDIF
SELECT menu|
CASE 1 ! Voreinstellung
ludwig
a$=SPACE$(1)+CHR$(189)+SPACE$(1)+MID$(ludwig$,5,6)+", "+MID$(ludwig$,11,11)+"| "
CLR dummy|
ALERT 0," "+ident$+" "+version$+" |"+a$+"| Voreinstellung „ndern?",1,"„ndern|Programm",dummy|
CLR funk&,menu|,eintrag|
IF dummy|=1
voreinstellung
ruecksprung(0)
ENDIF
IF dummy|=2
ruecksprung(0)
ENDIF
CASE 11 ! Neue Platte
CLR funk&,menu|
ruecksprung(0)
CASE 43 ! Abbruch ohne Speichern
CLR funk&,menu|,dummy|,eintrag|
safeguard
endkasten
CASE 39 ! Kopie derSicherheitskopie
CLR funk&,menu|,eintrag|
safe_to_use
CASE 35 ! Neue Maske laden
CLR funk&,bild$,menu|,eintrag|
neue_maske
CASE 17 ! Import
CLR menu|,funk&,eintrag|
~C:setz33%(L:start%)
sa_loeschen
wrt&=12
import
CASE 46 ! Makro-Input
CLR funk&,menu|
DEFFILL 1,0,0
GET 10,312/yt&,628,342/yt&,makro_ersatz$
PBOX 10,312/yt&,628,342/yt&
BOX 12,314/yt&,626,340/yt&
PRINT AT(4,21);"Makro: ";
FORM INPUT 66 AS makro$
PUT 10,312/yt&,makro_ersatz$
CLR makro_ersatz$
GOTO menu_ende
CASE 48 ! Klick
CLR funk&,menu|,a&
a&=PEEK(&H484)
IF BTST(a&,0)
leiste$(48)=" Klick an "
ELSE
leiste$(48)=" Klick aus "
ENDIF
a&=BCHG(a&,0)
SPOKE &H484,a&
MENU leiste$()
menuecheck
CLR a&
GOTO menu_ende
CASE 47 ! Glocke
CLR funk&,menu|,a&
a&=PEEK(&H484)
IF BTST(a&,2)
leiste$(47)=" Glocke an "
ELSE
leiste$(47)=" Glocke aus "
ENDIF
a&=BCHG(a&,2)
SPOKE &H484,a&
MENU leiste$()
menuecheck
CLR a&
GOTO menu_ende
CASE 36 ! Neue Datei laden
kriterium&=0
CLR funk&,menu|,dummy|,eintrag|
safeguard_signal
a%=@letzter_satz
b%=CARD{a%+8}+(BYTE{a%+7} AND &X110000)/16
IF k_stand%<>a% OR ledel%<>b%
ALERT 1," | Datei wurde ver„ndert! | |Trotzdem nicht abspeichern? ",1," Laden | zurck ",dummy|
ENDIF
IF dummy|=0
IF merker_stand%=1
alt_k%=k%
katalog
FOR k%=4 TO schluss_k%-8 STEP 4
wo%={start2%+k%}
IF BTST(BYTE{start%+wo%+13},0)
ALERT 1," | Merker sind gesetzt! | |Trotzdem nicht abspeichern? ",1," Laden | zurck ",dummy|
EXIT IF TRUE
ENDIF
NEXT k%
k%=alt_k%
ENDIF
ENDIF
IF dummy|=2
CLR dummy|
zwischenspeichern
ruecksprung(0)
ELSE
CLS
datload(-1)
ruecksprung(0)
ENDIF
ENDSELECT
REM - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
IF schluss_k%=8
CLR funk&,menu|
ALERT 1,"| Es ist noch keine Platte| eingetragen! ",1,weiter$,dummy|
CLR dummy|
ENDIF
REM - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
SELECT menu|
CASE 13 ! Serie-Žndern
CLR funk&,menu|,eintrag|
~C:setz33%(L:start%)
CLR schreib1$,schreib2$,schreib$,sternchen|,f_art&
CLR nichtschreibend!
sa_loeschen
fvar_loeschen
wrt&=14
modus&=lieblingsmodus&
plattenbild
ruecksprung(1)
CASE 49 ! Merker l”schen
alt_k%=k%
CLR funk&,menu|,samerker&
katalog
FOR k%=4 TO schluss_k%-8 STEP 4
wo%={start2%+k%}
BYTE{start%+wo%+13}=BCLR(BYTE{start%+wo%+13},0)
NEXT k%
PUT 602,369/yt&,merker_hell$
k%=alt_k%
CASE 50 ! Merker setzen
alt_k%=k%
CLR funk&,menu|
katalog
FOR k%=4 TO schluss_k%-8 STEP 4
wo%={start2%+k%}
BYTE{start%+wo%+13}=BSET(BYTE{start%+wo%+13},0)
NEXT k%
PUT 602,369/yt&,merker_dunkel$
samerker&=1
k%=alt_k%
CASE 52 ! ASCII-Export
CLR funk&,menu|
ascii_export
CASE 53 ! Letzter Eintrag
CLR funk&,menu|
aus_dem_keller
CASE 51 ! Sortieren
CLR funk&,menu|
sortieren|=1
sortieren
ruecksprung(0)
CASE 20 ! Lesen
CLR wrt&,eintrag|
k%=MAX(k%,4)
lesen
CASE 31 ! Platten pro Besitzer
CLR eintrag|
CLS
platten_pro_besitzer
CASE 34 ! Zwischenspeichern
CLR eintrag|
kein_merker&=1
zwischenspeichern
ruecksprung(0)
CASE 42 ! Ende mit Speichern
CLR eintrag|,menu|,funk&
zwischenspeichern
endkasten
CASE 12 ! Žndern
CLR eintrag|
wrt&=1
sa_loeschen
lesen
CASE 21 ! Filterlesen
CLR schreib1$,schreib2$,schreib$,sternchen|
CLR sternchen|,f_art&,eintrag|
sa_loeschen
fvar_loeschen
wrt&=5
plattenbild
IF modus&<>lieblingsmodus&
modus&=lieblingsmodus&
kopf_bild(lieblingsmodus&)
ENDIF
CLR nichtschreibend!
ruecksprung(1)
CASE 14 ! L”schen
CLR eintrag|
wrt&=2
lesen
CASE 25 ! Vollbild
CLR eintrag|
wrt&=3
IF wo%=0
ADD k%,4
wo%={start2%+k%}
ELSE IF CARD{start%+wo%+8}=999
SUB k%,4
wo%={start2%+k%}
ENDIF
grosser_dateisatz
aendern_loeschen_vollbild
CASE 38 ! Sicherheitskopie
CLR eintrag|
kein_merker&=1
sicherheitskopie
ruecksprung(0)
CASE 30 ! Filterz„hlen
CLR schreib1$,schreib2$,schreib$,eintrag|
CLR sternchen|,f_art&,nichtschreibend!
fvar_loeschen
sa_loeschen
wrt&=6
plattenbild
IF modus&<>lieblingsmodus&
modus&=lieblingsmodus&
kopf_bild(lieblingsmodus&)
ENDIF
ruecksprung(1)
CASE 22 ! Alle Platten drucken
CLR dummy|,eintrag|
ALERT 1," Achtung! | Ein Ausdruck der gesamten | Liste kostet Zeit und | viel Papier!",2," Drucken | Abbruch ",dummy|
IF dummy|=2
ruecksprung(0)
ENDIF
IF dsatz$(0)=CHR$(255)
SUB k%,4
wo%={start2%+k%}
kleiner_dateisatz
ENDIF
wrt&=7
filterdummy&=TRUE
CLR schreib1$,schreib2$,schreib$,sternchen|
fvar_loeschen
sa_loeschen
CLS
zumabbrechen
kleines_bild
filtervergleich
CASE 23 ! Filterdrucken
CLR schreib1$,schreib2$,schreib$,sternchen|
CLR eintrag|,f_art&,nichtschreibend!
sa_loeschen
fvar_loeschen
CLR filterdummy&
wrt&=7
plattenbild
' IF modus&<>lieblingsmodus&
' kopf_bild(modus&)
' ENDIF
IF modus&<>lieblingsmodus&
modus&=lieblingsmodus&
kopf_bild(lieblingsmodus&)
ENDIF
ruecksprung(1)
CASE 24 ! Ausdruck aller Daten
CLR dummy|,eintrag|
ALERT 1," Achtung! | Ein Ausdruck der gesamten | Liste kostet Zeit und | viel Papier!",2," Drucken | Abbruch ",dummy|
IF dummy|=2
ruecksprung(0)
ENDIF
wrt&=7
filterdummy&=TRUE
parole!=TRUE
fvar_loeschen
CLS
zumabbrechen
kleines_bild
filtervergleich
CASE 37 ! Datei prfen
kein_merker&=1
modus_merken|=modus&
pruefen
modus&=modus_merken|
CLR modus_merken|,kein_merker&
CASE 29 ! Gesamtzahl(jetzt Info)
kein_merker&=1
zahl%=C:statistik%(L:start%)-2
c%=zahl%
ADD zahl%,2 ! fr Anfangs- und Schlusssatz
zahl%=schlussb%/zahl%
REM a%=MALLOC(-1)-puffer%+arbeitsraum%-(39500*final&) !39458=Letzter Aufruf
a%=MALLOC(-1)+arbeitsraum%-50000 !39458=Letzter Aufruf,10000 wird aufgerufen
b%=a%/zahl%
a$="Gesamtzahl: "+STR$(c%)
a$=a$+" |Mittlere Satzl„nge "+STR$(zahl%)+" Bytes "
a$=a$+" |Dateil„nge "+STR$(schlussb%)+" Bytes"
a$=a$+" |Platz fr "+STR$(b%)+" Platten"
ALERT 0,a$,1,weiter$,dummy|
CLR dummy|,zahl%,a%,kein_merker&,c%,a$,b%
CASE 16 ! Verdoppeln
CLR eintrag|
wrt&=9
lesen
CASE 26 ! Export
CLR schreib1$,schreib2$,schreib$,sternchen|
CLR eintrag|,f_art&,nichtschreibend!
sa_loeschen
fvar_loeschen
wrt&=11
plattenbild
' IF modus&<>lieblingsmodus&
' kopf_bild(modus&)
' ENDIF
IF modus&<>lieblingsmodus&
modus&=lieblingsmodus&
kopf_bild(lieblingsmodus&)
ENDIF
ruecksprung(1)
CASE 15 ! Serienl”schen
CLR schreib1$,schreib2$,schreib$,sternchen|
CLR eintrag|,f_art&,nichtschreibend!
sa_loeschen
fvar_loeschen
wrt&=13
plattenbild
' IF modus&<>lieblingsmodus&
' kopf_bild(modus&)
' ENDIF
IF modus&<>lieblingsmodus&
modus&=lieblingsmodus&
kopf_bild(lieblingsmodus&)
ENDIF
ruecksprung(1)
ENDSELECT
menu_ende:
CLR menu|
RETURN
PROCEDURE menuecheck
hier%=51
REM * LPRINT "menuecheck"
a&=3
IF schluss_k%=8
DEC a&
ENDIF
RESTORE menuecheck
DO
READ b&
EXIT IF b&=0
MENU b&,a&
LOOP
menuecheck:
DATA 12,13,14,15,16,20,21,22,23,24,25,26,29
DATA 30,31,34,37,38,42,49,50,51,52,53,0
CLR a&,b&
RETURN
PROCEDURE alarm
hier%=52
REM * LPRINT "alarm"
IF alarm&=0
COLOR 0
DEFLINE 1,4,2,2
BOX 250,145/yt&,380,165/yt&
COLOR 1
alarm&=1
DEFLINE 1,1*yt&,0,0
BOX 250,145/yt&,380,165/yt&
ELSE
CLR alarm&
DEFLINE 1,4,2,2
BOX 250,145/yt&,380,165/yt&
ENDIF
DEFLINE 1,1*yt&,0,0
RETURN
REM _______________________________________________________________________Abgabe
PROCEDURE abgabe_wandeln
hier%=53
REM * LPRINT "abgabe_wandeln"
IF sainterpret$=""
IF saplatte$=""
ALERT 1," | Platten ohne Interpreten | und ohne Plattentitel | werden nicht akzeptiert",1," ",dummy|
CLR dummy|
DEFLINE 1,1*yt&,0,0
DEFFILL 1,0,0
PBOX 250,145/yt&,380,165/yt& ! fr šbernahme
DEFTEXT 1,17,0,13/yt&
TEXT 270,161/yt&,"šbernahme"
DEFTEXT 1,0,0,13/yt&
pfeil(0,alt1x&,alt2y&,alt3x&,alt3y&)
ruecksprung(1)
ELSE
sainterpret$="-"
ENDIF
ENDIF
dsatz$(0)=sainterpret$
dsatz$(1)=saplatte$
dsatz$(2)=saorchester$
dsatz$(3)=saleitung$
djahr&=sajahr&
dart&=saart&
dsatz$(4)=sauebergabe$
dverliehen&=sverliehen&
dbesitzer&=sabesitzer&
dsatz$(5)=saland$
dzustand&=sazustand&
dmerker&=samerker& ! Merker
dz1&=saz1&
dz2&=saz2&
dz3&=saz3&
dwert&=sawert1&
dnummer%=sanummer%
dsatz$(6)=sverliehen$
dsatz$(7)=samitspieler$(1)
dsatz$(8)=samitspieler$(2)
dsatz$(9)=samitspieler$(3)
dsatz$(10)=samitspieler$(4)
dsatz$(11)=samitspieler$(5)
REM dsatz$(12)=""
SELECT wrt&
CASE 12 ! Import
DEFAULT
dsatz$(12)=""
FOR tth&=1 TO 100
IF safenster$(tth&)>""
dsatz$(12)=dsatz$(12)+CHR$(244)+safenster$(tth&)
safenster$(tth&)=""
ENDIF
NEXT tth&
IF dsatz$(12)>""
dsatz$(12)=dsatz$(12)+CHR$(244)
ENDIF
ENDSELECT
dmodus&=modus&
dleer%=100
FOR schritt&=12 DOWNTO 0
dleer%=dleer%+LEN(dsatz$(schritt&))
NEXT schritt&
dleer%=dleer%+dmodus&+VAL(RIGHT$(STR$(djahr&),2))+dart&+dbesitzer&
dleer%=dleer%+dzustand&+dz1&+dz2&+dz3&
dleer%=dleer%+dwert&
IF dnummer%>0
dleer%=dleer%+LEN(STR$(dnummer%))
ENDIF
RETURN
FUNCTION inter_ungleich
hier%=54
REM * LPRINT "FUNCTION inter_ungleich"
distanz&=BYTE{start%+wo%+6}+1
testin2$=CHAR{start%+wo%+distanz&}
sprung%=LEN(testin2$) ! um schneller an dplatte heranzukommen
testin2$=@umlaute$(0,testin2$)
testin2$=MAX(testin2$,CHR$(45))
IF testin1$<>testin2$
RETURN TRUE
ENDIF
RETURN 0
ENDFUNC
PROCEDURE abgabe
hier%=55
REM * LPRINT "abgabe"
~FRE(0)
zahl1%=dnummer%
jahr1%=djahr&
wert1&=dwert&
k%=@kriterium(kriterium&)
CLR alt_katalog$ ! Gilt dann nicht mehr
keep%=k%
wo%={start2%+schluss_k%-4}
CARD{start%+wo%+4}=33333
IF wrt&=12
IF warnung|
CLR warnung|
CARD{start%+wo%+4}=22222
ENDIF
ENDIF
BYTE{start%+wo%+6}=14 ! Stelle des ersten IDs
IF dwert&>0 OR dnummer%>0
BYTE{start%+wo%+6}=20 ! Stelle des ersten IDs (3 Bytes mehr)
REM 14,15,16,17=dnummer%
REM 18,19=dwert& etc
REM 20=Stelle des ersten IDs
{start%+wo%+14}=dnummer%
BYTE{start%+wo%+18}=dwert& ! Ist noch nichts anderes da
ENDIF
info1$=BIN$(dmodus&,1)+BIN$(dzustand&,1)+BIN$(dverliehen&,2)+BIN$(dart&,4)
BYTE{start%+wo%+7}=VAL("&x"+info1$)
CLR info1$
CARD{start%+wo%+8}=dleer%
CARD{start%+wo%+10}=djahr&
BYTE{start%+wo%+12}=ASC(UPPER$(testin1$))
IF VAL?(testin1$)
BYTE{start%+wo%+12}=48 !="0"
ENDIF
info2$=BIN$(dbesitzer&,2)+"00"+BIN$(dz3&)+BIN$(dz2&)+BIN$(dz1&)+BIN$(dmerker&,1) ! Merker
BYTE{start%+wo%+13}=VAL("&X"+info2$)
CLR info2$
sss&=BYTE{start%+wo%+6} ! 14 oder 20
IF dsatz$(0)=""
dsatz$(0)="-"
ENDIF
FOR schritt&=0 TO 12
IF dsatz$(schritt&)>""
BYTE{start%+wo%+sss&}=schritt& ! ID
CHAR{start%+wo%+sss&+1}=dsatz$(schritt&)
sss&=sss&+LEN(dsatz$(schritt&))+2
ENDIF
NEXT schritt&
BYTE{start%+wo%+sss&}=254 ! Schluss-ID
sss&=sss&+1
IF EVEN(sss&)=0
INC sss&
ENDIF
w_neu%=sss&
{start%+w_neu%+wo%}=w_neu%+wo% ! VP des 255ers auf selbst
CARD{start%+w_neu%+wo%+4}=33333
BYTE{start%+w_neu%+wo%+6}=14
BYTE{start%+w_neu%+wo%+7}=0
CARD{start%+w_neu%+wo%+8}=999
BYTE{start%+w_neu%+wo%+12}=255 ! ID von dinterpret$/dinterpret$
BYTE{start%+w_neu%+wo%+14}=0 ! ID von dinterpret$/dinterpret$
CHAR{start%+w_neu%+wo%+15}=CHR$(255)
CARD{start%+w_neu%+wo%+16}=0
CARD{start%+w_neu%+wo%+18}=60000
REM ********* Adressen: ***********
IF keep%<>schluss_k%-4 AND keep%<>schluss_k%
{start%+{start2%+keep%-4}}=wo% ! Neuer VP des A-Satzes
{start%+{start2%+schluss_k%-8}}=wo%+w_neu% ! VP des Z-Satzes um W_neu% erh”hen
{start%+wo%}={start2%+keep%} ! VP des neuen C-Satzes auf B-Satz
ELSE IF keep%=schluss_k%-4
{start%+{start2%+schluss_k%-4}}=wo%+w_neu%
ENDIF
arbeitsraum%=arbeitsraum%-w_neu%
IF arbeitsraum%<=10000
neuer_arbeitsraum
ENDIF
k%=keep%
CLR sprung%,testin1$,testin2$,sss&,w_neu%,keep%,testpla1$,testpla2$,dummy|
schlussbyte
CARD{start%+schlussb%-2}=60000
katalog
SELECT wrt&
CASE 0
in_den_keller
ENDSELECT
REM
REM demo ! Aktivieren, wenn Demo-Version *************
REM
SELECT wrt&
CASE 4,9
SELECT wrt&
CASE 4
wrt&=3
CASE 9
wrt&=4
ENDSELECT
CLR schreib1$,schreib2$,schreib$,sternchen|
aendern_loeschen_vollbild
CASE 12,14,15 ! Import, Serien„ndern
DEFAULT
ruecksprung(0)
ENDSELECT
RETURN
PROCEDURE demo
hier%=56
REM * LPRINT "demo"
IF C:statistik%(L:start%)-2>=200
ALERT 1,demo$,1,SPACE$(6),dummy|
CLR dummy|
loeschen
ENDIF
RETURN
PROCEDURE neuer_arbeitsraum
hier%=57
REM * LPRINT "neuer_arbeitsraum"
SELECT final&
CASE 2
ALERT 0," | Speicherplatzprobleme! | | Bitte abspeichern! ",1," OK ",dummy|
filebox|=0
IF wrt&=12
ruecksprung(0)
ENDIF
DEFAULT
start3%=start% ! Adresse merken
back_start%=GEMDOS(73,L:start%) ! MFREE start% freigeben
IF back_start%=0
start%=MALLOC(schlussb%+w_neu%+30000) ! 30000 ist arbeitsraum%
IF start%>0
arbeitsraum%=30000
IF start3%<>start%
BMOVE start3%,start%,schlussb%+w_neu%+100
ENDIF
ENDIF
IF start%=0 OR final&=1
start%=start3%
ALERT 0," | Speicherplatzprobleme! | | Bitte abspeichern! ",1," OK ",dummy|
filebox|=0
IF wrt&=12
ruecksprung(0)
ENDIF
ENDIF
ELSE
ALERT 0," | Speicherplatzprobleme! | | Bitte abspeichern! ",1," OK ",dummy|
filebox|=0
IF wrt&=12
ruecksprung(0)
ENDIF
ENDIF
IF MALLOC(-1)<39500 ! Letzter Aufruf
SELECT final&
CASE 0
ALERT 1," | | Speicher wird knapp | ",1," OK ",dummy|
final&=1
CASE 1
final&=2
ENDSELECT
ELSE
CLR final&
ENDIF
ENDSELECT
RETURN
PROCEDURE loeschen
hier%=58
REM * LPRINT "loeschen"
IF {start%}={start2%+schluss_k%}
ruecksprung(0)
ENDIF
CLR merken%,k_merken%
merken%={start%+wo%}
k_merken%=k%
{start%+{start2%+k%-4}}={start2%+k%+4} ! Neuer VP von A-Satz, E_DAT
SELECT wrt&
CASE 4,13,14,15
DEFAULT
CLR wrt&
ENDSELECT
lela%=C:loeschen%(L:start%,L:wo%) ! Return ist L„nge des L”schsatzes
REM kein dateiende!!
BMOVE start%+wo%+lela%,start%+wo%,schlussb%-wo%-lela%
wo%=merken%
k%=k_merken%
katalog
schlussbyte
CARD{start%+schlussb%-2}=60000
arbeitsraum%=arbeitsraum%+lela%
CLR lela%,merken%,k_merken%
CLR alt_katalog$ ! Gilt dann nicht mehr
RETURN
REM ___________________________________________________________________Funktionen
FUNCTION umlaute$(stoppen&,wandel$)
hier%=59
REM * LPRINT "FUNCTION umlaute$(stoppen&,wandel$)"
REM gibt nur Grožbuchstaben zurck!
LOCAL zuwandel$,alter_buchstabe|
LOCAL platz$,platz%
IF wandel$="-" OR wandel$=""
RETURN wandel$
ENDIF
a&=INSTR(wandel$,CHR$(62)) !">"
IF a&>0
wandel$=MID$(wandel$,a&)
ENDIF
CLR u_schritt&,objekt%
alter_buchstabe|=32 ! Falls Leerzeichen am Anfang
objekt%=LEN(wandel$)-1
~FRE(0)
CLR platz%
platz$=STRING$(objekt%+15,CHR$(0))
FOR u_schritt&=0 TO objekt%
SELECT BYTE{V:wandel$+u_schritt&}
CASE 32,254
SELECT alter_buchstabe|
CASE 32,254
DEFAULT
BYTE{V:platz$+platz%}=32
INC platz%
ENDSELECT
CASE 48 TO 57,65 TO 90,255
BYTE{V:platz$+platz%}=BYTE{V:wandel$+u_schritt&}
INC platz%
CASE 97 TO 122 ! kleinbuchstaben
BYTE{V:platz$+platz%}=BCLR(BYTE{V:wandel$+u_schritt&},5) ! Upper
INC platz%
CASE 132,142
BYTE{V:platz$+platz%}=65 ! A
BYTE{V:platz$+platz%+1}=69 ! E
ADD platz%,2
CASE 148,153
BYTE{V:platz$+platz%}=79 ! O
BYTE{V:platz$+platz%+1}=69 ! E
ADD platz%,2
CASE 129,154
BYTE{V:platz$+platz%}=85 ! U
BYTE{V:platz$+platz%+1}=69 ! E
ADD platz%,2
CASE 158
BYTE{V:platz$+platz%}=83 ! S
BYTE{V:platz$+platz%+1}=83 ! S
ADD platz%,2
CASE 91 !"["
SELECT alter_buchstabe|
CASE 32,254
BYTE{V:platz$+platz%}=0
ENDSELECT
DO
SELECT BYTE{V:wandel$+u_schritt&}
CASE 93 !"]"
IF CHAR{V:platz$}=""
REPEAT
INC u_schritt&
UNTIL BYTE{V:wandel$+u_schritt&}>=48
DEC u_schritt&
ENDIF
EXIT IF TRUE
DEFAULT
INC u_schritt&
EXIT IF u_schritt&>=objekt%
ENDSELECT
LOOP
CASE 62 !">"
platz$=STRING$(objekt%+15,CHR$(0))
INC u_schritt&
DO
SELECT BYTE{V:wandel$+u_schritt&}
CASE 60 !"<"
BYTE{V:platz$+platz%}=0
RETURN @umlaute$(stoppen&,CHAR{V:platz$})
CASE 62 !">"
INC u_schritt&
DEFAULT
BYTE{V:platz$+platz%}=BYTE{V:wandel$+u_schritt&}
INC platz%
IF u_schritt&=objekt%
IF BYTE{V:wandel$+u_schritt&-1}=62
CLR platz$,platz%
RETURN ""
ENDIF
EXIT IF TRUE
ENDIF
INC u_schritt&
ENDSELECT
LOOP
BYTE{V:platz$+platz%}=0
RETURN @umlaute$(stoppen&,CHAR{V:platz$})
DEFAULT ! fr alle anderen Zeichen
SELECT alter_buchstabe|
CASE 32,254
DEFAULT
BYTE{V:platz$+platz%}=32
INC platz%
ENDSELECT
ENDSELECT
IF stoppen&>0
EXIT IF platz%>=stoppen&
ENDIF
alter_buchstabe|=BYTE{V:platz$+platz%-1}
NEXT u_schritt&
CLR u_schritt&,alter_buchstabe|,objekt%
BYTE{V:platz$+platz%}=0
RETURN CHAR{V:platz$} ! Trimm brauchts scheint nicht mehr
REM (allerdings r„tselhaft, warum 254 auftaucht!)
ENDFUNC
FUNCTION kleiner_gleich(kl_a$,kl_b$)
hier%=60
REM * LPRINT "FUNCTION kleiner_gleich(kl_a$,kl_b$)"
kl_a$=TRIM$(kl_a$)
kl_b$=TRIM$(kl_b$)
IF kl_a$=kl_b$
RETURN TRUE
ENDIF
IF kl_a$="-"
RETURN TRUE
ENDIF
IF kl_b$=CHR$(255)
RETURN TRUE
ENDIF
kl_a$=TRIM$(kl_a$)+CHR$(240)
kl_b$=TRIM$(kl_b$)+CHR$(240)
~FRE(0)
DO
b&=BYTE{VARPTR(kl_b$)}
b_plus&=b&+1
b_minus&=b&-1
IF b&=240
IF BYTE{VARPTR(kl_a$)}<>240
RETURN FALSE
ENDIF
ENDIF
SELECT BYTE{VARPTR(kl_a$)}
CASE 240
RETURN TRUE
CASE 48 TO 57
IF VAL?(kl_b$)=0 ! damit reihe: - Zahl Bchst
IF b&=45 ! "-" !
RETURN FALSE ! sonst k„me Zahl nach Bchst
ENDIF !
RETURN TRUE !
ENDIF !
IF VAL(kl_a$)VAL(kl_b$)
RETURN FALSE
ELSE IF VAL(kl_a$)=VAL(kl_b$)
kl_a$=MID$(kl_a$,VAL?(kl_a$)+1)
kl_b$=MID$(kl_b$,VAL?(kl_b$)+1)
ENDIF
CASE b_plus& TO 255
RETURN FALSE
CASE TO b_minus&
RETURN TRUE
CASE b&
kl_a$=MID$(kl_a$,2)
kl_b$=MID$(kl_b$,2)
ENDSELECT
LOOP
RETURN TRUE ! zur Sicherheit
ENDFUNC
FUNCTION pfadfrage$
hier%=61
REM * LPRINT "FUNCTION pfadfrage$"
LOCAL a$
DEFFILL 1,0,0
PRBOX 100,130/yt&,500,300/yt&
PRINT AT(17,10);"Bitte geben Sie den Pfad mit der Hand ein."
PRINT AT(17,11);"Die Datei ist ungeschtzt und k”nnte durch "
PRINT AT(17,12);"eine Fileselect-Box zerst”rt werden!"
PRINT AT(17,16);"(Beispiel: A:\SICHER.PLA )"
PRINT AT(17,14);
INPUT a$
RETURN UPPER$(a$)
ENDFUNC
FUNCTION uebergabe$
hier%=62
REM * LPRINT "FUNCTION uebergabe$"
REM Kleinbchst. laut saueberg.$ Grožbchst.(alphabetisch)
CLR a$
FOR schritt&=1 TO 24
klein$(schritt&)=CHR$(schritt&+96)
IF INSTR(sauebergabe$,UPPER$(klein$(schritt&)))>0
klein$(schritt&)=UPPER$(klein$(schritt&))
a$=a$+klein$(schritt&)
ENDIF
NEXT schritt&
RETURN a$ ! sollte vielleicht bleiben
ENDFUNC
PROCEDURE katalog
hier%=63
REM * LPRINT "katalog"
schluss_k%=C:katalog%(L:start%,L:start2%)
RETURN
PROCEDURE schlussbyte
hier%=64
REM * LPRINT "schlussbyte"
schlussb%=C:dateiende%(L:start%)+20
RETURN
PROCEDURE freitest
hier%=65
REM * LPRINT "freitest"
PRINT AT(73,1);USING "#######",FRE(0)-1000; ! ==> Freitest
RETURN
REM ________________________________________________________________________Datei
PROCEDURE init_dat
hier%=66
REM * LPRINT "init_dat"
{start%}=20 ! Adresse des provisorischen Schluss-Strings
CARD{start%+4}=33333
BYTE{start%+6}=14 ! Stelle, wo erstes ID
BYTE{start%+7}=0 ! dmodus&
CARD{start%+8}=700+kriterium& ! Code fr den Anfangsssatz
BYTE{start%+12}=10 ! "Anfangsbuchstabe" des Anfangssatzes
BYTE{start%+BYTE{start%+6}}=0 ! Byte 14 ID fr dinterpret$
CHAR{start%+BYTE{start%+6}+1}=CHR$(10) ! Byte 15 dinterpret$ Anfangsatz
{start%+16}=0 ! Vier Byte frei
REM
{start%+20}=20 !*** Schluss-Satz*** ! Adresse auf sich selbst
CARD{start%+20+4}=33333
BYTE{start%+20+6}=14 ! Stelle, wo erstes ID
BYTE{start%+20+7}=0 ! dmodus&
CARD{start%+20+8}=999 ! Code fr den Anfangsssatz (Stelle dleer)
BYTE{start%+20+12}=255 ! "Anfangsbuchstabe" des Schluss-Satzes
BYTE{start%+20+14}=0 ! ID fr dinterpret$
CHAR{start%+20+15}=CHR$(255) ! dinterpret$ des Anfangsatzes
CARD{start%+20+16}=0 ! freibleibend (0 hinter Char lassen, gerade Adresse
CARD{start%+20+18}=60000 ! fr den 60000er
katalog
RETURN
PROCEDURE mini_start
hier%=67
REM * LPRINT "mini_start"
back_start%=GEMDOS(73,L:start%)
start%=MALLOC(30000) ! 30000 ist arbeitsraum%
init_dat
arbeitsraum%=30000
CLR k%,merker_stand%,final&
filebox|=1
schlussbyte
k_stand%=@letzter_satz
ledel%=CARD{k_stand%+8}+(BYTE{k_stand%+7} AND &X110000)/16
IF neu!
plattenbild
ELSE
plattenbild1(TRUE)
ENDIF
ruecksprung(0)
RETURN
PROCEDURE datload(neu!)
hier%=68
REM * LPRINT "datload(neu!)"
LOCAL kleiner%,alles%,test$
PRINT AT(24,20);"Vorgemerkter Pfad:";SPACE$(15) !STRING$(15,".");
PRINT AT(24,21);SPACE$(33);
PRINT AT(24,21);ppfad$;
CLR ok!,datei$
test$=SPACE$(2)
REPEAT
CLOSE
CLR dummy|
CARD{V:test$}=0
ALERT 0," | Wo befindet sich die Datei? | | ",1," Pfad | Neu | Suchen ",dummy|
SELECT dummy|
CASE 1
datei$=ppfad$
CASE 2
mini_start
CASE 3
DEFFILL 1,2,8
PBOX 0,0,640,400/yt&
CLR bild$
REPEAT
IF filebox|
FILESELECT fileselect$,"",datei$
ELSE
datei$=@pfadfrage$
ENDIF
IF datei$=""
IF neu!
ruecksprung(0)
ELSE IF NOT neu!
mini_start
ENDIF
ENDIF
extension_pruefen(datei$,"PLA",*kontrolle$)
datei$=kontrolle$
UNTIL datei$<>"000"
ENDSELECT
IF NOT EXIST(datei$)
ALERT 0," | Datei ist nicht zu finden | ",1,SPACE$(7),dummy|
CLR dummy|,ok!
ELSE
OPEN "I",#1,datei$
IF LOF(#1)=0
CLOSE
mini_start
ENDIF
laenge%=LOF(#1)
SEEK #1,8
BGET #1,V:test$,MIN(LOF(#1),2)
CLOSE
SELECT CARD{V:test$}
CASE 700,702,703,704,705 ! 700+kriterium&
kriterium&=CARD{V:test$}-700
ok!=TRUE
CASE 1952,1954,1955,1956,1957 ! 1952+kriterium&
CLR dummy|,test$
ALERT 1," Sicherheitskopien werden | nicht geladen! | (Menpunkt 'Kopie der | Sicherheitskopie') ",1," nochmal |Programm",dummy|
SELECT dummy|
CASE 2
CLOSE
mini_start
ENDSELECT
CLR dummy|
DEFAULT
ALERT 1," Dies ist keine | Plattendatei! |",1,SPACE$(5),dummy|
CLR dummy|,test$
ENDSELECT
ENDIF
UNTIL ok!
back_start%=GEMDOS(73,L:start%)
alles%=MALLOC(-1)
IF laenge%3
CHDRIVE zwsp$
OPEN "I",#1,zwsp$
a%=DFREE(0)+LOF(#1)
CLOSE
IF a%3
OPEN "I",#1,sisp$
CHDRIVE sisp$
a%=DFREE(0)+LOF(#1)
CLOSE
IF a%"000"
IF NOT EXIST(stu1$)
ALERT 0," | Datei ist nicht zu finden | ",1,SPACE$(7),dummy|
CLR dummy|,ok!
ELSE
OPEN "I",#1,stu1$
IF LOF(#1)=0
CLOSE
mini_start
ENDIF
SEEK #1,MIN(LOF(#1),8)
BGET #1,V:test$,MIN(LOF(#1),2)
CLOSE
SELECT CARD{V:test$}
CASE 1952,1954,1955,1956,1957 ! 1952+kriterium&
kriterium&=CARD{V:test$}-1952
ok!=TRUE
CASE 700,702,703,704,705 ! 700+kriterium&
CLR dummy|,test$
ALERT 0," Das ist |keine Sicherheitskopie! | ",1," weiter |Abbruch",dummy|
IF dummy|=1
CLR ok!
ELSE IF dummy|=2
ruecksprung(0)
ENDIF
CLR dummy|
DEFAULT
ALERT 1," Dies ist keine | Plattendatei! |",1,SPACE$(5),dummy|
CLR dummy|,test$
ENDSELECT
IF ok!
back_start%=GEMDOS(73,L:start%)
REM alles%=MALLOC(-1)-puffer% ! Die puffer% sind zur Sicherheit
alles%=MALLOC(-1)
start%=MALLOC(INT(alles%))
init_dat ! Rudiment-Satz
BLOAD stu1$,start% ! Datei laden
ENDIF
ENDIF
UNTIL ok!
REM ----------------
PRINT AT(10,2);"Unter welchem Namen soll die Arbeitskopie gespeichert werden?";''''''
dateiwahl(3)
stu2$=dateiwahl$
OPEN "O",#1,stu2$
CLOSE
REM ----------
BLOAD stu1$,start%
CARD{start%+8}=700+kriterium&
schlussbyte
CARD{start%+schlussb%-2}=60000
BSAVE stu2$,start%,schlussb%+5
REM -----------
SELECT GEMDOS(74,0,L:start%,L:(schlussb%+30000)) ! Malloc kleiner machen
CASE 0
arbeitsraum%=30000
DEFAULT
arbeitsraum%=INT(alles%)
ENDSELECT
katalog
k_stand%=@letzter_satz
ledel%=CARD{k_stand%+8}+(BYTE{k_stand%+7} AND &X110000)/16
~C:setz33%(L:start%)
CLR test$
ruecksprung(0)
RETURN
PROCEDURE dateiwahl(kennung|)
hier%=73
REM * LPRINT "dateiwahl(kennung|)"
REM kennung|=1 zwischenspeichern
REM kennung|=2 sicherheitskopie
REM kennung|=3 safe_to_use-Speichern
CLR dateiwahl$,ok!
REPEAT
CLR dummy|
SELECT kennung|
CASE 1
PRINT AT(10,20);"Vorgemerkter Pfad:";';
PRINT AT(10,21);ppfad$;SPACE$(20)
ALERT 0," | Wohin soll die Datei? | | ",1," Pfad |Programm| Suchen ",dummy|
CASE 2
PRINT AT(10,20);"Vorgemerkter Pfad fr die Sicherheitskopie:";
PRINT AT(10,21);spfad$;SPACE$(20)
ALERT 0," | Wohin soll | die Sicherheitskopie? | | ",1," Pfad |Programm| Suchen ",dummy|
CASE 3
dummy|=3
ENDSELECT
SELECT dummy|
CASE 1
SELECT kennung|
CASE 1
dateiwahl$=ppfad$
CASE 2
dateiwahl$=spfad$
ENDSELECT
ok!=TRUE
CASE 2
ruecksprung(0)
CASE 3
CLR bild$
REPEAT
IF filebox|
FILESELECT fileselect$,"",dateiwahl$
ELSE
dateiwahl$=@pfadfrage$
ENDIF
IF dateiwahl$=""
ruecksprung(0)
ENDIF
extension_pruefen(dateiwahl$,"PLA",*kontrolle$)
dateiwahl$=kontrolle$
IF INSTR(UPPER$(RIGHT$(dateiwahl$,MIN(LEN(dateiwahl$),12))),"MASKE")
ALERT 1," | Masken werden |nicht berladen ",1,weiter$,dummy|
CLR dummy|
dateiwahl$="000"
ENDIF
UNTIL dateiwahl$<>"000"
SELECT kennung|
CASE 1
PRINT AT(10,20);"Aktueller Pfad zum Abspeichern:"
CASE 2
PRINT AT(10,20);"Aktueller Pfad fr die Sicherheitskopie:";'''''''''';
CASE 3
PRINT AT(10,20);"Name der restaurierten Arbeitskopie:";SPACE$(31)
ENDSELECT
PRINT AT(10,21);dateiwahl$;SPACE$(36)
IF NOT EXIST(dateiwahl$)
OPEN "O",#1,dateiwahl$
CLOSE
ok!=TRUE
ELSE IF EXIST(dateiwahl$)
test$=SPACE$(2)
OPEN "I",#1,dateiwahl$
IF LOF(#1)<9
CLOSE
ok!=TRUE
ELSE
SEEK #1,8
BGET #1,V:test$,2
CLOSE
SELECT CARD{V:test$}
CASE 700,702,703,704,705 ! 700+kriterium&
SELECT kennung|
CASE 1,3
ok!=TRUE
CASE 2
CLR dummy|,test$,ok!
ALERT 1,"| Dies ist eine | normale Plattendatei! ",1," nochmal |Programm",dummy|
SELECT dummy|
CASE 2
CLOSE
ruecksprung(0)
ENDSELECT
ENDSELECT
CASE 1952,1954,1955,1956,1957 ! 1952+kriterium&
SELECT kennung|
CASE 1,3
CLR dummy|,test$,ok!
ALERT 1,"| Dies ist eine | Sicherheitskopie! ",1," nochmal |Programm",dummy|
SELECT dummy|
CASE 2
CLOSE
ruecksprung(0)
ENDSELECT
CASE 2
ok!=TRUE
ENDSELECT
DEFAULT
ALERT 1," Dies ist keine | Plattendatei! |",1,SPACE$(5),dummy|
CLR dummy|,test$,ok!
ENDSELECT
ENDIF
ENDIF
ENDSELECT
IF NOT EXIST(dateiwahl$)
ALERT 0," | Datei ist nicht zu finden | ",1," ",dummy|
CLR dummy|,ok!
ENDIF
UNTIL ok!
RETURN
PROCEDURE maskeninput(ma$)
hier%=74
REM * LPRINT "maskeninput(ma$)"
ON MENU
ON ERROR GOSUB fehler
OPEN "R",#4,ma$
IF LOF(#4)>0
SEEK #4,0
FOR schritt&=1 TO 48
INPUT #4,adj$(schritt&)
NEXT schritt&
INPUT #4,debes$(1),debes$(2),debes$(3)
INPUT #4,pref&,ppfad$,spfad$
INPUT #4,dz%(1),dz%(2),dz%(3),dz%(4)
INPUT #4,dz$(1),dz$(2),dz$(3),dz$(4)
modus&=dz%(1)
lieblingsmodus&=modus&
zproz&=dz%(2)
IF zproz&<30
zproz&=70
ENDIF
ENDIF
CLOSE #4
CLR ma$
RETURN
PROCEDURE neue_maske
hier%=75
REM * LPRINT "neue_maske"
a$=maskenpfad$
CLR bild$
REPEAT
IF filebox|
FILESELECT fileselect$,"",maskenpfad$
ELSE
maskenpfad$=@pfadfrage$
ENDIF
IF maskenpfad$=""
maskenpfad$=a$
CLR a$
ruecksprung(0)
ENDIF
IF RIGHT$(maskenpfad$,4)=".MSK"
nebenmasken$=maskenpfad$
nebenmaske|=1
EXIT IF TRUE
ENDIF
IF INSTR(RIGHT$(maskenpfad$,MIN(LEN(maskenpfad$),12)),"MASKE") AND UPPER$(RIGHT$(maskenpfad$,4))=".PLA"
CLR nebenmaske|,nebenmasken$
EXIT IF TRUE
ENDIF
UNTIL UPPER$(RIGHT$(maskenpfad$,9))="MASKE.PLA"
CLR a$
maskeninput(maskenpfad$)
CHDRIVE programmlaufwerk|
CLR bild$
ruecksprung(0)
RETURN
PROCEDURE export
hier%=76
REM * LPRINT "export"
CLS
CLOSE
CLR bild$,exsp$,erster_export_treffer!
~FRE(0)
PRINT AT(17,2);" Wohin soll die Export-Datei gespeichert werden?"
REPEAT
IF filebox|
FILESELECT fileselect$,"",exsp$
ELSE
exsp$=@pfadfrage$
ENDIF
IF exsp$=""
ruecksprung(0)
ENDIF
extension_pruefen(exsp$,"PLA",*kontrolle$)
exsp$=kontrolle$
UNTIL exsp$<>"000"
IF NOT EXIST(exsp$)
OPEN "O",#11,exsp$
CLOSE
ENDIF
IF NOT EXIST(exsp$)
ALERT 0," | Datei ist nicht zu finden | ",1," ",dummy|
CLR dummy|
export
ENDIF
filtervergleich
CLR exoe%
IF filterzahl%=0
IF LOF(#11)=20
CLOSE #11
KILL exsp$
ENDIF
ELSE
a$=SPACE$(100)
a%=VARPTR(a$)
{a%}=ex_adr% !*** Schluss-Satz*** ! Adresse auf sich selbst
CARD{a%+4}=33333
BYTE{a%+6}=14 ! Stelle, wo erstes ID
BYTE{a%+7}=0 ! dmodus&
CARD{a%+8}=999 ! Code fr den Anfangsssatz
BYTE{a%+12}=255 ! "Anfangsbuchstabe" des Schluss-Satzes
BYTE{a%+14}=0 ! ID fr dinterpret$
CHAR{a%+15}=CHR$(255) ! dinterpret$ des Anfangsatzes
CARD{a%+16}=0 ! freibleibend (0 hinter Char lassen, gerade Adresse
CARD{a%+18}=60000 ! fr den 60000er
BPUT #11,a%,20
CLOSE #11
ENDIF
CLR erster_export_treffer! !Datei wird nur bei Treffer=0 er”ffnet
CLR wrt&
CLR exsp$,ex_adr%,ex_adr$,a$
CHDRIVE programmlaufwerk|
ruecksprung(0)
RETURN
PROCEDURE import
hier%=77
REM * LPRINT "import"
kein_merker&=1
erster_satz|=1 ! damit nicht gleich durchmarsch gesetzt wird
imp_modus&=modus&
import_anzeige&=1
CLR bild$,ok!,imp$
CLR alt_imp_test$,imp_test$
CLR imp_keep_k% ! (aus abgabe)
CLOSE
DEFFILL 1,2,8
PBOX 0,0,640,400/yt&
~FRE(0)
PRINT AT(18,2);''''';"Welche Datei soll importiert werden?";''''
REPEAT
CLOSE
REPEAT
IF filebox|
FILESELECT fileselect$,"",impsp$
ELSE
impsp$=@pfadfrage$
ENDIF
IF impsp$=""
ruecksprung(0)
ENDIF
UNTIL impsp$<>"\" AND RIGHT$(impsp$,4)=".PLA" AND impsp$<>""
DEFFILL 1,2,8
PBOX 0,0,640,400/yt&
kleines_bild
imp_adr$=SPACE$(4)
IF EXIST(impsp$)
OPEN "i",#12,impsp$
laenge%=LOF(#12)
IF laenge%=0 OR laenge%=20
CLOSE #12
CHDRIVE programmlaufwerk|
ALERT 1," Diese Datei ist leer |",1,SPACE$(5),dummy|
CLR dummy|,ok!
ENDIF
guck$=SPACE$(4)
SEEK #12,MIN(laenge%,8)
BGET #12,VARPTR(guck$),MIN(LOF(#12),2)
SEEK #12,0
SELECT CARD{VARPTR(guck$)}
CASE 700,702,703,704,705 ! 700+kriterium&
ok!=TRUE
REM dann ist alles ok
CASE 1952,1954,1955,1956,1957 ! 1952+kriterium&
CLR dummy|
ALERT 1," Sicherheitskopien werden | nicht geladen! | (Menpunkt 'Kopie der | Sicherheitskopie') ",1," nochmal |Programm",dummy|
IF dummy|=2
CLOSE #12
CHDRIVE programmlaufwerk|
ruecksprung(0)
ENDIF
IF dummy|=2
CLOSE #12
CHDRIVE programmlaufwerk|
ENDIF
DEFAULT
ALERT 1," Dies ist keine | Plattendatei! |",1,SPACE$(5),dummy|
CLR dummy|,ok!
ENDSELECT
IF ok!
CLR guck$
SEEK #12,0
BGET #12,VARPTR(imp_adr$),4
imp_adr%={VARPTR(imp_adr$)}
RELSEEK #12,-4
SEEK #12,imp_adr%
BGET #12,VARPTR(imp_adr$),4
imp_adr%={VARPTR(imp_adr$)}
RELSEEK #12,-4
ENDIF
ENDIF
UNTIL ok!
CLR impoe%,ok!
CLR dummy|
SELECT final&
CASE 0
IF laenge%>arbeitsraum%-10000+MALLOC(-1)
dummy|=1
ENDIF
CASE 1
IF laenge%>arbeitsraum%-10000 ! ab 10000 wird aufgerufen
dummy|=1
ENDIF
CASE 2 ! letzter Aufruf war schon
dummy|=1
ENDSELECT
IF dummy|=1
ALERT 1," | Der Speicherplatz reicht | nicht aus, die gew„hlte | Datei zu importieren! ",1,"Abbruch",dummy|
ruecksprung(0)
ENDIF
CLR dummy|
IF MALLOC(-1)-arbeitsraum%>2*laenge%+60000 !(60000 als Puffer zwischen den Dateien)
high%=start%+schlussb%+laenge%+60000
BLOAD impsp$,high%
imp%=0
schnell|=1
ELSE
CLR schnell|
ENDIF
PRBOX 110,120/yt&,260,150/yt&
PRBOX 25,125/yt&,110,146/yt& ! fr Nummer-Anzeige
MENU KILL
HIDEM
CLR imp_a%,durchmarsch|
DO
ON BREAK GOSUB fehler
KEYTEST imp_a%
IF imp_a%>0
IF imp_a%=3145826 !"b"
CLR import_anzeige&
ELSE IF imp_a%=36700226 !"B"
import_anzeige&=1
ELSE IF imp_a%=2031731 OR imp_a%=35586131 !"s" OR "S"
CLR dverliehen&,djahr&,dbesitzer&,dzustand&,dart&,dmodus&
CLR kein_merker&
ERASE dsatz$()
DIM dsatz$(20)
EXIT IF TRUE
ENDIF
CLR imp_a%
ENDIF
CLR imp_a%
CLR sss&,x|
ERASE dsatz$()
DIM dsatz$(20)
IF schnell|
imp%={high%+imp%}
EXIT IF BYTE{high%+imp%+12}=255
EXIT IF CARD{high%+imp%+4}<>33333 AND CARD{high%+imp%+4}<>22222
x|=BYTE{high%+imp%+7}
dmodus&=ABS(BTST(x|,7))
dzustand&=ABS(BTST(x|,6))
dverliehen&=(x| AND &X110000)/16
dart&=(x| AND &X1111)
x|=BYTE{high%+imp%+13}
dbesitzer&=(x| AND &X11000000)/64
dmerker&=ABS(BTST(x|,0)) ! Merker
dz1&=ABS(BTST(x|,1))
dz2&=ABS(BTST(x|,2))
dz3&=ABS(BTST(x|,3))
djahr&=CARD{high%+imp%+10}
dleer%=CARD{high%+imp%+8}
sss&=BYTE{high%+imp%+6}
SELECT sss&
CASE 20
dnummer%={high%+imp%+14}
dwert&=BYTE{high%+imp%+18}
DEFAULT
CLR dnummer%,dwert&
ENDSELECT
CLR hol&,a&
DO
hol&=BYTE{high%+imp%+sss&}
EXIT IF hol&>20
EXIT IF hol&=254
dsatz$(hol&)=CHAR{high%+imp%+sss&+1}
sss&=sss&+LEN(dsatz$(hol&))+2
LOOP
ELSE ! Einzeln von Diskette lesen
~FRE(0)
imp$=SPACE$(30)
BGET #12,VARPTR(imp$),20
IF BYTE{V:imp$+6}=20
BGET #12,V:imp$+20,10
RELSEEK #12,-30
ELSE
RELSEEK #12,-20
ENDIF
imp%=VARPTR(imp$)
EXIT IF BYTE{imp%+12}=255
EXIT IF CARD{imp%+4}<>33333 AND CARD{imp%+4}<>22222
x|=BYTE{imp%+7}
dmodus&=ABS(BTST(x|,7))
dzustand&=ABS(BTST(x|,6))
dverliehen&=(x| AND &X110000)/16
dart&=(x| AND &X1111)
x|=BYTE{imp%+13}
dbesitzer&=(x| AND &X11000000)/64
dmerker&=ABS(BTST(x|,0)) ! Merker
dz1&=ABS(BTST(x|,1))
dz2&=ABS(BTST(x|,2))
dz3&=ABS(BTST(x|,3))
djahr&=CARD{imp%+10}
dleer%=CARD{imp%+8}
sss&=BYTE{imp%+6}
SELECT sss&
CASE 20
dnummer%={imp%+14}
dwert&=BYTE{imp%+18}
DEFAULT
CLR dnummer%,dwert&
ENDSELECT
RELSEEK #12,sss&
CLR hol&,a&
DO
hol&=INP(#12)
EXIT IF hol&>20
EXIT IF hol&=254
DO
a&=INP(#12)
EXIT IF a&=0
dsatz$(hol&)=dsatz$(hol&)+CHR$(a&)
LOOP
LOOP
ENDIF
IF import_anzeige&
kleine_ausgabe
ENDIF
IF kriterium&=0 ! durchmarsch| nur bei Standard-Sortierung
alt_imp_test$=imp_test$
imp_test$=dsatz$(0)
imp_test$=@umlaute$(0,imp_test$)
CLR durchmarsch|
SELECT erster_satz|
CASE 0
IF @kleiner_gleich(alt_imp_test$,imp_test$)
durchmarsch|=1
ENDIF
CASE 1
CLR erster_satz|
ENDSELECT
ENDIF
CLR stoppen&
abgabe
INC impoe%
PRINT AT(17,9);USING "####",impoe%;
PRINT ';"importiert";
SELECT schnell|
CASE 0
SEEK #12,imp_adr%
BGET #12,VARPTR(imp_adr$),4
imp_adr%={VARPTR(imp_adr$)}
RELSEEK #12,-4
ENDSELECT
LOOP
CLOSE #12
CHDRIVE programmlaufwerk|
CLR warnung$
FOR k%=0 TO schluss_k%-4 STEP 4
wo%={start2%+k%}
IF CARD{start%+wo%+4}=22222
warnung$=warnung$+STR$(k%/4)+CHR$(32)
ENDIF
CARD{start%+wo%+4}=33333
NEXT k%
IF warnung$>""
PRINT AT(1,19);warnung$
ALERT 1," | Folgende Plattennummern sind | durch das Importieren | verdoppelt worden! ",1," OK |Ausdruck",dummy|
IF dummy|=2
zumabbrechen
trennung&=10
langschreiben(warnung$,0,zproz&)
LPRINT
ENDIF
ENDIF
CLR alt_imp_test$,imp_test$,durchmarsch|,imp_keep_k%
CLR warnung$,warnung|,dummy|,imp_adr%,imp_adr$,imp$,imp%,hol&,a&,sss&,impsp$
CLR schnell|,high%,impoe%,import_anzeige&
CLR kein_merker& ! Merker
schlussbyte
CARD{start%+schlussb%-2}=60000
PAUSE 20
SHOWM
modus&=imp_modus&
CLR imp_modus&
ruecksprung(0)
RETURN
PROCEDURE extension_pruefen(pr$,ex$,ps%)
hier%=78
REM * LPRINT "extension_pruefen(pr$,ex$,ps%)"
LOCAL nl%,dn$,epri%
IF RIGHT$(pr$)<>"\" AND RIGHT$(pr$,5)<>"\."+ex$ AND pr$>""
FOR epri%=LEN(pr$) DOWNTO 1
INC nl%
EXIT IF MID$(pr$,epri%,1)="\"
NEXT epri%
dn$=RIGHT$(pr$,nl%)
IF INSTR(dn$,".")=0
*ps%=pr$+"."+ex$
dn$=dn$+"."+ex$
ENDIF
IF RIGHT$(dn$,4)<>"."+ex$
IF LEFT$(dn$,2)<>"\."
*ps%=LEFT$(pr$,LEN(pr$)-nl%)+LEFT$(dn$,INSTR(dn$,"."))+ex$
ELSE
*ps%="000"
ENDIF
ELSE
*ps%=LEFT$(pr$,LEN(pr$)-nl%)+dn$
ENDIF
ELSE
*ps%="000"
ENDIF
RETURN
PROCEDURE safeguard_signal
hier%=79
REM * LPRINT "safeguard_signal"
DEFFILL 1,0,0
PBOX 10,312/yt&,628,342/yt&
BOX 12,314/yt&,626,340/yt&
PRINT AT(11,21);"Sicherheitsberprfung: Datei ver„ndert? Merker neu gesetzt?";
PAUSE 10
RETURN
PROCEDURE safeguard
hier%=80
REM * LPRINT "safeguard"
safeguard_signal
CLR dummy|
a%=@letzter_satz
b%=CARD{a%+8}+(BYTE{a%+7} AND &X110000)/16
IF k_stand%<>a% OR ledel%<>b%
ALERT 1," | Datei wurde ver„ndert! | |Trotzdem nicht abspeichern? ",1," Ende | zurck ",dummy|
ENDIF
IF dummy|=0
IF merker_stand%=1
alt_k%=k%
katalog
FOR k%=4 TO schluss_k%-8 STEP 4
wo%={start2%+k%}
IF BTST(BYTE{start%+wo%+13},0)
ALERT 1," | Merker sind gesetzt! | |Trotzdem nicht abspeichern? ",1," Ende | zurck ",dummy|
EXIT IF TRUE
ENDIF
NEXT k%
k%=alt_k%
ENDIF
ENDIF
IF dummy|=2
zwischenspeichern
ENDIF
CLR dummy|
RETURN
REM _______________________________________________________________________Person
PROCEDURE koptest
hier%=81
REM * LPRINT "koptest"
~FRE(0)
LOCAL cdc%,kontrzaehl%,tot$,kasten_adr%
tot$=SPACE$(512)
IF programmlaufwerk|-1<=1
cdc%=XBIOS(8,L:V:tot$,L:0,programmlaufwerk|-1,1,0,0,1)
IF cdc%=0
kontrzaehl%=BYTE{V:tot$+8}
IF kontrzaehl%<>BYTE{kasten%} OR kontrzaehl%=0 ! OR BYTE{kasten%}=0
kontrzaehl%=BYTE{kasten%}
IF BYTE{V:tot$+510}>0 AND BYTE{V:tot$+511}>0 ! wegen Ram-Disk(Checksumme)
INC kontrzaehl%
BYTE{kasten%}=kontrzaehl%
BYTE{V:tot$+8}=kontrzaehl%
BYTE{V:tot$+9}=kontrzaehl%+&H7B
BYTE{V:tot$+10}=kontrzaehl%+&HCB
kasten_adr%=kasten%-BASEPAGE-228
OPEN "U",#1,aufruf$
SEEK #1,kasten_adr%
OUT #1,kontrzaehl%
CLOSE
ENDIF
IF kontrzaehl%>3
tot
ENDIF
~BIOS(7,programmlaufwerk|-1)
~XBIOS(18,L:V:tot$,-1,-1,-1)
cdc%=XBIOS(9,L:V:tot$,L:0,programmlaufwerk|-1,1,0,0,1)
ENDIF
ENDIF
ENDIF
IF kontrzaehl%>3
tot
ENDIF
CLR tot$
CHDRIVE programmlaufwerk|
RETURN
PROCEDURE ludwig
hier%=82
REM * LPRINT "ludwig"
~FRE(0)
RESTORE hermann
ludwig$=SPACE$(33)
FOR schritt&=0 TO 32
READ a%
BYTE{V:ludwig$+schritt&}=a%
NEXT schritt&
hermann:
DATA 32,98,121,32,76,117,100,119,105,103,56,48,51,49,32,66,105,98,117,114,103
DATA 68,111,114,102,115,116,114,97,158,101,32,49
RETURN
PROCEDURE signet
hier%=83
REM * LPRINT "signet"
CLS
DEFFILL 1,2,4
PBOX 10,10/yt&,630,390/yt&
DEFFILL 1,0,0
PCIRCLE 320,200/yt&,180
DEFLINE 1,16/yt&,0,0
CIRCLE 320,200/yt&,180
DEFFILL 1,2,8
PCIRCLE 320,200/yt&,10
DEFTEXT 1,17,0,26,0
TEXT 250,210/yt&,ident$
DEFTEXT 1,4,0,13/yt&
ludwig
TEXT 318,230/yt&,CHR$(189)+LEFT$(ludwig$,10)
TEXT 311,245/yt&,MID$(ludwig$,11,11)
TEXT 302,260/yt&,RIGHT$(ludwig$,12)
DEFLINE 1,1,0,0
CLR ludwig$
RETURN
PROCEDURE leerlauf
hier%=84
REM * LPRINT "leerlauf"
endkasten
DO
OUT 5,7 ! kommt man normal nicht hin, weil endkasten
LOOP
RETURN
PROCEDURE tot
hier%=85
REM * LPRINT "tot"
DEFFILL 1,2,8
PBOX 0,0,640,400
ludwig
a$=SPACE$(1)+CHR$(189)+SPACE$(1)+MID$(ludwig$,5,6)+", "+MID$(ludwig$,11,11)+" | "+RIGHT$(ludwig$,12)
ALERT 3,SPACE$(5)+ident$+"| |"+a$+" ",1,weiter$,dummy|
CLR dummy|
ALERT 3,dead$,1,btn2$,dummy|
CLR dummy|
leerlauf
RETURN
REM _____________________________________________________________________Einzelne
PROCEDURE pruefen
hier%=86
REM * LPRINT "pruefen"
CLR merken%,k_merken%,p_zahl%,gefunden!
HIDEM
zahl%=C:statistik%(L:start%)-2
PRINT AT(64,4);zahl%
merken%=wo%
k_merken%=k%
k%=4
wo%={start2%+k%}
grosser_dateisatz
INC p_zahl%
DEFTEXT 1,0,0,13/yt&
REPEAT
PRINT AT(70,4);USING "#####",p_zahl%
REM TEXT 552,61/yt&-yt&,p_zahl%
lassen:
IF dsatz$(1)=""
IF dsatz$(0)=""
dick_fehler!=TRUE
ENDIF
IF dsatz$(0)="-"
dick_fehler!=TRUE
ENDIF
ENDIF
IF dick_fehler!
CLR dick_fehler!
gefunden!=TRUE
b$=" Datei-Nr.: "+STR$(k%/4)+" | hat weder Interpret | noch Titel: "
CLR dummy|
ALERT 1,b$,0,"l”schen | lassen ",dummy|
IF dummy|=2
ADD k%,4
wo%={start2%+k%}
grosser_dateisatz
CLR gefunden!
GOTO lassen
ENDIF
IF dummy|=1
loeschen
ENDIF
CLR dummy|
ENDIF
CLR dummy|
FOR schritt&=0 TO 12
IF dsatz$(schritt&)>""
b%=LEN(dsatz$(schritt&))-1
FOR schr&=0 TO b%
SELECT BYTE{V:dsatz$(schritt&)+schr&}
CASE TO 31
b$="| hat falsche Buchstaben ("+STR$(BYTE{V:dsatz$(schritt&)+schr&})+") | in Zeile "+STR$(schritt&)
dummy|=TRUE
EXIT IF TRUE
' pruefalert
ENDSELECT
NEXT schr&
ENDIF
NEXT schritt&
IF dummy|
pruefalert
ENDIF
CLR dummy|
'
'
' FOR schritt&=12 DOWNTO 0
' IF INSTR(dsatz$(schritt&),CHR$(21))
' b$="| hat falsche Buchstaben (21) | "
' pruefalert
' ' INC schritt&
' ENDIF
' IF INSTR(dsatz$(schritt&),CHR$(26))
' b$="| hat falsche Buchstaben (26) | "
' pruefalert
' ' INC schritt&
' ENDIF
' NEXT schritt&
dleertest%=100
FOR schritt&=0 TO 12
dleertest%=dleertest%+LEN(dsatz$(schritt&))
NEXT schritt&
dleertest%=dleertest%+dmodus&+VAL(RIGHT$(STR$(djahr&),2))+dart&+dbesitzer&
dleertest%=dleertest%+dzustand&+dz1&+dz2&+dz3&
dleertest%=dleertest%+dwert&
IF dnummer%>0
dleertest%=dleertest%+LEN(STR$(dnummer%))
ENDIF
IF CARD{start%+wo%+4}<>33333 AND CARD{start%+wo%+4}<>22222
b$="| hat Dateifehler | "
pruefalert
ELSE IF dbesitzer&>3 OR dbesitzer&<1
b$="| hat keinen Besitzer | "
pruefalert
ELSE IF dart&<1 OR dart&>15
b$="| hat keinen Arteintrag| "
pruefalert
ELSE IF dsatz$(4)=""
b$="| hat keinen Profileintrag | "
pruefalert
ELSE IF dleer%<100
b$="| Prfzahl nicht dreistellig| "
pruefalert
ELSE IF dleer%<>dleertest%
PRINT dleer%,dleertest%,dnummer%,LEN(STR$(dnummer%))
b$="| hat unkorrekte Prfsumme | "
pruefalert
ENDIF
sasa&=LEN(dsatz$(4))
soso&=1
IF sasa&>2
CLR dummy|
REPEAT
IF MID$(dsatz$(4),soso&,1)>=MID$(dsatz$(4),soso&+1,1)
b$="| hat unkorrektes Profil| "
pruefalert
ENDIF
EXIT IF gefunden!=TRUE
INC soso&
UNTIL soso&=sasa&-1
CLR dummy|
ELSE IF ASC(dsatz$(4))>88 OR ASC(dsatz$(4))<65
b$="| hat unkorrektes Profil| "
pruefalert
ENDIF
IF CARD{start%+{start%+wo%}+4}<>33333 AND CARD{start%+{start%+wo%}+4}<>22222
b$=" Zerst”rte Platte nach: | "+LEFT$(dsatz$(0),20)+"| "+LEFT$(dsatz$(1),28)+"| "
pruefalert
ENDIF
INC p_zahl%
EXIT IF p_zahl%=zahl%+1
ADD k%,4
wo%={start2%+k%}
EXIT IF CARD{start%+wo%+4}<>33333 AND CARD{start%+wo%+4}<>22222
EXIT IF BYTE{start%+wo%+12}=255
grosser_dateisatz
UNTIL dsatz$(0)=CHR$(255)
SELECT gefunden!
CASE 0
IF von_sicherheitskopie&=1 ! kommt von sicherheitskopie
ELSE
ALERT 0,"Keinen Dateifehler gefunden | | ",1,weiter$,dummy|
ENDIF
CLR dummy|
CASE -1
IF von_sicherheitskopie&=1
von_sicherheitskopie&=100 ! ist gleich fehler / 1 ist fehlerfrei
ENDIF
ENDSELECT
PRINT AT(64,4);SPC(12)
SHOWM
wo%=merken%
k%=k_merken%
CLR merken%,k_merken%,gefunden!,b$,sasa&,soso&,zahl%,p_zahl%
IF von_sicherheitskopie&=0 ! kommt nicht von Sicherheitskopie
MENU leiste$()
menuecheck
ON MENU
freitest
ENDIF
ON MENU
RETURN
PROCEDURE pruefalert
ON MENU
hier%=87
ON ERROR GOSUB fehler
REM * LPRINT "pruefalert"
von_sicherheitskopie&=100
gefunden!=TRUE
a$=" "+LEFT$(dsatz$(0),28)+"| "+LEFT$(dsatz$(1),28)+b$
CLR dummy|
ALERT 1,a$,1,"abbruch|weiter",dummy|
IF dummy|=1
' MENU leiste$()
' menuecheck
' ON MENU
ruecksprung(0)
ENDIF
MENU OFF
RETURN
PROCEDURE voreinstellung
hier%=88
REM * LPRINT "voreinstellung"
CLS
MENU leiste$()
menuecheck
IF yt&<2
DEFMOUSE eckmaus$
ENDIF
~FRE(0)
RBOX 3,170/yt&,320,390/yt& ! fr Profil
RBOX 320,170/yt&,635,390/yt& ! fr Daten
DEFTEXT 1,17,0,32
TEXT 99,185/yt&,"Profil"
TEXT 425,185/yt&,"Daten"
modus&=lieblingsmodus&
adj_schreiben(TRUE)
DEFTEXT 1,17/yt&,0,6
TEXT 350,210/yt&,"Besitzer"
DEFTEXT 1,0,0,6
PRINT AT(45,15);"Besitzer 1:";'';debes$(1)
PRINT AT(45,16);"Besitzer 2:";'';debes$(2)
PRINT AT(45,17);"Besitzer 3:";'';debes$(3)
PRINT AT(45,19);"E-Musik:"
PRINT AT(60,19);"U-Musik:"
PRINT AT(45,21);"Diskettenspeicherplatz prfen?"
PRINT AT(63,22);"prfen:"
PRINT AT(45,22);"nicht prfen:"
PRINT AT(45,24);"Zeichen/Druckzeile:";';
IF zproz&<30
zproz&=70
ENDIF
zproz&=MAX(zproz&,30)
PRINT AT(66,24);USING "###",zproz&;
TEXT 445,210/yt&,UPPER$(LEFT$(debes$(1)))
TEXT 515,210/yt&,UPPER$(LEFT$(debes$(2)))
TEXT 585,210/yt&,UPPER$(LEFT$(debes$(3)))
PUT 455,197/yt&,hell$,3 ! fr Besitzer1
PUT 525,197/yt&,hell$,3 ! fr Besitzer2
PUT 595,197/yt&,hell$,3 ! fr Besitzer3
BOX 517,367/yt&,547,385/yt& ! fr Zeichen/Druckzeile
DEFFILL 1,2,8
IF pref&=1 ! prfen
PUT 555,337/yt&,dunkel$,3
PUT 460,337/yt&,hell$,3 ! fr nicht prfen
ELSE IF pref&=3 ! nicht prfen
PUT 460,337/yt&,dunkel$,3
PUT 555,337/yt&,hell$,3 ! fr prfen
ENDIF
IF lieblingsmodus&=1 ! E_Musik
PUT 420,287/yt&,dunkel$,3
PUT 542,287/yt&,hell$,3 ! fr U-Musik
ELSE IF lieblingsmodus&=0 ! U-Musik
PUT 542,287/yt&,dunkel$,3
PUT 420,287/yt&,hell$,3 ! fr E-Musik
ENDIF
DEFFILL 1,0,0
DEFTEXT 1,17,0,6
TEXT 270,158/yt&," EXIT"
BOX 250,145/yt&,380,165/yt& ! fr šbernahme
DEFTEXT 1,0,0,4
TEXT 264,140/yt&,"(rechte Maustaste)"
DEFTEXT 1,0,0,13
plw$=CHR$(programmlaufwerk|+64)
IF LEFT$(plw$,4)=LEFT$(maskenpfad$,4)
maskenpfad$=MID$(maskenpfad$,4)
ENDIF
PRINT AT(6,4);"Voreinstellung fr Suchpfade:"
PRINT AT(7,6);"Plattendatei";''''''';ppfad$;
PRINT AT(7,7);"Sicherheitsdatei";''';spfad$;
IF nebenmaske|=1
PRINT AT(6,8);"Name dieser Neben-Maske:";'';nebenmasken$;
ELSE
IF LEFT$(maskenpfad$)="\"
PRINT AT(6,8);"Name dieser Maske:";'';plw$;":";maskenpfad$;
ELSE
PRINT AT(6,8);"Name dieser Maske:";'';maskenpfad$;
ENDIF
ENDIF
BOX 40,80/yt&,176,96/yt&
BOX 40,96/yt&,176,112/yt&
REPEAT
SHOWM
CLR exit&
REPEAT
ON MENU
ON MENU KEY GOSUB schreiben
EXIT IF MOUSEK=2
UNTIL MOUSEK=1
xx&=MOUSEX
yy&=MOUSEY*yt&
kk&=MOUSEK
REPEAT
UNTIL MOUSEK=0
IF kk&=2
IF yy&>145 AND yy&<165
IF kk&=2 AND xx&>250
ALERT 0,SPACE$(19),0,"Speichern|Programm",exit&
IF exit&=1
IF nebenmaske|=0
DEFFILL 1,0,0
PBOX 200,150/yt&,420,250/yt&
BOX 203,153/yt&,417,247/yt&
PRINT AT(29,11);"Welche Masken-Nummer?"
PRINT AT(35,13);"MASKE??";
PRINT AT(39,13);"E";
FORM INPUT 2,maskennummer$
PRINT AT(40,13);maskennummer$
ENDIF
GOTO abspeichern
ENDIF
IF exit&=2
SELECT modus& ! l”st plattenbild aus
CASE 1
CLR modus&
DEFAULT
modus&=1
ENDSELECT
ruecksprung(0)
ENDIF
ENDIF
ENDIF
ENDIF
SELECT yy&
CASE 80 TO 95
SELECT xx&
CASE 40 TO 180
PRINT AT(6,6);CHR$(27);"p";';"Plattendatei";'''';CHR$(27);"q";
CLR bild$
a$=ppfad$
REPEAT
IF filebox|
FILESELECT fileselect$,"",ppfad$
ELSE
ppfad$=@pfadfrage$
ENDIF
IF ppfad$=""
ppfad$=a$
ENDIF
extension_pruefen(ppfad$,"PLA",*kontrolle$)
ppfad$=kontrolle$
UNTIL ppfad$<>"000"
IF NOT EXIST(ppfad$)
OPEN "O",#5,ppfad$
CLOSE
ENDIF
PRINT AT(6,6);';"Plattendatei";''''''';ppfad$;SPACE$(23);
BOX 40,80/yt&,176,96/yt&
IF yt&<2
DEFMOUSE eckmaus$
ENDIF
ENDSELECT
CASE 96 TO 112
SELECT xx&
CASE 40 TO 180
PRINT AT(6,7);CHR$(27);"p";';"Sicherheitsdatei";CHR$(27);"q";
CLR bild$
a$=spfad$
REPEAT
IF filebox|
FILESELECT fileselect$,"",spfad$
ELSE
spfad$=@pfadfrage$
ENDIF
IF spfad$=""
spfad$=a$
ENDIF
extension_pruefen(spfad$,"PLA",*kontrolle$)
spfad$=kontrolle$
UNTIL spfad$<>"000"
IF NOT EXIST(spfad$)
OPEN "O",#5,spfad$
CLOSE
ENDIF
PRINT AT(6,7);';"Sicherheitsdatei";''';spfad$;SPACE$(22);
BOX 40,96/yt&,176,112/yt&
IF yt&<2
DEFMOUSE eckmaus$
ENDIF
ENDSELECT
CASE 367 TO 385 ! fr Zeichen/Druckzeile
SELECT xx&
CASE 517 TO 547
SETMOUSE 580,375/yt&
PRINT AT(66,24);''';
PRINT AT(66,24);
FORM INPUT 3,a$
zproz&=MAX(VAL(a$),30)
PRINT AT(66,24);''';
PRINT AT(66,24);USING "###",zproz&;
SETMOUSE 580,375/yt&
BOX 517,367/yt&,547,385/yt& ! fr Zeichen/Druckzeile
ENDSELECT
CASE 197 TO 213
CLR b%
SELECT xx&
CASE 455 TO 485 !Besitzer1
b%=1
CASE 525 TO 555 !Besitzer2
b%=2
CASE 595 TO 625 !Besitzer3
b%=3
ENDSELECT
IF b%
PUT 455-70+70*b%,197/yt&,dunkel$,3
CLR zet$,bst%
debes$(b%)=""
PRINT AT(58,14+b%);SPACE$(20)
DEFTEXT 1,0,0,6
TEXT 445-70+70*b%,210/yt&," "
IF MOUSEK=1
REPEAT
UNTIL MOUSEK=0
ENDIF
DO
CLR draus!,zet$,bst%
REPEAT
ON MENU
ON ERROR GOSUB fehler
ON MENU KEY GOSUB schreiben
EXIT IF draus!
EXIT IF MOUSEK
UNTIL bst%=7181
EXIT IF bst%=7181
EXIT IF MOUSEK
debes$(b%)=debes$(b%)+zet$
IF LEN(debes$(b%))>=20
debes$(b%)=LEFT$(debes$(b%),20)
ENDIF
PRINT AT(58,14+b%);debes$(b%)
DEFTEXT 1,0,0,6
TEXT 445-70+70*b%,210/yt&,UPPER$(LEFT$(debes$(b%)))
LOOP
PUT 455,197/yt&,hell$,3 ! fr Besitzer1
PUT 525,197/yt&,hell$,3 ! fr Besitzer2
PUT 595,197/yt&,hell$,3 ! fr Besitzer3
ENDIF
REPEAT
UNTIL MOUSEK=0
CLR b%
CASE 337 TO 351 !Prffrage
IF xx&>555 AND xx&<585 ! prfen
PUT 460,337/yt&,hell$,3
PUT 555,337/yt&,dunkel$,3 ! fr prfen
pref&=1
ELSE IF xx&>460 AND xx&<490 ! fr nicht prfen
PUT 555,337/yt&,hell$,3
PUT 460,337/yt&,dunkel$,3 ! fr nicht prfen
pref&=3
ENDIF
DEFFILL 1,0,0
CASE 287 TO 303 ! E- oder U-Musikfrage
SELECT xx&
CASE 420 TO 455,452 TO 577
SELECT xx&
CASE 420 TO 455
PUT 542,287/yt&,hell$,3
PUT 420,287/yt&,dunkel$,3
CLR bild$
modus&=1
lieblingsmodus&=1
CASE 542 TO 577
PUT 420,287/yt&,hell$,3
PUT 542,287/yt&,dunkel$,3
CLR modus&,lieblingsmodus&,bild$
ENDSELECT
adj_schreiben(TRUE)
DEFFILL 1,0,0
ENDSELECT
ENDSELECT
SELECT xx&
CASE 3 TO 320
SELECT yy&
CASE 170 TO 390
PUT 455,197/yt&,hell$,3 ! fr Besitzer1
PUT 525,197/yt&,hell$,3 ! fr Besitzer2
PUT 595,197/yt&,hell$,3 ! fr Besitzer3
ENDSELECT
ENDSELECT
SELECT xx&
CASE 100 TO 220 ! Profiladjektive
SELECT yy&
CASE 191 TO 383
j&=INT((yy&-63)/(16))
j&=MIN(19,j&)
jl&=j&-7
jr&=j&+5
SELECT xx&
CASE 161 TO
CLR kr&
IF adj$(jr&+24*modus&)>""
kr&=1
ENDIF
ls&=160
CASE TO 160
CLR kr&
IF adj$(jl&+24*modus&)>""
kr&=1
ENDIF
ls&=100
ENDSELECT
IF kr&=1 ! l”schen ! ****** „ndern, nicht nach Farbe
PUT ls&,63/yt&+j&*16/yt&,profil_hell$
SELECT xx&
CASE 60 TO 160
adj$(jl&+24*modus&)=""
PRINT AT(2,12+jl&);SPACE$(11)
CASE 161 TO
adj$(jr&+24*modus&)=""
PRINT AT(29,jr&);SPACE$(11)
ENDSELECT
ELSE IF kr&=0 ! Feld weiž: Eintrag
PUT ls&,63/yt&+j&*16/yt&,profil_dunkel$
DO
CLR draus!
REPEAT
ON MENU
ON ERROR GOSUB fehler
ON MENU KEY GOSUB schreiben
EXIT IF MOUSEK=2
EXIT IF MOUSEK=1
UNTIL draus!
EXIT IF bst%=7181
EXIT IF MOUSEK=1
EXIT IF MOUSEK=2
SELECT xx&
CASE TO 160
adj$(jl&+24*modus&)=adj$(jl&+24*modus&)+zet$
b$=SPACE$(11)
RSET b$=adj$(jl&+24*modus&)
PRINT AT(2,12+jl&);b$
CASE 161 TO
adj$(jr&+24*modus&)=adj$(jr&+24*modus&)+zet$
b$=SPACE$(11)
LSET b$=adj$(jr&+24*modus&)
PRINT AT(29,jr&);b$
ENDSELECT
CLR zet$,bst%
LOOP
SELECT xx&
CASE TO 160
IF adj$(jl&+24*modus&)>""
PUT ls&,63/yt&+j&*16/yt&,profil_muster$
ELSE
PUT ls&,63/yt&+j&*16/yt&,profil_hell$
ENDIF
CASE 161 TO
IF adj$(jr&+24*modus&)>""
PUT ls&,63/yt&+j&*16/yt&,profil_muster$
ELSE
PUT ls&,63/yt&+j&*16/yt&,profil_hell$
ENDIF
ENDSELECT
ENDIF
CLR zet$,bst%
ENDSELECT
REPEAT
UNTIL MOUSEK=0
ENDSELECT
abspeichern:
UNTIL exit&=1
CLR exit&
IF nebenmaske|=1
OPEN "R",#4,nebenmasken$
ELSE
maskenpfad$=programmordner$+"\MASKE"+maskennummer$+".PLA"
CHDRIVE programmlaufwerk|
OPEN "R",#4,maskenpfad$
ENDIF
SEEK #4,0
FOR schritt&=1 TO 48
PRINT #4,adj$(schritt&)
NEXT schritt&
PRINT #4,debes$(1)
PRINT #4,debes$(2)
PRINT #4,debes$(3)
PRINT #4,pref&
PRINT #4,ppfad$
PRINT #4,spfad$
PRINT #4,modus&
PRINT #4,zproz&
PRINT #4,1
PRINT #4,1
PRINT #4,"a"
PRINT #4,"a"
PRINT #4,"a"
PRINT #4,"a"
CLOSE #4
plattenbild1(FALSE)
RETURN
PROCEDURE platten_pro_besitzer ! slow
hier%=89
REM * LPRINT "platten_pro_besitzer"
IF yt&<2
DEFMOUSE eckmaus$
ELSE
BOX 0,20/yt&,639,399/yt&
ENDIF
MENU leiste$()
menuecheck
ON MENU
ON ERROR GOSUB fehler
freitest
ERASE fragezaehler&(),fragebreite&(),fragehoch&()
DIM fragezaehler&(15),fragebreite&(15),fragehoch&(15)
CLR frageart&
ARRAYFILL fragehoch&(),4
RESTORE fragebreite
FOR schritt&=1 TO 15
READ a&
fragebreite&(schritt&)=a&
NEXT schritt&
fragebreite:
DATA 6,42,14,50,29,10,54,19,21,35,59,70,64,28,70
fragehoch&(6)=8
fragehoch&(8)=8
fragehoch&(13)=8
fragehoch&(7)=8
fragehoch&(14)=8
fragehoch&(15)=8
CLR wosp%,ksp%,frageart&,fragebesitzer&,a&,a$
DEFFILL 1,0,0
DEFLINE 1,1*yt&,0,0
PUT 40,130/yt&,profil_hell$ ! Besitzer 1
PUT 285,130/yt&,profil_hell$ ! Besitzer 2
PUT 545,130/yt&,profil_hell$ ! Besitzer 3
DEFTEXT 1,17,0,4
RESTORE art_text
b&=75/yt&
FOR schr&=1 DOWNTO 0
FOR schritt&=8 DOWNTO 0
READ a&,c&,a$
EXIT IF a&=0
TEXT a&,b&,a$
PUT c&,b&-10/yt&,hell$,3
NEXT schritt&
b&=106/yt&
NEXT schr&
CLR a&,b&,c&,a$
PUT 285,200/yt&,profil_hell$ ! fr alles selektieren
TEXT 248,230/yt&,"alles selektieren"
DEFTEXT 1,17,0,8 !/yt&
TEXT 40,170/yt&,UPPER$(LEFT$(debes$(1),10))
TEXT 275,170/yt&,UPPER$(LEFT$(debes$(2),10))
TEXT 510,170/yt&,UPPER$(LEFT$(debes$(3),10))
PBOX 250,345/yt&,380,365/yt& ! fr Z„hlen-Beginn
DEFTEXT 1,17,0,13/yt&
TEXT 270,361/yt&," Z„hlen "
DEFTEXT 1,0,0,4
TEXT 265,335/yt&,"rechte Maustaste"
DO
REPEAT
UNTIL MOUSEK=0
REPEAT
ON MENU
ON ERROR GOSUB fehler
ON MENU GOSUB menue
UNTIL MOUSEK>0
xx&=MOUSEX
yy&=MOUSEY*yt&
kr&=PTST(MOUSEX,MOUSEY)
SELECT yy&
CASE 65 TO 79
CLR a_pl&
IF MOUSEK=1
CLR a_pl&,fa&
SELECT xx&
CASE 50 TO 80 ! LP=1
fa&=1
a_pl&=50
CASE 116 TO 146 ! DoLP=3
fa&=3
a_pl&=116
CASE 166 TO 196 ! EP=9
fa&=9
a_pl&=166
CASE 232 TO 262 ! Maxi=5
fa&=5
a_pl&=232
CASE 289 TO 319 ! Box=10
fa&=10
a_pl&=289
CASE 338 TO 368 ! CD=2
fa&=2
a_pl&=338
CASE 404 TO 434 ! DoCD=4
fa&=4
a_pl&=404
CASE 478 TO 508 ! CD-EP=11
fa&=11
a_pl&=478
CASE 565 TO 595 ! CD-Maxi=12
fa&=12
a_pl&=565
DEFAULT
CLR a_pl&,fa&
ENDSELECT
IF a_pl&
frageart&=BCHG(frageart&,fa&-1)
IF BTST(frageart&,fa&-1)
PUT a_pl&,65/yt&,dunkel$
ELSE
PUT a_pl&,65/yt&,hell$
ENDIF
ENDIF
CLR a_pl&,fa&
ENDIF
CASE 96 TO 110
CLR a_pl&
IF MOUSEK=1
CLR a_pl&,fa&
SELECT xx&
CASE 83 TO 113 ! Single=6
fa&=6
a_pl&=83
CASE 151 TO 181 ! Cass=8
fa&=8
a_pl&=151
CASE 226 TO 256 ! Video=14
fa&=14
a_pl&=226
CASE 434 TO 464 ! CD-Single=7
fa&=7
a_pl&=434
CASE 515 TO 545 ! CD-Box
fa&=13
a_pl&=515
CASE 558 TO 588 ! ?=15
fa&=15
a_pl&=558
DEFAULT
CLR a_pl&,fa&
ENDSELECT
IF a_pl&
frageart&=BCHG(frageart&,fa&-1)
IF BTST(frageart&,fa&-1)
PUT a_pl&,96/yt&,dunkel$
ELSE
PUT a_pl&,96/yt&,hell$
ENDIF
ENDIF
CLR a_pl&,fa&
ENDIF
CASE 200 TO 216 ! fr alles selektieren
SELECT xx&
CASE 285 TO 345
IF kr&=0
frageart&=-1
PUT 285,200/yt&,profil_dunkel$
b$=dunkel$
ELSE
frageart&=0
PUT 285,200/yt&,profil_hell$
b$=hell$
ENDIF
RESTORE art_text
b&=65/yt&
FOR schr&=1 DOWNTO 0
FOR schritt&=8 DOWNTO 0
READ a&,c&,a$
EXIT IF a&=0
PUT c&,b&,b$,3
NEXT schritt&
b&=96/yt&
NEXT schr&
CLR a&,b&,c&,a$,b$
ENDSELECT
CASE 130 TO 146
IF MOUSEK=1
CLR a_pl&
IF kr&=0
a$=profil_dunkel$
ELSE
a$=profil_hell$
ENDIF
SELECT xx&
CASE 40 TO 100 ! Besitzer 1
fragebesitzer&=BCHG(fragebesitzer&,1-1)
a_pl&=40
CASE 285 TO 345 ! Besitzer 2
fragebesitzer&=BCHG(fragebesitzer&,2-1)
a_pl&=285
CASE 545 TO 605 ! Besitzer 3
fragebesitzer&=BCHG(fragebesitzer&,3-1)
a_pl&=545
ENDSELECT
IF a_pl&
PUT a_pl&,130/yt&,a$
ENDIF
CLR a$,a_pl&
ENDIF
CASE 345 TO 365
IF MOUSEK=2
SELECT xx&
CASE 250 TO 380
DEFFILL 1,2,8
PBOX 250,345/yt&,380,365/yt& ! fr Z„hlen-Beginn
HIDEM
CLR wosp%,ksp%
IF frageart&<>0
FOR ksp%=4 TO schluss_k% STEP 4
wosp%={start2%+ksp%}
x|=BYTE{start%+wosp%+13}
dbesitzer&=(x| AND &X11000000)/64
IF BTST(fragebesitzer&,dbesitzer&-1) OR fragebesitzer&=0
dart&=(BYTE{start%+wosp%+7} AND &X1111)
IF dart&>0
IF BTST(frageart&,dart&-1)
INC fragezaehler&(dart&)
PRINT AT(fragebreite&(dart&),fragehoch&(dart&));USING "#####",fragezaehler&(dart&)
ENDIF
ENDIF
ENDIF
NEXT ksp%
ENDIF
CLR a&
FOR schritt&=14 DOWNTO 0
ADD a&,fragezaehler&(schritt&)
NEXT schritt&
PRINT AT(34,18);"(zusammen ";a&;")";
CLR frageart&,a&
SHOWM
ALERT 0,SPACE$(24),1,weiter$,dummy|
CLR dummy|
PRINT AT(1,4);SPACE$(80)
PRINT AT(1,8);SPACE$(80)
PRINT AT(34,18);SPACE$(15)
platten_pro_besitzer
ENDSELECT
ENDIF
ENDSELECT
LOOP
RETURN
REM _______________________________________________________________________Filter
PROCEDURE filtervergleich
hier%=90
REM * LPRINT "filtervergleich"
CLR sternchen|,eintrag|
fgrs%=start%+wo% ! anstatt in ffilter_dateisatz
IF BYTE{fgrs%+12}=255 ! (reicht ja wohl einmal?)
IF {start%}<>{start2%+schluss_k%}
SUB k%,4
ENDIF
wo%={start2%+k%}
ENDIF
IF k%<=0 ! kein else if !!
IF {start%}={start2%+schluss_k%}
ruecksprung(0)
ENDIF
ENDIF
HIDEM
CLR schreib1$,schreib2$,schreib$,sternchen|,fja%
IF sainterpret$>""
fsatz$(0)=sainterpret$
fja%=BSET(fja%,0)
ENDIF
IF saplatte$>""
fsatz$(1)=saplatte$
fja%=BSET(fja%,1)
ENDIF
IF saorchester$>""
fsatz$(2)=saorchester$
fja%=BSET(fja%,2)
ENDIF
IF saleitung$>""
fsatz$(3)=saleitung$
fja%=BSET(fja%,3)
ENDIF
fmodus&=modus&
IF klassikfilter&
fja%=BSET(fja%,18)
ENDIF
IF sajahr&
fjahr&=sajahr&
fja%=BSET(fja%,16)
ENDIF
IF f_art&
fja%=BSET(fja%,17)
ENDIF
IF sauebergabe$>""
fsatz$(4)=sauebergabe$
fprofl&=LEN(fsatz$(4))
fja%=BSET(fja%,4)
ENDIF
IF saz1&
fz1&=saz1&
fja%=BSET(fja%,20)
ENDIF
IF saz2&
fz2&=saz2&
fja%=BSET(fja%,21)
ENDIF
IF saz3&
fz3&=saz3&
fja%=BSET(fja%,22)
ENDIF
IF sanummer%
fnummer%=sanummer%
fja%=BSET(fja%,23)
ENDIF
IF sawert1& OR sawert2&
fwert1&=MIN(sawert1&,sawert2&)
fwert2&=MAX(sawert1&,sawert2&)
fja%=BSET(fja%,24)
ENDIF
IF sabesitzer&
fbesitzer&=sabesitzer&
fja%=BSET(fja%,13)
ENDIF
IF saland$>""
fsatz$(5)=saland$
fja%=BSET(fja%,5)
ENDIF
IF sazustand&
fzustand&=sazustand&
fja%=BSET(fja%,14)
ENDIF
IF sverliehen&
IF sverliehen&=1
zverliehen$="Verliehen"
ENDIF
fverliehen&=sverliehen&
fja%=BSET(fja%,15)
ENDIF
IF sverliehen$>""
fsatz$(6)=sverliehen$
fja%=BSET(fja%,6)
ENDIF
IF samerker& ! Merker
fmerker&=samerker&
fja%=BSET(fja%,19)
ENDIF
CLR fsatz!
FOR schritt&=1 TO 5
IF samitspieler$(schritt&)>""
fsatz$(schritt&+6)=samitspieler$(schritt&)
fsatz!=TRUE
fja%=BSET(fja%,schritt&+6)
ENDIF
NEXT schritt&
IF safenster$(1)>""
fsatz$(12)=safenster$(1)
fja%=BSET(fja%,12)
ENDIF
IF fja%=0 AND filterdummy&=0 ! wegen Ausdruck aller Platten/Daten
ALERT 1," | | - Keine Filterangabe! -",1,"zurck",dummy|
sa_loeschen ! eigentlich nicht n”tig, wenn Filter leer, aber.....
plattenbild
grosse_ausgabe
ruecksprung(1)
ENDIF
CLR filterdummy&
SELECT fbesitzer&
CASE 1
zbesitzer$=" ("+debes$(1)+") "
CASE 2
zbesitzer$=" ("+debes$(2)+") "
CASE 3
zbesitzer$=" ("+debes$(3)+")"
DEFAULT
zbesitzer$=""
ENDSELECT
'
in_den_keller
'
SELECT wrt&
CASE 7
filter_kriterium_drucken
CASE 5,6,11,13,14
CLS
MENU leiste$()
menuecheck
SELECT wrt&
CASE 5,11,13
kleines_bild
CASE 6,14
RBOX 25,70/yt&,605,100/yt&
SELECT wrt&
CASE 6
PRINT AT(25,6);"Gefilterte Zahl: "
CASE 14
PRINT AT(16,6);"Vorwahl fr Serie-Žndern: "
ENDSELECT
ENDSELECT
filter_kriterium_lesen ! = Der Filter wird angezeigt
ENDSELECT
FOR schritt&=0 TO 20 ! h”chstes schritt& finden
IF fsatz$(schritt&)>""
fhol&=schritt&
ENDIF
NEXT schritt&
IF fhol&>=7 AND fhol&<=10
fhol&=11
ENDIF
filterneustart:
wo%={start2%+4}
k%=4
CLR filterzahl%
filterneustart2:
zeit%=TIMER
REM
ffilter ! ********************** der eigentliche Filter *****************
REM
IF filterzahl%=0
IF wrt&<>11 ! Export
CLOSE
ENDIF
PRINT AT(5,24);ROUND((TIMER-zeit%)/200,1);';"sek.";
PRINT CHR$(7);
ALERT 0," | Kein Eintrag | ",1," Weiter ",dummy|
CLR dummy|
IF wrt&<11 OR wrt&=14 ! Export=11,Serienl”schen=13
plattenbild
CLR schreib1$,schreib2$,schreib$,sternchen|
modus&=fmodus&
sainterpret$=fsatz$(0)
saplatte$=fsatz$(1)
saorchester$=fsatz$(2)
saleitung$=fsatz$(3)
sajahr&=fjahr&
REM saart&=fart&
sverliehen&=fverliehen&
sauebergabe$=fsatz$(4)
sabesitzer&=fbesitzer&
samerker&=fmerker& ! Merker
saz1&=fz1&
saz2&=fz2&
saz3&=fz3&
sanummer%=fnummer%
sawert1&=fwert1&
sawert2&=fwert2&
saland$=fsatz$(5)
sazustand&=fzustand&
sverliehen$=fsatz$(6)
samitspieler$(1)=fsatz$(7)
samitspieler$(2)=fsatz$(8)
samitspieler$(3)=fsatz$(9)
samitspieler$(4)=fsatz$(10)
samitspieler$(5)=fsatz$(11)
safenster$(1)=fsatz$(12)
wiederholung!=TRUE
a&=klassikfilter&
b&=f_art&
fvar_loeschen
klassikfilter&=a&
f_art&=b&
CLR a&,b&
grosse_ausgabe
ruecksprung(1)
ENDIF
ENDIF
SELECT wrt& ! Export
CASE 11
IF filterzahl%>0
PRINT AT(38,12);DIV(k%-4,4);'
fvar_loeschen
sa_loeschen
ENDIF
CASE 7,13 ! filterdrucken und Serienl”schen
IF wrt&=13 AND filterzahl%>0
PRINT AT(38,12);DIV(k%-4,4);'
ENDIF
CLR loeschpr%,sloe%
fvar_loeschen
sa_loeschen
PAUSE 20
ruecksprung(0)
CASE 14 ! Serien„ndern
PRINT AT(38,12);DIV(k%-4,4);'
FOR k%=0 TO schluss_k%-8 STEP 4
wo%={start2%+k%}
EXIT IF CARD{start%+wo%+4}=22222
NEXT k%
IF k%255
INC zahl%
a%={start%+a%}
WEND
PRINT CHR$(7);
PRINT AT(25,6);"Gefilterte Zahl: ";filterzahl%;';
OUT 5,4
prozent=filterzahl%/(zahl%-2)*100
prozent=ROUND(prozent,2)
PRINT AT(24,8);"(entspricht ";prozent;"% der Gesamtzahl)"
PRINT AT(5,24);ROUND((TIMER-zeit%)/200,1);';"sek.";
CLR prozent,filterzahl%,wrt&
DEFMOUSE 0
DO
ON MENU
ON ERROR GOSUB fehler
ON MENU GOSUB menue
LOOP
CASE 5
IF BYTE{start%+wo%+12}=10 AND filterzahl%>0
anfang!=TRUE
ELSE
CLR anfang!
ENDIF
DEFFILL 0,0,0
PBOX 15,126/yt&,580,205/yt&
DEFFILL 1,0,0
RBOX 50,135/yt&,570,169/yt&
RBOX 48,133/yt&,572,171/yt&
a&=140/yt&
b&=163/yt&
BOX 220,a&,330,b&
BOX 335,a&,445,b&
BOX 450,a&,560,b&
BOX 448,138/yt&,562,165/yt&
DEFFILL 0,0,0 ! Merker
PBOX 602,369/yt&,635,396/yt&
kein_merker&=1
CLR filterzahl% ! Falls Merkersuche und Merker gel”scht
IF anfang!
PRINT AT(9,10);"Anfang der Liste!"
PRINT AT(35,10);
OUT 5,3
ELSE
PRINT AT(10,10);"Ende der Liste!"
PRINT AT(35,10);
OUT 5,4
ENDIF
PRINT AT(38,12);SPACE$(8)
PRINT AT(46,10);"Ausdruck"
PRINT AT(60,10);"Programm"
REPEAT
UNTIL MOUSEK=0
CLR zet$,bst%,kein_merker& ! Merker
DO
versch_menues
IF MOUSEK
SELECT MOUSEY*yt&
CASE 140 TO 163
CLR kein_merker& ! Merker
SELECT MOUSEX
CASE 220 TO 330 ! Pfeil
IF anfang!
rechts!=TRUE
ELSE
links!=TRUE
ENDIF
CASE 335 TO 445 ! Ausdruck
DEFFILL 0,0,0
PBOX 48,133/yt&,572,171/yt&
wrt&=7
filter_kriterium_drucken
CLR abnehmen! !nach rechts
GOTO filterneustart
CASE 450 TO 560 ! Programm
programm!=TRUE
ENDSELECT
ENDSELECT
ENDIF
IF bst%=7181 OR programm!
CLR programm!
fvar_loeschen
sa_loeschen
plattenbild
kopf_bild(modus&)
ruecksprung(1)
ELSE IF bst%=19200
links!=TRUE
ELSE IF bst%=19712
rechts!=TRUE
ENDIF
IF links!
CLR links!
PRINT AT(38,12);SPACE$(8)
DEFFILL 0,0,0
PBOX 48,133/yt&,572,171/yt&
kleines_bild
k%=schluss_k%-8
wo%={start2%+k%}
abnehmen!=TRUE ! nach lincks
GOTO filterneustart2
ELSE IF rechts!
CLR rechts!
PRINT AT(38,12);SPACE$(8)
DEFFILL 0,0,0
PBOX 48,133/yt&,572,171/yt&
kleines_bild
CLR abnehmen! ! nach rechts
GOTO filterneustart
ENDIF
LOOP
ENDSELECT
SHOWM
RETURN
PROCEDURE ffilter ! slow
hier%=91
REM * LPRINT "ffilter"
MENU OFF
CLR kp&
DEFTEXT 1,0,0,13
REPEAT
SELECT wrt&
CASE 5,6,11,13,14
INC kp& ! nicht jedesmal ausgeben
IF kp&=3 !9
PRINT AT(38,12);DIV(k%,4);';
CLR kp&
ENDIF
ENDSELECT
CLR uebereinstimmung!,resul%
fgrs%=start%+wo% ! ==> Filterdateisatz
fb1|=BYTE{fgrs%+7}
fb2|=BYTE{fgrs%+13}
sss&=BYTE{fgrs%+6}
ERASE dsatz$()
DIM dsatz$(20)
DO
hol&=BYTE{fgrs%+sss&}
EXIT IF hol&>20
EXIT IF hol&=254
dsatz$(hol&)=CHAR{fgrs%+sss&+1}
EXIT IF hol&=fhol&
sss&=sss&+LEN(dsatz$(hol&))+2
LOOP
IF dsatz$(0)="-"
dsatz$(0)=""
ENDIF
IF fprofl&
CLR profilzaehler&
IF fmodus&=ABS(BTST(fb1|,7))
FOR schritt&=1 TO fprofl&
IF INSTR(dsatz$(4),MID$(fsatz$(4),schritt&,1))
INC profilzaehler&
ELSE
EXIT IF TRUE
ENDIF
NEXT schritt&
ENDIF
ENDIF
IF fsatz! ! Mitspieler
f_komb$=dsatz$(0)+" "+dsatz$(7)+" "+dsatz$(8)+" "+dsatz$(9)+" "+dsatz$(10)+" "+dsatz$(11)
ENDIF
REM Anfang Filter +++++++++++++++++++++++++++++++++++++++++++++++++++++++
b%=fja%
FOR schritt&=0 TO 24
b%=BCLR(b%,schritt&)
IF BTST(fja%,schritt&)
SELECT schritt&
CASE 0 ! Interpret
IF INSTR(dsatz$(0),fsatz$(0))
resul%=BSET(resul%,0)
ENDIF
CASE 1,2,3,6,12 ! Platte, Stcke, Verliehen$, Orchester, Leitung
IF INSTR(UPPER$(dsatz$(schritt&)),UPPER$(fsatz$(schritt&)))
resul%=BSET(resul%,schritt&)
ENDIF
CASE 4 ! Profil
IF fprofl&=profilzaehler&
resul%=BSET(resul%,4)
ENDIF
CASE 5 ! Land
IF fsatz$(5)=dsatz$(5)
resul%=BSET(resul%,5)
ENDIF
CASE 7 TO 11 ! Mitspieler
IF INSTR(UPPER$(f_komb$),UPPER$(fsatz$(schritt&)))
resul%=BSET(resul%,schritt&)
ENDIF
CASE 13 ! Besitzer
IF fbesitzer&=(fb2| AND &X11000000)/64
resul%=BSET(resul%,13)
ENDIF
CASE 14 ! Zustand
IF BTST(fb1|,6)
resul%=BSET(resul%,14)
ENDIF
CASE 15 ! Verliehen&
IF (fverliehen&>0 AND ((fb1| AND &X110000)/16)>0)
resul%=BSET(resul%,15)
ENDIF
CASE 16 ! Jahr
IF CARD{fgrs%+10}=fjahr& OR (fjahr&>0 AND fjahr&<1000 AND INSTR(STR$(CARD{fgrs%+10}),STR$(fjahr&)))
resul%=BSET(resul%,16)
ENDIF
CASE 17 ! Art
IF BTST(f_art&,(fb1| AND &X1111)-1)
resul%=BSET(resul%,17)
ENDIF
CASE 18 ! Klassikfilter
IF klassikfilter&=1
IF ABS(BTST(fb1|,7))=1
resul%=BSET(resul%,18)
ENDIF
ELSE IF klassikfilter&=2
IF ABS(BTST(fb1|,7))=0
resul%=BSET(resul%,18)
ENDIF
ENDIF
CASE 19 ! Merker
IF BTST(fb2|,0)
resul%=BSET(resul%,19)
ENDIF
CASE 20,21,22 ! z1&,z2&,z3&
IF BTST(fb2|,schritt&-19)
resul%=BSET(resul%,schritt&)
ENDIF
CASE 23 ! Nummer
IF BYTE{fgrs%+6}=20
IF {fgrs%+14}=fnummer%
resul%=BSET(resul%,23)
ENDIF
ENDIF
CASE 24 ! Wert
SELECT BYTE{fgrs%+6}
CASE 20
a&=BYTE{fgrs%+18}
DEFAULT
a&=0
ENDSELECT
IF a&>=fwert1& AND a&=20
EXIT IF hol&=254
exp_satz$(hol&)=CHAR{exsd%+sss&+1}
sss&=sss&+LEN(exp_satz$(hol&))+2
LOOP
sss&=sss&+1 ! fr: BYTE{start%+wo%+sss&}=254 ! Schluss-ID
IF EVEN(sss&)=0
INC sss&
ENDIF
ex_adr$=SPACE$(4)
ex_adr%=ex_adr%+sss&
{VARPTR(ex_adr$)}=ex_adr%
BPUT #11,VARPTR(ex_adr%),4
BPUT #11,exsd%+4,sss&-4
INC exoe%
PRINT AT(32,10);USING "####",exoe%;
PRINT ';"exportiert";
ERASE exp_satz$()
CLR exsd%,sss&
CASE 5 ! Filerlesen ******
PRINT AT(38,12);DIV(k%,4);'
kleiner_dateisatz
kleine_ausgabe
PRINT CHR$(7);
REPEAT
CLR draus!,zet$
IF BTST(BIOS(11,-1),2) ! Control-Taste
IF abnehmen!
bst%=19200
ELSE
bst%=19712
ENDIF
EXIT IF TRUE
ELSE
WHILE GEMDOS(11)>0
~GEMDOS(7)
WEND
~XBIOS(35,10,0)
ENDIF
REPEAT
IF BTST(BIOS(11,-1),2) ! Control-Taste
IF abnehmen!
bst%=19200
ELSE
bst%=19712
ENDIF
EXIT IF TRUE
ENDIF
versch_menues
IF MOUSEK>1
check
ELSE IF MOUSEK=1 ! Merker
SELECT MOUSEY*yt&
CASE 369 TO 398
SELECT MOUSEX
CASE 602 TO 638
merker_eintrag
CASE 315 TO 348 ! Stckefeld
SETMOUSE MOUSEX,MOUSEY,0
bst%=29197
draus!=TRUE
ENDSELECT
ENDSELECT
REPEAT
UNTIL MOUSEK=0
ENDIF
UNTIL draus!
SELECT bst%
CASE 19712,29696
CLR abnehmen!
CASE 19200,29440
abnehmen!=TRUE
CASE 29197
~XBIOS(35,6,3) ! Tastatur (Delay 6,repeat 3) (unstimmig)
wrt&=10
titel(TRUE,58)
wrt&=5
DEFFILL 0,0,0
PRBOX 3,145/yt&,320*60/30,390/yt& ! fr Schallplattentitel
filter_kriterium_lesen
kleiner_dateisatz
IF dmerker&=1 ! Merker
PUT 602,369/yt&,merker_dunkel$
ELSE
PUT 602,369/yt&,merker_hell$
ENDIF
DEFTEXT 1,0,0,13
PUT 315,369/yt&,merker_hell$ ! Stckefeld
TEXT 323,388/yt&,"St"
PRINT AT(38,12);DIV(k%,4);'
CASE 7181
plattenbild
DEFFILL 1,0,0
PBOX 250,145/yt&,380,165/yt& ! fr šbernahme
grosser_dateisatz
sa_gleich_d
grosse_ausgabe
CLR zet$,bst%
REPEAT
REPEAT
ON MENU
ON ERROR GOSUB fehler
ON MENU KEY GOSUB schreiben
IF MOUSEK=1 ! Merker
SELECT MOUSEY*yt&
CASE 369 TO 398
SELECT MOUSEX
CASE 602 TO 638
merker_eintrag
CASE 315 TO 348 ! Stckefeld
SETMOUSE MOUSEX,MOUSEY,0
bst%=29197
draus!=TRUE
ENDSELECT
ENDSELECT
ENDIF
UNTIL bst%=7181 OR bst%=19712 OR bst%=19200 OR bst%=29197
SELECT bst%
CASE 7181,19712,19200
SELECT bst% ! Schliessen mit Cursor-Taste
CASE 19712
CLR abnehmen!
CASE 19200
abnehmen!=TRUE
ENDSELECT
CLS
kleiner_dateisatz
kleines_bild
filter_kriterium_lesen
kleine_ausgabe
PRINT AT(38,12);DIV(k%,4);'
CASE 29197
~XBIOS(35,6,3)
weiss|=1 ! Titelfeld schliessen
wrt&=10
titel(TRUE,30)
wrt&=5
schliessen
CLR zet$,bst%
~XBIOS(35,6,0)
ENDSELECT
UNTIL bst%=7181 OR bst%=19712 OR bst%=19200
ENDSELECT
EXIT IF bst%=29440
EXIT IF bst%=29696
UNTIL bst%=19712 OR bst%=19200
CASE 7
kleiner_dateisatz
kleine_ausgabe
drucken
CASE 6
PRINT AT(42,6);filterzahl%
ENDSELECT
ENDIF
IF NOT abnehmen!
k%=ADD(k%,4)
wo%={start2%+k%}
ELSE IF abnehmen!
k%=SUB(k%,4)
wo%={start2%+k%}
ENDIF
EXIT IF BYTE{start%+wo%+12}=10
UNTIL BYTE{start%+wo%+12}=255
RETURN
PROCEDURE filter_kriterium_lesen ! slow
hier%=92
REM * LPRINT "filter_kriterium_lesen"
PRINT AT(5,14);"Filterbedingungen:"
DRAW 15,223/yt& TO 615,223/yt&
DEFTEXT 1,0,0,13
PUT 315,369/yt&,merker_hell$ ! Stckefeld
TEXT 323,388/yt&,"St"
zart$=SPACE$(4)
FOR schritt&=0 TO 15
IF BTST(f_art&,schritt&)
zart$=zart$+TRIM$(zaart$(schritt&+1))+" "
ENDIF
NEXT schritt&
IF fjahr&=0
ljahr$=""
ELSE
ljahr$=STR$(fjahr&)
ENDIF
PRINT SPACE$(4)+fsatz$(0);';fsatz$(1);';ljahr$
IF zart$>SPACE$(4)
PRINT LEFT$(zart$,LEN(zart$)-3)
ENDIF
IF fmodus&=1
PRINT SPACE$(4)+fsatz$(2),fsatz$(3)
ENDIF
ljahr$=""
lzart$=""
IF klassikfilter&=1
PRINT SPACE$(4);"E-Musik "
ELSE IF klassikfilter&=2
PRINT SPACE$(4);"U-Musik "
ENDIF
IF fz1& OR fz2& OR fz3&
PRINT SPACE$(4);"freier Zusatz ";
IF fz1&
PRINT " 1 ";
ENDIF
IF fz2&
PRINT " 2 ";
ENDIF
IF fz3&
PRINT " 3 "
ENDIF
ENDIF
IF fnummer%
PRINT SPACE$(4);"Nummer: ";fnummer%
ENDIF
IF fwert1& OR fwert2&
CLR a$
IF fwert2&>0 AND fwert2&<>fwert1&
a$="-"+STR$(fwert2&)
ENDIF
PRINT SPACE$(4);"Wert ";fwert1&;a$
ENDIF
IF fsatz$(12)>""
PRINT SPACE$(4);"Titelsuche: ";fsatz$(12)
ENDIF
IF fsatz$(4)>""
PRINT SPACE$(4)+"Profil: ";@profilrueckuebersetzung$(fsatz$(4))
ENDIF
IF fsatz$(7)>"" OR fsatz$(8)>"" OR fsatz$(9)>"" OR fsatz$(10)>"" OR fsatz$(11)>""
PRINT SPACE$(4)+fsatz$(7);';fsatz$(8);';fsatz$(9);';fsatz$(10);';fsatz$(11)
ENDIF
IF fverliehen&=2 OR fverliehen&=0
zverliehen$=""
ENDIF
PRINT SPACE$(4)+zverliehen$;';fsatz$(5);'
IF fverliehen&=2
PRINT SPACE$(4)+"Verliehen an ";fsatz$(6);';fsatz$(5);'
ENDIF
IF fzustand&=1
PRINT SPACE$(4)+"Zustand schlecht"
ENDIF
IF fmerker&=1 ! Merker
PRINT SPACE$(4)+"- Merker -"
ENDIF
IF zbesitzer$>""
PRINT SPACE$(4)+"Besitzer:";zbesitzer$
ENDIF
IF wrt&=11
PRINT AT(5,23);"Pfad zum Abspeichern der Export-Datei:"
PRINT AT(5,24);exsp$;SPACE$(36)
ENDIF
RETURN
PROCEDURE filter_kriterium_drucken
hier%=93
REM * LPRINT "filter_kriterium_drucken"
CLR fjahr$,lpart$
zumabbrechen
IF fsatz$(0)="" AND fsatz$(1)="" AND fjahr&=0 AND f_art&=0 AND fsatz$(4)=""
IF fsatz$(2)="" AND fsatz$(3)="" AND fmodus&=0
IF fbesitzer&=0 AND fsatz$(5)="" AND fzustand&=0
IF fsatz$(6)="" AND fverliehen&=0
IF fsatz$(7)="" AND fsatz$(8)="" AND fsatz$(9)=""
IF fsatz$(10)="" AND fsatz$(11)="" AND fsatz$(12)=""
IF fmerker&=0 AND fz1&=0 AND fz2&=0 AND fz3&=0
IF fnummer%=0 AND fwert1&=0 AND fwert2&=0
LPRINT STRING$(zproz&-10,"_");DATE$
LPRINT "Gesamtliste ohne Auswahlkriterium"
LPRINT "***"
LPRINT
GOTO subkriterium
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
IF zproz&<30
zproz&=70
ENDIF
fjahr$=STR$(fjahr&)
IF fjahr&=0
CLR fjahr$
ENDIF
LPRINT STRING$(zproz&-10,"_");DATE$
LPRINT ;"Filterbedingungen:"
lpart$=""
FOR schritt&=0 TO 15
IF BTST(f_art&,schritt&)
lpart$=lpart$+TRIM$(zaart$(schritt&+1))+SPACE$(3)
ENDIF
NEXT schritt&
IF fsatz$(0)>"" OR fsatz$(1)>""
LPRINT ;fsatz$(0);';fsatz$(1)
ENDIF
IF fmodus&=1
IF fsatz$(2)>"" OR fsatz$(3)>""
LPRINT ;fsatz$(2);';fsatz$(3);'
ENDIF
ENDIF
IF fjahr$>"" OR zbesitzer$>""
LPRINT ;fjahr$;';zbesitzer$;';
ENDIF
IF lpart$>SPACE$(3)
LPRINT LEFT$(lpart$,LEN(lpart$)-3)
ENDIF
lpart$=""
IF fsatz$(4)>""
LPRINT ;"Profil:";';@profilrueckuebersetzung$(fsatz$(4))
ENDIF
IF fsatz$(7)>"" OR fsatz$(8)>"" OR fsatz$(9)>"" OR fsatz$(10)>"" OR fsatz$(11)>""
LPRINT ;fsatz$(7);fsatz$(8);fsatz$(9);fsatz$(10);fsatz$(11)
ENDIF
IF klassikfilter&=1
LPRINT "E-Musik "
ELSE IF klassikfilter&=2
LPRINT "U-Musik "
ENDIF
IF fmerker&=1 ! Merker
LPRINT "- Merker -"
ENDIF
IF fz1& OR fz2& OR fz3&
LPRINT "freier Zusatz ";
IF fz1&
LPRINT " 1 ";
ENDIF
IF fz2&
LPRINT " 2 ";
ENDIF
IF fz3&
LPRINT " 3 "
ENDIF
ENDIF
IF fnummer%>0
LPRINT "Nummer ";fnummer%
ENDIF
IF fwert1& OR fwert2&
CLR a$
IF fwert2&>0 AND fwert2&<>fwert1&
a$="-"+STR$(fwert2&)
ENDIF
LPRINT "Wert ";fwert1&;a$
ENDIF
IF fsatz$(12)>""
LPRINT "Titelsuche: ";fsatz$(12)
ENDIF
IF fverliehen&=2 OR fverliehen&=0
zverliehen$=""
ENDIF
LPRINT ;zverliehen$;';fsatz$(5);';
IF fverliehen&=2
LPRINT ;"Verliehen an ";fsatz$(6);';fsatz$(5);';
ENDIF
IF fzustand&=1
LPRINT ;"Zustand schlecht"
ENDIF
LPRINT ;"***"
LPRINT
subkriterium:
CLR fjahr$,lpart$
RETURN
FUNCTION profilrueckuebersetzung$(pr$)
hier%=94
REM * LPRINT "FUNCTION profilrueckuebersetzung$(pr$)"
LOCAL a$,b&
~FRE(0)
CLR a$,b&
a&=24*modus&-64
FOR b&=1 TO LEN(pr$)
a$=a$+adj$(ASC(MID$(pr$,b&,1))+a&)+" "
NEXT b&
RETURN TRIM$(a$)
ENDFUNC
REM ______________________________________________________________________Drucken
PROCEDURE drucken
hier%=95
REM * LPRINT "drucken"
freitest
LOCAL lzustand$,lverliehen$,lbesitzer$,druckplatte$,druckklassik$
LOCAL druckleitung$,druckzart$,druckjahr$
LOCAL tzeige$
DIM lfenster$(100)
IF zproz&<30
zproz&=70
ENDIF
trennung&=15
CLR lzustand$,lverliehen$,lbesitzer$,druckleitung$
DO
IF GEMDOS(17)=0
PAUSE 50
ENDIF
EXIT IF GEMDOS(17)=TRUE
druck_abbruch
LOOP
grosser_dateisatz
ON MENU
ON ERROR GOSUB fehler
ON MENU KEY GOSUB druck_abbruch
IF NOT zwischendruck!
kleine_ausgabe
ENDIF
IF dzustand&=1
lzustand$="schlechter Zustand"
ENDIF
IF dverliehen&=1
lverliehen$="(verliehen)"
ELSE IF dverliehen&=2
lverliehen$="(an "+LEFT$(dsatz$(6),20)+" verliehen) "
IF parole!
lverliehen$="(an "+dsatz$(6)+" verliehen) "
ENDIF
ENDIF
IF dbesitzer&>0
lbesitzer$="("+UPPER$(LEFT$(debes$(dbesitzer&),1))+")"
ENDIF
druckjahr$=SPACE$(6)
IF djahr&>0
LSET druckjahr$=STR$(djahr&)
ENDIF
druckzart$=SPACE$(10)
LSET druckzart$=zaart$(dart&)
druckbesitzer$=SPACE$(5)
LSET druckbesitzer$=lbesitzer$
REM
REM ********** anfang <> totalausdruck
REM
IF NOT parole!
IF dsatz$(0)>""
LPRINT LEFT$(dsatz$(0),zproz&)
ENDIF
druckplatte$=SPACE$(zproz&-24)
LSET druckplatte$=dsatz$(1)
LPRINT druckplatte$'''druckjahr$;druckbesitzer$;druckzart$
IF dmodus&=1
druckklassik$=SPACE$(zproz&)
anz&=INSTR(dsatz$(3),CHR$(44))
IF anz&>0
druckleitung$=", "+LEFT$(dsatz$(3),anz&-1)
ENDIF
LSET druckklassik$=LEFT$(dsatz$(2),zproz&-LEN(druckleitung$))+druckleitung$
IF druckklassik$>""
LPRINT druckklassik$
ENDIF
ENDIF
IF lverliehen$>""
LPRINT lverliehen$;
ENDIF
IF lzustand$>""
LPRINT lzustand$
ENDIF
LPRINT
ELSE IF parole!
FOR schritt&=0 TO 3
langschreiben(dsatz$(schritt&),0,zproz&)
NEXT schritt&
LPRINT ''druckjahr$;druckbesitzer$;druckzart$''dsatz$(5)
langschreiben(lverliehen$,2,zproz&)
IF lzustand$>""
LPRINT '';lzustand$
ENDIF
IF dmerker&
LPRINT '"- Merker gesetzt -"'
ENDIF
IF dz1& OR dz2& OR dz3&
LPRINT "freier Zusatz ";
IF dz1&
LPRINT '"1"';
ENDIF
IF dz2&
LPRINT '"2"';
ENDIF
IF dz3&
LPRINT '"3"'
ENDIF
ENDIF
IF dsatz$(4)>""
tzeige$=@profilrueckuebersetzung$(dsatz$(4))
a$=LEFT$(tzeige$,zproz&-8)
IF LEN(tzeige$)>zproz&-8
IF RINSTR(a$,CHR$(32))>zproz&-8-trennung&
a$=LEFT$(a$,RINSTR(a$,CHR$(32))-1)
ENDIF
tzeige$=MID$(tzeige$,LEN(a$)+1)
LPRINT a$
tzeige$=TRIM$(tzeige$)
langschreiben(tzeige$,8,zproz&)
ELSE
LPRINT tzeige$
ENDIF
CLR vors!
ENDIF
IF dsatz$(7)>"" OR dsatz$(8)>"" OR dsatz$(9)>"" OR dsatz$(10)>"" OR dsatz$(11)>""
LPRINT "Mitspieler: ";
tth&=7
REPEAT
IF dsatz$(tth&)>""
IF NOT vors!
a$=LEFT$(dsatz$(tth&),zproz&-12)
IF LEN(dsatz$(tth&))>zproz&-12
IF RINSTR(a$,CHR$(32))>zproz&-12-trennung&
a$=LEFT$(a$,RINSTR(a$,CHR$(32))-1)
ENDIF
dsatz$(tth&)=MID$(dsatz$(tth&),LEN(a$)+1)
LPRINT a$
dsatz$(tth&)=TRIM$(dsatz$(tth&))
langschreiben(dsatz$(tth&),12,zproz&)
ELSE
LPRINT dsatz$(tth&)
ENDIF
vors!=TRUE
ELSE IF vors!
langschreiben(dsatz$(tth&),12,zproz&)
ENDIF
ENDIF
INC tth&
UNTIL tth&=12
CLR vors!
ENDIF
IF dsatz$(12)>""
LPRINT "Titel: ";
CLR anz&,stelle&,tth&
REPEAT
EXIT IF dsatz$(12)=""
EXIT IF INSTR(dsatz$(12),CHR$(244),stelle&)=0
anz&=INSTR(stelle&,dsatz$(12),CHR$(244))-stelle&
lfenster$(tth&)=MID$(dsatz$(12),stelle&,anz&)
IF tth&>0
IF NOT vors!
a$=LEFT$(lfenster$(tth&),zproz&-7)
IF LEN(lfenster$(tth&))>zproz&-7
IF RINSTR(a$,CHR$(32))>zproz&-7-trennung&
a$=LEFT$(a$,RINSTR(a$,CHR$(32))-1)
ENDIF
lfenster$(tth&)=MID$(lfenster$(tth&),LEN(a$)+1)
LPRINT a$
lfenster$(tth&)=TRIM$(lfenster$(tth&))
langschreiben(lfenster$(tth&),7,zproz&)
ELSE
LPRINT lfenster$(tth&)
ENDIF
vors!=TRUE
ELSE IF vors!
langschreiben(lfenster$(tth&),7,zproz&)
ENDIF
ENDIF
stelle&=stelle&+anz&
INC stelle&
INC tth&
UNTIL tth&>100
CLR anz&,stelle&,tth&,vors!
ENDIF
LPRINT
ENDIF
ERASE lfenster$()
CLR lbesitzer$,druckplatte$,druckklassik$,druckjahr$,druckzart$,druckbesitzer$
CLR lverliehen$,lzustand$
RETURN
PROCEDURE langschreiben(b$,rand&,zproz&)
hier%=96
REM * LPRINT "langschreiben(b$,rand&,zproz&)"
LOCAL a$,anz&,a%,trenn!
IF b$>""
DO
DO
IF GEMDOS(17)=0
PAUSE 50
ENDIF
EXIT IF zwischendruck!
EXIT IF GEMDOS(17)=TRUE
druck_abbruch
LOOP
PAUSE 5
ON MENU
ON MENU KEY GOSUB druck_abbruch
ON ERROR GOSUB fehler
a$=LEFT$(b$,zproz&-rand&)
IF LEN(b$)>zproz&-rand&
anz&=RINSTR(a$,CHR$(32))-1
a%=anz&+1
IF anz&13
DEFFILL 1,0,0
PRBOX 182,140/yt&,450,279/yt&
PRINT AT(33,12);"Zum Abbrechen:"
PRINT AT(33,15);"Taste drcken "
ENDIF
ENDIF
RETURN
PROCEDURE druck_abbruch
hier%=98
REM * LPRINT "druck_abbruch"
CLR dummy|
ALERT 0," | Ausdruck abgebrochen? | | ",2,"stoppen|weiter",dummy|
IF dummy|=1
ERASE lfenster$()
ruecksprung(0)
ENDIF
RETURN
PROCEDURE zwischendruck(zwd|)
hier%=99
REM * LPRINT "zwischendruck(zwd|)"
IF schluss_k%=8
ALERT 1,"| Es ist noch keine Platte| eingetragen! ",1,weiter$,dummy|
CLR dummy|
ELSE
zwischendruck!=TRUE
IF zwd|=1
parole!=TRUE
ELSE
CLR parole!
ENDIF
CLR zwd|
IF BYTE{start%+wo%+12}=255
IF {start%}<>{start2%+schluss_k%}
SUB k%,4
ENDIF
wo%={start2%+k%}
ENDIF
IF k%<=0 ! kein else if !!
IF {start%}={start2%+schluss_k%}
ruecksprung(0)
ENDIF
ENDIF
k%=MAX(4,k%)
wo%={start2%+k%}
IF wrt&<>13
zumabbrechen
ENDIF
drucken
CLR zwischendruck!,parole!
ON MENU KEY GOSUB schreiben
ENDIF
RETURN
REM _________________________________________________________________Eingangsbild
PROCEDURE einrichten
hier%=100
REM * LPRINT "einrichten"
CLR bild$
bild_einrichten$=SPACE$(32500)
lo%=V:bild_einrichten$/256
lo%=lo%*256+256
ph%=XBIOS(2)
~XBIOS(5,L:lo%,L:ph%,-1)
CLS
RETURN
PROCEDURE wechsel
hier%=101
REM * LPRINT "wechsel"
SWAP lo%,ph%
~XBIOS(5,L:ph%,L:lo%,-1)
RETURN
PROCEDURE restaurieren
hier%=102
REM * LPRINT "restaurieren"
CLR bild_einrichten$
BMOVE MIN(lo%,ph%),MAX(lo%,ph%),32000
~XBIOS(5,L:MAX(lo%,ph%),L:MAX(lo%,ph%),-1)
bild$=SPACE$(32000)
BMOVE XBIOS(2),V:bild$,32000
RETURN
REM _________________________________________________________________________Ende
PROCEDURE fehler
' hier%=hier%
REM * LPRINT "fehler"
' CLS
ALERT 0,"| Programmfehler | in Funktion "+STR$(hier%)+" | ",1,weiter$,dummy|
REM OPEN "O",#1,"D:\lstvar2"
REM DUMP "" TO "D:\lstvar2"
REM CLOSE #1
IF ERR=8 AND FRE(0)>10000 AND fehler%=0
CLR bild$
~FRE(0)
PRINT FRE(0)
CLR filebox|
fehler%=1
ALERT 0,"| Speicherprobleme | | ",1,weiter$,dummy|
ALERT 0,"| 1. Datei prfen | 2. Abspeichern | 3. Neustart | ",1,weiter$,dummy|
ruecksprung(0)
ELSE IF ERR=37 ! Diskette voll
ALERT 0,"| Diskette voll | | ",1,"zurck",dummy|
CLR dummy|
CLOSE
CHDRIVE programmlaufwerk|
ELSE
~FORM_ALERT(1,ERR$(ERR))
ENDIF
CLR ziel%
CLOSE
ruecksprung(0)
RESUME laufkontrolle ! doppelte Sicherheit
RETURN
PROCEDURE endkasten
hier%=103
REM * LPRINT "endkasten"
MENU OFF
MENU KILL
a%=MENU(-1)
~MENU_BAR(a%,0)
SPOKE &H484,&X1111 ! Klick, Repeat, Glocke, Shift-Bit an
~GEMDOS(73,L:start%)
~GEMDOS(73,L:start2%)
CLIP 0,0,640,400/yt&
DEFLINE 1,1*yt&,0,0
FOR schritt&=0 TO 320
BOX schritt&,schritt&/yt&,639-schritt&,(399-schritt&/320*200)/yt&
NEXT schritt&
RESERVE
STOP
RETURN
REM ________________________________________________________________________Start
PROCEDURE start
hier%=104
REM * LPRINT "start"
~XBIOS(64,1) ! Blitter anschalten, wenn da
INLINE rsv%,10
REM {rsv%}=30100
RESERVE 36400+MIN(MAX(15000,{rsv%}),65000)
OPTION BASE 0
BOUNDARY 1
yt&=MIN(2,3-XBIOS(4))
xt&=2-SGN(XBIOS(4))
REM
REM xt&=INTOUT(0)+1 !=640--------------- ! Intout-Block -----------
REM xt&=MAX(1,640/xt&)
REM yt&=INTOUT(1)+1 !=400
REM yt&=MAX(1,400/yt&)
REM CLIP 0,0,640,ABS(400/yt&) ! ------------------------------------------
REM
IF xt&=2
ALERT 1," Bitte mittlere | Aufl”sung einstellen!",1,weiter$,dummy|
endkasten
ENDIF
REM IF yt&=2
REM IF einfarbig&
REM SETCOLOR 0,&H777
REM SETCOLOR 1,&H0
REM SETCOLOR 2,&H0
REM SETCOLOR 3,&H0
REM ELSE
REM SETCOLOR 0,5,5,5 !fr weiž
REM SETCOLOR 3,0,0,1 !fr schwarz
REM SETCOLOR 1,7,0,0 !fr rot
REM SETCOLOR 2,5,6,4 !fr grn
REM ENDIF
REM ENDIF
~SHEL_READ(programmname$,a$)
programmlaufwerk|=GEMDOS(25)+1
programmordner$=DIR$(programmlaufwerk|)
IF MID$(programmname$,2,2)=":\"
aufruf$=programmname$
ELSE
aufruf$=CHR$(programmlaufwerk|+64)+":"+programmordner$+"\"+programmname$
ENDIF
a$=CHR$(programmlaufwerk|+64)+":\*.PLA"
fileselect$=CHR$(programmlaufwerk|+64)+":\*.PLA"
~XBIOS(35,6,3) ! Tastatur (Delay 6,repeat 3) (unstimmig)
DEFFILL 1,2,8
PBOX 0,0,640,400/yt&
KEYLOOK a%
ON ERROR GOSUB fehler
IF a%=1245298 ! (Buchstabe "r")
ALERT 0,"|Gr”že des Arbeitspeichers | ("+STR$(CARD{rsv%+2})+") | ",2,"„ndern?|lassen!",dummy|
IF dummy|=1
DEFFILL 1,0,0
PBOX 200,120/yt&,420,250/yt&
BOX 203,123/yt&,417,247/yt&
PRINT AT(29,9);"Neuer Arbeitspeicher:"
PRINT AT(27,10);"(zwischen 15000 und 65000)"
PRINT AT(29,12);"jetzige Gr”že: ";CARD{rsv%+2}
PRINT AT(29,14);"BYTES:";';
a$=STR$(CARD{rsv%+2})
FORM INPUT 5,a$
rsv_eingabe%=VAL(a$)
rsv_eingabe%=MIN(MAX(15000,rsv_eingabe%),65000)
PRINT AT(36,14);rsv_eingabe%;
rsv_adr%=rsv%-BASEPAGE-228
OPEN "U",#1,aufruf$
SEEK #1,rsv_adr%+2
OUT #1,(ASC(LEFT$(MKI$(rsv_eingabe%))))
CLOSE #1
RESERVE
RESERVE 36400+MIN(MAX(15000,rsv_eingabe%),65000)
DEFFILL 1,2,8
PBOX 0,0,640,400/yt&
ENDIF
CLR rsv_eingabe%,rsv_adr%
ENDIF
REM alles%=MALLOC(-1)-puffer% ! Die puffer% sind zur Sicherheit
alles%=MALLOC(-1)
kapazitaet%=alles%-alles%/100*4
start2%=MALLOC(INT(alles%/100*4))
PRINT AT(24,8);"Speicherplatz fr ca.";INT((kapazitaet%/125)/100)*100;" Platten"
IF INT((kapazitaet%/125)/100)*100<3
back_start2%=GEMDOS(73,L:start2%) ! Notbremse mit MFREE
RESERVE
PAUSE 100
STOP
ENDIF
CLR kapazitaet%,xt&,alles%
DIM safenster$(101),dz$(4),dz%(4),samitspieler$(6)
DIM dsatz$(20),fsatz$(20),klein$(25),leiste$(60),adj$(49),debes$(4),zaart$(16)
ident$=CHR$(82)+CHR$(69)+CHR$(67)+CHR$(79)+CHR$(82)
ident$=ident$+CHR$(68)+CHR$(73)+CHR$(65)
zaart$(0)=" " !
zaart$(1)="LP " ! 35 50 80
zaart$(2)="CD " ! 323 338 368
zaart$(3)="Doppel-LP" ! 85 116 146
zaart$(4)="Doppel-CD" ! 373 404 434
zaart$(5)="Maxi " ! 202 232 262
zaart$(6)="Single " ! 36 83 113
zaart$(7)="CD-Single" ! 363 434 464
zaart$(8)="Cassette " ! 119 151 181
zaart$(9)="EP " ! 151 166 196
zaart$(10)="Box " ! 266 289 319
zaart$(11)="CD-EP " ! 439 478 508
zaart$(12)="CD-Maxi " ! 512 565 595
zaart$(13)="CD-Box " ! 468 515 545
zaart$(14)="Video " ! 186 226 256
zaart$(15)="? " ! 550 558 588
filebox|=1 ! Erm”glicht Fileselect-Box
dead$=" | Bitte fertigen Sie eine neue | Kopie des Programms von der | Originaldiskette! "
btn2$=" ENDE "
weiter$="weiter"
demo$=" Die Demo-Version ist auf | 200 Eintr„ge begrenzt.| | Eintrag wird gel”scht. "
REM
INLINE loeschen%,90
INLINE k_ascii%,48
INLINE k22_finden%,56
INLINE setz33%,48
INLINE dateiende%,50
INLINE katalog%,60
INLINE statistik%,48
INLINE kasten%,1
INLINE eckmaus%,74
INLINE slide%,74
ON ERROR GOSUB fehler
ON MENU KEY GOSUB schreiben
ON MENU GOSUB menue
DEFMOUSE 0
IF yt&<2
eckmaus$=SPACE$(74)
BMOVE eckmaus%,VARPTR(eckmaus$),74
ENDIF
SPOKE &H484,&X1111 ! Klick, Repeat, Glocke, Shift-Bit an
slide$=SPACE$(74)
BMOVE slide%,VARPTR(slide$),74
REM koptest
maske_laden
RETURN
PROCEDURE maske_laden
hier%=105
REM * LPRINT "maske_laden"
CHDRIVE programmlaufwerk|
a&=FSFIRST(programmordner$+"\maske??.pla",0)
IF a&=0
a$=CHAR{FGETDTA()+30}
DO
a&=FSNEXT()
EXIT IF a&<>0
IF VAL(MID$(CHAR{FGETDTA()+30},6))>VAL(MID$(a$,6))
a$=CHAR{FGETDTA()+30}
ENDIF
LOOP
CLR a&
maskenpfad$=programmordner$+"\"+a$
ELSE
CLR dummy|
ALERT 1," | Datei 'MASKE(Zahl).PLA' fehlt | ",2,"Abbruch| Suchen |Programm",dummy|
IF dummy|=2
CLR bild$
REPEAT
IF filebox|
FILESELECT fileselect$,"",maskenpfad$
ELSE
maskenpfad$=@pfadfrage$
ENDIF
IF maskenpfad$=""
dummy|=3
ENDIF
EXIT IF maskenpfad$=""
IF UPPER$(RIGHT$(maskenpfad$,4))=".PLA"
EXIT IF INSTR(RIGHT$(maskenpfad$,MIN(LEN(maskenpfad$),12)),"MASKE")
ENDIF
UNTIL UPPER$(RIGHT$(maskenpfad$,9))="MASKE.PLA"
ENDIF
IF maskenpfad$=""
dummy|=3
ENDIF
IF dummy|=1
endkasten
ELSE IF dummy|=3
datload(0)
plattenbild1(TRUE)
ruecksprung(0)
ENDIF
ENDIF
maskeninput(maskenpfad$)
datload(0)
plattenbild1(TRUE)
RETURN
REM _____________________________________________________________________________
FUNCTION krit_frage
hier%=106
REM * LPRINT "FUNCTION krit_frage"
GET 210,145/yt&,430,285/yt&,makro_ersatz$
DEFFILL 1,0,0
PBOX 210,145/yt&,430,285/yt&
BOX 212,147/yt&,428,283/yt&
PRINT AT(30,11);" Standard ";'';" Nummer"
PRINT AT(30,13);" Jahr ";'';" Wert "
PRINT AT(30,15);" Datum ";'';" "
SELECT kriterium&
CASE 0 ! Standard
PRINT AT(28,11);"X"
CASE 2 ! Jahr
PRINT AT(28,13);"X"
CASE 3 ! Nummer
PRINT AT(53,11);"X"
CASE 4 ! Wert
PRINT AT(53,13);"X"
CASE 5 ! Datum
PRINT AT(28,15);"X"
ENDSELECT
a$=" zurck"
IF alt_katalog$>""
IF kriterium&>0
a$=" Rckstellen"
ENDIF
ENDIF
PRINT AT(30,17);a$
BOX 230,160/yt&,312,175/yt& ! LO Standard=0
BOX 230,192/yt&,312,207/yt& ! LM Jahr=2
BOX 230,224/yt&,312,239/yt& ! LU Datum=5
BOX 327,160/yt&,409,175/yt& ! RO Zahl=3
BOX 327,192/yt&,409,207/yt& ! RM Wert=4
BOX 327,224/yt&,409,239/yt& ! RU
BOX 230,256/yt&,409,271/yt& ! Rueckstellen
DEFMOUSE eckmaus$
DO
ON MENU
IF MOUSEK=1
xx&=MOUSEX
yy&=MOUSEY*yt&
SELECT yy&
CASE TO 159,272 TO
SELECT xx&
CASE TO 229,411 TO
RETURN 100+kriterium&
ENDSELECT
CASE 160 TO 175
SELECT xx&
CASE 230 TO 312 ! Standard
RETURN 0
CASE 327 TO 409 ! Zahl
RETURN 3
ENDSELECT
CASE 192 TO 207
SELECT xx&
CASE 230 TO 312 ! Jahr
RETURN 2
CASE 327 TO 409 ! Wert
RETURN 4
ENDSELECT
CASE 224 TO 239 ! fr die dritte Reihe
SELECT xx&
CASE 230 TO 312 !
RETURN 5
CASE 327 TO 409 !
ENDSELECT
CASE 256 TO 271 ! fr die vierte Reihe
SELECT xx&
CASE 230 TO 409 ! "Rckstellen"/"zurck"
IF alt_katalog$>""
IF kriterium&>0 AND kriterium&<100
zahl%=C:statistik%(L:start%)-2
PRINT AT(64,4);zahl%
BMOVE VARPTR(alt_katalog$),start2%,schluss_k%+40
CLR alt_katalog$
FOR schritt&=0 TO schluss_k%-4 STEP 4
PRINT AT(70,4);schritt&/4-1
{start%+{start2%+schritt&}}={start2%+schritt&+4}
NEXT schritt&
katalog
RETURN 100
ENDIF
ENDIF
RETURN kriterium&+100
ENDSELECT
ENDSELECT
ENDIF
LOOP
ENDFUNC
PROCEDURE sortieren
hier%=107
REM * LPRINT "sortieren"
IF kriterium&=0
alt_katalog$=SPACE$(schluss_k%+40)
BMOVE start2%,VARPTR(alt_katalog$),schluss_k%+40
freitest
ENDIF
kriterium&=@krit_frage
IF kriterium&>99
SUB kriterium&,100
GOTO no_sort
ENDIF
zahl%=C:statistik%(L:start%)-2
PRINT AT(64,4);zahl%
IF kriterium&=5 ! Datum
DIM a%(C:statistik%(L:start%)) ! mit Anfangs- und Schlužsatz
FOR k%=0 TO schluss_k% STEP 4
a%(k%/4)={start2%+k%}
NEXT k%
QSORT a%()
FOR k%=4 TO schluss_k% STEP 4
{start2%+k%}=a%(k%/4)
{start%+{start2%+k%-4}}=a%(k%/4)
PRINT AT(70,4);ABS(k%/4-2)
NEXT k%
ERASE a%()
katalog
k%=schluss_k%-8
PAUSE 20
lesen
ENDIF
katalog
CARD{start%+{start2%+schluss_k%}+10}=10000 !(wegen Jahrvergleich)
CARD{start%+10}=0 ! "
FOR a%=4 TO schluss_k%-4 STEP 4 ! 22222 berall setzen
CARD{start%+{start2%+a%}+4}=22222
NEXT a%
CLR zahl%,alt_k%,alt_zahl1%,alt_wert1&,alt_jahr1%
erster_satz|=1 ! damit nicht gleich durchmarsch gesetzt wird
REPEAT
ON MENU
k_geht%=C:k22_finden%(L:start%,L:start2%)
wo_wandert%={start2%+k_geht%}
INC zahl% ! nicht zahl1%
PRINT AT(70,4);zahl%-1 ! nicht zahl1%
EXIT IF BYTE{start%+wo_wandert%+12}=255
CARD{start%+wo_wandert%+4}=33333
jahr1%=CARD{start%+wo_wandert%+10}
SELECT BYTE{start%+wo_wandert%+6}
CASE 20
zahl1%={start%+wo_wandert%+14}
wert1&=BYTE{start%+wo_wandert%+18}
DEFAULT
zahl1%=0
wert1&=0
ENDSELECT
k%=@kriterium(kriterium&)
IF k_geht%<>k% ! Nicht auf sich selbst
SELECT kriterium&
CASE 0 !(Prinzip Exit if >= und k% als Rckgabe)
wo%={start2%+k%}
{start%+{start2%+k_geht%-4}}={start%+wo_wandert%}
{start%+wo_wandert%}=wo%
{start%+{start2%+k%-4}}=wo_wandert%
katalog
CASE 2,3,4,5 !(Prinzip Exit if > und k%-4 als Rckgabe)
wo%={start2%+k%}
{start%+{start2%+k_geht%-4}}={start%+wo_wandert%}
{start%+wo_wandert%}={start%+wo%}
{start%+wo%}=wo_wandert%
katalog
ENDSELECT
ENDIF
UNTIL k_geht%>=schluss_k%
CARD{start%+{start2%+schluss_k%}+10}=0
CLR k_geht%,jahr1%,wo_wandert%,zahl%
CLR erster_satz|,alt_imp_test$,imp_test$,durchmarsch|
~C:setz33%(L:start%)
~FRE(0)
PAUSE 20
no_sort:
PUT 210,145/yt&,makro_ersatz$
CLR makro_ersatz$
SELECT wrt&
CASE 1,10,14,16
k%=4
lesen
DEFAULT
ruecksprung(0)
ENDSELECT
RETURN
FUNCTION kriterium(kriterium&)
hier%=108
REM * LPRINT "FUNCTION kriterium(kriterium&)"
REM +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
SELECT kriterium&
CASE 0 ! Sortieren nach Standard-Abgabe
IF sortieren|
wo%={start2%+k_geht%}
grosser_dateisatz
alt_imp_test$=imp_test$
imp_test$=@umlaute$(0,dsatz$(0))
CLR durchmarsch|
SELECT erster_satz|
CASE 0
IF @kleiner_gleich(alt_imp_test$,imp_test$)
durchmarsch|=1
ENDIF
CASE 1
CLR erster_satz|
ENDSELECT
ENDIF
CLR warnung|
CLR wo%,testin1$,testin2$,testpla1$,testpla2$,stoppen&
CLR abgabe_a$
testin1$=MAX("-",@umlaute$(0,dsatz$(0)))
CLR k%
SELECT VAL?(testin1$)
CASE 0 ! Ein-Buchstaben-Vergleich
k%=C:k_ascii%(L:start%,L:start2%,L:ASC(LEFT$(testin1$)))
ENDSELECT
SELECT durchmarsch|
CASE 0
DEFAULT
a%=MAX(4,imp_keep_k%)
k%=MAX(a%,k%)
ENDSELECT
wo%={start2%+k%}
stoppen&=MAX(2,VAL?(testin1$))
abgabe_a$=LEFT$(testin1$,MIN(LEN(testin1$),stoppen&))
DO ! Vergleich Interpret
DO
distanz&=BYTE{start%+wo%+6}+1
testin2$=CHAR{start%+wo%+distanz&} !Menge an Buchstaben
testin2$=@umlaute$(stoppen&,testin2$)
stoppen&=MAX(stoppen&,VAL?(testin2$)) !wegen Zahlen komplett
IF VAL?(RIGHT$(abgabe_a$))
INC stoppen&
abgabe_a$=LEFT$(testin1$,MIN(LEN(testin1$),stoppen&))
ENDIF
EXIT IF @kleiner_gleich(abgabe_a$,testin2$)
ADD k%,4
wo%={start2%+k%}
LOOP
imp_keep_k%=k%
EXIT IF BYTE{start%+wo%+12}=255
testin2$=CHAR{start%+wo%+distanz&}
testin2$=@umlaute$(0,testin2$)
testin2$=MAX(testin2$,CHR$(45))
EXIT IF testin1$=testin2$
EXIT IF @kleiner_gleich(testin1$,testin2$)
MUL stoppen&,2
ADD k%,4
wo%={start2%+k%}
abgabe_a$=LEFT$(testin1$,MIN(LEN(testin1$),stoppen&))
IF VAL?(RIGHT$(abgabe_a$))
INC stoppen&
abgabe_a$=LEFT$(testin1$,MIN(LEN(testin1$),stoppen&))
ENDIF
LOOP
CLR stoppen&,abgabe_a$
IF djahr&>0
DO ! Vergleich nach Jahren
EXIT IF BYTE{start%+wo%+12}=255
EXIT IF djahr&=0
EXIT IF djahr&<=CARD{start%+wo%+10} ! djahr&
EXIT IF @inter_ungleich
ADD k%,4
wo%={start2%+k%}
LOOP
ENDIF
IF dsatz$(1)>""
testpla1$=@umlaute$(0,dsatz$(1))
DO ! Vergleich nach Plattentiteln
EXIT IF BYTE{start%+wo%+12}=255
EXIT IF djahr&<>CARD{start%+wo%+10} ! djahr&
EXIT IF @inter_ungleich
EXIT IF BYTE{start%+wo%+distanz&+sprung%+1}<>1
testpla2$=CHAR{start%+wo%+distanz&+sprung%+2}
testpla2$=@umlaute$(0,testpla2$)
EXIT IF testpla2$=""
EXIT IF @kleiner_gleich(testpla1$,testpla2$)
ADD k%,4
wo%={start2%+k%}
LOOP
ENDIF
IF dart&>0
DO ! Vergleich nach Art
EXIT IF BYTE{start%+wo%+12}=255
EXIT IF djahr&<>CARD{start%+wo%+10} ! djahr&
EXIT IF dart&<=(BYTE{start%+wo%+7} AND &X1111)
EXIT IF @inter_ungleich
EXIT IF BYTE{start%+wo%+distanz&+sprung%+1}<>1
testpla2$=CHAR{start%+wo%+distanz&+sprung%+2}
testpla2$=@umlaute$(0,testpla2$)
EXIT IF testpla1$<>testpla2$
ADD k%,4
wo%={start2%+k%}
LOOP
ENDIF
SELECT wrt&
CASE 4,9 ! Verdoppeln, Žndernabgabe
DEFAULT ! Test auf Gleichheit
IF sortieren|=0
IF testin1$=testin2$
IF dart&=(BYTE{start%+wo%+7} AND &X1111)
IF dbesitzer&=(BYTE{start%+wo%+13} AND &X11000000)/64
IF testpla1$=testpla2$
IF wrt&=12
warnung|=1
ELSE
CLR dummy|
ALERT 1," | Identische Platte vorhanden",1," weg |nehmen",dummy|
IF dummy|=1
ruecksprung(0)
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDSELECT
CASE 2 ! Sortieren nach Jahren
schritt&=4
IF jahr1%>alt_jahr1%
schritt&=alt_k%
ENDIF
FOR k%=schritt& TO schluss_k% STEP 4
wo%={start2%+k%}
a%=CARD{start%+wo%+10}
EXIT IF jahr1%alt_zahl1%
schritt&=alt_k%
ENDIF
FOR k%=schritt& TO schluss_k% STEP 4
wo%={start2%+k%}
SELECT BYTE{start%+wo%+6}
CASE 20
a%={start%+wo%+14}
DEFAULT
a%=0
ENDSELECT
EXIT IF zahl1%=alt_wert1&
schritt&=alt_k%
ENDIF
FOR k%=schritt& TO schluss_k% STEP 4
wo%={start2%+k%}
SELECT BYTE{start%+wo%+6}
CASE 20
a%=BYTE{start%+wo%+18}
DEFAULT
a%=0
ENDSELECT
EXIT IF wert1&""
a$=LEFT$(datei$,3)+"*.TXT"
ENDIF
b$=RIGHT$(datei$,LEN(datei$)-RINSTR(datei$,"\"))
MID$(b$,LEN(b$)-3,4)=".TXT"
CLR bild$
FILESELECT a$,b$,aex_datei$
' PRINT "8"
IF aex_datei$=""
ruecksprung(0)
ENDIF
UNTIL LEN(aex_datei$)>3+3+2
OPEN "o",#23,aex_datei$
ERASE aex$()
k%=4
DO
'
freitest
'
wo%={start2%+k%}
CLR zeilen%,ax$
EXIT IF BYTE{start%+wo%+12}=255
grosser_dateisatz
IF dsatz$(5)>""
IF BTST(aex_kennung%,4)
ax$=ax$+"Land: "+dsatz$(5)+", "
ENDIF
ENDIF
IF djahr&
IF BTST(aex_kennung%,5)
ax$=ax$+STR$(djahr&)+", "
ENDIF
ENDIF
IF dart&
IF BTST(aex_kennung%,6)
ax$=ax$+TRIM$(zaart$(dart&))+", "
ENDIF
ENDIF
IF dverliehen&
IF BTST(aex_kennung%,7)
ax$=ax$+"Verliehen "+", "
ENDIF
ENDIF
IF dbesitzer&
IF BTST(aex_kennung%,8)
ax$=ax$+"("+debes$(dbesitzer&)+")"+", "
ENDIF
ENDIF
IF dmerker& ! Merker
IF BTST(aex_kennung%,9)
ax$=ax$+"Merker gesetzt"+", "
ENDIF
ENDIF
IF BTST(aex_kennung%,10)
IF dz1&
ax$=ax$+"fr.Zusatz 1"+", "
ENDIF
IF dz2&
ax$=ax$+"fr.Zusatz 2"+", "
ENDIF
IF dz3&
ax$=ax$+"fr.Zusatz 3"+", "
ENDIF
ENDIF
IF dzustand&
IF BTST(aex_kennung%,12)
ax$=ax$+"Zustand schlecht"+", "
ENDIF
ENDIF
IF dwert&
IF BTST(aex_kennung%,14)
ax$=ax$+"Wert "+STR$(dwert&)+", "
ENDIF
ENDIF
IF dnummer%
IF BTST(aex_kennung%,13)
ax$=ax$+"Nummer "+STR$(dnummer%)+", "
ENDIF
ENDIF
IF ax$>""
ax$=LEFT$(ax$,LEN(ax$)-2)
INC zeilen%
ENDIF
FOR schritt&=0 TO 11
IF dsatz$(schritt&)>""
SELECT schritt&
CASE 0,1,2,3
IF BTST(aex_kennung%,schritt&)
INC zeilen%
ENDIF
CASE 4 ! Profil
IF BTST(aex_kennung%,11)
INC zeilen%
ENDIF
CASE 5 ! Land
CASE 6 ! Verliehen
IF BTST(aex_kennung%,7)
INC zeilen%
ENDIF
CASE 7,8,9,10,11 ! Mitspieler/Solisten
IF BTST(aex_kennung%,15)
INC zeilen%
ENDIF
ENDSELECT
ENDIF
NEXT schritt&
IF dsatz$(12)>""
IF BTST(aex_kennung%,16)
CLR anz&,stelle&,tth&
WHILE INSTR(dsatz$(12),CHR$(244),stelle&)>0
anz&=INSTR(stelle&,dsatz$(12),CHR$(244))-stelle&
safenster$(tth&)=MID$(dsatz$(12),stelle&,anz&)
stelle&=stelle&+anz&
INC stelle&
INC tth&
WEND
zeilen%=zeilen%+tth&-1
CLR anz&,stelle&,tth&
ENDIF
ENDIF
REM ....................................................................
REM ....................................................................
IF zeilen%>0
IF BTST(aex_regel%,6)=0
DEC zeilen%
ENDIF
DIM aex$(zeilen%)
CLR zeilen%
FOR schritt&=0 TO 12
IF dsatz$(schritt&)>"" OR schritt&=4
SELECT schritt&
CASE 0,1,2,3
IF BTST(aex_kennung%,schritt&)
aex$(zeilen%)=LEFT$(dsatz$(schritt&),kurze_zeile%)
INC zeilen%
ENDIF
CASE 7,8,9,10,11
IF BTST(aex_kennung%,15)
aex$(zeilen%)=LEFT$(dsatz$(schritt&),kurze_zeile%)
INC zeilen%
ENDIF
CASE 5 ! Land (in ax$)
CASE 4
IF ax$>""
aex$(zeilen%)=LEFT$(ax$,kurze_zeile%)
CLR ax$
INC zeilen%
ENDIF
IF dsatz$(4)>""
IF BTST(aex_kennung%,11)
aex$(zeilen%)=LEFT$("Profil: "+@profilrueckuebersetzung$(dsatz$(4)),kurze_zeile%)
INC zeilen%
ENDIF
ENDIF
CASE 6
IF BTST(aex_kennung%,7)
aex$(schritt&)=LEFT$("Verliehen an: "+dsatz$(6),kurze_zeile%)
INC zeilen%
ENDIF
CASE 12
IF BTST(aex_kennung%,16)
tth&=1
WHILE safenster$(tth&)>""
aex$(zeilen%)=LEFT$(" "+safenster$(tth&),kurze_zeile%)
safenster$(tth&)=""
INC zeilen%
INC tth&
EXIT IF tth&>=101 ! zur Sicherheit
WEND
ENDIF
ENDSELECT
ENDIF
NEXT schritt&
IF BTST(aex_regel%,6)=0
DEC zeilen%
ENDIF
ON MENU
b%=b%+DIM?(aex$())
PRINT AT(65,24);b%;
IF BTST(aex_regel%,8) ! Datei aufteilen
FOR schr&=0 TO DIM?(aex$())-1
laengenzaehler%=laengenzaehler%+LEN(aex$(schr&))+2
IF laengenzaehler%>aex_stopper%
CLOSE #23
INC aex_datei_kenner%
b$=RIGHT$(STR$(aex_datei_kenner%),2)
b&=LEN(b$)
MID$(aex_datei$,LEN(aex_datei$)-3-b&,b&)=b$
CLR laengenzaehler%,b$,b&
a$=" ™ffne "+STR$(aex_datei_kenner%+1)+". Datei"
ALERT 0,a$,1," ™ffne |Abbruch",dummy|
IF dummy|=2
ruecksprung(0)
ENDIF
OPEN "o",#23,aex_datei$
ENDIF
NEXT schr&
ENDIF
STORE #23,aex$()
ENDIF
ERASE aex$()
ADD k%,4
LOOP
CLOSE
ruecksprung(0)
RETURN
PROCEDURE welche_ascii
hier%=111
REM * LPRINT "welche_ascii"
CLS
menueleiste
DEFMOUSE eckmaus$
CLR kurze_zeile%
aex_kennung%=3 ! Interpret + Titel an
aex_regel%=BSET(aex_regel%,6) ! Voreingestellt: Leerzeile zwischen den S„tzen
PRINT AT(4,3);"Welche Eintr„ge sollen in die";
PRINT AT(4,4);"ASCII-Datei bernommen werden?";
PRINT AT(50,6);"alle Eintr„ge bernehmen"
PRINT AT(50,10);"Zeilenl„nge"'''"ganz"
BOX 495,141/yt&,545,161/yt&
PRINT AT(50,12);"Leerzeile zwischen den S„tzen"
PRINT AT(50,14);"Datei aufteilen"
PRINT AT(75,14);"Bytes"
PRINT AT(67,14);'"ganz"'';
BOX 495+25,205/yt&,545+45,225/yt&
RESTORE welche_ascii
DO
READ a$
EXIT IF a$="X"
PRINT AT(12,6+a&);a$;
INC a&
LOOP
welche_ascii:
DATA Interpret(Komponist)
DATA Titel
DATA Orchester
DATA Leitung
DATA Land
DATA Jahr
DATA Art
DATA Verliehen(an)
DATA Besitzer
DATA Merker
DATA freie Zusatzk„stchen
DATA Profil
DATA Zustand schlecht
DATA Nummer
DATA Wert
DATA Mitspieler
DATA Stcke auf der Platte
DATA X
CLR a$,a&
FOR schritt&=0 TO 1
PUT 20,(80+schritt&*16)/yt&,profil_dunkel$
NEXT schritt&
FOR schritt&=2 TO 16
PUT 20,(80+schritt&*16)/yt&,profil_hell$
NEXT schritt&
PUT 320,80/yt&,profil_hell$ ! alles bernehmen
PUT 320,(80+2*16)/yt&,profil_hell$ !
PUT 320,(80+4*16)/yt&,profil_hell$ ! Zeilenl„nge krzen
PUT 320,(80+6*16)/yt&,profil_dunkel$ ! Leerzeile zwischen den S„tzen
PUT 320,(80+8*16)/yt&,profil_hell$ ! Dateil„nge portionieren
BOX 10,27/yt&,272,(376-20)/yt& ! Umrandung
BOX 8,25/yt&,274,(378-20)/yt& ! Umrandung
BOX 440,325/yt&,540,365/yt& ! Startfeld
BOX 438,323/yt&,542,367/yt& ! Startfeld
PRINT AT(60,22);"Start"
DO
REPEAT
UNTIL MOUSEK=0
REPEAT
ON MENU
ON ERROR GOSUB fehler
ON MENU GOSUB menue
UNTIL MOUSEK>0
SELECT MOUSEK
CASE 1
SELECT MOUSEX
CASE 20 TO 76
a&=(MOUSEY*yt&-80)/16
SELECT a&
CASE 0 TO 16 ! Was einzel bernehmen?
aex_kennung%=BCHG(aex_kennung%,a&)
SELECT BTST(aex_kennung%,a&)
CASE -1
PUT 20,(80+a&*16)/yt&,profil_dunkel$
CASE 0
PUT 20,(80+a&*16)/yt&,profil_hell$
IF BTST(aex_regel%,0)
aex_regel%=BCLR(aex_regel%,0)
PUT 320,(80)/yt&,profil_hell$
ENDIF
ENDSELECT
ENDSELECT
CASE 320 TO 376
a&=(MOUSEY*yt&-80)/16
SELECT a&
CASE 0 ! alles bernehmen
aex_regel%=BCHG(aex_regel%,a&)
SELECT BTST(aex_regel%,a&)
CASE -1
PUT 320,(80+(a&)*16)/yt&,profil_dunkel$
CASE 0
PUT 320,(80+(a&)*16)/yt&,profil_hell$
ENDSELECT
IF BTST(aex_regel%,0)
aex_kennung%=TRUE
a$=profil_dunkel$
ELSE IF BTST(aex_regel%,0)=0
aex_kennung%=0
a$=profil_hell$
ENDIF
FOR schritt&=0 TO 16
PUT 20,(80+schritt&*16)/yt&,a$
NEXT schritt&
CLR a$
REM CASE 2
REM DUMP "" TO "e:\dump.dmp"
CASE 4 ! Zeilenl„nge beibehalten/krzen
SELECT a&
CASE 4
aex_regel%=BCHG(aex_regel%,4)
ENDSELECT
SELECT BTST(aex_regel%,4)
CASE 0
PUT 320,(80+(4)*16)/yt&,profil_hell$
PRINT AT(64,10);"ganz";
CASE -1
PUT 320,(80+(4)*16)/yt&,profil_dunkel$
PRINT AT(64,10);'''';
PRINT AT(64,10);
FORM INPUT 4,a$
kurze_zeile%=MAX(VAL(a$),1)
PRINT AT(64,10);'''';
PRINT AT(64,10);USING "###",kurze_zeile%;
BOX 495,141/yt&,545,161/yt&
CLR a$
ENDSELECT
CASE 6 ! Leerzeile zwischen den S„tzen
aex_regel%=BCHG(aex_regel%,a&)
SELECT BTST(aex_regel%,a&)
CASE -1
PUT 320,(80+(a&)*16)/yt&,profil_dunkel$
CASE 0
PUT 320,(80+(a&)*16)/yt&,profil_hell$
ENDSELECT
CASE 8 ! Datei aufteilen
aex_regel%=BCHG(aex_regel%,a&)
SELECT BTST(aex_regel%,a&)
CASE -1
PUT 320,(80+(a&)*16)/yt&,profil_dunkel$
CASE 0
PUT 320,(80+(a&)*16)/yt&,profil_hell$
IF BTST(aex_regel%,8)=0
PRINT AT(67,14);'"ganz"'';
CLR aex_stopper%
ENDIF
ENDSELECT
IF BTST(aex_regel%,a&)
PUT 320,(80+(a&)*16)/yt&,profil_dunkel$
IF BTST(aex_regel%,8)
PRINT AT(67,14);''''''';
PRINT AT(67,14);
FORM INPUT 7,a$
aex_stopper%=MAX(VAL(a$),1000)
PRINT AT(67,14);USING "#######",aex_stopper%;
PRINT ';"Bytes";
BOX 495+25,205/yt&,545+45,225/yt&
CLR a$
ENDIF
ENDIF
ENDSELECT
ENDSELECT
CASE 2 ! Startfeld mit rechter Maustaste
SELECT MOUSEX
CASE 438 TO 542
SELECT MOUSEY*yt&
CASE 323 TO 367
EXIT IF TRUE
ENDSELECT
ENDSELECT
ENDSELECT
LOOP
RETURN
PROCEDURE in_den_keller
' PRINT
' PRINT "in_den_keller"
' PRINT
' PAUSE 100
'
' CLR keller_orchester$,keller_leitung$,keller_platte$,keller_jahr&,keller_art&
' CLR keller_uebergabe$,keller_besitzer&
' CLR keller_land$,keller_zustand&,sverliehen&,sverliehen$,keller_interpret$
' CLR keller_fenster$
' CLR keller_mitspieler1$
' CLR keller_mitspieler2$
' CLR keller_mitspieler3$
' CLR keller_mitspieler4$
' CLR keller_mitspieler5$
' CLR keller_merker&,keller_z1&,keller_z2&,keller_z3&
' CLR keller_nummer%,keller_wert1&,keller_wert2&
'
keller_modus&=modus&
keller_interpret$=sainterpret$
keller_platte$=saplatte$
keller_orchester$=saorchester$
keller_leitung$=saleitung$
keller_jahr&=sajahr&
keller_art&=saart&
keller_verliehen&=sverliehen&
keller_uebergabe$=sauebergabe$
keller_besitzer&=sabesitzer&
keller_merker&=samerker&
keller_z1&=saz1&
keller_z2&=saz2&
keller_z3&=saz3&
keller_land$=saland$
keller_zustand&=sazustand&
keller_verliehen$=sverliehen$
keller_wert1&=sawert1&
keller_wert2&=sawert2&
keller_nummer%=sanummer%
keller_mitspieler1$=samitspieler$(1)
keller_mitspieler2$=samitspieler$(2)
keller_mitspieler3$=samitspieler$(3)
keller_mitspieler4$=samitspieler$(4)
keller_mitspieler5$=samitspieler$(5)
'
keller_fenster$=""
FOR tth&=1 TO 100
IF safenster$(tth&)>""
keller_fenster$=keller_fenster$+CHR$(244)+safenster$(tth&)
' safenster$(tth&)=""
ENDIF
NEXT tth&
IF keller_fenster$>""
keller_fenster$=keller_fenster$+CHR$(244)
ENDIF
RETURN
PROCEDURE aus_dem_keller
' PRINT
' PRINT "aus_dem_keller"
' PRINT
' PAUSE 100
SELECT wrt&
CASE 0,5,6,7,11,13,14 ! Filterf„lle und schlicht
IF NOT nichtschreibend!
sa_loeschen
' PRINT
' PRINT "wird ge„ndert"
' PRINT
' PAUSE 100
modus&=keller_modus&
sainterpret$=keller_interpret$
saplatte$=keller_platte$
saorchester$=keller_orchester$
saleitung$=keller_leitung$
sajahr&=keller_jahr&
saart&=keller_art&
sverliehen&=keller_verliehen&
sauebergabe$=keller_uebergabe$
sabesitzer&=keller_besitzer&
samerker&=keller_merker& ! Merker
saz1&=keller_z1&
saz2&=keller_z2&
saz3&=keller_z3&
saland$=keller_land$
sazustand&=keller_zustand&
sverliehen$=keller_verliehen$
sawert1&=keller_wert1&
sawert2&=keller_wert2&
sanummer%=keller_nummer%
samitspieler$(1)=keller_mitspieler1$
samitspieler$(2)=keller_mitspieler2$
samitspieler$(3)=keller_mitspieler3$
samitspieler$(4)=keller_mitspieler4$
samitspieler$(5)=keller_mitspieler5$
IF keller_fenster$>""
CLR anz&,stelle&,tth&
WHILE INSTR(keller_fenster$,CHR$(244),stelle&)>0
anz&=INSTR(stelle&,keller_fenster$,CHR$(244))-stelle&
safenster$(tth&)=MID$(keller_fenster$,stelle&,anz&)
stelle&=stelle&+anz&
INC stelle&
INC tth&
WEND
CLR anz&,stelle&,tth&
ELSE
ERASE safenster$()
DIM safenster$(101)
ENDIF
aus_dem_keller&=TRUE
plattenbild
' IF modus&<>lieblingsmodus&
' kopf_bild(modus&)
' ENDIF
grosse_ausgabe
ruecksprung(1)
ENDIF
ENDSELECT
RETURN
'
'
'
'
'