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

Datum: 2020-05-10 Sun 00:00

Autor: Carsten Strotmann

Created: 2020-05-10 Sun 21:43

Validate