home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 13.ddi / PSTTCS.FOR < prev    next >
Encoding:
Text File  |  1980-01-04  |  5.1 KB  |  270 lines
  1.     SUBROUTINE DRAWR(X,Y)
  2.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  3.     COMMON /POPSC/I1,I2
  4.     CALL CHXY(X,Y,IX,IY)
  5.     IX=IX+I1
  6.     IY=IY+I2
  7. C    IY=360-IY
  8.     CALL LINE (I1,I2,IX,IY,2)
  9.     I1=IX
  10.     I2=IY
  11.     RETURN
  12.     END
  13.     SUBROUTINE DRAWA(X,Y)
  14.     COMMON /POPSC/I1,I2
  15.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  16.     CALL CHXY(X,Y,IX,IY)
  17. C    IY=360-IY
  18.     CALL LINE (I1,I2,IX,IY,2)
  19.     I1=IX
  20.     I2=IY
  21.     RETURN
  22.     END
  23.     SUBROUTINE DRWABS (IX,IY)
  24.      COMMON /VIDEO/ICM,IGR,IXM,IYM,ICHX,ICHY,IXB,IYB
  25.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  26.     COMMON /POPSC/I1,I2
  27.     CALL CHIXY(IX,IY,IXX,IYY)
  28. CIYY=360-IYY
  29.     CALL LINE (I1,I2,IXX,IYY,2)
  30.     I1=IXX
  31.     I2=IYY
  32.     RETURN
  33.     END
  34.     SUBROUTINE DRWREL(IX,IY)
  35.      COMMON /VIDEO/ICM,IGR,IXM,IYM,ICHX,ICHY,IXB,IYB
  36.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  37.     COMMON /POPSC/I1,I2
  38.     CALL CHIXY(IX,IY,IXX,IYY)
  39.     IXX=IXX+I1
  40.     IYY=IYY+I2
  41. C    IYY=360-IYY
  42.     CALL LINE (I1,I2,IXX,IYY,2)
  43.     I1=IXX
  44.     I2=IYY
  45.     RETURN
  46.     END
  47.     SUBROUTINE DRWREL1(IX,IY)
  48.      COMMON /VIDEO/ICM,IGR,IXM,IYM,ICHX,ICHY,IXB,IYB
  49.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  50.     COMMON /POPSC/I1,I2
  51.     CALL CHIXY(IX,IY,IXX,IYY)
  52.     IXX=IXX+I1
  53.     IYY=IYY+I2
  54. C    IYY=360-IYY
  55.     CALL LINE (I1,I2,IXX,IYY,3)
  56.     I1=IXX
  57.     I2=IYY
  58.     RETURN
  59.     END
  60.     SUBROUTINE CHXY(X,Y,IX,IY)
  61.     COMMON /WENDU/XM1,XM2,YM1,YM2
  62.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  63.      COMMON /VIDEO/ICM,IGR,IXM,IYM,ICHX,ICHY,IXB,IYB
  64.     XL=XM2-XM1
  65.     YL=YM2-YM1
  66.     X1=(X-XM1)*(MAX-MIX)/XL
  67.     Y1=(Y-YM1)*(MAY-MIY)/YL
  68.     IX=X1
  69.     IY=Y1
  70.     RETURN
  71.     END
  72.     SUBROUTINE CHIXY(I1,I2,IX,IY)
  73.     COMMON /WENDU/XM1,XM2,YM1,YM2
  74.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  75.      COMMON /VIDEO/ICM,IGR,IXM,IYM,ICHX,ICHY,IXB,IYB
  76.     IX=I1*(MAX-MIX)/1024
  77.     IY=I2*(MAY-MIY)/960
  78.     RETURN
  79.     END
  80.     SUBROUTINE VWINDO(X1,X2,Y1,Y2)
  81.     XMAX=X1+X2
  82.     YMAX=Y1+Y2
  83.     CALL DWINDO(X1,XMAX,Y1,YMAX)
  84.     RETURN
  85.     END
  86.     SUBROUTINE SWINDO(MINX,LENX,MINY,LENY)
  87.     MAXX=MINX+LENX
  88.     MAXY=MINY+LENY
  89.     CALL TWINDO(MINX,MAXX,MINY,MAXY)
  90.     RETURN
  91.     END
  92.     SUBROUTINE TWINDO(MINX,MAXX,MINY,MAXY)
  93.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  94.      COMMON /VIDEO/ICM,IGR,IXM,IYM,ICHX,ICHY,IXB,IYB
  95.     MIX=MINX*IXM/1024
  96.     MIY=MINY*IYM/1024
  97.     MAX=MAXX*IXM/970
  98.     MAY=MAXY*IYM/970
  99.     IF (MIX.LT.0.OR.MIX.GE.IXM) MIX=0
  100.     IF (MIY.LT.0.OR.MIX.GE.IYM) MIY=0
  101.     IF (MAX.LE.0.OR.MAX.GT.IXM) MAX=IXM
  102.     IF (MAY.LE.0.OR.MAY.GT.IYM) MAY=IYM
  103.     CALL WGRAP(MIX,MIY,MAX,MAY)
  104.     RETURN
  105.     END
  106.     SUBROUTINE DWINDO(XMIN,XMAX,YMIN,YMAX)
  107.     COMMON /WENDU/XM1,XM2,YM1,YM2
  108.     XM1=XMIN
  109.     XM2=XMAX
  110.     YM1=YMIN
  111.     YM2=YMAX
  112.     RETURN
  113.     END
  114.     SUBROUTINE MOVEA(X,Y)
  115.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  116.     COMMON /POPSC/IX,IY
  117.     CALL CHXY(X,Y,IX,IY)
  118. CIY=360-IY
  119.     CALL POINT(IX,IY,7)
  120.     RETURN
  121.     END
  122.     SUBROUTINE MOVABS(IX,IY)
  123.     COMMON /POPSC/I1,I2
  124.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  125.     CALL CHIXY(IX,IY,I1,I2)
  126. CI2=360-I2
  127.     CALL POINT (I1,I2,7)
  128.     RETURN
  129.     END
  130.     SUBROUTINE MOVER(X,Y)
  131.     COMMON /POPSC/I1,I2
  132.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  133.     CALL CHXY(X,Y,IX,IY)
  134.     IX=IX+I1
  135.     IY=IY+I2
  136. C    IY=360-IY
  137.     CALL POINT (IX,IY,7)
  138.     I1=IX
  139.     I2=IY
  140.     RETURN
  141.     END
  142.     SUBROUTINE MOVREL(IX,IY)
  143.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  144.     COMMON /POPSC/I1,I2
  145.     CALL CHIXY (IX,IY,I3,I4)
  146.     I3=I3+I1
  147.     I4=I4+I2
  148. CI4=360-I4
  149.     CALL POINT (I3,I4,7)
  150.     I1=I3
  151.     I2=I4
  152.     RETURN
  153.     END
  154.     SUBROUTINE INITT(I)
  155.      COMMON /VIDEO/ICM,IGR,IXM,IYM,ICHX,ICHY,IXB,IYB
  156.     COMMON/LAB/ILAB
  157.     INTEGER*2 C,XXA,YYA,XXB,YYB,XM,YM,CM,CHX,CHY,XB,YB,GR
  158.     INTEGER*2 XW1,YW1,XW2,YW2,XCW1,YCW1,XCW2,YCW2,X00,Y00
  159.     INTEGER*2 X0,Y0,R,TH1,TH2,CHLIN,CDX,CDY,CCX,CCY,XCC,YCC,CCC,FCC
  160.     ICF=0
  161.     CALL VIDEO(CM,GR,XM,YM,CHX,CHY,XB,YB)
  162.     ICM=CM
  163.     IGR=GR
  164.     IXM=XM
  165.     IYM=YM
  166.     IF(IXM.EQ.320.AND.IYM.EQ.200) GOTO 120
  167.         ILAB=0
  168.     GOTO 130
  169. 120    ILAB=1
  170. 130    ICHX=CHX
  171.     ICHY=CHY
  172.     IXB=XB
  173.     IYB=YB
  174.     IF(CM.EQ.0) GOTO 1000
  175.        CHLIN=4+ICF*2
  176.     YM=YM/8
  177.     YM=YM*8
  178.     C=1
  179.     CALL SCREEN(C)
  180.     CALL CLSG
  181.     C=CM
  182.     IF(GR.EQ.CM) C=C-1
  183.     CCC=CM+256
  184.     XW1=0
  185.     YW1=0
  186.     XW2=XM
  187.     YW2=YM-8*CHLIN-8
  188.     CALL LLIN(XW1,YW2,XW2,YW2,C)
  189.     XCW1=0
  190.     YCW1=CHY-CHLIN
  191.     XCW2=CHX
  192.     YCW2=CHY
  193.     CALL WTEXT(XCW1,YCW1,XCW2,YCW2)
  194.     RETURN
  195. 1000    WRITE (*,'('' TERMINAL INITIALIZATION ERROR !! '')')
  196.     STOP
  197.     END
  198.     SUBROUTINE NEWPAG
  199.     CALL CLSG
  200.     CALL CLST
  201.     RETURN
  202.     END
  203.     SUBROUTINE DASHA (X,Y)
  204.     COMMON /POPSC/I1,I2
  205.     CALL CHXY (X,Y,IX,IY)
  206.     CALL LINE (I1,I2,IX,IY,3)
  207.     I1=IX
  208.     I2=IY
  209.     RETURN
  210.     END
  211.     SUBROUTINE ERASE
  212.     CALL CLSG
  213.     CALL CLST
  214.     RETURN
  215.     END
  216.     SUBROUTINE POINTA (X,Y)
  217.     COMMON /POPSC/I1,I2
  218.     CALL CHXY(X,Y,I1,I2)
  219.     CALL POINT (IX,IY)
  220.     RETURN
  221.     END
  222.     SUBROUTINE ANSTR (NC,CHAR,NW)
  223.     DIMENSION CHAR(1)
  224.     COMMON /POPSC/I1,I2
  225.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  226.     IX=I1+MIX
  227.     IY=I2+MIY
  228.     ILX=IX*0.125
  229. C    ILX=IX*0.125
  230. C    ILY=36-IY*0.125
  231.     ILY=36-IY*0.125
  232.     CALL LOCATE (ILX,ILY)
  233.     CALL MODE (1)
  234.     WRITE (*,'(1X,15A4)')(CHAR(JJ),JJ=1,NW)
  235.     CALL MODE (0)
  236. CI1=I1+NC*8
  237.     I1=I1+NC*6
  238.     CALL POS(ILX,ILY)
  239.     ILY=ILY+1
  240.     CALL INTO (ILX,ILY)
  241.     RETURN
  242.     END
  243.     SUBROUTINE TOUTPT(ICHAR)
  244.     COMMON /POPSC/I1,I2
  245.     CALL ANSTR (1,ICHAR,1)
  246.     I1=I1+8
  247.     RETURN
  248.     END
  249.     SUBROUTINE VCURSR (ICHAR,X,Y)
  250.     COMMON /POPSC/I1,I2
  251.     COMMON /WENDU/XM1,XM2,YM1,YM2
  252.     COMMON /TWENDU/MIX,MAX,MIY,MAY
  253.     CALL DRAWC
  254.     READ(*,1) CHAR
  255. 1    FORMAT(A1)
  256.     CALL RCORD(XI,YI,IF)
  257.     IX=XI
  258.     IY=YI
  259.     LX=IX-MIX
  260.     LY=IY-MIY
  261.     X=XM1+LX*(XM2-XM1)/(MAX-MIX)
  262.     Y=YM1+LY*(YM2-YM1)/(MAY-MIY)
  263.     WRITE (*,*)' IX,IY,MIX,MIY,MAX,MAY',XI,YI,MIX,MIY,MAX,MAY
  264.     RETURN
  265.     END
  266.     SUBROUTINE FINIT (I)
  267.     CALL QUIT
  268.     RETURN
  269.     END
  270.