|
|
Dies ist der Turbo-BASIC XL Programmcode des Level-Editors 2.0 des Spiels Electro Maniac!. Den Level-Editor 1.0 hatte ich ursprünglich in Atari Basic geschrieben. Als ich duch Zufall auf Turbo-BASIC XL von Frank Ostrowski gestoßen bin, habe ich den Editor komplett neu geschrieben.
100 ------------------------------
110 REM Electro Maniac! Ver. 07/88
120 REM (C) 1988 Stefan C. Mueller
130 ------------------------------
140 BLOAD "D:EMANIAC.OBJ":TRAP #ERROR
150 DIM Q$(%3),L$(%3),T$(40),FN$(14),FNB$(192)
160 LBL=10000:DIM LB$(LBL)
170 MANZ=9:DIM P(17),M(MANZ),C(15),Z(19)
180 EMS=$9C00:P6=$0600:LR=$B300
190 UBZ=$B5E0:OBZ=$B400:MBZ=$B428
200 PMC=$0669:WPR=$062B:WPL=$063F
210 PMS=$0603:NOMSTR=$0654
220 PMX=$0617:STB=$0602:MLN=64:BM=85
230 LN=%1:L$="01":BSS=%1
240 ------------------------------
250 EXEC INITLE
260 DO
270 T$=" Disk Setzen L;schen Testen Autor Ende ":M=%0:EXEC ITEM:IF E THEN I=6
280 ON I EXEC DISK,SETZEN,LOESCHEN,TESTEN,AUTOR,ENDE
290 LOOP
300 ------------------------------
310 PROC TRAP
320 # ERROR:EXEC CLL:? " ACHTUNG! Fehler Nr.";ERR;" trat auf! *+";
330 TRAP #ERROR:EXEC KEYB
340 ENDPROC
350 ------------------------------
360 PROC PMOFF
370 POKE $D01D,%0:FOR T=$D00D TO $D011:POKE T,%0:NEXT T
380 ENDPROC
390 PROC CLL:POKE UBZ,%0:MOVE UBZ,UBZ+%1,39:POSITION %0,12:ENDPROC
400 ------------------------------
410 PROC DCOMP
420 MOVE LR,P6,BM:NN=USR(EMS,%3,LR+BM):A=USR(EMS,%0)
430 Q=255-NN-BM:EXEC TRI:POSITION 30,%0:? Q$
440 FOR T=PMC TO PMC+19:POKE T,8:NEXT T
450 ENDPROC
460 ------------------------------
470 PROC SCOMP
480 MOVE LR,P6,BM:NN=USR(EMS,%2,LR+BM)
490 Q=255-NN-BM:EXEC TRI:POSITION 30,%0:? Q$;:MOVE P6,LR,BM
500 ENDPROC
510 ------------------------------
520 PROC K_INIT
530 POSITION %1,%0:? "X: 00.0 Y: 00.0"
540 EXEC K_PRINT
550 ENDPROC
560 ------------------------------
570 PROC K_WEG
580 POSITION %1,%0:? "Electro Maniac! "
590 ENDPROC
600 ------------------------------
610 PROC K_PRINT
620 IF CUR=%1:Q=XP+1:Q2=%0
630 ELSE :Q=INT((XP-48)/8):Q2=XP-48-Q*8:Q=Q+1
640 ENDIF :EXEC TWO:POSITION 4,0:? Q$;".";Q2
650 IF CUR=%1:Q=YP+%1:Q1=%0
660 ELSE :IF CUR=%3:Q=2*(Z(YP)-(Z(YP)>9)*10)+%3:Q2=%0
670 ELSE :Q=INT((YP-15)/8):Q2=YP-15-Q*8
680 ENDIF :ENDIF :EXEC TWO:POSITION 13,0:? Q$;".";Q2;
690 ENDPROC
700 ------------------------------
710 PROC KEYB:U=%0:L=%0:R=%0:D=%0:B=%0:E=%0
720 KB=%0:ST=%0:BT=%0:POKE 77,%0:POKE 20,%0
730 REPEAT :A=PEEK(20) MOD 32>16
740 IF PEEK(764)<>255 THEN GET KB:E=(KB=27)
750 IF STRIG(%0)=%0 OR PEEK(53279)=6 THEN BT=%1
760 IF STICK(%0)<>15 THEN ST=STICK(%0) EXOR 15
770 U=(KB=28) OR (KB=45) OR (KB=95) OR (ST&1)
780 L=(KB=30) OR (KB=43) OR (KB=92) OR (ST&4)
790 R=(KB=31) OR (KB=42) OR (KB=94) OR (ST&8)
800 D=(KB=29) OR (KB=61) OR (KB=124) OR (ST&%2)
810 B=BT OR (KB=155)
820 IF H:DX=L!R*(DX+R*(DX<4)-L*(DX>-4))
830 DY=U!D*(DY+D*(DY<4)-U*(DY>-4))
840 ENDIF
850 IF CUR=%0 THEN POKE 755,(%1-A)*%2
860 IF CUR=%1 THEN POKE CPOS,A*CORG+(NOT A)*16:PAUSE %1
870 IF CUR=%2 THEN POKE STB,PEEK(STB)!(L*4)&(7-(R*4))!A&(6+A)
880 IF CUR=%3 THEN POKE PMC+Z(YP),12-A*10:POKE PMX+Z(YP),XP:PAUSE %1
890 UNTIL U OR L OR R OR D OR B OR E
900 IF CUR=%0 THEN POKE 755,%2
910 IF CUR=%1 THEN POKE CPOS,CORG
920 IF CUR=%2 THEN POKE STB,PEEK(STB)&6
930 IF CUR=%3 THEN POKE PMC+Z(YP),12
940 ENDPROC
950 ------------------------------
960 PROC LEVEL
970 X1=LN:X2=1:X3=64:EXEC GETNUMBER
980 IF NOT E THEN LN=Q:L$=Q$:POSITION 26,0:? L$;
990 FN$="D:EMANIAC.L":FN$(12)=L$
1000 ENDPROC
1010 ------------------------------
1020 PROC TWO:Q$="00":Q=Q*(Q>%0)
1030 Q$(%3-LEN(STR$(Q)))=STR$(Q)
1040 ENDPROC
1050 PROC TRI:Q$="000":Q=Q*(Q>%0)
1060 Q$(4-LEN(STR$(Q)))=STR$(Q)
1070 ENDPROC
1080 ------------------------------
1090 PROC GETNUMBER:Q=X1:B=%0:E=%0
1100 WHILE NOT (B!E):Q=Q+U!R-D!L
1110 Q=Q+(Q<X2)-(Q>X3):Q$="00":Q$(1+(Q<10))=STR$(Q)
1120 DPOKE UBZ+37,(DPEEK(ADR(Q$))-$2020)!$8080:EXEC KEYB
1130 WEND
1140 ENDPROC
1150 ------------------------------
1160 PROC INITLE:POKE 731,%1
1170 A=USR(EMS,255):EXEC KEYB
1180 FOR T=%0 TO MANZ:M(T)=%1:NEXT T
1190 FOR T=690 TO 693:POKE T,%0:NEXT T
1200 RESTORE #CD:FOR T=%0 TO 15:READ A:C(T)=A:NEXT T
1210 # CD:DATA 0,0,0,64,0,0,64,128,192,192,64,192,192,192,192,64
1220 POKE 87,%0:EXEC CLEARLE
1230 POKE 729,6:POKE 752,%1
1240 ENDPROC
1250 PROC TITLE:POSITION %0,%0
1260 ? " Electro Maniac! Level ";L$;": 000 frei ";:EXEC SCOMP
1270 ENDPROC
1280 ------------------------------
1290 PROC CLEARLE
1300 S=OBZ:L=520:EXEC CLRAM
1310 S=LR:L=256:EXEC CLRAM
1320 S=P6:L=256:EXEC CLRAM
1330 POKE LR,128:POKE LR+%1,128
1340 A=USR(EMS,%0):EXEC TITLE:EXEC SCOMP
1350 ENDPROC
1360 PROC CLRAM:POKE S,%0:MOVE S,S+%1,L-%1:ENDPROC
1370 ------------------------------
1380 PROC ITEM:P=%0:EXEC CLL:? T$;
1390 FOR A=BSS TO LEN(T$)-%1
1400 IF T$(A,A)=" " AND T$(A+%1,A+%1)<>" " THEN P=P+%1:P(P)=A+%1
1410 NEXT A:P(%0)=P:I=M(M):SR=DPEEK(88)+40+22*20:EXEC ITEMI
1420 REPEAT :EXEC KEYB:EXEC ITEMN
1430 I=I+R-L:I=I+(I=%0)*P(%0)-(I=P(%0)+%1)*P(%0):EXEC ITEMI
1440 UNTIL E OR B:M(M)=I:BSS=%1:I=I*B
1450 ENDPROC
1460 PROC ITEMI:A=SR+P(I)-%1
1470 REPEAT :POKE A,PEEK(A)!$80:A=A+%1:UNTIL PEEK(A)=%0
1480 ENDPROC
1490 PROC ITEMN:A=SR+P(I)-%1
1500 REPEAT :POKE A,PEEK(A)&$7F:A=A+%1:UNTIL PEEK(A)=%0
1510 ENDPROC
1520 ------------------------------
1530 PROC AUTOR
1540 POKE $06AE,%0:POKE $06B0,%0:POKE $06AD,%1
1550 MOVE $B0DF,UBZ,40:PAUSE 10:EXEC KEYB
1560 ENDPROC
1570 ------------------------------
1580 PROC DISK
1590 REPEAT
1600 T$=" Load Save Directory Linker Men< ":M=%1:EXEC ITEM
1610 ON I EXEC LOAD,SAVE,DIR,LINK:EXEC DCOMP
1620 UNTIL I=5 OR I=%0 OR E
1630 ENDPROC
1640 ------------------------------
1650 PROC LOAD:EXEC CLL:CLOSE
1660 ? " Level laden. Nummer: ";:EXEC LEVEL:EXEC PMOFF
1670 IF NOT E
1680 OPEN #%1,4,%0,FN$:GET #1,NN
1690 BGET #%1,LR,NN+BM:CLOSE :E=%1
1700 ENDIF
1710 ENDPROC
1720 ------------------------------
1730 PROC SAVE
1740 EXEC SCOMP:EXEC CLL:CLOSE
1750 ? " Level speichern. Nummer: ";:EXEC LEVEL:EXEC PMOFF
1760 IF NOT E
1770 OPEN #%1,8,%0,FN$:PUT #%1,NN
1780 BPUT #%1,LR,NN+BM:CLOSE
1790 ENDIF
1800 ENDPROC
1810 ------------------------------
1820 PROC DIR:NOF=%0:EXEC PMOFF:CLOSE #1
1830 OPEN #%1,6,%0,"D:EMANIAC.L*":INPUT #%1,FN$
1840 WHILE FN$(%2,%2)=" ":NOF=NOF+%1
1850 FNB$(NOF*%2-%1)=FN$(12,13):INPUT #%1,FN$
1860 WEND :CLOSE #1
1870 IF NOF
1880 IF NOF>%1:TT=NOF-%1
1890 REPEAT :CHA=%0
1900 FOR T=%1 TO TT
1910 A=(T-%1)*%2+%1:B=T*%2:C=B+%1:D=(T+%1)*%2
1920 IF FNB$(A,B)>FNB$(C,D)
1930 FN$=FNB$(A,B):FNB$(A,B)=FNB$(C,D)
1940 FNB$(C,D)=FN$:CHA=%1
1950 ENDIF
1960 NEXT T:TT=TT-%1
1970 UNTIL NOT CHA
1980 ENDIF
1990 IF NOT FLAG:EXEC DCOMP:T=%0
2000 WHILE T<NOF:EXEC CLL:? " ";:TT=%0
2010 WHILE TT<12 AND T<NOF:TT=TT+%1:T=T+%1
2020 ? FNB$(T*%2-%1,T*%2);" ";
2030 WEND :POSITION 37,12:? "*+";:EXEC KEYB:PAUSE 10
2040 WEND
2050 ENDIF
2060 ELSE :EXEC CLL:? " Keine Level-Dateien vorhanden! *+";
2070 EXEC KEYB:ENDIF
2080 ENDPROC
2090 ------------------------------
2100 PROC SETZEN
2110 REPEAT :T$=" Setze: Tr=ger Monster Bobby Stein Men< "
2120 BSS=8:M=%2:EXEC ITEM
2130 ON I EXEC SETIT,SETIT,SETBOB,SETST
2140 UNTIL I=5 OR I=%0
2150 ENDPROC
2160 ------------------------------
2170 PROC SETIT:MS=%2*(I=%1)
2180 BX=128:Z=%0:OLD_RL=%0
2190 FOR T=%0 TO 9
2200 IF PEEK(PMX+T)=%0:Z(Z)=T:Z=Z+%1
2210 ELSE :IF PEEK(PMX+T+10)=%0 THEN Z(Z)=T+10:Z=Z+%1
2220 ENDIF
2230 NEXT T:EXEC CLL
2240 IF Z:YP=%0:H=%1
2250 ? " Startposition: #$%& setzen *+";
2260 XP=128:X3=48:X4=200:V=%1:RL=%0:EXEC GETPOS:BX=XP:RLS=RL
2270 EXEC K_WEG:EXEC CLL:? " Geschwindigkeit: %&";
2280 X1=16:X2=%0:X3=31:EXEC GETNUMBER:SP=Q*8:IF E THEN GO# ESCAPE
2290 IF SP
2300 EXEC CLL:? " Rechte Wendemarke: %& setzen: *+";
2310 XP=201:X3=BX+%1:X4=XP:V=%0:RL=%0:EXEC GETPOS:XR=XP
2320 EXEC CLL:? " Linke Wendemarke: %& setzen: *+";
2330 XP=47:X3=XP:X4=BX-%1:V=%0:RL=%1:EXEC GETPOS:XL=XP
2340 ELSE :XR=%0:XL=%0
2350 ENDIF
2360 # ESCAPE:FOR A=%0 TO Z-%1:POKE PMS+Z(A),%0
2370 POKE PMX+Z(A),%0:POKE PMC+Z(A),%0
2380 NEXT A
2390 IF NOT E
2400 POKE PMX+Z(YP),BX:POKE PMS+Z(YP),MS!SP!RLS
2410 POKE WPR+Z(YP),XR:POKE WPL+Z(YP),XL
2420 IF NOT MS THEN POKE NOMSTR,PEEK(NOMSTR)+1
2430 MOVE P6,LR,85
2440 ENDIF :EXEC K_WEG:EXEC DCOMP
2450 ELSE :EXEC CLL
2460 ? " Schon alle m;glichen Pl=tze belegt! *+";:EXEC KEYB
2470 ENDIF
2480 ENDPROC
2490 ------------------------------
2500 PROC GETPOS
2510 CUR=%3:EXEC PM_ON:EXEC K_INIT:EXEC KEYB
2520 WHILE NOT (B!E):RL=RL!L&(1-R)
2530 IF H:IF NOT MS AND OLD_RL<>RL AND V THEN EXEC PM_ON
2540 XP=XP+DX:T=(XP<X3)-(XP>X4)
2550 IF T THEN XP=XP+(X4-X3+1)*T:DX=%0
2560 ENDIF
2570 IF V AND U!D:POKE PMC+Z(YP),%0
2580 POKE PMX+Z(YP),%0:YP=YP+D-U
2590 YP=YP+Z*((YP=-%1)-(YP=Z))
2600 ENDIF :EXEC K_PRINT:EXEC KEYB
2610 WEND :CUR=%0
2620 IF E THEN POP :GO# ESCAPE
2630 ENDPROC
2640 ------------------------------
2650 PROC PM_ON
2660 FOR A=%0 TO Z-%1
2670 POKE PMS+Z(A),RL!MS
2680 NEXT A:A=USR(EMS,%0)
2690 OLD_RL=RL:DX=%0
2700 ENDPROC
2710 ------------------------------
2720 PROC SETST
2730 T$=" Nix Men< ":XP=6:YP=22
2740 FOR T=%1 TO 15:T$(T*%2+4,T*%2+5)=CHR$(T):NEXT T:M=6
2750 CUR=%1:EXEC K_INIT
2760 REPEAT
2770 IF YP<22 AND E=%0:CPOS=XP+YP*20+MBZ:CORG=PEEK(CPOS)
2780 EXEC KEYB:XP=XP+R-L:YP=YP+D-U
2790 XP=XP+(XP=-%1)*20-(XP=20)*20
2800 YP=YP+(YP=-%1)*22:EXEC K_PRINT
2810 IF B THEN POKE CPOS,C:EXEC SCOMP:IF NN+BM>255 THEN EXEC ERROR2
2820 ELSE :CUR=%0:EXEC ITEM:EE=E
2830 IF I AND I<17 THEN C=(I-%1)!C(I-1):YP=YP-B*(YP=22)
2840 CUR=%1:EXEC K_PRINT:PAUSE B*10
2850 ENDIF
2860 UNTIL (I=17 AND B) OR EE:CUR=%0
2870 EXEC K_WEG
2880 ENDPROC
2890 PROC ERROR2:EXEC CLL:CUR=%0
2900 ? " WARNUNG: Bildschirmspeicher voll! *+";:EXEC KEYB:CUR=%1:EXEC CLL
2910 ? T$;:POKE CPOS,CORG:EXEC SCOMP
2920 ENDPROC
2930 ------------------------------
2940 PROC SETBOB:XP=PEEK(P6):YP=PEEK(P6+%1):EXEC K_INIT
2950 EXEC CLL:? " Bobby Startposition: #$%&, setzen: *+";:CUR=%2:H=%1:EXEC KEYB
2960 WHILE NOT (B!E)
2970 XP=XP+DX:YP=YP+DY
2980 XP=XP+((XP<47)-(XP>200))*154
2990 YP=YP+((YP<25)-(YP>191))*167
3000 DPOKE P6,XP+YP*256
3010 EXEC K_PRINT:EXEC KEYB
3020 WEND :CUR=%0:H=%0:MOVE P6,LR,%3:EXEC K_WEG
3030 ENDPROC
3040 ------------------------------
3050 PROC LOESCHEN
3060 T$=" L;sche: Tr=ger Monster Bild Men< ":BSS=9:M=%3:EXEC ITEM
3070 ON I EXEC DELIT,DELIT,DELPIC
3080 ENDPROC
3090 ------------------------------
3100 PROC DELIT:MS=%2*(I=%1):Z=%0
3110 FOR T=0 TO 19
3120 IF (PEEK(PMS+T)&%2=MS) AND (PEEK(PMX+T)<>%0) THEN Z(Z)=T:Z=Z+%1
3130 NEXT T:EXEC CLL
3140 IF Z:? " Objekt ausw=hlen: #$, l;schen: *+";:YP=%0
3150 REPEAT
3160 C=PEEK(PMC+Z(YP)):XP=PEEK(PMX+Z(YP))
3170 CUR=%3:EXEC KEYB:CUR=%0
3180 POKE PMC+Z(YP),C:YP=YP+D-U
3190 YP=YP+Z*((YP=-%1)-(YP=Z))
3200 UNTIL B OR E
3210 IF NOT E:POKE PMC+Z(YP),%0
3220 POKE PMX+Z(YP),%0:POKE PMS+Z(YP),%0
3230 POKE WPL+Z(YP),%0:POKE WPR+Z(YP),%0
3240 IF NOT MS THEN POKE NOMSTR,Z-%1
3250 MOVE P6,LR,85
3260 ENDIF
3270 ELSE :? " Nichts zum l;schen vorhanden! *+";:EXEC KEYB
3280 ENDIF
3290 ENDPROC
3300 ------------------------------
3310 PROC DELPIC
3320 EXEC CLL:T$=" Bild wirklich l;schen? Nein Ja":BSS=24:M=5:EXEC ITEM
3330 IF I=%2 THEN EXEC CLEARLE
3340 ENDPROC
3350 ------------------------------
3360 PROC TESTEN
3370 EXEC DCOMP:A=USR(EMS,%1):EXEC CLL:? " Mit *+ zur<ck zum Level-Editor...";
3380 EXEC KEYB:EXEC DCOMP:EXEC TITLE
3390 ENDPROC
3400 ------------------------------
3410 PROC ENDE
3420 EXEC CLL:T$=" Editor wirklich verlassen? Nein Ja":BSS=29:M=4:EXEC ITEM
3430 IF I=%2
3440 POKE 106,$9B:GRAPHICS %0:EXEC PMOFF
3450 POKE 710,%0:POKE 82,%0:POKE 729,10:END
3460 ENDIF
3470 ENDPROC
3480 ------------------------------
3490 PROC LINK:LEHEAD=$5000
3500 POSITION 17,%0:? " Level-Linker 1.0 "
3510 DN=%0:LBP=%0:LB=ADR(LB$):MLOK=%0
3520 REPEAT :DN=DN+%1:EXEC CLL
3530 EXEC PROMT:SDDD=%0
3540 FLAG=%1:EXEC DIR:FLAG=%0:*F
3550 FOR TT=%1 TO NOF
3560 IF LBL-LBP<256 THEN EXEC WBUFFER:EXEC PROMT
3570 FN$="D:EMANIAC.L":FN$(12)=FNB$(TT*%2-%1,TT*%2)
3580 CLOSE #%1:OPEN #%1,4,%0,FN$:GET #1,NN
3590 POKE LB+LBP,NN+BM+%1:BGET #1,LB+LBP+1,NN+BM:CLOSE #1
3600 LBP=LBP+NN+BM+1
3610 IF LBP+$5000>$9B00:EXEC CLL
3620 ? " Speicher voll! Linken wird beendet ... ";
3630 POP :POP :EXEC KEYB:GO# SVOLL
3640 ENDIF
3650 NEXT TT
3660 T$=" Andere Level-Disk linken? Nein Ja":BSS=27:M=9:EXEC ITEM
3670 UNTIL I=%1
3680 # SVOLL:IF LBP THEN EXEC WBUFFER
3690 DPOKE P6,LEHEAD:DPOKE P6+2,LEHEAD:POKE P6+4,%0:BPUT #2,P6,5
3700 DPOKE 738,$9DDB:EXEC PH:CLOSE :EXEC TITLE
3710 ENDPROC
3720 ------------------------------
3730 PROC PH:READ VON,BIS
3740 DPOKE P6,VON:DPOKE P6+%2,BIS
3750 BPUT #2,P6,4:BPUT #2,VON,BIS-VON+%1
3760 ENDPROC
3770 ------------------------------
3780 PROC PROMT:EXEC CLL
3790 ? " Bitte ";DN;". Quelldiskette einlegen! *+";:EXEC KEYB
3800 ENDPROC
3810 ------------------------------
3820 PROC WBUFFER
3830 EXEC CLL:? " Bitte Zieldiskette einlegen! *+";:EXEC KEYB
3840 IF NOT MLOK:CLOSE #2:OPEN #2,8,0,"D:EMANIAC.EXE"
3850 RESTORE #HEADER:PUT #2,255:PUT #2,255:DPOKE 738,39939
3860 FOR T=1 TO 3:EXEC PH
3870 NEXT T:MLOK=%1
3880 # HEADER:DATA 39936,40317,738,739,40318,45700,738,739
3890 ENDIF
3900 DPOKE P6,LEHEAD:DPOKE P6+%2,LEHEAD+LBP-%1:BPUT #2,P6,4
3910 BPUT #2,LB,LBP
3920 LEHEAD=LEHEAD+LBP
3930 LBP=%0
3940 ENDPROC
|
|
Stefan C. Müller
www.ElectroManiac.de
|
|
