home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / pcmag / vol4n13.arc / BAR2.BAS < prev    next >
BASIC Source File  |  1980-01-02  |  3KB  |  79 lines

  1. 'Figure 2:(longest line = 64; stat 67% in 2-column width)
  2.  
  3.  
  4.   0 '*** Program 2 **
  5.  10 INF=1.7E+38      'Infinity
  6.  20 LM=40:RM=319:TM=3: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 SCREEN 0:WIDTH 80:CLS       'Set graphics mode
  12.  60 INPUT"Number of values in vertical axis ";NV:IF NV<2 THEN 60
  13.  70 INPUT"Number of bars ";N:IF N<2 THEN 70
  14.  80 DIM S(N),T$(N)      'Set space for N values and titles
  15.  90 DIM M(200),N(200)   'Temporary arrays for GET and PUT
  16. 100 MAX=-INF           'Set maximum to minus infinity
  17. 110 MIN=INF            'Set minimum to infinity
  18. 120 FOR I=1 TO N
  19. 130   INPUT"Title, Value ";T$(I),S(I)
  20. 140   IF S(I)>MAX THEN MAX=S(I)
  21. 150   IF S(I)<MIN THEN MIN=S(I)
  22. 160 NEXT
  23. 170 IF MIN=MAX THEN PRINT"All numbers are the same.":END
  24. 180 'Find longest value
  25. 190 LNG1=LEN(STR$(INT(MAX))):IF MAX>=0 THEN LNG1=LNG1-1
  26. 200 LNG2=LEN(STR$(INT(MIN))):IF MIN>=0 THEN LNG2=LNG2-1
  27. 210 IF LNG1>LNG2 THEN MAXLEN=LNG1 ELSE MAXLEN=LNG2   'Find
  28.       length of longest value
  29. 220 IF MAXLEN*8+2>LM THEN CLS:PRINT"The left margin is too small
  30.       for the":PRINT"values to fit.  Use a larger one.":END
  31. 230 'Draw chart
  32. 240 SCREEN 1:CLS
  33. 250 LINE(LM,TM)-(LM,BM)     'Y-axis
  34. 260 LINE(LM,BM)-(RM,BM)     'X-axis
  35. 270 WC=(RM-LM+1)/N          'Width of one column
  36. 280 WB=WC*.8                'Width of one bar
  37. 290 MWT=WB\8                'Maximum width of titles
  38. 300 SPB=LM+WC*.5-(WB*.5)    'Starting point of first bar
  39. 310 CC=SPB+WB\2             'Center of first column
  40. 320 HW=BM-TM+1              'Height of window
  41. 330 MVP=INT(HW*.95)         'Maximum vertical point
  42. 340 FACTOR=MVP/(MAX-MIN)    'Scaling factor for bars
  43. 350 D=MAX-MIN               'Distance between MIN and MAX
  44. 360 FV=1/(NV-1)             'Factor to scale values
  45. 370 DY=MVP/(NV-1)           'Vertical distance between values
  46. 380 PY=TM+MVP-3:PX=LM-2-MAXLEN*8  'Position of values
  47. 390 'Put values in vertical axis
  48. 400 FOR I=0 TO NV-1
  49. 410   T=INT(D*FV*I+MIN)     'Value for Y axis
  50. 420   LOCATE 1,1:PRINT USING STRING$(MAXLEN,"#");T;
  51. 430   GET(0,0)-(MAXLEN*8-1,7),M   'Copy value in graphics form
  52. 440   LOCATE 1,1:PRINT SPACE$(MAXLEN);
  53. 450   DH=PY+3
  54. 460   PUT(PX,PY),M,PSET
  55. 470   FOR J=LM TO RM STEP 3   'Dotted line
  56. 480     PSET(J,DH)
  57. 490   NEXT
  58. 500   PY=PY-DY   'Set vertical position for next value
  59. 510 NEXT
  60. 520 GET(0,0)-(200,7),N  'Copy top-left part of screen
  61. 530 'Put titles in horizontal axis
  62. 540 FOR I=1 TO N
  63. 550   LOCATE 1,1:T$=LEFT$(T$(I),MWT):PRINT T$;"  "
  64. 560   LT=LEN(T$)*8    'Length of title, in pixels
  65. 570   GET(0,0)-(LT,7),M  'Copy title in graphics form
  66. 580   PUT(CC-LT\2,BM+2),M     'Put title in its place
  67. 590   CC=CC+WC
  68. 600 NEXT
  69. 610 LOCATE 1,1:PRINT SPACE$(20);   'Erase last title
  70. 620 PUT(0,0),N,PSET                'Restore axis and value
  71. 630 'Draw bars
  72. 640 FOR I=1 TO N
  73. 650   HEIGHT=(S(I)-MIN)*FACTOR  'Height of bar
  74. 660   LINE(SPB,MVP-HEIGHT+TM)-(SPB+WB,BM),2,BF
  75. 670   LINE(SPB,MVP-HEIGHT+TM)-(SPB+WB,BM),3,B
  76. 680   SPB=SPB+WC    'Set position of next bar
  77. 690 NEXT
  78. 700 W$=INPUT$(1)
  79.