home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
clarion
/
clarmemo.zip
/
MEMOEDIT.CLA
< prev
next >
Wrap
Text File
|
1991-12-30
|
36KB
|
820 lines
MEMBER()
!═════════════════════════════════════════════════════════════════════════
!
! 'MEMOEDIT.CLA' - Clarion Memo Field Editor
!
! Revision Number: '1'
! Revision Date : '21-Sep-91'
!
! Copyright : Bobcat Systems (c) 1991
! Author : Robert J. Pupazzoni
! CIS:[70441,204]
!
! Compiler : Clarion Professional Developer v.2.1, Batch 2105
!
! Modified by Bob Gamer DTM Data Services. 12/29/91
!
! BACKGROUND
!
! I wrote this because of my frustration with Eckenroed's MEMO3 product.
! While MEMO3 does what it claims to do, it is quite inflexible and a real
! memory hog (>30K BIN file). This was not acceptable for the app I was
! writing at the time, so MEMOEDIT is my attempt to rectify the situation.
!
! DESCRIPTION
!
! This module replaces the standard Clarion memo field editing. It adds the
! following features:
!
! Dynamic word wrapping and paragraph reformatting (optional b.g.)
!
! Block operations: Copy, Move, Delete
!
! NOT a LEM - Written entirely in Clarion, so it can be put in an
! overlay.
!
! Since it's all in Clarion, you can add as many Hot Keys, features
! etc. as you want.
!
!
!═════════════════════════════════════════════════════════════════════════
!═════════════════════════════════════════════════════════════════════════
! Edit a memo field
!═════════════════════════════════════════════════════════════════════════
MemoEdit FUNCTION( xMemo, xLine, ibRow, ibMaxRows, eRow, eColumn )
! Parameters:
xMemo EXTERNAL,DIM(1) ! Memo field
xLine EXTERNAL ! Screen string for edit
ibRow EXTERNAL ! Repeat index for screen
ibMaxRows BYTE ! # of rows on screen
eRow EXTERNAL ! Edit Col Disp (new b.g.)
eColumn EXTERNAL ! Edit Row Disp (new b.g.)
! Return:
bbModified BYTE ! Modified flag
! Equates:
eMarkedFG EQUATE(14) ! Foreground for marked text
eMarkedBG EQUATE(4) ! Background for marked text
oHueFG BYTE ! Orig fore hue (new b.g.)
oHueBG BYTE ! Orig back hue (new b.g.)
noReform BYTE ! No Reformat (new b.g.)
eHelpID EQUATE('MEMOEDIT') ! Help screen ID
! Locals:
tTable TABLE,PRE(TAB) ! Edit table
STRING(255) !
. !
tHold TABLE,PRE(HLD) ! Hold area for block ops.
STRING(255) !
. !
sCursorSize STRING('<07><06><07><04>') ! Cursor sizes
aCursorSize SHORT,DIM(2),OVER(sCursorSize) !
gRegisters GROUP ! CPU Registers
isAX SHORT !
isBX SHORT !
isCX SHORT !
isDX SHORT !
isSI SHORT !
isDI SHORT !
isDS SHORT !
isES SHORT !
ibInt BYTE !
isFlags SHORT !
. !
ilMemoRows SHORT ! Total rows in memo field
ibRowOfs BYTE ! Screen field row offset
ibColOfs BYTE ! Screen field column offset
ilRowTop SHORT ! Index of top displayed line
ibCol BYTE ! Cursor column
ibMaxCols BYTE ! Max. displayable columns
ibWrapCol BYTE ! Column to word-wrap on
isKeystroke SHORT ! Last keystroke
bbInsertMode BYTE ! Insert mode flag
sTemp STRING(255) ! Temporary line buffer
ilMarkBegRow SHORT ! Start row of marked block
ibMarkBegCol BYTE ! Start column of marked block
ilMarkEndRow SHORT ! End row of marked block
ibMarkEndCol BYTE ! End column of marked block
bbMarking BYTE ! Marking mode flag
ilAbsTarget SHORT ! Temporaries used in block
ilAbsMrkBeg SHORT ! operations
ilAbsMrkEnd SHORT !
ibHiCol1 BYTE ! Hilight column start
ibHiCol2 BYTE ! Hilight column end
ilTblNdx SHORT ! Edit table index
ilHoldNdx SHORT ! Hold table index
ilMemoNdx SHORT ! Memo array index
ibColNdx BYTE ! Column index
ibLineNdx BYTE ! Line index
CODE
eRow = 1 ! Row Disp (new b.g.)
eColumn = 1 ! Col Disp (new b.g.)
bbModified = 0 ! Clear modified flag
bbInsertMode = 0 ! Ins mode OFF (new b.g.)
ibRow = 1 ! Start on first row
ibCol = 1 ! Start in first column
noReform = 1 ! Turn on Reformat bypass
ilMemoRows = MAXIMUM(xMemo[],1) ! Set row/column values
ibRowOfs = ROW(xLine) - 1 !
ibColOfs = COL(xLine) - 1 !
ibMaxCols = COLS(xLine) !
ibWrapCol = ibMaxCols - 1 !
oHueFG = FOREHUE(ibRowOfs+1,ibColOfs+1) ! Orig Fore hue (new b.g.)
oHueBG = BACKHUE(ibRowOfs+1,ibColOfs+1) ! Orig Back hue (new b.g.)
ilMarkBegRow = 0 ! Reset marked block values
ibMarkBegCol = 0 !
ilMarkEndRow = 0 !
ibMarkEndCol = 0 !
bbMarking = 0 !
HELP(,eHelpID) ! Set the help window
DO LoadMemo ! Load memo into table
DO First_Page ! Display first page
DO EditLoop ! Edit the memo
DO SaveMemo ! Save table to memo field
HELP(,'') ! Deactivate help window
SETCURSOR ! Turn offf cursor
FREE(tTable) ! Clean up
FREE(tHold) !
SETHUE ! (new b.g.)
RETURN(bbModified) ! Return modified flag
!──────────────────────────────────────────────────────────────────────────
EditLoop ROUTINE ! Main edit loop
!──────────────────────────────────────────────────────────────────────────
LOOP ! Loop
SETCURSOR(ibRowOfs+ibRow,ibColOfs+ibCol) ! Set cursor position
DO CursorSize ! Set cursor size
ASK ! Wait for keystroke
isKeystroke = KEYCODE() ! Save it
CASE isKeystroke ! Process action
OF Esc_Key; BREAK !
OF F1_Key; HELP !
OF Left_Key; DO Move_Left ! Horizontal movement
OF Ctrl_Left; DO MoveW_Left !
OF Home_Key; DO Move_BOL !
OF Right_Key; DO Move_Right !
OF Ctrl_Right; DO MoveW_Right !
OF End_Key; DO Move_EOL !
OF Tab_Key; DO Tab_Right !
OF Up_Key; DO Move_Up ! Vertical movement
OF Down_Key; DO Move_Down !
OF PgUp_Key; DO Page_Up !
OF PgDn_Key; DO Page_Down !
OF Ctrl_PgUp; DO First_Page !
OF Ctrl_PgDn; DO Last_Page !
OF Enter_Key; DO Newline ! Insertion/deletion
OF Ins_Key; DO Toggle_Ins !
OF Del_Key; DO Delete_Char !
OF BS_Key; DO Backspace !
OF Ctrl_End; DO Delete_EOL !
OF Alt_K; DO Block_Mark ! Block operations
OF Alt_D; DO Block_Delete !
OF Alt_C; DO Block_Copy ! (new b.g.)
OF Alt_M; DO Block_Move !
OF Alt_U; DO Block_Unmark ! (new b.g.)
OF Alt_O; sTemp = '°' ! Special keys
Do Insert_Str !
!
OF F4_Key; sTemp = FORMAT(TODAY(),@D1) !
Do Insert_Str !
ELSE
IF ALERTED(isKeystroke) THEN BREAK. ! Return on alerted key
IF INRANGE(isKeystroke,32,255) ! Printable character
DO Insert_Char !
ELSE !
BEEP ! Garbage
. .
IF bbMarking ! If marking a block
ilMarkEndRow = ilRowTop + ibRow ! Update block end row
ibMarkEndCol = ibCol ! Update block end column
DO Show_Page ! Update marking on screen
. . ! End loop
!**************************************************************************
! Horizontal Movement Routines
!**************************************************************************
!──────────────────────────────────────────────────────────────────────────
Move_Left ROUTINE ! Move cursor left
!──────────────────────────────────────────────────────────────────────────
IF ibCol > 1 ! If not at first column
ibCol -= 1 ! Move cursor left
DO SetRowCol ! Row/Col Disp (new b.g.)
ELSE BEEP ! (new b.g.)
. ! Endif
!──────────────────────────────────────────────────────────────────────────
MoveW_Left ROUTINE ! Move left one word
!──────────────────────────────────────────────────────────────────────────
GET(tTable,ilRowTop+ibRow) ! Get current line
ibColNdx = ibCol - 1 ! Set column index
DO Word_Left ! Search left
ibCol = ibColNdx ! Set new cursor postion
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Move_BOL ROUTINE ! Move to beginning of line
!──────────────────────────────────────────────────────────────────────────
ibCol = 1 ! Set to first column
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Move_Right ROUTINE ! Move cursor right
!──────────────────────────────────────────────────────────────────────────
IF ibCol < ibMaxCols ! If not on last column
ibCol += 1 ! Move cursor right
ELSE BEEP ! (new b.g.)
. ! Endif
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
MoveW_Right ROUTINE ! Move right one word
!──────────────────────────────────────────────────────────────────────────
GET(tTable,ilRowTop+ibRow) ! Get current line
ibColNdx = ibCol ! Set column index
DO Word_Right ! Search right
ibCol = ibColNdx ! Set new cursor postion
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Move_EOL ROUTINE
!──────────────────────────────────────────────────────────────────────────
GET(tTable,ilRowTop+ibRow) ! Get current line
ibCol = LEN(CLIP(tTable)) + 1 ! Set cursor to last character
IF ibCol > ibMaxCols
ibCol = ibMaxCols
.
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Tab_Right ROUTINE
!──────────────────────────────────────────────────────────────────────────
ibCol = 8 * (ibCol/8 + 1) ! Calculate new tab column
IF ibCol > ibMaxCols ! If past end of screen
ibCol = ibMaxCols ! Fix cursor positionn
. ! Endif
DO SetRowCol ! Row/Col Disp (new b.g.)
!*************************************************************************
! Vertical Movement Routines
!*************************************************************************
!──────────────────────────────────────────────────────────────────────────
Move_Up ROUTINE ! Move one line up
!──────────────────────────────────────────────────────────────────────────
IF ilRowTop + ibRow = 1 THEN BEEP; EXIT. ! Exit if at first record
IF ibRow > 1 ! If not at first screen row
ibRow -= 1 ! Move cursor up
ELSE ! Else
ilRowTop -= 1 ! Scroll up
SCROLL(ibRowOfs+1,ibColOfs+1,ibMaxRows,ibMaxCols,-1)
GET(tTable,ilRowTop+1) ! Fill top line
DO Show_Line !
. ! Endif
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Move_Down ROUTINE ! Move one line down
!──────────────────────────────────────────────────────────────────────────
IF ilRowTop+ibRow = RECORDS(tTable) THEN BEEP; EXIT. ! Exit if at last record
IF ibRow < ibMaxRows ! If not at last screen row
ibRow += 1 ! Move cursor down
ELSE ! Else
ilRowTop += 1 ! Scroll down
SCROLL(ibRowOfs+1,ibColOfs+1,ibMaxRows,ibMaxCols,1)
GET(tTable,ilRowTop+ibRow) ! Fill bottom line
DO Show_Line !
. ! Endif
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
First_Page ROUTINE ! Display first page
!──────────────────────────────────────────────────────────────────────────
ilRowTop = 0 ! Reset top row
ibRow = 1 ! Move cursor to top line
DO Show_Page ! Display the page
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Last_Page ROUTINE ! Display last page
!──────────────────────────────────────────────────────────────────────────
IF RECORDS(tTable) > ibMaxRows ! If more records than rows
ilRowTop = RECORDS(tTable) - ibMaxRows ! Set top row
ibRow = ibMaxRows ! Set cursor row
ELSE ! Else
ilRowTop = 0 ! Set top row
ibRow = RECORDS(tTable) ! Set cursor row
. ! Endif
DO Show_Page ! Display page
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Page_Up ROUTINE ! Scroll one page up
!──────────────────────────────────────────────────────────────────────────
IF ilRowTop > ibMaxRows ! If previous page exists
ilRowTop -= ibMaxRows ! Display previous page
DO Show_Page !
ELSE ! Else
DO First_Page ! Display first page
. ! Endif
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Page_Down ROUTINE ! Scroll one page down
!──────────────────────────────────────────────────────────────────────────
IF ilRowTop + ibMaxRows >= RECORDS(tTable) ! Exit if no next page
EXIT !
. !
ilRowTop += ibMaxRows ! Set to next page
IF ilRowTop + ibRow > RECORDS(tTable) ! If past last record
ibRow = RECORDS(tTable) - ilRowTop ! Fix cursor position
. ! Endif
DO Show_Page ! Display page
DO SetRowCol ! Row/Col Disp (new b.g.)
!*************************************************************************
! Insertion and Deletion Routines
!*************************************************************************
!──────────────────────────────────────────────────────────────────────────
Toggle_Ins ROUTINE ! Toggle insert/overwrite mode
!──────────────────────────────────────────────────────────────────────────
bbInsertMode = BXOR(bbInsertMode,1) ! Toggle insert flag
!──────────────────────────────────────────────────────────────────────────
Newline ROUTINE ! Insert a new line, or go to BOL of next line
!──────────────────────────────────────────────────────────────────────────
bbModified = 1 ! Set modified flag
IF bbInsertMode ! If insert mode
DO Split ! Split current line
ELSE ! Else
DO Move_BOL ! Move to start-of-line
DO Move_Down ! Move to next line
. ! Endif
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Insert_Char ROUTINE ! Insert a character
!──────────────────────────────────────────────────────────────────────────
sTemp = CHR(isKeystroke) ! Set to last char typed
DO Insert_Str ! Insert into text
!──────────────────────────────────────────────────────────────────────────
Insert_Str ROUTINE ! Insert a string
!──────────────────────────────────────────────────────────────────────────
bbModified = 1 ! Set modified flag
GET(tTable,ilRowTop+ibRow) ! Get current line
ibColNdx = ibCol + BXOR(bbInsertMode,1) ! Set insert/overwrite column
IF CLIP(sTemp) ! If string not empty
tTable = SUB(tTable,1,ibCol-1) & | ! Insert string
CLIP(sTemp) & | !
SUB(tTable,ibColNdx,255) !
ibCol += LEN(CLIP(sTemp)) ! Move cursor
ELSE ! Else
tTable = SUB(tTable,1,ibCol-1) & | ! Insert space
' ' & | !
SUB(tTable,ibColNdx,255) !
ibCol += 1 ! Move cursor
. ! Endif
PUT(tTable) ! Update line table
DO Show_Line ! Refresh display
IF ibCol > ibWrapCol+1 ! If past wrap column
DO WordWrap ! Perform word wrap
ELSIF LEN(CLIP(tTable)) > ibWrapCol ! Else if line is too long
DO Reformat ! Reformat paragraph
. ! Endif
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Delete_Char ROUTINE ! Delete character under cursor
!──────────────────────────────────────────────────────────────────────────
bbModified = 1 ! Set modified flag
GET(tTable,ilRowTop+ibRow) ! Get current line
IF ibCol > LEN(CLIP(tTable)) ! If EOL
DO Join ! Join next line
ELSE ! Else
tTable = SUB(tTable,1,ibCol-1) & | ! Delete cursor char.
SUB(tTable,ibCol+1,255) !
PUT(tTable) ! Update line
DO Show_Line ! Refresh display
DO Backfill ! Backfill empty space
. ! Endif
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Backspace ROUTINE ! Delete character before cursor
!──────────────────────────────────────────────────────────────────────────
IF ibCol > 1 ! If not at BOL
ibCol -= 1 ! Move cursor left
DO Delete_Char ! Delete char under cursor
. ! Endif
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Delete_EOL ROUTINE ! Delete to end-of-line
!──────────────────────────────────────────────────────────────────────────
bbModified = 1 ! Set modified flag
GET(tTable,ilRowTop+ibRow) ! Get current line
tTable = SUB(tTable,1,ibCol-1) ! Delete after cursor
PUT(tTable) ! Update line table
DO Show_Line ! Refresh display
DO Backfill ! Fill in empty space
!──────────────────────────────────────────────────────────────────────────
Split ROUTINE ! Split line at cursor position
!──────────────────────────────────────────────────────────────────────────
GET(tTable,ilRowTop+ibRow) ! Get current line
sTemp = SUB(tTable,ibCol,255) ! Save text after cursor
tTable = SUB(tTable,1,ibCol-1) ! Delete part after cursor
PUT(tTable) ! Update line table
DO Show_Line ! Refresh display
tTable = sTemp ! Create a new line
ADD(tTable,ilRowTop+ibRow+1) ! with saved text
DO Move_BOL ! Move to BOL
DO Move_Down ! Move down
DO Show_Partial ! Refresh display
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Join ROUTINE ! Join next line with current line
!──────────────────────────────────────────────────────────────────────────
GET(tTable,ilRowTop+ibRow+1) ! Get next line
IF ERRORCODE() THEN EXIT. ! Exit if not found
sTemp = tTable ! Save text
DELETE(tTable) ! Delete line
GET(tTable,ilRowTop+ibRow) ! Get current line
tTable = CLIP(tTable) & ' ' & sTemp ! Join lines
PUT(tTable) ! Update line table
DO Show_Partial ! Refresh display
GET(tTable,ilRowTop+ibRow) ! Get current line
IF ~noReform THEN DO Reformat. ! Reformat if not suppressed
DO SetRowCol ! Row/Col Disp (new b.g.)
!*************************************************************************
! Word Wrap and Reformatting
!**************************************************************************
!──────────────────────────────────────────────────────────────────────────
WordWrap ROUTINE ! Perform word wrap
!──────────────────────────────────────────────────────────────────────────
IF isKeystroke = VAL(' ') ! If last char was space
ibCol = 1 ! Move cursor to 1st column
ELSE ! Else
ibColNdx = ibCol ! Find breakpoint
DO Word_Left !
sTemp = SUB(tTable,ibColNdx,255) !
ibCol = LEN(CLIP(sTemp)) + 1 ! Move cursor to new pos.
IF ~noReform THEN DO Reformat. ! Reformat (new b.g.)
. ! Endif
IF ilRowTop+ibRow = RECORDS(tTable) ! If last line
CLEAR(tTable); ADD(tTable) ! Add a new one
. ! Endif
DO Move_Down ! Move cursor down one line
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Reformat ROUTINE ! Reformat paragraph
!──────────────────────────────────────────────────────────────────────────
! Loop for each line
LOOP ilTblNdx = ilRowTop+ibRow TO RECORDS(tTable)
IF LEN(CLIP(tTable)) <= ibWrapCol THEN BREAK.! Break if no wrap needed
ibColNdx = ibWrapCol+1 !
DO Word_Left ! Find breakpoint
sTemp = SUB(tTable,ibColNdx,255) ! Save excess portion
tTable = SUB(tTable,1,ibColNdx-1) !
PUT(tTable) ! Update current line
GET(tTable,ilTblNdx+1) ! Get next line
IF ERRORCODE() OR NOT tTable ! If not found or empty
tTable = sTemp ! Create a new one
ADD(tTable,ilTblNdx+1) !
ELSE ! Else
tTable = CLIP(sTemp) & ' ' & tTable ! Add saved section
PUT(tTable) ! Update line
. . ! End loop
DO Show_Partial ! Refresh display
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Backfill ROUTINE ! Backfill line
!──────────────────────────────────────────────────────────────────────────
if noReform then exit. ! Reformat (new b.g.)
GET(tTable,ilRowTop+ibRow+1) ! Get next line
IF ERRORCODE() OR NOT tTable THEN EXIT. ! Exit if empty or not found
sTemp = tTable ! Save contents
DELETE(tTable) ! Delete line
GET(tTable,ilRowTop+ibRow) ! Get current line
tTable = CLIP(tTable) & ' ' & sTemp ! Append saved section
PUT(tTable) ! Update line
DO Reformat ! Reformat paragraph
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Word_Left ROUTINE ! Search for next word to left
!──────────────────────────────────────────────────────────────────────────
LOOP WHILE (ibColNdx > 0) ! Loop
IF SUB(tTable,ibColNdx,1) <> ' ' THEN BREAK.! Break on non-space
ibColNdx -= 1 ! Decrement column index
. ! End loop
LOOP WHILE (ibColNdx > 0) ! Loop
IF SUB(tTable,ibColNdx,1) = ' ' THEN BREAK. ! Break on space
ibColNdx -= 1 ! Decrement column index
. ! End loop
ibColNdx += 1 ! Adjust column index
!──────────────────────────────────────────────────────────────────────────
Word_Right ROUTINE ! Search for next word to right
!──────────────────────────────────────────────────────────────────────────
LOOP WHILE (ibColNdx <= LEN(CLIP(tTable))) ! Loop
IF SUB(tTable,ibColNdx,1) = ' ' THEN BREAK. ! Break on space
ibColNdx += 1 ! Increment column index
. ! End loop
LOOP WHILE (ibColNdx <= LEN(CLIP(tTable))) ! Loop
IF SUB(tTable,ibColNdx,1) <> ' ' THEN BREAK.! Break on non-space
ibColNdx += 1 ! Increment column index
. ! End loop
!*************************************************************************
! Block Operation Routines
!*************************************************************************
!──────────────────────────────────────────────────────────────────────────
Block_Mark ROUTINE ! Toggle block marking on/off
!──────────────────────────────────────────────────────────────────────────
IF NOT bbMarking ! If not in marking mode
ilMarkBegRow = ilRowTop + ibRow ! Set block start
ibMarkBegCol = ibCol !
ilMarkEndRow = ilMarkBegRow ! Set block end
ibMarkEndCol = ibMarkBegCol !
bbMarking = 1 ! Turn marking mode on
ELSE ! Else
bbMarking = 0 ! Turn marking mode off
. ! Endif
!──────────────────────────────────────────────────────────────────────────
Block_Unmark ROUTINE ! Unmark any marked blocks
!──────────────────────────────────────────────────────────────────────────
bbMarking = 0 ! Turn marking off
ilMarkBegRow = 0 ! Clear mark locations
ibMarkBegCol = 0 !
ilMarkEndRow = 0 !
ibMarkEndCol = 0 !
DO Show_Page ! Refresh screen
!──────────────────────────────────────────────────────────────────────────
Block_Delete ROUTINE ! Delete marked block
!──────────────────────────────────────────────────────────────────────────
IF NOT ilMarkBegRow THEN EXIT. ! Exit if nothing marked
bbModified = 1 ! Set modified flag
DO CutBlock ! Delete block
IF INRANGE(ilMarkBegRow,ilRowTop+1,ilRowTop+ibMaxRows)
ibRow = ilMarkBegRow - ilRowTop ! Update cursor position
ibCol = ibMarkBegCol !
. !
DO Block_Unmark ! Unmark the block
DO BackFill ! Backfill empty space
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Block_Copy ROUTINE ! Copy marked block to cursor location
!──────────────────────────────────────────────────────────────────────────
IF NOT ilMarkBegRow THEN EXIT. ! Exit if nothing marked
ilAbsTarget = 255 * (ilRowTop+ibRow) + ibCol ! Calculate absolute locations
ilAbsMrkBeg = 255 * ilMarkBegRow + ibMarkBegCol!
ilAbsMrkEnd = 255 * ilMarkEndRow + ibMarkEndCol!
IF INRANGE(ilAbsTarget,ilAbsMrkBeg,ilAbsMrkEnd)! If target in middle of block
! Not implemented ! Can't do that!
EXIT ! Exit
. ! Endif
bbModified = 1 ! Set modified flag
DO CopyToHold ! Copy marked block to hold
DO CopyFromHold ! Copy hold to cursor pos.
DO Block_Unmark ! Unmark the block
IF ~noReform THEN DO Reformat. ! Reformat (new b.g.)
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Block_Move ROUTINE ! Move marked block to cursor location
!──────────────────────────────────────────────────────────────────────────
IF NOT ilMarkBegRow THEN EXIT. ! Exit if nothing marked
ilAbsTarget = 255 * (ilRowTop+ibRow) + ibCol ! Calculate absolute locations
ilAbsMrkBeg = 255 * ilMarkBegRow + ibMarkBegCol!
ilAbsMrkEnd = 255 * ilMarkEndRow + ibMarkEndCol!
IF ilAbsTarget < ilAbsMrkBeg ! If target before block
DO CopyToHold ! Copy marked block to hold
DO CutBlock ! Delete the block
DO CopyFromHold ! Copy hold to cursor pos.
DO Block_Unmark ! Unmark the block
bbModified = 1 ! Set modified flag
ELSIF ilAbsTarget > ilAbsMrkEnd ! Else if target after block
DO CopyToHold ! Copy marked block to hold
DO CopyFromHold ! Copy hold to cursor pos.
DO CutBlock ! Delete the block
DO Block_Unmark ! Unmark the block
bbModified = 1 ! Set modified flag
ELSE ! Else target is inside block
! Not implemented ! Can't do that!
. ! Endif
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
CopyToHold ROUTINE ! Copy the marked block to the hold area
!──────────────────────────────────────────────────────────────────────────
IF NOT ilMarkBegRow THEN EXIT. ! Exit if nothing marked
FREE(tHold) ! Clear hold area
GET(tTable,ilMarkBegRow) ! Get first marked line
IF ilMarkBegRow = ilMarkEndRow ! If only one line marked
tHold = SUB(tTable,ibMarkBegCol,ibMarkEndCol-ibMarkBegCol+1)
ELSE ! Else
tHold = SUB(tTable,ibMarkBegCol,255) ! Get mark to EOL
. ! Endif
ADD(tHold) ! Copy to hold area
LOOP ilTblNdx = ilMarkBegRow+1 TO ilMarkEndRow-1! Loop thru fully marked lines
GET(tTable,ilTblNdx) ! Get line
tHold = tTable ! Copy to hold area
ADD(tHold) !
. ! End loop
IF ilMarkBegRow <> ilMarkEndRow ! If more than one line marked
GET(tTable,ilMarkEndRow) ! Get last marked line
tHold = SUB(tTable,1,ibMarkEndCol) ! Isolate marked section
ADD(tHold) ! Copy to hold area
. !
!──────────────────────────────────────────────────────────────────────────
CopyFromHold ROUTINE ! Copy hold area to current cursor position
!──────────────────────────────────────────────────────────────────────────
IF RECORDS(tHold) = 0 THEN EXIT. ! Exit if hold is empty
ilTblNdx = ilRowTop + ibRow ! Get current line index
GET(tHold,1) ! Get first hold line
GET(tTable,ilTblNdx) ! Get current line
sTemp = SUB(tTable,ibCol,255) ! Save portion past cursor
tTable = SUB(tTable,1,ibCol-1) & tHold ! Insert hold at cursor
PUT(tTable) ! Update line
LOOP ilHoldNdx = 2 TO RECORDS(tHold)-1 ! Loop for each hold line
GET(tHold,ilHoldNdx) ! Get hold line
tTable = tHold ! Add to line table
ilTblNdx += 1 ! Increment table index
ADD(tTable,ilTblNdx) !
. ! End loop
IF RECORDS(tHold) = 1 ! If only one line in hold
GET(tTable,ilTblNdx) ! Get displayed line
tTable = CLIP(tTable) & sTemp ! Join line and saved sect.
PUT(tTable) ! Update line table
ELSE ! Else
GET(tHold,RECORDS(tHold)) ! Get last hold line
tTable = CLIP(tHold) & sTemp ! Join hold and saved sect.
ilTblNdx += 1 ! Increment table index
ADD(tTable,ilTblNdx) ! Add to line table
. ! End if
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
CutBlock ROUTINE ! Cut marked block
!──────────────────────────────────────────────────────────────────────────
GET(tTable,ilMarkEndRow) ! Get last marked line
sTemp = SUB(tTable,ibMarkEndCol+1,255) ! Isolate unmarked section
GET(tTable,ilMarkBegRow) ! Get first marked line
tTable = SUB(tTable,1,ibMarkBegCol-1) & sTemp ! Join unmarked sections
PUT(tTable) ! Update line
LOOP ilTblNdx = ilMarkBegRow+1 TO ilMarkEndRow ! Loop for each marked row
GET(tTable,ilMarkBegRow+1) ! Get line
IF ERRORCODE() THEN CYCLE. ! Ignore if not found
DELETE(tTable) ! Delete line
. ! End loop
!*************************************************************************
! Display Routines
!*************************************************************************
!──────────────────────────────────────────────────────────────────────────
Show_Page ROUTINE ! Redisplay entire page
!──────────────────────────────────────────────────────────────────────────
ibLineNdx = ibRow ! Save current row
LOOP ibRow = 1 TO ibMaxRows ! Loop thru each row
GET(tTable,ilRowTop+ibRow) ! Get line from table
IF ERRORCODE() THEN CLEAR(tTable). ! Clear if not found
DO Show_Line ! Display line
. ! End loop
ibRow = ibLineNdx ! Restore current row
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Show_Partial ROUTINE ! Redisplay page from current cursor position
!──────────────────────────────────────────────────────────────────────────
ibLineNdx = ibRow ! Save current row
LOOP ibRow = ibLineNdx TO ibMaxRows ! Loop thru each row
GET(tTable,ilRowTop+ibRow) ! Get line from table
IF ERRORCODE() THEN CLEAR(tTable). ! Clear if not found
DO Show_Line ! Display line
. ! End loop
ibRow = ibLineNdx ! Restore current row
DO SetRowCol ! Row/Col Disp (new b.g.)
!──────────────────────────────────────────────────────────────────────────
Show_Line ROUTINE ! Display line, including block marks
!──────────────────────────────────────────────────────────────────────────
! xLine = tTable ! (new b.g.)
SETHUE(oHueFG,oHueBG) ! (new b.g.)
SHOW(ibRowOfs+ibrow,ibColOfs+1,tTable,@s76) ! (new b.g.)
SETHUE
IF ilMarkBegRow = 0 THEN EXIT. ! (new b.g.)
IF ilMarkEndRow = 0 THEN EXIT. ! (new b.g.)
IF INRANGE(ilRowTop+ibRow,ilMarkBegRow,ilMarkEndRow)
ibHiCol1 = ibColOfs + 1
ibHiCol2 = ibColOfs + ibMaxCols
IF ilRowTop+ibRow = ilMarkBegRow
ibHiCol1 = ibColOfs + ibMarkBegCol
.
IF ilRowTop+ibRow = ilMarkEndRow
ibHiCol2 = ibColOfs + ibMarkEndCol
.
SETHUE(eMarkedFG,eMarkedBG)
COLOR(ibRowOfs+ibRow,ibHiCol1,1,ibHiCol2-ibHiCol1+1)
SETHUE
.
!──────────────────────────────────────────────────────────────────────────
CursorSize ROUTINE ! Set cursor size
!──────────────────────────────────────────────────────────────────────────
CLEAR(gRegisters) ! Clear group
isAX = 0100H ! Set Cursor Size request
isCX = aCursorSize[1+bbInsertMode] ! Select cursor size
ibInt = 10H ! ROM-BIOS Video Services
Interrupt(gRegisters) ! Call interrupt handler
!*************************************************************************
! Memo Read/Write Routines
!*************************************************************************
!──────────────────────────────────────────────────────────────────────────
LoadMemo ROUTINE ! Load memo field into edit table
!──────────────────────────────────────────────────────────────────────────
FREE(tTable) ! Clear edit table
LOOP ilMemoNdx = ilMemoRows TO 2 BY -1 ! Loop back thru each line
IF xMemo[ilMemoNdx] THEN BREAK. ! Find last non-blank line
. ! End loop
LOOP ilTblNdx = 1 TO ilMemoNdx ! Loop for each line
tTable = xMemo[ilTblNdx] ! Add to edit table
ADD(tTable) !
. ! End loop
!──────────────────────────────────────────────────────────────────────────
SaveMemo ROUTINE ! Save edit table back to memo field
!──────────────────────────────────────────────────────────────────────────
CLEAR(xMemo[]) ! Clear memo field
LOOP ilTblNdx = 1 TO RECORDS(tTable) ! Loop for each record
GET(tTable,ilTblNdx) ! Get table line
xMemo[ilTblNdx] = tTable ! Add to edit table
. ! End loop
!-------------------------------------------------------------------------
SetRowCol ROUTINE ! Set Display Row And Column (new b.g.)
!-------------------------------------------------------------------------
eColumn = ibcol ! Display Column (new b.g.)
eRow = ilRowTop + ibRow ! Display Row (new b.g.)
