home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / diskplot / diskplot.lbr / DISKPLOT.BQS / DISKPLOT.BAS
Encoding:
BASIC Source File  |  1985-06-17  |  6.8 KB  |  149 lines
  1. 950 REM DISKPLOT
  2. 990 REM this routine draws a line from (X1,Y1) to (X2,Y2)
  3.      leaves (X1,Y1) and (X,Y) pointing to end of line (X2,Y2)
  4. 1000 L1=X2-X1 :L2=Y2-Y1 :L3=0 :L4=1 :L5=1 :L6=0
  5. 1010 IF L1<0 THEN L5=-1 :L1=-L1
  6. 1020 IF L2<0 THEN L4=-1 :L2=-L2
  7. 1030 IF L2>L1 THEN L8=L1 :L1=L2 :L2=L8 :L3=L5 :L5=0 :L6=L4 :L4=0
  8. 1040 L7=INT(L1/2) :X=X1 :Y=Y1 :IF L1=0 THEN GOSUB 1500 :RETURN
  9. 1050 FOR L8=1 TO L1
  10. 1060  GOSUB 1500
  11. 1070  X=X+L5 :Y=Y+L6 :L7=L7+L2
  12. 1080  IF L7>L1 THEN L7=L7-L1 :X=X+L3 :Y=Y+L4
  13. 1090 NEXT :X1=X2 :Y1=Y2 :RETURN
  14. 1490 REM this routine plots 1 dot at (X,Y) 
  15. 1500 IF X<0 OR X>P10 OR Y<0 OR Y>P9 THEN 
  16.       PRINT USING "Coordinate OUT OF RANGE X=###, Y=###";X,Y :RETURN 
  17. 1520 IF PQ$="O" THEN PQ$="" :GOSUB 2600 '** read for Overlay
  18. 1530 P3=INT(Y/P12) :P4=Y-P3*P12 :P3=P3+1 :P7=P3-P1+1
  19. 1540 IF P7=P6+1 THEN GOSUB 2000 ELSE IF P7=0 THEN GOSUB 2100
  20.        ELSE IF P7<0 OR P7>P6+1 THEN GOSUB 2200
  21. 1550 PH=INT(X/128)+1 :PL=X+1-(128*(PH-1))
  22. 1560 PP=ASC(MID$(PB$(P7,PH),PL,1)) OR PD(P4)
  23. 1570 MID$(PB$(P7,PH),PL,1)=CHR$(PP) :PW(P7,PH)=1 '** set flag
  24. 1580 'PRINT CP2$; :PRINT USING PU$;X,Y,P3,P7,P4,PH,(P3-1)*P11+PH,PL
  25. 1590 RETURN
  26. 1990 REM Y is too large so move window DOWN with overlap
  27. 2000 FOR P7=1 TO P8 :P3=P1+P7-1 :GOSUB 2800 :NEXT
  28. 2010 FOR P7=1 TO P8-1
  29. 2020  FOR PI=1 TO P11
  30. 2030   MID$(PB$(P7,PI),1)=PB$(P8+P7,PI) :PW(P7,PI)=PW(P8+P7,PI)
  31. 2040  NEXT :NEXT :P1=P1+P8
  32. 2050 FOR P7=P8 TO P6 :P3=P1+P7-1 :GOSUB 2700 :NEXT
  33. 2060 P7=P8 :RETURN
  34. 2090 REM Y is too small so move window UP with overlap
  35. 2100 FOR P7=P8 TO P6 :P3=P1+P7-1 :GOSUB 2800 :NEXT
  36. 2110 FOR P7=P8+1 TO P6
  37. 2120  FOR PI=1 TO P11
  38. 2130   MID$(PB$(P7,PI),1)=PB$(P7-P8,PI) :PW(P7,PI)=PW(P7-P8,PI)
  39. 2140  NEXT :NEXT :P1=P1-P8
  40. 2150 FOR P7=1 TO P8 :P3=P1+P7-1 :GOSUB 2700 :NEXT
  41. 2160 P7=P8 :RETURN
  42. 2190 REM move window to another part of the page (no overlap)
  43. 2200 PQ=P3 : GOSUB 2500   '** write all buffers
  44. 2210 P1=PQ-P8+1 :GOSUB 2600  '** read all buffers
  45. 2220 P7=P8 :P3=PQ :RETURN
  46. 2490 REM write all buffers to appropriate records
  47. 2500 FOR P7=1 TO P6 :P3=P1+P7-1 :GOSUB 2800 :NEXT
  48. 2510 RETURN
  49. 2590 REM read all buffers from disk
  50. 2600 FOR P7=1 TO P6 :P3=P1+P7-1 :GOSUB 2700 :NEXT
  51. 2610 RETURN
  52. 2690 REM read record P3 into buffer P7
  53. 2700 IF P3<1 OR P3>P5 THEN RETURN '** no such logical record
  54. 2710 P2=(P3-1)*P11+1 '** calculate physical record
  55. 2720 'PRINT CP3$; :PRINT USING "READING Buffer ## from Record ###";P7,P3
  56. 2725 FOR PI=1 TO P11
  57. 2730  GET 1,P2+PI-1 :MID$(PB$(P7,PI),1)=PR$ :PW(P7,PI)=0 '** reset flag
  58. 2740 NEXT
  59. 2750 REM PRINT CHR$(30); '** (@132)
  60. 2760 RETURN
  61. 2790 REM write buffer P7 to recrtod P3
  62. 2800 IF P3<1 OR P3>P5 THEN RETURN
  63. 2810 P2=(P3-1)*P11+1
  64. 2820 'PRINT CP3$; :PRINT USING "WRITTING Buffer ## to Record ### ";P7,P3
  65. 2825 FOR PI=1 TO P11
  66. 2830  IF PW(P7,PI) THEN LSET PR$=PB$(P7,PI) :PUT 1,P2+PI-1
  67. 2840 NEXT
  68. 2850 REM PRINT CHR$(30); '(@132)
  69. 2860 RETURN
  70. 2990 REM Initialize file and virtual plotting system variables
  71. 3000 CS$=CHR$(12) '** define clear screen
  72. 3006 CP2$=CHR$(27)+CHR$(102)+CHR$(32)+CHR$(33) '** cursor to line 2
  73. 3007 CP3$=CHR$(27)+CHR$(102)+CHR$(32)+CHR$(34) '** cursor to line 3
  74. 3010 PRINT CS$; :PRINT "Virtual Memory Plotter Emulator"
  75. 3011 PRINT "programmed by Dan Rollins as published in BYTE, Dec 83"
  76. 3012 PRINT "adapted for CP/M's MBASIC by Bob Bloom"
  77. 3013 DEFINT P,L :PRINT :PRINT
  78. 3020 X=0 :Y=0 :P3=0 :P1=0 :P7=0 :PH=0 :PL=0 :PP=0 :P12=7 '** used often
  79. 3025 IF P10<10 THEN
  80.       INPUT "Plot width (Horizontally) in dots (84/in, 640 for 7.5in)";P10
  81.       ELSE PRINT USING "Plot will have #### dots horizontally)";P10
  82. 3030 P11=INT(P10/128+1) :PRINT :PRINT "Will use ";P11;" sectors across"
  83. 3035 PRINT :IF P9<10 THEN 
  84.       INPUT "Plot length (Vertically) in dots (84/in, 840 for 10in)";P9
  85.       ELSE PRINT USING "Plot will have ### dots vertically)";P9
  86. 3040 P5=INT(P9/P12+1) :PRINT :PRINT "Will use ";P5;" lines down" :PRINT
  87. 3045 P9=P5*P12 :P10=P11*128 '** allow extra room
  88. 3050 PRINT "Input the number of memory buffers to use or '0' for"
  89. 3055 INPUT "automatic determination of number of buffers";P6
  90. 3056 IF P6=0 THEN PI=INT(INT(FRE(0)/135)/P11)-1 :P6=PI OR 1
  91.       :IF P6>P5 THEN P6=P5
  92. 3060 P6=P6 OR 1 :P8=INT(P6/2)+1 :IF P6<3 OR P6>41 GOTO 3030
  93. 3061 PRINT :PRINT "Will use ";P6;" buffers to hold ";P6*P12;" Vertical Dots"
  94. 3062 DIM PB$(P6,P11), PW(P6,P11) '** buffers, write flags
  95. 3065 PRINT: PRINT "** Initializing buffers **" :PC$=STRING$(128,128)
  96. 3070 FOR PQ=1 TO P6 :FOR PI=1 TO P11 :PB$(PQ,PI)=PC$ :NEXT :NEXT
  97. 3080 PRINT: INPUT "Filename to store Plot-image in";PF$
  98. 3090 OPEN "R",1,PF$ :FIELD 1,128 AS PR$
  99. 3100 IF LOF(1)=0 THEN PS=1 :GOTO 3170
  100. 3110 PRINT "File: ";PF$" already exists!!!"
  101. 3120 INPUT "(C)lear file out, (O)verlay plot or use (D)ifferent file";PQ$
  102. 3130 IF PQ$="C" THEN PRINT "Are you sure your want to clear ";PF$;" (Y/N)";
  103.       :INPUT PQ$ :IF PQ$="Y" THEN CLOSE 1 :KILL PF$ :GOTO 3090 ELSE 3120
  104. 3140 IF PQ$="D" THEN CLOSE 1 :GOTO 3000
  105. 3150 IF PQ$<>"O" GOTO 3120
  106. 3160 IF LOF(1)<P5*P11 THEN PS=LOF(1) ELSE 3220
  107. 3170 PRINT CS$ :LSET PR$=PC$
  108. 3180 FOR PQ=PS TO P5*P11
  109. 3190  PRINT CP2$; :PRINT USING "Initializing file physical sector ###";PQ
  110. 3200  PUT 1,PQ
  111. 3210 NEXT
  112. 3230 PU$="X=### Y=### Line=### Buffer=### Bit=# LinSec=# PhysSec=### X-Sec=###"
  113. 3240 PD(0)=1 :PD(1)=2 :PD(2)=4 :PD(3)=8 :PD(4)=16 :PD(5)=32 :PD(6)=64 :PD(7)=128
  114. 3245 P1=INT(Y/P12)-P8 :IF P1<1 THEN P1=1 ELSE IF P1>P5 THEN P1=P5-P6 
  115. 3250 PRINT :RETURN
  116. 3990 REM flush buffers and close file
  117. 4000 PRINT CS$ :PRINT "Closing file: ";PF$
  118. 4010 GOSUB 2500 :CLOSE 1
  119. 4020 PRINT "file closed" :PRINT
  120. 4030 INPUT "Press <cr> to continue"; PQ$
  121. 4040 RETURN
  122. 4990 REM routine prints entire file to printer
  123. 5000 PRINT CS$ :PRINT "Print graphics file" :PRINT
  124. 5020 IF P11=0 THEN INPUT "How many sectors wide is the plot";P11
  125. 5030 IF LEN(PF$)=0 THEN
  126.       INPUT "filename to print";PF$ :IF LEN(PF$)=0 GOTO 5030
  127.       ELSE PRINT "Looking for file ";PF$
  128. 5040 OPEN "R",1,PF$ :FIELD 1,128 AS PR$
  129. 5050 IF LOF(1)=0 THEN PRINT "NO SUCH FILE!" :CLOSE 1 :KILL PF$ :GOTO 5020
  130. 5055 PRINT :INPUT "Ready printer and strike any key to start print";QA$
  131. 5060 WIDTH LPRINT 255 :PE$=CHR$(131) '** set NO <cr> & graphics escape char
  132. 5070 PRINT: PRINT "Now printing ..." :LPRINT :LPRINT PE$; '** into graphics
  133. 5080 LPRINT PE$;CHR$(14); :P2=1  '** linefeed
  134. 5095  FOR PI=1 TO P11
  135. 5100   GET 1,P2+PI-1 :GOSUB 5200
  136. 5110  NEXT
  137. 5120 P2=P2+P11 : LPRINT PE$;CHR$(14); '** linefeed
  138. 5130 IF EOF(1)=-1 AND LOF(1)<>128 AND LOF(1)<=P2 GOTO 5140 ELSE GOTO 5095
  139. 5140 LPRINT PE$;CHR$(2) '** enter normal mode
  140. 5150 LPRINT :CLOSE 1
  141. 5160 RETURN
  142. 5190 REM prints first PL characters from PR$
  143. 5200 PJ=1
  144. 5210 PQ=INSTR(PJ,PR$,PE$)
  145. 5220 IF PQ=0 THEN LPRINT MID$(PR$,PJ); :RETURN
  146. 5230 LPRINT MID$(PR$,PJ,PQ-PJ);PE$;PE$;
  147. 5240 PJ=PQ+1 :IF PJ<=128 THEN 5210 ELSE RETURN
  148. 6000 END
  149.