-+-+-+-+-+-+-+-+ START OF PART 177 -+-+-+-+-+-+-+-+ X SUBROUTINE ptkf_transform(matrix, point, tpoint) X REAL matrix(3,3), point(2), tpoint(2) X X tpoint(1) = matrix(1, 1) * point(1) + matrix(1, 2) * point(2) +`20 X : matrix(1, 3) X tpoint(2) = matrix(2, 1) * point(1) + matrix(2, 2) * point(2) +`20 X : matrix(2, 3) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_matrixtomatrix3(mat, mat3) X REAL mat(3,3), mat3(4,4) X external ptk_matrixtomatrix3`20 X X call ptk_matrixtomatrix3(mat, mat3) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_outputmatrix3(filename, matrix, string) X CHARACTER*(*) filename X REAL matrix(4,4) X CHARACTER*(*) string X INTEGER*4 fileptr X CHARACTER*20 type X external ptk_outputmatrix3`20 X external ptkc_openfile X external ptkc_closefile `20 X X type = 'w+' X call ptkc_openfile(filename, type, fileptr) X call ptk_outputmatrix3(%val(fileptr), matrix, string) X call ptkc_closefile(filename, fileptr) X X RETURN X END X `20 X SUBROUTINE ptkf_box3tobox3(box1, box2, preserve, operation,`20 X : matrix, error) X REAL box1(6), box2(6) X LOGICAL preserve X INTEGER operation X REAL matrix(4,4) X INTEGER error X external ptk_box3tobox3`20 X X call ptk_box3tobox3(box1, box2, %val(preserve),`20 X : %val(operation), matrix, error) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_boxtobox(box1, box2, preserve, operation, matrix,`20 X : error) X REAL box1(4), box2(4) X LOGICAL preserve X INTEGER operation X REAL matrix(3,3) X INTEGER error X external ptk_boxtobox `20 X X call ptk_boxtobox(box1, box2, %val(preserve), %val(operation),`20 X : matrix, error) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_accumulatetran3(fixed, shift, rotx, roty, rotz,`20 X : scale,operation, matrix) X REAL fixed(3), shift(3), rotx, roty, rotz, scale(3) X INTEGER operation X REAL matrix(4,4) X REAL*4 dprotx, dproty, dprotz X external ptk_accumulatetran3`20 X `20 X dprotx = rotx X dproty = roty X dprotz = rotz X call ptk_accumulatetran3(fixed, shift, %val(dprotx),`20 X : %val(dproty), %val(dprotz), scale, %val(operation), matrix) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_accumulatetran(fixed, shift, rot, scale,`20 X : operation, matrix) X REAL fixed(2), shift(2), rot, scale(2) X INTEGER operation X REAL matrix(3,3) X REAL*4 dprot X external ptk_accumulatetran`20 X `20 X dprot = rot X call ptk_accumulatetran(fixed, shift, %val(dprot), scale,`20 X : %val(operation), matrix) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_evalvieworientation3(viewrefpoint, viewplanenormal, X : viewupvector, operation, matrix, error) X REAL viewrefpoint(3), viewplanenormal(3), viewupvector(3) X INTEGER operation X REAL matrix(4,4) X INTEGER error X external ptk_evalvieworientation3`20 X `20 X call ptk_evalvieworientation3(viewrefpoint, viewplanenormal,`20 X : viewupvector, %val(operation), matrix, error) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_evalvieworientation(viewrefpoint, viewupvector,`20 X : operation, matrix, error) X REAL viewrefpoint(2), viewupvector(2) X INTEGER operation X REAL matrix(3,3) X INTEGER error X external ptk_evalvieworientation`20 X X call ptk_evalvieworientation(viewrefpoint, viewupvector,`20 X : %val(operation), matrix, error) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_evalviewmapping3(wlimits, vlimits, viewtype,`20 X : refpoint,vplanedist, operation, matrix, error) X REAL wlimits(6), vlimits(6) X INTEGER viewtype X REAL refpoint(3), vplanedist X INTEGER operation X REAL matrix(4,4) X INTEGER error X REAL*4 dpvplanedist X external ptk_evalviewmapping3`20 X X dpvplanedist = vplanedist X call ptk_evalviewmapping3(wlimits, vlimits, %val(viewtype),`20 X : refpoint,%val(dpvplanedist), %val(operation), matrix, error) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_evalviewmapping(wlimits, vlimits, operation,`20 X : matrix, error) X REAL wlimits(4), vlimits(4) X INTEGER operation X REAL matrix(3,3) X INTEGER error X external ptk_evalviewmapping`20 X X call ptk_evalviewmapping(wlimits, vlimits, %val(operation),`20 X : matrix, error) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_stackmatrix3(matrix) X REAL matrix(4,4) X external ptk_stackmatrix3`20 X X call ptk_stackmatrix3(matrix) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_stackmatrix(matrix) X REAL matrix(3,3) X external ptk_stackmatrix`20 X X call ptk_stackmatrix(matrix) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_unstackmatrix3(matrix) X REAL matrix(4,4) X external ptk_unstackmatrix3`20 X X call ptk_unstackmatrix3(matrix) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_unstackmatrix(matrix) X REAL matrix(3,3) X external ptk_unstackmatrix`20 X X call ptk_unstackmatrix(matrix) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_examinestackmatrix3(matrix) X REAL matrix(4,4) X external ptk_examinestackmatrix3`20 X X call ptk_examinestackmatrix3(matrix) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_examinestackmatrix(matrix) X REAL matrix(3,3) X external ptk_examinestackmatrix`20 X X call ptk_examinestackmatrix(matrix) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_3ptto3pt(p1, p2, p3, q1, q2, q3, operation,`20 X : matrix, error) X REAL p1(3), p2(3), p3(3), q1(3), q2(3), q3(3) X INTEGER operation X REAL matrix(4,4) X INTEGER error X external ptk_3ptto3pt `20 X X call ptk_3ptto3pt(p1, p2, p3, q1, q2, q3, %val(operation),`20 X : matrix, error) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_0to3pt(origin, xdirn, ydirn, operation, matrix) X REAL origin(3), xdirn(3), ydirn(3) X INTEGER operation X REAL matrix(4,4) X external ptk_0to3pt`20 X `20 X call ptk_0to3pt(origin, xdirn, ydirn, %val(operation), matrix) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_oto3pt(origin, xdirn, ydirn, operation, matrix) X REAL origin(3), xdirn(3), ydirn(3) X INTEGER operation X REAL matrix(4,4) X external ptk_oto3pt`20 X X call ptk_oto3pt(origin, xdirn, ydirn, %val(operation), matrix) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_invertmatrix3(a, ainverse, error) X REAL a(4,4), ainverse(4,4) X INTEGER error X external ptk_invertmatrix3`20 X `20 X call ptk_invertmatrix3(a, ainverse, error) X `20 X RETURN X END X `20 X SUBROUTINE ptkf_invertmatrix(a, ainverse, error) X REAL a(4,4), ainverse(4,4) X INTEGER error X external ptk_invertmatrix`20 X `20 X call ptk_invertmatrix(a, ainverse, error) X `20 X RETURN X END X `20 XC end of tran.f`20 $ CALL UNPACK [.FORTRAN.SOURCE.LIBRARY]TRAN.FOR;1 1883428402 $ create 'f' X X SUBROUTINE ptkf_stacktsl() X external ptk_stacktsl`20 X X call ptk_stacktsl() X X RETURN X END X X SUBROUTINE ptkf_unstacktsl() X external ptk_unstacktsl`20 X X call ptk_unstacktsl() X X RETURN X END X X LOGICAL FUNCTION ptkf_boundingbox(structid, wcbounds, descend) X INTEGER structid X REAL wcbounds(6) X LOGICAL descend X LOGICAL*1 ptk_boundingbox, ans, desc X external ptk_boundingbox`20 X X desc = descend X ans = ptk_boundingbox(%val(structid), wcbounds, %val(desc)) X if (ans .eq. 1) then X ptkf_boundingbox = .TRUE. X else X ptkf_boundingbox = .FALSE. X endif X X RETURN X END X X SUBROUTINE ptkf_inittsl() X external ptk_inittsl`20 X X call ptk_inittsl() X X RETURN X END X XC SUBROUTINE ptkf_tsltraversepath(num, reflst) XC INTEGER num, reflst(3, num) XC structure /Pintlst/ XC INTEGER number XC INTEGER integers(100) XC end structure XC record /Pintlst/ namelist XC external ptk_tsltraversepath`20 XC XC call ptk_tsltraversepath(reflst) XC XC RETURN XC END X X SUBROUTINE ptkf_tsltraverserange(startstid, startelemid, stopstid,`20 X : stopelemid, descend) X INTEGER startstid, startelemid, stopstid, stopelemid X LOGICAL descend X external ptk_tsltraverserange`20 X X call ptk_tsltraverserange(%val(startstid), %val(startelemid), X : %val(stopstid), %val(stopelemid), %val(descend)) X X RETURN X END X X SUBROUTINE ptkf_inqboundingbox(bbox) X REAL bbox(6) X external ptk_inqboundingbox`20 X X call ptk_inqboundingbox(bbox) X X RETURN X END X X SUBROUTINE ptkf_inqtsledge(edgeind, edgeflag, edgetype,`20 X : edgewidth, edgecolour) X INTEGER edgeind, edgeflag, edgetype X REAL edgewidth X INTEGER edgecolour X external ptk_inqtsledge`20 X X call ptk_inqtsledge(edgeind, edgeflag, edgetype, edgewidth,`20 X : edgecolour) X X RETURN X END X X SUBROUTINE ptkf_inqtslline(lineind, linetype, linewidth,`20 X : linecolour) X INTEGER lineind, linetype X REAL linewidth X INTEGER linecolour X external ptk_inqtslline`20 X X call ptk_inqtslline(lineind, linetype, linewidth, linecolour) X X RETURN X END X X SUBROUTINE ptkf_inqtslmarker(markerind, markertype, markersize, X : markercolour) X INTEGER markerind, markertype X REAL markersize X INTEGER markercolour X external ptk_inqtslmarker`20 X X call ptk_inqtslmarker(markerind, markertype, markersize,`20 X : markercolour) X X RETURN X END X X SUBROUTINE ptkf_inqtslinterior(intind, intstyle, intstyleind,`20 X : intcolour) X INTEGER intind, intstyle, intstyleind, intcolour X external ptk_inqtslinterior`20 X X call ptk_inqtslinterior(intind, intstyle, intstyleind, intcolour) X X RETURN X END X X SUBROUTINE ptkf_inqtsltext(textind, textfont, textprec, textpath,`20 X : textalign, textcolour) X INTEGER textind, textfont, textprec, textpath, textalign, textcolour X external ptk_inqtsltext`20 X X call ptk_inqtsltext(textind, textfont, textprec, textpath,`20 X : textalign, textcolour) X X RETURN X END X X SUBROUTINE ptkf_inqtslannotext(style, charheight, charup, textalign, X : textpath) X INTEGER style X REAL charheight, charup(2) X INTEGER textalign, textpath X external ptk_inqtslannotext`20 X X call ptk_inqtslannotext(style, charheight, charup, textalign,`20 X : textpath) X X RETURN X END X X SUBROUTINE ptkf_inqtslchar(exp, spacing, height, charup) X REAL exp, spacing, height, charup(2) X external ptk_inqtslchar`20 X X call ptk_inqtslchar(exp, spacing, height, charup) X X RETURN X END X X SUBROUTINE ptkf_inqtslctm(globaltran, localtran) X REAL globaltran(4, 4), localtran(4, 4) X external ptk_inqtslctm`20 X X call ptk_inqtslctm(globaltran, localtran) X X RETURN X END X X SUBROUTINE ptkf_inqtslnameset(num, nameset, totalnum) X INTEGER num, nameset(num), totalnum X external ptkc_inqtslnameset`20 X X call ptkc_inqtslnameset(%val(num), nameset, totalnum) X X RETURN X END X X SUBROUTINE ptkf_inqtslids(pickid, hlhsrid, viewind) X INTEGER pickid, hlhsrid, viewind X external ptk_inqtslids`20 X X call ptk_inqtslids(pickid, hlhsrid, viewind) X X RETURN X END X X SUBROUTINE ptkf_inqtslpattern(size, refpt, refvec) X REAL size(2), refpt(3), refvec(3, 2) X external ptk_inqtslpattern`20 X X call ptk_inqtslpattern(size, refpt, refvec) X X RETURN X END X X SUBROUTINE ptkf_inqtslattrasf(attr, asf) X INTEGER attr, asf X external ptk_inqtslattrasf`20 X X call ptk_inqtslattrasf(%val(attr), asf) X X RETURN X END X XC end of tsl.f $ CALL UNPACK [.FORTRAN.SOURCE.LIBRARY]TSL.FOR;1 1948301722 $ create 'f' X X X SUBROUTINE ptkf_vieweditor(wsid, num, stids, vwormt, vwmpmt,`20 X : vwcplm, xyclpi, bclipi, fclipi) X INTEGER wsid, num, stids(num) X REAL vwormt(4, 4) X REAL vwmpmt(4, 4) X REAL vwcplm(6) X INTEGER xyclpi, bclipi, fclipi X external ptkc_vieweditor`20 X`20 X call ptkc_vieweditor(%val(wsid), %val(num), stids, vwormt,`20 X : vwmpmt, vwcplm, xyclpi, bclipi, fclipi) X X RETURN X END X X SUBROUTINE ptkf_setvieweditorattrs(menufont, windowfont, X : menucol, menutextcol,`20 X : windowcol, bannercol, bannertextcol, tlcol, brcol, arrowcol,`20 X : arrowedgecol) X`09INTEGER menufont, windowfont X`09INTEGER menucol, menutextcol, windowcol X INTEGER bannercol, bannertextcol, tlcol, brcol X`09INTEGER arrowcol, arrowedgecol X external ptk_setvieweditorattrs`20 X X `09call ptk_setvieweditorattrs(%val(menufont), %val(windowfont), X : %val(menucol), %val(menutextcol),`20 +-+-+-+-+-+-+-+- END OF PART 177 +-+-+-+-+-+-+-+-