10 REM MAKEADV.MBS - DR DOBBS JOURNAL #61, NOV. 1981
20 PRINT "*** MAKEADV - AN ADVENTURE DATABASE CONVERSION UTILITY ***"
30 CLEAR 1000
40 DEFINT A-Z
60 PRINT
70 INPUT "Enter name of Database file (assumed ext .ADV)";FC$
80 IF FC$="" THEN PRINT "INVALID NAME":GOTO 70
90 IF INSTR(FC$,".")=0 THEN 110
100 FC$=LEFT$(FC$,INSTR(FC$,".")-1)
110 F$=FC$+".ADV"
120 MC$=FC$+".MAC"
130 TEST=0
140 PRINT "INPUT FILE = ";F$
150 PRINT "OUTPUT FILE = ";MC$
160 PRINT
170 OPEN "I",1,F$
180 OPEN "O",2,MC$
200 PRINT#2,"; ADVENTURE Z80 DATABASE SYSTEM"
210 PRINT#2,"; Released into the public domain 1981 P. Scargill"
215 PRINT#2,"; --modification by Bill Soon, Nov. 1981"
220 PRINT#2,"; This file is called ";MC$
230 PRINT#2,"; for the Microsoft Mac80 assembler using /Z switch"
231 READ W$:IF W$<>"EOF" THEN PRINT#2,W$:GOTO 231
240 REM
250 LINE INPUT #1,Q$
260 GOSUB 1580
270 IF Q$="" THEN 250
280 IF LEFT$(Q$,1)=" " THEN Q$=MID$(Q$,2):GOTO 280
290 IF LEFT$(Q$,1)=CHR$(9) THEN Q$=MID$(Q$,2):GOTO 280
300 IF LEFT$(Q$,1)="*" THEN 250
310 REM
320 IF RIGHT$(Q$,1)=" " THEN Q$=LEFT$(Q$,LEN(Q$)-1):GOTO 320
330 IF LEFT$(Q$,6)="OBJLOC" THEN TEST=TEST+1:GOTO 450
340 IF LEFT$(Q$,6)="OBJDES" THEN TEST=TEST+2:GOTO 510
350 IF LEFT$(Q$,6)="MATCHW" THEN TEST=TEST+4:GOTO 540
360 IF LEFT$(Q$,3)="MSG" THEN TEST=TEST+8:GOTO 640
370 IF LEFT$(Q$,5)="UMESS" THEN TEST=TEST+16:GOTO 740
380 IF LEFT$(Q$,3)="LOC" THEN TEST=TEST+32:GOTO 780
390 IF LEFT$(Q$,6)="TABKEY" THEN TEST=TEST+64:GOTO 870
400 IF LEFT$(Q$,5)="TITL1" THEN TEST=TEST+128:GOTO 1100
410 IF LEFT$(Q$,4)="FLAG" THEN TEST=TEST+256:GOTO 1170
415 IF LEFT$(Q$,6)="OBJDSK" THEN TEST=TEST+512:GOTO 1261
416 IF LEFT$(Q$,6)="OBPROP" THEN TEST=TEST+1024:GOTO 1091
419 IF LEFT$(Q$,8)="ENDGAME" AND TEST=2047 THEN PRINT#2,"    END"
420 IF LEFT$(Q$,8)="ENDGAME" AND TEST=2047 THEN PRINT "[EOF] ALL CORRECT": CLOSE:GOTO 1620
430 IF LEFT$(Q$,8)<>"ENDGAME" THEN PRINT "BAD LINE":PRINT Q$:CLOSE:GOTO 1620
440 PRINT "MISSING SECTION MET AT END OF GAME":CLOSE:GOTO 1620
450 PRINT "PROCESSING OBJLOC TABLE"
460 PRINT#2,"OBJLOC:";
470 GOSUB 1480
480 IF LEFT$(Q$,8)="ENDTABLE" THEN PRINT#2," DEFB 00,00":GOTO 250
485 MID$(Q$,INSTR(Q$," "),1)=","
490 PRINT#2," DEFB ";Q$
500 GOTO 470
510 PRINT "PROCESSING OBJDES TABLE"
520 PRINT#2,"OBJDES:";
530 GOTO 470
540 PRINT "PROCESSING MATCHW TABLE"
550 PRINT#2,"MATCHW:";
560 GOSUB 1480
570 IF LEFT$(Q$,8)="ENDTABLE" THEN GOTO 480
580 IF Q$="MATCHALL" THEN PRINT#2," DEFB 255,255":GOTO 560
590 IF LEFT$(Q$,5)<>"MATCH" AND LEFT$(Q$,4)<>"TEST" THEN 610
600 PRINT#2," DEFB ";MID$(Q$,INSTR(Q$," ")+1):GOTO 560
610 IF LEFT$(Q$,6)<>"ACTION" THEN CLOSE:PRINT "COND/ACTION FAULT":PRINT Q$:GOTO 1620
620 PRINT#2," DEFB 255,"MID$(Q$,INSTR(Q$," ")+1);",255
630 GOTO 560
640 PRINT "PROCESSING MSG TABLE"
650 PRINT#2,"MSG:";
660 WE$="MES"
670 GOSUB 1480
680 IF LEFT$(Q$,8)="ENDTABLE" THEN GOTO 480
690 IF LEFT$(Q$,1)<>"'" THEN 710
700 PRINT#2," DEFB ";Q$:GOTO 670
710 PRINT#2," DEFB 00"
720 PRINT#2," DEFB ";MID$(Q$,INSTR(Q$," ")+1)
730 GOTO 670
740 PRINT "PROCESSING UMESS TABLE"
750 PRINT#2,"UMESS:";
760 WE$="UMES"
770 GOTO 670
780 PRINT "PROCESSING LOC TABLE"
790 PRINT#2,"LOC:";
800 GOSUB 1480
810 IF LEFT$(Q$,8)="ENDTABLE" THEN 480
820 IF LEFT$(Q$,1)<>"'" THEN 840
830 PRINT#2," DEFB ";Q$:GOTO 800
840 PRINT#2," DEFB 00"
850 PRINT#2," DEFB ";MID$(Q$,INSTR(Q$," ")+1);",255"
860 GOTO 800
870 PRINT "PROCESSING TABKEY TABLE"
880 CNT=0
890 PRINT#2,"TABKEY:"
900 GOSUB 1480
910 IF LEFT$(Q$,8)="ENDTABLE" THEN 1030
920 IF INSTR(Q$," ")=0 THEN CNT=CNT+1:PRINT#2,Q$;" EQU ";CNT:GOTO 900
930 Q1$=LEFT$(Q$,INSTR(Q$," ")-1)
940 Q$=MID$(Q$,INSTR(Q$," ")+1)
950 IF LEFT$(Q$,1)=" " THEN Q$=MID$(Q$,2):GOTO 950
960 CNT=CNT+1
970 PRINT#2,Q1$;" EQU ";CNT
980 PRINT#2,"  DEFB ";CNT
990 IF LEFT$(Q$,1)="'" AND RIGHT$(Q$,1)="'" THEN 1010
1000 CLOSE:PRINT "INCORRECT KEYS ";Q$:GOTO 1620
1010 Q1$=MID$(Q$,LEN(Q$)-1,1)
1012 Q$=LEFT$(Q$,LEN(Q$)-2)+"'"
1014 PRINT#2,"  DEFM ";Q$
1016 PRINT#2,"  DEFB '";Q1$;"'+80H"
1020 GOTO 900
1030 PRINT#2,"THEN DEFL 250":PRINT#2," DEFB 250"
1040 PRINT#2," DEFM 'THENAND ALS'"
1042 PRINT#2," DEFB 'O'+80H"
1050 PRINT#2,"IT DEFL 251":PRINT#2," DEFB 251"
1060 PRINT#2," DEFM 'IT  THE'"
1062 PRINT#2," DEFB 'M'+80H"
1070 PRINT#2,"AGAIN DEFL 252":PRINT#2," DEFB 252"
1080 PRINT#2," DEFM 'AGAIREP'"
1082 PRINT#2," DEFB 'E'+80H"
1090 GOTO 480
1091 PRINT "PROCESSING OBPROP TABLE"
1092 PRINT#2,"OBPROP:";
1093 GOTO 1263
1100 PRINT "PROCESSING TITL1 TABLE"
1110 PRINT#2,"TITL1:";
1120 GOSUB 1480
1130 IF LEFT$(Q$,8)="ENDTABLE" THEN 480
1140 IF LEFT$(Q$,5)<>"CHR$(" THEN 1160
1150 Q$=MID$(Q$,6):Q$=LEFT$(Q$,LEN(Q$)-1)
1160 PRINT#2," DEFB ";Q$:GOTO 1120
1170 PRINT "PROCESSING FLAG TABLE"
1180 PRINT#2,"FLAG: DEFB 00"
1190 GOSUB 1480
1200 IF LEFT$(Q$,8)="ENDTABLE" THEN 480
1210 IF VAL(Q$)=0 THEN CLOSE:PRINT Q$:PRINT "INVALID FLAG":GOTO 1620
1220 IF LEFT$(Q$,2)="14" THEN PRINT#2,"FL14:";
1230 IF LEFT$(Q$,2)="20" THEN PRINT#2,"FL20:";
1240 IF LEFT$(Q$,2)="21" THEN PRINT#2,"FL21:";
1250 PRINT#2," DEFB ";MID$(Q$,INSTR(Q$," ")+1)
1260 GOTO 1190
1261 PRINT "PROCESSING OBJDSK TABLE"
1262 PRINT#2,"OBJDSK:";
1263 GOSUB 1480:IF LEFT$(Q$,1)<>"'" THEN PRINT#2," DEFB 00"
1265 IF LEFT$(Q$,8)="ENDTABLE" THEN 480
1266 MID$(Q$,INSTR(Q$," "),1)=","
1267 PRINT#2," DEFB ";Q$
1268 GOTO 1263
1270 DATA "    .Z80","     DSEG"
1272 DATA " PUBLIC OBJLOC"," PUBLIC OBJDES", " PUBLIC MATCHW"
1274 DATA " PUBLIC OBPROP"," PUBLIC OBJDSK"
1280 DATA " PUBLIC TITL1"," PUBLIC MSG"," PUBLIC UMESS"
1290 DATA " PUBLIC LOC"," PUBLIC TABKEY"," PUBLIC FLAG"
1300 DATA " PUBLIC FL14"," PUBLIC FL20"," PUBLIC FL21"
1310 DATA "RTN DEFL 249","ANY DEFL 255","INP DEFL 00"
1320 DATA "NULL DEFL 00","NORMAL DEFL 255","NOEXIT DEFL 254"
1330 DATA "DARK DEFL 253","DARKNO DEFL 252","CL DEFL 1"
1340 DATA "NCL DEFL 2","OP DEFL 3","OC DEFL 4","OW DEFL 5"
1350 DATA "OWC DEFL 6","OH DEFL 7","ONP DEFL 8","ONC DEFL 9"
1360 DATA "ONW DEFL 10","NWC DEFL 11","ONH DEFL 12","OE DEFL 13"
1370 DATA "ONE DEFL 14","ZL DEFL 15","NZL DEFL 16","RND DEFL 17"
1380 DATA "TF DEFL 18","NTF DEFL 19","GES DEFL 20","LTS DEFL 21"
1390 DATA "C2 DEFL 22","C3 DEFL 23","NC2 DEFL 24","NC3 DEFL 25"
1400 DATA "INV DEFL 1","TKE DEFL 2","WR DEFL 3","DR DEFL 4"
1410 DATA "PR DEFL 5","PRM DEFL 6","DL DEFL 7","SF DEFL 8"
1420 DATA "DSCOB DEFL 9","SWP DEFL 10","MV DEFL 11","OK DEFL 12","QT DEFL 13"
1430 DATA "INF DEFL 14","DEF DEFL 15","EXTB DEFL 16","SC DEFL 17"
1440 DATA "PU DEFL 18","CR DEFL 19","DES DEFL 20","FLIP DEFL 21"
1450 DATA "LA DEFL 22","SMA DEFL 23","SMB DEFL 24","WT DEFL 25"
1460 DATA "PF DEFL 26","ATF DEFL 27","SFF DEFL 28","GRUN DEFL 29"
1470 DATA "EOF"
1480 LINE INPUT#1,Q$
1490 GOSUB 1580
1500 IF LEFT$(Q$,1)=" " THEN Q$=MID$(Q$,2):GOTO 1500
1510 IF LEFT$(Q$,1)=CHR$(9) THEN Q$=MID$(Q$,2):GOTO 1500
1520 IF LEFT$(Q$,1)="*" THEN 1480
1530 IF INSTR(Q$,CHR$(9))=0 THEN 1550
1540 Q$=LEFT$(Q$,INSTR(Q$,CHR$(9))-1)+" "+MID$(Q$,INSTR(Q$,CHR$(9))+1):GOTO 1530
1550 IF RIGHT$(Q$,1)=" " THEN Q$=LEFT$(Q$,LEN(Q$)-1):GOTO 1550
1560 IF Q$="" THEN 1480
1570 RETURN
1580 IF INSTR(Q$,"/*")=0 THEN RETURN
1590 IF INSTR(Q$,"*/")=0 THEN CLOSE:PRINT "BAD COMMENT":PRINT Q$:GOTO 1620
1600 Q$=LEFT$(Q$,INSTR(Q$,"/*")-1)+MID$(Q$,INSTR(Q$,"*/")+2)
1610 GOTO 1580
1620 PRINT "type SYSTEM to return to CP/M"
1630 END