Kaiser 2 - Datei "KAISER6.TUR"

100 COM ACKER(6),LEUTE(6),KRIEG(6),LKORN(6),LAND(6),KPREIS(6),MUHL(6),MARKT(6),GELD(6),LPREIS(6),APREIS(6)
110 COM VERALAND(6),PUNKTE(6),VERBLAND(6),JUSTIZ(6),ENTHOB(6),HH(6),BD(6)
120 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)
130 DIM MEM$(800),NAM$(160)
140 DIM JAHR(101),NAMEN$(1050),IN$(10),PUNKT(101),NAME$(10),STUFE(101)
150 NAM$(160)="#"
160 OPEN #%1,4,%0,"D:NAMEN.DAT"
170 BGET #%1,ADR(NAM$),160
180 CLOSE #%1
190 REM KAISER6.TUR
200 POKE 106,176:GRAPHICS %0:POKE 559,%0
210 OPEN #%1,4,0,"D8:KAISER.FNT"
220 BGET #%1,$BC00,$0400
230 CLOSE #%1
231 EXEC LOAD
232 IN$=NAM$(SP*20+%1,SP*20+10)
240 EXEC KROENUNG:POKE 106,182:GRAPHICS %0:POKE 559,%0
250 MOVE ADR("HT-^^C^M^VP-_^C^M^WP-`^C^M^XPh@"),960,40
260 DPOKE 512,960
270 POKE 708,4:POKE 709,8:POKE 710,12
280 POKE 559,%0
290 OPEN #%1,4,%0,"D:KAISER6.DAT"
300 BGET #%1,1024,80
310 CLOSE #%1
320 OPEN #%1,4,%0,"D:KAISER6.PIC"
330 BGET #%1,46592,1800
340 CLOSE #%1
350 DPOKE 560,1024:DPOKE 1028,46592
360 DPOKE 1078,DPEEK(88):POKE 756,224
380 OPEN #%1,4,%0,"D:KAISER.DAT"
390 FOR U=%0 TO 99
400	INPUT #%1,IN$
410	NAMEN$(U*10+%1)=IN$
420	%GET #%1,T:JAHR(U)=T
430	%GET #%1,T:PUNKT(U)=T
440	%GET #%1,T:STUFE(U)=T
450 NEXT U
460 CLOSE #%1
470 NAMEN$(1050)="#"
480 MSP=VAL(NAM$(%1,%1))
490 FOR SP=%1 TO MSP
500	POKE 752,%1
510	NAME$=NAM$(SP*20+%1,SP*20+10)
520	EXEC WERT
530	EXEC EINSORT
540 NEXT SP
550 OPEN #%1,8,%0,"D:KAISER.DAT"
560 FOR U=%0 TO 99
570	? #%1;NAMEN$(U*10+%1,U*10+10)
580	%PUT #%1,JAHR(U)
590	%PUT #%1,PUNKT(U)
600	%PUT #%1,STUFE(U)
610 NEXT U
620 CLOSE #%1
630 POKE 54286,192
640 POKE 1024+50,128
650 POKE 991,14:POKE 992,32
660 CLS
670 ? "PLATZ/STUFE  NAME		JAHR	  PUNKTE"
680 MOVE DPEEK(88),46592+1800,40
690 CLS
700 A=%0:POKE 559,34
710 REPEAT
720	ST=STICK(%0)
730	IF ST=14 AND A>%0
740	  A=A-10:IF A<%0 THEN A=%0
750	ENDIF
760	IF ST=13 AND A<93
770	  A=A+10:IF A>90 THEN A=90
780	ENDIF
790	IF ST=15 AND QF=%1 THEN 720
800	FOR U=%0 TO 9
810	  POSITION %3,%2+U
820	  ? A+U+%1;"./";STUFE(A+U);" "
830	  POSITION 10,%2+U
840	  ? NAMEN$((A+U)*10+%1,(A+U)*10+10)
850	  POSITION 23,%2+U
860	  ? JAHR(A+U);"	"
870	  POSITION 32,%2+U
880	  ? PUNKT(A+U);"			 "
890	NEXT U:QF=%1
900 UNTIL 1=2
910 END
920 ------------------------------
930 PROC EINSORT
940	SORT=100:F=%1
950	REPEAT
960	  IF PU>PUNKT(SORT)
970		 PUNKT(SORT+%1)=PUNKT(SORT)
980		 JAHR(SORT+%1)=JAHR(SORT)
990		 STUFE(SORT+%1)=STUFE(SORT)
1000		 NAMEN$((SORT+%1)*10+%1,(SORT+%1)*10+10)=NAMEN$(SORT*10+%1,SORT*10+10)
1010		 PUNKT(SORT)=PU
1020		 JAHR(SORT)=JAHR
1030		 STUFE(SORT)=TITEL(SP)
1040		 NAMEN$(SORT*10+%1,SORT*10+10)=NAME$
1050		 SORT=SORT-%1
1060	  ELSE
1070		 F=%0
1080	  ENDIF
1090	UNTIL F=%0 OR SORT<%0
1100 ENDPROC
1110 ------------------------------
1120 PROC LOAD
1130	OPEN #%1,4,%0,"D1:DATEN.DAT"
1140	%GET #%1,SP
1150	FOR U=%1 TO 6
1160	  %GET #%1,A:%GET #%1,B:ACKER(U)=A:LEUTE(U)=B
1170	  %GET #%1,A:%GET #%1,B:KRIEG(U)=A:LKORN(U)=B
1180	  %GET #%1,A:%GET #%1,B:LAND(U)=A:KPREIS(U)=B
1190	  %GET #%1,A:%GET #%1,B:MUHL(U)=A:MARKT(U)=B
1200	  %GET #%1,A:%GET #%1,B:GELD(U)=A:LPREIS(U)=B
1210	  %GET #%1,A:%GET #%1,B:APREIS(U)=A:VERALAND(U)=B
1220	  %GET #%1,A:%GET #%1,B:PUNKTE(U)=A:VERBLAND(U)=B
1230	  %GET #%1,A:%GET #%1,B:JUSTIZ(U)=A:MWST(U)=B
1240	  %GET #%1,A:%GET #%1,B:EIN(U)=A:ZOLL(U)=B
1250	  %GET #%1,A:%GET #%1,B:LET DOM(U)=A:BURG(U)=B
1260	  %GET #%1,A:%GET #%1,B:INFANT(U)=A:ARTELL(U)=B
1270	  %GET #%1,A:%GET #%1,B:KAVALL(U)=A:MANOV(U)=B
1280	  %GET #%1,A:%GET #%1,B:TOD(U)=A:TITEL(U)=B
1290	  %GET #%1,A:%GET #%1,B:HH(U)=A:BD(U)=B
1300	  %GET #%1,A:VERKORN(U)=A:%GET #%1,B:ENTHOB(U)=B:NEXT U:%GET #%1,MG1
1310	%GET #%1,MG2:%GET #%1,JAHR:%GET #%1,U:HH(%0)=U
1320	CLOSE #%1
1330 ENDPROC
1340 ------------------------------
1350 PROC WERT
1360	PU=%0
1370	PU=(200-(JAHR-1700))*200
1380	PU=PU+MARKT(SP)*200
1390	PU=PU+MUHL(SP)*300
1400	PU=PU+HH(SP)*500
1410	PU=PU+LEUTE(SP)*100
1420	PU=PU+DOM(SP)*1000
1430	PU=PU+BURG(SP)*800
1440	PU=PU-KRIEG(SP)*200
1450 ENDPROC
1460 ------------------------------
1470 PROC KROENUNG
1480	GRAPHICS 24:DPOKE 709,15
1490	POKE 559,%0:POKE 756,$BC
1500	OPEN #%1,4,%0,"D:KRON.PIC"
1510	BGET #%1,DPEEK(88),7040
1520	CLOSE #%1
1530	BRUN "D:EHRE.COM"
1540	POKE 559,34:AD=DPEEK(88)
1550	DPOKE 88,ADR(MEM$)
1560	RESTORE #TEXT:COLOR %1
1570	REPEAT
1580	  MOVE ADR(MEM$),ADR(MEM$)+%1,719
1590	  READ NAMEN$
1591	  IF NAMEN$="#"
1592		 NAMEN$=IN$
1593	  ENDIF
1600	  TEXT 160-LEN(NAMEN$)*4,%0,NAMEN$
1610	  READ NAMEN$
1620	  TEXT 160-LEN(NAMEN$)*4,8,NAMEN$
1630	  FOR U=%0 TO 18 STEP %2
1640		 MOVE DPEEK(88)+U*40,AD+U*40+7040,40
1650		 MOVE DPEEK(88)+(17-U)*40,AD+(17-U)*40+7040,40:PAUSE %3
1660	  NEXT U:PAUSE 200
1670	UNTIL NAMEN$=""
1671	REPEAT :UNTIL STRIG(%0)=%0
1680	NAMEN$="hL-^B"
1690	X=USR(ADR(NAMEN$)):SOUND
1700 ENDPROC
1710 ------------------------------
1720 # TEXT
1730 DATA Erbietet dem neuen Kaiser,eure Ehrerbietung!
1740 DATA #,der neue Kaiser
1750 DATA von Gottes Gnaden,Herrscher der Welt
1760 DATA ^ber alle L\nder,und Reiche
1770 DATA Ein g^tiger und,gerechter Herrscher
1780 DATA ,

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 22:01

Validate