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