Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : 50MOUSE.ZIP
Filename : PMENU.PRG

#define AR_MAX 40
#define CNT 24
#define MAX_ITEM 10 // max item hor.
#define H_MAX 4 // max item ver.
#include "inkey.ch"


PROCEDURE MAIN

PUBLIC m1,m2,m3,m4,m5,mi2,mi3,mi4,mi5,wo,top_row,top_col,bot_row,bot_col,;
LOGO,G_NO,clip50,poslev1,h_ar, ph_st,v_max,col6,v_ar[26],p_st[26],h_flag,;
poslev2,wo_c,wo_r,wo_rel,wo_col,cnt_i,men_step


h_ar := {}; ph_st := {}
m1 := m2 := m3 := m4 := m5 := mi2 := mi3 := mi4 := mi5 := wo := cnt_i := 0
poslev1 := poslev2 := top_row := top_col := bot_row := bot_col := 0
men_step := 0

* What do you have ?
IF iscolor()
col1 ="W/B"
col2 ="R/B"
col3 ="G/B"
col4 ="B/W*"
col5 ="N/GR"
col6 ="W+/bl,N/BG"
col7 ="B/W"
col8 ="G+/B"
col9 ="GR+/R"
col10 ="W/B,R/W,,,W/B"
ELSE
STORE "W/N" TO col1,col2,col3,col6,col10
STORE "N/W" TO col4,col5,col7,col8,col9
ENDIF
SET COLOUR TO &col1
SET Cursor OFF
SET SCOREBOARD OFF
CLEAR


STORE " Mouse Interface for Clipper S'87 * SHAREWARE * Author: ù "+;
"Jobst Hensiek ù " TO LOGO &&
SET COLOUR TO &col8 &&
@ 0,0 SAY LOGO &&
SET COLOUR TO &col1 &&

*******************************************
*
* 5.0 Code Blocks
*
vmen := { |col, item| aadd(h_ar, col), aadd( ph_st, item) }
hmen := { |arind, row, item| v_ar[ ARind ] := row, p_st[ ARind ] := item }


* MOUSE : Reset mouse & get status.
Mouse(@m1,@m2,@m3,@m4)
IF m1 # -1
SET COLOUR TO
@ 1,0 CLEAR TO 24,79
SET COLOUR TO (col8)
@ 0,0 SAY LOGO
? "No mouse found !"+CHR(7)
QUIT
ENDIF

m_wake_up()
m1 = 10
m2 = 0
m3 = 65535
m4 = 30464
Mouse(@m1,@m2,@m3,@m4)


* DEMO - Menu
ant1_0=1
DO WHILE .T. && Show mouse
m_wake_up()
SET COLOUR TO (col6)
@ 1,0 CLEAR TO 24,79
SET INTENSITY ON
CLEAR TYPEAHEAD
* keep the mouse in this area
men_step := mn_init(6,25,17,54,6) && Menu coordinates
* Activation character for menu.
m_setint("1010","MN_ACTION") && Set interrupt
* put cursor there
m_putxy(24,5+ant1_0*2) && keep mouse cursor there
SET MESSAGE TO 24 CENTER

@ 2,0 say center("ù Sorry, only the registered version will not beep ù")
@ 7,25 PROMPT " 1) Show mouse botton status " MESSAGE ;
"Draw a mouse & display button status, print location of interrupt"
@ 9,25 PROMPT " 2) Using the mouse on GETs " MESSAGE ;
"Use standard GETs with your mouse"
@ 11,25 PROMPT " 3) Mouse & ACHOICE " MESSAGE ;
"HOME, END, UP, DOWN, Pdg.UP & Pdg. Dn., ESC, SELECT. Achoice is TOP!"
@ 13,25 PROMPT " 4) Registration terms " MESSAGE ;
"What to expect if you register. Assembly source is available."
@ 15,25 PROMPT " 5) Pulldown - Menu " MESSAGE ;
"Easy pulldown menu full key support"
@ 17,25 PROMPT " 6) Quit program " MESSAGE ;
"Quit Demo and return to DOS "
MENU TO ant1_0
m_sleep() && hide mouse
SET COLOR TO (col1)
DO CASE
CASE ant1_0=1 && STATUS
* let the mouse use the whole screen
m_setarea(0,0,24,79) && allow mouse in this area
*
@ 1,0 CLEAR TO 24,79
dum = ' '
maus_bild()
m_setint("1010","BT_ACTION") && prepare for interrupt
* Wait-State. You may now invoke the "SET KEY drop_in TO procedure"
@ 1,0 SAY CENTER("Status of the mouse")
@ 24,0 SAY CENTER("Right mouse button or ESC to leave")
SET Cursor OFF
SET INTENSITY OFF
DO WHILE .T.
m_wake_up() && Show mouse
@ 1,0 GET dum
Readexit(.T.)
READ
IF LASTKEY() = 27
Readexit(.F.)
EXIT
ENDIF
LOOP
ENDDO
SET INTENSITY ON
LOOP
CASE ant1_0 = 2 && GETs
PUBLIC C[ CNT + 2 ], R[ CNT + 2 ],MM[ CNT + 2]
SET INTENSITY OFF
SET DELIMITER TO "[]"
SET DELIMITER ON
SET COLOUR TO (col1)
@ 1,0 CLEAR TO 24,79
@ 1,0 SAY CENTER("Using the mouse with GETs")
@ 24,0 SAY CENTER("Right mouse button or ESC to leave")
* make it hot
m_setarea(0,0,24,79) && use the whole screen
m_setint("1010","MG_ACTION") && setup interrupt
G_NO = 0

AFILL(MM, " ")

WHILE (.T.)
m_wake_up()

@ 3,2 SAY ""
FOR G_NO := 1 to 8
@ G_NO + 3, 2 GET mm[ G_NO]
R[ G_NO ] := G_NO + 3 ; C[ G_NO ] := 2
next

@ 3,25 SAY ""
FOR G_NO := 9 to 16
@ G_NO - 5, 25 GET mm[ G_NO]
R[ G_NO ] := G_NO - 5 ; C[ G_NO ] := 25
next

@ 3,50 SAY ""
FOR G_NO := 17 to 24
@ G_NO - 13, 50 GET mm[ G_NO]
R[ G_NO ] := G_NO - 13 ; C[ G_NO ] := 50
next

SET INTENSITY ON
SET COLOUR TO (col10)
SET Cursor ON
SETCURSOR(3) && block cursor
Readexit(.T.)
READ
SET INTENSITY OFF
SET Cursor OFF
SET COLOUR TO (col1)
IF LASTKEY() =27
SET DELIMITER OFF
EXIT
ENDIF
ENDDO
LOOP
CASE ant1_0 = 3 && ACHOICE()
* Put something in the ARRAY
SET COLOR TO (col1)
wo = 0
PRIVATE choice[ AR_MAX ]
PRIVATE on_off[ AR_MAX ]
SET KEY 1 TO home
SET KEY 6 TO BOTTOM
FOR I= 1 TO AR_MAX
choice[i] = STR(I,2)+" Guten Tag"
IF I > 10
on_off[i] =.T.
ELSE
on_off[i] =.F.
ENDIF
NEXT
top_row := top_col := 10
bot_row=20
bot_col=21
@ 1,0 CLEAR TO 24,79
@ 1,0 SAY CENTER("Mouse & ACHOICE()")
@ 24,0 SAY CENTER("Right mouse button or ESC to leave")
SET COLOUR TO (col7)
@ top_row,bot_col+1 CLEAR TO bot_row,bot_col+10
@ top_row,bot_col+2 SAY " Top"
@ ROW()+1,bot_col+2 SAY " ÄÄÄÄÄÄ"
@ top_row+2,bot_col+2 SAY " Pdg. Up"
@ ROW()+1,bot_col+2 SAY " ÄÄÄÄÄÄ"
@ top_row+4,bot_col+2 SAY " Up"
@ ROW()+1,bot_col+2 SAY " ÄÄÄÄÄÄ"
@ top_row+6,bot_col+2 SAY " Down"
@ ROW()+1,bot_col+2 SAY " ÄÄÄÄÄÄ"
@ top_row+8,bot_col+2 SAY " Pdg. Dn"
@ ROW()+1,bot_col+2 SAY " ÄÄÄÄÄÄ"
@ top_row+10,bot_col+2 SAY " Bottom"
SET COLOUR TO (col6)
* Activation character.
m_setarea(top_row,top_col-1,bot_row,bot_col+13)
m_putxy(top_row,bot_col+13) &&
m_setint("1010","AC_ACTION")
@ top_row-1,top_col-1 TO bot_row+1,bot_col+1
m_wake_up()

X := ACHOICE(top_row,top_col,bot_row,bot_col,choice,.T.,"acfunc")

BUSY(.t.) // No ints wanted !!!!! Crash the stack !!
IF X > 0
SET COLOR TO (col9)
@ 22,20 SAY " You selected item "+STR(X,2)+". "
SET COLOR TO (col1)
C = INKEY(4)
@ 22,0
ENDIF
BUSY(.f.)

SET COLOR TO (col1)
m_putxy(top_row+X,bot_col+13)
@ 1,0 CLEAR TO 24,79
LOOP
CASE ant1_0 = 4 && MEMOEDIT()
wo_c := wo_r := wo_rel := wo_col := 0
top_row=1
top_col=0
bot_row=24
bot_col=79
m_setarea(top_row,top_col,bot_row,bot_col)
m_setint("1010","MEM_ACTION")
SET Cursor ON
* The word processor: Handle with care !!
m_wake_up()
Memowrit("maus.doc",Memoedit(Memoread("maus.doc"),top_row,top_col,bot_row-1,;
bot_col,.T.,"memfunc"))
SET Cursor OFF
@ 1,0 CLEAR TO 24,79
LOOP
CASE ant1_0 = 5 && MEMOEDIT()
M_SLEEP()
SAVE SCREEN
CLEAR
*--- row - coordinate's for horizontal - menu
eval( vmen, 0," Maintenance ")
eval( vmen, 15," System ")
eval( vmen, 26," Click ")
eval( vmen, 36," Exit ")

*--- row - coordinate's for 1nd vertical - menu
eval( hmen, 1, 2," Prospects ")
eval( hmen, 2, 3," Strategies ")
eval( hmen, 3, 4," Actions ")
eval( hmen, 4, 5," Results ")
eval( hmen, 5, 6," Qualifiers ")
eval( hmen, 6, 7," Letters ")
eval( hmen, 7, 8," Sources ")
eval( hmen, 8, 9," Holidays ")
eval( hmen, 9,10," Salesprsns ")
eval( hmen,10,11," Company ")

*--- row - coordinate's for 2nd vertical - menu
eval( hmen,11, 2," Defaults ")
eval( hmen,12, 3," Passwords ")
eval( hmen,13, 4," Sort ")
eval( hmen,14, 5," Maintain ")
eval( hmen,15, 6," Clean Up ")
eval( hmen,16, 7," DOS ")

*--- row - coordinate's for 3rd vertical - menu
eval( hmen,21, 2," Much ")
eval( hmen,22, 3," money ")
eval( hmen,23, 4," makes ")
eval( hmen,24, 5," the ")
eval( hmen,25, 6," world ")
eval( hmen,26, 7," go round ")

poslev1 := poslev2 := 1
h_flag := .t. // mouse corsor clicked on the top line

m_wake_up()
m_setarea(0,0,24,79) && allow mouse in this area
m1 := 10 ; m2 := 0; m3 := 65535; m4 := 30464

mouse( @m1, @m2, @m3, @m4 )
m_setint("1010","MP_ACTION") // set interrupt; mouse udf

set cursor off
while(.t.)
m_wake_up(); clear typeahead
set key K_DOWN to runter
set key K_RIGHT to
set key K_LEFT to
*---
* horizontal menu
h_flag :=.t.
for i := 1 to H_MAX ; @ 00, h_ar[ i ] prompt ph_st[ i ]
next
menu to poslev1
if poslev1 < 1 .or. poslev1 > 3 ; EXIT
endif
h_flag :=.f.
set key K_RIGHT to rechts
set key K_LEFT to links
set key K_DOWN to

*--- submenue
p1 := poslev1; m_sleep()
scn := SaveScreen( 2, h_ar[ P1 ], 2 + MAX_ITEM, h_ar[ P1 + 1] +1)
@ 2, h_ar[ P1 ] clear to 2 + MAX_ITEM, h_ar[ P1 + 1] +1
m_wake_up()
do case
case poslev1 == 1 ; drwhmen( 1, MAX_ITEM, poslev1 )
case poslev1 == 2 ; drwhmen( 11, 16, poslev1)
case poslev1 == 3 ; drwhmen( 21, 26, poslev1)
endcase
menu to poslev2
poslev2 := 1
*---
m_sleep()
RestScreen( 2, h_ar[ P1 ], 2 + MAX_ITEM, h_ar[ P1 + 1] +1, scn )
enddo
set key K_RIGHT to
set key K_LEFT to
set key K_DOWN to
RESTORE SCREEN
m_wake_up()
LOOP
CASE ant1_0=0 .OR. ant1_0 = 6
EXIT
ENDCASE
ENDDO

bye()

RETURN


PROCEDURE CheckMouse()
m1 := 0
mouse( @m1,,,)
if m1 # -1
set colour to
@ 1,0 clear to 24,79
? "No mouse found !"+chr(7)
quit
endif
RETURN


*!*********************************************************************
*!
*! Function: MOUSE()
*!
*! Called by: PULLDN.PRG
*! : M_WAKE_UP() (function in PULLDN.PRG)
*! : M_SETINT() (function in PULLDN.PRG)
*! : M_SLEEP() (function in PULLDN.PRG)
*! : SET_F16() (function in PULLDN.PRG)
*! : M_SETAREA() (function in PULLDN.PRG)
*! : M_PUTXY() (function in PULLDN.PRG)
*! : BYE() (procedure in PULLDN.PRG)
*!
*! Calls: IF() (function in ?)
*! : PCOUNT() (function in ?)
*! : MAUS() (function in ?)
*! : M_GETMXY() (function in ?)
*!
*!*********************************************************************
function mouse ( m1,m2,m3,m4,m5,udf )
LOCAL _m[ 7 ] && Might want to declare it somewhere else
_m[ 1 ] := m1 && take these lines as an approach..
_m[ 2 ] := m2 &&
_m[ 3 ] := m3
_m[ 4 ] := m4
_m[ 5 ] := if( pcount()< 5,0,m5) && used for function 16 only
_m[ 6 ] := if( pcount() == 6, udf, nil )
maus( @_m )
m1 := _m[ 1 ]
m2 := _m[ 2 ]
m3 := _m[ 3 ]
m4 := _m[ 4 ]
return nil

*!*********************************************************************
*!
*! Function: M_GETMXY(()
*!
*! Calls: AFILL() (function in ?)
*! : GETMXY() (function in ?)
*! : SET_F16() (function in PULLDN.PRG)
*!
*!*********************************************************************
function m_getmxy( mi2,mi3,mi4,mi5 )
LOCAL _m[6] ; afill(_m,0,5)
getmxy( @_m )
mi2 := _m[ 1 ]
mi3 := _m[ 2 ]
mi4 := _m[ 3 ]
mi5 := _m[ 4 ]
return nil

*!*********************************************************************
*!
*! Function: M_SETINT()
*!
*! Called by: PULLDN.PRG
*!
*! Calls: BIT_DEC() (function in ?)
*! : MOUSE() (function in PULLDN.PRG)
*!
*!*********************************************************************
function m_setint ( mask_bit, action )
m1:= 20 ; m3:= bit_dec(mask_bit) && however it is not supported by all
mouse(@m1,,@m3,,,action)
return nil

*!*********************************************************************
*!
*! Function: M_SETAREA()
*!
*! Calls: MOUSE() (function in PULLDN.PRG)
*!
*!*********************************************************************
function m_setarea ( t_r,t_c,b_r,b_c )

m1 := 7 ; m3 := t_c * 8 ; m4 := b_c * 8
mouse(@m1,,@m3,@m4)

m1 := 8 ; m3 := t_r*8 ; m4 := b_r*8
mouse(@m1,,@m3,@m4)
return nil


*!*********************************************************************
*!
*! Function: M_WAKE_UP()
*!
*! Called by: PMENU.PRG
*! : AC_ACTION (procedure in PMENU.PRG)
*! : MN_ACTION (procedure in PMENU.PRG)
*! : MG_ACTION (procedure in PMENU.PRG)
*! : BT_ACTION (procedure in PMENU.PRG)
*! : MEM_ACTION (procedure in PMENU.PRG)
*!
*!*********************************************************************
FUNCTION m_wake_up
m1 := 1
Mouse(@m1,,,)
RETURN .T.


*!*********************************************************************
*!
*! Function: M_SLEEP()
*!
*! Called by: PULLDN.PRG
*! : MN_ACTION() (function in PULLDN.PRG)
*!
*! Calls: MOUSE() (function in PULLDN.PRG)
*!
*!*********************************************************************
function m_sleep
m1 := 2
mouse(@m1,,,)
return nil

*!*********************************************************************
*!
*! Function: M_PUTXY()
*!
*! Called by: MN_ACTION() (function in PULLDN.PRG)
*!
*! Calls: MOUSE() (function in PULLDN.PRG)
*! : BYE.PRG
*!
*!*********************************************************************
function m_putxy ( x, y )
m1:=4 ; m3:=y*8 ; m4:=x*8
mouse(@m1,,@m3,@m4)
return nil


*!*********************************************************************
*!
*! Function: MN_INIT()
*!
*! Called by: PMENU.PRG
*!
*! Calls: M_SETAREA() (function in PMENU.PRG)
*!
*!*********************************************************************
FUNCTION mn_init ( t_r, t_c, b_r, b_c, cnt_i )
top_row = t_r
top_col = t_c
bot_row = b_r
bot_col = b_c
* Keep the mouse in this area
m_setarea( top_row, top_col - 1, bot_row, bot_col + 1 )
RETURN( INT((b_r-t_r)/(cnt_i-1)) )


*!*********************************************************************
*!
*! Procedure: BYE
*!
*! Called by: PMENU.PRG
*!
*!*********************************************************************
PROCEDURE bye
* MOUSE: Disable Interrupt !!!!!- Don't forget to do this, before you *
* return to DOS -!!!!!! *
m1=0 && RESET MOUSE
Mouse(@m1,@m2,@m3,@m4)
SET COLOUR TO
SET Cursor ON
CLEAR MEMORY
CLEAR TYPEAHEAD
@ 1,0 CLEAR TO 24,79
@ 2,0 SAY "Auf Wiedersehen!"
QUIT
RETURN

*!*********************************************************************
*!
*! Function: ACFUNC()
*!
*! Called by: PMENU.PRG
*!
*!*********************************************************************
FUNCTION acfunc ( mode,cur_elem,rel_pos )
LOCAL LK, back
wo = rel_pos
lk = LASTKEY()
IF lk == 27
back = 0
ELSEIF lk == 13
back = 1
ELSE
back = 2
ENDIF
RETURN back


*!*********************************************************************
*!
*! Procedure: AC_ACTION
*!
*! Calls: BUSY() (function in ?)
*! : M_GETMXY() (function in PMENU.PRG)
*! : M_PUTXY() (function in PMENU.PRG)
*! : M_WAKE_UP() (function in PMENU.PRG)
*!
*!*********************************************************************
PROCEDURE ac_action
PRIVATE mos_col,mos_row,I,puls,PUT
do_nothing=.F.
put = ""
I = 1
m_getmxy( @mi2, @mi3,@mi4,@mi5) &&
* place curor in the front
mos_row = int(mi4/8) && current row of mouse cursor
mos_col = int(mi3/8)
IF mi2 == 1
IF mos_col < bot_col
m_putxy(mos_row,top_col-2)
puls = top_col + wo - mos_row
DO CASE
CASE puls = 0
put = CHR(13)
CASE puls > 0
FOR I= 1 TO puls
put += ""
NEXT
CASE puls < 0
puls = ABS(puls)
FOR I= 1 TO puls
put += ""
NEXT
ENDCASE
ELSE
DO CASE
CASE mos_row = 10
put=""
CASE mos_row = 12
put=""
CASE mos_row = 14
put=""
CASE mos_row = 16
put=""
CASE mos_row = 18
put=""
CASE mos_row = 20
put=""
OTHERWISE
put=""
ENDCASE
ENDIF
m_wake_up()
ELSE
m_putxy( mos_row, bot_col + 13)
put=""
ENDIF
KEYBOARD put
RETURN

*!*********************************************************************
*!
*! Procedure: MN_ACTION
*!
*! Calls: BUSY() (function in ?)
*! : M_GETMXY() (function in PMENU.PRG)
*! : M_PUTXY() (function in PMENU.PRG)
*! : M_WAKE_UP() (function in PMENU.PRG)
*! : M_SLEEP() (function in PMENU.PRG)
*!
*!*********************************************************************
PROCEDURE mn_action
PRIVATE bar_row,mos_row,puls,I,PUT
put=""
*
bar_row = ROW() && current row of the menu bar
m_getmxy(@mi2,@mi3,@mi4,@mi5)
mos_row = int(mi4 / 8) && current row of mouse cursor
*
* place curor in front
IF ( mi2 = 1 ) && right
m_putxy( mos_row, top_col - 1 )
puls = INT( ABS(bar_row - mos_row) /men_step)
DO CASE
CASE (bar_row = mos_row)
put = CHR(13) && Select
CASE (bar_row > mos_row) && move bar up
FOR I=1 TO puls
put += ""
NEXT
CASE (bar_row < mos_row ) && move bar down
FOR I=1 TO puls
put += ""
NEXT
ENDCASE
m_wake_up()
ELSEIF (mi2 >= 2) && right button pressed
m_sleep() && hide mouse
put=""
ENDIF
KEYBOARD put
*busy(.F.)
RETURN

*!*********************************************************************
*!
*! Procedure: MG_ACTION
*!
*! Calls: BUSY() (function in ?)
*! : M_GETMXY() (function in PMENU.PRG)
*! : M_PUTXY() (function in PMENU.PRG)
*! : M_WAKE_UP() (function in PMENU.PRG)
*! : M_SLEEP() (function in PMENU.PRG)
*!
*!*********************************************************************
PROCEDURE mg_action
PRIVATE mos_col,mos_row,I,J,do_nothing,act_g,PUT,cur_row,cur_col
do_nothing := .F.
put := ""
I := J := 1
m_getmxy( @mi2,@mi3,@mi4,@mi5) //
mos_row := int( mi4 /8 ) // current row of mouse cursor
mos_col := int( mi3 /8 )
m_sleep() // hide mouse
CLEAR GETS
IF mi2 == 1
WHILE( j <= CNT )
IF ABS(mos_col - C[ J ]) < 5 //
IF( (j := ASCAN(R, mos_row,j, CNT )) # 0 )
put = replicate(CHR( K_ENTER ), j ) // action
m_putxy(R[ j ],C[ j ]-1)
ENDIF
EXIT
endif
j++
ENDDO
ELSEIF mi2 >= 2
put = "" // right button pressed
ENDIF // - leave
if j <= CNT .and. j # 0 ; KEYBOARD put ; ENDIF
m_wake_up()
SET CURSOR ON
RETURN


* serves the buttons
*!*********************************************************************
*!
*! Procedure: BT_ACTION
*!
*! Calls: BUSY() (function in ?)
*! : M_GETMXY() (function in PMENU.PRG)
*! : M_SLEEP() (function in PMENU.PRG)
*! : M_WAKE_UP() (function in PMENU.PRG)
*!
*!*********************************************************************
PROCEDURE bt_action
PRIVATE C, by_flg,PUT
CLEAR GETS
by_flag := .F.
put := ""
m_getmxy( @mi2,@mi3, @mi4,@mi5)
DO CASE
CASE mi2 = 1
SET COLOUR TO (col2)
FOR I= 7 TO 11
@ I,23 SAY "ÛÛÛÛÛÛÛ"
NEXT
CASE mi2 = 2
SET COLOUR TO (col3)
FOR I=7 TO 11
@ I,42 SAY "ÛÛÛÛÛÛÛ"
NEXT
CASE mi2 = 3
FOR I=7 TO 11
SET COLOUR TO (col2)
@ I,23 SAY "ÛÛÛÛÛÛÛ"
SET COLOUR TO (col3)
@ I,42 SAY "ÛÛÛÛÛÛÛ"
NEXT
ENDCASE
SET COLOUR TO &col1
@ 20,25 SAY "X:= "+STR(mi3,3)+" Y:="+STR(mi4,3)
IF (mi3 >= 432) .AND. (mi3 <= 504)
m_sleep()
IF (mi4 >=136) .AND. (mi4 <= 144)
SET COLOUR TO (col4)
@ 17,54 SAY " "
@ 18,54 SAY "  hello "
? CHR(7)
ENDIF
m_wake_up()
IF (mi4 >=160) .AND. (mi4 <= 168)
SET COLOUR TO (col5)
@ 20,54 SAY " "
@ 21,54 SAY "
bye... "
C=INKEY(0.5)
m_sleep()
put=""
ENDIF
ENDIF
SET COLOR TO (col1)
C=INKEY(1.5)
@ 7,23 CLEAR TO 11,29
@ 7,42 CLEAR TO 11,48
@ 20,25 CLEAR TO 20,46
@ 17,54 SAY " "
@ 18,54 SAY " BEEP "
KEYBOARD put
m_wake_up()
RETURN


*!*********************************************************************
*!
*! Function: MEMFUNC()
*!
*! Calls: SHAPE() (function in ?)
*!
*!*********************************************************************
FUNCTION memfunc (mode,LINE,COL)
LOCAL msg,lk
PRIVATE back
wo_r := wo_c := wo_rel := wo_col := 0
back := 0
IF mode == 3
IF ! Readinsert()
SETCURSOR( 3 )
msg := "INS:[ON] "
back := 22
ELSE
IF Readinsert()
msg := "INS:[ON] "
SETCURSOR( 3 )
ELSE
msg := "INS:[OFF]"
SETCURSOR( 1 )
ENDIF
ENDIF
SET COLOR TO (col7)
@ 24,0 SAY " Home ³ Pdg. UP ³ Pdg. DN ³ End ³ Save ³ Quit ³ col: "+;
STR(COL,4)+" row: "+STR(LINE,4)+" ³ "+msg
SET COLOUR TO (col1)
ENDIF
wo_r = LINE
wo_c = COL
wo_rel = ROW()
wo_col = COL()
lk = LASTKEY()
IF mode = 1 .OR. mode = 2
IF lk = 22
Readinsert(!Readinsert())
back = 32
ELSE
back = lk
ENDIF
ENDIF
IF Readinsert()
msg="INS:[ON] "
SETCURSOR( 3 )
ELSE
msg="INS:[OFF]"
SETCURSOR( 1 )
ENDIF
SET COLOR TO (col7)
@ 24,54 SAY STR(COL,4)
@ 24,64 SAY STR(LINE,4)
@ 24,71 SAY msg
SET COLOR TO (col1)
RETURN back

*!*********************************************************************
*!
*! Procedure: MEM_ACTION
*!
*! Calls: BUSY() (function in ?)
*! : M_GETMXY() (function in PMENU.PRG)
*! : M_WAKE_UP() (function in PMENU.PRG)
*!
*!*********************************************************************
PROCEDURE mem_action
PRIVATE mos_col,mos_row,I,rpuls,cpuls,put
do_nothing=.F.
put := ""
rpuls := I := cpuls := 0
m_getmxy(@mi2, @mi3, @mi4, @mi5) &&
* place curor in the back
mos_row := INT(mi4/8) && current row of mouse cursor
mos_col := INT(mi3/8)
IF mi2=1 && Move cursor
IF mos_row < 24
rpuls := mos_row-wo_rel
IF rpuls > 0 && runter
FOR I :=1 TO rpuls
put += ""
NEXT
ELSEIF rpuls < 0 && Rauf
rpuls := rpuls*(-1)
FOR I := 1 TO rpuls
put +=""
NEXT
ENDIF
cpuls := mos_col - wo_col
IF cpuls > 0

FOR I :=1 TO cpuls
put +=""
NEXT
ELSEIF cpuls < 0
cpuls := cpuls*(-1)
FOR I := 1 TO cpuls
put +=""
NEXT
ENDIF
ELSE
DO CASE
CASE mos_col < 9
put := "" && Home
CASE mos_col >= 9 .AND. mos_col < 19
put := "" && Pdg. UP
CASE mos_col >= 19 .AND. mos_col < 29
put := "" && Pdg. DN
CASE mos_col >= 29 .AND. mos_col < 35
put := "" && End
CASE mos_col >= 35 .AND. mos_col < 42
put := "" && Save
CASE mos_col >= 42 .AND. mos_col < 49
put := "" && Esc
CASE mos_col >= 49
put := "" && Insert
ENDCASE
ENDIF
ELSE
put := ""
ENDIF
KEYBOARD put
m_wake_up()
RETURN



PROCEDURE MP_ACTION
PRIVATE put,i
i := 0
bar_row := row() && current row of the menu bar
m_getmxy(@mi2,@mi3,@mi4,)
mos_row := int( mi4 / 8 )
mos_col := int( mi3 / 8 ) && current col of mouse cursor
put := ""
*
* place curor in front
if (mi2 == 1)
m_putxy( mos_row + 1, h_ar[ poslev1 ] ) && keep mouse cursor there
if bar_row == 0
*-- open submenu
if mos_col >= h_ar[ poslev1 ] .and. mos_col < h_ar[ IIF(poslev1 + 1 >= H_MAX,H_MAX, poslev1 + 1) ]
put := chr(13)
elseif mos_col < h_ar[ poslev1 ]
*-- move top menu left
while( mos_col < h_ar[ poslev1 ])
put += chr(19) ; poslev1--
enddo
m_putxy( mos_row + 1, h_ar[ poslev1 ] ) && keep mouse cursor there
elseif mos_col >= h_ar[ poslev1 ]
*-- move top menu right
while(mos_col >= h_ar[ poslev1 ] .and. poslev1 < H_MAX )
put += if( mos_col > h_ar[ ++poslev1 ], chr(4),"")
enddo
m_putxy( mos_row + 1, h_ar[ poslev1 ] ) && keep mouse cursor there
if mos_col > h_ar[ H_MAX ]
put := chr(27)
endif

endif
elseif mos_row == bar_row && select
*-- select item from any sub
poslev2 := 1 ; put := chr(13)
else
*-- move vertical on any sub
if mos_col >= h_ar[ poslev1 ] .and. mos_col < h_ar[ IIF(poslev1 + 1 >= H_MAX,H_MAX, poslev1 + 1 ) ]
put := replicate( iif(bar_row = mos_row, chr(13), iif( bar_row > mos_row,"","")), abs(bar_row - mos_row) )
m_putxy( mos_row , h_ar[ poslev1 ] + len( p_st[ (poslev1-1)* MAX_ITEM + poslev2])) && keep mouse cursor there
elseif mos_col < h_ar[ poslev1 ]
*-- close sub & move left
put := chr(27)
while( mos_col < h_ar[ poslev1 ] )
put += chr( 19 ) ; poslev1--
enddo
elseif mos_col >= h_ar[ poslev1 ]
*-- close sub & move right
put := chr(27)
while( mos_col >= h_ar[ poslev1 ] .and. poslev1 < H_MAX)
put += if( mos_col > h_ar[ ++poslev1 ], chr(4),"")
enddo
poslev1-- && sorry for that
endif
endif
elseif (mi2 >= 2) && right button pressed
*-- right m-button
m_sleep(); put := ""
endif
keyboard put
m_wake_up()
release put
return


* You know this one, don't you
*!*********************************************************************
*!
*! Function: CENTER()
*!
*!*********************************************************************
FUNCTION CENTER ( STR )
RETURN(SPACE(int(80-LEN(STR))/2)+STR)

*!*********************************************************************
*!
*! Procedure: HOME
*!
*! Called by: PMENU.PRG
*!
*!*********************************************************************
PROCEDURE home ; KEYBOARD CHR(31)
RETURN

*!*********************************************************************
*!
*! Procedure: BOTTOM
*!
*! Called by: PMENU.PRG
*!
*!*********************************************************************
PROCEDURE BOTTOM ; KEYBOARD CHR(30)
RETURN

*!*********************************************************************
*!
*! Function: SET_F16()
*!
*! Called by: M_GETMXY() (function in PMENU.PRG)
*!
*!*********************************************************************
FUNCTION set_f16
m1 := 16
m2 := m3 := 0
m4 := 632
m5 := 192
Mouse(@m1,@m2,@m3,@m4,@m5)
RETURN NIL


*!*********************************************************************
*!
*! Procedure: MAUS_BILD
*!
*! Called by: PMENU.PRG
*!
*!*********************************************************************
PROCEDURE maus_bild
@ 3,20 SAY " ³"
@ ROW()+1,20 SAY " ÚÄÁÄ¿"
@ ROW()+1,20 SAY "ÚÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
@ ROW()+1,20 SAY "³ ÚÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄ¿ ³"
@ ROW()+1,20 SAY "³ ³ ³ ³ ³ ³"
@ ROW()+1,20 SAY "³ ³ ³ ³ ³ ³"
@ ROW()+1,20 SAY "³ ³ ³ ³ ³ ³"
@ ROW()+1,20 SAY "³ ³ ³ ³ ³ ³"
@ ROW()+1,20 SAY "³ ³ ³ ³ ³ ³"
@ ROW()+1,20 SAY "³ ÀÄÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÙ ³"
@ ROW()+1,20 SAY "³ ³"
@ ROW()+1,20 SAY "³ Mouse Interrupt (12) with ³"
@ ROW()+1,20 SAY "³ Clipper(tm) S'87 ³"
@ ROW()+1,20 SAY "³ ³ ÚÄÄÄÄÄÄÄÄÄÄ¿"
@ ROW()+1,20 SAY "³ ÉÍÍÍÍÍÍ- Interrupt -ÍÍÍÍÍ» ³ ³ ³"
@ ROW()+1,20 SAY "³ º invoked at location º ³ ³ BEEP ³"
@ ROW()+1,20 SAY "³ º º ³ ÃÄÄÄÄÄÄÄÄÄÄ´ Use the mouse"
@ ROW()+1,20 SAY "³ º º ³ ³ ³ or press"
@ ROW()+1,20 SAY "³ ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ ³ ³ QUIT ³ any key to"
@ ROW()+1,20 SAY "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÄÙ quit"
RETURN

*!*********************************************************************
*!
*! Procedure: RUNTER(VN,VL,VR
*!
*! Calls: CHR() (function in ?)
*!
*!*********************************************************************
procedure runter( p,l,v )
clear typeahead ; keyboard chr( 13 )
poslev2 := 1
return


*!*********************************************************************
*!
*! Procedure: LINKS
*!
*! Called by: PULLDN.PRG
*!
*! Calls: CHR() (function in ?)
*!
*!*********************************************************************
procedure links (p,l,v)
poslev1 := iif( poslev1 - 1 = 0, 1, --poslev1 )
poslev2 := 1
if l > 0 .or. ! h_flag ; keyboard chr(27)
endif
return


*!*********************************************************************
*!
*! Procedure: RECHTS
*!
*! Called by: PULLDN.PRG
*!
*! Calls: IIF() (function in ?)
*! : ROW() (function in ?)
*! : CHR() (function in ?)
*!
*!*********************************************************************
procedure rechts (p,l,v )
poslev1 := iif( poslev1 + 1 > H_MAX, H_MAX , ++poslev1 )
poslev2 := 1
if row() > 0 .or. ! h_flag ; keyboard chr(13)
endif
return

function DrwHmen (start, v_max, menlev )
local i
for i = start to v_max ; @ v_ar[ i ], h_ar[ MenLev ] prompt p_st[ i ]
next
return NIL

*: EOF: PMENU.PRG