Return to g2.e CVS log

Up to [Research Unix] / researchv10no / cmd / view2d

Annotation of researchv10no/cmd/view2d/g2.e, revision 1.1

1.1     ! root        1: procedure g2sc(s,x,n)
        !             2: integer n, i, j
        !             3: real s(6), x(2,n), denom, xmin(2), xmax(2)
        !             4: do i=1,2{
        !             5:    xmin(i)=x(i,1)
        !             6:    xmax(i)=x(i,1)
        !             7:    do j=2,n{
        !             8:       xmin(i)=amin1(xmin(i),x(i,j))
        !             9:       xmax(i)=amax1(xmax(i),x(i,j))
        !            10:       }
        !            11:    denom=xmax(i)-xmin(i)+1.0e-4*(abs(xmax(i))+abs(xmin(i)))+1.0e-12
        !            12:    s(i)=1.0e0/denom
        !            13:    s(i+4)=-s(i)*xmin(i)
        !            14:    }
        !            15: s(4)=s(2)
        !            16: s(2)=0
        !            17: s(3)=0
        !            18: end
        !            19: #-------------------------------------------------------------------
        !            20: procedure g2sce(s,x,n)
        !            21: integer n, i, j
        !            22: real s(6), x(2,n), denom, xmin(2), xmax(2)
        !            23: denom=1.0e-20
        !            24: do i=1,2{
        !            25:    xmin(i)=x(i,1)
        !            26:    xmax(i)=x(i,1)
        !            27:    do j=2,n{
        !            28:       xmin(i)=amin1(xmin(i),x(i,j))
        !            29:       xmax(i)=amax1(xmax(i),x(i,j))
        !            30:       }
        !            31:    denom=amax1(denom,
        !            32:       xmax(i)-xmin(i)+1.0e-4*(abs(xmax(i))+abs(xmin(i)))+1.0e-12)
        !            33:    }
        !            34: s(1)=1/denom
        !            35: s(2)=0
        !            36: s(3)=0
        !            37: s(4)=1/denom
        !            38: s(5)=0.5-0.5*s(1)*(xmax(1)+xmin(1))
        !            39: s(6)=0.5-0.5*s(4)*(xmax(2)+xmin(2))
        !            40: end
        !            41: #------------------------------------------------------------------
        !            42: procedure g2box(s,d)
        !            43: real box(2,5), s(6), d(2,2)
        !            44: box(1,1)=d(1,1)
        !            45: box(2,1)=d(2,1)
        !            46: box(1,2)=d(1,2)
        !            47: box(2,2)=d(2,1)
        !            48: box(1,3)=d(1,2)
        !            49: box(2,3)=d(2,2)
        !            50: box(1,4)=d(1,1)
        !            51: box(2,4)=d(2,2)
        !            52: box(1,5)=d(1,1)
        !            53: box(2,5)=d(2,1)
        !            54: g2li(s,box,5)
        !            55: end
        !            56: #------------------------------------------------------------------
        !            57: procedure g2gr(s,n1,n2)
        !            58: integer n1,n2,j1,j2
        !            59: real s(6),x(2,1)
        !            60: do j2=1,n2{
        !            61:    x(2,1)=j2
        !            62:    do j1=1,n1{
        !            63:       x(1,1)=j1
        !            64:       g2sy(s,x,1,'+')
        !            65:       }
        !            66:    }
        !            67: end
        !            68: #------------------------------------------------------------------
        !            69: procedure g2ti(s,d)
        !            70: integer i, lab1, nlab, labk
        !            71: integer ifloor
        !            72: real s(6), p(2,2), tic1(2), tic2(2)
        !            73: real d(2,2), l, h
        !            74: l=d(1,1)
        !            75: h=d(1,2)
        !            76: labk=ifloor(alog10((h-l)/2.0001))
        !            77: lab1=ifloor(0.0001+l*10.0**(-labk))
        !            78: nlab=ifloor(0.0001+h*10.0**(-labk))-lab1+1
        !            79: tic1(1)=lab1*10.0**labk
        !            80: tic1(2)=(lab1+nlab-1)*10.0**labk
        !            81: do i=1,nlab{
        !            82:    p(2,1)=d(2,1)-0.01*(d(2,2)-d(2,1))
        !            83:    p(1,1)=(lab1+i-1)*10.0**labk
        !            84:    p(2,2)=d(2,1)
        !            85:    p(1,2)=p(1,1)
        !            86:    g2li(s,p,2)
        !            87:    }
        !            88: l=d(2,1)
        !            89: h=d(2,2)
        !            90: labk=ifloor(alog10((h-l)/2.0001))
        !            91: lab1=ifloor(0.0001+l*10.0**(-labk))
        !            92: nlab=ifloor(0.0001+h*10.0**(-labk))-lab1+1
        !            93: tic2(1)=lab1*10.0**labk
        !            94: tic2(2)=(lab1+nlab-1)*10.0**labk
        !            95: do i=1,nlab{
        !            96:    p(1,1)=d(1,1)-0.01*(d(1,2)-d(1,1))
        !            97:    p(2,1)=(lab1+i-1)*10.0**labk
        !            98:    p(1,2)=d(1,1)
        !            99:    p(2,2)=p(2,1)
        !           100:    g2li(s,p,2)
        !           101:    }
        !           102: #write(,{" tics ":c,tic1:e(15,5)," to ":c,tic2:e(15,5)})
        !           103: end
        !           104: #------------------------------------------------------------------
        !           105: procedure number ( s, q, i )
        !           106:    real q(2)
        !           107:    integer i, digits(10)
        !           108:    real s(6)
        !           109:    initial digits = ("0","1","2","3","4","5","6","7","8","9")
        !           110:    g2sy(s,q,1,digits(1+mod(i,10)))
        !           111:    end
        !           112: #------------------------------------------------------------------
        !           113: integer function ifloor(x)
        !           114: real x
        !           115: ifloor=int(x)
        !           116: if(x<ifloor){ifloor=ifloor-1}
        !           117: end
        !           118: #------------------------------------------------------------------
        !           119: procedure g2ca(s,d,n1,n2,f)
        !           120: integer n1, n2, j1, j2
        !           121: real s(6), d(2,2), f(n1,n2), c(5)
        !           122: real fmax, fmin
        !           123: fmax=-1e30
        !           124: fmin=-fmax
        !           125: #write(,{" n1,n2=",n1:i(10),n2:i(10)})
        !           126: do j1=1,n1{
        !           127:    do j2=1,n2{
        !           128:       fmax=amax1(fmax,f(j1,j2))
        !           129:       fmin=amin1(fmin,f(j1,j2))
        !           130:       }}
        !           131: #write(,{"fmax, fmin=":c,fmax:e(15,3),fmin:e(15,3)})
        !           132: do j1=1,5{
        !           133:    c(j1)= fmin+j1*(fmax-fmin)/6
        !           134:    #write(,{" contour ":c,c(j1):e(15,7)})
        !           135:    }
        !           136: g2co(s,d,n1,n2,f,5,c)
        !           137: end
        !           138: #  g2   a simple plot package
        !           139: #       NPLOT VERSION
        !           140: #       (ehg 30 aug 84)
        !           141: #
        !           142: #  g2open    initialize system.
        !           143: #  g2ff      start a picture.
        !           144: #  g2clos    finish up plotting.
        !           145: #  g2sc(s,x,n)  set up coordinate transform
        !           146: #    where  x is a collection of points dimensioned (2,n)
        !           147: #    and on output s is a coordinate transform
        !           148: #       [ w(1) ]   [ s(1) s(2) ] [ x(1) ]   [ s(5) ]
        !           149: #       [      ] = [           ] [      ] + [      ]
        !           150: #       [ w(2) ]   [ s(3) s(4) ] [ x(2) ]   [ s(6) ].
        !           151: #  g2sce(s,x,n)  does the same, but forces s(1)=s(4)
        !           152: #     (so that circles come out as circles and not ellipses)
        !           153: #  g2li(s,x,n)  draws lines between the points x.
        !           154: #  g2lit(j)  sets the line type.
        !           155: #    where j=0 solid, =1 dash, =2 dots.
        !           156: #  g2sy(s,x,n,'+')  puts a '+' at each of the points x.
        !           157: #  g2arc(s,center,start,stop) draws a circular arc counterclockwise from start
        !           158: #    to stop, about specified center
        !           159: #  g2ti(s,d)  draws tic marks around a rectangle where d is dimensioned (2,2),
        !           160: #    d(,1)=lower left corner, and d(,2)=upper right corner.
        !           161: #  g2box(s,d)  draws the rectangle d
        !           162: #  g2co(s,d,n1,n2,f,nc,c)  draws contours at levels c(j), 1<=j<=nc
        !           163: #    for function values f given on a n1 by n2 array corresponding 
        !           164: #    to rectangle d.
        !           165: #
        !           166: #------------------------------------------------------------------
        !           167: procedure g2open
        !           168: write(,"..o")
        !           169: write(,"..ra -0.1 -0.1 1.1 1.1")
        !           170: end
        !           171: #------------------------------------------------------------------
        !           172: procedure g2ff
        !           173: integer frame
        !           174: initial frame = 0
        !           175: frame=frame+1
        !           176: if ( frame > 1 ) { write(,"..pau"); write(,"..e") }
        !           177: end
        !           178: #------------------------------------------------------------------
        !           179: procedure g2clos
        !           180: write(,"..cl")
        !           181: end
        !           182: #------------------------------------------------------------------
        !           183: procedure g2tx(s,x,n,char)
        !           184: #  write n characters at x
        !           185: integer n, i, j
        !           186: real char(1), s(6), x(2), xp, yp
        !           187:   xp=s(1)*x(1)+s(2)*x(2)+s(5)
        !           188:   yp=s(3)*x(1)+s(4)*x(2)+s(6)
        !           189:   write(,"..m ",xp:f(10,7),yp:f(10,7))
        !           190:   write(,"..t ",char:c(4))
        !           191: end
        !           192: #------------------------------------------------------------------
        !           193: procedure g2li(s,x,n)
        !           194: integer n, j
        !           195: real s(6), x(2,n), x1, y1
        !           196: j=1
        !           197: x1=s(1)*x(1,j)+s(2)*x(2,j)+s(5)
        !           198: y1=s(3)*x(1,j)+s(4)*x(2,j)+s(6)
        !           199: write(,"..m ",x1:f(10,7),y1:f(10,7))
        !           200: do j=2,n{
        !           201:   x1=s(1)*x(1,j)+s(2)*x(2,j)+s(5)
        !           202:   y1=s(3)*x(1,j)+s(4)*x(2,j)+s(6)
        !           203:   write(,"..v ",x1:f(10,7),y1:f(10,7))
        !           204:   }
        !           205: end
        !           206: #------------------------------------------------------------------
        !           207: procedure g2la(s,x,n)
        !           208: # (like g2li, but only connect pairs of points)
        !           209: integer n, j
        !           210: real s(6), x(2,n), xb, xf, yb, yf
        !           211: do j=1,n/2{
        !           212:   xb=s(1)*x(1,2*j-1)+s(2)*x(2,2*j-1)+s(5)
        !           213:   yb=s(3)*x(1,2*j-1)+s(4)*x(2,2*j-1)+s(6)
        !           214:   xf=s(1)*x(1,2*j)  +s(2)*x(2,2*j)  +s(5)
        !           215:   yf=s(3)*x(1,2*j)  +s(4)*x(2,2*j)  +s(6)
        !           216:   write(,"..li ",xb:f(10,7),yb:f(10,7),xf:f(10,7),yf:f(10,7))
        !           217:   }
        !           218: end
        !           219: #------------------------------------------------------------------
        !           220: procedure g2lit(l)
        !           221: integer l
        !           222: if(l==0){
        !           223:   write(,"..co white/solid/H*")
        !           224:   }
        !           225: else if(l==1){
        !           226:   write(,"..co red/longdashed/H#")
        !           227:   }
        !           228: else if(l==2){
        !           229:   write(,"..co green/dotdashed/H$")
        !           230:   }
        !           231: end
        !           232: #------------------------------------------------------------------
        !           233: procedure g2sy(s,x,n,char)
        !           234: integer n, j
        !           235: real char
        !           236: real s(6), x(2,n), xp, yp
        !           237: do j=1,n{
        !           238:   xp=s(1)*x(1,j)+s(2)*x(2,j)+s(5)
        !           239:   yp=s(3)*x(1,j)+s(4)*x(2,j)+s(6)
        !           240:   write(,"..m ",xp:f(10,7),yp:f(10,7))
        !           241:   write(,"..t ",char:c(1))
        !           242:   }
        !           243: end
        !           244: #------------------------------------------------------------------
        !           245: procedure g2arc ( s, c, a, b )
        !           246:   real s(6), c(2), a(2), b(2), radius, start
        !           247:   real finish, pi, x(2), y(2), z(2)
        !           248:   pi=4*atan(1.0e0)
        !           249:   x(1)=s(1)*c(1)+s(2)*c(2)+s(5)
        !           250:   x(2)=s(3)*c(1)+s(4)*c(2)+s(6)
        !           251:   y(1)=s(1)*a(1)+s(2)*a(2)+s(5)
        !           252:   y(2)=s(3)*a(1)+s(4)*a(2)+s(6)
        !           253:   z(1)=s(1)*b(1)+s(2)*b(2)+s(5)
        !           254:   z(2)=s(3)*b(1)+s(4)*b(2)+s(6)
        !           255:   radius=sqrt((x(1)-y(1))**2+(x(2)-y(2))**2)
        !           256:   if ( radius > 5. ) {
        !           257:      write(,"..li ",y(1):f(10,7),y(2):f(10,7),z(1):f(10,7),z(2):f(10,7))
        !           258:      }
        !           259:   else {
        !           260:      start=atan2(y(2)-x(2),y(1)-x(1))
        !           261:      finish=atan2(z(2)-x(2),z(1)-x(1))
        !           262:      write(,"..a ",y:f(10,7),z:f(10,7),x:f(13,7),radius:f(13,7))
        !           263:      }
        !           264:   end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.