home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tiger Disk 27
/
Tiger_Disk_027_19xx_Tiger-Crew-Disk_de_Side_B.d64
/
votesheet-count.
(
.txt
)
< prev
Wrap
Commodore BASIC
|
2023-02-26
|
4KB
|
139 lines
10 f=53272:pokef+8,.:pokef+9,.:pokef,20:poke657,128:poke788,52:l=peek(186):goto250
20 datatiger-disk,spiele,demos,anwender,utilities
30 print""x$(a,t):poke198,0:ri$=""
40 getri$:ifri$=""then40
50 ifri$=chr$(133)then530
60 e1=t:t=100:goto530
70 q=peek(768):poke768,185:open1,l,15,"i":close1:poke768,q:ifst<>-128thenreturn
75 print" bitte laufwerk ";l;" einschalten !":ll=l:an=1:gosub140:goto70
80 poke198,0:wait198,1:poke198,0:return
90 open15,l,15
100 input#15,aa,bb$,cc,dd
110 ifaa<>0thenprint" daten-disk in laufwerk";l;"[157] einlegen!![150]":goto130
120 return
130 print,aa;bb$;cc;dd:ll=l:ifll<8thenll=8
140 print"[129]laufwerk-wechsel zu ";:ifll=8thenprintll+1;"[157][157][157][157]";
150 ifll=9thenprintll-1;"[157][157][157][157]";
160 l$="":inputl$:l=val(l$)
170 ifl$=""thenl=ll:goto190
175 ifl$="f"andan=0thenl=ll:open1,l,15,"n:datendisk,01":print"formatiere!":close1:goto190
180 ifl<8orl>15thenprint"[145][145][145][145]":goto140
190 close2:close15:print"[147]":return
195 print"[147]bitte drucker abschalten!":ru=1:gosub200:ifst<>-128then195
196 return
200 q=peek(768):open4,4:poke768,185:print#4:close4:poke768,q:ifst<>-128thenreturn
205 ifru=1thenru=0:return
210 print" bitte drucker einschalten ! ":print" e = menue "
220 getab$:ifab$<>" "andab$<>"e"then220
230 ifab$=" "then200
240 ifab$="e"thenau=3:close1:return
250 ifl<8thenl=8
260 dimx$(5,100),x(5,100):print"[147]"
270 fort=1to5:reada$(t):next
271 print"[153] besteht die datei ?":print" [space = ja / n = nein]"
272 getda$:ifda$<>" "andda$<>"n"then272
273 ifda$="n"then720
275 gosub195
280 gosub70:an=0:open2,l,2,"daten,s,r":gosub90:ifaa<>0then280
290 forv=1to5:forw=1to100
300 input#2,x$(v,w):input#2,x(v,w):
310 print"kategorie/anzahl[146]: ";v;:ifw<10thenprint" ";
320 ifw<100thenprint" ";
330 print""w
340 nextw:nextv
350 close2:close15:sa=1
360 print"[147][129] datenstand anzeigen ?"
370 getau$:ifau$<>"j"andau$<>"n"then370
380 ifau$="j"then830
390 poke53265,11:print"[147]"tab(10)"kategorien :":fort=1to5:print"[156]"t,a$(t):next:print
395 print"[176]";:forb=1to37:print"[195]";:next:print"[174]":print"[194]";tab(38)"[194]"
400 print"[194][154] return [146] = eingabe-ende";spc(9)"[194]":print"[194]";tab(38)"[194]"
402 print"[194][150] e + return [146] = prg.-ende";spc(12)"[194]":print"[194]";tab(38)"[194]"
405 print"[173]";:forb=1to37:print"[195]";:next:print"[189]"
410 poke53265,27
420 k$="":input"[156] welche kategorie ";k$
430 ifk$=""then590
435 ifk$="e"andsa=0then590
440 ifk$="e"thenend
450 a=val(k$):ifa<1ora>5thenprint"[145][145][145]":goto420
460 print"[147]"tab(9)"return [146] [158]= eingabe-ende[153]":e1=0
470 print"bei namensanzeige: space = o.k.":printtab(19)"f1 = weitersuchen"
480 d$="":input"[156]name ";d$
490 ifd$=""then390
500 fort=1to100
510 ifleft$(x$(a,t),len(d$))=d$then30
520 ifx$(a,t)="/"thene1=t:t=100:x$(a,e1)=d$:print""x$(a,e1)
530 nextt
535 ife1=0thenprint"[158]datei voll! - keine eingabe mehr moeglich!":gosub80:goto390
540 pl$="":input"platz ";pl$:pl=val(pl$):ifpl>5thenprint"[145][145][145]":goto540
550 ifpl>0thenpu=6-pl:sa=0
560 ifpl=0thenpu=0
570 x(a,e1)=x(a,e1)+pu
580 goto480
590 print"[147][151]ich sortiere! - moment bitte!"
600 fort=1to5:print"";t
610 f5=0
620 forz=1to99:print"[154]";z
630 ifx(t,z)>=x(t,z+1)then680
640 h$=x$(t,z):h=x(t,z)
650 x(t,z)=x(t,z+1):x$(t,z)=x$(t,z+1)
660 x$(t,z+1)=h$:x(t,z+1)=h
670 f5=1:rem sys46374 ruft die 'garbage collection' auf...
680 nextz
690 iff5=1then610
700 nextt
705 gosub195
710 gosub70:an=0:open15,l,15,"s:daten":close15
720 open2,l,2,"daten,s,w":gosub90:ifaa<>0then710
730 forv=1to5:forw=1to100:print"[159]"v;:ifw<10thenprint" ";
740 ifw<100thenprint" ";
750 print"[150]"w
760 ifx(v,w)=0thenx$(v,w)="/"
770 ifx$(v,w)=""thenx$(v,w)="/"
780 print#2,x$(v,w):print#2,x(v,w)
790 gosub100:ifaa<>0then710
800 nextw
810 nextv
820 close2:close15:sa=1:ifk$="e"then390
825 ifda$="n"thenda$="":goto280
830 print"[147]";:au=3
835 open1,au
840 fort=1to5:print#1,"[153]"a$(t)"[146][158]":print#1:pl=1
850 forz=1to100:ifz>1thenifx(t,z)<x(t,z-1)andx$(t,z)<>"/"thenprint#1,pl;
860 ifz=1andx$(t,1)<>"/"thenprint#1,pl;
870 ifx$(t,z)="/"thenz=100:forli=1to39:print#1,"[195]";:next:print#1:k1=1:goto890
880 print#1,,x(t,z),x$(t,z):ifau=3thenifz/21=int(z/21)thengosub80:print#1,"[147]";
890 ifk1=1thenk1=0:ifau=3thengosub80:print#1,"[147]"
900 pl=pl+1:ifst=-128thengosub210:ifab$="e"then390
905 nextz
910 nextt:ifau=4thenprint#1:au=3:goto950
920 close1:print" drucken?"
930 getdr$:ifdr$<>"j"anddr$<>"n"then930
940 ifdr$="j"thenau=4:gosub200:ifab$<>"e"thenprint"[147] ich drucke!":goto835
950 close1:goto390
960 rem -- quicksort --
970 onsfgoto990
980 dims1(55),s2(55):sf=1
990 fork=1to5:print""k:sn=99:sp=0
1000 s1(0)=0:s2(0)=sn
1010 s1=s1(sp):s2=s2(sp)
1020 sp=sp-1
1030 l1=s1:l2=s2
1040 sd=x(k,(s1+s2)/2)
1050 ifx(k,l1)>sdandl1<s2thenl1=l1+1:goto1050
1060 ifx(k,l2)<sdandl2>s1thenl2=l2-1:goto1060
1070 ifl1>l2then1110
1080 sv=x(k,l1):x(k,l1)=x(k,l2):x(k,l2)=sv
1090 sv$=x$(k,l1):x$(k,l1)=x$(k,l2):x$(k,l2)=sv$
1100 l1=l1+1:l2=l2-1:print""l1,l2
1110 ifl1<=l2then1050
1120 ifs2-l1<=l2-s1then1150
1130 ifs1<l2thensp=sp+1:s1(sp)=s1:s2(sp)=l2
1140 s1=l1:goto1170
1150 ifl1<s2thensp=sp+1:s1(sp)=l1:s2(sp)=s2
1160 s2=l2
1170 ifs2>s1then1030
1180 ifsp>-1then1010
1190 next
1200 return