home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
clipper
/
snip0693.zip
/
MEMOTEST.PRG
< prev
next >
Wrap
Text File
|
1992-09-05
|
8KB
|
273 lines
#include "memoedit.ch"
#ifndef BOX_DD
#define BOX_DD "+-+|+-+|" + CHR(32)
#endif
#ifndef BOX_DD
#define BOX_SS "+-+|+-+|" + CHR(32)
#endif
procedure SpIns(cBrd, cToy, cDow)
local nLineLen := 70
local nTabSize := 4
local cScr
local cColr := setcolor()
local nCurs := setcursor(SC_NORMAL)
local mSpIns
private nLineNum := 1
private nColNum := 0
private nRelRow := 0
private nRelCol := 0
private nTop := 5
private nLeft := 5
private nBottom := 20
private nRight := 77
private lUpdate := .T.
private lInsOn := .F.
private lScrollOn := .F.
private lWordWrap := .T.
cScr := savescreen(nTop - 2, nLeft - 1, nBottom + 3, nRight + 1)
@ nTop - 2, nLeft - 1, nBottom + 3, nRight + 1 box BOX_DD
@ nTop, nLeft, nBottom, nRight box BOX_SS
@ nTop - 1, nLeft say "Special Instructions"
@ nBottom + 2, nLeft + 1 say "{ESC}exit no save, {F2}save, "+;
"{F3}delete line, {F4}insert line"
select F31_INFO
set order to 1
seek cBrd + cToy + cDow
if found()
// We are in the right place now
else
//We have to exit because the correct running board was not found
return
endif
mSpIns := F31_INFO->m31_spinst
mSpIns := hardcr(MEMOEDIT(mSpIns, nTop + 1, nLeft + 1,;
nBottom - 1, nRight - 1, lUpDate, "mfunc",;
nLineLen, nTabSize, nLineNum, nColNum,;
nRelRow, nRelCol))
if lastkey() != K_ESC
F31_INFO->m31_spinst := mSpIns
endif
setcolor(cColr)
setcursor(nCurs)
restscreen(nTop - 2, nLeft - 1, nBottom + 3, nRight + 1, cScr)
return
****
*
* memoedit user function
****
function mfunc(mode, line, col)
static lDejaVu := .f.
static lAltered := .f.
static nInitCount := 0
local keypress := LASTKEY()
local nRetVal := 0
local lInsMode
local cResponse
MEMVAR nLineNum, lInsOn, lUpdate, lWordWrap, lScrollOn
MEMVAR nTop, nLeft, nBottom, nRight
MEMVAR nRelRow, nRelCol, nColNum
DO CASE
CASE mode == ME_INIT
* initialization..global variables "nInitCount" and "lDejaVu"
* control the initialization process
IF nInitCount == NIL .or. nInitCount == 0
nInitCount := 1
lDejaVu := .F.
lAltered := .F.
endif
IF nInitCount == 1
* set initial insert mode
lInsMode := READINSERT()
IF (lInsOn .AND. .NOT. lInsMode) .OR.;
(.NOT. lInsOn .AND. lInsMode)
* toggle insert mode
nRetVal := 22
ELSE
* insert mode correct
nInitCount := 2
@ nBottom + 1, nRight - 25 SAY IF(lInsOn, "I", " ")
ENDIF
ENDIF
IF nInitCount == 2
* set initial scroll state (defaults ON if lUpdate OFF)
IF ((.NOT. lScrollOn .AND. .NOT. lUpdate) .OR.;
(lScrollOn .AND. lUpdate)) .AND. .NOT. lDejaVu
* need to toggle
lDejaVu := .T.
nRetVal := 35
ELSE
* scroll state correct
nInitCount := 3
lDejaVu := .F.
@ nBottom + 1, nRight - 24 SAY IF(lScrollOn, "S", " ")
ENDIF
ENDIF
IF nInitCount == 3
* set initial word wrap..always defaults ON
IF .NOT. lWordWrap .AND. .NOT. lDejaVu
* need to toggle
lDejaVu := .T.
nRetVal := 34
ELSE
* word wrap correct
nInitCount := 4
lDejaVu := .F.
@ nBottom + 1, nRight - 23 SAY IF(lWordWrap, "W", " ")
ENDIF
ENDIF
IF nInitCount == 4
* finished initialization
nRetVal := 0
nInitCount := 0
ENDIF
CASE mode == ME_IDLE
* idle
@ nBottom + 1, nRight - 20 SAY "Line: " + pad(LTRIM(STR(line)), 4)
@ nBottom + 1, nRight - 8 SAY "Col: " + pad(LTRIM(STR(col)), 3)
OTHERWISE
* keystroke exception
* save values to possibly resume edit
nLineNum := line
nColNum := col
nRelRow := ROW() - nTop - 1
nRelCol := COL() - nLeft - 1
IF mode == ME_UNKEYX
lAltered := .T.
ENDIF
DO CASE
CASE keypress == K_CTRL_W .or. keypress == K_F2
* Ctrl-W..write file
IF .NOT. lAltered
* no changes to write
nRetVal := 27
ELSE
* write and resume
@ nBottom + 1, nLeft SAY SPACE(40)
@ nBottom + 1, nLeft SAY "Writing "
nRetVal := 23
ENDIF
CASE keypress == K_ALT_X .OR. keypress == K_ESC
* Esc/Alt-X..exit
IF .NOT. lAltered
* no change
nRetVal := 27
ELSE
* changes have been made to memo
@ nBottom + 1, nLeft SAY SPACE(40)
@ nBottom + 1, nLeft SAY "Abandon [yn]? "
cResponse := " "
DO WHILE .NOT. cResponse $ "YN"
att_tone()
cResponse := UPPER(CHR(INKEY(0)))
ENDDO
@ nBottom + 1, nLeft SAY SPACE(40)
DO CASE
CASE cResponse == "Y"
* abort
nRetVal := 27
CASE cResponse == "N"
* ignore
nRetVal := 32
CASE cResponse == "W"
* save and exit
@ nBottom + 1, nLeft SAY SPACE(40)
@ nBottom + 1, nLeft SAY "Writing "
nRetVal := 23
ENDCASE
ENDIF
CASE keypress == K_F3
* F3..delete line
nRetVal := 25
CASE keypress == K_F4
* F4..insert line
nRetVal := 14
CASE keypress == K_ALT_W .AND. lUpdate
* Alt-W..toggle word wrap
* lWordWrap := .NOT. lWordWrap
* @ nBottom + 1, nRight - 23 SAY IF(lWordWrap, "W", " ")
* nRetVal := 34
CASE keypress == K_ALT_S
* Alt-S..toggle scroll lock
* lScrollOn := !lScrollOn
* @ nBottom + 1, nRight - 24 SAY IF(lScrollOn, "S", " ")
* nRetVal := 35
CASE (keypress == K_ALT_I .OR. keypress == K_CTRL_V .or. ;
keypress == K_INS) .AND. lUpdate
* ^V/Ins/Alt-I..toggle insert mode
lInsOn := !lInsOn
@ nBottom + 1, nRight - 25 SAY IF(lInsOn, "I", " ")
nRetVal := 22
ENDCASE
ENDCASE
RETURN nRetVal