home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / preprss.lbr / BINPUT.MZ / BINPUT.ML
Encoding:
Text File  |  1993-10-25  |  20.6 KB  |  669 lines
  1. BINPUT.ML
  2.  
  3. ;;==========================================================================
  4. ; NOTE:
  5. ;         THE `|' VERTICAL BAR IS USED AS A CONTINUATION MARK.
  6. ; DOCUMENTATION ABREVIATIONS:
  7. ;         S/L  =  STRING VARIABLE OR LITERAL ENCLOSED WITH DOUBLE QUOTES.
  8. ;         N/L  =  NUMERIC VARIABLE OR LITERAL.
  9. ;         S    =  STRING VARIABLE ONLY.
  10. ;         N    =  NUMERIC VARIABLE ONLY.         
  11. ;         S/N  =  STRING OR NUMERIC VARIABLE.
  12. ;         
  13. ==========================================================================
  14. ;**
  15. ::INPUT (Macro)
  16. ;**   FUNCTION:
  17. ;**             Standard Terminal Input Subroutine.
  18. ;**   USAGE:
  19. ;**             Twelve parameters required.
  20. ;**     Calling:
  21. ;**                [1]   N/L      -   input order index. 
  22. ;**                [2]   S        -   input/display buffer.
  23. ;**                [3]   N/L      -   cursor row to input-display on.
  24. ;**                [4]   N/L      -   cursor column to input-display on.
  25. ;**                [5]   N/L      -   maximum number of input characters.
  26. ;**                [6]   S/L      -   Editing method:
  27. ;**                                   A - any printable character.
  28. ;**                                   N - numbers & minus sign.
  29. ;**                                   D - dates with verification.
  30. ;**                                   Y - allows yes/no with conversion.
  31. ;**                                   V - validate input using [10].
  32. ;**                                   U - convert to upper case.
  33. ;**                [7]   S/L      -   allowable exit method:
  34. ;**                                   E - <End> key = abort.
  35. ;**                [8]   S/L      -   display format, eg.`??/??/??'.
  36. ;**                [9]   S/L      -   default for [2] on carriage return.
  37. ;**                [10]  S/L      -   optional input editing feature:
  38. ;**                                   R - required input if no default.
  39. ;**                                   if [6] = "V" [10] must have
  40. ;**                                   a valid string.
  41. ;**                [11]  S/L      -   lower limit for range of numeric input.
  42. ;**                [12]  S/L      -   upper limit for range of numeric input.
  43. ;**     Returning:
  44. ;**                 [2]           -   has unformatted entry.
  45. ;**                ABORTFLAG%     -   entry has been aborted if non-zero.
  46. ;**                XFK%           -   if non-zero a cursor flag will be set
  47. ;**                                   Cursor Flags:
  48. ;**                                      XU.% - up arrow = prior field.
  49. ;**                                      XD.% - down arrow = next field.
  50. ;**
  51. ;**   EXAMPLE:
  52. ;**            $input 1,a$,8,8,1,"Y","E","","Y","","",""
  53. ;**                a$ ="1" if a `Y' or <CR> was entered.
  54. ;**   NOTE:
  55. ;**     Modes:
  56. ;**             The variable ENTRYFLAG% controls the function mode.
  57. ;**   
  58. ;**             Input:   ENTRYFLAG% = 1 : input from keyboard.
  59. ;**                      EDITFLAG%  = 1 : edit - change the contents of [2].
  60. ;**                                     : WHO% controls which item to edit, 
  61. ;**                                       the contents of [2] is formatted 
  62. ;**                                       and displayed on line 24.
  63. ;**             Display: ENTRYFLAG% = 0 : display the contents of [2].
  64. ;**
  65. ;**            This macro requires the _INPUT subroutine. 
  66. ;**            
  67. ;**
  68. MACRO INPUT
  69.    Unless EDITFLAG%=1 And WHO%<>[1]
  70.       XWH%=[1]|
  71.       XEE$=[2]|
  72.       XRW%=[3]|
  73.       XCL%=[4]|
  74.       XLG%=[5]|
  75.       XTY$=[6]|
  76.       XCT$=[7]|
  77.       XFT$=[8]|
  78.       XDF$=[9]|
  79.       XOP$=[10]|
  80.       XLW$=[11]|
  81.       XHI$=[12]|
  82.       Gosub _Input|
  83.       If(ENTRYFLAG%=1)Then If((XAB%+XU.%)<>0)Then Return Else [2]=XEE$
  84.    Endu
  85. ;**
  86. ;**  Include _INPUT subroutine    
  87.    $$_INPUT
  88. ;**
  89. ENDM
  90. ;;==========================================================================
  91. ;**
  92. ::_INPUT (Subroutine)
  93. ;**   FUNCTION:
  94. ;**             Subroutine for support of the INPUT macro.
  95. ;**
  96. MACRO _INPUT
  97. Proc _Input
  98.    XED%=EDITFLAG%
  99.    Unless ENTRYFLAG%<>1
  100.      Gosub _Input_1:If(XAB%<>0)Then Return
  101.      XED%=Abs((XED%+XU.%+XD.%)<>0):If(XED%)Then WHO%=XWH%+(XU.%=1)+ABS(XD.%=1)
  102.      EDITFLAG%=XED%
  103.    Endu
  104.    XTX$=XEE$:If(XTY$="Y")Then If(XEE$="1")Then XTX$="Y"Else XTX$="N"
  105.    $DISPLAY XRW%,XCL%,XTX$,XFT$
  106. Endp
  107. Proc _Input_1
  108.    XFK%=0|
  109.    XU.%=0|
  110.    XD.%=0|
  111.    XAB%=0|
  112.    XLN%=0|
  113.    XH.!=Val(XHI$)|
  114.    XL.!=Val(XLW$)
  115.    Unless XED%=0 Or Len(XEE$)=0
  116.        $DISPLAY 24,XCL%,XEE$,XFT$
  117.    Endu
  118.    XTX$=XEE$
  119.    Unless Len(XEE$)=0
  120.        XTX$="."+XEE$:While(Right$(XTX$,1)=" "):XTX$=Left$(XTX$,Len(XTX$)-1):Wend| 
  121.        XTX$=Mid$(XEE$,1,Len(XTX$)-1):XLN%=Len(XTX$)
  122.    Endu
  123.    If(Len(XTX$)<XLG%)Then XTX$=XTX$+String$(XLG%-Len(XTX$),176)
  124.    XK$=XEE$:If(Len(XEE$)=0)Then XK$=Space$(XLG%)
  125.    Gosub Locate_Input:Gosub _Input_2:ABORTFLAG%=XAB%
  126.    If(XAB%)Then Return Else If(XLN%>0)Then XEE$=XK$
  127.    XEE$=XEE$+Space$(XLG%-Len(XEE$))
  128. Endp
  129. Proc _Input_2
  130.    XZ.%=0|
  131.    XA.%=0|
  132.    While XA.%+XAB%+XFK%=0
  133.       Gosub _InKey
  134.       When XFK%=0
  135.          When XI.%=8 And XZ.%>0
  136.             Print Chr$(29);Chr$(176);Chr$(29);|
  137.             Mid$(XK$,XZ.%,1)=" "|
  138.             XZ.%=XZ.%-1:XLN%=XLN%-1
  139.          Else Unless XI.%<32 Or XI.%>126
  140.             When XTY$="A" Or XI.%=45 Or (XI.%>47 And XI.%<58)
  141.                Gosub _Input_3
  142.             Else Unless Instr("UVY",XTY$)=0
  143.                XI.$=Chr$(XI.%+(32*(XI.%>96 And XI.%<123)))
  144.                When XTY$="V" And (Instr(XOP$,XI.$)=0)
  145.                   $MSG "Invalid Entry!"
  146.                Else
  147.                   Gosub _Input_3
  148.                Endw
  149.             Else
  150.                Beep
  151.             Endw
  152.          Else Unless XI.%<>13
  153.             Gosub Test_Input
  154.          Else
  155.             Beep
  156.          Endw
  157.       Else
  158.          When XFK%=79 And XCT$="E"
  159.             XAB%=1
  160.          Else
  161.             FK%=XFK%
  162.             Switch XFK%
  163.             Case 82
  164.                XFK%=0:X.$=Mid$(XK$,1,XZ.%)+" ":XLN%=XLN%+1|
  165.                X.$=X.$+Mid$(XK$,XZ.%+1,XLG%):XK$=Mid$(X.$,1,XLG%)|
  166.                Gosub New_Display
  167.                Break
  168.             Case 83
  169.                XFK%=0:XK$=Mid$(XK$,1,XZ.%)+Mid$(XK$,XZ.%+2,XLG%)+" ":XLN%=XLN%-1|
  170.                Gosub New_Display
  171.                Break
  172.             Case 72
  173.                XZ.%=0:Gosub Test_Input:XU.%=XK.%
  174.                Break
  175.             Case 75
  176.                XFK%=0:If(XZ.%>0)Then Print Chr$(29);:XZ.%=XZ.%-1:Else Beep
  177.                Break
  178.             Case 77
  179.                XFK%=0:If(XZ.%<XLG%)Then Print Chr$(28);:XZ.%=XZ.%+1:Else Beep
  180.                Break
  181.             Case 80
  182.                XZ.%=0:Gosub Test_Input:XD.%=XK.%
  183.                Break
  184.             Case FK%
  185.                XFK%=0|
  186.                Beep
  187.             Endc
  188.          Endw
  189.       Endw
  190.    Wend
  191. Endp
  192. Proc Locate_Input
  193.    If(Len(XFT$)<XLG%)Then XFT%=XLG%-Len(XFT$) Else XFT%=1
  194.    Locate XRW%,XCL%,0:Print Space$(Len(XFT$)+XFT%);:Locate XRW%,XCL%|
  195.    Print XTX$;:Locate XRW%,XCL%
  196. Endp
  197. Proc Test_Input
  198.       XK.%=1
  199.       When XZ.%=0 And XOP$="R" And Len(XEE$)=0 And Len(XDF$)=0
  200.             $MSG "Required Entry!"
  201.             XK.%=0:XFK%=0
  202.       Else
  203.          Gosub _Input_4
  204.       Endw
  205. Endp
  206. Proc New_Display
  207.    XR.%=Csrlin:XC.%=Pos(0):Locate XRW%,XCL%,0:Print Space$(XLG%);|
  208.    Locate XRW%,XCL%:Print Mid$(XK$,1,XLN%);String$(XLG%-XLN%,176);:Locate XR.%,XC.%
  209. Endp
  210. Proc _Input_3
  211.    If(XZ.%+1<=XLG%)Then XZ.%=Pos(0)-XCL%+1:Print XI.$;:Mid$(XK$,XZ.%,1)=XI.$:Else Beep
  212.    If(XZ.%>XLN%)Then XLN%=XZ.%
  213. Endp
  214. Proc _Input_4
  215.    When XZ.%=0 And XED%=0 And Len(XDF$)>0
  216.       XK$=XDF$:XZ.%=Len(XDF$)
  217.    Endw
  218.    XE!=Val(XK$)
  219.    When XTY$="N" Or XTY$="#"
  220.       XE.%=((XL.!<>0 And XE!<XL.!) Or (XH.!<>0 And XE!>XH.!))
  221.       When XE.%<>0
  222.          $MSG "Out of Range!"
  223.       Else
  224.          XA.%=1:If(XE!=0)Then XK$="00":XZ.%=2
  225.       Endw
  226.    Else
  227.       When XTY$="Y"
  228.          XA.%=1:If(XK$="Y" Or XK$="y")Then XK$="1"Else XK$="2"
  229.       Else When XTY$="D"
  230.          Unless Val(XK$)<>0
  231.             X.$=Date$|
  232.             XM$=Left$(X.$,2)|
  233.             XD$=Mid$(X.$,4,2)|
  234.             XY$=Right$(X.$,2)|
  235.             XK$=XM$+XD$+XY$
  236.          Endu
  237.          XM%=Val(Left$(XK$,2))|
  238.          XD%=Val(Mid$(XK$,3,2))|
  239.          When XM%<1 Or XM%>12 Or XD%<1 Or XD%>31
  240.             $MSG "Enter Date Format MMDDYY"
  241.          Else
  242.             XA.%=1
  243.          Endw
  244.       Else
  245.          XA.%=1
  246.       Endw
  247.    Endw
  248.    Unless XA.%+XFK%=0
  249.       $MSG ""
  250.       Locate 24,1:Print Space$(79);
  251.    Endu
  252. Endp
  253. ;**
  254. ;**  Here are additional supporting subroutines.
  255.    $$_FORMAT
  256.    $$_INKEY
  257. ENDM
  258. ;;==========================================================================
  259. ;**
  260. ::_INKEY (Subroutine)
  261. ;**   FUNCTION:
  262. ;**             Get keyboard input one character at a time.
  263. ;**   USAGE:
  264. ;**             Cursor should be positioned before calling.
  265. ;**             The variable XI.% is returned as decimal value or zero
  266. ;**             if control/function key was entered,
  267. ;**             in which case the XFK% variable will be the decimal
  268. :**             value of entry.
  269. ;**   NOTE:
  270. ;**             Basic's INKEY$ function is used to return input from keyboard.
  271. ;**             Time display will be updated if the variable timeflag%
  272. ;**             is non-zero.
  273. ;**           
  274. MACRO _INKEY
  275. Proc _InKey
  276.      ;* call the time display subroutine if non-zero.
  277.    Unless timeflag%=0
  278.      ;* the following three variables control time display only.
  279.       XU%=0|
  280.       XS%=0|
  281.       Gosub _Time
  282.    Endu
  283.      ;* turn on block cursor
  284.    Locate ,,1,0,13|
  285.    XI.$=""|
  286.      ;* loop here waiting for input and updating the time every second.
  287.    While XI.$=""|
  288.       If(timeflag%)Then XU%=XU%+1:If(XU%>GT.%)Then Gosub _Time:XU%=0
  289.       XI.$=Inkey$
  290.    Wend|
  291.    XI.%=Asc(XI.$)|
  292.      ;* return control or function key if first byte=null.
  293.    If(XI.%=0)Then XFK%=Asc(Right$(XI.$,1)) Else XFK%=0
  294. Endp
  295. ;**
  296. ;**  Include _TIME subroutine.
  297.    $$_TIME
  298. ;**
  299. ENDM
  300. ;;==========================================================================
  301. ;**
  302. ::_TIME (Subroutine)
  303. ;**   FUNCTION:
  304. ;**             Display time-of-day.
  305. ;**   USAGE:
  306. ;**             The display location is controlled by the variables
  307. ;**             T.r% (row) and T.c% (column). 
  308. ;**             T.r% and T.c% are set prior to calling.
  309. ;**   NOTE:
  310. ;**             GT.% is used by _INKEY to control update frequency.
  311. ;**             GT.% = 60 - for interpreter.
  312. ;**             GT.% = 1000 - for compiled.
  313. ;** 
  314. MACRO _TIME
  315. Proc _Time
  316.    XR.%=Csrlin|
  317.    XC.%=Pos(0)|
  318.    XT.$=Time$|
  319.    XH.%=Val(Left$(XT.$,2))|
  320.    XM.$=" am"
  321.    Unless XH.%<12
  322.       XM.$=" pm":XH%=XH.%+(12*(XH.%>12))|
  323.       XT.$=Str$(XH%)+Right$(XT.$,Len(XT.$)-Len(Str$(XH.%))+1)|
  324.       If(XH%=12)Then XM.$=" am"
  325.    Endu
  326.    Locate ,,0|  
  327.    Locate T.R%,T.C%|
  328.    Print XT.$;XM.$;|
  329.    Locate XR.%,XC.%,1|
  330.    XS.%=Val(Right$(XT.$,2))|
  331.       ;* adjust update frequency if compiled.
  332.    GT.%=60+(940*ABS(XS.%-XS%=0 And XS%>0))|
  333.    XS%=XS.%
  334. Endp
  335. ENDM
  336. ;;==========================================================================
  337. ;**
  338. ::MSG (Macro)
  339. ;**   FUNCTION:
  340. ;**             Display message on line 25 and ding the bell.
  341. ;**   USAGE:
  342. ;**             One parameter required.
  343. ;**             [1] - S/L 
  344. ;**   EXAMPLE:
  345. ;**             $msg "HELLO WORLD"
  346. ;**   NOTE:
  347. ;**             The current cursor location is saved and then restored after
  348. ;**             message has been displayed.
  349. ;**
  350. MACRO MSG
  351.    X.$=[1]:Gosub _MSG
  352. ;**
  353. ;**  Include the _MSG subroutine.
  354.    $$_MSG
  355. ;**
  356. ENDM
  357. ;;==========================================================================
  358. ;**
  359. ::_MSG (Subroutine)
  360. ;**   FUNCTION: Subroutine for the MSG macro.
  361. ;**
  362. ;**   NOTE:
  363. ;**             If X.$ is NULL, line 25 is cleared.
  364. ;**
  365. MACRO _MSG
  366. Proc _MSG
  367.    XR.%=Csrlin|
  368.    XC.%=Pos(0)|
  369.    Locate 25,1,0|
  370.    Print Space$(79);:If Len(X.$)>0 Then Beep:Locate 25,1:Print X.$;
  371.    Locate XR.%,XC.%
  372. Endp
  373. ENDM
  374. ;;==========================================================================
  375. ;**
  376. ::FORMAT (Macro)
  377. ;**   FUNCTION: 
  378. ;**             Format a string using a format description.
  379. ;**   USAGE:
  380. ;**             Two parameters are required.
  381. ;**      Calling:
  382. ;**             [1] - S   -  containing characters to be formatted.
  383. ;**             [2] - S/L -  containing a format description.
  384. ;**      Optional:
  385. ;**             [3] - L   -  L = left justify
  386. ;**      Returning:
  387. ;**             [1] - formatted string.
  388. ;**
  389. ;**   EXAMPLE:
  390. ;**             $format NUMBER$,"###,###.##"
  391. ;**             $format ACCOUNT$,"????-???",L
  392. ;**
  393. ;**   NOTE:
  394. ;**             Format description characters:
  395. ;**             # - digit (0..9).
  396. ;**                 default to "0" if right of decimal point. 
  397. ;**                 default to " " if left of decimal point.
  398. ;**             Z - digit (0..9).
  399. ;**                 default to "0" always.
  400. ;**             ? - wild card.
  401. ;**                 default to " " always.
  402. MACRO FORMAT
  403.    XTF$=[1]:XFF$=[2]:XJ.$="[3]":Gosub _Format:[1]=XTF$
  404. ;**   Include _FORMAT subroutine
  405. ;**
  406.    $$_FORMAT
  407. ;**
  408. ENDM
  409. ;;==========================================================================
  410. ;**
  411. ::_FORMAT (Subroutine)
  412. ;**   FUNCTION:
  413. ;**             Supporting subroutine for FORMAT macro.
  414. ;**
  415. ;**
  416. MACRO _FORMAT
  417. Proc _Format
  418.    Unless Len(XFF$)=0 Or Len(XTF$)=0
  419.       XF1%=Len(XTF$)|
  420.       XF2%=Len(XFF$)|
  421.       XXF$=Space$(XF2%)|
  422.       XF3%=Instr(XFF$,".")|
  423.       XF4%=(XF3%>0 And Instr(XFF$,"#"))
  424.       While XF2%+XF1%>0
  425.          When XF2%>0
  426.             XF.$=Mid$(XFF$,XF2%,1):XF.%=Instr("?#Z",XF.$)
  427.             Unless XF.%=0
  428.                When XF1%>0
  429.                   XF.$=Mid$(XTF$,XF1%,1)|
  430.                   If(XF.%>1 And Val(XF.$)=0 And XF.$<>"0")Then XF.$="0" Else XF1%=XF1%-1
  431.                Else
  432.                   If(XF.%=3)Then XF.$="0"Else XF.$=" "
  433.                Endw
  434.             Endu
  435.             If(XF.$=" " And XF4% And XF3%>0 And XF2%=>XF3%)Then XF.$="0"
  436.             Mid$(XXF$,XF2%,1)=XF.$:XF2%=XF2%-1
  437.          Else
  438.             XXF$=Mid$(XTF$,XF1%,1)+XXF$:XF1%=XF1%-1
  439.          Endw
  440.       Wend
  441.       While Left$(XXF$,1)=" " And XJ.$="L"
  442.          XXF$=Right$(XXF$,Len(XXF$)-1)
  443.       Wend
  444.       XTF$=XXF$ 
  445.    Endu
  446. Endp
  447. ENDM
  448. ;;==========================================================================
  449. ;**
  450. ::DISPLAY (Macro)
  451. ;**   FUNCTION:
  452. ;**             Display on CRT.
  453. ;**   USAGE:
  454. ;**             Three parameters are required.
  455. ;**             One optional parameter.
  456. ;**     Calling:
  457. ;**             [1] - N/L - display row (1..24).
  458. ;**             [2] - N/L - display column (1..80).
  459. ;**             [3] - S/L - containing characters to be displayed. 
  460. ;**             [4] - S/L - optional format description.
  461. ;**
  462. ;**   EXAMPLE:
  463. ;**             $display 10,20,"HELLO WORLD"
  464. ;**             $display RW.%,CL.%,SSN$,"???-??-????"
  465. ;**             $display 11,25,TODAY$,"??/??/??"
  466. MACRO DISPLAY
  467.    XD.$=[3]
  468. ;**   if the [4] parameter is used
  469.    $IF [4]
  470. ;**   formatting is required.
  471.    $FORMAT XD.$,[4]
  472.    $END
  473.    XR.%=[1]:XC.%=[2]
  474.    Gosub _Display
  475. ;**   Include _DISPLAY subroutine
  476.    $$_DISPLAY
  477. ;**
  478. ENDM
  479. ;;==========================================================================
  480. ;**
  481. ::_DISPLAY (Subroutine)
  482. ;**   FUNCTION:
  483. ;**             Supporting subroutine for DISPLAY macro.
  484. ;**
  485. ;**
  486. MACRO _DISPLAY
  487. Proc _Display
  488.    Locate XR.%,XC.%,0|
  489.    Print Space$(Len(XD.$)+1);|
  490.    Locate XR.%,XC.%|
  491.    Print XD.$;
  492. Endp
  493. ENDM
  494. ;;==========================================================================
  495. ;**
  496. ::PROMPT (Macro)
  497. ;**   FUNCTION:
  498. ;**             Display a prompt on line 25 and get input from keyboard.
  499. ;**   USAGE:
  500. ;**             Two parameters required.
  501. ;**             Two optional parameters.
  502. ;**     Calling:
  503. ;**             [1] - S/L - display message.
  504. ;**             [2] - S/L - input validation string.
  505. ;**     Returning:
  506. ;**      Optional- [3] - N   - index value of input in validation string.
  507. ;**      Optional- [4] - S   - input character.
  508. ;**
  509. ;**   EXAMPLE:
  510. ;**             $prompt "Any Change","YN",ask.%
  511. ;**             ask.% = 1 if `Y' entered.
  512. ;**             ask.% = 2 if `N' entered.
  513. ;**   NOTE:
  514. ;**             The current cursor location is saved and restored.
  515. ;**
  516. MACRO PROMPT
  517.    $IF [3]
  518.    PROMPT$=[1]:XX.$=[2]:Gosub _Prompt:[3]=XX.%
  519.    $ELSE
  520.    PROMPT$=[1]:XX.$=[2]:Gosub _Prompt
  521.    $END
  522.    $IF [4]
  523.    [4]=XI.$
  524.    $END
  525. ;**   Include supporting subroutine.
  526.    $$_PROMPT
  527. ;**
  528. ENDM
  529. ;;==========================================================================
  530. ;**
  531. ::_PROMPT (Subroutine)
  532. ;**   FUNCTION:
  533. ;**             Supporting subroutine for PROMPT macro.
  534. ;**
  535. MACRO _PROMPT
  536. Proc _Prompt
  537.    XR.%=Csrlin|
  538.    XC.%=Pos(0)|
  539.    locate 25,1,0:Print PROMPT$;:Locate 25,Pos(0)+1,1,0,13:XI.$=""
  540.    While(XI.$="")
  541.       Gosub _InKey|
  542.       XI.$=Chr$(XI.%+(32*(XI.%>96 And XI.%<123)))|
  543.       XX.%=Instr(XX.$,XI.$)|
  544.       If(Len(XX.$)>0)Then If(XX.%=0)Then Beep:XI.$=""
  545.    Wend
  546.    Locate 25,1,0|
  547.    Print Space$(79);|
  548.    Locate XR.%,XC.%
  549. Endp
  550. ;**   Include supporting subroutine.
  551.    $$_INKEY
  552. ;**
  553. ENDM
  554. ;;==========================================================================
  555. ;**
  556. ::FRAME (Macro)
  557. ;**   FUNCTION:
  558. ;**             Draws a block graphic frame on screen.
  559. ;**   USAGE:
  560. ;**             Four parameters required.
  561. ;**     Calling:
  562. ;**             [1] - N/L - top row (1..24).
  563. ;**             [2] - N/L - bottom row (1..24).
  564. ;**             [3] - N/L - left column (1..80).
  565. ;**             [4] - N/L - right column (1..80).
  566. ;**   EXAMPLE:
  567. ;**             $frame 4,10,20,60
  568. ;**             $frame TR%,BR%,LC%,RC%
  569. ;**             
  570. MACRO FRAME
  571.    X1.%=[1]:X2.%=[2]:X3.%=[3]:X4.%=[4]:Gosub _Frame
  572. ;**   Include supporting subroutine.
  573.    $$_FRAME
  574. ;**
  575. ENDM
  576. ;;==========================================================================
  577. ;**
  578. ::_FRAME (Subroutine)
  579. ;**   FUNCTION:
  580. ;**             Called by FRAME macro to do the work.
  581. ;**             
  582. MACRO _FRAME
  583. Proc _Frame
  584.    Locate X1.%,X3.%,0|
  585.    Print Chr$(201);String$(X4.%-X3.%-1,205);Chr$(187);
  586.    For X5.%=X1.%+1 To X2.%-1|
  587.    Locate X5.%,X3.%:Print Chr$(186);:Locate X5.%,X4.%:Print Chr$(186);|
  588.    Next
  589.    Locate X2.%,X3.%|
  590.    Print Chr$(200);String$(X4.%-X3.%-1,205);Chr$(188);
  591. Endp
  592. ENDM
  593. ;;==========================================================================
  594. ;**
  595. ::VIDEO (Macro)
  596. ;**   FUNCTION:
  597. ;**             Routine to get CRT memory offset for color or monochrome,
  598. ;**             and reset screen and color, and clear screen.
  599. ;**             Screen:
  600. ;**                   text mode.
  601. ;**                   color burst set non-zero (if color monitor).
  602. ;**                   active page zero.
  603. ;**                   visual page zero.
  604. ;**             Width:
  605. ;**                   80.
  606. ;**             Color:
  607. ;**                   foreground  = yellow (14).
  608. ;**                   background  = blue   (1).
  609. ;**                   border      = blue   (1).
  610. ;**             Monochrome:
  611. ;**                   foreground  = white  (7).
  612. ;**                   background  = black  (0).
  613. ;**                   border      = black  (0).
  614. ;**   USAGE:
  615. ;**             No parameter required.
  616. ;**     Returning:
  617. ;**             VIDEO% - offset to CRT memory.
  618. ;**             MONO%  - true (-1) if monochrome.
  619. ;**             ADPT%  - true (-1) if color adapter.
  620. ;**             FG.%   - foreground: 7=monochrome, 14=color.
  621. ;**             BG.%   - background: 0=monochrome, 1=color.
  622. ;**             BD.%   - border: same as background (BG.%).
  623. ;**   NOTE:
  624. ;**             &HB000=monochrome offset, &HB800=Color offset.
  625. ;**             If you call this more than once in a program,
  626. ;**             you should change it to a procedure subroutine,
  627. ;**             ie..(_VIDEO).
  628. ;**
  629. ;**             **(DEF SEG is set to zero by VIDEO).
  630. ;**             
  631. MACRO VIDEO
  632.    Def Seg=0:VIDEO%=&HB000-(&H800*(((Peek(1040) And 48)/16)<3))|
  633.    MONO%=((Peek(&H410) And &H30)=&H30)|
  634.    ADPT%=Not MONO%|
  635.    Screen 0,Abs(ADPT%),0,0|
  636.    Width 80|
  637.    FG.%=FG.%+(7*ABS(FG.%=0))|
  638.    FG.%=(FG.%*(1+ABS(ADPT% And FG.%=7)))|
  639.    BG.%=BG.%+(1*ABS(BG.%=0))|   
  640.    BG.%=(BG.%+(MONO%*ABS(BG.%=1)))|
  641.    BD.%=BG.%|
  642.    Color FG.%,BG.%,BD.%:Cls
  643. ENDM
  644. ;;==========================================================================
  645. ;**
  646. ::CRT (Macro)
  647. ;**   FUNCTION:
  648. ;**             Screen display.
  649. ;**   USAGE:
  650. ;**             Three parameters required.
  651. ;**             [1] - N/L - screen row.
  652. ;**             [2] - N/L - screen column.
  653. ;**             [3] - S/L - display buffer.
  654. ;**             [4] - L   - optional reverse video.
  655. ;**   EXAMPLE:
  656. ;**             $crt 12,25,"HELP"
  657. ;**             $crt RW.%,CL.%,HELP$,1
  658. ;**
  659. MACRO CRT
  660.    $IF [4]
  661.    Color BG.%,FG.%
  662.    $END
  663.    Locate [1],[2]:Print [3];
  664.    $IF [5] 
  665.    Color FG.%,BG.%
  666.    $END
  667. ENDM
  668. ;
  669.