home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol194 / upload.bas < prev    next >
BASIC Source File  |  1984-10-17  |  10KB  |  215 lines
  1. 090 CLEAR 10000:    REM  RESERVE SOME SPACE FOR STRINGS
  2. 100 REM-----------PLOT PACKAGE-------------
  3. 101 REM VARIABLES:
  4. 102 REM CX      CHARACTER SIZE
  5. 103 REM LY      LINE SIZE IN Y DIRECTION
  6. 104 REM ML      LEFT MARGIN
  7. 105 REM MR      RIGHT MARGIN
  8. 106 REM MB      BOTTOM MARGIN
  9. 107 REM MT      TOP MARGIN
  10. 108 REM NY%     NUMBER OF CHARACTERS IN Y AXIS LABELS
  11. 109 REM NX%     NUMBER OF CHARACTERS IN X AXIS LABELS
  12. 110 REM LX%     NUMBER OF LINES OF X AXIS LABELS
  13. 111 REM DX,DY   REAL INCREMENTS BETWEEN GRID TIC MARKS
  14. 112 REM XL,XR   REAL VALUES FOR ENDS OF X AXIS
  15. 113 REM YB,YT   REAL VALUES FOR ENDS OF Y AXIS
  16. 114 REM GD      PLOTTER INCREMENT BETEEN DOTS IN GRID LINES
  17. 115 REM X1,Y1   STARTING PLOTTER COORDINATES FOR LINE SEGMENTS OR STRINGS
  18. 116 REM X2,Y2   ENDING PLOTTER COORDINATES FOR LINE SEGMENTS
  19. 117 REM G1-G7   GRAPHICS PACKAGE TEMPORARY VARIABLES
  20. 118 REM GF$     FILE NAME FOR VECTOR FILE
  21. 119 REM GB$     BUFFER STRING FOR VECTOR FILE
  22. 120 REM GC$     GRAPHIC COMMAND STRING
  23. 121 REM GC%    COLOR VALUE 0=WHITE, 1-63=PATTERNED, 64-127=GREY,NEG=XOR
  24. 122 REM GL$     LABEL STRING
  25. 123 REM --------------------------------
  26. 124 REM ------------------------------------------------------------------------
  27. 125 REM !                              ^                                       !
  28. 126 REM !                              MT                                      !
  29. 127 REM !                              !                                       !
  30. 128 REM !                              V                                       !
  31. 129 REM !          --------------------------------------------------          !
  32. 130 REM !          !                                                !          !
  33. 131 REM !<--ML---->!                                                !<---MR--->!
  34. 132 REM !          !   1000 I    .    .    .    .    .    .    .    !          !
  35. 133 REM !          !        I         .         .         .         !          !
  36. 134 REM !          !        I         .         .         .         !          !
  37. 135 REM !          !    950 I    .    .    .    .    .    .    .    !          !
  38. 136 REM !          !        I         !<-->!    .         .         !          !
  39. 137 REM !          !        I         . GD      .         .         !          !
  40. 138 REM !          !    900 I    .    .    .    .    .    .    .    !          !
  41. 139 REM !          !        I         .         .         .         !          !
  42. 140 REM !          !        I         .         .         .         !          !
  43. 141 REM !          !    850 I    .    .    .    .    .    .    .    !          !
  44. 142 REM !          !        I         .         .         .         !          !
  45. 143 REM !          !        I         .         .         .         !          !
  46. 144 REM !          !    800 I=======================================!          !
  47. 145 REM !          !      10.01     10.02     10.03     10.04       !          !
  48. 146 REM !          !                                                !          !
  49. 147 REM !          --------------------------------------------------          !
  50. 148 REM !                              ^                                       !
  51. 149 REM !                              !                                       !
  52. 150 REM !                              MB                                      !
  53. 151 REM !                              !                                       !
  54. 152 REM !                              V                                       !
  55. 153 REM ------------------------------------------------------------------------
  56. 154 REM XL=10.01, XR=10.05, DX=.01, YB=800, YT=1000, DY=50
  57. 155 REM NX%=5, LX%=1, NY%=4
  58. 156 REM WHEN LX%=-1, ADDITIONAL LINES WILL BE ADDED AUTOMATICALLY TO AVOID 
  59. 157 REM OVERLAP IN THE X AXIS LABELS.
  60. 158 REM
  61. 159 REM
  62. 160  REM  SCALING & CONVERSION FUNCTIONS
  63. 161 CX=1/80:LY=1/82: REM VALUES FOR MX-80
  64. 162 GK=32767: REM CONVERSION CONSTANT FOR COORDINATES
  65. 163  DEF  FN RX(X) =  ML + NY% * CX + (1 - ML - MR - NY% * CX) * (X - XL) / (XR - XL)
  66. 164  DEF  FN RY(Y) =  MB + LX% * LY +(1 - MT - MB - LX% * LY) * (Y - YB) / (YT - YB)
  67. 165  DEF  FN UX(X) = (X - ML - NY% * CX) * (XR - XL) / (1 - ML - MR - NY% * CX) + XL
  68. 166 DEF FN UY(Y) = (Y - MB - LX% * LY) * (YT - YB)/(1 - MT - MB - LX% * LY) + YB
  69. 167 REM OPEN .VEC FILE
  70. 168 GOSUB 200
  71. 169  GOTO 278: REM  TRANSFER TO USER PROGRAM
  72. 170 REM WRITE COMMAND STRING SUBROUTINE ****************************************
  73. 171 IF LEN(GB$)+LEN(GC$)<=126 THEN 174
  74. 172 GB$=GB$+STRING$(126-LEN(GB$),"N")
  75. 173 PRINT #1, GB$: GB$=MKS$(FRE(0)):GB$=""
  76. 174 GB$=GB$+GC$: RETURN
  77. 175 REM DRAW LINE SEGMENT               ****************************************
  78. 176 GC$="D"+MKI$(INT(X1*GK))+MKI$(INT(Y1*GK))+MKI$(INT(X2*GK))+MKI$(INT(Y2*GK))
  79. 177 GOSUB 171: RETURN
  80. 178 REM PLOT POINT                      ****************************************
  81. 179 GC$="P"+MKI$(INT(X1*GK))+MKI$(INT(Y1*GK)): GOSUB 171: RETURN
  82. 180 REM PLOT INCREMENTAL SEGMENT        ****************************************
  83. 181 GC$="I"+MKI$(INT(X1*GK))+MKI$(INT(Y1*GK)): GOSUB 171: RETURN
  84. 182 REM SET COLOR CODE                  ****************************************
  85. 183 GC$="C"+LEFT$(MKI$(GC%),1)
  86. 184 GOSUB 171: RETURN
  87. 185 REM ERASE PICTURE                   ****************************************
  88. 186 GC$="C"+LEFT$(MKI$(GC%),1)+"E"
  89. 187 GOSUB 171: RETURN
  90. 188 REM PLOT PRINTED STRING             ****************************************
  91. 189 GC$="S"+MKI$(INT(X1*GK))+MKI$(INT(Y1*GK))+GL$+CHR$(13): GOSUB 171: RETURN
  92. 190 REM PLOT FILLED SEGMENT             ****************************************
  93. 191 GC$="F"+MKI$(INT(X1*GK))+MKI$(INT(Y1*GK))+MKI$(INT(X2*GK))+MKI$(INT(Y2*GK))
  94. 192 GC$=GC$+MKI$(INT(YF*GK))
  95. 193 GOSUB 171:RETURN
  96. 194 REM SEND PRINT PICTURE COMMAND      ****************************************
  97. 195 GC$="O": GOSUB 171: RETURN
  98. 196 REM QUIT PLOTTING, PRINT GRAPH      ****************************************
  99. 197 GC$="OQ":GOSUB 171
  100. 198 GB$=GB$+GC$: GB$=GB$+STRING$(126-LEN(GB$),"N")
  101. 199 PRINT #1,GB$: CLOSE 1: RETURN
  102. 200 REM OPEN NEW OUTPUT FILE            ****************************************
  103. 201 INPUT "ENTER PLOT OUTPUT FILENAME";GF$
  104. 202 IF INSTR(GF$,".")=0 THEN GF$=GF$+".VEC"
  105. 203 OPEN "O",#1,GF$:GB$="":GC$="C"+CHR$(0)+"EC"+CHR$(127): GOSUB 171: RETURN
  106. 204  REM  SET DEFAULT VALUES            ****************************************
  107. 205 GC%=127
  108. 206 MT = 0:MB = 0:MR = 0:ML = 0
  109. 207 XL = 0:XR = 1:YB = 1:YT = 0:DX = 1:DY = 1
  110. 208 NX% = 0:NY% = 0:LX% =  - 1:GD = .01
  111. 209  RETURN 
  112. 210  REM  CALCULATE GRID                ****************************************
  113. 211 G1 =  FRE (0):G1 = 1 - ML - MR - CX * NX%: REM  PLOTTER LN OF X AXIS
  114. 212  IF G1 > CX THEN 214
  115. 213 VTAB 24:INVERSE:  PRINT "GRAPH TOO NARROW": NORMAL : RETURN 
  116. 214 G3 =  ABS ( FN RX(XL) -  FN RX(XL + DX)): REM  PLOTTER DX
  117. 215  IF LX% >  = 0 THEN 217
  118. 216 LX% = INT(NX% * CX/ G3) + 1
  119. 217 G2 = 1 - MT - MB - LY * LX%: REM  PLOTTER LN OF Y AXIS
  120. 218  IF G2 > CX THEN 220
  121. 219  VTAB 24: INVERSE : PRINT "GRAPH TOO SHORT": NORMAL : RETURN 
  122. 220  RETURN 
  123. 221  REM  DRAW GRID                     ****************************************
  124. 222 REM
  125. 226  Y1=FN RY(YB):Y2=FN RY(YT)
  126. 227  GC$="C"+CHR$(8): GOSUB 171
  127. 228  FOR G4 = XL TO XR STEP DX
  128. 229 X1 =  FN RX(G4): X2=X1
  129. 231  GOSUB 176
  130. 232 NEXT G4
  131. 233 GC$="C"+CHR$(1): GOSUB 171
  132. 234  X1=FN RX(XL):X2=FN RX(XR)
  133. 235  FOR G4 = YB TO YT STEP DY
  134. 236  Y1=FN RY(G4):Y2=Y1
  135. 237  GOSUB 176
  136. 239 NEXT G4
  137. 240  GOSUB 182: RETURN 
  138. 241 IF NX%=0 THEN GOTO 246 ELSE G6 =  FN RY(YB)
  139. 242  FOR G4 = XL TO XR STEP DX
  140. 243 G5 =  FN RX(G4)
  141. 244 X1=G5:Y1=G6:X2=G5:Y2=G6-CX:GOSUB 176
  142. 245  NEXT G4:  X1=FN RX(XR):Y1=FN RY(YB):X2=FN RX(XL): Y2=Y1: GOSUB 176
  143. 246 IF NY%=0 THEN GOTO 251 ELSE G5 =  FN RX(XL)
  144. 247  FOR G4 = YB TO YT STEP DY
  145. 248 G6 =  FN RY(G4)
  146. 249  X1=G5:Y1=G6:X2=G5-CX:Y2=G6:GOSUB 176
  147. 250  NEXT G4: X1=FN RX(XL):Y1=FN RY(YT):X2=X1: Y2=FN RY(YB): GOSUB 176
  148. 251  RETURN 
  149. 252  REM  LABEL X AXIS                  ****************************************
  150. 253 IF NX%=0 THEN RETURN ELSE G7 =  FRE (0):G7 = 0
  151. 254 G6=FN RY(YB)-2*LY
  152. 255  FOR G4 = XL TO XR STEP DX
  153. 256 G5 =  FN RX(G4):G7 = G7 + 1
  154. 257 Y1=G6- (-INT (G7 / LX%) * LX% + G7)*LY
  155. 258 X1= INT((G5-NX%*CX/2)/CX)*CX
  156. 259 GL$ = LEFT$( STR$ (G4),NX%)
  157. 260 GOSUB 189
  158. 261 NEXT G4: X1=FN RX(XR):Y1=FN RY(YB): X2=FN RX(XL): Y2=Y1: GOSUB 176
  159. 262  RETURN 
  160. 263  REM  LABEL Y AXIS                  ****************************************
  161. 264 IF NY%=0 THEN RETURN ELSE G7 =  FRE (0):G7 = 0
  162. 265 X1=ML
  163. 266  FOR G4 = YB TO YT STEP DY
  164. 267 Y1=FN RY(G4)
  165. 268 GL$ =  LEFT$( STR$ (G4), NY% )
  166. 269 GOSUB 189
  167. 270  NEXT G4: X1=FN RX(XL):Y1=FN RY(YT):X2=X1: Y2=FN RY(YB): GOSUB 176
  168. 271  RETURN 
  169. 272  REM  DO WHOLE GRID                 ****************************************
  170. 273  GOSUB 210
  171. 274  GOSUB 222
  172. 275  GOSUB 252
  173. 276  GOSUB 263
  174. 277  RETURN 
  175. 278  GOSUB 204
  176. 279 REM -------- TOP OF USER PROGRAM -------------------------------------------
  177. 280 REM UPLOAD NEW COLOR VALUES
  178. 281 REM
  179. 282 DATA 63,111,85,103,75,115,93,95
  180. 283 DATA 112,69,104,86,116,76,96,94
  181. 284 DATA 79,105,65,117,87,97,77,121
  182. 285 DATA 106,80,118,66,98,88,122,78
  183. 286 DATA 71,119,81,99,67,123,89,107
  184. 287 DATA 120,72,100,82,124,68,108,90
  185. 288 DATA 91,101,73,125,83,109,69,113
  186. 289 DATA 102,92,126,74,110,84,114,70
  187. 290 GC$="U"+MKI$(64)
  188. 300 FOR I=1 TO 64:READ GC%:GC$=GC$+CHR$(GC%):NEXT I
  189. 310 GOSUB 171:  REM UPLOAD NEW DITHER MATRIX
  190. 320 REM
  191. 330 GC$="U"+MKI$(8)
  192. 340 DATA 0,&H11,&H13,&H1F,&H35,&H75,&H73,&H07
  193. 350 FOR I=1 TO 8:READ GC% :GC$=GC$+CHR$(GC%):NEXT I
  194. 360 GOSUB 171:  REM UPLOAD NEW PLAID ARRAY
  195. 500 TY=1/15:HT=1/16:TX=1/11:LN=1/12
  196. 510 X1=0:X2=LN:YF=1-TY:Y1=YF+HT:Y2=Y1
  197. 520 FOR I%=1 TO 13
  198. 530 FOR J%=1 TO 10
  199. 540 GC%=(I%-1)*10+J%
  200. 550 IF GC%>127 GOTO 620
  201. 560 GOSUB 182: REM SET COLOR
  202. 570 GOSUB 190: REM FILL BLOCK
  203. 580 X1=X1+TX:X2=X1+LN
  204. 590 NEXT J%
  205. 600 X1=0:X2=LN:YF=YF-TY:Y1=YF+HT:Y2=Y1
  206. 610 NEXT I%
  207. 620 X1=0:LN=1/65:YF=0:Y1=HT:Y2=Y1:X2=LN
  208. 630 FOR GC%=64 TO 127
  209. 640 GOSUB 182:  REM SET COLOR
  210. 650 GOSUB 190:  REM FILL BLOCK
  211. 660 X1=X2:X2=X2+LN
  212. 670 NEXT GC%
  213. 680 GOSUB 196:  REM CLOSE OUT PLOT
  214. 690 END
  215.