subroutine LADRW (ibit1,ibit2,ixp1,iyp1,ixp2,iyp2,mode,iasc, & iarq,isym,inter,rumbr,char4,char8,log) c c is a version of LADRAW which calls the experimental routine ASMBL c c ibit1 ibit2 operation 1 operation 2 c to 1st coord. to 2nd coord. c 0 0 abs. move abs. draw c 0 1 " rel. " c 1 0 rel. move abs. draw c 1 1 " rel. " c 2 2 abs. draw abs. move c 2 3 " rel. " c 3 2 rel. draw abs. move c 3 3 " rel. " c 4 0 abs. move to 1st coord. c 5 0 rel. move " c 6 0 abs. draw " c 7 0 rel. draw " c mode 1: mark with different symbol (isym = 1 to 6) c 2: print number with an integer input, field: i5 c 3: print number with a real no. input, field: f5.0 c 4: print number with a real no. input, field: f5.1 c 5: print number with a real no. input, field: f5.2 c 6: print characters with Real*4 as input (normal form) c 7: print characters with Real*8 as input (double precision) c 8: print characters with Logical*1 as input c logical*1 text(80),log(40),act1,act2 real*8 char8 real*4 char4(10) c-----Terminator c call scopy ('=@@',text) c call sendw (text,3) d type *,'-----------wadraw-----------' d type *,' ibit1,ibit2=',ibit1,ibit2 d type *,' ixp1,iyp1,ixp2,iyp2=',ixp1,iyp1,ixp2,iyp2 d type *,' mode=',mode d type *,'----------------------------' 1 if (mode.gt.8) go to 1000 c-------------------------------------------------------------- iby=ibit1+1 go to (5,6,7,8,5,6,7,8) iby 5 act1='M' act2='D' if (ibit2.eq.1) act2='I' if (ibit1.eq.4) go to 25 go to 20 6 act1='R' act2='D' if (ibit2.eq.1) act2='I' if (ibit1.eq.5) go to 25 go to 20 7 act1='D' act2='M' if (ibit2.eq.3) act2='R' if (ibit1.eq.6) go to 25 go to 20 8 act1='I' act2='M' if (ibit2.eq.3) act2='R' if (ibit1.eq.7) go to 25 go to 20 c-----send operation codes and coordinates 20 call lgo(act1,ixp1,iyp1) call lgo(act2,ixp2,iyp2) ix=ixp2 iy=iyp2 go to 30 25 call lgo(act1,ixp1,iyp1) ix=ixp1 iy=iyp1 c------------------------------------------------------------- 30 if (mode.le.0) return if (mode.gt.1) call siz(iasc) go to (100,200,300,400,500,600,700,800) mode c-----mark a symbol c if isym < 0, do not redefine the symbol in the subroutine ASMBL 100 call asmbl(isym,ix,iy) return c-----print numbers 200 encode (5,220,text) inter 220 format(i5) call rotat(iarq) call lpr(text,5) call rotat(-iarq) return 300 continue if (rumbr.gt.-999.4999) go to 315 encode (6,310,text) rumbr 310 format (f6.0) call rotat(iarq) call lpr(text,6) call rotat(-iarq) return 315 encode (5,320,text) rumbr 320 format (f5.0) call rotat(iarq) call lpr(text,5) call rotat(-iarq) d type *,' rumbr=',rumbr return 400 encode (5,420,text) rumbr 420 format (f5.1) call rotat(iarq) call lpr(text,5) call rotat(-iarq) d type *,' rumbr=',rumbr return 500 encode (5,520,text) rumbr 520 format (f5.2) call rotat(iarq) call lpr(text,5) call rotat(-iarq) return c-----print characters 600 encode (40,620,text) (char4(j),j=1,10) 620 format (10a4) d type 650, (text(j),j=1,40) 650 format (' '40a1) call rotat(iarq) call lpr(text,40) call rotat(-iarq) return 700 encode (8,720,text) char8 720 format (a8) call rotat(iarq) call lpr(text,8) call rotat(-iarq) return 800 nchar=len(log) call rotat(iarq) call lpr(log,nchar) call rotat(-iarq) return c 1000 type *,' undefined operating mode!! ' type *,' re-entry mode :(1-8) ' accept 1200,mode 1200 format(i1) go to 1 return end