home *** CD-ROM | disk | FTP | other *** search
- /*
- Copyright StarTeck 1992. All rights reserved.
-
- This Genie will name zoom positions.
- Just answer prompts...
- */
- trace off
-
- signal on error
- signal on syntax
-
- call pdm_AutoUpdate(0)
-
- cr = '0a'x
- datafile = 'datafile'
- filename = 'sys:S/ZoomList.STk' /* load data file varable*/
- filename2 = 'sys:S/ZoomList2.STk' /* load data file varable*/
- windowname. = ''
- windownames = ''
- zoomdata. = ''
- tempfile = 'tempfile'
- count = 0
-
-
- if open(datafile, filename, 'r') then do
- if datafile = '' then exit_msg(filename' is empty...')
-
- do while ~eof(datafile) /* do until end of file */
- line = readln(datafile) /* read line of file */
- parse var line name.count ',' zoomdata.count
-
- if count = 0 then
- windownames = name.count
- else do
- if ~(eof(datafile)) then
- windownames = windownames ||cr|| name.count
- end /* else */
-
- count = count + 1
- end /* do while */
- end /* if then do */
- else
- exit_msg('Can not find 'filename)
-
- call close(datafile)
- count = count - 1
-
-
- userchoice = pdm_selectFromList('Select window name...',30,count,2,windownames)
- if userchoice = '' then exit_msg()
-
- select
-
- when userchoice = 'DEFINE NEW WINDOW' then do
- /* create a file */
- if ~(open(tempfile,filename2, 'w')) then
- call exit_msg('Can not find ""sys:s/"" dir...')
- else do
- do i = 0 to (count - 1)
- call writeln(tempfile,name.i','zoomdata.i)
- end /* do */
-
- UserZoomArea = pdm_clickarea(Drag rectangle with mouse...)
- if UserZoomArea = '' then exit_msg()
-
- parse var UserZoomArea TopX TopY BotX BotY
- width = BotX - TopX
- width = trunc(width,4)
- height = BotY - TopY
- height = trunc(height,4)
- centerX = TopX + (width / 2)
- centerX = trunc(centerX,4)
- centerY = TopY + (height / 2)
- centerY = trunc(centerY,4)
-
- WindowName = pdm_getUserText(30,'Input WINDOW NAME')
- if WindowName = '' then exit_msg()
-
- call writeln(tempfile,Windowname','centerX','centerY','Width)
- call close(datafile)
- call close(tempfile)
- address command 'copy >nil SYS:S/zoomlist2.STk sys:s/zoomlist.STk'
- address command 'delete >nil SYS:S/zoomlist2.STk'
-
- call pdm_zoomscreen(centerX,centerY,Width)
-
- end /* else */
- end /* when */
-
-
- when userchoice = 'DELETE A WINDOW' then do
- parse var windownames scrap1 (cr) scrap2 (cr) windownamesdelete
- userchoice = pdm_selectFromList('Select window name...',30,count - 2,2,windownamesdelete)
- if userchoice = '' then exit_msg()
- /* create a file */
- if open(tempfile,filename2, 'w') then do
-
- do i = 0 to count - 1
- if ~(userchoice = name.i) then
- call writeln(tempfile,name.i','zoomdata.i)
- end /* do */
-
- call close(datafile)
- call close(tempfile)
- address command 'copy >nil sys:s/zoomlist2.STk sys:s/zoomlist.STk'
- address command 'delete >nil sys:s/zoomlist2.STk'
- end /* do */
- else
- call exit_msg('Can not find ""sys:s/"" dir...')
-
- end /* when */
-
-
- otherwise do
- do i = 2 to count
- if userchoice = name.i then do
- parse var zoomdata.i centerX ',' centerY ',' width
- call pdm_zoomscreen(centerx,centery,width)
- end /* if then do */
- end /* do */
- end /* otherwise */
-
- end /* select */
-
-
- call exit_msg()
-
-
- error:
- syntax:
- do
- exit_msg("Genie failed due to error: "errortext(rc))
- end
- return
-
-
- writeln: procedure
- len = 'WRITELN'(arg(1), arg(2))
- if len ~= length(arg(2)) + 1 then do
- say "Error on write to file "arg(1) " . Aborting script..."
- call close(arg(1))
- exit
- end
- return
-
- exit_msg:
- do
- parse arg message
- if message ~= '' then call pdm_Inform(0, message)
- call pdm_AutoUpdate(1)
- call close(datafile)
- call close(tempfile)
- exit
- end