home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / pcmagazi / 1985 / 13 / bar6.bas < prev   
BASIC Source File  |  1980-01-02  |  6KB  |  166 lines
  1. 'Figure 6: (longest line = 64 characters; stat 67% in 2-column width)
  2.  
  3.  
  4.   0 '** High resolution stacked bars: Program 6 **
  5.  10 INF=1.7E+38      'Infinity
  6.  20 LM=40:RM=635:TM=5:BM=190  'Screen margins
  7.  30 IF BM>190 THEN CLS:PRINT"The bottom margin is too large
  8.       for":PRINT"the titles to fit. Use a larger one.":END
  9.  40 IF TM<3 THEN CLS:PRINT"The top margin is too small
  10.       for":PRINT"the titles to fit. Use a larger one.":END
  11.  50 'Read patterns
  12.  60 READ NP  'Number of patterns
  13.  70 DIM P$(NP)
  14.  80 FOR I=1 TO NP
  15.  90   FOR J=1 TO 8
  16. 100     T=0
  17. 110     FOR K=1 TO 8
  18. 120       READ C:T=T+C*2^(8-K)
  19. 130     NEXT
  20. 140     P$(I)=P$(I)+CHR$(T)
  21. 150   NEXT
  22. 160 NEXT
  23. 170 SCREEN 0:WIDTH 80:CLS       'Set text mode
  24. 180 INPUT"Number of bars ";N:IF N<2 THEN 180
  25. 190 INPUT"Number of levels ";NL:IF NL<1 THEN 190
  26. 200 DIM S(N,NL),T$(N),T(N)     'Set space for N values,titles
  27.       and totals
  28. 210 DIM M(200),N(200)   'Temporary arrays for GET and PUT
  29. 220 MAX=-INF           'Set maximum to minus infinity
  30. 230 MIN=0              'Set minimum to zero for stacked bars
  31. 240 FOR I=1 TO N
  32. 250   PRINT I;
  33. 260   INPUT"Title ";T$(I)
  34. 270   FOR J=1 TO NL
  35. 280     PRINT "  ";J;
  36. 290     INPUT S(I,J)
  37. 300     IF S(I,J)<0 THEN PRINT"< 0 illegal in stacked bars.
  38.           Repeat ":GOTO 280
  39. 310     T(I)=T(I)+S(I,J)
  40. 320   NEXT
  41. 330   IF T(I)>MAX THEN MAX=T(I)
  42. 340 NEXT
  43. 350 'Find longest value
  44. 360 MAXLEN=LEN(STR$(MAX)):IF MAX>=0 THEN MAXLEN=MAXLEN-1
  45. 370 'Draw chart
  46. 380 SCREEN 2:CLS
  47. 390 LINE(LM,TM)-(LM,BM)     'Y-axis
  48. 400 LINE(LM,BM)-(RM,BM)     'X-axis
  49. 410 WC=(RM-LM+1)/N          'Width of one column
  50. 420 WB=WC*.8                'Width of one bar
  51. 430 MWT=WB\8                'Maximum width of titles
  52. 440 SPB=LM+WC*.5-(WB*.5)    'Starting point of first bar
  53. 450 CC=SPB+WB\2            'Center of first column
  54. 460 HW=BM-TM+1              'Height of window
  55. 470 MVP=INT(HW*.95)         'Maximum vertical point
  56. 480 FACTOR=MVP/(MAX-MIN)    'Scaling factor for bars
  57. 490 D=MAX-MIN               'Distance between MIN and MAX
  58. 500 FV=1/(NV-1)             'Factor to scale values
  59. 510 DY=MVP/(NV-1)           'Vertical distance between values
  60. 520 PY=TM+MVP-3:PX=LM-2-MAXLEN*8  'Position of values
  61. 530 'Put values in vertical axis
  62. 540 FOR I=LM+2 TO RM STEP 3:PSET(I,0):NEXT
  63. 550 GET(LM+2,0)-(RM,0),N:CLS    'Dotted line
  64. 560 LINE(LM,TM)-(LM,BM)     'Y-axis
  65. 570 LINE(LM,BM)-(RM,BM)     'X-axis
  66. 580 F$=STRING$(MAXLEN,"#")
  67. 590 MA=MAX-MIN
  68. 600 'Normalize numbers and find number of zeros
  69. 610 IF MA<1 THEN 650
  70. 620 WHILE INT(MA)>=10:MA=MA/10:R=R+1:WEND:B=MA
  71. 630 IF R=0 THEN F$=F$+".#"  'At least one decimal in the format
  72. 640 GOTO 670
  73. 650 WHILE INT(MA)<1:MA=MA*10:R=R-1:WEND:B=MA+.001
  74. 660 F$=F$+"."+STRING$(ABS(R),"#")   'R zeros after the decimal
  75.       point
  76. 670 IF B>=1.2 THEN 690 ELSE R=R-1:ST=10:IF R<=-2 THEN F$=F$+"#"
  77. 680 GOTO 730
  78. 690 IF B>=5 THEN 720 ELSE ST=5          'Since step is 0.5, add
  79. 700 IF INSTR(F$,".")<>0 THEN F$=F$+"#"  'one decimal to format
  80. 710 GOTO 730
  81. 720 ST=10
  82. 730 MAXLEN=LEN(F$)   'F$ is the format
  83. 740 IF MAXLEN*8+2>LM THEN CLS:PRINT"The left margin is too small
  84.       for the":PRINT"values to fit.  Use a larger value.":END
  85. 750 'Print values
  86. 760 EX=10^(R-1)
  87. 770 A=MIN/(ST*EX)                  'Find bottom number
  88. 780 IF A<>INT(A)THEN A=INT(A)+1 ELSE A=INT(A)
  89. 790 WHILE A*ST*EX-MAX < .000001
  90. 800   T=A*ST*EX                    'Number on axis
  91. 810   Y=MVP+TM-(T-MIN)*FACTOR      'Scaled height of number
  92. 820   LINE(LM-1,Y)-(LM+2,Y)        'Line in vertical axis
  93. 830   PUT(LM+2,Y),N                'Put dotted line
  94. 840   LOCATE 1,1:PRINT USING F$;T; 'Print number
  95. 850   GET(0,0)-(MAXLEN*8-1,7),M    'Copy in graphics form
  96. 860   LOCATE 1,1:PRINT SPACE$(MAXLEN);  'Erase number
  97. 870   PUT(LM-MAXLEN*8-2,Y-3),M,PSET     'Put number in its place
  98. 880   A=A+1                        'Increment for next number
  99. 890 WEND
  100. 900 GET(0,0)-(200,7),N             'Copy top-left part of screen
  101. 910 'Put titles in horizontal axis
  102. 920 FOR I=1 TO N
  103. 930   LOCATE 1,1:T$=LEFT$(T$(I),MWT):PRINT T$;"  "
  104. 940   LT=LEN(T$)*8                 'Length of title, in pixels
  105. 950   GET(0,0)-(LT,7),M            'Copy title in graphics form
  106. 960   PUT(CC-LT\2,BM+2),M          'Put title in its
  107. 970   CC=CC+WC
  108. 980 NEXT
  109. 990 LOCATE 1,1:PRINT SPACE$(20);   'Erase last title
  110. 1000 PUT(0,0),N,PSET               'Restore axis and value
  111. 1010 'Draw bars
  112. 1020 FOR I=1 TO N
  113. 1030   T=0
  114. 1040   X1=SPB:X2=SPB+WB:Y2=BM
  115. 1050   PAT=1       'Pattern for first stacked bar
  116. 1060   FOR J=1 TO NL
  117. 1070     T=T+S(I,J)
  118. 1080     HEIGHT=(T-MIN)*FACTOR    'Height of bar
  119. 1090     Y1=MVP+TM-HEIGHT
  120. 1100     LINE(X1,Y1)-(X2,Y2),0,BF
  121. 1110     LINE(X1,Y1)-(X2,Y2),1,B
  122. 1120     IF X2-X1>2 THEN PAINT(X1+2,Y1+1),P$(PAT),1
  123. 1130     Y2=Y1
  124. 1140     PAT=PAT+1:IF PAT>NP THEN PAT=1
  125. 1150   NEXT
  126. 1160   SPB=SPB+WC    'Set position of next bar
  127. 1170 NEXT
  128. 1180 W$=INPUT$(1)
  129. 2000 DATA 4:     'Number of patterns
  130. 2010 'First Pattern
  131. 2020 DATA 1,0,0,0,1,0,0,0
  132. 2030 DATA 0,0,0,0,0,0,0,0
  133. 2040 DATA 0,0,1,0,0,0,1,0
  134. 2050 DATA 0,0,0,0,0,0,0,0
  135. 2060 DATA 1,0,0,0,1,0,0,0
  136. 2070 DATA 0,0,0,0,0,0,0,0
  137. 2080 DATA 0,0,1,0,0,0,1,0
  138. 2090 DATA 0,0,0,0,0,0,0,0
  139. 2100 'Second Pattern
  140. 2110 DATA 1,0,0,0,0,0,0,0
  141. 2120 DATA 0,1,0,0,0,0,0,0
  142. 2130 DATA 0,0,1,0,0,0,0,0
  143. 2140 DATA 0,0,0,1,0,0,0,0
  144. 2150 DATA 0,0,0,0,1,0,0,0
  145. 2160 DATA 0,0,0,0,0,1,0,0
  146. 2170 DATA 0,0,0,0,0,0,1,0
  147. 2180 DATA 0,0,0,0,0,0,0,1
  148. 2190 'Third pattern
  149. 2200 DATA 0,1,1,1,0,1,1,1
  150. 2210 DATA 1,1,1,1,1,1,1,1
  151. 2220 DATA 1,1,0,1,1,1,0,1
  152. 2230 DATA 1,1,1,1,1,1,1,1
  153. 2240 DATA 0,1,1,1,0,1,1,1
  154. 2250 DATA 1,1,1,1,1,1,1,1
  155. 2260 DATA 1,1,0,1,1,1,0,1
  156. 2270 DATA 1,1,1,1,1,1,1,1
  157. 2280 'Fourth pattern
  158. 2290 DATA 1,0,0,0,0,0,0,1
  159. 2300 DATA 0,0,0,0,0,1,1,0
  160. 2310 DATA 0,0,0,1,1,0,0,0
  161. 2320 DATA 0,1,1,0,0,0,0,0
  162. 2330 DATA 1,0,0,0,0,0,0,1
  163. 2340 DATA 0,0,0,0,0,1,1,0
  164. 2350 DATA 0,0,0,1,1,0,0,0
  165. 2360 DATA 0,1,1,0,0,0,0,0
  166.