Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/circle.for
There are no other files named circle.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 circle ( wrtopt , prmt )
integer curdx , curdy , smalld , larged
integer scf , lorng , hirng
integer cname ( 75 )
common / keypad / curdx , curdy , smalld , larged , scf , lorng ,
*hirng , cname
integer wrtopt ( 10 )
integer prmt ( 1 )
integer centx , centy , circx , circy , arc
common / ccircl / centx , centy , circx , circy , arc
integer pf , circf
C values for pf...
integer inch , key , c
real sqrt , dx , dy , r , f
integer enterd
integer attrw , helper
integer redef
C string circid circle
C string cirhlp cir
integer circid ( 7 )
integer cirhlp ( 4 )
data circid ( 1 ) , circid ( 2 ) , circid ( 3 ) , circid ( 4 ) , c
*ircid ( 5 ) / 99 , 105 , 114 , 99 , 108 /
data circid ( 6 ) , circid ( 7 ) / 101 , 0 /
data cirhlp ( 1 ) , cirhlp ( 2 ) , cirhlp ( 3 ) , cirhlp ( 4 ) / 9
*9 , 105 , 114 , 0 /
pf = 0
circf = 1
enterd = 0
call pushxo
redef = 1
call prompt ( prmt , circid )
continue
23000 if(.not.( circf .ne. 0 ))goto 23001
if(.not.( redef .ne. 0 ))goto 23002
if(.not.( arc .lt. - 360 ))goto 23004
arc = - 360
23004 continue
if(.not.( arc .gt. 360 ))goto 23006
arc = 360
23006 continue
call clip ( centx , centy )
call clip ( circx , circy )
call defmac ( 79 )
call drcirc ( centx , centy , circx , circy , arc )
call fedmac ( 79 )
redef = 0
23002 continue
if(.not.( pf .eq. 0 ))goto 23008
call positn ( centx , centy )
goto 23009
23008 continue
if(.not.( pf .eq. 1 .or. pf .eq. 2 ))goto 23010
call positn ( circx , circy )
23010 continue
23009 continue
key = inch ( c )
if(.not.( key .ge. 256 .and. key .le. 267 ))goto 23012
C cursor key...
call usemac ( 79 )
if(.not.( pf .eq. 0 ))goto 23014
centx = centx + curdx
centy = centy + curdy
circx = circx + curdx
circy = circy + curdy
goto 23015
23014 continue
if(.not.( pf .eq. 1 ))goto 23016
circx = circx + curdx
circy = circy + curdy
goto 23017
23016 continue
arc = arc + curdx - curdy
23017 continue
23015 continue
redef = 1
goto 23013
23012 continue
if(.not.( key .eq. 269 .or. key .eq. 270 ))goto 23018
C adjust radius
dx = centx - circx
dy = centy - circy
r = sqrt ( dx * dx + dy * dy )
f = r + 5 . 0
if(.not.( key .eq. 269 ))goto 23020
f = r - 5 . 0
23020 continue
if(.not.( dx .eq. 0 .and. dy .eq. 0 ))goto 23022
dx = 2
dy = 2
goto 23023
23022 continue
f = f / r
dx = f * dx
dy = f * dy
23023 continue
if(.not.( pf .eq. 0 ))goto 23024
circx = centx - dx
circy = centy - dy
goto 23025
23024 continue
centx = circx + dx
centy = circy + dy
23025 continue
call usemac ( 79 )
redef = 1
goto 23019
23018 continue
if(.not.( key .eq. 271 .or. key .eq. 272 ))goto 23026
if(.not.( key .eq. 271 ))goto 23028
arc = arc - 10
goto 23029
23028 continue
arc = arc + 10
23029 continue
call usemac ( 79 )
redef = 1
goto 23027
23026 continue
if(.not.( key .eq. 276 ))goto 23030
if(.not.( pf .eq. 2 ))goto 23032
call drline ( centx , centy , circx , circy )
23032 continue
pf = pf - 1
if(.not.( pf .lt. 0 ))goto 23034
pf = 2
23034 continue
if(.not.( pf .eq. 2 ))goto 23036
call drline ( centx , centy , circx , circy )
23036 continue
goto 23031
23030 continue
if(.not.( key .eq. 274 ))goto 23038
if(.not.( pf .eq. 2 ))goto 23040
call drline ( centx , centy , circx , circy )
23040 continue
pf = pf + 1
if(.not.( pf .gt. 2 ))goto 23042
pf = 0
23042 continue
if(.not.( pf .eq. 2 ))goto 23044
call drline ( centx , centy , circx , circy )
23044 continue
goto 23039
23038 continue
if(.not.( key .eq. 273 ))goto 23046
enterd = enterd + attrw ( wrtopt )
goto 23047
23046 continue
if(.not.( key .eq. 268 ))goto 23048
circf = 0
enterd = 1
goto 23049
23048 continue
if(.not.( key .eq. 277 ))goto 23050
if(.not.( helper ( cirhlp ) .eq. ( - 1 ) ))goto 23052
circf = 0
23052 continue
goto 23051
23050 continue
if(.not.( key .eq. 269 .or. key .eq. 270 .or. key .eq. 271 .or. ke
*y .eq. 272 .or. key .eq. 277 .or. key .eq. 275 ))goto 23054
goto 23055
23054 continue
circf = 0
23055 continue
23051 continue
23049 continue
23047 continue
23039 continue
23031 continue
23027 continue
23019 continue
23013 continue
goto 23000
23001 continue
call usemac ( 79 )
if(.not.( pf .eq. 2 ))goto 23056
call drline ( centx , centy , circx , circy )
23056 continue
call usemac ( 80 )
call popwo
circle = enterd
if(.not.( enterd .eq. 0 ))goto 23058
return
23058 continue
if(.not.( wrtopt ( 5 ) .ne. 0 ))goto 23060
wrtopt ( 6 ) = centy
23060 continue
call pushwo ( wrtopt )
call drcirc ( centx , centy , circx , circy , arc )
call popwo
return
end