home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l076 / 1.ddi / GRAPHLIB.TRU < prev    next >
Encoding:
Text File  |  1985-01-09  |  4.7 KB  |  186 lines
  1. !  Graphics routines
  2. !
  3. !  a True BASIC(tm) product
  4. !
  5. !  ABSTRACT
  6. !  A library of general purpose graphics routines
  7. !  for use in user programs.
  8. !
  9. !  Copyright (c)1985, True BASIC, Inc.
  10.  
  11. EXTERNAL
  12.  
  13. SUB frame                         ! Frame window
  14.     ASK window x1,x2,y1,y2
  15.     BOX LINES x1,x2,y1,y2
  16. END SUB
  17.  
  18. SUB axes                          ! Draw axes
  19.     ASK window x1,x2,y1,y2
  20.     PLOT x1,0;x2,0
  21.     PLOT 0,y1;0,y2
  22. END SUB
  23.  
  24. SUB ticks(x,y)                    ! Axes with ticks, x and y units apart
  25.     ASK screen u1,u2,v1,v2
  26.     ASK window x1,x2,y1,y2
  27.     ASK mode m$
  28.     PLOT x1,0;x2,0
  29.     PLOT 0,y1;0,y2
  30.     IF m$="hires" then LET xu=640 else LET xu = 320
  31.     LET p1 = abs(v2-v1)*200       ! Pixels vertical
  32.     LET p2 = abs(u2-u1)*xu        ! Pixels horizontal
  33.     LET r = min(p1/50,p2/50)      ! Small fraction
  34.     LET r = max(r,2)+.5           ! At least 2, avoid round error
  35.     LET d1 = r/p1*abs(y2-y1)      ! For x
  36.     LET d2 = r/p2*abs(x2-x1)      ! For y
  37.     CALL mark(x1,x,1,d1)
  38.     CALL mark(x2,x,1,d1)
  39.     CALL mark(y1,y,2,d2)
  40.     CALL mark(y2,y,2,d2)
  41.  
  42.     SUB mark(u2,us,c,d)           ! Does one tick
  43.         IF u2=0 then EXIT SUB
  44.         FOR u = 0 to u2 step sgn(u2)*us
  45.             IF c=1 then
  46.                PLOT u,-d;u,d
  47.             ELSE
  48.                PLOT -d,u;d,u
  49.             END IF
  50.         NEXT u
  51.     END SUB
  52.  
  53. END SUB
  54.  
  55.  
  56. SUB polygon(x1,x2,y1,y2,n)        ! n-sided, in box
  57.  
  58.     LET c1 = (x1+x2)/2            ! Center
  59.     LET c2 = (y1+y2)/2
  60.     LET r1 = abs(x2-x1)/2         ! Radius
  61.     LET r2 = abs(y2-y1)/2
  62.     LET delta = 2*pi/n            ! Angle step
  63.     FOR i = 0 to n
  64.         LET a = i*delta
  65.         LET x = c1 + r1*cos(a)
  66.         LET y = c2 + r2*sin(a)
  67.         PLOT x,y;
  68.     NEXT i
  69.     PLOT
  70.  
  71. END SUB
  72.  
  73. SUB bars(data(),n)                ! Bar graph of data
  74.  
  75.     LET low,high = data(1)        ! Scale
  76.     FOR i = 2 to n
  77.         LET x = data(i)
  78.         IF x<low then LET low = x
  79.         IF x>high then LET high = x
  80.     NEXT i
  81.     LET low = min(low,0)
  82.     LET high = max(high,0)
  83.     IF high = low then LET high = high + 1
  84.     LET range = max(abs(high),abs(low))
  85.     LET r = int(log10(range))
  86.     LET s = 10^r
  87.     CALL divide(high,s,q,r)
  88.     IF r>0 then LET high = (q+1)*s
  89.     CALL divide(low,s,q,r)
  90.     LET low = q*s
  91.  
  92.     LET n2 = max(n,8)             ! Coordinates
  93.     ASK screen u1,u2,v1,v2
  94.     LET pix = abs(u2-u1)*320      ! Horizontal pixels
  95.     LET left = -32                ! 4 characters
  96.     LET w = int((pix+left)/n2)    ! Pixels per bar
  97.     LET w1 = int(w/3)
  98.     LET w2 = int(w/6)
  99.     LET delta = (high-low)/16
  100.     SET WINDOW left,n2*w,low-delta/2,high
  101.     SET COLOR 1
  102.     PLOT 0,0;n*w,0
  103.     PLOT 0,low;0,high
  104.     SET COLOR 2
  105.     FOR i = 1 to n
  106.         BOX AREA (i-1)*w+w1,i*w-w2,0,data(i)
  107.     NEXT i
  108.     SET COLOR 3
  109.     LET f$ = ">###"
  110.     IF high>0 then PLOT TEXT, at left,high-delta: using$(f$,str$(high)[1:4])
  111.     PLOT TEXT, at left,0-delta/2: using$(f$,"0")
  112.     IF low<0 then PLOT TEXT, at left,low: using$(f$,str$(low)[1:4])
  113.  
  114. END SUB
  115.  
  116. SUB arc(x,y,r,a1,a2)              ! Arc of circle, between angles a1, a2
  117.  
  118.     DEF radn(x) = x*pi/180
  119.     FOR d = a1 to a2 step .5
  120.         LET d1 = mod(d,360)
  121.         SELECT CASE d1
  122.         CASE is <= 45
  123.              LET u = radn(d1)     ! Degrees to radians
  124.              CALL ab
  125.              PLOT points: x+b,y+a
  126.         CASE is <= 90
  127.              LET u = radn(90-d1)
  128.              CALL ab
  129.              PLOT points: x+a,y+b
  130.         CASE is <= 135
  131.              LET u = radn(d1-90)
  132.              CALL ab
  133.              PLOT points: x-a,y+b
  134.         CASE is <= 180
  135.              LET u = radn(180-d1)
  136.              CALL ab
  137.              PLOT points: x-b,y+a
  138.         CASE is <= 225
  139.              LET u = radn(d1-180)
  140.              CALL ab
  141.              PLOT points: x-b,y-a
  142.         CASE is <= 270
  143.              LET u = radn(270-d1)
  144.              CALL ab
  145.              PLOT points: x-a,y-b
  146.         CASE is <= 315
  147.              LET u = radn(d1-270)
  148.              CALL ab
  149.              PLOT points: x+a,y-b
  150.         CASE else
  151.              LET u = radn(360-d1)
  152.              CALL ab
  153.              PLOT points: x+b,y-a
  154.         END SELECT
  155.     NEXT d
  156.  
  157.     SUB ab
  158.         LET a = r*u*(1-u*u/8)
  159.         LET b = r*(1-u*u/2)
  160.     END SUB
  161.  
  162. END SUB
  163.  
  164.  
  165. SUB fplot(a,b)                    ! Plot function f from a to b
  166.  
  167.     DIM temp(0 to 64,2)
  168.     DECLARE DEF f
  169.     LET delta = (b-a)/64
  170.     LET y1 = +1e100
  171.     LET y2 = -1e100
  172.     FOR i = 0 to 64
  173.         LET x = a + i*delta
  174.         LET y = f(x)
  175.         IF y<y1 then LET y1 = y
  176.         IF y>y2 then LET y2 = y
  177.         LET temp(i,1) = x
  178.         LET temp(i,2) = y
  179.     NEXT i
  180.     SET WINDOW a,b,y1,y2
  181.     FOR i = 0 to 64
  182.         PLOT temp(i,1), temp(i,2);
  183.     NEXT i
  184.     PLOT
  185. END SUB
  186.