* WINMOVE
* By Vic Garside   CIS-76666,2400  Internet-intvic@eng1.med.utah.edu
* Freeware
* All the usual disclaimers apply.

* The important functions are resize() and wincal().

* Resize() saves the current screen and sets up the
* box to be moved around and re-draws it after wincal() is called.
* Wincal() calculates the coordinates.

****************************************************************************
*-- constant variable definitions
constants()

*-- initial colors
c_standard= 'W/B,W+/N,,,w/b'
c_help =    'W/r,n/w'
c_heading = 'R+/w,'
c_message="w+/r"

*-- initial help screen coordinates
m_top=5
m_left=10
m_bottom=15
m_right=60

Setcolor(c_standard)
CLEAR

*-- just draw junk on the screen
@ 10,0 TO 15,40
@ 1,1 SAY REPLICATE('1',30)
@ 4,1 SAY REPLICATE('4',30)
@ 9,13 SAY REPLICATE('9',30)
@ 15,40 SAY REPLICATE('15',30)
@ 17,1 SAY REPLICATE('17',30)
@ 18,1 SAY REPLICATE('18',30)
@ 21,1 SAY REPLICATE('21',30)

USE HELP

memodisp(helpnotes,m_top,m_left,m_bottom,m_right,' '+LTRIM(RTRIM(INDEX))+' ')

QUIT


*!*********************************************************************
*!
*!       Function: MEMODISP()
*!
*!      Called by: UPLOAD.PRG                    
*!
*!          Calls: EXITMEMO()     (function  in UPLOAD.PRG)
*!               : EXITMEMO().PRG
*!               : CTRPOS()       (function  in UPLOAD.PRG)
*!               : DISPMSG()      (function  in UPLOAD.PRG)
*!               : RESIZE()       (function  in UPLOAD.PRG)
*!
*!*********************************************************************
FUNCTION memodisp
*displays memo and calls resize routine

PARA m_memo,m_top,m_left,m_bottom,m_right,m_heading
PRIV m_len,m_tempscr
SET KEY tab TO exitmemo()

Setcolor(c_help)

*-- original screen
m_tempscr=Savescreen(0,0,24,79)

DO WHILE true
   *--draw box
   @ m_top-1,m_left-1 CLEAR TO m_bottom+1,m_right+1
   @ m_top-1,m_left-1 TO m_bottom+1,m_right+1
   
   *--put the heading on the top of the box
   IF .NOT. EMPTY(m_heading)
      IF LEN(m_heading)<(m_right-m_left)
         Setcolor(c_heading)
         @ m_top-1,ctrpos(m_heading,m_left,m_right) SAY m_heading
         dispmsg('Tab - resize  Esc - exit '+CHR(25)+' - Down  '+CHR(24)+' - Up  PgDn - 20 Down  PgUp - 20 Up')
         Setcolor(c_help)
      ENDIF
   ENDI
   
   *-- display the contents of the memo field
   Memoedit(m_memo,m_top,m_left,m_bottom,m_right,false)
   
   *-- If the user has pressed tab, exitmemo() keyboards ctrl-w and tab
   IF Nextkey()=tab
      resize()
      *-- go back and display the memo again but witht he new box size
      LOOP
   ENDIF
   *-- restore the orignal screen
   Restscreen(0,0,24,79,m_tempscr)
   EXIT
ENDDO

SET KEY tab TO
RETURN  null

*!*********************************************************************
*!
*!       Function: RESIZE()
*!
*!      Called by: MEMODISP()     (function  in UPLOAD.PRG)
*!
*!          Calls: DISPMSG()      (function  in UPLOAD.PRG)
*!               : CTRPOS()       (function  in UPLOAD.PRG)
*!               : WINCAL()       (function  in UPLOAD.PRG)
*!               : EXITMEMO()     (function  in UPLOAD.PRG)
*!               : EXITMEMO().PRG
*!
*!*********************************************************************
FUNCTION resize
* clears box from screen, and calls wincal to calculate the new
* window coordinates, then redraws box with the new corrdinates

PRIV m_tempscr1,c_oldcolor
SET KEY tab TO

*-- restore orignal screen to remove box
Restscreen(0,0,24,79,m_tempscr)

c_oldcolor=Setcolor()

*-- tell user what to do
dispmsg('Move window - '+upkey+' '+downkey+' '+leftkey+' '+rightkey+'.  Resize - ^'+upkey+' ^'+downkey+' ^Pg Up ^Pg Dn.  ^End to exit')
*-- save the screen with the instructions on it
m_tempscr1=Savescreen(0,0,24,79)

*-- draw the box again
@ m_top-1,m_left-1 TO m_bottom+1,m_right+1

*-- loop to put box on screen, change coordinates, draw box, and do it again
DO WHILE true
   Restscreen(0,0,24,79,m_tempscr1)
   @ m_top-1,m_left-1 TO m_bottom+1,m_right+1
   *-- dispaly the heading if there is one and if it will fit in the
   *-- current box
   IF .NOT. EMPTY(m_heading)
      IF LEN(m_heading)<(m_right-m_left)
         Setcolor(c_heading)
         @ m_top-1,ctrpos(m_heading,m_left,m_right) SAY m_heading
         Setcolor(c_oldcolor)
      ENDIF
   ENDI
   
   *-- call re-size routine and get keystroke that will determine
   *-- what to do
   IF wincal(@m_top,@m_left,@m_bottom,@m_right)
      EXIT
   ENDIF
ENDDO
SET KEY tab TO exitmemo()
*-- the orignal screen
Restscreen(0,0,24,79,m_tempscr)
RETURN null
*!*********************************************************************
*!
*!       Function: WINCAL()
*!
*!      Called by: RESIZE()       (function  in UPLOAD.PRG)
*!
*!*********************************************************************
FUNC wincal
*get next keystroke and calculate new coordinates

PARA m_top,m_left,m_bottom,m_right
PRIV m_exit
m_exit=false


INKEY(0)
DO CASE
   
CASE LASTKEY()=up
   IF m_top<>1
      m_top=m_top-1
      m_bottom=m_bottom-1
   ENDIF
CASE LASTKEY()=down
   IF m_bottom<>22
      m_bottom=m_bottom+1
      m_top=m_top+1
   ENDIF
   
CASE LASTKEY()=ctrlup
   IF m_top<>1
      m_top=m_top-1
   ELSE
      IF m_bottom<>m_top
         m_bottom=m_bottom-1
      ENDIF
   ENDIF
   
CASE LASTKEY()=ctrldown
   IF m_bottom<>22
      m_bottom=m_bottom+1
   ELSE
      IF m_top<>m_bottom
         m_top=m_top+1
      ENDIF
   ENDIF
   
CASE LASTKEY()=LEFT
   IF m_left<>1
      m_left=m_left-1
      m_right=m_right-1
   ENDIF
   
CASE LASTKEY()=RIGHT
   IF m_right<>78
      m_right=m_right+1
      m_left=m_left+1
   ENDIF
   
CASE LASTKEY()=ctrleft
   IF m_left<>1
      m_left=m_left-1
   ELSE
      IF m_right<>m_left
         m_right=m_right-1
      ENDIF
   ENDIF
   
CASE LASTKEY()=ctrlright
   IF m_right<>78
      m_right=m_right+1
   ELSE
      IF m_left<>m_right
         m_left=m_left+1
      ENDIF
   ENDIF
   
CASE LASTKEY()=ctrlend
   m_exit=true
ENDCASE

RETURN m_exit

*!*********************************************************************
*!
*!       Function: EXITMEMO()
*!
*!      Called by: MEMODISP()     (function  in UPLOAD.PRG)
*!               : RESIZE()       (function  in UPLOAD.PRG)
*!
*!*********************************************************************
FUNCTION exitmemo
* just stuffs the keyboard to exit memo and call resize routine
KEYBOARD CHR(ctrlw)+CHR(tab)
RETURN null








*-- just stuff to make the demo easier to read ( and write)




*!*********************************************************************
*!
*!       Function: CONSTANTS()
*!
*!      Called by: UPLOAD.PRG                    
*!
*!*********************************************************************
FUNCTION constants
PUBLIC true, false, null, emptydate, returnkey, leftkey, rightkey,upkey, downkey, home, END, RIGHT, LEFT, up, down, END, ins
PUBLIC INSERT, del, DELETE, esc, ESCAPE, pgup, pgdn, ctrlhome,ctrlend, backspace, RETURN, enter, tab, backspace, prtscrn,     ctrlpgup, ctrlpgdn, ctrlright, ctrleft,ctrlw,ctrly
PUBLIC ctrldown,ctrlup
PUBLIC f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,altf1

*** system constants
true      = .T.
false     = .F.
null      = ''       && more readable than ""
emptydate = CTOD(SPACE(8))

*** picture elements for return key and cursor keys
returnkey = CHR(17) + CHR(196) + CHR(217)
upkey     = CHR(24)
downkey   = CHR(25)
rightkey  = CHR(26)
leftkey   = CHR(27)

*** inkey constants
home      =  1
END       =  6
RETURN    = 13
enter     = 13       && also see enter
pgup      = 18
pgdn      =  3
down      = 24
up        =  5
RIGHT     =  4
LEFT      = 19
esc       = 27
ESCAPE    = 27       && synonym FOR "esc"
ins       = 22
INSERT    = 22       && synonym FOR "ins"
del       =  7
DELETE    =  7       && synonym FOR "del"
tab       =  9
backspace =  8
prtscrn   = 42       && PRINT SCREEN KEY
ctrlhome  = 29
ctrlend   = 23
ctrleft  = 26
ctrlright =  2
ctrldown  = 401
ctrlup    = 397
ctrlpgdn  = 30
ctrlpgup  = 31
ctrlw     = 23
ctrly     = 25
ctrlc     = 3
ctrlr     = 18
**** Function keys
f1=28
f2=-1
f3=-2
f4=-3
f5=-4
f6=-5
f7=-6
f8=-7
f9=-8
f10=-9
altf1=-30
RETURN null


*!*********************************************************************
*!
*!       Function: DISPMSG()
*!
*!      Called by: MEMODISP()     (function  in UPLOAD.PRG)
*!               : RESIZE()       (function  in UPLOAD.PRG)
*!
*!*********************************************************************
FUNCTION dispmsg
*  puts msg on bottom row
* Syntax:dispmsg(string to display)
PARA m_message
PRIV m_oldcolor
m_oldcolor=Setcolor()
Setcolor(c_message)
@ 24,0 CLEAR TO 24,79
CENTER(24,m_message)
Setcolor(m_oldcolor)
RETURN null

*!*********************************************************************
*!
*!       Function: CTRPOS()
*!
*!      Called by: MEMODISP()     (function  in UPLOAD.PRG)
*!               : RESIZE()       (function  in UPLOAD.PRG)
*!
*!*********************************************************************
FUNCTION  ctrpos
* Syntax: ctrpos(chr string,left position,right position)
* Return: number showing the center of a line that is less then 80 cols
*         wide
PARA m_head,m_left,m_right
RETURN m_left+(((m_right-m_left)/2)-(LEN(m_head)/2))


*!*********************************************************************
*!
*!       Function: CENTER()
*!
*!*********************************************************************
FUNCTION CENTER                                                                                                                 && line 40: after RETURN never executed
PARA m_row,m_str
@ m_row,INT((80-LEN(m_str))/2) SAY m_str
RETURN null
*: EOF: UPLOAD.PRG