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 >
Wrap
Text File
|
1986-12-07
|
2KB
|
102 lines
1000 E$="DIMS doc command March 20, 1982
1005 'by Dan Dugan -- public domain
1010 DEFINT A-Z
1020 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
1030 CLOSE 2 'N.B. DOC USES TWO FILES, #2 AND #3. IT RE-OPENS 2 AT END.
1040 GOTO 1080
1050 '
(SUB) CLEAR SCREEN (TERM DEP)
1060 PRINT CHR$(12);
1065 PRINT E$
1070 RETURN
1080 '
DOCUMENT COMMAND
1090 GOSUB 1050 'cs
1100 PRINT"'" F$"' document file
1110 PRINT:PRINT"Do you want to write (1) read (2) or finish (3) ";
1120 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="1"
1130 PRINT A$
1140 A=VAL(A$): IF A<1 OR A>3 THEN 1110
1150 ON A GOTO 1170,1430,1640
1160 GOTO 1110
1170 '
DOC WRITE
1180 GOSUB 1050 'cs
1190 ON ERROR GOTO 1230
1200 OPEN"I",3,DD$(5)+F$+".DOC"
1210 ON ERROR GOTO 1610
1220 GOTO 1250
1230 IF ERR=53 AND ERL=1200 THEN OPEN"O",2,DD$(5)+"DOC.$$$":
ON ERROR GOTO 1610:RESUME 1320 ' fix
1240 ON ERROR GOTO 0
1250 OPEN"O",2,DD$(5)+"DOC.$$$"
1260 IF EOF(3) THEN 1300
1270 LINE INPUT#3,L$
1280 PRINT#2,L$
1290 GOTO 1260
1300 CLOSE 3
1310 KILL DD$(5)+F$+".DOC"
1320 PRINT"Writing on "F$" document file
1330 PRINT
1340 PRINT"Type 'stop' to finish
1350 PRINT
1360 LINE INPUT L$
1370 IF L$="stop" THEN 1400
1380 PRINT #2,L$
1390 GOTO 1360
1400 CLOSE 2,3
1410 NAME DD$(5)+"DOC.$$$" AS DD$(5)+F$+".DOC"
1420 GOTO 1110
1430 '
DOC READ
1440 ON ERROR GOTO 1470
1450 OPEN"I",3,DD$(5)+F$+".DOC"
1460 ON ERROR GOTO 1610: GOTO 1490
1470 IF ERR=53 THEN CLOSE 3:
PRINT:PRINT"No document file present":
ON ERROR GOTO 1610:RESUME 1110
1480 ON ERROR GOTO 1610
1490 GOSUB 1050 'cs
1500 PRINT: PRINT "'"F$"' document file
1510 PRINT
1520 FOR I=1 TO 20
1530 IF EOF(3) THEN CLOSE 3: GOTO 1110
1540 LINE INPUT #3, L$
1550 PRINT L$
1560 NEXT I
1570 PRINT"(more)";
1580 '
PAUSE
1582 X$=INPUT$(1)
1584 IF X$=CHR$(27) THEN 1640 'exit
1590 PRINT
1600 GOTO 1520
1610 '
GENERAL ERROR
1620 IF ERR=61 THEN PRINT:PRINT"Out of disk space.":PRINT:RESUME 1110
1630 ON ERROR GOTO 0
1640 '
FINISH
1645 CLOSE 2,3 'make sure
1650 OPEN"R",2,DD$(4)+F$+".DD"+FT$
1660 FIELD #2,128 AS S$
1670 PRINT:PRINT"Re-loading DIMS file editor (DEDIT).":CHAIN"DEDIT",1000
N"R",2,DD$(4)+F$+".DD"+FT$
1660 FIELD #2,128 AS S$
1670 PRINT:PRINT"Re-loading DIMS file editor (D