-+-+-+-+-+-+-+-+ START OF PART 168 -+-+-+-+-+-+-+-+
X         call ptkf_point(0.3, 0.2, size)
X         call ptkf_createrotator(1, rotator3, PTKETHREED, size,`20
X     : '3D rotator', 0.02)
X         if (colour .gt. 2) then
X           blue = ptkf_stringtoint('colourindex', 'blue')
X           white = ptkf_stringtoint('colourindex', 'white')
X           black = ptkf_stringtoint('colourindex', 'black')
X           call ptkf_setrotatorattrs(1, rotator1, 1, white,`20
X     : blue, white, blue, white, blue, white, black)
X           call ptkf_setrotatorattrs(1, rotator2, 1, white,`20
X     : blue, white, blue, white, blue, white, black)
X           call ptkf_setrotatorattrs(1, rotator3, 1, white,`20
X     : blue, white, blue, white, blue, white, black)
X         endif
X         call ptkf_point(0.5, 0.3, pos)
X         call ptkf_setmenuposition(rotator1, pos)
X         call ptkf_point(0.5, 0.55, pos)
X         call ptkf_setmenuposition(rotator2, pos)
X         call ptkf_point(0.5, 0.8, pos)
X         call ptkf_setmenuposition(rotator3, pos)
X         call ptkf_setrotatortitle(rotator1, 'zoom')
X
X         RETURN
X         END
X        `20
XC--------------------------------------------------------------------------
X        `20
X         SUBROUTINE testboxmenu()
X         LOGICAL boxmenuquit, picked
X         INTEGER itemnum
X         LOGICAL getmenupick
X         INTEGER ptkf_stringtoint
X
X         include '`5B`5Dvmsphigs77.for'
X
X         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 'mainmenu')) `20
X         call ptkf_postmenu(1, ptkf_stringtoint('menuid', 'inputmenu'))
X         call ptkf_postmenu(1, ptkf_stringtoint('menuid', 'boxmenu')) `20
X
X         call prst(1, PALWAY)
X         boxmenuquit = .FALSE.
X
X 10      itemnum = 0
X         picked = getmenupick(ptkf_stringtoint('menuid', 'inputmenu'),`20
X     : itemnum)`20
X         if (picked .eq. .TRUE.) then
X            print *,('Testing ptkf_setboxmenuhighlightitem()...')
X            call ptkf_setboxmenuhighlightitem(ptkf_stringtoint('menuid',
X     : 'inputmenu'), itemnum)
X            call prst(1, PALWAY)
X
X            if (itemnum .eq. 1) then
X              call pickinput(itemnum)
X              call ptkf_setboxmenuhighlightitem(ptkf_stringtoint(
X     : 'menuid', 'boxmenu'), itemnum)
X            else if (itemnum .eq. 2) then
X              call pointinput(itemnum)
X              call ptkf_setboxmenuhighlightitem(ptkf_stringtoint(
X     : 'menuid', 'boxmenu'), itemnum)
X            else if (itemnum .eq. 3) then
X              call stringinput(itemnum)
X              call ptkf_setboxmenuhighlightitem(ptkf_stringtoint(
X     : 'menuid', 'boxmenu'), itemnum)
X            else
X              boxmenuquit = .TRUE.
X            endif
X         endif
X
X         call prst(1, PALWAY)
X
X         if (boxmenuquit .eq. .TRUE.) then
X           goto 20
X         else`20
X           goto 10
X         endif
X
X 20      call ptkf_clearboxmenuhighlight(ptkf_stringtoint('menuid',`20
X     : 'inputmenu'))
X         call ptkf_clearboxmenuhighlight(ptkf_stringtoint('menuid',`20
X     : 'boxmenu'))
X         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid', 'boxmenu'))
X
X         RETURN
X         END
X           `20
XC--------------------------------------------------------------------------
X         `20
X         SUBROUTINE testrotator()
X         LOGICAL rotatorquit, picked
X         INTEGER err, itemnum
X         LOGICAL getmenupick
X         INTEGER ptkf_stringtoint
X
X         include '`5B`5Dvmsphigs77.for'
X
X         print *,('Testing ptkf_delmenuitem...')
X         call ptkf_delmenuitem(ptkf_stringtoint('menuid',`20
X     : 'inputmenu'), 3)
X         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid',`20
X     : 'mainmenu')) `20
X         call ptkf_postmenu(1, ptkf_stringtoint('menuid',`20
X     : 'inputmenu'))
X         `20
X         call ptkf_postmenu(1, ptkf_stringtoint('menuid',`20
X     : '1drotator'))
X         call ptkf_postmenu(1, ptkf_stringtoint('menuid',`20
X     : '2drotator'))
X         call ptkf_postmenu(1, ptkf_stringtoint('menuid',`20
X     : '3drotator'))
X         call prst(1, PALWAY)
X         rotatorquit = .FALSE.
X 10      itemnum = 0
X         picked = getmenupick(ptkf_stringtoint('menuid', 'inputmenu'),
X     : itemnum)
X         if (picked .eq. .TRUE.) then
X            if (itemnum .eq. 1) then
X              call pickinput(itemnum)
X            else if (itemnum .eq. 2) then
X              call pointinput(itemnum)
X            else
X              rotatorquit = .TRUE.
X            endif
X         endif
X
X         if (rotatorquit .eq. .TRUE.) then
X           goto 20
X         else`20
X           goto 10
X         endif
X
X 20      call ptkf_unpostmenu(1, ptkf_stringtoint('menuid',`20
X     : '1drotator'))
X         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid',`20
X     : '2drotator'))
X         call ptkf_unpostmenu(1, ptkf_stringtoint('menuid',`20
X     : '3drotator'))
X         call ptkf_createtextmenuitem(ptkf_stringtoint('menuid',`20
X     : 'inputmenu'), 'string', 3, PINSRT, err)
X
X         RETURN
X         END
X         `20
XC--------------------------------------------------------------------------
X         `20
XC     end of menutest.f
$ CALL UNPACK [.FORTRAN.SOURCE.DEMO]MENUTEST.FOR;2 661524456
$ create 'f'
XC---------------------------------------------------------------------------
V`20
X
XC Program name: Phinter utility program.
X
XC Author: Gareth Williams
X
XC Description:
X
XC Modification history : (Version), (Date), (Name), (Description).
X
XC 1.0, 1st March 1991, G. Williams, First Version.
X
XC---------------------------------------------------------------------------
V-
X
X      PROGRAM phinter
X
X      call ptkf_inithashtables()
X      call ptkf_createhashtable('structureid', 1, 500)
X      call ptkf_createhashtable('label', 1, 100)
X      call ptkf_createhashtable('viewindex', 1, 50)
X      call ptkf_createhashtable('colourindex', 2, 256)
X      call ptkf_createhashtable('name', 1, 500)
X      call ptkf_callphinter()
X
X      STOP
X      END
X     `20
XC--------------------------------------------------------------------------
X
XC end of phinter.f
$ CALL UNPACK [.FORTRAN.SOURCE.DEMO]PHINTER.FOR;1 92144592
$ create 'f'
XC---------------------------------------------------------------------------
V`20
X
XC Program name: StructureDraw test program.
X
XC Author: Gareth Williams
X
XC Description:
X
XC Modification history : (Version), (Date), (Name), (Description).
X
XC 1.0, 1st July 1991, G. Williams, First Version.
X
XC---------------------------------------------------------------------------
V-
X         `20
X       PROGRAM stcttest
X
X       implicit none
X
X       INTEGER err, minid, maxid, pid
X       LOGICAL ptkf_readphinterscript
X       INTEGER ptkf_stringtoint
X
X       include '`5B`5Dvmsphigs77.for'
X
X       print *,('Testing the structure draw module of the PHIGS`20
X     : Toolkit...')
X       print *,('Opening DEC PHIGS...')
X
X       call popph(0, 0)
X
XC     create the workstation type (either tool or canvas)`20
X             `20
XC     open the workstation`20
X      `20
X       call popwk(1, 0, 0)
X
X       call psdus(1, PWAITD, PNIVE)
X       minid = 1
X       maxid = 30
X       call ptkf_inithashtables()
X       call ptkf_createhashtable('structureid', minid, maxid)
X       call ptkf_createhashtable('label', 0, maxid)
X       call ptkf_createhashtable('name', 0, maxid)
X      `20
X       if (ptkf_readphinterscript('`5B-.-.scripts`5Dpostcard.scr',`20
X     : 0, 0)) then
X         call popst(ptkf_stringtoint('structureid', 'content'))
X         pid = ptkf_stringtoint('structureid', 'postcard')
X         call ptkf_structcontent(1, pid, 1, 0, 0, 1, err)
X         call pclst()
X      `20
X         if (err .eq. 0) then
X           call ppost(1, ptkf_stringtoint('structureid', 'content'),`20
X     : 0.0)
X         endif
X
X         call prst(1, PALWAY)
X         call options()
X       endif
X
X         call pclwk(1)
X         call pclph()
X
X       STOP
X       END
X
XC--------------------------------------------------------------------------
X
X       SUBROUTINE options()
X       CHARACTER*20 commandstr, postcdstr, rangestr, pointstr, quitstr
X       INTEGER lencom, err, elem1, elem2, eptr, postcardid
X       LOGICAL structquit
X       REAL echoarea(4)
X       INTEGER ptkf_readint
X       INTEGER ptkf_stringtoint
X       REAL devx, devy
X      `20
X       postcdstr = 'postcard'
X       rangestr = 'range'
X       pointstr = 'pointer'
X       quitstr = 'quit'
X       structquit = .FALSE.
X       eptr = 0
X       postcardid = ptkf_stringtoint('structureid', 'postcard')
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, 'range', 'Input command`20
X     : (default = range) >', echoarea, 20, commandstr, lencom)
X       if (commandstr(1:lencom) .eq. rangestr(1:lencom)) then
X          elem1 = ptkf_readint(1, 1, 'Input element number (1) >',`20
X     : echoarea)
X          elem2 = ptkf_readint(1, 0, 'Input element number (0) >',`20
X     : echoarea)
X          call pemst(ptkf_stringtoint('structureid', 'content'))
X          call popst(ptkf_stringtoint('structureid', 'content'))
X          call ptkf_structcontent(1, postcardid, elem1, elem2, eptr, 1,`20
X     : err)
X          call pclst()
X          call prst(1, PALWAY)
X       else if (commandstr(1:lencom) .eq. pointstr(1:lencom)) then
X          eptr = ptkf_readint(1, 0, 'Input element pointer (0) >',`20
X     : echoarea)
X          call popst(ptkf_stringtoint('structureid', 'content'))
X          call ptkf_setstructcontentelemptr(ptkf_stringtoint(
X     : 'structureid', 'content'), eptr)
X          call pclst()
X          call prst(1, PALWAY)
X       else if (commandstr(1:lencom) .eq. quitstr(1:lencom)) then
X          structquit = .TRUE.
X       else
X          print *,('Command unknown')   `20
X       endif
X
X       if (structquit .eq. .TRUE.) then
X         goto 20
X       else`20
X         goto 10
X       endif
X
X 20    RETURN
X       END
X
XC--------------------------------------------------------------------------
X         `20
XC     end of stcttest.f
$ CALL UNPACK [.FORTRAN.SOURCE.DEMO]STCTTEST.FOR;2 908042371
$ create 'f'
XC---------------------------------------------------------------------------
V`20
X
XC Program name: TopDraw test program.
X
XC Author: Gareth Williams
X
XC Description:
X
XC Modification history : (Version), (Date), (Name), (Description).
X
XC 1.0, 1st June 1991, G. Williams, First Version.
X
XC---------------------------------------------------------------------------
V-
X
X       PROGRAM toptest
X
X       implicit none
X
X       include '`5B`5Dvmsphigs77.for'
X       include '`5B`5Dvmsptk77.for'
X
XC--------------------------------------------------------------------------
X
X       INTEGER err, minid, maxid
X       LOGICAL ptkf_readphinterscript
X       INTEGER ptkf_stringtoint
X      `20
X       print *,('Testing the topdraw module of the PHIGS Toolkit...')
X       print *,('Opening DEC PHIGS...')
X
X       call popph(0, 0)
X
XC     create the workstation type (either tool or canvas)`20
X             `20
XC     open the workstation`20
X      `20
X       call popwk(1, 0, 0)
X
X       call psdus(1, PWAITD, PNIVE)
X
X       minid = 0
X       maxid = 30
X       call ptkf_inithashtables()
X       call ptkf_createhashtable('structureid', 17, 100)
X       call ptkf_createhashtable('label', minid, maxid)
X       call ptkf_createhashtable('topologyid', minid, maxid)
X       call ptkf_createhashtable('name', minid, maxid)
X      `20
XC     make dummy network`20
X    `20
X       if (ptkf_readphinterscript('`5B-.-.scripts`5Dlamp.scr',`20
X     : 0, 0)) then
X         print *,('Testing ptkf_topology()...')
X         call ptkf_createtopology(ptkf_stringtoint('topologyid',`20
X     : 'topology'), ptkf_stringtoint('structureid', 'lamp'), err)
X         print *,('Testing ptkf_posttopology()...')
X         call ptkf_posttopology(1, ptkf_stringtoint('topologyid',`20
X     : 'topology'), 0.0)
X         call prst(1, PALWAY)
X
X         call options()
X       endif
X
X       call pclwk(1)
X       call pclph()
X
X       STOP
X       END
X
XC--------------------------------------------------------------------------
X
X       SUBROUTINE options()
X
X       implicit none
X
X       CHARACTER*20 commandstr
X       INTEGER lencom
X       LOGICAL topquit
X       REAL echoarea(4)
X       INTEGER ptkf_stringtoint
X       INTEGER topid
X       INTEGER lldr, pldr
X       REAL ra(2)
X       INTEGER ia(2), lstr(2)
X       CHARACTER*80 str
X       CHARACTER*80 ldatrec(10), pdatrec(10)
X       CHARACTER*80 storename
X       INTEGER*4 fileptr, err
X       INTEGER ptkf_fopen
X       INTEGER ptkf_fclose
X       REAL devx, devy
X
X       include '`5B`5Dvmsphigs77.for'
X       include '`5B`5Dvmsptk77.for'
X
X       storename = '`5B-.-.data`5Dstore.dat'
X       topid = ptkf_stringtoint('topologyid', 'topology')
X       topquit = .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, 'boxtopology',`20
X     : 'Input command (default = boxtopology) >', echoarea, 20,`20
X     : commandstr, lencom)
X       if (commandstr(1:lencom) .eq. 'boxtopology') then
X         print *,('Testing ptkf_settopologytype()...')
X         call ptkf_settopologytype(topid, PTKEBOXTOPOLOGY)
X
X      else if (commandstr(1:lencom) .eq. 'structnettopology') then
X         print *,('Testing ptkf_settopologytype()...')
X         call ptkf_settopologytype(topid, PTKESTRUCTNETTOPOLOGY)
X
X      else if (commandstr(1:lencom) .eq. 'structtopology') then
X         print *,('Testing ptkf_settopologytype()...')
X         call ptkf_settopologytype(topid, PTKESTRUCTTOPOLOGY)
X
X      else if (commandstr(1:lencom) .eq. 'tidysingle') then
X         print *,('Testing ptkf_tidytopology()...')
X         ra(1) = 0.01
X         call pprec(0, ia, 1, ra, 0, lstr, str, 10, err, pldr,
X     : pdatrec)
X         call pprec(0, ia, 0, ra, 0, lstr, str, 10, err, lldr,
X     : ldatrec)
X         call ptkf_tidytopology(1, ptkf_stringtoint('topologyid',`20
X     : 'topology'), PTKESINGLE, 1, 1, pldr, pdatrec, 1, 1,`20
X     : lldr, ldatrec)
X
+-+-+-+-+-+-+-+-  END  OF PART 168 +-+-+-+-+-+-+-+-