Kaiser 2 - Datei "KAISER2.TUR"
100 GRAPHICS 8:POKE 559,%0:DIM K$(1760),K(8),A$(40):EXEC DLINIT 110 A$="h"^F ^K)^G \d`-^M^Cp^L-y^B^Mx^B-^E^B^M^D^BLbd" 120 MOVE ADR(A$),$0680,40 130 X=USR($0680):POKE $D000,40 140 OPEN #%1,4,%0,"D1:KAISERII.PIC" 150 BGET #1,ADR(K$),936 160 CLOSE #%1 170 OPEN #%1,8,%0,"D8:KAISERII" 180 BPUT #1,ADR(K$),936 190 CLOSE #%1 200 OPEN #%1,4,%0,"D1:KAISER3.PIC" 210 BGET #%1,ADR(K$),1760 220 CLOSE #%1 230 OPEN #%1,8,%0,"D8:KAISER.FNT" 240 BPUT #%1,PEEK(106)*256,1024 250 CLOSE #%1 260 DPOKE 708,52229:POKE 710,192:POKE 1790,%0 270 DIM TITEL$(40),FN$(17),MAP$(7680),NAME$(160) 280 TITEL$="^@^@^@^@^@^@^@^@^@^@^@^@.amensvergabe^@^@^@^@^@^@^@^@^@^@^@^@^@^@^@^@^@^@" 290 MOVE ADR(TITEL$),PEEK(106)*256+1824,40:POKE 702,%0 300 POKE 756,PEEK(106):NAME$(160)="#" 310 COLOR %1:POKE 82,%0:POKE 752,%1 320 PLOT %0,49:DRAWTO 319,49 330 PLOT %0,143:DRAWTO 319,143 340 POKE 559,34:EXEC NEWGAME 360 IF NEW=%1 THEN POKE 1790,100:GOTO 790 370 MOVE ADR(K$),DPEEK(88),1760 380 OPEN #%1,8,%0,"D1:DATEN.DAT" 390 %PUT #%1,%1 400 FOR U=1 TO 200 410 TRAP 430:%PUT #%1,%0 420 NEXT U 430 CLOSE #%1 440 REPEAT 450 FN$="D8:MAP0" 460 MAP=MAP+%1 470 FN$(7,7)=STR$(MAP) 480 CLOSE #%1 490 TRAP 710:OPEN #%1,4,%0,FN$ 500 BGET #%1,ADR(MAP$),7680 510 CLOSE #%1 520 FOR S=%0 TO %1 530 FOR U=20 TO 1860 STEP 40 540 MOVE ADR(MAP$)+1860-U+S*3720,DPEEK(88)+2000,U 550 MOVE ADR(MAP$)+1860+S*3720,DPEEK(88)+5720-U,U 560 NEXT U 570 READ A$ 580 CLS 590 ? :? "HERRSCHER VON ";A$;:FN$="" 600 ? "^]^_..........^\^^^^^^^^^^^^^^^^^^^^^^"; 610 INPUT ":",FN$ 620 IF FN$="" AND MAP=%1 AND S=%0 THEN RESTORE :GOTO 570 630 IF FN$="" THEN G=G+%1:GOTO 710 640 NAME$((G+%1)*20+%1,(G+%1)*20+20)=FN$ 650 IF LEN(FN$)>10 THEN CLS :? " Nur 2-10 Buchstaben !!":PUT 253:PAUSE 200:GOTO 580 660 EXEC STICK 670 G=G+%1 680 EXEC BILD 690 NEXT S 700 UNTIL FN$="" OR LEN(FN$)<%3 OR G=6 710 NAME$(%1,%1)=STR$(G-%1*(G<7)) 720 FOR U=%1 TO 140 730 TRAP 750:IF NAME$(U,U)="^@" THEN NAME$(U,U)=" " 740 NEXT U 750 CLOSE #1:OPEN #%1,8,%0,"D:NAMEN.DAT" 760 BPUT #%1,ADR(NAME$),160 770 BPUT #%1,$06F0,6 780 CLOSE :TRAP 100 790 OPEN #%1,4,%0,"D:NAMEN.DAT":POKE 559,%0 800 OPEN #%2,8,%0,"D8:NAMEN.DAT" 810 BGET #%1,DPEEK(88),166 820 BPUT #%2,DPEEK(88),166 830 CLOSE #%2 840 CLOSE #%1 850 RUN "D:KAISERB.TUR" 860 ------------------------------ 870 PROC DLINIT 880 DL=DPEEK(560) 890 DPOKE 1537,PEEK(106)*256+1024 900 DPOKE 1560,DPEEK(560)+%3 910 OPEN #%1,4,%0,"D8:KAISER1.PIC" 920 BGET #%1,PEEK(106)*256+1024,800 930 CLOSE #%1 940 MOVE 1536+30,PEEK(106)*256+1824,40 950 POKE DL,%1 960 DPOKE DL+%1,1536 970 ENDPROC 980 ------------------------------ 990 PROC NEWGAME 1000 LET NEW=%1 1010 REPEAT 1020 IF NEW=%0 1030 TEXT 50,15,"NEUES SPIEL JA / NEIN " 1040 ELSE 1050 TEXT 50,15,"NEUES SPIEL JA / NEIN " 1060 ENDIF 1070 IF STICK(%0)=11 THEN LET NEW=%0 1080 IF STICK(%0)=7 THEN LET NEW=%1 1090 UNTIL STRIG(%0)=%0 1100 ENDPROC 1110 ------------------------------ 1120 DATA ANLOOR,KACHJIAN,ANDORIN,GARENHELL,SEMEDAL,GALADOR 1130 ------------------------------ 1140 PROC BILD 1150 BILD=%0 1160 REPEAT 1170 ST=STICK(%0) 1180 COLOR %1:PLOT 4+40*BILD,%3:DRAWTO 35+40*BILD,%3:DRAWTO 35+40*BILD,42:DRAWTO 4+40*BILD,42:DRAWTO 4+40*BILD,%3 1190 COLOR %0:PLOT 4+40*BILD,%3:DRAWTO 35+40*BILD,%3:DRAWTO 35+40*BILD,42:DRAWTO 4+40*BILD,42:DRAWTO 4+40*BILD,%3 1200 IF ST=7:BILD=BILD+%1 1210 IF BILD>7 THEN BILD=%0 1220 ENDIF 1230 IF ST=11:BILD=BILD-%1 1240 IF BILD<%0 THEN BILD=7 1250 ENDIF 1260 IF K(BILD)=%1:BILD=BILD+%1*(ST=7)-%1*(ST=11)+%1*(ST=15) 1270 IF BILD>7 THEN BILD=%0 1280 IF BILD<%0 THEN BILD=7 1285 GOTO 1260 1290 ENDIF 1300 UNTIL STRIG(%0)=%0 1310 NAME$(G+%1,G+%1)=STR$(BILD) 1320 K(BILD)=%1 1330 FOR U=%0 TO 4 1340 TEXT 4+40*BILD,3+U*8," " 1350 NEXT U 1360 ENDPROC 1370 ------------------------------ 1380 PROC STICK 1390 COLOR %1:TEXT 60,148,"W\hle Joystick (1/2)" 1400 REPEAT 1410 PAUSE 10 1420 IF STICK(%0)<15 1430 IF ZS=%0 1440 ZS=%1 1450 ELSE 1460 ZS=%0 1470 ENDIF 1480 IF ZS=0 1490 TEXT 188,148,"1/2" 1500 ELSE 1510 TEXT 188,148,"1/2" 1520 ENDIF 1530 ENDIF 1540 UNTIL STRIG(%0)=%0 1550 TEXT 60,148," " 1560 POKE $06F0+G,ZS:PAUSE 20 1570 ENDPROC 1580 ------------------------------
Kaiser II (c) 1989-2020 PhöniX SoftCrew
Carsten Strotmann / Björn Israel
Atari und PC Software
https://kaiser2.strotmann.de