Kaiser 2 - Datei "KAISER0.TUR"

100 EXEC VAR:POKE 106,176
110 GRAPHICS 24
120 POKE 710,%0
130 POKE 712,%0
140 POKE 1626,96
150 POKE 709,%0
160 POKE 65,%0
170 COLOR %1:EXEC DL
180 IF PEEK(732)=17 THEN 350
190 EXEC BILDLAD
200 BRUN "D:TITEL.COM"
210 EXEC DIMHELL
220 EXEC ZWEI
230 EXEC CST
240 EXEC KSTAUF
250 EXEC HOPS
260 EXEC KSTZU
270 EXEC BLOCK
280 EXEC BROECKEL
290 EXEC UND
300 COLOR 1
310 EXEC ANST
320 EXEC UPDOWN
330 MC$="hL-^B"
340 X=USR(ADR(MC$)):SOUND
350 POKE 106,160:MOVE $B000,$A000,$0400
360 GRAPHICS %0
370 POKE 559,%0
380 RUN "D:KAISER1.TUR"
390 DO :LOOP
400 PROC BILDLAD
410	DIM MIL$(275):POKE 559,%0
420	OPEN #%3,4,%0,"D:KAISERL.DAT"
430	BGET #%3,ADR(MIL$),275
440	CLOSE #%3
450	OPEN #%1,4,%0,"D:KAISER2.PIC"
460	X=USR(ADR(MIL$))
470	CLOSE #%1
480	FOR PSC=DPEEK(88) TO DPEEK(88)+7680 STEP 33
490	  Z=Z+PEEK(PSC)
500	NEXT PSC
510	IF Z<>13314 THEN POKE 1626,%0
520 ENDPROC
530 PROC DIMHELL
540	DPOKE 709,%0:POKE 559,34
550	FOR I=%0 TO 14 STEP 0.25
560	  POKE 709,I
570	NEXT I
580 ENDPROC
590 PROC HOPS
600	RESTORE 680
610	READ A$,H,L
620	IF H=%0 THEN 670
630	FOR I=320 TO L STEP -%1
640	  TEXT I,H,A$
650	NEXT I
660	GOTO 610
670 ENDPROC
680 DATA G,106,225
690 DATA R,106,233
700 DATA A,106,241
710 DATA P,106,249
720 DATA H,106,257
730 DATA I,106,265
740 DATA C,106,273
750 DATA S,106,281
760 DATA b,120,249
770 DATA y,120,257
780 DATA O,0,0
790 PROC BLOCK
800	POX=229
810	POY=122
820	FOR I=%0 TO %1
830	  FOR J=%0 TO 5
840		 RESTORE 930
850		 READ X,Y
860		 IF X=-%1 THEN 910
870		 A=POX+((J+%1)*7)+X
880		 B=POY+((I+%1)*8)+Y
890		 PLOT A,B
900		 GOTO 850
910	  NEXT J
920	NEXT I
930	DATA 4,4,4,3,3,3,3,4,3,5
940	DATA 4,5,5,5,5,4,5,3,5,2
950	DATA 4,2,3,2,2,2,2,3,2,4
960	DATA 2,5,2,6,3,6,4,6,5,6
970	DATA 6,6,6,5,6,4,6,3,6,2
980	DATA 6,1,5,1,4,1,3,1,2,1
990	DATA 1,1,1,2,1,3,1,4,1,5
1000	DATA 1,6,1,7,2,7,3,7,4,7
1010	DATA 5,7,6,7,-1,-1
1020 ENDPROC
1030 PROC BROECKEL
1040	Z=%0:REPEAT
1050	  COLOR %0
1060	  X=PEEK(ZW+Z):Y=PEEK(ZW+Z+%1):Z=Z+%2
1070	  PLOT X+100,Y
1080	UNTIL Z>235
1090 ENDPROC
1100 ------------------------------
1110 PROC DL
1120	OPEN #%1,4,%0,"D:DL.BIN"
1130	BGET #%1,1536,30
1140	CLOSE #%1
1150	OPEN #%1,4,%0,"D:KAISER.FNT"
1160	BGET #%1,PEEK(106)*256,1024
1170	CLOSE #%1
1180	OPEN #%1,4,%0,"D:KAISER.DAT"
1190	%GET #%1,AQ
1200	BGET #%1,ADR(SC$),AQ
1210	CLOSE #%1
1220 ENDPROC
1230 ------------------------------
1240 PROC VAR
1250	DIM A$(%1),SC$(4000),ZW$(1515),MC$(5)
1260	OPEN #%1,4,%0,"D:KAISER0.DAT"
1270	BGET #%1,ADR(ZW$),1515
1280	CLOSE #%1
1290	ZW=ADR(ZW$)
1300 ENDPROC
1310 PROC ZWEI
1320	COLOR %1:TRAP 1370:Z=236
1330	REPEAT
1340	  A=PEEK(ZW+Z):B=PEEK(ZW+Z+%1):Z=Z+%2
1350	  PLOT A-%2,B+95
1360	UNTIL Z>1515
1370 ENDPROC
1380 ------------------------------
1390 PROC CST
1400	FOR U=%0 TO AQ-%1 STEP %2
1410	  COLOR %1
1420	  X=PEEK(ADR(SC$)+U)
1430	  Y=PEEK(ADR(SC$)+U+%1)
1440	  PLOT X+215,Y+50
1450	NEXT U
1460 ENDPROC
1470 ------------------------------
1480 PROC UND
1490	RESTORE 1570
1500	READ A:ZA=ZA+%1
1510	IF A=-%1 THEN 1560
1520	FOR I=%0 TO A STEP 4
1530	  POKE DPEEK(88)+5872+ZA*40,I
1540	NEXT I
1550	GOTO 1500
1560 ENDPROC
1570 DATA 112,216,112,112,218,206,124,-1
1580 PROC ANST
1590	RESTORE 1610
1600	FOR I=%0 TO 13
1610	  DATA A,N,D,R,E,*,S,T,R,O,T,M,A,N,N
1620	  READ A$
1630	  IF A$="*" THEN X1=56:Y1=-8:GOTO 1620
1640	  FOR U=%0 TO 7
1650		 PLOT 240-X1+I*8,155+U-Y1
1660		 DRAWTO 247-X1+I*8,155+U-Y1
1670	  NEXT U
1680	  FOR U=%0 TO 8
1690		 POKE DPEEK(88)+(155+U-Y1)*40+(240-X1)/8+I,PEEK(PEEK(106)*256+(ASC(A$)-32)
*8+U)
1700	  NEXT U
1710	NEXT I
1720 ENDPROC
1730 PROC UPDOWN
1740	DIM P1(8),P2(8),P$(8)
1750	P$="GRAPHICS"
1760	TEXT 273,105,"C"
1770	FOR I=106 TO 104 STEP -%1
1780	  TEXT 265,I,"I":PAUSE %2
1790	NEXT I
1800	FOR I=106 TO 103 STEP -%1
1810	  TEXT 257,I,"H":PAUSE %2
1820	NEXT I
1830	FOR I=106 TO 102 STEP -%1
1840	  TEXT 249,I,"P":PAUSE %2
1850	NEXT I
1860	FOR I=106 TO 101 STEP -%1
1870	  TEXT 241,I,"A":PAUSE 2
1880	NEXT I
1890	FOR I=106 TO 100 STEP -%1
1900	  TEXT 233,I,"R":PAUSE %2
1910	NEXT I
1920	FOR I=106 TO 99 STEP -%1
1930	  TEXT 225,I,"G":PAUSE %2
1940	NEXT I
1950	P1(%1)=99:P1(%2)=100:P1(%3)=101
1960	P1(4)=102:P1(5)=103:P1(6)=104
1970	P1(%1)=99:P1(%2)=100:P1(%3)=101
1980	P1(4)=102:P1(5)=103:P1(6)=104
1990	P1(7)=105:P1(8)=106
2000	P2(%1)=%1:P2(%2)=%1:P2(%3)=%1
2010	P2(4)=%1:P2(5)=%1:P2(6)=%1
2020	P2(7)=%1:P2(8)=%1
2030	REPEAT
2040	  FOR I=%1 TO 8
2050		 PL=%0
2060		 IF P2(I)=%1
2070			P1(I)=P1(I)-%1
2080			IF P1(I)=98
2090			  P2(I)=%2
2100			ENDIF
2110			TEXT 217+I*8,P1(I),P$(I,I):PL=%1
2120		 ENDIF
2130		 IF PL=%0
2140			P1(I)=P1(I)+%1
2150			IF P1(I)=107
2160			  P2(I)=%1
2170			ENDIF
2180			TEXT 217+I*8,P1(I),P$(I,I)
2190		 ENDIF
2200	  NEXT I
2210	UNTIL STRIG(%0)=%0
2220 ENDPROC
2230 ------------------------------
2240 PROC KSTAUF
2250	PLOT 224,97
2260	PLOT 290,97
2270	PLOT 224,115
2280	PLOT 290,115
2290	PLOT 291,96
2300	DRAWTO 223,96
2310	DRAWTO 223,116
2320	DRAWTO 291,116
2330	DRAWTO 291,96
2340	COLOR %0:PLOT 291,96:DRAWTO 291,116:PAUSE %2
2350	COLOR %1:PLOT 297,97:DRAWTO 291,116:PAUSE %2
2360	COLOR %0:PLOT 297,97:DRAWTO 291,116:PAUSE %2
2370	COLOR %1:PLOT 302,100:DRAWTO 291,116:PAUSE %2
2380	COLOR %0:PLOT 302,100:DRAWTO 291,116:PAUSE %2
2390	COLOR %1:PLOT 307,102:DRAWTO 291,116:PAUSE %2
2400	COLOR %0:PLOT 307,102:DRAWTO 291,116:PAUSE %2
2410	COLOR %1:PLOT 310,106:DRAWTO 291,116:PAUSE %2
2420	COLOR %0:PLOT 310,106:DRAWTO 291,116:PAUSE %2
2430	COLOR %1:PLOT 312,110:DRAWTO 291,116:PAUSE %2
2440	COLOR %0:PLOT 312,110:DRAWTO 291,116:PAUSE %2
2450	COLOR %1:PLOT 313,116:DRAWTO 291,116:PAUSE %2
2460 ENDPROC
2470 PROC KSTZU
2480	COLOR %0:PLOT 313,116:DRAWTO 291,116:PAUSE %2
2490	COLOR %1:PLOT 312,110:DRAWTO 291,116:PAUSE %2
2500	COLOR %0:PLOT 312,110:DRAWTO 291,116:PAUSE %2
2510	COLOR %1:PLOT 310,106:DRAWTO 291,116:PAUSE %2
2520	COLOR %0:PLOT 310,106:DRAWTO 291,116:PAUSE %2
2530	COLOR %1:PLOT 307,102:DRAWTO 291,116:PAUSE %2
2540	COLOR %0:PLOT 307,102:DRAWTO 291,116:PAUSE %2
2550	COLOR %1:PLOT 302,100:DRAWTO 291,116:PAUSE %2
2560	COLOR %0:PLOT 302,100:DRAWTO 291,116:PAUSE %2
2570	COLOR %1:PLOT 297,97:DRAWTO 291,116:PAUSE %2
2580	COLOR %0:PLOT 297,97:DRAWTO 291,116:PAUSE 2
2590	COLOR %1:PLOT 291,96:DRAWTO 291,116
2600 ENDPROC
2610 ------------------------------

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 20:50

Validate