DataMuseum.dk

top - metrics - download

    Length: 12836 (0x3224)
    Types: TextFile
    Names: »subs7.f«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─⟦this⟧ »EUUGD11/euug-87hel/sec1/utep/subs7.f« 

TextFile

**************************************************************************
*
* subroutine geninfo does the following:
* (general information)
*  + display to the user some general info
*    - name of routine (IDBR).
*      (Interactive Drawing Board Routine)
*    - number of drawing pages/user.
*    - number of pages that can be saved /user.
*    - number of items/page.
**************************************************************************
	subroutine geninfo
	write(0,10)
10	format(5x,'This is an interactive drawing board routine.')
c
	write(0,20)
20	format(5x,'You have five 10x10 pages with bottom left point',
     *  /,5x,'coordinates (0,0)')
c
	write(0,30)
30	format(5x,'You are allowed to draw up to 20 items ',/,5x,
     *  'on each page and save up to five images',/)
	return
	end
**************************************************************************
*
* subroutine draw does the following:
*
*     + guide the user through the drawing
*       session
*      - supply blank pages
*      - recall saved pages
*      - image editing
*      - check if limits on number of image
*        items (numitms) or number of drawing 
*        pages is going to be violated ,if so
*        display warning messages (else)
*        continue drawing.
*      - display error messages when necessary
*        and allows the user to try again to 
*        to input correct info.
*
**************************************************************************
	subroutine draw
	common/poly/iflag,numpoly,ifivply(5)
	common/num/numitms
	character*1 answer1,answer
c
c
c supply of drawing pages/user/drawing session  
c are five pages,if all used display a warning
c message and give user choice of recalling 
c a saved image (else) continue drawing.
c
c
	do 90 i=1,6
	  if(i.eq.6)then
	  write(0,10)
10	  format(5x,'WARNING:You have used the'
     *    'limit of drawing pages/user')
	  call recall
	  else
	  call recall
	  call blnkpag
	  read(5,60) answer1
60	  format(a1)
c
c do you want a blank page to draw on?
c
	if(answer1.eq.'y' .or. answer1.eq.'Y')then
c
c (YES) need a blank page.
c
	     call ready
	     call sat
c
c number of items user can draw on one single
c page are (20) items,if number of image items within
c limits continue drawing (else) display a 
c warning message (no more drawing) then give
c user the choice of editing image.
c
	     do 20 j=1,30
	        if(numitms.lt.20)then
c
c ask if user want to continue drawing on
c current page.
c
	          if(iflag.eq.0)then
	            call samepag
	            read(5,80)answer
80	            format(a1)
	          else
	            answer='y'
	          endif
	       do 40 k=1,3
	         if(answer.eq.'y' .or. answer.eq.'Y')then
c
c (YES) want to draw an item,display item menu
c       , draw item.
c
	           call itmmenu
	           call ditem
	           k=4
	         elseif(answer.eq.'n' .or. answer.eq.'N')then
c
c (NO) give a chioce of editing image
c
	           k=4
	           j=31
	           call edit
	         else
c
c (OTHERWISE)  display error message--try again
c
	           call error(1)
	         endif
40	      continue
	       else
	         write(0,30)
30	         format(5x,'WARNING:You have used the'
     *           'limit of items/page')
	         call edit
	         j=31
	       endif
20	     continue
	elseif(answer1.eq.'n' .or. answer1.eq.'N')then
c
c (NO) don't need a blank page
c
             i=7
	else
c
c (OTHERWISE)--error-->(undefined answer try again)
c
	     call error(1)
	endif
	endif
90       continue

	return
	end
**************************************************************************
*
* subroutine blnkpag does the following:
* (blank page)
*  + display a question on the terminal.
*  + expect an answer.
**************************************************************************
	subroutine blnkpag
	write(0,10)
10	format(5x,'If you want to continue you will be supplied',/,5x,
     *  'with a blank page (else) this drawing session will be',/,5x,
     *  'terminated, answer: y-yes , n-no')
	return
	end
***************************************************************************
*
* subroutine samepag does the following:
* (same page)
*  + display a question on the terminal.
*  + expect an answer.
***************************************************************************
	subroutine samepag
	write(0,10)
10	format(5x,'Do you want to continue drawing on current page',/,5x,
     *  'answer: y-yes , n-no')
	return
	end
**************************************************************************
*
* subroutine change(ans) does the following:
* (local change - item editing)
*  + display a question on terminal.
*  + expect an answer.
*  + if positive answer, display an informative
*    message ( user have  3  chances to 
*    change item correctly).
*    else (negative answer) return
**************************************************************************
	subroutine change(ans)
	character*1 ans
c
	write(0,10)
10	format(5x,'Do you want to do some changes on this item ',/,5x,
     *  ' answer: y-yes , n-no')
c
	read(5,20)ans
20	format(a1)
	if(ans.eq.'y' .or. ans.eq.'Y')then
	  write(0,30)
30	  format(5x,'For each single change you have three chances',/
     *    ,5x,'to input the correct data else no change will be issued')
	endif
	return
	end
*************************************************************************
*
* subroutine edit does the following:
* (image editing - globle change)
*  
* + does user want to do globle change.
*   - yes->
*         * set image change flag (icflag)
*         * list image items
*         * pick one item by number
*         * display globle change menu
*           of commands (gcmenu)
*         * read one command and process it
*   - no->
*         * choice of saving created image
*   - otherwise->
*         * error- undefined answer
*           try again.
*************************************************************************
	subroutine edit
	common/prec/ipgrec,icflag
	common/gc/igcflg
	character*1 answer,ans1
	integer number
c
	     do 40 k=1,20
	        do 50 m=1,3
	                 igcflg=0
	                 call gchange(answer)
	     if(answer.eq.'y' .or. answer.eq.'Y')then
	                 icflag=1
	                 call lsitems
	                 call pickitm(number)
	                 do 30 i=1,3
	                  if(igcflg.eq.1)then
	                  i=4
	                  else
	                    do 20 j=1,3
c Remind user that this is image editing session.
	write(0,10)
10	format(5x,'You are in image editing session',/)
	                      call change(ans1)
	      if(ans1.eq.'y'.or.ans1.eq.'Y')then
	                 call gcmenu
	                 call rdcomnd(number)
	                 j=4
	     elseif(ans1.eq.'n'.or.ans1.eq.'N')then
	                 j=4
	                 i=4
	     else
	                 call error(1)
	     endif
20	                 continue
	              endif
30	                 continue
	     m=4
	     elseif(answer.eq.'n' .or. answer.eq.'N')then
	                 call savpag
	                 k=21
	                 m=4
	     else
	                 call error(1)
	     endif
50	   continue
40	     continue
	return
	end
************************************************************************
*
* subroutine fclose(ipnumb) does the following:
* (close files)
* 
* + close the files that contain image number
*   (ipnumb).
*   - inquire about units
*   - close and save image files.
*************************************************************************
	subroutine fclose(ipnumb)
	integer u1,u2,ipnumb
c
	call whichu(ipnumb,u1,u2)
	call csif(u1,u2)
	return
	end
***************************************************************************
*
* subroutine savpag does the following:
* (save page)
* 
*   + user have a choice of saving created
*     image.
*   + yes->
*          * new page-- save it
*          * recalled page
*            - changed-- resave it
*            - unchanged-- continue
*   + no->
*          * continue
*   + otherwise->
*          * error-undefined answer
*            try again.
***************************************************************************
	subroutine savpag
	common/prec/ipgrec,icflag
	character*1 anspg
c
	do 30 i=1,4
	   write(0,10)
10	format(5x,'Do you want to save image,answer:y-yes,n-no')
	   read(5,20)anspg
20	   format(a1)
	   if(anspg.eq.'y'.or.anspg.eq.'Y')then
	       if(ipgrec.eq.0)then
	            call snpage
	       else
	            if(icflag.eq.1)then
	                 call resave
	            endif
	       endif
	       ipgrec=0
	       icflag=0
	       i=5
	   elseif(anspg.eq.'n'.or.anspg.eq.'N')then
	       if(ipgrec.gt.0)then
	         call fclose(ipgrec)
	         ipgrec=0
	         icflag=0
	       endif
	            i=5
	   else
	            call error(1)
	   endif
30	continue
	call pgdone
	call newpage
	return
	end
****************************************************************************
*
* subroutine recall does the following:
* (recall image)
* 
*  + user have a choice of recalling a 
*    saved image.
*  + yes->
*         * input page number
*         * open its files
*         * image exist?
*           - yes-> display it
*                   look at it
*                   change it if needed
*                   close its files
*           - no->  continue
*           - otherwise->
*                   error-undefined answer try
*                         again.
****************************************************************************
	subroutine recall 
	common/prec/ipgrec,icflag
	common/pnum/numspg
	character*1 answer
	integer ansfil,number
c
	call howmpg
	do 40 j=1,numspg
	  do 30 i=1,4
	  write(0,10)
10	  format(5x,'Do you want to call a saved image,answer:y-yes,n-no')
	  read(5,20)answer
20	  format(a1)
	  if(answer.eq.'y'.or.answer.eq.'Y')then
	            call whichp(number)
	            ipgrec=number
	            call fopen(ansfil)
	            if(ansfil.eq.1)then
	                call dsimag
	            else
	                call error(9)
	            endif
	            i=5
	  elseif(answer.eq.'n'.or.answer.eq.'N')then
	            i=5
	            j=numspg+1
	  else
	            call error(1)
	  endif
30	  continue
40	continue
	return
	end
***************************************************************************
*
* subroutine dsimag does the following:
* (display recalled image)
* 
*   + image number in globle variable (ipgrec)
*   + inquire about its units
*   + read its files back
*   + display image on AED screen
*   + edit image if requested
***************************************************************************
	subroutine dsimag
	integer u1,u2
	common/device/lastx,lasty,numpag
	common/prec/ipgrec,icflag
c
	call clr
	call ready
	call whichu(ipgrec,u1,u2)
	call rdjpg(u1)
	call rdinf(u2)
	call dspage
	call edit
	numpag=numpag-1
	return
	end
***************************************************************************
*
* subroutine fopen(reply) does the following:
* (files open)
*   + recalled image number in globle var
*     (ipgrec)
*   + files exist?
*     - yes->
*            * open files for access
*            * reply=1
*     - no->
*            * reply=0
***************************************************************************
	subroutine fopen(reply)
	common/prec/ipgrec,icflag
	integer reply,u1,u2
	character*6 f1,f2
	logical creatd
c
	call whichu(ipgrec,u1,u2)
	call whichf(ipgrec,f1,f2)
	inquire(file=f1,exist=creatd)
	  if(creatd)then
	    call oif(u1,u2,f1,f2)
	    reply=1
	  else
	    reply=0
	  endif
	return
	end
****************************************************************************
*
* subroutine resave does the following:
* (resave recalled image)
*   
*   + recalled image number in globle var
*     (ipgrec)
*   + set its files initial position to
*     its first record
*   + save image into files
****************************************************************************
	subroutine resave
	common/prec/ipgrec,icflag
	integer u1,u2
c
	call whichu(ipgrec,u1,u2)
	rewind(u1)
	call savjpg(u1)
	rewind(u2)
	call savinf(u2)
	call fclose(ipgrec)
	return
	end
**************************************************************************
*
* subroutine dspage does the following:
*  (draw segmented saved page)
*  - draw the recalled segmented page one
*    segment at a time according to their
*    priorities.
*
*   + check if recalled image is empty
*     by any chance then display it as is.
*   + (else) if image has more than one item
*     in it then display image as described
*     above.
*
**************************************************************************
	subroutine dspage
	common/num/numitms
	common/table/tblitms(20,10),icolor(20),items(20)
	character*1 items
c
	call drawp
	   do 250 i=1,numitms
	      call tempinf(i)
	      call sndscd(i)
250	   continue
	return
	end