home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / snip0693.zip / MEMOTEST.PRG < prev    next >
Text File  |  1992-09-05  |  8KB  |  273 lines
  1. #include "memoedit.ch"
  2.  
  3. #ifndef BOX_DD
  4.    #define BOX_DD         "+-+|+-+|" + CHR(32)
  5. #endif
  6.  
  7. #ifndef BOX_DD
  8.    #define BOX_SS         "+-+|+-+|" + CHR(32)
  9. #endif
  10.  
  11. procedure SpIns(cBrd, cToy, cDow)
  12.    local nLineLen := 70
  13.    local nTabSize := 4
  14.    local cScr
  15.    local cColr := setcolor()
  16.    local nCurs := setcursor(SC_NORMAL)
  17.    local mSpIns
  18.  
  19.    private nLineNum := 1
  20.    private nColNum := 0
  21.    private nRelRow := 0
  22.    private nRelCol := 0
  23.  
  24.    private nTop := 5
  25.    private nLeft := 5
  26.    private nBottom := 20
  27.    private nRight := 77
  28.    private lUpdate := .T.
  29.  
  30.    private lInsOn := .F.
  31.    private lScrollOn := .F.
  32.    private lWordWrap := .T.
  33.  
  34.  
  35.    cScr :=  savescreen(nTop - 2, nLeft - 1, nBottom + 3, nRight + 1)
  36.  
  37.    @ nTop - 2, nLeft - 1, nBottom + 3, nRight + 1 box BOX_DD
  38.    @ nTop, nLeft, nBottom, nRight box BOX_SS
  39.  
  40.    @ nTop - 1, nLeft say "Special Instructions"
  41.  
  42.    @ nBottom + 2, nLeft + 1 say "{ESC}exit no save, {F2}save, "+;
  43.                      "{F3}delete line, {F4}insert line"
  44.  
  45.  
  46.    select F31_INFO
  47.    set order to 1
  48.  
  49.    seek cBrd + cToy + cDow
  50.    if found()
  51.       // We are in the right place now
  52.    else
  53.       //We have to exit because the correct running board was not found
  54.       return
  55.    endif
  56.  
  57.  
  58.    mSpIns := F31_INFO->m31_spinst
  59.  
  60.    mSpIns := hardcr(MEMOEDIT(mSpIns, nTop + 1, nLeft + 1,;
  61.                nBottom - 1, nRight - 1, lUpDate, "mfunc",;
  62.                nLineLen, nTabSize, nLineNum, nColNum,;
  63.                nRelRow, nRelCol))
  64.  
  65.    if lastkey() != K_ESC
  66.       F31_INFO->m31_spinst := mSpIns
  67.    endif
  68.  
  69.    setcolor(cColr)
  70.    setcursor(nCurs)
  71.    restscreen(nTop - 2, nLeft - 1, nBottom + 3, nRight + 1, cScr)
  72. return
  73.  
  74.  
  75.  
  76.  
  77.  
  78. ****
  79. *
  80. *   memoedit user function
  81. ****
  82. function mfunc(mode, line, col)
  83.    static lDejaVu := .f.
  84.    static lAltered := .f.
  85.    static nInitCount := 0
  86.    local keypress := LASTKEY()
  87.    local nRetVal := 0
  88.    local lInsMode
  89.    local cResponse
  90.  
  91.    MEMVAR nLineNum, lInsOn, lUpdate, lWordWrap, lScrollOn
  92.    MEMVAR nTop, nLeft, nBottom, nRight
  93.    MEMVAR nRelRow, nRelCol, nColNum
  94.  
  95.    DO CASE
  96.  
  97.       CASE mode == ME_INIT
  98.             * initialization..global variables "nInitCount" and "lDejaVu"
  99.             *   control the initialization process
  100.  
  101.             IF nInitCount == NIL .or. nInitCount == 0
  102.  
  103.                nInitCount := 1
  104.                lDejaVu := .F.
  105.                lAltered := .F.
  106.  
  107.             endif
  108.  
  109.             IF nInitCount == 1
  110.                * set initial insert mode
  111.                lInsMode := READINSERT()
  112.  
  113.                IF (lInsOn .AND. .NOT. lInsMode) .OR.;
  114.                   (.NOT. lInsOn .AND. lInsMode)
  115.                      * toggle insert mode
  116.                      nRetVal := 22
  117.  
  118.                ELSE
  119.                      * insert mode correct
  120.                      nInitCount := 2
  121.                      @ nBottom + 1, nRight - 25 SAY IF(lInsOn, "I", " ")
  122.                ENDIF
  123.             ENDIF
  124.  
  125.             IF nInitCount == 2
  126.                * set initial scroll state (defaults ON if lUpdate OFF)
  127.  
  128.                IF ((.NOT. lScrollOn .AND. .NOT. lUpdate) .OR.;
  129.                      (lScrollOn .AND. lUpdate)) .AND. .NOT. lDejaVu
  130.                      * need to toggle
  131.                      lDejaVu := .T.
  132.                      nRetVal := 35
  133.  
  134.                ELSE
  135.                      * scroll state correct
  136.                      nInitCount := 3
  137.                      lDejaVu := .F.
  138.                      @ nBottom + 1, nRight - 24 SAY IF(lScrollOn, "S", " ")
  139.  
  140.                ENDIF
  141.             ENDIF
  142.  
  143.             IF nInitCount == 3
  144.                * set initial word wrap..always defaults ON
  145.  
  146.                IF .NOT. lWordWrap .AND. .NOT. lDejaVu
  147.                      * need to toggle
  148.                      lDejaVu := .T.
  149.                      nRetVal := 34
  150.  
  151.                ELSE
  152.                      * word wrap correct
  153.                      nInitCount := 4
  154.                      lDejaVu := .F.
  155.                      @ nBottom + 1, nRight - 23 SAY IF(lWordWrap, "W", " ")
  156.  
  157.                ENDIF
  158.             ENDIF
  159.  
  160.             IF nInitCount == 4
  161.                * finished initialization
  162.  
  163.                nRetVal := 0
  164.                nInitCount := 0
  165.  
  166.             ENDIF
  167.  
  168.       CASE mode == ME_IDLE
  169.             * idle
  170.             @ nBottom + 1, nRight - 20 SAY "Line: " + pad(LTRIM(STR(line)), 4)
  171.             @ nBottom + 1, nRight - 8 SAY "Col: " + pad(LTRIM(STR(col)), 3)
  172.  
  173.       OTHERWISE
  174.             * keystroke exception
  175.             * save values to possibly resume edit
  176.             nLineNum := line
  177.             nColNum := col
  178.             nRelRow := ROW() - nTop - 1
  179.             nRelCol := COL() - nLeft - 1
  180.  
  181.             IF mode == ME_UNKEYX
  182.                lAltered := .T.
  183.  
  184.             ENDIF
  185.  
  186.             DO CASE
  187.  
  188.  
  189.                CASE keypress == K_CTRL_W .or. keypress == K_F2
  190.                      * Ctrl-W..write file
  191.                      IF .NOT. lAltered
  192.                            * no changes to write
  193.                            nRetVal := 27
  194.  
  195.                      ELSE
  196.                            * write and resume
  197.                            @ nBottom + 1, nLeft SAY SPACE(40)
  198.                            @ nBottom + 1, nLeft SAY "Writing "
  199.                            nRetVal := 23
  200.  
  201.                      ENDIF
  202.  
  203.                CASE keypress == K_ALT_X .OR. keypress == K_ESC
  204.                      * Esc/Alt-X..exit
  205.                      IF .NOT. lAltered
  206.                            * no change
  207.                            nRetVal := 27
  208.  
  209.                      ELSE
  210.                            * changes have been made to memo
  211.                            @ nBottom + 1, nLeft SAY SPACE(40)
  212.                            @ nBottom + 1, nLeft SAY "Abandon [yn]? "
  213.  
  214.                            cResponse := " "
  215.                            DO WHILE .NOT. cResponse $ "YN"
  216.                               att_tone()
  217.                               cResponse := UPPER(CHR(INKEY(0)))
  218.  
  219.                            ENDDO
  220.  
  221.                            @ nBottom + 1, nLeft SAY SPACE(40)
  222.  
  223.                            DO CASE
  224.  
  225.                               CASE cResponse == "Y"
  226.                                     * abort
  227.                                     nRetVal := 27
  228.  
  229.                               CASE cResponse == "N"
  230.                                     * ignore
  231.                                     nRetVal := 32
  232.  
  233.                               CASE cResponse == "W"
  234.                                     * save and exit
  235.                                     @ nBottom + 1, nLeft SAY SPACE(40)
  236.                                     @ nBottom + 1, nLeft SAY "Writing "
  237.                                     nRetVal := 23
  238.  
  239.                            ENDCASE
  240.                      ENDIF
  241.  
  242.  
  243.                CASE keypress == K_F3
  244.                      * F3..delete line
  245.                      nRetVal := 25
  246.  
  247.                CASE keypress == K_F4
  248.                      * F4..insert line
  249.                      nRetVal := 14
  250.  
  251.                CASE keypress == K_ALT_W .AND. lUpdate
  252.                      * Alt-W..toggle word wrap
  253.                      * lWordWrap := .NOT. lWordWrap
  254.                      * @ nBottom + 1, nRight - 23 SAY IF(lWordWrap, "W", " ")
  255.                      * nRetVal := 34
  256.  
  257.                CASE keypress == K_ALT_S
  258.                      * Alt-S..toggle scroll lock
  259.                      * lScrollOn := !lScrollOn
  260.                      * @ nBottom + 1, nRight - 24 SAY IF(lScrollOn, "S", " ")
  261.                      * nRetVal := 35
  262.  
  263.                CASE (keypress == K_ALT_I .OR. keypress == K_CTRL_V .or. ;
  264.                         keypress == K_INS) .AND. lUpdate
  265.                      * ^V/Ins/Alt-I..toggle insert mode
  266.                      lInsOn := !lInsOn
  267.                      @ nBottom + 1, nRight - 25 SAY IF(lInsOn, "I", " ")
  268.                      nRetVal := 22
  269.  
  270.             ENDCASE
  271.    ENDCASE
  272.    RETURN nRetVal
  273.