home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er 1989 September
/
64er_Magazin_89-09_1989_Markt__Technik_de_Side_A.d64
/
rel-demo
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
6KB
|
182 lines
10 rem ------------------------------
20 rem -- --
30 rem -- demonstrationsprogramm --
40 rem -- fuer relative dateien --
50 rem -- --
60 rem -- (w) 1989 joerg nebel --
70 rem -- und matthias ullmann --
80 rem -- --
90 rem ------------------------------
100 :
110 rem *** initialisieren ***
120 :
130 poke 53280,6:poke 53281,6:poke 646,7:print chr$(147)chr$(142)chr$(8)
140 sys 57812 "rel-tool",8,1:poke 780,0:sys 62629 : sys 49155
150 dm=100 : dim i$(dm) : nu$=chr$(0):cr$=chr$(13):pi$=chr$(255)
160 sys 49152,1,3,"demoprogramm fuer relative dateien"
170 sys 49152,2,2,"------------------------------------"
180 sys 49152,21,1," f1 [146] dateien zeigen f3 [146] datei anlegen"
190 sys 49152,22,1," f5 [146] datei loeschen f7 [146] programmstart"
200 gosub 7400:if ta=8 then 8000
210 if ta<1 or ta>4 then 200
220 sys 49155,5,20:if ta>1 then gosub 500
230 on ta goto 300,800,250,700
240 :
250 sys 49152,7,3,"sind sie sicher ? (j/n)"
260 gosub 7400:if ta$<>"j" and ta$<>"n" then 260
270 sys 49155,5,7:if ta$="n" then 200
280 open 1,8,15,"s0:"+dn$:print#1,"s0:"+in$:gosub 7050:close 1:sys 49155,5
290 :
300 gosub 400:open 1,8,15,"m-e"+chr$(34)+chr$(235):close 1:goto 200
310 :
380 rem *** dateien zeigen ***
390 :
400 open 1,8,0,"$:*=r":poke 781,1:sys 65478
410 get a$,a$,a$,a$:sys 49152,5,7,"0 ";
420 for i=1 to 28:get a$:print a$;:next:print cr$spc(6);
430 get a$,a$,a$,b$:if st then sys 65484:close 1:return
440 print asc(a$+nu$)+256*asc(b$+nu$);:goto 420
450 :
480 rem *** dateiangaben holen ***
490 :
500 na$="":sys 49152,5,3,"dateiname ";:input na$:if len(na$)>14 then 500
510 if na$="" then ta=1:sys 49155,5:return
520 for i=1 to len(na$):a$=mid$(na$,i,1)
530 if a$="*" or a$="?" or a$="." then 500
540 next i:dn$=na$+".d":in$=na$+".i":if ta>2 then return
550 open 1,8,15:open 2,8,2,dn$:gosub 7050:close 2:close 1:if en=0 then 500
560 sys 49152,7,3:input"satzlaenge ";sl
570 if sl<2 or sl>254 then 560
580 sys 49152,9,3:input"satzanzahl ";sm
590 af=1:si=1:open 1,8,15:open 2,8,2,dn$+",l,"+chr$(sl):gosub 7050
600 gosub 6510:close 2:close 1:sys 49155,5,9:return
610 :
680 rem *** hauptprogramm ***
690 :
700 open 1,8,15:open 2,8,2,dn$:gosub 7050:close 2:close 1
710 if en=62 then sys 49152,7,3,"datei nicht vorhanden !";:goto 200
720 :
800 print chr$(147)chr$(14)chr$(8):sys 49152,1,12,"[196]atei bearbeiten"
810 sys 49152,2,11,"------------------"
820 gosub 6000:gosub 5000
830 sys 49152,19,1," [198]1 [146] [194]laettern (+) [198]2 [146] [194]laettern (-)"
840 sys 49152,20,1," [198]3 [146] [211]atz eingeben [198]4 [146] [211]atz loeschen"
850 sys 49152,21,1," [198]5 [146] [206]ame suchen [198]6 [146] [211]atz aendern"
860 sys 49152,22,1," [198]7 [146] [215]eiter suchen [198]8 [146] [208]rogrammende"
870 gosub 7400:if ta<1 or ta>8 then 870
880 bf=0:if (ta=6 or ta=7) and (sn=0 or i$(sn)=pi$) then 870
890 on ta gosub 1000,2000,4000,4500,1000,3000,2010,8000:goto 870
900 rem tasten: <f1>,<f3>,<f5>,<f7>,<f2>,<f4>,<f6>,<f8>
910 :
980 rem *** blaettern ***
990 :
1000 if ta=1 then sn=sn+1:if sn>sm then sn=1:bf=bf+1
1010 if ta=5 then sn=sn-1:if sn<1 then sn=sm:bf=bf+1
1020 if bf=2 then sys 49152,5,1,"[206]och kein [196]atensatz vorhanden !";:return
1030 if i$(sn)=pi$ then 1000
1040 goto 5010
1050 :
1980 rem *** satz eingeben/aendern ***
1990 :
2000 su$=pi$:as=1:gosub 7500:if sn=0 then gosub 6500
2010 d0$=d1$:gosub 7300:if ta=2 then gosub 5040
2020 sys 49152,8,10:input d1$:if d1$="" then 2020
2030 sys 49152,10,10:input d2$
2040 sys 49152,12,10:input d3$
2050 sys 49152,14,10:input d4$
2060 sys 49152,16,10:input d5$
2070 da$=d1$+cr$+d2$+cr$+d3$+cr$+d4$+cr$+d5$:dl=len(da$)+1
2080 gosub 7000:print#2,da$:gosub 7050
2090 if en=51 then sys 49152,5,1,"[196]atensatz um";dl-sl;"[157] [218]eichen zu lang !";
2100 if en=51 then gosub 5050:gosub 7300:goto 2020
2110 i$(sn)=d1$:if d0$<>d1$ then df=1
2120 if i$(sn)=pi$ then d1$="[198]reier [196]atensatz"
2130 goto 5000
2140 :
2980 rem *** satz loeschen ***
2990 :
3000 sys 49152,5,1,"[211]ind [211]ie sicher ? ([202]/[206])";
3010 gosub 7400:if ta$="n" then 5040
3020 if ta$<>"j" then 3010
3030 gosub 7300:df=1:d1$=pi$
3040 sys 49155,5:goto 2070
3050 :
3980 rem *** suchen ***
3990 :
4000 su$="":sys 49155,5:input" [211]uchkriterium ";su$:if su$="" then 4000
4010 as=1:gosub 7500
4020 if sn=0 then sys 49152,5,1,"[196]atensatz nicht vorhanden !";:return
4030 goto 5010
4040 :
4480 rem *** weiter suchen ***
4490 :
4500 if sn=0 or su$="" or su$=pi$ then return
4510 as=sn+1:if as>sm then sn=0:sys 49152,5,1,"[196]ateiende erreicht !";:return
4520 gosub 7500:if sn>0 then 5010
4530 sys 49152,5,1,"[203]ein weiterer [211]atz vorhanden !";:return
4540 :
4980 rem *** satz anzeigen ***
4990 :
5000 sys 49152,5,1,"[211]tatus ";en$;:goto 5050
5010 sys 49155,6,18:gosub 7000
5020 input#2,d1$,d2$,d3$,d4$,d5$
5030 if d1$=pi$ then d1$="[198]reier [196]atensatz"
5040 sys 49152,5,1,"[196]atensatz [206]ummer ";sn;"[157] [146]";
5050 sys 49152,8,1,"[206]ame ";d1$;
5060 sys 49152,10,1,"[214]orname ";d2$;
5070 sys 49152,12,1,"[211]trasse ";d3$;
5080 sys 49152,14,1,"[208][204][218]/[207]rt ";d4$;
5090 sys 49152,16,1,"[212]elefon ";d5$;
5100 return
5110 :
5980 rem *** dateien oeffnen ***
5990 :
6000 open 1,8,15:open 2,8,2,dn$:gosub 7050
6010 if af=1 then af=0:return
6020 sys 49155,5:open 3,8,3,in$+",s,r"
6030 input#3,sm$,sl$:sm=val(sm$):sl=val(sl$):if sm>dm then 6530
6040 for i=1 to sm:input#3,i$(i):next
6050 close 3:return
6060 :
6480 rem *** datei anlegen/erweitern ***
6490 :
6500 sm=sm+1:si=sm
6510 sm=int(254*int((sm*sl+253)/254)/sl)
6520 if sm<=dm then 6560
6530 lf=1:sys 49155,5,18:sys 49152,5,3,"[196]imensionierung auf";sm;"anpassen !";
6540 gosub 7400:if af=1 then close 2:print#1,"s0:"+dn$:goto 8060
6550 sm=si-1:goto 8000
6560 sn=sm:gosub 7000:print#2,pi$
6570 for i=si to sm:i$(i)=pi$:next
6580 sn=si:df=1:return
6590 :
6980 rem *** positionieren ***
6990 :
7000 hb=int(sn/256):lb=sn-hb*256
7010 print#1,"p"+chr$(2)+chr$(lb)+chr$(hb)+chr$(1)
7020 :
7030 rem *** fehlerkanal ***
7040 :
7050 input#1,en,en$,et,es
7060 if en=0 or en=50 or en=51 or en=62 then return
7070 sys 49155,5:sys 49152,5,1," status [146] ";en;en$;et;es;:if en<20 then 7400
7080 close 3:close 2:close 1:end
7090 :
7100 rem *** einzeiler ***
7200 :
7300 d1$="":d2$="":d3$="":d4$="":d5$="":da$="":return
7400 poke 198,0:wait 198,1:get ta$:ta=asc(ta$)-132:return
7500 p%=0:sys 49158,su$,i$(as),i$(sm),p%:sn=p%:return
7600 :
7980 rem *** programmende ***
7990 :
8000 if df=0 then 8060
8010 sys 49155,5,18:sys 49152,5,7,"[196]ateien werden gesichert !"
8020 print#1,"s0:"+in$
8030 open 3,8,3,in$+",s,w"
8040 print#3,str$(sm)+cr$+str$(sl)
8050 for i=1 to sm:print#3,i$(i):next
8060 close 3:close 2:close 1:sys 49155
8070 print chr$(142)chr$(9)
8080 if lf=1 then list 150