Google
 

Trailing-Edge - PDP-10 Archives - BB-K818A-BM_1981 - sources/text.for
There are 2 other files named text.for in the archive. Click here to see a list.
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 text ( wopt , prmt )
      integer wopt ( 10 )
      integer prmt ( 1 )
      integer curdx , curdy , smalld , larged
      integer scf , lorng , hirng
      integer cname ( 75 )
      common / keypad / curdx , curdy , smalld , larged , scf , lorng , 
     *hirng , cname
      common / glopts / wrtopt , wrtcrv , wrtlin , wrtbox , wrtcir , wrt
     *txt , txtopt , gwopsp , gwop , ttytop
      integer wrtopt ( 10 ) , wrtcrv ( 10 ) , wrtlin ( 10 ) , wrtbox ( 1
     *0 )
      integer wrtcir ( 10 ) , wrttxt ( 10 ) , txtopt ( 6 ) , ttytop ( 6 
     *)
      integer gwop ( 36 ) , gwopsp
C         ^ should be Woplen*Maxwops
      integer strx , stry
      integer ti
C  tch allocation pointer
      integer tch ( 128 )
      common / ctext / strx , stry , ti , tch
      integer strlen
      integer typing , enterd
      integer attrw , helper
      integer key , c , inch
      integer redef
      integer i
C string textid text
C string txthlp txt
      integer textid ( 5 )
      integer txthlp ( 4 )
      data textid ( 1 ) , textid ( 2 ) , textid ( 3 ) , textid ( 4 ) , t
     *extid ( 5 ) / 116 , 101 , 120 , 116 , 0 /
      data txthlp ( 1 ) , txthlp ( 2 ) , txthlp ( 3 ) , txthlp ( 4 ) / 1
     *16 , 120 , 116 , 0 /
      typing = 1
      enterd = 0
      call pushxo
      call newtop ( txtopt )
      call prompt ( prmt , textid )
      redef = 1
      continue
23000 if(.not.( typing .ne. 0 ))goto 23001
      if(.not.( redef .ne. 0 ))goto 23002
      call defmac ( 79 )
      call drwstr ( tch , strx , stry )
      call fedmac ( 79 )
      redef = 0
23002 continue
      call settcp ( txtopt , tch , strx , stry , ti )
      key = inch ( c )
      if(.not.( key .lt. 32 .and. key .ne. 10 .and. key .ne. 8 .and. key
     * .ne. 9 ))goto 23004
      typing = 0
      goto 23005
23004 continue
      if(.not.( key .ge. 256 .and. key .le. 267 ))goto 23006
      call usemac ( 79 )
      strx = strx + curdx
      stry = stry + curdy
      call clip ( strx , stry )
      redef = 1
      goto 23007
23006 continue
      if(.not.( key .eq. 268 ))goto 23008
      typing = 0
      enterd = 1
      goto 23009
23008 continue
      if(.not.( key .eq. 273 ))goto 23010
      call usemac ( 79 )
      enterd = enterd + attrw ( wopt )
      call newtop ( txtopt )
      call usemac ( 79 )
      goto 23011
23010 continue
      if(.not.( key .eq. 270 .and. strlen ( tch ) .lt. 128 ))goto 23012
C   insert a space
      continue
       i = 128 - 1
23014 if(.not.(i.ge.ti))goto 23016
      tch ( i + 1 ) = tch ( i )
23015 i=i-1
      goto 23014
23016 continue
      tch ( ti ) = 32
      call usemac ( 79 )
      redef = 1
      goto 23013
23012 continue
      if(.not.( key .eq. 272 ))goto 23017
C   delete current character
      if(.not.( tch ( ti ) .ne. 0 ))goto 23019
      continue
       i = ti
23021 if(.not.(i.lt.128))goto 23023
      tch ( i ) = tch ( i + 1 )
23022 i=i+1
      goto 23021
23023 continue
      call usemac ( 79 )
      redef = 1
23019 continue
      goto 23018
23017 continue
      if(.not.( key .eq. 127 ))goto 23024
C   delete previous character
      if(.not.( ti .gt. 1 ))goto 23026
      ti = ti - 1
C  back up by 1
      continue
       i = ti
23028 if(.not.(i.lt.128))goto 23030
      tch ( i ) = tch ( i + 1 )
23029 i=i+1
      goto 23028
23030 continue
      call usemac ( 79 )
      redef = 1
23026 continue
      goto 23025
23024 continue
      if(.not.( key .eq. 274 .and. tch ( ti ) .ne. 0 ))goto 23031
      ti = ti + 1
      goto 23032
23031 continue
      if(.not.( key .eq. 276 .and. ti .gt. 1 ))goto 23033
      ti = ti - 1
      goto 23034
23033 continue
      if(.not.( key .eq. 277 ))goto 23035
      if(.not.( helper ( txthlp ) .eq. ( - 1 ) ))goto 23037
      typing = 0
23037 continue
      goto 23036
23035 continue
      if(.not.( key .eq. 269 .or. key .eq. 271 .or. key .eq. 275 .or. ke
     *y .eq. 277 .or.  key .eq. 270 .or. key .eq. 272 .or. key .eq. 274 
     *.or. key .eq. 276 ))goto 23039
      goto 23040
23039 continue
      if(.not.( strlen ( tch ) .lt. 128 ))goto 23041
C   append a char at cur pos and advance
      continue
       i = 128 - 1
23043 if(.not.(i.ge.ti))goto 23045
      tch ( i + 1 ) = tch ( i )
23044 i=i-1
      goto 23043
23045 continue
      tch ( ti ) = key
      ti = ti + 1
      call usemac ( 79 )
      redef = 1
23041 continue
23040 continue
23036 continue
23034 continue
23032 continue
23025 continue
23018 continue
23013 continue
23011 continue
23009 continue
23007 continue
23005 continue
      goto 23000
23001 continue
      call usemac ( 79 )
      call usemac ( 80 )
      call popwo
      text = enterd
      if(.not.( enterd .eq. 0 ))goto 23046
      return
23046 continue
      call pushwo ( wopt )
      call usemac ( 79 )
      call popwo
      return
      end