home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / DATABASE / DIMS103.ARK / DDOC.ASC < prev    next >
Text File  |  1986-12-07  |  2KB  |  102 lines
  1. 1000 E$="DIMS doc command March 20, 1982
  2. 1005 'by Dan Dugan -- public domain
  3. 1010 DEFINT A-Z
  4. 1020 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  5.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  6.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  7. 1030 CLOSE 2    'N.B. DOC USES TWO FILES, #2 AND #3.  IT RE-OPENS 2 AT END.
  8. 1040 GOTO 1080
  9. 1050 '
  10.  
  11.  
  12.                 (SUB) CLEAR SCREEN (TERM DEP)
  13.  
  14. 1060 PRINT CHR$(12);
  15. 1065 PRINT E$
  16. 1070 RETURN
  17. 1080 '
  18.  
  19.  
  20.                 DOCUMENT COMMAND
  21.  
  22. 1090 GOSUB 1050 'cs
  23. 1100 PRINT"'" F$"' document file
  24. 1110 PRINT:PRINT"Do you want to write (1) read (2) or finish (3) ";
  25. 1120 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="1"
  26. 1130 PRINT A$
  27. 1140 A=VAL(A$): IF A<1 OR A>3 THEN 1110
  28. 1150 ON A GOTO 1170,1430,1640
  29. 1160 GOTO 1110
  30. 1170 '
  31.  
  32.                 DOC WRITE
  33.  
  34. 1180 GOSUB 1050 'cs
  35. 1190 ON ERROR GOTO 1230
  36. 1200 OPEN"I",3,DD$(5)+F$+".DOC"
  37. 1210 ON ERROR GOTO 1610
  38. 1220 GOTO 1250
  39. 1230    IF ERR=53 AND ERL=1200 THEN OPEN"O",2,DD$(5)+"DOC.$$$":
  40.     ON ERROR GOTO 1610:RESUME 1320 '        fix
  41. 1240    ON ERROR GOTO 0
  42. 1250 OPEN"O",2,DD$(5)+"DOC.$$$"
  43. 1260 IF EOF(3) THEN 1300
  44. 1270    LINE INPUT#3,L$
  45. 1280    PRINT#2,L$
  46. 1290 GOTO 1260
  47. 1300 CLOSE 3
  48. 1310 KILL DD$(5)+F$+".DOC"
  49. 1320 PRINT"Writing on "F$" document file
  50. 1330 PRINT
  51. 1340 PRINT"Type 'stop' to finish
  52. 1350 PRINT
  53. 1360 LINE INPUT L$
  54. 1370    IF L$="stop" THEN 1400
  55. 1380    PRINT #2,L$
  56. 1390 GOTO 1360
  57. 1400 CLOSE 2,3
  58. 1410 NAME DD$(5)+"DOC.$$$" AS DD$(5)+F$+".DOC"
  59. 1420 GOTO 1110
  60. 1430 '
  61.  
  62.                 DOC READ
  63.  
  64. 1440 ON ERROR GOTO 1470
  65. 1450 OPEN"I",3,DD$(5)+F$+".DOC"
  66. 1460 ON ERROR GOTO 1610: GOTO 1490
  67. 1470    IF ERR=53 THEN CLOSE 3:
  68.         PRINT:PRINT"No document file present":
  69.         ON ERROR GOTO 1610:RESUME 1110
  70. 1480    ON ERROR GOTO 1610
  71. 1490 GOSUB 1050 'cs
  72. 1500 PRINT: PRINT "'"F$"' document file
  73. 1510 PRINT
  74. 1520 FOR I=1 TO 20
  75. 1530    IF EOF(3) THEN CLOSE 3: GOTO 1110
  76. 1540    LINE INPUT #3, L$
  77. 1550    PRINT L$
  78. 1560 NEXT I
  79. 1570 PRINT"(more)";
  80. 1580 '
  81.                 PAUSE
  82. 1582 X$=INPUT$(1)
  83. 1584 IF X$=CHR$(27) THEN 1640    'exit
  84. 1590 PRINT
  85. 1600 GOTO 1520
  86. 1610 '
  87.  
  88.                 GENERAL ERROR
  89.  
  90. 1620 IF ERR=61 THEN PRINT:PRINT"Out of disk space.":PRINT:RESUME 1110
  91. 1630 ON ERROR GOTO 0
  92. 1640 '
  93.  
  94.                 FINISH
  95.  
  96. 1645 CLOSE 2,3            'make sure
  97. 1650 OPEN"R",2,DD$(4)+F$+".DD"+FT$
  98. 1660 FIELD #2,128 AS S$
  99. 1670 PRINT:PRINT"Re-loading DIMS file editor (DEDIT).":CHAIN"DEDIT",1000
  100. N"R",2,DD$(4)+F$+".DD"+FT$
  101. 1660 FIELD #2,128 AS S$
  102. 1670 PRINT:PRINT"Re-loading DIMS file editor (D