950 REM DISKPLOT 990 REM this routine draws a line from (X1,Y1) to (X2,Y2) leaves (X1,Y1) and (X,Y) pointing to end of line (X2,Y2) 1000 L1=X2-X1 :L2=Y2-Y1 :L3=0 :L4=1 :L5=1 :L6=0 1010 IF L1<0 THEN L5=-1 :L1=-L1 1020 IF L2<0 THEN L4=-1 :L2=-L2 1030 IF L2>L1 THEN L8=L1 :L1=L2 :L2=L8 :L3=L5 :L5=0 :L6=L4 :L4=0 1040 L7=INT(L1/2) :X=X1 :Y=Y1 :IF L1=0 THEN GOSUB 1500 :RETURN 1050 FOR L8=1 TO L1 1060 GOSUB 1500 1070 X=X+L5 :Y=Y+L6 :L7=L7+L2 1080 IF L7>L1 THEN L7=L7-L1 :X=X+L3 :Y=Y+L4 1090 NEXT :X1=X2 :Y1=Y2 :RETURN 1490 REM this routine plots 1 dot at (X,Y) 1500 IF X<0 OR X>P10 OR Y<0 OR Y>P9 THEN PRINT USING "Coordinate OUT OF RANGE X=###, Y=###";X,Y :RETURN 1520 IF PQ$="O" THEN PQ$="" :GOSUB 2600 '** read for Overlay 1530 P3=INT(Y/P12) :P4=Y-P3*P12 :P3=P3+1 :P7=P3-P1+1 1540 IF P7=P6+1 THEN GOSUB 2000 ELSE IF P7=0 THEN GOSUB 2100 ELSE IF P7<0 OR P7>P6+1 THEN GOSUB 2200 1550 PH=INT(X/128)+1 :PL=X+1-(128*(PH-1)) 1560 PP=ASC(MID$(PB$(P7,PH),PL,1)) OR PD(P4) 1570 MID$(PB$(P7,PH),PL,1)=CHR$(PP) :PW(P7,PH)=1 '** set flag 1580 'PRINT CP2$; :PRINT USING PU$;X,Y,P3,P7,P4,PH,(P3-1)*P11+PH,PL 1590 RETURN 1990 REM Y is too large so move window DOWN with overlap 2000 FOR P7=1 TO P8 :P3=P1+P7-1 :GOSUB 2800 :NEXT 2010 FOR P7=1 TO P8-1 2020 FOR PI=1 TO P11 2030 MID$(PB$(P7,PI),1)=PB$(P8+P7,PI) :PW(P7,PI)=PW(P8+P7,PI) 2040 NEXT :NEXT :P1=P1+P8 2050 FOR P7=P8 TO P6 :P3=P1+P7-1 :GOSUB 2700 :NEXT 2060 P7=P8 :RETURN 2090 REM Y is too small so move window UP with overlap 2100 FOR P7=P8 TO P6 :P3=P1+P7-1 :GOSUB 2800 :NEXT 2110 FOR P7=P8+1 TO P6 2120 FOR PI=1 TO P11 2130 MID$(PB$(P7,PI),1)=PB$(P7-P8,PI) :PW(P7,PI)=PW(P7-P8,PI) 2140 NEXT :NEXT :P1=P1-P8 2150 FOR P7=1 TO P8 :P3=P1+P7-1 :GOSUB 2700 :NEXT 2160 P7=P8 :RETURN 2190 REM move window to another part of the page (no overlap) 2200 PQ=P3 : GOSUB 2500 '** write all buffers 2210 P1=PQ-P8+1 :GOSUB 2600 '** read all buffers 2220 P7=P8 :P3=PQ :RETURN 2490 REM write all buffers to appropriate records 2500 FOR P7=1 TO P6 :P3=P1+P7-1 :GOSUB 2800 :NEXT 2510 RETURN 2590 REM read all buffers from disk 2600 FOR P7=1 TO P6 :P3=P1+P7-1 :GOSUB 2700 :NEXT 2610 RETURN 2690 REM read record P3 into buffer P7 2700 IF P3<1 OR P3>P5 THEN RETURN '** no such logical record 2710 P2=(P3-1)*P11+1 '** calculate physical record 2720 'PRINT CP3$; :PRINT USING "READING Buffer ## from Record ###";P7,P3 2725 FOR PI=1 TO P11 2730 GET 1,P2+PI-1 :MID$(PB$(P7,PI),1)=PR$ :PW(P7,PI)=0 '** reset flag 2740 NEXT 2750 REM PRINT CHR$(30); '** (@132) 2760 RETURN 2790 REM write buffer P7 to recrtod P3 2800 IF P3<1 OR P3>P5 THEN RETURN 2810 P2=(P3-1)*P11+1 2820 'PRINT CP3$; :PRINT USING "WRITTING Buffer ## to Record ### ";P7,P3 2825 FOR PI=1 TO P11 2830 IF PW(P7,PI) THEN LSET PR$=PB$(P7,PI) :PUT 1,P2+PI-1 2840 NEXT 2850 REM PRINT CHR$(30); '(@132) 2860 RETURN 2990 REM Initialize file and virtual plotting system variables 3000 CS$=CHR$(12) '** define clear screen 3006 CP2$=CHR$(27)+CHR$(102)+CHR$(32)+CHR$(33) '** cursor to line 2 3007 CP3$=CHR$(27)+CHR$(102)+CHR$(32)+CHR$(34) '** cursor to line 3 3010 PRINT CS$; :PRINT "Virtual Memory Plotter Emulator" 3011 PRINT "programmed by Dan Rollins as published in BYTE, Dec 83" 3012 PRINT "adapted for CP/M's MBASIC by Bob Bloom" 3013 DEFINT P,L :PRINT :PRINT 3020 X=0 :Y=0 :P3=0 :P1=0 :P7=0 :PH=0 :PL=0 :PP=0 :P12=7 '** used often 3025 IF P10<10 THEN INPUT "Plot width (Horizontally) in dots (84/in, 640 for 7.5in)";P10 ELSE PRINT USING "Plot will have #### dots horizontally)";P10 3030 P11=INT(P10/128+1) :PRINT :PRINT "Will use ";P11;" sectors across" 3035 PRINT :IF P9<10 THEN INPUT "Plot length (Vertically) in dots (84/in, 840 for 10in)";P9 ELSE PRINT USING "Plot will have ### dots vertically)";P9 3040 P5=INT(P9/P12+1) :PRINT :PRINT "Will use ";P5;" lines down" :PRINT 3045 P9=P5*P12 :P10=P11*128 '** allow extra room 3050 PRINT "Input the number of memory buffers to use or '0' for" 3055 INPUT "automatic determination of number of buffers";P6 3056 IF P6=0 THEN PI=INT(INT(FRE(0)/135)/P11)-1 :P6=PI OR 1 :IF P6>P5 THEN P6=P5 3060 P6=P6 OR 1 :P8=INT(P6/2)+1 :IF P6<3 OR P6>41 GOTO 3030 3061 PRINT :PRINT "Will use ";P6;" buffers to hold ";P6*P12;" Vertical Dots" 3062 DIM PB$(P6,P11), PW(P6,P11) '** buffers, write flags 3065 PRINT: PRINT "** Initializing buffers **" :PC$=STRING$(128,128) 3070 FOR PQ=1 TO P6 :FOR PI=1 TO P11 :PB$(PQ,PI)=PC$ :NEXT :NEXT 3080 PRINT: INPUT "Filename to store Plot-image in";PF$ 3090 OPEN "R",1,PF$ :FIELD 1,128 AS PR$ 3100 IF LOF(1)=0 THEN PS=1 :GOTO 3170 3110 PRINT "File: ";PF$" already exists!!!" 3120 INPUT "(C)lear file out, (O)verlay plot or use (D)ifferent file";PQ$ 3130 IF PQ$="C" THEN PRINT "Are you sure your want to clear ";PF$;" (Y/N)"; :INPUT PQ$ :IF PQ$="Y" THEN CLOSE 1 :KILL PF$ :GOTO 3090 ELSE 3120 3140 IF PQ$="D" THEN CLOSE 1 :GOTO 3000 3150 IF PQ$<>"O" GOTO 3120 3160 IF LOF(1)P5 THEN P1=P5-P6 3250 PRINT :RETURN 3990 REM flush buffers and close file 4000 PRINT CS$ :PRINT "Closing file: ";PF$ 4010 GOSUB 2500 :CLOSE 1 4020 PRINT "file closed" :PRINT 4030 INPUT "Press to continue"; PQ$ 4040 RETURN 4990 REM routine prints entire file to printer 5000 PRINT CS$ :PRINT "Print graphics file" :PRINT 5020 IF P11=0 THEN INPUT "How many sectors wide is the plot";P11 5030 IF LEN(PF$)=0 THEN INPUT "filename to print";PF$ :IF LEN(PF$)=0 GOTO 5030 ELSE PRINT "Looking for file ";PF$ 5040 OPEN "R",1,PF$ :FIELD 1,128 AS PR$ 5050 IF LOF(1)=0 THEN PRINT "NO SUCH FILE!" :CLOSE 1 :KILL PF$ :GOTO 5020 5055 PRINT :INPUT "Ready printer and strike any key to start print";QA$ 5060 WIDTH LPRINT 255 :PE$=CHR$(131) '** set NO & graphics escape char 5070 PRINT: PRINT "Now printing ..." :LPRINT :LPRINT PE$; '** into graphics 5080 LPRINT PE$;CHR$(14); :P2=1 '** linefeed 5095 FOR PI=1 TO P11 5100 GET 1,P2+PI-1 :GOSUB 5200 5110 NEXT 5120 P2=P2+P11 : LPRINT PE$;CHR$(14); '** linefeed 5130 IF EOF(1)=-1 AND LOF(1)<>128 AND LOF(1)<=P2 GOTO 5140 ELSE GOTO 5095 5140 LPRINT PE$;CHR$(2) '** enter normal mode 5150 LPRINT :CLOSE 1 5160 RETURN 5190 REM prints first PL characters from PR$ 5200 PJ=1 5210 PQ=INSTR(PJ,PR$,PE$) 5220 IF PQ=0 THEN LPRINT MID$(PR$,PJ); :RETURN 5230 LPRINT MID$(PR$,PJ,PQ-PJ);PE$;PE$; 5240 PJ=PQ+1 :IF PJ<=128 THEN 5210 ELSE RETURN 6000 END