-+-+-+-+-+-+-+-+ START OF PART 170 -+-+-+-+-+-+-+-+
X         oldtwistval = 0.0
X         oldzoomval = 1.0
X         call prst(1, PALWAY)
X       endif
X
X       if (chnum .ne. 2) then
X         goto 20
X       endif
X
X       call psvlm(1, 1, PREQU, PECHO)
X       call psvlm(1, 2, PREQU, PECHO)
X       call psvlm(1, 3, PREQU, PECHO)
X       call psvlm(1, 4, PREQU, PECHO)
X       call pschm(1, 1, PREQU, PECHO)
X
X       RETURN
X       END
X      `20
XC--------------------------------------------------------------------------
X        `20
X         SUBROUTINE options()
X         CHARACTER*20 commandstr
X         INTEGER lencom
X         LOGICAL quit
X         REAL pos(2), size(2)
X         REAL echoarea(4)
X         REAL height
X         INTEGER font, bancol, titlecol
X         REAL ptkf_readfloat
X         INTEGER ptkf_readint
X         REAL devx, devy
X
X         include '`5B`5Dvmsphigs77.for'
X         include '`5B`5Dvmsptk77.for'
X
X         quit = .FALSE.
X         call ptkf_inqmaxdevicecoords(1, devx, devy)
X         call ptkf_limit(0.0, 0.5 * devx, 0.0, 0.05 * devy, echoarea)
X 10      call ptkf_readstring(1, 'camera', 'Input command`20
X     : (default = camera)>', echoarea, 20, commandstr, lencom)
X         if (commandstr(1:lencom) .eq. 'camera') then
X           call camerainterface()
X         else if (commandstr(1:lencom) .eq. 'position') then
X           pos(1) = ptkf_readfloat(1, 0.5, 'Input position, x (0.5) >',`20
X     : echoarea)
X           pos(2) = ptkf_readfloat(1, 0.5, 'Input position, y (0.5) >',`20
X     : echoarea)
X           call ptkf_setwindowposition(1, pos)
X         else if (commandstr(1:lencom) .eq. 'size') then
X           size(1) = ptkf_readfloat(1, 0.5, 'Input size, x (0.5) >',`20
X     : echoarea)
X           size(2) = ptkf_readfloat(1, 0.5, 'Input size, y (0.5) >',`20
X     : echoarea)
X           call ptkf_setwindowsize(1, size)
X         else if (commandstr(1:lencom) .eq. 'iconposition') then
X           pos(1) = ptkf_readfloat(1, 0.5, 'Input icon position,`20
X     : x (0.5) >', echoarea)
X           pos(2) = ptkf_readfloat(1, 0.5, 'Input icon position,`20
X     : y (0.5) >', echoarea)
X           call ptkf_seticonposition(1, pos)
X         else if (commandstr(1:lencom) .eq. 'iconsize') then
X           size(1) = ptkf_readfloat(1, 0.1, 'Input icon size,`20
X     : x (0.1) >', echoarea)
X           size(2) = ptkf_readfloat(1, 0.1, 'Input icon size,`20
X     : y (0.1) >', echoarea)
X           call ptkf_seticonsize(1, size)
X         else if (commandstr(1:lencom) .eq. 'framesize') then
X           size(1) = ptkf_readfloat(1, 0.01, 'Input frame size,
X     : x (0.01) >', echoarea)
X           size(2) = ptkf_readfloat(1, 0.01, 'Input frame size,`20
X     : y (0.01) >', echoarea)
X           call ptkf_setframesize(1, size)
X         else if (commandstr(1:lencom) .eq. 'open') then
X           call ptkf_openwindow(1)
X         else if (commandstr(1:lencom) .eq. 'close') then
X           call ptkf_closewindow(1)
X         else if (commandstr(1:lencom) .eq. 'front') then
X           call ptkf_frontwindow(1)
X         else if (commandstr(1:lencom) .eq. 'back') then
X           call ptkf_backwindow(1)
X         else if (commandstr(1:lencom) .eq. 'bannerheight') then
X           height = ptkf_readfloat(1, 0.01, 'Input banner height >',`20
X     : echoarea)
X           call ptkf_setbannerheight(1, height)
X         else if (commandstr(1:lencom) .eq. 'bannercolours') then
X           bancol = ptkf_readint(1, 0, 'Input banner colour index >',
X     : echoarea)
X           titlecol = ptkf_readint(1, 1,`20
X     : 'Input title string colour index >', echoarea)
X           call ptkf_setbannercolours(1, bancol, titlecol)
X         else if (commandstr(1:lencom) .eq. 'phinter') then
X           call ptkf_callphinter()
X         else if (commandstr(1:lencom) .eq. 'quit') then
X           quit = .TRUE.
X         else
X           print *,('Command unknown')   `20
X         endif
X
X         call prst(1, PALWAY)
X
X         if (quit .eq. .FALSE.) then
X           goto 10           `20
X         endif
X           `20
X         RETURN
X         END
X
XC--------------------------------------------------------------------------
X                  `20
XC     end of windtest.f
$ CALL UNPACK [.FORTRAN.SOURCE.DEMO]WINDTEST.FOR;2 1582518543
$ create 'f'
X
X       SUBROUTINE ptkf_hsltorgb(hsl, rgb)
X       REAL hsl(3), rgb(3)
X       external ptk_hsltorgb`20
X
X       call ptk_hsltorgb(hsl, rgb)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_rgbtohsl(rgb, hsl)
X       REAL rgb(3), hsl(3)
X       external ptk_rgbtohsl`20
X
X       call ptk_rgbtohsl(rgb, hsl)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_hsvtorgb(hsv, rgb)
X       REAL hsv(3), rgb(3)
X       external ptk_hsvtorgb`20
X
X       call ptk_hsvtorgb(hsv, rgb)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_rgbtohsv(rgb, hsv)
X       REAL rgb(3), hsv(3)
X       external ptk_rgbtohsv`20
X
X       call ptk_rgbtohsv(rgb, hsv)
X
X       RETURN
X       END
X
X       LOGICAL FUNCTION ptkf_cnstorgb(colourname, rgb)
X       CHARACTER*(*) colourname
X       REAL rgb(3)
X       LOGICAL*1 ptkc_cnstorgb, ans
X       external ptkc_cnstorgb`20
X
X       ans = ptkc_cnstorgb(colourname, rgb)
X       if (ans .eq. 1) then
X          ptkf_cnstorgb = .TRUE.
X       else
X          ptkf_cnstorgb = .FALSE.
X       endif
X
X       RETURN
X       END
X
X       LOGICAL FUNCTION ptkf_cnstohsl(colourname, hsl)
X       CHARACTER*(*) colourname
X       REAL hsl(3)
X       LOGICAL*1 ptkc_cnstohsl, ans
X       external ptkc_cnstohsl`20
X
X       ans = ptkc_cnstohsl(colourname, hsl)
X       if (ans .eq. 1) then
X          ptkf_cnstohsl = .TRUE.
X       else
X          ptkf_cnstohsl = .FALSE.
X       endif
X
X       RETURN
X       END
X
X       LOGICAL FUNCTION ptkf_cnstohsv(colourname, hsv)
X       CHARACTER*(*) colourname
X       REAL hsv(3)
X       LOGICAL*1 ptkc_cnstohsv, ans
X       external ptkc_cnstohsv`20
X
X       ans = ptkc_cnstohsv(colourname, hsv)
X       if (ans .eq. 1) then
X          ptkf_cnstohsv = .TRUE.
X       else
X          ptkf_cnstohsv = .FALSE.
X       endif
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setcnsdefaults(lightness, saturation)
X       INTEGER lightness, saturation
X       external ptk_setcnsdefaults`20
X
X       call ptk_setcnsdefaults(%val(lightness), %val(saturation))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_inqcnsdefaults(lightness, saturation)
X       INTEGER lightness, saturation
X       external ptk_inqcnsdefaults`20
X
X       call ptk_inqcnsdefaults(lightness, saturation)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setcolourrep(wsid, colourname)
X       INTEGER wsid
X       CHARACTER*(*) colourname
X       external ptkc_setcolourrep`20
X
X       call ptkc_setcolourrep(%val(wsid), colourname)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setrgbcolourname(colourname, rgb)
X       CHARACTER*(*) colourname
X       REAL rgb(3)
X       external ptkc_setrgbcolourname`20
X
X       call ptkc_setrgbcolourname(colourname, rgb)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setbackgroundcolourind(wsid, index)
X       INTEGER wsid, index
X       external ptk_setbackgroundcolourind`20
X
X       call ptk_setbackgroundcolourind(%val(wsid), %val(index))
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setbackgroundcolour(wsid, colourname)
X       INTEGER wsid
X       CHARACTER*(*) colourname
X       external ptkc_setbackgroundcolour`20
X
X       call ptkc_setbackgroundcolour(%val(wsid), colourname)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setlinecolour(wsid, colourname)
X       INTEGER wsid
X       CHARACTER*(*) colourname
X       external ptkc_setlinecolour`20
X
X       call ptkc_setlinecolour(%val(wsid), colourname)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setmarkercolour(wsid, colourname)
X       INTEGER wsid
X       CHARACTER*(*) colourname
X       external ptkc_setmarkercolour`20
X
X       call ptkc_setmarkercolour(%val(wsid), colourname)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setintcolour(wsid, colourname)
X       INTEGER wsid
X       CHARACTER*(*) colourname
X       external ptkc_setintcolour`20
X
X       call ptkc_setintcolour(%val(wsid), colourname)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_setedgecolour(wsid, colourname)
X       INTEGER wsid
X       CHARACTER*(*) colourname
X       external ptkc_setedgecolour`20
X
X       call ptkc_setedgecolour(%val(wsid), colourname)
X
X       RETURN
X       END
X
X       SUBROUTINE ptkf_settextcolour(wsid, colourname)
X       INTEGER wsid
X       CHARACTER*(*) colourname
X       external ptkc_settextcolour`20
X
X       call ptkc_settextcolour(%val(wsid), colourname)
X
X       RETURN
X       END
X
XC end of cns.f
X
$ CALL UNPACK [.FORTRAN.SOURCE.LIBRARY]CNS.FOR;1 152466717
$ create 'f'
X
X        SUBROUTINE ptkf_debugger(wsid, stid)
X        INTEGER wsid, stid
X        external ptk_debugger`20
X
X        call ptk_debugger(%val(wsid), %val(stid))
X`20
X        RETURN
X        END
X
X        SUBROUTINE ptkf_setdebuggerattrs(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_setdebuggerattrs`20
X
X `09call ptk_setdebuggerattrs(%val(menufont), %val(windowfont),
X     : %val(menucol), %val(menutextcol),`20
X     : %val(windowcol), %val(bannercol), %val(bannertextcol),`20
X     : %val(tlcol), %val(brcol), %val(arrowcol), %val(arrowedgecol))
X
X`09RETURN
X`09END
X
X        SUBROUTINE ptkf_inqdebuggerattrs(menufont, windowfont,
X     : menucol, menutextcol, windowcol,`20
X     : bannercol, bannertextcol, tlcol, brcol, arrowcol, arrowedgecol)
X`09INTEGER menufont, windowfont
X`09INTEGER menucol, menutextcol, windowcol
X        INTEGER bannercol, bannertextcol, tlcol, brcol
X`09INTEGER arrowcol, arrowedgecol
X        external ptk_inqdebuggerattrs
X
X `09call ptk_inqdebuggerattrs(menufont, windowfont,
X     : menucol, menutextcol,`20
X     : windowcol, bannercol, bannertextcol, tlcol,
X     : brcol, arrowcol, arrowedgecol)
X
X`09RETURN
X`09END
X
XC end of debug.f
$ CALL UNPACK [.FORTRAN.SOURCE.LIBRARY]DBUG.FOR;1 1932141123
$ create 'f'
X/*--------------------------------------------------------------------------
V*/
X
X#include <stdio.h>
X#include <descrip.h>
X#include <math.h>
X#include <phigs.h>
X#include "ptk.h"
X
X/*--------------------------------------------------------------------------
V*/
X/*-------------------------- returning reals -------------------------------
V*/
X
X
X/*--------------------------------------------------------------------------
V*/
X/*---------------------- variable length arrays ----------------------------
V*/
X
Xextern ptkboolean ptkc_pickscanmenus(ippd, pp, ppordr, menuid, itemnum)
XPint ippd;
XPpickpathel *pp;
XPint ppordr;
XPint *menuid, *itemnum;
X`7B
X  Ppickpath pickpath;
X  Pint i;
X  ptkboolean result;
X
X  pickpath.depth = ippd;
X  pickpath.pick_path = pp;
X  result = ptk_pickscanmenus(&pickpath, ppordr, menuid, itemnum);
X  free(pickpath.pick_path);
X  return result;
X`7D  /* ptkc_pickscanmenus */
X
X/*--------------------------------------------------------------------------
V*/
X
Xextern void ptkc_inqpostedmenus(wsid, num, menuids, totalnum, err)
XPint wsid, num, *menuids, *totalnum, *err;
X`7B
X  Pintlst menuidlst;
X
X  menuidlst.number = num;
X  menuidlst.integers = menuids;
X  ptk_inqpostedmenus(wsid, num, &menuidlst, totalnum, err);
X`7D  /* ptkc_inqpostedmenus */
X
X/*--------------------------------------------------------------------------
V*/
X
Xextern void ptkc_inqmenuids(num, menuids, totalnum, err)
XPint num, *menuids, *totalnum, *err;
X`7B
X  Pintlst menuidlst;
X
X  menuidlst.number = num;
X  menuidlst.integers = menuids;
X  ptk_inqmenuids(num, &menuidlst, totalnum, err);
X`7D  /* ptk_inqmenuids */
X
X/*--------------------------------------------------------------------------
V*/
X
Xextern void ptkc_inqpostedtopologies(wsid, num, topids, totalnum)
XPint wsid, num, *topids, *totalnum;
X`7B
X  Pintlst topidlst;
X
X  topidlst.number = num;
X  topidlst.integers = topids;
X  ptk_inqpostedtopologies(wsid, num, &topidlst, totalnum);
X`7D  /* ptkc_inqpostedtopologies */
X
X/*--------------------------------------------------------------------------
V*/
X
Xextern void ptkc_inqtopologyids(num, topids, totalnum)
XPint num, *topids, *totalnum;
X`7B
X  Pintlst topidlst;
X
X  topidlst.number = num;
X  topidlst.integers = topids;
X  ptk_inqtopologyids(num, &topidlst, totalnum);
X`7D  /* ptk_inqtopologyids */
X
X/*--------------------------------------------------------------------------
V*/
X
Xextern void ptkc_writestruct(fileptr, num, stids)
XFILE *fileptr;
XPint num, *stids;
X`7B
X  Pintlst stidlst;
X
X  stidlst.number = num;
X  stidlst.integers = stids;
X  ptk_writestruct(fileptr, &stidlst);
X`7D  /* ptkc_writestruct */
X
X/*--------------------------------------------------------------------------
V*/
X
Xextern void ptkc_writestructnet(fileptr, num, stids)
XFILE *fileptr;
XPint num, *stids;
X`7B
X  Pintlst stidlst;
X
X  stidlst.number = num;
X  stidlst.integers = stids;
X  ptk_writestructnet(fileptr, &stidlst);
X`7D  /* ptkc_writestructnet */
X
X/*--------------------------------------------------------------------------
V*/
X
Xextern void ptkc_inqpostedwindows(wsid, num, windowids, totalnum)
XPint wsid, num, *windowids, *totalnum;
X`7B
X  Pintlst windidlst;
X
X  windidlst.number = num;
X  windidlst.integers = windowids;
X  ptk_inqpostedwindows(wsid, num, &windidlst, totalnum);
X`7D  /* ptkc_inqpostedwindows */
X
X/*--------------------------------------------------------------------------
V*/
X
Xextern void ptkc_inqwindowids(num, windowids, totalnum)
XPint num, *windowids, *totalnum;
X`7B
X  Pintlst windidlst;
X
X  windidlst.number = num;
X  windidlst.integers = windowids;
X  ptk_inqwindowids(num, &windidlst, totalnum);
X`7D  /* ptkc_inqwindowids */
X
+-+-+-+-+-+-+-+-  END  OF PART 170 +-+-+-+-+-+-+-+-