Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

PB/DOS: String Editor

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PB/DOS: String Editor

    Code:
    ' FILE : EDIT$U.BAS
    ' PURPOSE : Make A "Unit" out of SUB Editstring
    ' COPYRIGHT: Placed in the public domain by the author, Michael Mattias.
    ' USAGE:
    '   Place cursor on correct ROW
    '   CALL EditString (Text$, LeftCol%, MaxSize%, KeyCode%, Upper)
    '    Text%    = string to be edited (default value)
    '    LeftCol% = column where string starts
    '    MaxSize% = maximum length permitted. (Beeps if attemt to execeed)
    '    KeyCode% = Value of key used to exit edit routine (see equates)
    '    Upper%   = Convert all letters to uppercase if non-zero
    ' HISTORY ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    ' 01.21.92 Coded as unit PB 2.1
    ' 03.13.93 brought into PB3
    ' 01.20.94 eliminated EXTERNAL ESColorScreen
    ' 09.09.94 problem with cursor was that I had the BIOS int h&10 reporting
    '          color when it should be mono. Fixed. Then I changed the cursor
    '          to make the insert cursor the small line, and the overwrite
    '          cursor the block.
    '12.27.95  Move to PB 3.2
    '11.01.98  Move to PB/DOS 3.5
    ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    ' Valid values for $STACK are 1536 thru 32766 (decimal)
    $LIB COM-, IPRINT+, GRAPH-, CGA-, LPT-, FULLFLOAT-
    $ERROR ALL OFF
    '$LIB options include:
    ' COM - Serial communications support
    ' LPT - line printer support
    ' GRAPH - all graphics            If a certain graphics is enabled,
    '  CGA                            all subordinate graphics are also
    '  EGA                            enabled. Priority is CGA,EGA,VGA;
    '  VGA                            HERC is independent. GRAPH- and CGA- do
    '  HERC				  permit the use of COLOR statements
    'FULLFLOAT - full floating point emulation
    ' ALL  - all the above
    '$FLOAT PROCEDURE
    ' $FLOAT options are:
    '  PROCEDURE - larger but faster than EMULATE; runs on any CPU
    '  EMULATE   - smaller but slower than EMULATE
    '  NPX       - runs only on 80x87, 80386 and 80486 processors
    $OPTION AUTODIM-, CNTLBREAK+
    $COMPILE UNIT
    
    DEFINT A - Z			' Variables are Integer unless overridden
    '======= End Standard Materials ==========================================
    
    
    ProgramConstants:
    '======== Named Program Constants ============
    %FALSE = 0 : %TRUE = NOT %FALSE
    %Home        = -71              ' Cursor Movement Keys
    %EndKey      = -79              ' used in SUB
    %LeftArrow   = -75
    %RightArrow  = -77
    %UpArrow     = -72
    %DownArrow   = -80
    %Escape      =  27
    %PageUp      = -73
    %PageDown    = -81
    %Insert      = -82
    %Delete      = -83
    %F5Key       = -63
    %F9Key       = -67
    %F10Key      = -68
    %CR          =  13              ' Carriage return
    %LF          =  10              ' Line feed
    %DBSpace     =   8              ' destructive backspace
    
    '====== End Named Program Constants ==========
    
    SharedDataNames:
    ' ========= SHARED Data Names ====================
    'EXTERNAL ESColorScreen  'eliminated 1/20/94
    ' ======== End SHARED Data Names =================
    
    'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
    'º    SUB TO  EDIT Text Strings                         SUB EditString      º
    'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
    SUB EditString (Text$, LeftCol%, MaxSize%, KeyCode%, Upper) PUBLIC
    ' NOTE : Modified 8.29.91 to pass "Upper". If Upper = NOT 0, THEN
    ' all letters will be capitalized
    
     LOCAL Edit$,TextPos%, Ky$ , RightCol%, TopScan%, BottomScan%, Xin%, HoldY
     LOCAL AL
     STATIC Inserting%, CursorSize%, BeenHere%
    
    
    ' Use BIOS interrupt 10h service 3 to get/ save incoming cursor shape
    ' INPUT : BH = Page number  AH = 3
    ' OUTPUT : DH,DL = Current Row, Column; CH,CL = cursor top,bottom
    '
      REG 1, &h0300		' set AH
      REG 2, &h0000		' set BH to page 0 ( default)
      CAll Interrupt &h10
      TopScan%    = Reg(3) \ &hFF        ' high byte (CH)
      BottomScan% = Reg(3) AND &h00FF            ' low byte  (CL)
      Xin% = POS(0)                              ' save cursor X at entry
    
     RightCol% = LeftCol% + MaxSize% - 1         ' set up text area
     IF BeenHere% = %FALSE THEN                  ' preserve insert/cursor size
        BeenHere%  = %TRUE                       ' relationship from last time
        REG 1, &h0F00			     ' use BIOS to get color/mono
        CALL INTERRUPT &h10                      ' on first use only
        AL = REG(1) AND &hFF
        IF AL = 7 THEN			     ' MONO monitor (fixed 9/9/94)
          CursorSize% = 12                      ' Monochrome uses 13 scan lines
        ELSE                                     '  (numbered 0 to 12)
          CursorSize% = 7                        ' Color uses 8 (0 to 7)
        END IF
        Inserting% = %TRUE			     ' my preferred default
     END IF
     Edit$ = LEFT$(Text$ + SPACE$(Maxsize%), MaxSize%)  'space pad the text to
    						    'the max field size
    
    ' TextPos% = POS(0) - LeftCol% + 1             'Get the cursor's location to
    ' IF TextPos% < 1 THEN TextPos% = 1            'see where to begin editing
    ' IF TextPos% > LEN(Edit$) THEN TextPos% = LEN(Edit$)
    
     LOCATE , LeftCol%   		        ' go to beg of field
     HoldY = CSRLIN				' save this to check for linewrap
     PRINT Edit$;      	                ' and put up the string
     LOCATE HoldY, LeftCol%		        ' restore cursor to beg of line
    					' done for linewrap situation
     IF Inserting%  THEN                    ' present correct cursor
       LOCATE ,,,CursorSize% -1, CursorSize%  ' single line cursor for insert mode
     ELSE
       LOCATE ,,, CursorSize% \ 2, CursorSize% ' block for overwrite
     END IF
    
    ' Insert this para to have editing start at other than start of field.
    ' requires NoHome% be EXTERNAL or added to call parameters
    ' If NoHome% THEN
    '  TextPos% = Xin%                  ' set by calling sub
    ' ELSE				   ' not coming from editscreen
    '  TextPos% = 1
    ' END IF
    
        '----- Main loop for handling key presses
    
     DO
           LOCATE , LeftCol% + TextPos% - 1, 1      'Locate the cursor, turn it on
    
           DO                                       'Wait for a key press
    	  Ky$ = INKEY$
           LOOP UNTIL LEN(Ky$)
    
    Upper1:
    
           IF Upper THEN Ky$ = UCASE$(Ky$)
    
           IF LEN(Ky$) = 1 THEN                     'Make a key code from Ky$
              KeyCode% = ASC(Ky$)                    'Single character key
           ELSE
              KeyCode% = -ASC(RIGHT$(Ky$, 1))        'Extended keys are negative
           END IF
    
           '----- Branch according to the key pressed
           SELECT CASE KeyCode%
              CASE %DBSpace                             'Destructive BS
    	   IF LeftCol% + TextPos% -1 > 1 THEN       ' if left col is at 1
    	     TextPos% = TextPos% - 1                'Back up the text pointer
                 LOCATE , LeftCol% + TextPos% - 1, 0    'Locate 1 to the left
                 IF TextPos% > 0 THEN                   'Still within the field?
    		IF Inserting% THEN                    'Truncate the string
                       MID$(Edit$, TextPos%) = MID$(Edit$, TextPos% + 1) + " "
                    ELSE                                 'Blank the letter
                       MID$(Edit$, TextPos%) = " "
                    END IF
    		HoldY = CSRLIN			     'for linewrap
    		PRINT MID$(Edit$, TextPos%);         'Print new part of text
    		LOCATE HoldY                         ' restore if Line Wrap
    	     ELSE				     ' we're at start of field
                    INCR TextPos%			     ' reset
                    Beep
                 END IF
    	   ELSE					     ' trying DBSpace at 1
    	     BEEP
    	   END IF
    	  CASE %CR,%Escape,%UpArrow, %DownArrow
                 EXIT LOOP                               ' Bail out
              CASE 32 TO 254                             ' printable characters
                 LOCATE , , 0                            ' Turn the cursor off
    	     HoldY = CSRLIN			     ' for linewrap!
    	     IF Inserting% THEN                      ' Expand the text string
                    MID$(Edit$, TextPos%) = Ky$ + MID$(Edit$, TextPos%)
    		PRINT MID$(Edit$, TextPos%);       ' Print the expanded part
    	     ELSE
                    MID$(Edit$, TextPos%) = Ky$       'Put the new letter in string
    		PRINT Ky$;                        'Print the letter
                 END IF
    	     LOCATE HoldY			  ' fix if linewrap
    	     IF TextPos% <> LEN(Edit$) THEN
                   INCR TextPos%                      'Increment the text pointer
    	     END IF                               ' if not at end
              CASE %LeftArrow
                 IF TextPos% = 1 THEN
                   BEEP
                 ELSE
    	       DECR TextPos%                       'Decrement text pointer
                 END IF
              CASE %RightArrow
                 IF Textpos% = LEN(Edit$) THEN
                   BEEP
                 ELSE
    	       INCR TextPos%                       'Increment text pointer
                 END IF
              CASE %Home
                 TextPos% = 1                         'Move text pointer to 1
              CASE %EndKey
                 FOR N% = LEN(Edit$) TO 1 STEP -1    'Look backwards for non-blank
                    IF MID$(Edit$, N%, 1) <> " " THEN EXIT FOR
                 NEXT N%
    	     TextPos% = N% + 1                  'Set pointer to last char +1
                 IF TextPos% > LEN(Edit$) THEN TextPos% = LEN(Edit$)
              CASE %Insert
    	     Inserting% = NOT Inserting%            'Toggle the Insert state
    	     IF Inserting% THEN                     'Adjust the cursor size
                    LOCATE , , , CursorSize% - 1, CursorSize%
                 ELSE
                    LOCATE , , , CursorSize% \ 2, CursorSize%
                 END IF
              CASE %Delete                              'Truncate the text
                 MID$(Edit$, TextPos%) = MID$(Edit$, TextPos% + 1) + " "
                 LOCATE , , 0                       'Print the truncated part
    	     HoldY = CSRLIN
    	     PRINT MID$(Edit$, TextPos%);
    	     LOCATE HoldY
              CASE ELSE                             'All other keys,
                 EXIT LOOP                           '  bail out
           END SELECT
    
      LOOP
    
    ' In here, we could strip trailing blanks. That way you always pass the data,
    ' and get back the data. Also, we should restore the incoming cursor shape.
    
       Text$ = Edit$			' set the text to new value
    
    ' Restore the incoming cursor ....
      LOCATE ,,,TopScan%, BottomScan%
    
    END SUB
    Michael Mattias
    Tal Systems Inc. (retired)
    Racine WI USA
    [email protected]
    http://www.talsystems.com
Working...
X