home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / basic / adven-80.ark / ADVEN-80.BAS next >
Encoding:
BASIC Source File  |  1986-11-22  |  6.9 KB  |  178 lines
  1. 10 PRINT:PRINT:PRINT:PRINT:
  2. 20 PRINT"****ADVEN-80.BAS an ADVENTURE data base conversion utility ***"
  3. 30 PRINT".......version 9/7/83........................................"
  4. 40 DEFINT A-Z
  5. 50 CPM=0
  6. 60 PRINT
  7. 70 INPUT "Enter name of Database File (assumed ext .DAT)";FC$
  8. 80 IF FC$="" THEN PRINT "Invalid name";GOTO 70
  9. 90 IF INSTR(FC$,".")=0 THEN 110
  10. 100 FC$=LEFT$(FC$,INSTR(FC$,".")-1)
  11. 110 F$=FC$+".DAT"
  12. 120 MC$=FC$+".MAC"
  13. 130 TEST=0
  14. 140 PRINT "Input file = ";F$
  15. 150 PRINT "Output file = ";MC$
  16. 160 PRINT
  17. 170 OPEN "I",1,F$
  18. 180 OPEN "O",2,MC$
  19. 200 PRINT#2,".Z80"
  20. 210 PRINT#2,".PRINTX *COMPILING A DATABASE FOR ";F$;" SYSTEM*"
  21. 220 PRINT #2,"; ADVENTURE Z80 DATABASE SYSTEM"
  22. 230 PRINT #2,"; This file called ";MC$
  23. 231 READ W$:IF W$<>"EOF" THEN PRINT #2,W$:GOTO 231
  24. 240 REM
  25. 250 LINE INPUT #1,Q$
  26. 260 GOSUB 1580
  27. 270 IF Q$="" THEN 250
  28. 280 IF LEFT$(Q$,1)=" " THEN Q$=MID$(Q$,2):GOTO 280
  29. 290 IF LEFT$(Q$,1)=CHR$(9) THEN Q$=MID$(Q$,2):GOTO 280
  30. 300 IF LEFT$(Q$,1)="*" THEN 250
  31. 310 REM
  32. 320 IF RIGHT$(Q$,1)=" " THEN Q$=LEFT$(Q$,LEN(Q$)-1):GOTO 320
  33. 330 IF LEFT$(Q$,6)="OBJLOC" THEN TEST=TEST+1:GOTO 450
  34. 340 IF LEFT$(Q$,6)="OBJDES" THEN TEST=TEST+2:GOTO 510
  35. 350 IF LEFT$(Q$,6)="MATCHW" THEN TEST=TEST+4:GOTO 540
  36. 360 IF LEFT$(Q$,3)="MSG"    THEN TEST=TEST+8:GOTO 640
  37. 370 IF LEFT$(Q$,5)="UMESS"  THEN TEST=TEST+16:GOTO 740
  38. 380 IF LEFT$(Q$,3)="LOC"    THEN TEST=TEST+32:GOTO 780
  39. 390 IF LEFT$(Q$,6)="TABKEY" THEN TEST=TEST+64:GOTO 870
  40. 400 IF LEFT$(Q$,5)="TITL1"  THEN TEST=TEST+128:GOTO 1100
  41. 410 IF LEFT$(Q$,4)="FLAG"   THEN TEST=TEST+256:GOTO 1170
  42. 415 IF LEFT$(Q$,6)="OBJDSK" THEN TEST=TEST+512:GOTO 1261
  43. 416 IF LEFT$(Q$,6)="OBPROP" THEN TEST=TEST+1024:GOTO 1091
  44. 420 IF LEFT$(Q$,8)="ENDGAME" AND TEST=2047 THEN PRINT"[EOF] ALL CORRECT":GOTO 1620
  45. 430 IF LEFT$(Q$,8)<>"ENDGAME" THEN PRINT "BAD LINE":PRINT Q$:CLOSE:GOTO 1620
  46. 440 PRINT "MISSING SECTION MET AT END OF GAME":CLOSE:GOTO 1620
  47. 450 PRINT"Processing OBJLOC table."
  48. 460 PRINT #2,"OBJLOC:";
  49. 470 GOSUB 1480
  50. 480 IF LEFT$(Q$,8)="ENDTABLE" THEN PRINT #2," DEFB 00,00":GOTO 250
  51. 485 MID$(Q$,INSTR(Q$," "),1)=","
  52. 490 PRINT#2," DEFB ";Q$
  53. 500 GOTO 470
  54. 510 PRINT "Processing OJBDES table."
  55. 520 PRINT#2,"OBJDES:";
  56. 530 GOTO 470
  57. 540 PRINT"Processing MATCHW table."
  58. 550 PRINT#2,"MATCHW:";
  59. 560 GOSUB 1480
  60. 570 IF LEFT$(Q$,8)="ENDTABLE" THEN GOTO 480
  61. 580 IF Q$="MATCHALL" THEN PRINT#2," DEFB 255,255":GOTO 560
  62. 590 IF LEFT$(Q$,5)<>"MATCH" AND LEFT$(Q$,4)<>"TEST" THEN 610
  63. 600 PRINT#2," DEFB ";MID$(Q$,INSTR(Q$," ")+1):GOTO 560
  64. 610 IF LEFT$(Q$,6)<>"ACTION" THEN CLOSE:PRINT"COND/ACTION FAULT":PRINT Q$:GOTO 1620
  65. 620 PRINT#2," DEFB 255,";MID$(Q$,INSTR(Q$," ")+1);",255"
  66. 630 GOTO 560
  67. 640 PRINT"Processing MSG table."
  68. 650 PRINT#2,"MSG:";
  69. 660 WE$="MES"
  70. 670 GOSUB 1480
  71. 680 IF LEFT$(Q$,8)="ENDTABLE" THEN GOTO 480
  72. 690 IF LEFT$(Q$,1)<>"'" THEN 710
  73. 700 PRINT#2," DEFB ";Q$:GOTO 670
  74. 710 PRINT#2," DEFB 00"
  75. 720 PRINT#2," DEFB ";MID$(Q$,INSTR(Q$," ")+1)
  76. 730 GOTO 670
  77. 740 PRINT"Processing UMESS table."
  78. 750 PRINT#2,"UMESS:";
  79. 760 WE$="UMES"
  80. 770 GOTO 670
  81. 780 PRINT"Processing LOC table."
  82. 790 PRINT#2,"LOC:";
  83. 800 GOSUB 1480
  84. 810 IF LEFT$(Q$,8)="ENDTABLE" THEN GOTO 480
  85. 820 IF LEFT$(Q$,1)<>"'" THEN 840
  86. 830 PRINT#2," DEFB ";Q$:GOTO 800
  87. 840 PRINT#2," DEFB 00"
  88. 850 PRINT#2," DEFB ";MID$(Q$,INSTR(Q$," ")+1);",255"
  89. 860 GOTO 800
  90. 870 PRINT"Processing TABKEY table."
  91. 880 CNT=0
  92. 890 PRINT#2,"TABKEY:"
  93. 900 GOSUB 1480
  94. 910 IF LEFT$(Q$,8)="ENDTABLE" THEN 1030
  95. 920 IF INSTR(Q$," ")=0 THEN CNT=CNT+1:PRINT#2,Q$;" EQU ";CNT:GOTO 900
  96. 930 Q1$=LEFT$(Q$,INSTR(Q$," ")-1)
  97. 940 Q$=MID$(Q$,INSTR(Q$," ")+1)
  98. 950 IF LEFT$(Q$,1)=" " THEN Q$=MID$(Q$,2):GOTO 950
  99. 960 CNT=CNT+1
  100. 970 PRINT#2,Q1$;" EQU ";CNT
  101. 980 PRINT#2," DEFB ";CNT
  102. 990 IF LEFT$(Q$,1)="'" AND RIGHT$(Q$,1)="'" THEN 1010
  103. 1000 CLOSE:PRINT"INCORRECT KEYS ";Q$:GOTO 1620
  104. 1010 PRINT#2," DC ";Q$
  105. 1020 GOTO 900
  106. 1030 PRINT#2,"THEN EQU 250":PRINT#2," DEFB 250"
  107. 1040 PRINT#2," DC 'THENAND ALSO'"
  108. 1050 PRINT#2,"IT EQU 251":PRINT#2," DEFB 251"
  109. 1060 PRINT#2," DC 'IT  THEM'"
  110. 1070 PRINT#2," AGAIN EQU 252":PRINT#2," DEFB 252"
  111. 1080 PRINT#2," DC 'AGAIREPE'"
  112. 1090 GOTO 480
  113. 1091 PRINT"Processing OBPROP table."
  114. 1092 PRINT#2,"OBPROP:";
  115. 1093 GOTO 1263
  116. 1100 PRINT"Processing TITL1 table."
  117. 1110 PRINT#2,"TITL1:";
  118. 1120 GOSUB 1480
  119. 1130 IF LEFT$(Q$,8)="ENDTABLE" THEN GOTO 480
  120. 1140 IF LEFT$(Q$,5)<>"CHR$(" THEN 1160
  121. 1150 Q$=MID$(Q$,6):Q$=LEFT$(Q$,LEN(Q$)-1)
  122. 1160 PRINT#2," DEFB ";Q$:GOTO 1120
  123. 1170 PRINT"Processing FLAG table."
  124. 1180 PRINT#2,"FLAG: DEFB 00"
  125. 1190 GOSUB 1480
  126. 1200 IF LEFT$(Q$,8)="ENDTABLE" THEN GOTO 480
  127. 1210 IF VAL(Q$)=0 THEN CLOSE:PRINT Q$:PRINT"INVALID FLAG":GOTO 1620
  128. 1220 IF LEFT$(Q$,2)="14" THEN PRINT#2,"FL14:";
  129. 1230 IF LEFT$(Q$,2)="20" THEN PRINT#2,"FL20:";
  130. 1240 IF LEFT$(Q$,2)="21" THEN PRINT#2,"FL21:";
  131. 1250 PRINT#2," DEFB ";MID$(Q$,INSTR(Q$," ")+1)
  132. 1260 GOTO 1190
  133. 1261 PRINT"Processing OBJDSK table."
  134. 1262 PRINT#2,"OBJDSK:";
  135. 1263 GOSUB 1480:IF LEFT$(Q$,1)<>"'" THEN PRINT#2," DEFB 00"
  136. 1265 IF LEFT$(Q$,8)="ENDTABLE" THEN GOTO 480
  137. 1266 MID$(Q$,INSTR(Q$," "),1)=","
  138. 1267 PRINT#2," DEFB ",Q$
  139. 1268 GOTO 1263
  140. 1270 DATA " PUBLIC OBJLOC"," PUBLIC OBJDES"
  141. 1271 DATA " PUBLIC MATCHW"," PUBLIC OBPROP"," PUBLIC OBJDSK"
  142. 1280 DATA " PUBLIC TITL1"," PUBLIC MSG"," PUBLIC UMESS"
  143. 1290 DATA " PUBLIC LOC"," PUBLIC TABKEY"," PUBLIC FLAG"
  144. 1300 DATA " PUBLIC FL14"," PUBLIC FL20"," PUBLIC FL21"
  145. 1310 DATA "RTN EQU 249","ANY EQU 255","INP EQU 00"
  146. 1320 DATA "NULL EQU 00","NORMAL EQU 255","NOEXIT EQU 254"
  147. 1330 DATA "DARK EQU 253","DARKNO EQU 252","CL EQU 1"
  148. 1340 DATA "NCL EQU 2","OP EQU 3","OC EQU 4","OW EQU 5"
  149. 1350 DATA "OWC EQU 6","OH EQU 7","ONP EQU 8","ONC EQU 9"
  150. 1360 DATA "ONW EQU 10","NWC EQU 11","ONH EQU 12","OE EQU 13"
  151. 1370 DATA "ONE EQU 14","@L EQU 15","N@L EQU 16","RND EQU 17"
  152. 1380 DATA "TF EQU 18","NTF EQU 19","GE EQU 20","LT EQU 21"
  153. 1390 DATA "C2 EQU 22","C3 EQU 23","NC2 EQU 24","NC3 EQU 25"
  154. 1400 DATA "INV EQU 1","TKE EQU 2","WR EQU 3","DR EQU 4"
  155. 1410 DATA "PR EQU 5","PRM EQU 6","DL EQU 7","SF EQU 8"
  156. 1420 DATA "DSCOB EQU 9","SWP EQU 10","MV EQU 11","OK EQU 12","QT EQU 13"
  157. 1430 DATA "INF EQU 14","DEF EQU 15","EX EQU 16","SC EQU 17"
  158. 1440 DATA "PU EQU 18","CR EQU 19","DES EQU 20","FLIP EQU 21"
  159. 1450 DATA "LA EQU 22","SMA EQU 23","SMB EQU 24","WT EQU 25"
  160. 1460 DATA "PF EQU 26","ATF EQU 27","SFF EQU 28","GRUN EQU 29"
  161. 1470 DATA "EOF"
  162. 1480 LINE INPUT#1,Q$
  163. 1490 GOSUB 1580
  164. 1500 IF LEFT$(Q$,1)=" " THEN Q$=MID$(Q$,2):GOTO 1500
  165. 1510 IF LEFT$(Q$,1)=CHR$(9) THEN Q$=MID$(Q$,2):GOTO 1500
  166. 1520 IF LEFT$(Q$,1)="*" THEN 1480
  167. 1530 IF INSTR(Q$,CHR$(9))=0 THEN 1550
  168. 1540 Q$=LEFT$(Q$,INSTR(Q$,CHR$(9))-1)+" "+MID$(Q$,INSTR(Q$,CHR$(9))+1):GOTO 1530
  169. 1550 IF RIGHT$(Q$,1)=" " THEN Q$=LEFT$(Q$,LEN(Q$)-1):GOTO 1550
  170. 1560 IF Q$="" THEN 1480
  171. 1570 RETURN
  172. 1580 IF INSTR(Q$,"/*")=0 THEN RETURN
  173. 1590 IF INSTR(Q$,"*/")=0 THEN CLOSE:PRINT "BAD COMMENT":PRINT Q$:GOTO 1620
  174. 1600 Q$=LEFT$(Q$,INSTR(Q$,"/*")-1)+MID$(Q$,INSTR(Q$,"*/")+2)
  175. 1610 GOTO 1580
  176. 1620 PRINT"Returning to CP/M operating system."
  177. 1630 SYSTEM
  178.