Google
 

Trailing-Edge - PDP-10 Archives - BB-K818A-BM_1981 - sources/cycwrt.for
There are no other files named cycwrt.for in the archive.
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C operating-system-dependent switches
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C 
C 
C   			C O P Y R I G H T
C 
C 
C   		Copyright (C) 1980 by
C   		Digital Equipment Corporation, Maynard, Mass.
C 
C 
C   	This software is furnished under a license and may be used and
C   	copied  only  in accordance with the terms of such license and
C   	with the  inclusion  of  the  above  copyright  notice.   This
C   	software  or  any  other copies thereof may not be provided or
C   	otherwise made available to any other person.  No title to and
C   	ownership of the software is hereby transferred.
C 
C   	The information in this software is subject to change  without
C   	notice  and should not be construed as a commitment by Digital
C   	Equipment Corporation.
C 
C   	DIGITAL assumes no responsibility for the use  or  reliability
C   	of its software on equipment that is not supplied by DIGITAL.
C 
C 	define char byte
C  27+128
C  w(riting) opt(ion)s come groups of 8:
C 	(1) replace(0)/erase(1)/complement(2)/overlay(3)
C 	(2) negative image 0/1
C 	(3) pattern  < 256	bit mask (e.g. 192 = P11000000)
C 		    >= 256	canned pattern * 256 (e.g. 512 = P2)
C 				if value >= 256, low 8 bits are ignored
C 	(4) pattern multiplier, different from 6(?)
C 	(5) shading flag, sim pattern+ >= 10 use char
C 	(6) if shading != 0 this is y reference val
C 	(7) pixel multiplier, 1 <= value <= 10
C 	(8) alternating 0/1
C 	(9) foreground intensity, 0 <= value <= 7
C 	(10) background intensity, 0 <= value <= 7
C 
C   offsets from gwopsp...
C   Inktypes...
C   Inkolors...
C Text options
C 	RSTSONLY	define Maxgels 1000	# due to limited RAM on RSTS
C   drawing primitive gels...
C   attribute/marker/other gels...
C   writing attribute gels : Woptbase + wopindex
C   similarly topts...
C maximum # of characters in a filespec
C maximum # of characters in a command line
C max length of prompt buffer
C max number of characters in file record
C size of record buffers (Fbufsz + 1)
C 	include logdef
C ========================================================================
C ========================================================================
      integer function cyrast ( k , m )
      integer k , m
      integer cycval
      integer rval ( 4 )
C string rast Raster\ op
C slist rasti
C string rastc replace
C string + erase
C string + complement
C string + overlay
C elist rasti
      integer rasti ( 4 )
      integer rast ( 10 )
      integer rastc ( 33 )
      data rast ( 1 ) , rast ( 2 ) , rast ( 3 ) , rast ( 4 ) , rast ( 5 
     *) / 82 , 97 , 115 , 116 , 101 /
      data rast ( 6 ) , rast ( 7 ) , rast ( 8 ) , rast ( 9 ) , rast ( 10
     * ) / 114 , 32 , 111 , 112 , 0 /
      data rastc ( 1 ) , rastc ( 2 ) , rastc ( 3 ) , rastc ( 4 ) , rastc
     * ( 5 ) / 114 , 101 , 112 , 108 , 97 /
      data rastc ( 6 ) , rastc ( 7 ) , rastc ( 8 ) , rastc ( 9 ) , rastc
     * ( 10 ) / 99 , 101 , 0 , 101 , 114 /
      data rastc ( 11 ) , rastc ( 12 ) , rastc ( 13 ) , rastc ( 14 ) , r
     *astc ( 15 ) / 97 , 115 , 101 , 0 , 99 /
      data rastc ( 16 ) , rastc ( 17 ) , rastc ( 18 ) , rastc ( 19 ) , r
     *astc ( 20 ) / 111 , 109 , 112 , 108 , 101 /
      data rastc ( 21 ) , rastc ( 22 ) , rastc ( 23 ) , rastc ( 24 ) , r
     *astc ( 25 ) / 109 , 101 , 110 , 116 , 0 /
      data rastc ( 26 ) , rastc ( 27 ) , rastc ( 28 ) , rastc ( 29 ) , r
     *astc ( 30 ) / 111 , 118 , 101 , 114 , 108 /
      data rastc ( 31 ) , rastc ( 32 ) , rastc ( 33 ) / 97 , 121 , 0 /
      data rasti ( 1 ) , rasti ( 2 ) , rasti ( 3 ) , rasti ( 4 ) / 1 , 9
     * , 15 , 26 /
      data rval ( 1 ) , rval ( 2 ) , rval ( 3 ) , rval ( 4 ) / 0 , 1 , 2
     * , 3 /
      cyrast = cycval ( k , rast , 4 , rasti , rastc , rval , m )
      return
      end
      integer function cynega ( k , m )
      integer k , m
      integer cycval
      integer negval ( 2 )
C string neg Negate
C slist negi
C string negc no
C string + yes
C elist negi
      integer negi ( 2 )
      integer neg ( 7 )
      integer negc ( 7 )
      data neg ( 1 ) , neg ( 2 ) , neg ( 3 ) , neg ( 4 ) , neg ( 5 ) / 7
     *8 , 101 , 103 , 97 , 116 /
      data neg ( 6 ) , neg ( 7 ) / 101 , 0 /
      data negc ( 1 ) , negc ( 2 ) , negc ( 3 ) , negc ( 4 ) , negc ( 5 
     *) / 110 , 111 , 0 , 121 , 101 /
      data negc ( 6 ) , negc ( 7 ) / 115 , 0 /
      data negi ( 1 ) , negi ( 2 ) / 1 , 4 /
      data negval ( 1 ) , negval ( 2 ) / 0 , 1 /
      cynega = cycval ( k , neg , 2 , negi , negc , negval , m )
      return
      end
      integer function cyblnk ( k , m )
      integer k , m
      integer cycval
      integer blnkv ( 2 )
C string blnk Blink
C slist blnki
C string blnkc off
C string + on
C elist blnki
      integer blnki ( 2 )
      integer blnk ( 6 )
      integer blnkc ( 7 )
      data blnk ( 1 ) , blnk ( 2 ) , blnk ( 3 ) , blnk ( 4 ) , blnk ( 5 
     *) / 66 , 108 , 105 , 110 , 107 /
      data blnk ( 6 ) / 0 /
      data blnkc ( 1 ) , blnkc ( 2 ) , blnkc ( 3 ) , blnkc ( 4 ) , blnkc
     * ( 5 ) / 111 , 102 , 102 , 0 , 111 /
      data blnkc ( 6 ) , blnkc ( 7 ) / 110 , 0 /
      data blnki ( 1 ) , blnki ( 2 ) / 1 , 5 /
      data blnkv ( 1 ) , blnkv ( 2 ) / 0 , 1 /
      cyblnk = cycval ( k , blnk , 2 , blnki , blnkc , blnkv , m )
      return
      end
      integer function cycolr ( k , m )
      integer k , m
      integer cycval
      integer colrv ( 9 )
C string colr Color
C slist colri
C string colrc null/
C string + black/0
C string + blue/1
C string + red/2
C string + magenta/3
C string + green/4
C string + cyan/5
C string + yellow/6
C string + white/7
C elist colri
      integer colri ( 9 )
      integer colr ( 6 )
      integer colrc ( 69 )
      data colr ( 1 ) , colr ( 2 ) , colr ( 3 ) , colr ( 4 ) , colr ( 5 
     *) / 67 , 111 , 108 , 111 , 114 /
      data colr ( 6 ) / 0 /
      data colrc ( 1 ) , colrc ( 2 ) , colrc ( 3 ) , colrc ( 4 ) , colrc
     * ( 5 ) / 110 , 117 , 108 , 108 , 47 /
      data colrc ( 6 ) , colrc ( 7 ) , colrc ( 8 ) , colrc ( 9 ) , colrc
     * ( 10 ) / 0 , 98 , 108 , 97 , 99 /
      data colrc ( 11 ) , colrc ( 12 ) , colrc ( 13 ) , colrc ( 14 ) , c
     *olrc ( 15 ) / 107 , 47 , 48 , 0 , 98 /
      data colrc ( 16 ) , colrc ( 17 ) , colrc ( 18 ) , colrc ( 19 ) , c
     *olrc ( 20 ) / 108 , 117 , 101 , 47 , 49 /
      data colrc ( 21 ) , colrc ( 22 ) , colrc ( 23 ) , colrc ( 24 ) , c
     *olrc ( 25 ) / 0 , 114 , 101 , 100 , 47 /
      data colrc ( 26 ) , colrc ( 27 ) , colrc ( 28 ) , colrc ( 29 ) , c
     *olrc ( 30 ) / 50 , 0 , 109 , 97 , 103 /
      data colrc ( 31 ) , colrc ( 32 ) , colrc ( 33 ) , colrc ( 34 ) , c
     *olrc ( 35 ) / 101 , 110 , 116 , 97 , 47 /
      data colrc ( 36 ) , colrc ( 37 ) , colrc ( 38 ) , colrc ( 39 ) , c
     *olrc ( 40 ) / 51 , 0 , 103 , 114 , 101 /
      data colrc ( 41 ) , colrc ( 42 ) , colrc ( 43 ) , colrc ( 44 ) , c
     *olrc ( 45 ) / 101 , 110 , 47 , 52 , 0 /
      data colrc ( 46 ) , colrc ( 47 ) , colrc ( 48 ) , colrc ( 49 ) , c
     *olrc ( 50 ) / 99 , 121 , 97 , 110 , 47 /
      data colrc ( 51 ) , colrc ( 52 ) , colrc ( 53 ) , colrc ( 54 ) , c
     *olrc ( 55 ) / 53 , 0 , 121 , 101 , 108 /
      data colrc ( 56 ) , colrc ( 57 ) , colrc ( 58 ) , colrc ( 59 ) , c
     *olrc ( 60 ) / 108 , 111 , 119 , 47 , 54 /
      data colrc ( 61 ) , colrc ( 62 ) , colrc ( 63 ) , colrc ( 64 ) , c
     *olrc ( 65 ) / 0 , 119 , 104 , 105 , 116 /
      data colrc ( 66 ) , colrc ( 67 ) , colrc ( 68 ) , colrc ( 69 ) / 1
     *01 , 47 , 55 , 0 /
      data colri ( 1 ) , colri ( 2 ) , colri ( 3 ) , colri ( 4 ) , colri
     * ( 5 ) / 1 , 7 , 15 , 22 , 28 /
      data colri ( 6 ) , colri ( 7 ) , colri ( 8 ) , colri ( 9 ) / 38 , 
     *46 , 53 , 62 /
      data colrv ( 1 ) , colrv ( 2 ) , colrv ( 3 ) , colrv ( 4 ) , colrv
     * ( 5 ) / 8 , 0 , 1 , 2 , 3 /
      data colrv ( 6 ) , colrv ( 7 ) , colrv ( 8 ) , colrv ( 9 ) / 4 , 5
     * , 6 , 7 /
      cycolr = cycval ( k , colr , 9 , colri , colrc , colrv , m )
      return
      end
      integer function cyshad ( k , m )
      integer k , m
      integer cycval
      integer shadv ( 2 )
C string shad Shading
C slist shadi
C string shadc off
C string + on
C elist shadi
      integer shadi ( 2 )
      integer shad ( 8 )
      integer shadc ( 7 )
      data shad ( 1 ) , shad ( 2 ) , shad ( 3 ) , shad ( 4 ) , shad ( 5 
     *) / 83 , 104 , 97 , 100 , 105 /
      data shad ( 6 ) , shad ( 7 ) , shad ( 8 ) / 110 , 103 , 0 /
      data shadc ( 1 ) , shadc ( 2 ) , shadc ( 3 ) , shadc ( 4 ) , shadc
     * ( 5 ) / 111 , 102 , 102 , 0 , 111 /
      data shadc ( 6 ) , shadc ( 7 ) / 110 , 0 /
      data shadi ( 1 ) , shadi ( 2 ) / 1 , 5 /
      data shadv ( 1 ) , shadv ( 2 ) / 0 , 1 /
      cyshad = cycval ( k , shad , 2 , shadi , shadc , shadv , m )
      return
      end
      integer function cypatt ( k , m )
      integer k , m
      integer cycval
      integer pattv ( 4 )
C string patt Pattern
C slist patti
C string pattc solid
C string + dotted
C string + dashed
C string + dot-dashed
C elist patti
      integer patti ( 4 )
      integer patt ( 8 )
      integer pattc ( 31 )
      data patt ( 1 ) , patt ( 2 ) , patt ( 3 ) , patt ( 4 ) , patt ( 5 
     *) / 80 , 97 , 116 , 116 , 101 /
      data patt ( 6 ) , patt ( 7 ) , patt ( 8 ) / 114 , 110 , 0 /
      data pattc ( 1 ) , pattc ( 2 ) , pattc ( 3 ) , pattc ( 4 ) , pattc
     * ( 5 ) / 115 , 111 , 108 , 105 , 100 /
      data pattc ( 6 ) , pattc ( 7 ) , pattc ( 8 ) , pattc ( 9 ) , pattc
     * ( 10 ) / 0 , 100 , 111 , 116 , 116 /
      data pattc ( 11 ) , pattc ( 12 ) , pattc ( 13 ) , pattc ( 14 ) , p
     *attc ( 15 ) / 101 , 100 , 0 , 100 , 97 /
      data pattc ( 16 ) , pattc ( 17 ) , pattc ( 18 ) , pattc ( 19 ) , p
     *attc ( 20 ) / 115 , 104 , 101 , 100 , 0 /
      data pattc ( 21 ) , pattc ( 22 ) , pattc ( 23 ) , pattc ( 24 ) , p
     *attc ( 25 ) / 100 , 111 , 116 , 45 , 100 /
      data pattc ( 26 ) , pattc ( 27 ) , pattc ( 28 ) , pattc ( 29 ) , p
     *attc ( 30 ) / 97 , 115 , 104 , 101 , 100 /
      data pattc ( 31 ) / 0 /
      data patti ( 1 ) , patti ( 2 ) , patti ( 3 ) , patti ( 4 ) / 1 , 7
     * , 14 , 21 /
      data pattv ( 1 ) , pattv ( 2 ) , pattv ( 3 ) , pattv ( 4 ) / 256 ,
     * 1024 , 512 , 768 /
      cypatt = cycval ( k , patt , 4 , patti , pattc , pattv , m )
      return
      end
      integer function cypmul ( k , m )
      integer k , m
      integer cycval
      integer pmulv ( 3 )
C string pmul Pattern\ multiplier
C slist pmuli
C string pmulc close
C string + medium
C string + wide
C elist pmuli
      integer pmuli ( 3 )
      integer pmul ( 19 )
      integer pmulc ( 18 )
      data pmul ( 1 ) , pmul ( 2 ) , pmul ( 3 ) , pmul ( 4 ) , pmul ( 5 
     *) / 80 , 97 , 116 , 116 , 101 /
      data pmul ( 6 ) , pmul ( 7 ) , pmul ( 8 ) , pmul ( 9 ) , pmul ( 10
     * ) / 114 , 110 , 32 , 109 , 117 /
      data pmul ( 11 ) , pmul ( 12 ) , pmul ( 13 ) , pmul ( 14 ) , pmul 
     *( 15 ) / 108 , 116 , 105 , 112 , 108 /
      data pmul ( 16 ) , pmul ( 17 ) , pmul ( 18 ) , pmul ( 19 ) / 105 ,
     * 101 , 114 , 0 /
      data pmulc ( 1 ) , pmulc ( 2 ) , pmulc ( 3 ) , pmulc ( 4 ) , pmulc
     * ( 5 ) / 99 , 108 , 111 , 115 , 101 /
      data pmulc ( 6 ) , pmulc ( 7 ) , pmulc ( 8 ) , pmulc ( 9 ) , pmulc
     * ( 10 ) / 0 , 109 , 101 , 100 , 105 /
      data pmulc ( 11 ) , pmulc ( 12 ) , pmulc ( 13 ) , pmulc ( 14 ) , p
     *mulc ( 15 ) / 117 , 109 , 0 , 119 , 105 /
      data pmulc ( 16 ) , pmulc ( 17 ) , pmulc ( 18 ) / 100 , 101 , 0 /
      data pmuli ( 1 ) , pmuli ( 2 ) , pmuli ( 3 ) / 1 , 7 , 14 /
      data pmulv ( 1 ) , pmulv ( 2 ) , pmulv ( 3 ) / 1 , 2 , 3 /
      cypmul = cycval ( k , pmul , 3 , pmuli , pmulc , pmulv , m )
      return
      end