home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l196 / 3.ddi / BAR.BA$ / BAR.bin
Encoding:
Text File  |  1990-06-24  |  5.9 KB  |  209 lines
  1. ' Define type for the titles:
  2. TYPE TitleType
  3.    MainTitle AS STRING * 40
  4.    XTitle AS STRING * 40
  5.    YTitle AS STRING * 18
  6. END TYPE
  7.  
  8. DECLARE SUB InputTitles (T AS TitleType)
  9. DECLARE FUNCTION DrawGraph$ (T AS TitleType, Label$(), Value!(), N%)
  10. DECLARE FUNCTION InputData% (Label$(), Value!())
  11.  
  12. ' Variable declarations for titles and bar data:
  13. DIM Titles AS TitleType, Label$(1 TO 5), Value(1 TO 5)
  14.  
  15. CONST FALSE = 0, TRUE = NOT FALSE
  16.  
  17. DO
  18.    InputTitles Titles
  19.    N% = InputData%(Label$(), Value())
  20.    IF N% <> FALSE THEN
  21.       NewGraph$ = DrawGraph$(Titles, Label$(), Value(), N%)
  22.    END IF
  23. LOOP WHILE NewGraph$ = "Y"
  24.  
  25. END
  26.  
  27. ' ======================== DRAWGRAPH ======================
  28. '   Draws a bar graph from the data entered in the
  29. '   INPUTTITLES and INPUTDATA procedures.
  30. ' =========================================================
  31. FUNCTION DrawGraph$ (T AS TitleType, Label$(), Value(), N%) STATIC
  32.  
  33.    ' Set size of graph:
  34.    CONST GRAPHTOP = 24, GRAPHBOTTOM = 171
  35.    CONST GRAPHLEFT = 48, GRAPHRIGHT = 624
  36.    CONST YLENGTH = GRAPHBOTTOM - GRAPHTOP
  37.  
  38.    ' Calculate maximum and minimum values:
  39.    YMax = 0
  40.    YMin = 0
  41.    FOR I% = 1 TO N%
  42.       IF Value(I%) < YMin THEN YMin = Value(I%)
  43.       IF Value(I%) > YMax THEN YMax = Value(I%)
  44.    NEXT I%
  45.  
  46.    ' Calculate width of bars and space between them:
  47.    BarWidth = (GRAPHRIGHT - GRAPHLEFT) / N%
  48.    BarSpace = .2 * BarWidth
  49.    BarWidth = BarWidth - BarSpace
  50.  
  51.    SCREEN 2
  52.    CLS
  53.  
  54.    ' Draw y-axis:
  55.    LINE (GRAPHLEFT, GRAPHTOP)-(GRAPHLEFT, GRAPHBOTTOM), 1
  56.  
  57.    ' Draw main graph title:
  58.    Start% = 44 - (LEN(RTRIM$(T.MainTitle)) / 2)
  59.    LOCATE 2, Start%
  60.    PRINT RTRIM$(T.MainTitle);
  61.  
  62.    ' Annotate y-axis:
  63.    Start% = CINT(13 - LEN(RTRIM$(T.YTitle)) / 2)
  64.    FOR I% = 1 TO LEN(RTRIM$(T.YTitle))
  65.       LOCATE Start% + I% - 1, 1
  66.       PRINT MID$(T.YTitle, I%, 1);
  67.    NEXT I%
  68.  
  69.    ' Calculate scale factor so labels aren't bigger than four digits:
  70.    IF ABS(YMax) > ABS(YMin) THEN
  71.       Power = YMax
  72.    ELSE
  73.       Power = YMin
  74.    END IF
  75.    Power = CINT(LOG(ABS(Power) / 100) / LOG(10))
  76.    IF Power < 0 THEN Power = 0
  77.  
  78.    ' Scale minimum and maximum values down:
  79.    ScaleFactor = 10 ^ Power
  80.    YMax = CINT(YMax / ScaleFactor)
  81.    YMin = CINT(YMin / ScaleFactor)
  82.    ' If power isn't zero then put scale factor on chart:
  83.    IF Power <> 0 THEN
  84.       LOCATE 3, 2
  85.       PRINT "x 10^"; LTRIM$(STR$(Power))
  86.    END IF
  87.  
  88.    ' Put tic mark and number for Max point on y-axis:
  89.    LINE (GRAPHLEFT - 3, GRAPHTOP) -STEP(3, 0)
  90.    LOCATE 4, 2
  91.    PRINT USING "####"; YMax
  92.  
  93.    ' Put tic mark and number for Min point on y-axis:
  94.    LINE (GRAPHLEFT - 3, GRAPHBOTTOM) -STEP(3, 0)
  95.    LOCATE 22, 2
  96.    PRINT USING "####"; YMin
  97.  
  98.    YMax = YMax * ScaleFactor ' Scale minimum and maximum back
  99.    YMin = YMin * ScaleFactor ' up for charting calculations.
  100.  
  101.    ' Annotate x-axis:
  102.    Start% = 44 - (LEN(RTRIM$(T.XTitle)) / 2)
  103.    LOCATE 25, Start%
  104.    PRINT RTRIM$(T.XTitle);
  105.  
  106.    ' Calculate the pixel range for the y-axis:
  107.    YRange = YMax - YMin
  108.  
  109.    ' Define a diagonally striped pattern:
  110.    Tile$ = CHR$(1)+CHR$(2)+CHR$(4)+CHR$(8)+CHR$(16)+CHR$(32)+CHR$(64)+CHR$(128)
  111.  
  112.    ' Draw a zero line if appropriate:
  113.    IF YMin < 0 THEN
  114.       Bottom = GRAPHBOTTOM - ((-YMin) / YRange * YLENGTH)
  115.       LOCATE INT((Bottom - 1) / 8) + 1, 5
  116.       PRINT "0";
  117.    ELSE
  118.       Bottom = GRAPHBOTTOM
  119.    END IF
  120.  
  121.    ' Draw x-axis:
  122.    LINE (GRAPHLEFT - 3, Bottom)-(GRAPHRIGHT, Bottom)
  123.    ' Draw bars and labels:
  124.    Start% = GRAPHLEFT + (BarSpace / 2)
  125.    FOR I% = 1 TO N%
  126.  
  127.       ' Draw a bar label:
  128.       BarMid = Start% + (BarWidth / 2)
  129.       CharMid = INT((BarMid - 1) / 8) + 1
  130.       LOCATE 23, CharMid - INT(LEN(RTRIM$(Label$(I%))) / 2)
  131.       PRINT Label$(I%);
  132.  
  133.       ' Draw the bar and fill it with the striped pattern:
  134.       BarHeight = (Value(I%) / YRange) * YLENGTH
  135.       LINE (Start%, Bottom) -STEP(BarWidth, -BarHeight), , B
  136.       PAINT (BarMid, Bottom - (BarHeight / 2)), Tile$, 1
  137.  
  138.       Start% = Start% + BarWidth + BarSpace
  139.    NEXT I%
  140.    LOCATE 1, 1
  141.    PRINT "New graph? ";
  142.    DrawGraph$ = UCASE$(INPUT$(1))
  143.  
  144. END FUNCTION
  145.  
  146. ' ======================== INPUTDATA ======================
  147. '     Gets input for the bar labels and their values
  148. ' =========================================================
  149. FUNCTION InputData% (Label$(), Value()) STATIC
  150.  
  151.    ' Initialize the number of data values:
  152.    NumData% = 0
  153.  
  154.    ' Print data-entry instructions:
  155.    CLS
  156.    PRINT "Enter data for up to 5 bars:"
  157.    PRINT "   * Enter the label and value for each bar."
  158.    PRINT "   * Values can be negative."
  159.    PRINT "   * Enter a blank label to stop."
  160.    PRINT
  161.    PRINT "After viewing the graph, press any key ";
  162.    PRINT "to end the program."
  163.  
  164.    ' Accept data until blank label or 5 entries:
  165.    Done% = FALSE
  166.    DO
  167.       NumData% = NumData% + 1
  168.       PRINT
  169.       PRINT "Bar("; LTRIM$(STR$(NumData%)); "):"
  170.       INPUT ; "        Label? ", Label$(NumData%)
  171.  
  172.       ' Only input value if label isn't blank:
  173.       IF Label$(NumData%) <> "" THEN
  174.      LOCATE , 35
  175.      INPUT "Value? ", Value(NumData%)
  176.  
  177.       ' If label is blank, decrement data counter
  178.       ' and set Done flag equal to TRUE:
  179.       ELSE
  180.      NumData% = NumData% - 1
  181.      Done% = TRUE
  182.       END IF
  183.    LOOP UNTIL (NumData% = 5) OR Done%
  184.  
  185.    ' Return the number of data values input:
  186.    InputData% = NumData%
  187.  
  188. END FUNCTION
  189.  
  190. ' ====================== INPUTTITLES ======================
  191. '     Accepts input for the three different graph titles
  192. ' =========================================================
  193. SUB InputTitles (T AS TitleType) STATIC
  194.    SCREEN 0, 0        ' Set text screen.
  195.    DO            ' Input titles.
  196.       CLS
  197.       INPUT "Enter main graph title: ", T.MainTitle
  198.       INPUT "Enter x-axis title    : ", T.XTitle
  199.       INPUT "Enter y-axis title    : ", T.YTitle
  200.  
  201.       ' Check to see if titles are OK:
  202.       LOCATE 7, 1
  203.       PRINT "OK (Y to continue, N to change)? ";
  204.       LOCATE , , 1
  205.       OK$ = UCASE$(INPUT$(1))
  206.    LOOP UNTIL OK$ = "Y"
  207. END SUB
  208.  
  209.