Kaiser 2 - Datei "KAISERB.TUR"

100 REM SAVE "D8:KAISERB.TUR"
110 COM ACKER(6),LEUTE(6),KRIEG(6),LKORN(6),LAND(6),KPREIS(6),MUHL(6),MARKT(6),GELD(6),LPREIS(6),APREIS(6)
120 COM VERALAND(6),PUNKTE(6),VERBLAND(6),JUSTIZ(6),ENTHOB(6),HH(6),BD(6)
130 COM MWST(6),EIN(6),ZOLL(6),DOM(6),BURG(6),INFANT(6),ARTELL(6),KAVALL(6),MANOV(6),TOD(6),TITEL(6),VERKORN(6)
140 DIM NAME$(160),LAND$(60),K$(1760),TITEL$(120)
150 TITEL$="Verwalter Baron	  Landgraf  Markgraf  Herzog	 F^rst	  Kurf^rst  K]nig					"
160 NAME$(160)="#"
170 LAND$="Anloor	Kachjian Andorin  GarenhellSemedal  Galador		"
180 OPEN #%1,4,%0,"D8:NAMEN.DAT"
190 BGET #%1,ADR(NAME$),160
191 BGET #%1,$06F0,6
200 CLOSE #%1
210 OPEN #%1,4,%0,"D8:KAISER.FNT"
220 BGET #%1,PEEK(106)*256,1024
230 CLOSE #%1
240 EXEC LOAD
250 OPEN #%1,4,%0,"D8:KAISER3.PIC"
260 BGET #%1,ADR(K$),1760
270 CLOSE #%1
280 ANZAHL=VAL(NAME$(%1,%1)):IF TITEL(SP)=8 THEN TITEL(SP)=7
290 GRAPHICS %0:POKE 559,%0:EXEC NAMEN
300 GRAPHICS 24:POKE 559,%0:POKE 756,PEEK(106):COLOR %1
310 DL=DPEEK(560)
320 DPOKE 1560,DL+%3:POKE DL,%1
330 DPOKE DL+%1,1536
340 POKE 708,8
350 DPOKE 709,62735
360 OPEN #%1,4,%0,"D8:CHRONIK.PIC"
370 BGET #1,DPEEK(88),1600
380 BGET #1,DPEEK(88)+6480,1200
390 CLOSE #%1
400 PLOT 43,40:DRAWTO 18,162
410 PLOT 312,40:DRAWTO 284,162
420 COLOR %1
430 BILD=VAL(NAME$(SP+%1,SP+%1))
440 FOR U=%0 TO 42
450	MOVE ADR(K$)+BILD*5+1+U*40,DPEEK(88)+2419+U*40,4
460 NEXT U
470 GE=VAL(NAME$(SP+%1,SP+%1))-4
480 TEXT 65,17,"Ihre Majest\t,"
490 TEXT 176,17,NAME$(SP*20,SP*20+10)
500 IF GE>=%0
510	U=16
520	TEXT 65,140,"Die Regentin von "
530 ELSE
540	U=%0
550	TEXT 65,140,"Der Regent von "
560 ENDIF
570 TEXT 185+U,140,LAND$((SP-%1)*9+%1,(SP-%1)*9+9)
580 PLOT 149,61:DRAWTO 182,61:DRAWTO 182,104:DRAWTO 149,104:DRAWTO 149,61
590 POKE 559,34
600 REPEAT
610 UNTIL STRIG(%0)=%0:EXEC ENTHOB2
620 IF TITEL(SP)>%1 THEN EXEC HANDEL:EXEC ENT
630 EXEC SAVE
640 TRAP 660:POKE 559,%0
650 RUN "D8:KAISER3"
660 RUN "D1:KAISER3.TUR"
670 ------------------------------
680 PROC LOAD
690	OPEN #%1,4,%0,"D1:DATEN.DAT"
700	%GET #%1,SP
710	FOR U=%1 TO 6
720	  %GET #%1,A:%GET #%1,B:ACKER(U)=A:LEUTE(U)=B
730	  %GET #%1,A:%GET #%1,B:KRIEG(U)=A:LKORN(U)=B
740	  %GET #%1,A:%GET #%1,B:LAND(U)=A:KPREIS(U)=B
750	  %GET #%1,A:%GET #%1,B:MUHL(U)=A:MARKT(U)=B
760	  %GET #%1,A:%GET #%1,B:GELD(U)=A:LPREIS(U)=B
770	  %GET #%1,A:%GET #%1,B:APREIS(U)=A:VERALAND(U)=B
780	  %GET #%1,A:%GET #%1,B:PUNKTE(U)=A:VERBLAND(U)=B
790	  %GET #%1,A:%GET #%1,B:JUSTIZ(U)=A:MWST(U)=B
800	  %GET #%1,A:%GET #%1,B:EIN(U)=A:ZOLL(U)=B
810	  %GET #%1,A:%GET #%1,B:LET DOM(U)=A:BURG(U)=B
820	  %GET #%1,A:%GET #%1,B:INFANT(U)=A:ARTELL(U)=B
830	  %GET #%1,A:%GET #%1,B:KAVALL(U)=A:MANOV(U)=B
840	  %GET #%1,A:%GET #%1,B:TOD(U)=A:TITEL(U)=B
850	  %GET #%1,A:%GET #%1,B:HH(U)=A:BD(U)=B
860	  %GET #%1,A:VERKORN(U)=A:%GET #%1,B:ENTHOB(U)=B:NEXT U:%GET #%1,MG1
870	%GET #%1,MG2:%GET #%1,JAHR:%GET #%1,U:HH(%0)=U
880	CLOSE #%1
890 ENDPROC
900 ------------------------------
910 PROC SAVE
920	OPEN #%1,8,%0,"D8:DATEN.DAT"
930	%PUT #%1,SP
940	FOR U=%1 TO 6
950	  %PUT #%1,ACKER(U):%PUT #%1,LEUTE(U)
960	  %PUT #%1,KRIEG(U):%PUT #%1,LKORN(U)
970	  %PUT #%1,LAND(U):%PUT #%1,KPREIS(U)
980	  %PUT #%1,MUHL(U):%PUT #%1,MARKT(U)
990	  %PUT #%1,GELD(U):%PUT #%1,LPREIS(U)
1000	  %PUT #%1,APREIS(U):%PUT #%1,VERALAND(U)
1010	  %PUT #%1,PUNKTE(U):%PUT #%1,VERBLAND(U)
1020	  %PUT #%1,JUSTIZ(U):%PUT #%1,MWST(U)
1030	  %PUT #%1,EIN(U):%PUT #%1,ZOLL(U)
1040	  %PUT #%1,DOM(U):%PUT #%1,BURG(U)
1050	  %PUT #%1,INFANT(U):%PUT #%1,ARTELL(U)
1060	  %PUT #%1,KAVALL(U):%PUT #%1,MANOV(U)
1070	  %PUT #%1,TOD(U):%PUT #%1,TITEL(U)
1080	  %PUT #%1,HH(U):%PUT #%1,BD(U)
1090	  %PUT #%1,VERKORN(U):%PUT #%1,ENTHOB(U):NEXT U:%PUT #%1,MG1
1100	%PUT #%1,MG2:%PUT #%1,JAHR:%PUT #%1,HH(%0)
1110	CLOSE #%1
1120 ENDPROC
1130 ------------------------------
1140 PROC HANDEL
1141	IF JAHR=1700 THEN HH(%0)=RAND(10)+10
1150	ZAHL=HH(SP)*50+LEUTE(SP)*1.2+MARKT(SP)*10+MUHL(SP)*15+BURG(SP)*80+DOM(SP)*110+RAND(100)+TITEL(SP)*150
1160	ZAHL=INT(ZAHL)
1170	AH=-(INT(HH(SP)-(BD(SP)/5))):IF AH>HH(SP) THEN AH=HH(SP)
1180	IF HH(SP)>%0 THEN GEW=INT(AH*(200+RAND(JAHR)+PUNKTE(SP)*5)*(AH>%0))
1190	BDL=BD(SP)*50
1200	GELD(SP)=GELD(SP)-BDL
1210	GELD(SP)=GELD(SP)+GEW
1220	ZAHL=ZAHL+INT(GELD(SP)*14/100)
1221	IF ZAHL>GELD(SP)
1222	  ZAHL=INT(ZAHL-((ZAHL-GELD(SP))*1.123))
1223	ENDIF
1230	IF ZAHL<%0 THEN ZAHL=%1
1240	GRAPHICS %0
1250	POKE 559,%0
1260	POKE 752,%1:POKE 756,PEEK(106)
1270	DL=DPEEK(560)
1280	DPOKE 1560,DL+%3
1290	POKE DL,%1:DPOKE DL+%1,1536
1300	POKE 710,50:POKE 709,108
1310	POKE 708,8:U=21
1320	POKE 559,34
1330	POSITION %3,%2:? "Handelsh\user"
1340	POSITION %2,%3:? "-=============-"
1350	POSITION %2,6:? "Ihr Verm]gen ";INT(GELD(SP));" ^X "
1360	POSITION 24,6:? "Gewinn ";GEW;" ^X "
1370	POSITION 4,8:? "Der Kaiser verlangt ";ZAHL;" ^X"
1380	POSITION 4,10:? "Sie geben ";ABG;" ^X "
1390	POSITION 6,13:? "Handelsh\user..........5000 ";HH(SP)
1400	POSITION 6,14:? "Bedienstete.(............50 ";BD(SP)
1410	POSITION 19,14:? BDL;")."
1420	POSITION 6,16:? "Neu einstellen..............";NEU
1430	POSITION 6,17:? "Entlassen...................";ALT
1440	POSITION 6,19:? "Tributzahlung............... "
1450	POSITION 6,21:? " Ende "
1460	REPEAT
1470	  ST=STICK(%0)
1480	  IF ST=14 AND U>13
1490		 U=U-%1-%1*(U=21 OR U=19)-%2*(U=16):SOUND %0,100+U,10,10:PAUSE %1:SOUND
1500	  ENDIF
1510	  IF ST=13 AND U<21
1520		 U=U+%1+%1*(U=17 OR U=19)+%2*(U=13):SOUND %0,100+U,10,10:PAUSE %1:SOUND
1530	  ENDIF
1540	  POSITION %2,U:? "ESC^_"
1550	  PAUSE %2
1560	  POSITION %2,U:? " "
1570	UNTIL STRIG(%0)=%0:SOUND %0,80,10,10:PAUSE %2:SOUND
1580	IF U=13 AND SPE=%0:SPE=%1
1590	  IF GELD(SP)>2500 AND HH(%0)>%0
1600		 HH(SP)=HH(SP)+%1:HH(%0)=HH(%0)-%1
1610		 GELD(SP)=GELD(SP)-5000:PUNKTE(SP)=PUNKTE(SP)+1.3
1620	  ELSE
1630		 PUT 253
1640	  ENDIF
1650	ENDIF
1660	IF U=16
1670	  STEL=%2:XPOS=34:YPOS=16:PAUSE 10:EXEC UJZER
1680	  NEU=ERGB
1690	  U=16
1700	ENDIF
1710	IF U=17
1720	  STEL=%2:XPOS=34:YPOS=17:PAUSE 10:EXEC UJZER
1730	  IF BD(SP)-ERGB<%0
1740		 PUT 253
1750	  ELSE
1760		 ALT=ERGB
1770	  ENDIF :U=17
1780	ENDIF
1790	IF U=19
1800	  STEL=5:XPOS=30:YPOS=19:EXEC UJZER
1810	  IF GELD(SP)-ERGB>-10000
1820		 ABG=ABG+ERGB
1830		 GELD(SP)=GELD(SP)-ERGB
1840	  ELSE
1850		 PUT 253
1860	  ENDIF :U=19
1870	ENDIF
1880	IF U<20 THEN GOTO 1330
1890	BD(SP)=BD(SP)+NEU-ALT
1900	IF ABG-1000+RAND(2000)>ZAHL
1910	  PUNKTE(SP)=PUNKTE(SP)+INT(ABG/2000)
1920	ELSE
1930	  PUNKTE(SP)=PUNKTE(SP)-%1
1940	ENDIF
1950 ENDPROC
1960 ------------------------------
1970 PROC UJZER
1980	ZAEHL=%0:ERGB=%0
1990	FOR U=%1 TO STEL
2000	  POSITION XPOS+U-%1,YPOS
2010	  ? ZAEHL
2020	NEXT U
2030	STE=STEL
2040	REPEAT
2050	  ST=STICK(%0)
2060	  IF ST<15
2070		 SOUND %0,40+10*(ST=13 OR ST=14),10,6
2080		 PAUSE 0.7:SOUND
2090	  ENDIF
2100	  IF ST=11 AND STE>%1 THEN STE=STE-%1
2110	  IF ST=7 AND STE<STEL THEN STE=STE+%1
2120	  IF ST=11 OR ST=7 THEN LOCATE XPOS-%1+STE,YPOS,ZAEHL:ZAEHL=ZAEHL-48
2130	  POSITION XPOS-%1+STE,YPOS+%1
2140	  ? "ESC^\":PAUSE %1
2150	  POSITION XPOS-%1+STE,YPOS+%1
2160	  ? " "
2170	  IF ST=14 THEN ZAEHL=ZAEHL+%1
2180	  IF ST=13 THEN ZAEHL=ZAEHL-%1
2190	  IF ZAEHL<%0 THEN ZAEHL=9
2200	  IF ZAEHL>9 THEN ZAEHL=%0
2210	  POSITION XPOS-%1+STE,YPOS
2220	  ? ZAEHL
2230	UNTIL STRIG(%0)=%0
2240	FOR U=%1 TO STEL
2250	  LOCATE XPOS-%1+U,YPOS,ZAEHL
2260	  ERGB=ERGB+((ZAEHL-48)*10^(STEL-U))
2270	NEXT U:SOUND %1,20,12,6:SOUND %0,70,10,6:PAUSE %3:SOUND
2280 ENDPROC
2290 ------------------------------
2300 PROC NAMEN
2310	IF SP>ANZAHL THEN SP=%1:JAHR=JAHR+%1
2320	GE=VAL(NAME$(SP+%1,SP+%1))-4
2330	IF GE>=%0
2340	  TITEL$(27,27)="\"
2350	  TITEL$(37,37)="\"
2360	ENDIF
2370	IF ENTHOB(SP)=%1 AND ANZAHL>%1 THEN ENTHOB(SP)=%0:SP=SP+%1:GOTO 2320
2380	TOD(SP)=TOD(SP)-%1:PUNKTE(SP)=PUNKTE(SP)+%1
2390	POSITION %1,%0:? CHR$(SP-%1);" ";
2400	? NAME$(SP*20,INSTR(NAME$(SP*20),"  ")+SP*20-%2);", ";
2410	A=TITEL(SP)
2420	B=9*(A=%0)+5*(A=%1 OR A=5 OR A=7)+8*(A=%2 OR A=%3 OR A=6)+6*(A=4)
2430	? TITEL$(TITEL(SP)*10+%1,TITEL(SP)*10+B);
2440	IF GE>=%0
2450	  ? "in";
2460	ENDIF
2470	? " von ";
2480	? LAND$((SP-%1)*9+%1,(SP-%1)*9+9)
2490	MOVE DPEEK(88),PEEK(106)*256+1824,40
2500	POKE $030D,PEEK($06F0+SP-%1)
2510 ENDPROC
2520 ------------------------------
2530 PROC ENT
2540	CLS :POKE 559,%0
2550	POKE 710,114:IF RAND(6)<5 THEN GOTO 2690
2560	IF HH(SP)>%0 AND VERKORN(SP)+RAND(5000)<LKORN(SP) OR ABG+RAND(5000)<ZAHL AND HH(SP)>%0:POKE 559,34
2570	  POSITION 13,5:? "Enteignung"
2580	  POSITION 13,6:? "=========="
2590	  POSITION 7,10:? "Aufgrund schlechter Handels-"
2600	  POSITION 7,11:? "gesch\fte wurde Ihnen eines "
2610	  POSITION 7,12:? "der Ihnen vom Kaiser zur Be-"
2620	  POSITION 7,13:? "wirtschaftung ^berlassenden"
2630	  POSITION 7,14:? "Handelsh\user enteignet."
2640	  HH(SP)=HH(SP)-%1
2650	  HH(%0)=HH(%0)+%1
2660	  REPEAT
2670	  UNTIL STRIG(%0)=%0
2680	ENDIF
2690 ENDPROC
2700 ------------------------------
2710 PROC ENTHOB2
2720	IF MWST(SP)+EIN(SP)+ZOLL(SP)>80
2730	  GRAPHICS 0:POKE 710,195:CLS :POKE 752,%1:POKE 756,PEEK(106)
2740	  DL=DPEEK(560):DPOKE 1560,DL+%3:POKE DL,%1:DPOKE DL+%1,1536
2750	  POSITION 12,5:? "STEUERPOLITIK"
2760	  POSITION 12,6:? "-------------"
2770	  POSITION %3,10:? "Aufgrund Ihrer schlechten Steuer-"
2780	  POSITION %3,11:? "politik wurden Sie um"
2790	  POSITION %3,12:? "zwei Jahre Ihres Amtes ent-"
2800	  POSITION %3,13:? "hoben und degradiert!"
2810	  ENTHOB(SP)=%2
2820	  PUNKTE(SP)=PUNKTE(SP)-TITEL(SP)*5
2830	  TITEL(SP)=TITEL(SP)-%1
2840	  IF TITEL(SP)<%0 THEN TITEL(SP)=%0
2850	  IF PUNKTE(SP)<%0 THEN PUNKTE(SP)=%0
2860	  PAUSE 100
2870	  REPEAT
2880	  UNTIL STRIG(%0)=%0
2890	ENDIF
2900 ENDPROC
2910 ------------------------------

Kaiser II (c) 1989-2020 PhöniX SoftCrew
Carsten Strotmann / Björn Israel
Atari und PC Software
https://kaiser2.strotmann.de

Datum: 2020-05-10 Sun 00:00

Autor: Carsten Strotmann

Created: 2020-05-10 Sun 21:47

Validate