home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / cl52bus.zip / 52BRL.EXE / RLDIALG.PRG < prev    next >
Text File  |  1993-06-10  |  11KB  |  703 lines
  1. /***
  2. *
  3. *  Rldialg.prg
  4. *
  5. *  Copyright (c) 1987-1993, Computer Associates International, Inc.
  6. *  All rights reserved.
  7. *
  8. *  Note: Compile with /m /n
  9. *
  10. */
  11.  
  12.  
  13. /***
  14. *
  15. *    multibox()
  16. *
  17. *    sysparam values:
  18. *        1    =    initialize and display
  19. *        2    =    hilite (become the current item)
  20. *        3    =    dehilite (become a non-current item)
  21. *        4    =    become a selected item and return a new state
  22. *
  23. *        note that the above values are interpreted
  24. *             differently by each function
  25. *
  26. *    states:
  27. *        0    =    abort the process
  28. *        1    =    initialization
  29. *        2    =    pointing (cursor)
  30. *        3    =    entry/selection
  31. *        4    =    complete the process
  32. *
  33. */
  34. FUNCTION multibox
  35.  
  36. PARAMETERS wt, wl, wh, beg_curs, boxarray
  37. PRIVATE funcn, sysparam, state, cursor, x
  38. PRIVATE asel, arel, frame, lframe
  39.  
  40. asel       = 1
  41. arel       = 0
  42. frame      = "╒═╕│╛═╘│"
  43. lframe     = "╤═╕│╛═╧│"
  44.  
  45. DECLARE box_row[LEN(boxarray)]
  46. DECLARE box_col[LEN(boxarray)]
  47.  
  48. SAVE SCREEN
  49.  
  50. @ wt, wl, wt + wh + 1, wl + 45 BOX frame + " "
  51.  
  52. * state 1 ... initialization
  53. sysparam = 1
  54.  
  55. FOR cursor = 1 TO LEN(boxarray)
  56.     funcn = boxarray[cursor]
  57.     x = &funcn
  58.  
  59.     * each function leaves the cursor at its top left corner
  60.     box_row[cursor] = ROW()
  61.     box_col[cursor] = COL()
  62.  
  63. NEXT
  64.  
  65. cursor = beg_curs
  66. state = 2
  67.  
  68. DO WHILE state <> 0 .AND. state <> 4
  69.     * till completed or aborted
  70.     funcn = boxarray[cursor]
  71.  
  72.     DO CASE
  73.  
  74.         CASE state = 2
  75.             * pointing state
  76.             sysparam = 2
  77.             x = &funcn
  78.  
  79.             k = INKEY(0)
  80.  
  81.             DO CASE
  82.  
  83.                 CASE k = 13 .OR. jisdata(k)
  84.                     * change to selection state
  85.                     state = 3
  86.  
  87.                 CASE k = 27
  88.                     * abort
  89.                     state = 0
  90.  
  91.                 OTHERWISE
  92.                     * current item becomes uncurrent
  93.                     sysparam = 3
  94.                     x = &funcn
  95.  
  96.                     * get a new cursor
  97.                     cursor = matrix(cursor, k)
  98.  
  99.             ENDCASE
  100.  
  101.         CASE state = 3
  102.             * be selected and return a new state
  103.             sysparam = 4
  104.             state = &funcn
  105.  
  106.     ENDCASE
  107. ENDDO
  108.  
  109. RESTORE SCREEN
  110.  
  111. RETURN state
  112.  
  113.  
  114.  
  115. /***
  116. *
  117. *  title()
  118. *
  119. */
  120. FUNCTION enter_title
  121. PARAMETERS sysparam
  122.  
  123. IF sysparam = 1
  124.     @ wt + 1, wl + 2 SAY "Enter a filename "
  125.  
  126.     * set cursor for initialization
  127.     @ wt + 1, wl + 2 SAY ""
  128.  
  129. ENDIF
  130.  
  131. RETURN 2
  132.  
  133.  
  134.  
  135. /***
  136. *
  137. *  save_title()
  138. *
  139. */
  140. FUNCTION save_title
  141. PARAMETERS sysparam
  142.  
  143. IF sysparam = 1
  144.     * watch out for the length of file, it may exceed the box width (path)
  145.     @ wt + 3, wl + 4 SAY "Save Changes To File " + TRIM(filename) + "?"
  146.  
  147.     * set cursor for initialization
  148.     @ wt + 3, wl + 4 SAY ""
  149.  
  150. ENDIF
  151.  
  152. RETURN 2
  153.  
  154.  
  155.  
  156. /***
  157. *
  158. *  rl_getfil()
  159. *
  160. *  get filename
  161. *
  162. */
  163. FUNCTION rl_getfil
  164. PARAMETERS sysparam
  165.  
  166. DO CASE
  167.  
  168.     CASE sysparam = 1 .OR. sysparam = 3
  169.         @ wt + 3, wl + 2 SAY "File " + SUBSTR(filename, 1, 20)
  170.  
  171.         IF sysparam = 1
  172.             * set cursor for initialization
  173.             @ wt + 3, wl + 9 SAY ""
  174.         ENDIF
  175.  
  176.     CASE sysparam = 2
  177.         * be current...hilite
  178.         SET COLOR TO I
  179.         @ wt + 3, wl + 7 SAY SUBSTR(filename, 1, 20)
  180.         SET COLOR TO BG+/B
  181.  
  182.     CASE sysparam = 4
  183.         * be selected...perform a GET on entry field
  184.         
  185.         Note: any other 'isdata' key will also execute selection
  186.         IF k <> 13
  187.             KEYBOARD CHR(k)
  188.         ENDIF
  189.         
  190.         filename = jenter_rc(filename, wt + 3, wl + 7, 64, "@K!S20")
  191.  
  192.         SET CURSOR ON
  193.         READ
  194.         SET CURSOR OFF
  195.  
  196.         IF LASTKEY() = 13 .AND. .NOT. EMPTY(filename)
  197.             * filename has been selected...go to the ok button
  198.             filename = JPAD(filename,20)
  199.             @ wt + 3, wl + 7 SAY filename
  200.             to_ok()
  201.         ENDIF
  202. ENDCASE
  203.  
  204. RETURN 2
  205.  
  206.  
  207.  
  208. /***
  209. *
  210. *  filelist()
  211. *
  212. */
  213. FUNCTION filelist
  214. PARAMETERS sysparam
  215. PRIVATE c
  216.  
  217. DO CASE
  218.  
  219.     CASE sysparam = 1
  220.         * clear the window
  221.         scroll(wt + 1, wl + 31, wt + wh, wl + 44, 0)
  222.         @ wt, wl + 30, wt + wh + 1, wl + 45 BOX lframe
  223.  
  224.         IF .NOT. EMPTY(files[1])
  225.             * display the files list
  226.             KEYBOARD CHR(27)
  227.             achoice(wt+1,wl+32,wt+wh,wl+43,files,"ch_func",0,asel,arel)
  228.  
  229.         ENDIF
  230.  
  231.         * set cursor for initialization
  232.         @ wt + 1, wl + 32 SAY ""
  233.  
  234.     CASE sysparam = 2
  235.  
  236.         IF EMPTY(files[1])
  237.             * cannot cursor onto an empty list
  238.             KEYBOARD CHR(219)
  239.  
  240.         ELSE
  241.             * set initial relative row and array element
  242.             asel = asel - arel + ROW() - wt - 1
  243.             arel = ROW() - wt - 1
  244.  
  245.             * do the list selection
  246.             c = achoice(wt+1,wl+32,wt+wh,wl+43,files,"ch_func",0,asel,arel)
  247.  
  248.             IF LASTKEY() = 13
  249.                 * filename selected from list...set memvar
  250.                 filename = SUBSTR(files[c] + SPACE(64), 1, 64)
  251.  
  252.                 * display filename in entry blank
  253.                 rl_getfil(3)
  254.  
  255.                 * go directly to ok button
  256.                 to_ok()
  257.  
  258.             ELSE
  259.  
  260.                 IF LASTKEY() = 19
  261.                     * the system responds to CHR(19) as ^S
  262.                     KEYBOARD CHR(219)
  263.  
  264.                 ELSE
  265.                     * send character to multibox
  266.                     KEYBOARD CHR(LASTKEY())
  267.  
  268.                 ENDIF
  269.             ENDIF
  270.         ENDIF
  271. ENDCASE
  272.  
  273. RETURN 2
  274.  
  275.  
  276.  
  277. /***
  278. *
  279. *  ok_button()
  280. *
  281. */
  282. FUNCTION ok_button
  283.  
  284. PARAMETERS sysparam
  285. PRIVATE ok, reply
  286.  
  287. ok = " Ok "
  288. reply = 2
  289.  
  290. DO CASE
  291.  
  292.     CASE sysparam = 1 .OR. sysparam = 3
  293.         @ wt + wh, wl + 9 SAY ok
  294.  
  295.         IF sysparam = 1
  296.             * set cursor for initialization
  297.             @ wt + wh, wl + 9 SAY ""
  298.  
  299.         ENDIF
  300.  
  301.     CASE sysparam = 2
  302.         * be current...hilite
  303.         SET COLOR TO I
  304.         @ wt + wh, wl + 9 SAY ok
  305.         SET COLOR TO BG+/B
  306.  
  307.     CASE sysparam = 4
  308.  
  309.         IF &okee_dokee
  310.             * a job well done...complete the process
  311.             reply = 4
  312.         ENDIF
  313.  
  314. ENDCASE
  315.  
  316. RETURN reply
  317.  
  318.  
  319.  
  320. /***
  321. *
  322. *  cancel_button()
  323. *
  324. */
  325. FUNCTION cancel_button
  326.  
  327. PARAMETERS sysparam
  328. PRIVATE can, reply
  329.  
  330. can = " Cancel "
  331. reply = 2
  332.  
  333. DO CASE
  334.  
  335.     CASE sysparam = 1 .OR. sysparam = 3
  336.         @ wt + wh, wl + 17 SAY can
  337.  
  338.         IF sysparam = 1
  339.             * set cursor for initialization
  340.             @ wt + wh, wl + 17 SAY ""
  341.  
  342.         ENDIF
  343.  
  344.     CASE sysparam = 2
  345.         * be current...hilite
  346.         SET COLOR TO I
  347.         @ wt + wh, wl + 17 SAY can
  348.         SET COLOR TO BG+/B
  349.  
  350.     CASE sysparam = 4
  351.         * cancel selected...abort the process
  352.         reply = 0
  353.  
  354. ENDCASE
  355.  
  356. RETURN reply
  357.  
  358.  
  359.  
  360. /***
  361. *
  362. *  can_button()
  363. *
  364. *    cancel button for save file box
  365. *
  366. */
  367. FUNCTION can_button
  368.  
  369. PARAMETERS sysparam
  370. PRIVATE can, reply
  371.  
  372. can = " Cancel "
  373. reply = 2
  374.  
  375. DO CASE
  376.  
  377.     CASE sysparam = 1 .OR. sysparam = 3
  378.         @ wt + wh, wl + 25 SAY can
  379.  
  380.         IF sysparam = 1
  381.             * set cursor for initialization
  382.             @ wt + wh, wl + 25 SAY ""
  383.  
  384.         ENDIF
  385.  
  386.     CASE sysparam = 2
  387.         * be current...hilite
  388.         SET COLOR TO I
  389.         @ wt + wh, wl + 25 SAY can
  390.         SET COLOR TO BG+/B
  391.  
  392.     CASE sysparam = 4
  393.         * cancel selected...abort the process
  394.         reply = 0
  395.  
  396. ENDCASE
  397.  
  398. RETURN reply
  399.  
  400.  
  401.  
  402. /***
  403. *
  404. *  no_button()
  405. *
  406. */
  407. FUNCTION no_button
  408.  
  409. PARAMETERS sysparam
  410. PRIVATE no, reply
  411.  
  412. no = " No "
  413. reply = 2
  414.  
  415. DO CASE
  416.  
  417.     CASE sysparam = 1 .OR. sysparam = 3
  418.         @ wt + wh, wl + 13 SAY no
  419.  
  420.         IF sysparam = 1
  421.             * set cursor for initialization
  422.             @ wt + wh, wl + 13 SAY ""
  423.  
  424.         ENDIF
  425.  
  426.     CASE sysparam = 2
  427.         * be current...hilite
  428.         SET COLOR TO I
  429.         @ wt + wh, wl + 13 SAY no
  430.         SET COLOR TO BG+/B
  431.  
  432.     CASE sysparam = 4
  433.         * 'No' selected...abort the process
  434.         reply = 0
  435.         no_save_flag = .T.
  436. ENDCASE
  437.  
  438. RETURN reply
  439.  
  440.  
  441.  
  442. /***
  443. *
  444. *  ch_func()
  445. *
  446. *    achoice user function
  447. *
  448. */
  449. FUNCTION ch_func
  450.  
  451. PARAMETERS amod, sel, rel
  452. PRIVATE k, r, srow, scol
  453.  
  454. srow = ROW()
  455. scol = COL()
  456.  
  457. asel = sel
  458. arel = rel
  459. r = 2
  460.  
  461. IF asel > arel + 1
  462.     * more files off screen up
  463.     @ wt + 1, wl + 44 SAY CHR(24)
  464.  
  465. ELSE
  466.     @ wt + 1, wl + 44 SAY " "
  467.  
  468. ENDIF
  469.  
  470. IF LEN(files) - asel > wh - 1 - arel
  471.     * more files off screen down
  472.     @ wt + wh, wl + 44 SAY CHR(25)
  473.  
  474. ELSE
  475.     @ wt + wh, wl + 44 SAY " "
  476.  
  477. ENDIF
  478.  
  479. IF amod = 3
  480.     k = LASTKEY()
  481.  
  482.     DO CASE
  483.  
  484.         CASE k = 27
  485.             * escape key
  486.             r = 0
  487.  
  488.         CASE k = 13 .OR. k = 19 .OR. k = 219
  489.             * return or left arrow
  490.             r = 1
  491.  
  492.         CASE k = 1
  493.             * home key..top of list
  494.             KEYBOARD CHR(31)
  495.  
  496.         CASE k = 6
  497.             * end key..end of list
  498.             KEYBOARD CHR(30)
  499.  
  500.     ENDCASE
  501. ENDIF
  502.  
  503. @ M->srow, M->scol SAY ""
  504. RETURN r
  505.  
  506.  
  507.  
  508. /***
  509. *
  510. *    do_it()
  511. *
  512. *    called from the "Ok" button as "&okee_dokee"
  513. *    this function normally completes the process
  514. *
  515. */
  516. FUNCTION do_it
  517.  
  518. PRIVATE done, error_str
  519.  
  520. DO CASE
  521.  
  522.     * error if empty filename
  523.     CASE EMPTY(filename)    && error, empty filename
  524.         KEYBOARD CHR(5)
  525.         done = .F.
  526.  
  527.     OTHERWISE
  528.         done = .T.
  529.  
  530. ENDCASE
  531.  
  532. RETURN done
  533.  
  534.  
  535.  
  536. /***
  537. *
  538. *  matrix()
  539. *
  540. *    relocate cursor
  541. *
  542. */
  543. FUNCTION matrix
  544.  
  545. PARAMETERS old_curs, k
  546. PRIVATE old_row, old_col, test_curs, new_curs
  547.  
  548. old_row = ROW()
  549. old_col = box_col[old_curs]
  550. new_curs = old_curs
  551. test_curs = old_curs
  552.  
  553. DO CASE
  554.  
  555.     CASE k = 19 .OR. k = 219
  556.         * left arrow
  557.  
  558.         DO WHILE test_curs > 2
  559.             test_curs = test_curs - 1
  560.  
  561.             IF box_col[test_curs] < old_col .AND. box_row[test_curs] >= old_row
  562.  
  563.                 IF box_row[test_curs] < box_row[new_curs] .OR. new_curs = old_curs
  564.                     * best so far
  565.                     new_curs = test_curs
  566.  
  567.                 ENDIF
  568.             ENDIF
  569.         ENDDO
  570.  
  571.     CASE k = 4
  572.         * right arrow
  573.  
  574.         DO WHILE test_curs < LEN(box_col)
  575.             test_curs = test_curs + 1
  576.  
  577.             IF box_col[test_curs] > old_col .AND. box_row[test_curs] <= old_row
  578.  
  579.                 IF box_row[test_curs] > box_row[new_curs] .OR. new_curs = old_curs
  580.                     * best so far
  581.                     new_curs = test_curs
  582.  
  583.                 ENDIF
  584.             ENDIF
  585.         ENDDO
  586.  
  587.     CASE k = 5
  588.         * up arrow
  589.  
  590.         DO WHILE test_curs > 2
  591.             test_curs = test_curs - 1
  592.  
  593.             IF box_row[test_curs] < old_row .AND. box_col[test_curs] <= old_col
  594.  
  595.                 IF box_col[test_curs] > box_col[new_curs] .OR. new_curs = old_curs
  596.                     * best so far
  597.                     new_curs = test_curs
  598.  
  599.                 ENDIF
  600.             ENDIF
  601.         ENDDO
  602.  
  603.     CASE k = 24
  604.         * down arrow
  605.  
  606.         DO WHILE test_curs < LEN(box_row)
  607.             test_curs = test_curs + 1
  608.  
  609.             IF box_row[test_curs] > old_row .AND. box_col[test_curs] >= old_col
  610.  
  611.                 IF box_col[test_curs] < box_col[new_curs] .OR. new_curs = old_curs
  612.                     * best so far
  613.                     new_curs = test_curs
  614.  
  615.                 ENDIF
  616.             ENDIF
  617.         ENDDO
  618. ENDCASE
  619.  
  620. RETURN new_curs
  621.  
  622.  
  623.  
  624. /***
  625. *
  626. *  to_ok()
  627. *
  628. *    go directly to ok button
  629. *
  630. */
  631. FUNCTION to_ok
  632.  
  633. cursor = ascan(boxarray, "ok_button(sysparam)")
  634. KEYBOARD CHR(219)
  635. RETURN 0
  636.  
  637.  
  638.  
  639. /***
  640. *
  641. *    jisdata()
  642. *
  643. *    determine if a key is data suitable for entry in place
  644. *
  645. */
  646. FUNCTION jisdata
  647.  
  648. PARAMETERS k
  649.  
  650. RETURN (M->k >= 32 .AND. M->k < 249 .AND. M->k <> 219 .AND. CHR(M->k) <> ";")
  651.  
  652.  
  653.  
  654. /***
  655. *
  656. *    jenter_rc(r,c,max_len,pfunc)
  657. *
  658. *    entry in place
  659. *
  660. */
  661. FUNCTION jenter_rc
  662.  
  663. PARAMETERS org_str,r,c,max_len,pfunc
  664. PRIVATE wk_str, keystroke
  665.  
  666. wk_str = JPAD(org_str, max_len)
  667. SET CURSOR ON
  668.  
  669. IF .NOT. EMPTY(pfunc)
  670.     @ r,c GET wk_str PICTURE pfunc
  671. ELSE
  672.     @ r,c GET wk_str
  673. ENDIF
  674.  
  675. READ
  676. SET CURSOR OFF
  677.  
  678. keystroke = LASTKEY()
  679.  
  680. IF keystroke = 27
  681.     wk_str = ""
  682. ENDIF
  683.  
  684. RETURN (TRIM(wk_str))
  685.  
  686.  
  687.  
  688. /***
  689. *
  690. *    jpad()
  691. *
  692. *    syntax: jpad( <expC>, <expN> )
  693. *
  694. *    return: <expC> padded with spaces so that len( <expC> ) = <expN>
  695. *
  696. */
  697. FUNCTION jpad
  698.  
  699. PARAMETERS s, n
  700.  
  701. RETURN(SUBSTR(s + SPACE(n), 1, n))
  702.  
  703.