home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tiger Disk 25
/
Tiger_Disk_025_19xx_Tiger-Crew-Disk_de_Side_D.d64
/
b.abrech
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2023-02-26
|
11KB
|
586 lines
98 restore
99 rem ********************************
100 rem *******************************
110 code=7*4096:vars=5*4096+6*256
111 gr=peek(code+3)+peek(code+4)*256
112 pg=vars
114 ps=vars+7
116 rs=ps+268
118 as=rs+80+512
120 es=as+560
122 pa=es+200
150 ap=peek(pg+1)
160 :
161 rem **** store city
162 poke ps+(ap-1)*67,peek(pg+2)
200 dim gs(8),rp(4,3),qs(3),cc(8)
204 for z=0 to 8
205 read gs(z)
206 next z
207 for z=0 to 4: for y=0 to 3
208 read rp(z,y)
209 next y:next z
215 for z = 0 to 3
216 read qs(z)
217 next z
300 sys code,3
301 print"[155]"
302 print"[194]itte warten !"
303 print"[211]trukturen werden entpackt !"
304 sys code,6,3
500 :
501 rem ***** check kreditrahmen
502 :
505 b=pa+16+(ap-1)*8+4
510 gosub 22000:vm=r
515 kr=vm*20/100
516 b=ps+(ap-1)*67+6
517 r=kr:gosub 20500: rem store kr
525 gosub 21000 : rem get k
530 if k>0 then 600
535 :
540 rem *** auscheiden wegen low geld
542 if k>=-kr then 550
543 poke ps+(ap-1)*67+56,255: rem !!!!
544 rem **** ausscheiden !!!!!!!!
545 :
547 ft=65:fp=ap:op=3:gosub 7000 :rem fax ausscheid
549 gosub 8502:goto 5000:rem player
550 :
551 rem ***** check aktienuebernahem
552 :
555 if peek(pa+(ap-1)*4+ap-1)>49 then 600
560 for y=0 to 3
562 if y=ap-1 then 590
564 if peek(pa+(y-1)*4+ap-1)<50 then590
570 :
571 rem ***** uebernommen
572 :
575 rem "player : ";ap;" von player :";y+1;" ue"
577 gosub 9500: rem uebernahme
580 :
581 rem print uebernahme
582 goto 590: rem no !!!!! uebernahme
584 rem faxen texte fuer uebern
585 gosub 7500:goto 5000: rem next play
590 next y
600 :
1000 rem **** real abrechnung
1001 ug=0:qg=0:gbes=0:ka=0:kf=0:ke=0
1002 en=0
1005 ag=gr
1006 b=40944+(ap-1)*4:gosub 22000
1007 lk=r
1010 for z=0 to 6*9-1
1015 a=peek(ag+2)
1020 b=a and 15
1025 a=int(a/16)
1030 if b=0 or b=1 then 1200
1035 if (a><ap) then goto 1200
1100 gosub 10000:rem ump-bere
1150 rem **** uwp bere end
1152 ug=ug+uw:qg=qg+qu:ka=ka+ak:gbes=gbes+bes
1153 kf=kf+fk:ke=ke+ek:en=en+ne
1200 rem **** next ground
1205 ag=ag+31
1210 next z
1250 rem :
1251 rem ***** runden
1252 gbes=int(gbes)
1253 en=int(en)
1254 qu=int(qu)
1255 de=int(de)
1256 dk=int(dk)
1257 zi=int(zi)
2000 rem ***** zinsen
2001 gosub 21000 :rem getkonto
2002 if k<0 then zi=k*15/100
2003 if k>=0 then zi=k*5/100
2005 zi = int (zi)
2010 gosub 22000: wk=r
2012 :
2015 aa=peek(pa+(ap-1)*4+ap-1)
2020 aa=100-aa
2025 if aa=0 then 2050 :rem noaktie
2030 b=ps+(ap-1)*67+10
2035 gosub 22000 : rem get long
2040 dk=r*aa/100/4:dk=int(dk)
2050 rem ***** dividenden ertraege
2052 :
2055 ab=pa+(ap-1)*4:de=0
2060 for z=0 to 3
2065 if z=ap-1 then 2095 :rem next z
2070 aa=peek(ab+z):if aa=0 then 2095
2075 b=ps+(z)*67+10
2080 gosub 22000 :rem get long
2085 de=de+r*aa/100/4:de=int(de)
2095 next z
2100 :
2101 rem *** get vermoegen
2102 :
2105 b=pa+16+(ap-1)*8+4
2110 gosub 22000: rem get long
2115 vm=r
2120 :
2121 rem *** get investitionen
2122 :
2125 b=pa+16+(ap-1)*8
2130 gosub 22000: rem get long
2135 iv=r
2200 :
2201 rem ***** bere werbekosten
2202 :
2205 b=ps+(ap-1)*67+46
2210 gosub 22000:wk=r
2250 :
2251 rem **** bere energiesparpreise
2252 b=ps+(ap-1)*67+58:ep=0
2253 for z=0 to 8
2255 ep=ep+peek(b+z)
2260 next z
2500 :
2501 rem ***** bere gewinn
2502 :
2505 gw=en-ke-kf-ka-wk-dk+zi+de
2506 gw=int(gw)
2507 ga=gw-zi-iv
2550 :
2551 rem **** bere new konto
2552 :
2554 k=k+gw:vm=vm+gw
2555 gosub 20000
2560 rem store vermoegen
2570 r=vm:b=pa+16+(ap-1)*8+4
2580 gosub 20500
2600 :
2601 rem store new last konto
2603 r=k:b=40944+(ap-1)*4:gosub 20500
3000 rem :
3001 rem :
3002 rem ****** out put
3003 :
3004 sys code,4,3,4,6
3005 sys code,7,96,32,10:sys code,6,3
3010 sys code,3:print"";
3011 sys code,4,3,24,2:sys code,21,ap
3012 print" [199][197][211][193][205][212][193][194][210][197][195][200][206][213][206][199]:"
3014 print
3015 print" [214]erm*gen : ";vm
3020 print" [199]uthaben vorher : ";:if lk>=0 then print lk:goto 3025
3024 print
3025 print" [194]esucherzahl : "; gbes
3030 print" [197]nergiesparpreise : ";ep
3035 print
3040 print" [201]nvestitionskosten: "
3045 print" [208]ersonalkosten : "
3050 print" [198]ahrzeugkosten : "
3055 print" [215]erbekosten : "
3060 print" [197]nergiekosten : "
3065 print" [196]ividendenkosten : "
3070 print" [196]ividendenertr@ge : ";de
3075 print" [218]insen : ";:if zi>=0 then print zi:goto 3080
3079 print
3080 print" [197]innahmen : ";en
3085 print"---------------------------------------"
3090 print" [199]ewinn : ";:if qa>=0 then print ga:goto 3095
3094 print
3095 gosub 21000
3096 print" [199]uthaben aktuell : ";:if k>=0 then print k:goto 3100
3097 print
3100 sys code,6,3
3101 :
3102 :
3110 sys code,3:print"";
3113 print
3114 print
3115 print
3120 print"";:if lk<0 then print lk:goto 3125
3124 print
3125 print
3130 print
3135 print
3140 print"";iv
3145 print"";ka
3150 print"";kf
3155 print"";wk
3160 print"";int(ke)
3165 print"";dk
3170 print
3175 print"";:if zi<0 then print zi:goto 3180
3176 print
3180 print
3185 print
3190 print"";:if ga<0 then print ga:goto 3195
3194 print
3195 gosub 21000
3196 print"";:if k<0 then print k:goto 3200
3197 print
3200 sys code,6,8 : rem conv bright
4000 :
4001 rem ***** reset values
4002 :
4003 rem *** scroll gewinn
4005 b=ps+(ap-1)*67+14
4010 for z = 0 to 11
4012 poke b+z,peek(b+4+z)
4014 next z
4020 rem ***** store gewinn
4025 r=gw:b=b+12:gosub 20500
4050 :
4052 rem *** scroll einkommen
4055 b=ps+(ap-1)*67+30
4060 for z = 0 to 11
4072 poke b+z,peek(b+4+z)
4074 next z
4080 rem ***** store einkommen
4085 r=en:b=b+12:gosub 20500
4090 rem ***** store einkommen
4095 r=en:b=ps+(ap-1)*67+10
4096 gosub 20500
4100 :
4101 rem **** clear investments
4102 :
4105 b=pa+16+(ap-1)*8
4106 poke b+0,0
4107 poke b+1,0
4108 poke b+2,0
4109 poke b+3,0
4500 :
4501 rem **** ask buttons
4502 :
4505 poke 2,255
4510 cl=peek(2):if cl=99 then 4550
4515 goto 4510
4550 rem *** klicked exit
4555 :
5000 nq=0
5001 rem **** weiter zaehlen
5002 :
5003 gosub 9000:rem test humans raus ?
5004 if hr=1 then 5150
5005 ap=ap+1:if ap=5 then nq=1:ap=1
5006 poke pg+2,peek(ps+(ap-1)*67)
5010 poke pg+1,ap
5011 b=ps+(ap-1)*67+56
5012 if peek(b)=255 then goto 5005 rem *** ausgeschieden ->next player
5013 if peek(b)>0 then poke b,0:goto 5005 rem *** aussetzen
5014 if nq=1 then 5100
5015 if ap>peek(pg) then 5050:rem compi
5020 :
5021 rem **** haupsiz oder city !
5022 :
5023 rem city
5024 :
5025 if peek(ps+(ap-1)*67)=10 then 5040
5030 sys code,25,1
5031 z=peek(vars+2):a$="l.city"+str$(z)
5032 sys code,1,a$,8
5040 :
5041 rem *** goto haupsiz waehlen
5045 sys code,25,1
5046 sys code,1,"l.hauptsit",8
5050 :
5051 rem ***** call computer
5052 :
5053 if peek(ps+(ap-1)*67)=10 then int(rnd(0)*8)+1
5070 sys code,1,"l.computer",8
5100 :
5101 rem ***** quartal up
5102 aq=peek(pg+4)
5110 aq=aq+1: if aq=5 then 5200
5115 poke pg+4,aq
5120 goto 5030 : rem load city
5130 :
5150 ft=66:fp=0:op=0:gosub 7000
5151 sys code,9:sys code,1,"l.save",8:sys code,10
5155 sys code,25,1
5160 sys code,1,"l.splrzahl",8
5170 end
5195 :
5200 :
5201 rem ***** umweltpreise
5202 poke pg+5,peek(pg+5)+1
5205 aq=1: poke pg+4,aq
5220 sys code,1,"l.epreis",8
6999 end
7000 :
7001 rem ***** init fax
7002 :
7003 :
7004 sys code,22,ft
7008 :
7010 if fp>0 then gosub 7200
7012 sys code,1,"l.fax",8
7013 :
7014 sys code,3
7015 sys code,4,3,4,6
7020 sys code,7,96,32,10
7030 sys code,6,3
7040 sys code,8
7050 return
7200 :
7201 rem insert name
7202 :
7205 sys code,4,3,0,0
7206 sys code,21,fp
7208 for x=0 to 9
7210 poke 25344+op+x,peek(1024+x)
7212 next x
7250 return
7251 :
8502 rem ***** make ausscheiden
8503 :
8505 ag=gr
8506 for z=0 to 6*9-1
8510 p=peek(ag+2):gs=p and 15:p=int(p/16)
8515 if p<>ap then 8550
8525 poke ag+2,0
8550 ag=ag+31:next z
8600 :
8601 rem *** player weg in strukt
8602 :
8605 poke ps+(ap-1)*67+56,255
8700 :
8701 rem ***** clear gewinn
8702 :
8705 b=ps+(ap-1)*67+14
8710 for z = 0 to 15
8712 poke b+z,0
8714 next z
8750 :
8751 rem ***** clear einkommen
8752 :
8755 b=ps+(ap-1)*67+30
8760 for z = 0 to 15
8762 poke b+z,0
8764 next z
8800 :
8801 rem ***** clear aktien
8802 :
8805 b=pa+(ap-1)*4
8810 for z=0 to 3: poke b+z,0:next z
8815 for z=0 to 3
8820 poke pa+z*4+ap-1,0
8825 next z
8900 return
9000 :
9001 rem **** test alle human raus
9002 :
9003 hr=0
9005 ah=peek(pg):ah=ah-1
9010 if peek(ps+ah*67+56)<>255 then9050
9021 hr=1:rem alle ausscheiden
9050 return
9500 :
9501 :
9502 rem ***** make uebernahme
9503 :
9505 ag=gr
9506 for z=0 to 6*9-1
9510 p=peek(ag+2):gs=p and 15:p=int(p/16)
9515 if p<>ap then 9550
9520 p=(y+1)*16+gs
9525 poke ag+2,p
9550 ag=ag+31:next z
9600 :
9601 rem *** player weg in strukt
9602 :
9605 poke ps+(ap-1)*67+56,255
9700 :
9701 rem ***** clear gewinn
9702 :
9705 b=ps+(ap-1)*67+14
9710 for z = 0 to 15
9712 poke b+z,0
9714 next z
9750 :
9751 rem ***** clear einkommen
9752 :
9755 b=ps+(ap-1)*67+30
9760 for z = 0 to 15
9762 poke b+z,0
9764 next z
9800 :
9801 rem ***** clear aktien
9802 :
9805 b=pa+(ap-1)*4
9810 for z=0 to 3: poke b+z,0:next z
9815 for z=0 to 3
9820 poke pa+z*4+ap-1,0
9825 next z
9900 return
10000 rem *****************************
10150 rem **** uwp for this restaurant
10160 rem **** extras
10161 uw=0:qu=0:bes=0:ak=0:fk=0:ek=0
10162 ne=0
10165 a=peek(ag+6)
10170 f=a and 15
10175 a=int(a/16)
10180 if (a and 1) =1 then uw=uw+3 : qu=qu+6
10181 if (a and 2) =2 then uw=uw+4 : qu=qu+6
10182 if (a and 4) =4 then uw=uw+2 : qu=qu+6
10183 if (a and 8) =8 then uw=uw-3 : qu=qu+6
10200 rem **** fahrzeuge
10201 if (f and 1) =1 then uw=uw-3 : qu=qu+20: fk=5000: goto 10250
10202 if (f and 2) =2 then uw=uw-1 : qu=qu+25: fk=3000: goto 10250
10203 if (f and 4) =4 then uw=uw+1 : qu=qu+15: fk=500: goto 10250
10204 if (f and 8) =8 then uw=uw+3 : qu=qu+10: fk=0
10250 rem **** gruenflaeche
10255 a=peek(ag+3)
10260 r=a and 15
10265 a=int(a/16)
10270 s=gs(a)
10271 s=s-r
10272 s=s*4
10273 uw=uw+s
10274 qu=qu+s
10300 rem **** einrichtung
10305 for y=0 to 4
10310 anz=peek(ag+7+5+y)
10315 typ=peek(ag+7+y)
10320 ua=(peek(es+y*40+typ*4+1))
10321 if ua>128 then uw=uw-((ua and 127)*anz)
10322 if ua<128 then uw=uw+ua*anz
10325 qu=qu+(peek(es+y*40+typ*4+0)*anz)
10330 next y
10350 rem ****** werbung
10355 b=ps+(ap-1)*67+46
10360 w=peek(b+0)
10361 w=w+peek(b+1)*256
10362 w=w+peek(b+2)*65536
10363 w=w+(peek(b+3) and 127)*16777216
10370 ra=peek(b+4):ra=ra*w/100
10371 pl=peek(b+5):pl=pl*w/100
10372 pr=peek(b+6):pr=pr*w/100
10373 ma=peek(b+7):ma=ma*w/100
10374 um=peek(b+8):um=um*w/100
10380 ra=int(ra/20000)
10381 pl=int(pl/10000)
10382 pr=int(pr/12000)
10383 ma=int(ma/15000)
10384 um=int(um/15000)
10390 if (ra>5) then ra=5
10391 if (pl>2) then pl=2
10392 if (pr>3) then pr=3
10393 if (ma>4) then ma=4
10394 if (um>6) then um=6
10400 rem ****** image neu bere
10405 i=peek(b+9)
10410 i=i+ra+pl+pr+ma+int(um/2)
10415 i=i-3:if i<0 then i=0
10420 poke (b+9),i
10450 rem ****** werbung auf uwp bere
10455 uw=uw+um+int(ra/2)
10500 rem ****** ump abschlag size
10505 b=ps+(ap-1)*67
10510 r=peek(b+1)
10511 s=(peek(ag+3) and 15)
10515 uw=uw*rp(r,s-1)/100
10550 rem ****** qual grundstueck
10555 qu=qu+peek(ag+4)
10600 rem ****** qual persk arbeiter
10605 for y=0 to 9
10610 ar=peek(ag+17+y)
10615 if ar=255 then 10640
10620 rem *** get qual of worker
10625 av=peek(as+ar*7+6)
10626 ak=ak+peek(as+ar*7+1)*100
10630 qu=qu+av
10640 next y
10650 rem *** quartalschwankung
10655 s=peek(pg+4)-1
10660 sp=qs(s)
10670 qu=qu*sp/100
10700 rem *** imageschwankung
10705 qu=qu*(i+30)/100
10750 rem *** besucher bere
10755 b=ps+(ap-1)*67 : rem player
10760 re=peek(b+1) : rem rest art
10765 b=rs+re*16 : rem rest strk
10770 gw=peek(b+4)
10775 qm=peek(b+5)
10780 bes=qu*200*qm/100
10790 rem **** einnahmen
10791 ne=bes*gw
10800 rem *** test auf angestellten
10805 for y=0 to 9
10806 if peek(ag+17+y)<>255 then 10850
10807 next y
10808 bes=0:qu=0:uw=0:ne=0
10850 rem *** test auf 0 besucher
10900 rem *** energiekosten
10905 ek=(70-uw):if ek<1 then ek=1
10910 ek=ek*100
10915 if bes=0 then ek=0
11000 :
11001 rem **** count anz city
11002 :
11005 c=ag-gr:c=int(c/31/6)
11010 cc(c)=cc(c)+1
12000 if uw<0 then uw=0:rem **** uwp bere end
12001 poke ag+27,uw :rem save up ground
12002 return
20000 :
20001 rem *** store kontostand
20002 :
20005 qk=k
20006 b=vars+7+2+((peek(vars+1)-1)*67)
20010 x=0:if k<0 then k=k-k-k:x=128
20020 poke(b+3),int(k/16777216)
20030 k=k-(int(k/16777216)*16777216)
20040 poke(b+2),int(k/65536)
20050 k=k-(int(k/65536)*65536)
20060 poke(b+1),int(k/256)
20070 k=k-(int(k/256)*256)
20080 poke(b+0),k
20090 poke(b+3),peek(b+3) or x
20100 k=qk
20110 return
20500 :
20501 rem *** store long
20502 :
20510 x=0:if r<0 then r=r-r-r:x=128
20520 poke(b+3),int(r/16777216)
20530 r=r-(int(r/16777216)*16777216)
20540 poke(b+2),int(r/65536)
20550 r=r-(int(r/65536)*65536)
20560 poke(b+1),int(r/256)
20570 r=r-(int(r/256)*256)
20580 poke(b+0),r
20590 poke(b+3),peek(b+3) or x
20610 return
21000 :
21001 rem *** get kontostand
21002 :
21010 b=vars+7+2+((peek(vars+1)-1)*67)
21020 x=peek(b+3) and 128
21030 k=peek(b+0)
21040 k=k+(peek(b+1)*256)
21050 k=k+(peek(b+2)*65536)
21060 k=k+((peek(b+3)and127)*16777216)
21070 if x=128 then k=-k
21080 return
22000 :
22001 rem *** get kontostand
22002 rem:b has to be bered
22004 :
22020 x=peek(b+3) and 128
22030 r=peek(b+0)
22040 r=r+(peek(b+1)*256)
22050 r=r+(peek(b+2)*65536)
22060 r=r+((peek(b+3)and127)*16777216)
22070 if x=128 then r=-r
22080 return
30000 rem ******* datas
30002 rem ******* datas grundst. size
30003 data 0,1,2,2,3,3,4,5,5
30004 rem ******* datas grundst. size
30005 data 130,110,090,070
30006 data 130,110,090,070
30007 data 130,110,090,070
30008 data 130,110,090,070
30009 data 130,110,090,070
30020 rem ******* datas quartalsschw
30022 data 95,80,100,90