Category : BASIC Source Code
Archive   : PBWRITE.ZIP
Filename : PBWRITE.BAS

'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'³ PBWRITE.BAS ³
'³ This subroutine must be included in your program. See PBWDEMO1 - 3 for ³
'³ examples of how to call the PBWRITE text editor subroutine. ³
'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

' *** IBM SPEED DRAFT I
' *** HIGH ASCII GRAF t16
$IF 0

CHANGES TO THIS SUBROUTINE 08/24/93
Vastly improved speed of video writes through an improved inline
assembler video routine. This routine uses a parameter for video
ram address so it does not need to check each time.

Added ^Q-S Search and Replace facility
Added ^G Change Margins facility with margin reformat options
Added ^D Clear all text with save document protection

Added background processing subroutine facility for background
printing or any other background operation the programmer needs.
See the very last support subroutine in PBWRITE.BAS for more
notes on how to implement background processing.

Added TAB key handling, TAB jumps to tab point every 8 spaces.
At startup, a document passed to the routine will be checked for
tabs. If tabs are present, tabs will be expanded. This can take
a few seconds for large documents.

Added Keyboard macro support. Press ^K and then M for MACRO.
The editor will ask you to enter a hot key (ALT+something). Every
keystroke entered from this point is recorded. Press ALT+M to
end recording. Press the hot key (ALT+something) to playback.

CHANGES TO THIS SUBROUTINE 06/12/93
Fixed a major crippling word-wrap error that trashed the document
if word-wrap occured along with windowed scroll.

CHANGES TO THIS SUBROUTINE 04/30/93
Added CTRL-Y Line Delete
Added CTRL-T Word Right Delete
Added CTRL-U Line/Word undelete (up to 32K of deleted history)
Added ^K-B Block Begin, ^K-K Block End (does not highlight, though)
Added ^K-C Block Copy, ^K-Y Block Delete, ^K-V Block Move
Added ^K-R File Insert
Note: File Insert Loads a file into the clipboard. You must
use ^K-C to copy it into the current cursor position.
Added ^K-P will print block if defined, else print entire doc

CHANGES TO THIS SUBROUTINE 03/20/93
Added inline ASM routine VPRINT for direct video writes. Eliminates
need for external OBJ file

CHANGES TO THIS SUBROUTINE 12/18/92
Added Bishop's EXPANDTABS routine to correctly tab docs

Modified ExitCode%: If this var=chr$(13) upon entry, then
chr$(13) becomes an exit key, like ESCAPE, unless the doc
is ZOOMed, in which case it acts like it should. This is
so we can use PBWrite for data field entry, like FrameWork.

CHANGES TO THIS SUBROUTINE - 12/08/93
Activated internal error trap

Backspace was acting like Delete key in first position.

CHANGES TO THIS SUBROUTINE - 11/24/92
Added wordwrap and Margin% parameter

Added ExitCode% to return the scan code of key used to exit
the subroutine - ALT-X, ALT-Q, ESC, F6-F10 or F1

Fixed END key, actually goes to the end of the line, not just
the edge of the window

F3 to load a file - just press enter for a list of files

Added local error handler

F4 or ^K-P will print (that was easy)

THIS FILE: PBWRITE.BAS
AUTHOR: Erik Olson
DESCRIPTION: A collection of subroutines which center around PBWRITE(), which
is a fully functional "word-star" compatible editor subroutine.
PBWRITE edits the contents of a single string, so the largest
size document it can hold is 32K, however, the routine is
completely self-contained and can be called recursively, thus
providing you with a tool for producing multi-window and multi-
document editing. This sub only opens one window for editing,
but as many windows as RAM allows can be opened and maintained
by simply preserving the screen (if desired) and saving the
contents of the string. See the SUBROUTINE header remarks for
more details.

$ENDIF

' *** LINE FEED
DECLARE SUB GETSTRLOC ()
$IF 0
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
ÛßÛ Û Û ÛßÝ ÛßÛ ÛßÛ Û Û ßÛß Û ÛÝÞ Ûßß
ßþÜ Û Û ÛßÛ ÛßÝ Û Û Û Û Û Û ÛÛÛ Ûß
ÛÜÛ ÛÜÛ ÛÜÛ Û Û ÛÜÛ ÛÜÛ Û Û ÝÞÛ ÛÜÜ
ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
PBWRITE() - Open a window and edit
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
Parameters: ED$
A string which contains the entire document being edited. This
document must be an ASCII file with each line ending in a Carriage-
return, Line-feed pair. To get a file from disk, open it as binary
and read the entire file into ED$, like this:

OPEN F$ FOR BINARY AS #1 : GET$ #1, LOF(1), ED$ : CLOSE #1

ED$ cannot be any more than 32K in size. If the file is larger,
you must read it into multiple variables, and perhaps split it
into separate windows, or just load the part being edited, like
some sort of bridge.

TopView%, LeftView%, BottomView%, RightView%
These four integers contain the screen coordinates for the window.
The size of the window can be changed while editing by pressing
the SCROLL-LOCK key. When SCLK is active, the arrows ENLARGE the
window, while SHIFT-ARROW (numbers) shrink the window. If the
size of the window is changed by the user, the new coordinates
are returned in these parameters.

CursorRow%, CursorCol%
These parameters may (or should) start out as 0, unless you are
returning to a document that has been previously loaded and edited.
These integers contain the current cursor position within the
window (not within the document itself) and may be saved on exit
in order to restore the cursor when the user re-enters the document.

Ptr%
This integer should start out as 0 as well, but can be stored and
passed again when returning to a document. Ptr% holds the current
"top of window" position of the document.

Offset%
This integer, like the others, starts as 0 and stores the current
horizontal scroll offset of the window. If a person editing has
arrowed far to the right, causing the window contents to scroll
horizontally, Offset% contains the horizontal "left of window"
position of the document.
Title$

TextAttr%
This is a number from 0-255 which contains the color attribute
(foreground and background) of the text within the window.

BorderAttr%
This is a number from 0-255 which contains the color attribute
(foreground and background) of the window border, title, and
some of the pop-up windows and prompts.

Margin%
This is any reasonable number which represents the right margin
of the document. Set this to 0 to disable wordwrap

ExitCode%
This contains the scan code of the key used to exit the routine
ALT + anything, F5-F12. If ExitCode% = 256 going into this
routine, PBWRITE will draw the window and the text in it, but
immediately exit with an exit code of 256. This is so you
can call all of your windows the first time around just to
get them onto the screen. From that point on, calling PBWRITE
with exitcode%=0 will actually allow you to edit it.


STATUS ON EXIT
ED$ will contain the current document and the remaining parameters
will retain the current status if editing. If you call PBWRITE
with these parameters again, the user will find himself right
where he left off in the document. If you call PBWRITE with
another set of parameters, alternate documents can be edited
without disturbing eachother. In this fashion, you could write
a multiple-window editor very easily. PBWRITE can also be called
recursively, that is, from within itself, to temporarily edit
another document, or even temporarily edit another PART of the
current document.

THROW AWAY VARIABLES
VideoRAM&............long integer which stores the screen segment
O$...................saved screen
I%, C%, N%, S%.......Keyboard shift states (INS CAPS NUM SCLK)
FL$() ...............Array to contain the file list
Zoom% ...............True if window is currently zoomed.
Exit13% .............Exits on if this is True%
Character% ..........Current character offset from start
$ENDIF

%PBWFALSE=0
%PBWTRUE=NOT %PBWFALSE

SUB PBWRITE(ED$,TopView%,LeftView%,BottomView%,RightView%,CursorRow%,CursorCol%,_
Ptr%,Offset%,Title$, TextAttr%, BorderAttr%, Margin%, ExitCode%)
SHARED Macro%,KBuffer$,Macro$
ON LOCAL ERROR GOTO PBWriteError
IF ED$="" THEN ED$=" " + chr$(13)+chr$(10)
IF INSTR(ED$, CHR$(9)) THEN ExpandTabs ED$ ' expand tabs if they exist
REG 1, 15*256
CALL INTERRUPT &H10
IF Reg(1) - (Reg(1)\256) * 256 = 7 THEN VideoRAM&=&HB000 else VideoRAM&=&HB800
DIM Fl$(500) ' for loading the directory


IF CursorRow% < TopView% THEN CursorRow% = TopView%
IF CursorRow% > BottomView% THEN CursorRow% = BottomView%
'Make sure the cursor is within the effective window
IF CursorCol% < LeftView% THEN CursorCol% = LeftView%
IF CursorCol% > RightView% THEN CursorCol% = RightView%

' establish keyboard shift states
REG 1,&h1200
CALL INTERRUPT &h16
b=ABS(REG(1))

IF (b AND 16) = 16 THEN S1% = 1 ELSE S1% = 0
IF (b and 32) = 32 THEN N1% = 1 ELSE N1%= 0
IF (b and 64) = 64 THEN C1% = 1 ELSE C1%= 0
IF (b and 128)=128 THEN I1% = 1 ELSE I1%= 0

' Setting an exitcode on entry will cause the window and text to draw,
' but immediately exit. This way, we can pop the window onto the screen
' without having to go into it.


' save the screen before drawing the frame so we can 'lift' the frame
' or move it around, or re-size it using the scroll lock key

O$=SaveScreen$
OrgTopView%=TopView%
OrgLeftView%=LeftView%
OrgRightView%=RightView%
OrgBottomView%=BottomView%

RedrawAndExit:
WideNess%=RightView%-LeftView%
Call PBWriteBox(TopView%-1, LeftView%-1, BottomView%+1, RightView%, BorderAttr%,VideoRAM&)
IF WideNess% > 20 THEN
IF Zoom% THEN a%= 25:b%=1 ELSE a%=BottomView%+1: b%=LeftView%+3
IF I1% THEN Stat$= "(Ins)" ELSE Stat$= "(Ovr)"
IF C1% THEN Stat$=Stat$+ "(Caps)" ELSE Stat$=Stat$+ "(Norm)"
IF N1% THEN Stat$=Stat$+ "(Num)" ELSE Stat$=Stat$+ "(Pad)"
IF S1% THEN Stat$=Stat$+ "(ScLk)" ELSE Stat$=Stat$+"(Edit)"
CALL VPRINT(a%,b%,Stat$,BorderAttr%,VideoRAM&)
END IF
If len(Title$) THEN CALL VPRINT(TopView%-1, LeftView%+1,"["+Title$+"]",BorderAttr%,VideoRAM&)
' starting byte for view (1 is top of file)
If Ptr%=0 then Ptr%=1

' Draw the screen
DO
TempPtr% = Ptr% : Temp% = TopView% : LastLine%=0
IF Right$(ED$,2)<>CHR$(13)+CHR$(10) THEN ED$=ED$+CHR$(13)+CHR$(10)
DO
eol% = Instr(Mid$(ED$,TempPtr%),Chr$(13))
if eol%=0 then
eol%=LEN(ED$)
if LastLine%=0 THEN LastLine%=Temp%-1
If CursorCol% > LeftView%+LenEditLine% THEN CursorCol%=LeftView%+LenEditLine%
If CursorRow% > LastLine% THEN CursorRow%=LastLine%
ELSE
DECR eol% ' DECR: do not show the CR
END IF
Curr$ = Mid$(ED$, TempPtr%,eol%):if Curr$=chr$(10) then Curr$=""
IF Temp%=CursorRow% THEN LenEditLine%=LEN(Curr$):EditPtr%=TempPtr%:EditEol%=TempPtr% + eol%
CALL VPRINT(Temp%, LeftView%, Mid$(Curr$+Space$(WideNess%+Offset%), 1+Offset%,WideNess%), TextAttr%,VideoRAM&)
TempPtr% = Instr(TempPtr%, ED$, Chr$(13)) + 2 ' +2 for CRLF pair
If TempPtr%=2 Then TempPtr%=LEN(ED$)
INCR Temp%
if Temp% > BottomView% THEN Exit LOOP
LOOP
IF RedrawPatch% THEN EXIT LOOP ' If redrawing on exit after forced UNZOOM
IF ExitCode% = 256 THEN EXIT LOOP ' if touch and go drawing
IF ExitCode% = 13 THEN Exit13%=%PBWTRUE:ExitCode%=0 ' exit on

'....................make sure the cursor is not beyond the end of a line
'If CursorCol% > LeftView%+LenEditLine% THEN CursorCol%=LeftView%+LenEditLine%
'If CursorRow% > LastLine% THEN CursorRow%=LastLine%

LOCATE CursorRow%,CursorCol%, 1 ' keep a visible cursor always

KB$ = "" ' KB$ will contain the next keystroke

WHILE KB$ = ""

' Call a possible multitasker

CALL TASK.MANAGER

' check for change in keyboard shift states
REG 1,&h1200
CALL INTERRUPT &h16
b=ABS(REG(1))

IF (b AND 16) = 16 THEN S2% = 1 ELSE S2% = 0
IF (b and 32) = 32 THEN N2% = 1 ELSE N2%= 0
IF (b and 64) = 64 THEN C2% = 1 ELSE C2%= 0
IF (b and 128)=128 THEN I2% = 1 ELSE I2%= 0


' if shift states have changed then update the status indicators
IF C2% <> C1% or N2% <> N1% or I2% <> I1% or S2% <> S1% THEN
REG 1,&h1200
CALL INTERRUPT &h16
b=ABS(REG(1))

IF (b AND 16) = 16 THEN S1% = 1 ELSE S1% = 0
IF (b and 32) = 32 THEN N1% = 1 ELSE N1%= 0
IF (b and 64) = 64 THEN C1% = 1 ELSE C1%= 0
IF (b and 128)=128 THEN I1% = 1 ELSE I1%= 0
IF WideNess% > 20 THEN
IF Zoom% THEN a%= 25:b%=1 ELSE a%=BottomView%+1: b%=LeftView%+3
IF I1% THEN Stat$= "(Ins)" ELSE Stat$= "(Ovr)"
IF C1% THEN Stat$=Stat$+ "(Caps)" ELSE Stat$=Stat$+ "(Norm)"
IF N1% THEN Stat$=Stat$+ "(Num)" ELSE Stat$=Stat$+ "(Pad)"
IF S1% THEN Stat$=Stat$+ "(ScLk)" ELSE Stat$=Stat$+"(Edit)"
CALL VPRINT(a%,b%,Stat$,BorderAttr%,VideoRAM&)
END IF
If len(Title$) THEN CALL VPRINT(TopView%-1, LeftView%+1,"["+Title$+"]",BorderAttr%,VideoRAM&)
LOCATE CursorRow%,CursorCol%, 1
END IF

KB$ = IN.KEY$ : WEND

SELECT CASE KB$

CASE CHR$(9)

Tabs%=8-(Offset%+(CursorCol%-LeftView%) MOD 8)
Keyin SPACE$(Tabs%)

CASE CHR$(32) TO CHR$(126) ' normal allowable document keys

NoSave%=-1 ' not saved
'........................the position of the char within ED$
Character%=EditPtr%+Offset%+(CursorCol%-LeftView%)

'........................add extra spaces if beyond endofline
If Offset%+(CursorCol%-LeftView%)>LENEditLine% THEN_
ED$=LEFT$(ED$,Character%-1)+SPACE$((Offset%+(CursorCol%-LeftView%))-LENEditLine%)+MID$(ED$,Character%)

'........................add extra spaces is beyond endoffile
'IF Character%>LEN(ED$) THEN ED$=ED$+SPACE$(LEN(ED$)-Character%)


' INSERT OR OVERTYPE THE CHARACTER

IF I1% THEN ' Insert mode inserts character
ED$=LEFT$(ED$,Character%-1) + KB$ + MID$(ED$,Character%)
ELSE
' If we are at the end of a line, we must
' pretend the insert is on
if MID$(ED$,Character%,1)=CHR$(13) THEN
ED$=LEFT$(ED$,Character%-1) + KB$ + MID$(ED$,Character%)
ELSE
MID$(ED$,Character%,1)=KB$ ' overtype mode changes char
END IF ' if it's a carriage return or not

END IF ' if insert is on or not

' ..............WRAP TEXT IF NECESSARY ' ** WORDWRAP
IF (CursorCol%-LeftView%)+Offset% > Margin% and Margin% > 0 THEN
n% = Character% ' ** WORDWRAP
newcursorcol% = 0 ' ** WORDWRAP
DO ' ** WORDWRAP
Check$ = MID$(ED$,n%,1) ' ** WORDWRAP
if CHECK$ = CHR$(10) OR n% = 1 THEN ' ** WORDWRAP
' abort wrap, just go to the next line
CursorCol%=LeftView% ' ** WORDWRAP
Offset%=0 ' ** WORDWRAP
INCR CursorRow% ' ** WORDWRAP
EXIT LOOP ' ** WORDWRAP

END IF
' ** WORDWRAP
IF Check$ = " " THEN ' ** WORDWRAP
'WRAP HERE! ' ** WORDWRAP
ED$=LEFT$(ED$,n%-1)+CHR$(13)+CHR$(10)+MID$(ED$,n%+1)
Cursorcol% = NewCursorCol%+LeftView%
Offset% = 0
''''' bug fix 6/12/93
CursorCol%=LeftView%
IF Offset%>0 THEN GOSUB GOHOME
Offset%=0
CursorCol%=NewCursorCol%+LeftView%
IF CursorRow% < BottomView% THEN
INCR CursorRow%
ELSE
GOSUB GODOWN
END IF
''''' end bug fix -- also iterate loop instead of gosub redraw below
EXIT LOOP ' ** WORDWRAP
END IF ' ** WORDWRAP
DECR n% ' ** WORDWRAP
INCR NewCursorCol% ' ** WORDWRAP
LOOP ' ** WORDWRAP
ITERATE LOOP
'GOSUB REDRAW ' ** WORDWRAP

END IF ' time to wrap ' ** WORDWRAP


'................NOW ADJUST THE CURSOR POSITION

IF CursorCol% < RightView%-1 THEN
INCR CursorCol%
ELSE
GOSUB GORIGHT
END IF

CASE CHR$(13)
IF Exit13% AND NOT Zoom% THEN ExitCode%=13:EXIT SELECT

''IF I1% THEN ' insert mode inserts carriage return + line feed
Character%=EditPtr%+Offset%+(CursorCol%-LeftView%)
ED$=LEFT$(ED$,Character%-1) + CHR$(13)+CHR$(10) + MID$(ED$,Character%)
''END IF
CursorCol%=LeftView%
IF Offset%>0 THEN GOSUB GOHOME
Offset%=0
IF CursorRow% < BottomView% THEN
INCR CursorRow%
ELSE

GOSUB GODOWN
END IF


CASE CHR$(8)

IF Character% > 2 and Offset% = 0 AND CursorCol%=LeftView% THEN BFlag%=%PBWTRUE

IF CursorCol% > LeftView% THEN
DECR CursorCol%
ELSE
GOSUB GOLEFT
END IF
Character%=EditPtr%+Offset%+(CursorCol%-LeftView%)


IF Bflag% THEN
BFlag% = %PBWFALSE
' This is where we want to delete and join up
' with the line above. Hmmmm....

'ED$=LEFT$(ED$,Character%-2)+Mid$(ED$,Character%+1)
ELSE
IF LEN(ED$) AND MID$(ED$,Character%,1)<>CHR$(13) AND _
Mid$(ED$,Character%,1)<>CHR$(10) THEN_
ED$=LEFT$(ED$,Character%-1)+Mid$(ED$,Character%+1)
END IF

CASE CHR$(0,&H53) ' del
Character%=EditPtr%+Offset%+(CursorCol%-LeftView%)
IF LEN(ED$) THEN
IF MID$(ED$,Character%,1)=CHR$(13) THEN
ED$=LEFT$(ED$,Character%-1)+MID$(ED$,Character%+2)
ELSE
ED$=LEFT$(ED$,Character%-1)+MID$(ED$,Character%+1)
END IF
END IF

CASE CHR$(11) ' Control - K
Temp$=SaveScreen$
IF WideNess% > 30 THEN CALL VPRINT(TopView%-1, RightView%-14, "^K-BCDKNPQRSWM", BorderAttr%,VideoRAM&)
Sound 1500,.5:Sound 2000,.5:Sound 2500,.5
DO : KK$ = IN.KEY$ : LOOP WHILE KK$=""
CALL RestoreScreen(Temp$)
KK$=UCASE$(KK$) ' **WORDSTAR**
SELECT CASE KK$
CASE "B" ' mark block begin ' **WORDSTAR**
BlockStart%=EditPtr%+Offset%+(CursorCol%-LeftView%)
IF BlockEnd%>BlockStart% THEN
SOUND 2500,.5:SOUND 3000,.5:SOUND 3500,.5
BLOCK$=MID$(ED$,BlockStart%,BlockEnd%-BlockStart%)
END IF

CASE "K" ' mark block end ' **WORDSTAR**
BlockEnd%=EditPtr%+Offset%+(CursorCol%-LeftView%)
IF BlockEnd%>BlockStart% THEN
SOUND 2500,.5:SOUND 3000,.5:SOUND 3500,.5
BLOCK$=MID$(ED$,BlockStart%,BlockEnd%-BlockStart%)
END IF
CASE "T" ' mark single word ' **WORDSTAR**
CASE "C" ' copy block ' **WORDSTAR**
IF LEN(BLOCK$) THEN
Character%=EditPtr%+Offset%+(CursorCol%-LeftView%)
ED$=LEFT$(ED$,Character%-1) + BLOCK$ + MID$(ED$,Character%)
BlockStart%=Character%:BlockEnd%=Character%+LEN(Block$)
END IF
CASE "V" ' move block ' **WORDSTAR**
IF LEN(BLOCK$) THEN
Character%=EditPtr%+Offset%+(CursorCol%-LeftView%)
' if cursor is before block then delete block first,
' then insert
IF Character% < BlockStart% THEN
ED$=LEFT$(ED$,BlockStart%-1) + MID$(ED$,BlockEnd%)
ED$=LEFT$(ED$,Character%-1) + BLOCK$ + MID$(ED$,Character%)
BlockStart%=Character%:BlockEnd%=Character%+LEN(Block$)
' otherwise if character is after block then insert
' block first then delete it.
ELSEIF Character% > BlockEnd% THEN
ED$=LEFT$(ED$,Character%-1) + BLOCK$ + MID$(ED$,Character%)
ED$=LEFT$(ED$,BlockStart%-1) + MID$(ED$,BlockEnd%)
BlockStart%=Character%:BlockEnd%=Character%+LEN(Block$)
END IF
END IF
CASE "Y" ' delete block ' **WORDSTAR**
ED$=LEFT$(ED$,BlockStart%-1) + MID$(ED$,BlockEnd%)
IF ED$="" THEN ED$=CHR$(13)+CHR$(10)
CASE "R" ' read block from file ' **WORDSTAR**
INF%=1
GOSUB INSERTFILE
CASE "W" ' write block to disk ' **WORDSTAR**
GOSUB SAVEAS
CASE "H" ' hide/display block ' **WORDSTAR**
CASE "P" ' print block ' **WORDSTAR**
IF BLOCK$="" THEN GOSUB PRINTALL ELSE _
LPRINT BLOCK$

CASE "D" ' save and exit ' **WORDSTAR**
GOSUB QUITSAVE
CASE "S" ' save ' **WORDSTAR**
GOSUB SAVE
CASE "Q" ' quit without saving ' **WORDSTAR**
ExitCode% = 27
CASE "N" ' set place marker ' **WORDSTAR**
CASE "M" ' Start Macro
LOCATE ,,0
IF Macro% THEN
Sound 3000,1:SOUND 2000,1:SOUND 1000,1
MESSAGE "PRESS ALT-M TO STOP RECORDING"
DELAY 1
RESTORESCREEN Temp$
ELSE
MESSAGE "Press ALT+key for Macro Record"
DO:M$=INKEY$:LOOP WHILE M$=""
RESTORESCREEN TEMP$
IF M$=CHR$(27) THEN EXIT SELECT
IF LEN(M$)=2 AND M$<>CHR$(0,50) THEN
Macro$=Macro$+CHR$(13,10)+"MACRO:"+M$
Macro%=-1
MESSAGE "BEGIN RECORDING. PRESS ALT-M TO FINISH"
Sound 1000,1:SOUND 2000,1:SOUND 3000,1
DELAY 2
ELSE
SOUND 50,1
MESSAGE "CANNOT USE THAT KEY"
DELAY 2
END IF
RESTORESCREEN TEMP$
END IF
CASE ELSE
END SELECT
Temp$=""
CASE CHR$(17) ' Control - Q
Temp$=SaveScreen$
IF Wideness% > 30 THEN CALL VPRINT(TopView%-1, RightView%-18, "^Q-SDEXRCBKPWLFAV", BorderAttr%,VideoRAM&)
Sound 1500,.5:Sound 2000,.5:Sound 2500,.5
DO : QQ$ = IN.KEY$ : LOOP WHILE QQ$=""
CALL RestoreScreen(Temp$)
SELECT CASE UCASE$(QQ$)
' Some of these we are going to ignore because
' they are pretty much useless.
'''CASE "S" 'move to beginning of line
' Use HOME and END instead
'''CASE "D" 'end of line ' **WORDSTAR**
'''CASE "E" 'top of window ' **WORDSTAR**
'''CASE "X" 'bottom of window ' **WORDSTAR**
'''CASE "R" 'top of file ' **WORDSTAR**
'''CASE "C" 'end of file ' **WORDSTAR**
CASE "B" 'beginning of block ' **WORDSTAR**
CASE "K" 'end of block ' **WORDSTAR**
CASE "P" 'last cursor position ' **WORDSTAR**
CASE "W" 'restore error message ' **WORDSTAR**
CASE "L" 'restore line ' **WORDSTAR**
CASE "F" 'search ' **WORDSTAR**
CASE "A" 'search and replace ' **WORDSTAR**
MESSAGE "SEARCH FOR ..."
SRCH$=PBWRITEEDITBOX$(SRCH$+SPACE$(25-LEN(SRCH$)),TextAttr%,BorderAttr%,VideoRAM&)
IF SRCH$="" THEN EXIT SELECT
MESSAGE "REPLACE WITH ..."
RPLC$=PBWRITEEDITBOX$(RPLC$+SPACE$(25-LEN(RPLC$)),TextAttr%,BorderAttr%,VideoRAM&)
IF RPLC$="" THEN EXIT SELECT
REPLACE SRCH$ WITH RPLC$ IN ED$
CASE "V" 'last cursor position ' **WORDSTAR**
CASE ELSE
END SELECT
RESTORESCREEN Temp$:Temp$=""
CASE CHR$(20) ' CTRL-T ' ** WORDSTAR**
' get current line, add to a string /1/2/3/4
Character%=EditPtr%+Offset%+(CursorCol%-LeftView%)
Temp%=(INSTR(Character%+1,ED$,ANY CHR$(32,10))+1)-Character%
SAVELINE$=MID$(ED$,Character%,temp%)+CHR$(1)+SAVELINE$
ED$=LEFT$(ED$,Character%-1) + MID$(ED$,Character%+Temp%)
IF ED$="" THEN ED$=CHR$(13)+CHR$(10)


CASE CHR$(25) ' CTRL-Y ' **WORDSTAR**
' get current line, add to a string /1/2/3/4
SAVELINE$=MID$(ED$,EditPtr%,EditEol%-EditPtr%)+CHR$(13)+CHR$(10)+CHR$(1)+SAVELINE$
ED$=LEFT$(ED$,EditPtr%-1) + MID$(ED$,EditEol%+2)
IF ED$="" THEN ED$=CHR$(13)+CHR$(10)

CASE CHR$(21) ' CTRL-U ' **WORDSTAR**
' restore leftmost line in /1/2/3/4
IF LEN(SAVELINE$) THEN
TEMP$=EXTRACT$(SAVELINE$,CHR$(1))
IF SAVELINE$=TEMP$+CHR$(1) THEN SAVELINE$="" ELSE _
SAVELINE$=MID$(SAVELINE$,INSTR(SAVELINE$,CHR$(1))+1)
Character%=EditPtr%+Offset%+(CursorCol%-LeftView%)
ED$=LEFT$(ED$,Character%-1) + TEMP$ + MID$(ED$,Character%)
END IF

CASE CHR$(4) ' CTRL-D ... Erase document in memory
GOSUB CLEARALL

CASE CHR$(7) ' CTRL-G ... Change Margin%
Temp$=SAVESCREEN$
ChangeMargin:
MESSAGE "CHANGE MARGIN TO ..."
Margin$=STR$(Margin%)+" "
Margin$=PBWRITEEDITBOX$(Margin$,TextAttr%,BorderAttr%,VideoRAM&)
IF VAL(Margin$)<15 and VAL(Margin$) > 4096 THEN
SOUND 50,2
MESSAGE "BE REASONABLE"
DELAY 2
Restorescreen Temp$
GOTO ChangeMargin
END IF
IF Margin$<>"" THEN
Margin%=VAL(Margin$)
REDIM Temp$(5)
Temp$(1)="reformat on double carriage return"
Temp$(2)="reformat, preserve carriage returns"
Temp$(3)="continue with new margin, no change"
SELECT CASE POPMENU(Temp$())
CASE 1
REPLACE CHR$(13,10,13,10) WITH CHR$(13,13) IN ED$
REPLACE CHR$(32,13,10) WITH " " IN ED$
REPLACE CHR$(13,10) WITH " " IN ED$
KEYIN ED$
ED$=CrLf$
Ptr%=1:Offset%=0:CursorRow%=0:CursorCol%=0
IF CursorRow% < TopView% THEN CursorRow% = TopView%
IF CursorRow% > BottomView% THEN CursorRow% = BottomView%
IF CursorCol% < LeftView% THEN CursorCol% = LeftView%
IF CursorCol% > RightView% THEN CursorCol% = RightView%

CASE 2
REPLACE CHR$(13,10) WITH CHR$(13) IN ED$
KEYIN ED$
ED$=CrLf$
Ptr%=1:Offset%=0:CursorRow%=0:CursorCol%=0
IF CursorRow% < TopView% THEN CursorRow% = TopView%
IF CursorRow% > BottomView% THEN CursorRow% = BottomView%
IF CursorCol% < LeftView% THEN CursorCol% = LeftView%
IF CursorCol% > RightView% THEN CursorCol% = RightView%
CASE 3
END SELECT
END IF
RESTORESCREEN Temp$:Temp$=""


CASE CHR$(0,59) ' F1
ExitCode%=59 ' exit for help? <--------------+
CASE CHR$(0,60) ' F2 |
GOSUB SAVE ' F2 = save |
CASE CHR$(0,61) ' F3 |
GOSUB LOADNEW ' F3 = load new |
CASE CHR$(0,62) ' F4 |
GOSUB PRINTALL ' F4 = Print |
' F5 - zoom (handled elsewhere) |

CASE CHR$(0,64) ' F6 '\ |
ExitCode% = 64 ' \ |
CASE CHR$(0,65) ' F7 ' \ |
ExitCode% = 65 ' \ |
CASE CHR$(0,66) ' F8 ' \ V
ExitCode% = 66 ' \
CASE CHR$(0,67) ' F9 ' \
ExitCode% = 67 ' \
CASE CHR$(0,68) ' F10 ' Keys that make you exit
ExitCode% = 68 ' /
' /
CASE CHR$(27) ' ESC exit ' /
ExitCode%=27 ' /
' /
CASE CHR$(0,16) ' ALT-Q ' /
ExitCode%=16 ' /
'
CASE CHR$(0,45) ' ALT-X '
ExitCode%=45 '

CASE CHR$(0,&H50) 'dn arrow ' ** NAVIGATION **
IF CursorRow% < BottomView% THEN
INCR CursorRow%
ELSE
GOSUB GODOWN
END IF

CASE CHR$(0,&H48) 'up arrow ' ** NAVIGATION **
IF CursorRow% > TopView% THEN
DECR CursorRow%
ELSE
GOSUB GOUP
END IF

CASE CHR$(0,&H4F) ' end ' ** NAVIGATION **
CursorCol% = LeftView%+LenEditLine%+1
IF CursorCol% > RightView% THEN CursorCol% = RightView%-1:_
Offset%=(LenEditLine%-RightView%)+LeftView%+1

CASE CHR$(0,&H47) 'home ' ** NAVIGATION **
IF CursorCol% > LeftView% or Offset% THEN
Offset% = 0
CursorCol%=LeftView%

ELSE
CursorCol%=LeftView%
CursorRow%=TopView%
Ptr% = 1
END IF

CASE CHR$(0, &H4D) ' right arrow ' ** NAVIGATION **
IF CursorCol% < RightView%-1 THEN
INCR CursorCol%
ELSE
GOSUB GORIGHT
END IF

CASE CHR$(0,&H4B) ' left arrow ' ** NAVIGATION **
IF CursorCol% > LeftView% THEN
DECR CursorCol%
ELSE
GOSUB GOLEFT
END IF

CASE CHR$(0,&H51) ' page down ' ** NAVIGATION **
if LastLine%=0 THEN GOSUB PAGEDOWN

CASE CHR$(0, &H49) ' page up ' ** NAVIGATION **
GOSUB PAGEUP

CASE CHR$(0,63) ' F5 Zoom ' ** ZOOM/UNZOOM **
If Zoom% THEN
Zoom%=0
TopView% = OldTopView%
LeftView% = OldLeftView%
BottomView% = OldBottomView% ' ** ZOOM/UNZOOM **
RightView% = OldRightView%
WideNess%=RightView%-LeftView%
CursorRow% =CursorRow% + (Topview%-2)
CursorCol% =CursorCol% + (LeftView%-1)
IF CursorCol% > RightView% THEN _ ' ** ZOOM/UNZOOM **
OffSet%= CursorCol%-RightView%:_
CursorCol%=RightView%
CALL RestoreScreen(Z$)
DO
IF CursorRow%>BottomView% THEN
GOSUB GODOWN ' ** ZOOM/UNZOOM **
DECR CursorRow%
ELSE
EXIT LOOP
END IF
LOOP
ELSE ' ** ZOOM/UNZOOM **
Zoom%=-1
CursorRow% =CursorRow% - (Topview%-3)
CursorCol% =CursorCol% - (LeftView%-2)
OldTopView%=TopView%
OldLeftView%=LeftView%
OldRightView%=RightView% ' ** ZOOM/UNZOOM **
OldBottomView%=BottomView%

TopView%=2
LeftView%=1
BottomView%=24
RightView%=81 ' ** ZOOM/UNZOOM **
WideNess%=RightView%-LeftView%
CursorRow% =CursorRow% - (Topview%-1)
CursorCol% =CursorCol% - LeftView%
Z$=SaveScreen$
LOCATE 2,1
PRINT Space$(80*23); ' ** ZOOM/UNZOOM **
END IF
CASE ELSE ' ** ZOOM/UNZOOM **
END SELECT

LOOP WHILE ExitCode%=0 ' ** END MAIN CODE

IF RedrawPatch% THEN EXIT SUB

If Zoom% THEN ' ** FORCE UNZOOM ON EXIT
Zoom%=0
TopView% = OldTopView%
LeftView% = OldLeftView%
BottomView% = OldBottomView%
RightView% = OldRightView%
WideNess%=RightView%-LeftView%

CursorRow% =CursorRow% + (Topview%-2)
CursorCol% =CursorCol% + (LeftView%-1)
IF CursorCol% > RightView% THEN _
OffSet%= CursorCol%-RightView%:_
CursorCol%=RightView%
CALL RestoreScreen(Z$)
DO
IF CursorRow%>BottomView% THEN
GOSUB GODOWN
DECR CursorRow%
ELSE
EXIT LOOP
END IF
LOOP
RedrawPatch%=-1:RedrawExit%=-1 ' redraw on UNZOOM/flags exit correctly
GOTO RedrawAndExit
END IF
EXIT SUB

' document animation routines ' ** ANIMATE
GODOWN: 'CASE CHR$(0,&H50) 'dn arrow
IF TempPtr% < LEN(ED$) THEN
Ptr%=Instr(Ptr%, ED$, Chr$(13) ) + 2

ELSE
Sound 100,.1 ' we are at the end
END IF
RETURN
GOUP: 'CASE CHR$(0,&H48) 'up arrow ' ** ANIMATE

IF Ptr% > 1 THEN
' search backwards for a CR or 1
DECR Ptr%:IF Ptr%>1 then DECR Ptr%
DO:DECR Ptr%:LOOP UNTIL Mid$(ED$, Ptr%, 1)=CHR$(13) OR Ptr%=1
IF Ptr%>1 THEN INCR Ptr%:INCR Ptr%
ELSE
Sound 100,.1 ' we are at the beginning
END IF
RETURN ' ** ANIMATE
GOHOME: 'CASE CHR$(0,&H47) 'home
If Offset% THEN Offset% = 0 ELSE Ptr%=1
RETURN
GORIGHT: 'CASE CHR$(0, &H4D) ' right arrow ' ** ANIMATE
INCR Offset%
RETURN
GOLEFT: 'CASE CHR$(0,&H4B) ' left arrow
If Offset% THEN DECR Offset% ' ** ANIMATE
RETURN
PAGEDOWN: 'CASE CHR$(0,&H51) ' page down
FOR pd = TopView% to BottomView%-1 ' ** ANIMATE
OldPtr%=Ptr%
Ptr%=Instr(Ptr%, ED$, Chr$(13) ) + 2
if Ptr%=2 then Ptr%=OldPtr%:Exit FOR
Next Pd
RETURN
PAGEUP: 'CASE CHR$(0, &H49) ' page up ' ** ANIMATE
FOR pd = TopView% to BottomView% -1
IF Ptr% > 1 THEN
' search backwards for a CR or 1
DECR Ptr%:IF Ptr%>1 then DECR Ptr%
DO:DECR Ptr%:LOOP UNTIL Mid$(ED$, Ptr%, 1)=CHR$(13) OR Ptr%=1
IF Ptr%>1 THEN INCR Ptr%:INCR Ptr%
ELSE
EXIT FOR
END IF
NEXT Pd
RETURN

REDRAW:
IF NOT Zoom% THEN Call PBWriteBox(TopView%-1, LeftView%-1, BottomView%+1, RightView%, BorderAttr%,VideoRAM&)
IF CursorRow% < TopView% THEN CursorRow% = TopView%
IF CursorRow% > BottomView% THEN CursorRow% = BottomView%
'Make sure the cursor is within the effective window
IF CursorCol% < LeftView% THEN CursorCol% = LeftView%
IF CursorCol% > RightView% THEN CursorCol% = RightView%
IF WideNess% > 20 THEN
IF Zoom% THEN a%= 25:b%=1 ELSE a%=BottomView%+1: b%=LeftView%+3
IF I1% THEN Stat$= "(Ins)" ELSE Stat$= "(Ovr)"
IF C1% THEN Stat$=Stat$+ "(Caps)" ELSE Stat$=Stat$+ "(Norm)"
IF N1% THEN Stat$=Stat$+ "(Num)" ELSE Stat$=Stat$+ "(Pad)"
IF S1% THEN Stat$=Stat$+ "(ScLk)" ELSE Stat$=Stat$+"(Edit)"
CALL VPRINT(a%,b%,Stat$,BorderAttr%,VideoRAM&)
END IF
If len(Title$) THEN CALL VPRINT(TopView%-1, LeftView%+1,"["+Title$+"]",BorderAttr%,VideoRAM&)

' starting byte for view (1 is top of file)
If Ptr%=0 then Ptr%=1

' Draw the screen
TempPtr% = Ptr% : Temp% = TopView%
DO
eol% = Instr(Mid$(ED$,TempPtr%),Chr$(13))
if eol%=0 then eol%=LEN(ED$) ELSE DECR eol% ' DECR: do not show the CR
IF Eol%=TempPtr% THEN Curr$="" ELSE Curr$ = Mid$(ED$, TempPtr%,eol%)
IF Temp%=CursorRow% THEN EditLine$=Curr$:EditPtr%=TempPtr%
Locate Temp%, LeftView%
CALL VPRINT(Temp%,LeftView%, Mid$(Curr$+Space$(WideNess%+Offset%), 1+Offset%,WideNess%),TextAttr%,VideoRAM&)
TempPtr% = Instr(TempPtr%, ED$, Chr$(13)) + 2 ' +2 for CRLF pair
If TempPtr%=2 Then TempPtr%=LEN(ED$)
INCR Temp%
if Temp% > BottomView% THEN Exit LOOP
LOOP
RETURN


SAVE:
GOSUB SAVEAS
RETURN
SAVEAS:
Temp$=SaveScreen$
d$=Title$+SPACE$(40):d$=LEFT$(d$,40)
Fi$=PBWriteEditBox$(d$,TextAttr%,BorderAttr%,VideoRAM&)
CALL RestoreScreen(Temp$)
Temp$=""

if len(Fi$) and Fi$<> CHR$(27) THEN
fi%=FREEFILE
OPEN Fi$ FOR OUTPUT AS #fi%
PRINT #fi%,ED$;
CLOSE #Fi%
NoSave%=0
Title$=Fi$
END IF
RETURN ' saveas
QUITSAVE:
GOSUB SAVEAS
IF Fi$<>CHR$(27) THEN ExitCode%=1

RETURN ' quitsave
PRINTALL:
O2$=SAVESCREEN$
redim temp$(4)
temp$(1)="LPT1:"
temp$(2)="LPT2:"
temp$(3)="LPT3:"
LPT%=POPMENU(temp$()):IF LPT%=0 THEN GOTO DonePrinting

' You can define one of the exit keys, say F7, as a "mail merge"
' key in which ED$ can be copied to a temporary string and
' then using the REPLACE .. WITH statement mailmerge fields
' can be replaced with memory variables or database fields.

RESTORESCREEN O2$

for i%=1 to len(ED$)
a%=val(mid$(ch$,i%,1))
reg 1, &h00+a
reg 4,LPT%
call Interrupt &h17
pstat%=REG(1)
if (pstat% and 32)= 32 then ERROR 27:EXIT FOR ' "Out of Paper"
if (pstat% and 8)= 8 then ERROR 57:EXIT FOR ' "I/O Error"
if (pstat% and 1)= 1 then ERROR 24:EXIT FOR ' "Printer Time Out"
next i%

DonePrinting:
RESTORESCREEN O2$
SOUND 5000,.5:SOUND 1000,.5


RETURN ' printall

CLEARALL:
IF NoSave% THEN
O2$=SAVESCREEN$
a% = YesOrNo("Save " + Title$, TextAttr%, BorderAttr%, VideoRAM&)
RESTORESCREEN O2$
if A%=1 THEN
GOSUB SAVEAS
IF Fi$=CHR$(27) THEN RETURN
END IF

END IF
if a%<>27 THEN
Title$="NONAME.TXT"
ED$=CrLf$
Ptr%=1:Offset%=0:CursorRow%=0:CursorCol%=0
IF CursorRow% < TopView% THEN CursorRow% = TopView%
IF CursorRow% > BottomView% THEN CursorRow% = BottomView%
'Make sure the cursor is within the effective window
IF CursorCol% < LeftView% THEN CursorCol% = LeftView%
IF CursorCol% > RightView% THEN CursorCol% = RightView%
END IF

Call VPrint (TopView%-1, LeftView%+1,String$(RightView%-LeftView%-1,205),BorderAttr%,VideoRAM&)
CALL VPRINT(TopView%-1, LeftView%+1,"["+Title$+"]",BorderAttr%,VideoRAM&)

RETURN ' Clear all


LOADNEW:
IF NoSave% THEN
O2$=SAVESCREEN$
a% = YesOrNo("Save " + Title$, TextAttr%, BorderAttr%, VideoRAM&)
RESTORESCREEN O2$
if A%=1 THEN
GOSUB SAVEAS
IF Fi$=CHR$(27) THEN RETURN
END IF

END IF
INSERTFILE:
if a%<>27 or INF%=1 THEN
d$=Left$(CurDir$+"\"+Space$(40),40)
'Temp2$=SaveScreen$
O2$=SAVESCREEN$
Fi$=PBWriteEditBox$(D$, TextAttr%,BorderAttr%, VideoRAM&)
RESTORESCREEN O2$
IF Fi$="" or Fi$=chr$(27) THEN RETURN
DO
IF RIGHT$(Fi$,1)="\" OR INSTR(Fi$,"?") OR INSTR(Fi$,"*") OR INSTR(Fi$,"..") THEN
CD$ = Fi$
' get the specified directory
DO UNTIL RIGHT$(CD$,1)="\" OR RIGHT$(CD$,1)=":" OR CD$=""
CD$=LEFT$(CD$,LEN(CD$)-1)
LOOP
REDIM FL$(500)
i% = 1
fl$(i%) = DIR$(Fi$) '............... get directory into an array
DO
INCR i%
FL$(i%) = DIR$
IF i%=499 THEN EXIT LOOP
LOOP WHILE FL$(i%) <> ""

ARRAY SORT fl$() FOR i%

Fi$=FileBox$( Fl$() )
IF INF%=0 THEN Title$=Fi$

ELSE
EXIT LOOP

END IF
LOOP

IF Fi$ <> "" THEN
Fi%=FREEFILE
IF INSTR(Fi$,"\")=0 THEN Fi$=CD$+Fi$
OPEN Fi$ FOR BINARY AS #fi%
IF LOF(Fi%) > 32700 THEN
CLOSE #Fi%
ERROR 700 ' file to big
ELSE
O2$=SAVESCREEN$
MESSAGE "GETTING..."
IF INF%=1 THEN
GET$ Fi%, LOF(Fi%),BLOCK$
INF%=0
CALL ExpandTabs(BLOCK$)
ELSE
GET$ Fi%, LOF(Fi%), ED$
CALL ExpandTabs(ED$)
IF ED$="" THEN ED$=" "+CHR$(13) + CHR$(10)
END IF
RESTORESCREEN O2$
CLOSE #fi%
END IF
END IF
Ptr%=1:Offset%=0:CursorRow%=0:CursorCol%=0
IF CursorRow% < TopView% THEN CursorRow% = TopView%
IF CursorRow% > BottomView% THEN CursorRow% = BottomView%
'Make sure the cursor is within the effective window
IF CursorCol% < LeftView% THEN CursorCol% = LeftView%
IF CursorCol% > RightView% THEN CursorCol% = RightView%
END IF
'Title$ = Fl$(i%)
Call VPrint (TopView%-1, LeftView%+1,String$(RightView%-LeftView%-1,205),BorderAttr%,VideoRAM&)
CALL VPRINT(TopView%-1, LeftView%+1,"["+Title$+"]",BorderAttr%,VideoRAM&)
RETURN ' loadnew

PBWriteError:
O3$=SAVESCREEN$
SELECT CASE ERR
CASE 6
MESSAGE "OVERFLOW"
CASE 7
MESSAGE "OUT OF MEMORY"
CASE 9
MESSAGE "SEGMENT OR STACK EXPIRED"
CASE 11
MESSAGE "DIVIDE BY 0"
CASE 14
MESSAGE "OUT OF VARIABLE SPACE"
CASE 24
MESSAGE "DEVICE TIMEOUT"
CASE 25
MESSAGE "DEVICE FAULT"
CASE 27
MESSAGE "NO PAPER"
CASE 52
MESSAGE "IMPROPER FILE LOGIC"
CASE 53
MESSAGE "FILE NOT ACCESSABLE"
CASE 54
MESSAGE "BAD FILE MODE"
CASE 55
MESSAGE "FILE IS OPEN"
CASE 57
MESSAGE "DEVICE I/O"
CASE 61
MESSAGE "DISK IS FULL"
CASE 62
MESSAGE "UNEXPECTED END OF FILE"
CASE 64
MESSAGE "BAD FILE NAME"
CASE 68
MESSAGE "DEVICE UNNAVAILABLE"
CASE 70
MESSAGE "FILE LOCK"
CASE 71
MESSAGE "DISK IS NOT READY"
CASE 72
MESSAGE "DISK MEDIA ERROR"
CASE 75
MESSAGE "BAD PATH/FILE"
CASE 76
MESSAGE "PATH NOT FOUND"
CASE 5
MESSAGE "ILLEGAL FUNCTION CALL"
CASE 58
MESSAGE "FILE EXISTS"
CASE 67
MESSAGE "TOO MANY FILES OPEN"
CASE 73
MESSAGE "ADVANCED FEATURE UNNAVAILABLE"
CASE 74
MESSAGE "RENAME ACROSS DISKS"
CASE 700
MESSAGE "FILE EXCEEDS 32K"
CASE ELSE
MESSAGE "ERROR"+STR$(ERR)+" AT PGM-CTR"+STR$(ERADR)
END SELECT

SOUND 50,5
DO:LOOP WHILE INKEY$=""
''''STOP '*****************************************************************
RESTORESCREEN O3$

RESUME NEXT

END SUB
' *** LINE FEED


SUB SingleBox (Wa%, Wb%, Wc%, Wd%)

REG 1, 15*256
CALL INTERRUPT &H10
IF Reg(1) - (Reg(1)\256) * 256 = 7 THEN Address&=&HB000 else Address&=&HB800
DEF SEG = ADDRESS&

LOCATE Wa%, Wb%: PRINT CHR$(213) + STRING$((Wd% - Wb%) - 1, 205) + CHR$(184)
LOCATE Wc%, Wb%: PRINT CHR$(212) + STRING$((Wd% - Wb%) - 1, 205) + CHR$(190)

FOR zxy% = 1 TO Wc% - Wa% - 1
LOCATE Wa% + zxy%, Wb%
PRINT CHR$(179) + SPACE$((Wd% - Wb%) - 1) + CHR$(179)
' right side of the box is Wa+zxy *80 + Wd + 1
' stuff an attribute into there
POKE ( (Wa%+Zxy%) * 160 ) + (Wd%*2) + 1,8
NEXT zxy%
for i%=(Wc% * 160) + ((wb%+2)*2)-1 TO (Wc%*160) + ((Wd%*2)+2)-1 STEP 2
' What this does is calculate the memory locations of the characters
' in video ram
POKE i%, 8
Next i%
DEF SEG
END SUB


FUNCTION PopMenu(item$())
' Center a scrolling menu on the screen containing options in Item$()
' This function returns the number of the selected item, or 0 if ESC pressed.
MenWid=0:MenHi=0
DO:MenHi=MenHi+1:IF LEN(Item$(MenHi))>MenWid then MenWid=LEN(Item$(MenHi))
LOOP WHILE LEN(Item$(MenHi))
MenHi=MenHi:MenWid=MenWid+4

' Menu box is MenHi x MenWid
wa% = 12 - (MenHi\2)
wb% = 40 - (MenWid\2)
wc% = wa% + MenHi
wd% = wb% + MenWid

COLOR 0,7
CALL SingleBox(Wa%,Wb%,Wc%,Wd%)

For y=1 to MenHi-1
Locate 12 - (MenHi\2) + y, 42 - (MenWid\2):Print Item$(y)
Next y

PopMe=1
DO
Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
Color 7,0 : Print Item$(PopMe) : Color 0,7
do:a$ = IN.KEY$:loop while a$=""
If Len(a$) = 2 THEN a=asc(right$(a$,1)) else a=asc(a$)


SELECT CASE a

CASE &H48 ' up arrow
Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
Print Item$(PopMe)
PopMe=PopMe-1
If PopMe = 0 then PopMe = 1

CASE &H50 ' dn arrow
Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
Print Item$(PopMe)
PopMe=PopMe+1
If PopMe = MenHi then PopMe = MenHi - 1


CASE &H47 ' home
Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
Print Item$(PopMe)
PopMe=1


CASE &H4D ' right arrow ........ it could happen
CASE &H4B ' left arrow
' these keys might indicate that the
' user wants to move horizontally to
' another menu. See CASEKEYS.BAS for
' a generic keyboard polling CASE struct

CASE &H51, &H4F ' page down or END
Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
Print Item$(PopMe)
PopMe=MenHi-1

CASE &H49 ' page up
Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
Print Item$(PopMe)
PopMe=1

CASE 27 ' escape
PopMenu=0 : Exit Loop

CASE 13
PopMenu=PopMe : Exit Loop

CASE ELSE
END SELECT


loop


END FUNCTION


FUNCTION SaveScreen$
REG 1, 15*256
CALL INTERRUPT &H10
IF Reg(1) - (Reg(1)\256) * 256 = 7 THEN Address=&HB000 else Address=&HB800
DEF SEG = ADDRESS
SaveScreen$=PEEK$(0,4000)
DEF SEG
END FUNCTION

SUB RestoreScreen(S$)
REG 1, 15*256
CALL INTERRUPT &H10
IF Reg(1) - (Reg(1)\256) * 256 = 7 THEN Address=&HB000 else Address=&HB800
DEF SEG = Address
POKE$ 0, S$
DEF SEG
END SUB


$IF 0
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
ÛßÛ Û Û ÛßÝ ÛßÛ ÛßÛ Û Û ßÛß Û ÛÝÞ Ûßß
ßþÜ Û Û ÛßÛ ÛßÝ Û Û Û Û Û Û ÛÛÛ Ûß
ÛÜÛ ÛÜÛ ÛÜÛ Û Û ÛÜÛ ÛÜÛ Û Û ÝÞÛ ÛÜÜ
ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
VPRINT - writes directly to video
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
$ENDIF
SUB VPrint(BYVAL Row%,BYVAL Col%,BYVAL St$, BYVAL Att%, Byval VideoRAM&)
! push si ; Save em
! push di ;
! push ds ;
! mov ax,St$ ; get the handle
! push ax ; push it
! call getstrloc ; Get String info
! mov ds,dx ; Set the string seg
! mov si,ax ; set string ptr
! cmp cx,0 ; Quit if string = 0
! je Done ;
! xor ax,ax ;
! mov ax,Row% ; get the row
! dec al ; convert row to zero base
! mov bl,80 ; get the number of cols
! mul bl ; multiply # of cols * rows
! add ax,Col% ; add the column
! dec al ; convert column to zero base
! mov di,ax ; offset within video page
! shl di,1 ; account for color/attribute
! mov ax,VideoRAM& ; ' default to mono card segment
Display:
! mov es,ax ; point ES to video
! mov ax,Att% ; color/attribute
! mov ah,al
Printit:
! lodsb ; get a char into al
! stosw ; write char and attr to screen
! loop Printit ; go for entire string
Done: ' (len\counter already in cx)
! pop ds ; pop em
! pop di ;
! pop si ;
END SUB



' *** LINE FEED
$IF 0
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
ÛßÛ Û Û ÛßÝ ÛßÛ ÛßÛ Û Û ßÛß Û ÛÝÞ Ûßß
ßþÜ Û Û ÛßÛ ÛßÝ Û Û Û Û Û Û ÛÛÛ Ûß
ÛÜÛ ÛÜÛ ÛÜÛ Û Û ÛÜÛ ÛÜÛ Û Û ÝÞÛ ÛÜÜ
ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
EXPANDTABS - remove TABS from doc
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
Special thanks to Mel Bishop for this routine!
$ENDIF

SUB ExpandTabs(Msg$)

REM *******************************************************
REM * Might as well convert Word-Star extended characters *
REM * into normal ASCII characters here as well. *
REM *******************************************************

crlf$=chr$(13)+chr$(10)

' We want to leave high ascii graf chars the same. It saves time too.
' for x=128 to 255 'Might as well convert
' replace chr$(x) with chr$(x-128) in Msg$ 'Word Star extended
' next x 'characters.

msg$=remove$(msg$,chr$(10)) 'Temporary remove line feeds from
temp$="" 'string. Leave C/R's for INSTR.

do 'Set the master loop
if msg$="" then exit loop 'If no more string to process,
'perform a grand exit

p=instr(msg$,chr$(13)) 'Find a C/R in the string.

if p=0 then 'If no C/R in string, reassign entire
te$=msg$ 'remaining string to be processed
msg$="" 'and null out the main string

else

te$=left$(msg$,p) 'Other wise, strip off the left hand
tm$=right$(msg$,len(msg$)-p) 'portion of the string for processing
msg$=tm$ 'and rid it from the main string.
tm$=""
end if

te$=remove$(te$,chr$(13)) 'Remove the C/R from string.

do
t1$="":t2$=""
p=instr(te$,chr$(9)) 'Find a TAB in the sub-string
if p=0 then exit loop 'If none present, whole line done.

t1$=left$(te$,p-1) 'Split the process string into 2
t2$=right$(te$,len(te$)-p) 'sub-strings with TAB as delimiter.
'NOTE: (p) points to the TAB character
'in t1$ so use p-1 to avoid it.

t1$ = t1$ + " " 'Add a space to replace the lost TAB

do until len(t1$)/8=int(len(t1$)/8) 'Lengthen to a multiple of 8
t1$ = t1$ + " "
loop

te$ = t1$ + t2$ 'Concanotate original string with the
loop 'added spaces & loop for more TAB's

temp$=temp$+te$+crlf$ 'Build temporary holding string
loop 'and loop back for next line.

msg$=temp$ 'Reassign the temporary hold string to
'the string being called
temp$="" 'and null out temp strings for memory
t1$="" 'management.
t2$=""
te$="" 'fini

END SUB


' *** LINE FEED
$IF 0
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
ÛßÛ Û Û ÛßÝ ÛßÛ ÛßÛ Û Û ßÛß Û ÛÝÞ Ûßß
ßþÜ Û Û ÛßÛ ÛßÝ Û Û Û Û Û Û ÛÛÛ Ûß
ÛÜÛ ÛÜÛ ÛÜÛ Û Û ÛÜÛ ÛÜÛ Û Û ÝÞÛ ÛÜÜ
ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
SINGLEBOX - draws a box on the screen
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
$ENDIF
SUB PBWriteBox (Wa%, Wb%, Wc%, Wd%,Attr%,VideoRAM&)
DEF SEG=VideoRAM&
CALL VPRINT(Wa%,Wb%,CHR$(213) + STRING$((Wd% - Wb%) - 1, 205) + CHR$(184),Attr%,VideoRAM&)
CALL VPRINT(Wc%,Wb%,CHR$(212) + STRING$((Wd% - Wb%) - 1, 205) + CHR$(190),Attr%,VideoRAM&)

FOR zxy% = 1 TO Wc% - Wa% - 1
CALL VPRINT(Wa%+Zxy%,Wb%,CHR$(179),Attr%,VideoRAM&)
CALL VPRINT(Wa%+Zxy%,Wd%,CHR$(179),Attr%,VideoRAM&)
' right side of the box is Wa+zxy *80 + Wd + 1
' stuff an attribute into there
POKE ( (Wa%+Zxy%) * 160 ) + (Wd%*2) + 1,8

NEXT zxy%

for i%=(Wc% * 160) + ((wb%+2)*2)-1 TO (Wc%*160) + ((Wd%*2)+2)-1 STEP 2
POKE i%, 8
Next i%
DEF SEG

END SUB
' *** LINE FEED
$IF 0
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
Ûßß Û Û ÛÝÞ Ûßß ßÛß Û ÛßÛ ÛÝÞ Û Û
Ûß Û Û ÛÛÛ Û Û Û Û Û ÛÛÛ ÞÝ ÞÝ
Û ÛÜÛ ÝÞÛ ÛÜÜ Û Û ÛÜÛ ÝÞÛ Û Û
ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
PBWRITEEDITBOX - pop up input box
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
$ENDIF
FUNCTION PBWriteEditBox$(Default$, TAttr%, BAttr%, VideoRAM&)
COLOR 0,7
CALL PBWriteBox(9, 28-(LEN(Default$)\2), 11, 32+(LEN(Default$)\2), Battr%, VideoRAM&)
y% = 30 - (LEN(Default$) \ 2) : YY%=0
yy%=LEN(RTRIM$(default$))
DO
CALL VPRINT(10, y%-1, " " + Default$+" ", Tattr%,VideoRAM&)
LOCATE 10,Y%+yy%,1

DO:Scratch$=IN.KEY$:LOOP WHILE LEN(Scratch$)=0
IF LEN(Scratch$) THEN
SELECT CASE(Scratch$)
CASE CHR$(27), CHR$(13)
EXIT SELECT
CASE CHR$(8)
IF YY% THEN
YY%=YY%-1
IF YY% THEN
Default$=LEFT$(Default$,yy%)+MID$(Default$,yy%+2) + " "
ELSE
Default$=MID$(Default$,yy%+2) + " "
END IF
END IF
CASE CHR$(0)+CHR$(83)
IF YY% THEN
Default$=LEFT$(Default$,yy%)+MID$(Default$,yy%+2) + " "
ELSE
Default$=MID$(Default$,yy%+2) + " "
END IF
CASE CHR$(0)+CHR$(&H4D)
IF YY% < LEN(Default$) THEN INCR YY%
CASE CHR$(0)+CHR$(&H4B)
IF YY% THEN DECR YY%
CASE CHR$(0)+CHR$(79) 'end
yy%=LEN(RTRIM$(default$))
CASE CHR$(0)+CHR$(71)
yy%=0



CASE ELSE
IF LEN(Scratch$)=1 and YY%=0 THEN Default$=SPACE$(LEN(default$))
IF LEN(Scratch$)=1 and YY% < LEN(Default$) THEN_
MID$(Default$,YY%+1,1) = Scratch$ : YY%=YY%+1

END SELECT
IF Scratch$=CHR$(27) THEN PBWriteEditBox$=CHR$(27):EXIT LOOP
IF Scratch$=CHR$(13) THEN PBWriteEditBox$=RTRIM$(Default$):EXIT LOOP

END IF
LOOP

END FUNCTION

FUNCTION FileBox$( ListArray$() )
O$=SAVESCREEN$
' The last element of the list in the array has to be blank.
' calculate how wide to make the window
Yy%=0
DO
INCR Yy%
IF LEN(ListArray$(Yy%)) > MaxLen% THEN MaxLen%=LEN(ListArray$(Yy%))
IF LEN(ListArray$(Yy%)) = 0 THEN ListLen%=Yy%: EXIT LOOP
LOOP

WinTop%=5:WinLeft%=38-(MaxLen%\2):WinRight%=43+(MaxLen%\2)
WinBot% = (WinTop% + Yy%)-1:If WinBot% > 20 THEN WinBot% = 20
COLOR 0,7
Call SingleBox(WinTop%, WinLeft%, WinBot%, WinRight%)

TopLine% = 0 ' the first element to appear inside the box
PickLine% = 1 ' the offset box line you are pointing at

DO ' Main loop start

For Yy% = WinTop% + 1 TO WinBot%-1
Locate Yy%, WinLeft%+1
IF Yy% = WinTop% + PickLine% THEN COLOR 7,0 ELSE COLOR 0,7
PRINT " " + ListArray$(Yy%-WinTop%+TopLine%) + SPACE$(MaxLen%-LEN(ListArray$(Yy%-WinTop%+TopLine%))+2)
Next Yy%


DO:A$=IN.KEY$:LOOP WHILE A$=""

Pick:

SELECT CASE A$
CASE CHR$(0,&H48) 'up arrow
DECR PickLine%
CASE CHR$(0,&H50) 'dn arrow
INCR PickLine%
CASE CHR$(0,&H4B) 'rt arrow
CASE CHR$(0,&H4D) 'lf arrow
CASE CHR$(0,&H47) 'home
PickLine%=1
CASE CHR$(0,&H4F) 'end
PickLine%=WinBot%-WinTop%-1
CASE CHR$(0,&H49) 'page up
if PickLine%=1 then_
TopLine%=TopLine%-(WinBot%-winTop%)+2 else_
PickLine%=1
CASE CHR$(0,&H51) 'page dn
If PickLine%=WinBot%-WinTop%-1 THEN_
TopLine%=TopLine%+(WinBot%-WinTop%)-2 else_
PickLine%=WinBot%-WinTop%-1
CASE CHR$(0,82) ' insert
CASE CHR$(0,119) 'ctrl home
CASE CHR$(0,117) 'ctrl end
CASE CHR$(0,132) 'ctrl pgup
CASE CHR$(0,118) 'ctrl pgdn
CASE CHR$(27) ' Escape ESC

CASE ELSE

END SELECT

if A$=CHR$(27) then FileBox$="":RESTORESCREEN O$:EXIT FUNCTION
if A$=CHR$(13) then FileBox$=ListArray$(TopLine%+PickLine%):RESTORESCREEN O$:EXIT FUNCTION



if PickLine%<1 then PickLine%=1:DECR TopLine%
if topLine%<0 then TopLine%=0:PickLine%=1:sound 1500,.1

if PickLine%=>WinBot%-WinTop% then PickLine%=WinBot%-WinTop%-1:INCR TopLine%
if TopLine% > ListLen% - (Winbot%-WinTop%) then TopLine%=ListLen%-(Winbot%-WinTop%):PickLine%=WinBot%-WinTop%-1:sound 500,.1

LOOP

END FUNCTION

FUNCTION YesOrNo (Prompt$, TAttr%, BAttr%, VideoRAM&)
Temp$=SaveScreen$
IF LEN(Prompt$) < 15 THEN Prompt$ = SPACE$(8 - LEN(Prompt$) \ 2) + Prompt$ + SPACE$(8 - LEN(Prompt$) \ 2)
Wb% = 38 - LEN(Prompt$) \ 2
Wd% = 42 + LEN(Prompt$) \ 2
Wa% = CSRLIN
Wc% = Wa% + 3
CALL PBWriteBox(Wa%, Wb%, Wc%, Wd%, BAttr%, VideoRAM&)
CALL VPRINT(Wa%+1, Wb%+1, SPACE$(Wd%-Wb%-1), TAttr%,VideoRAM&)
CALL VPRINT(Wa%+2, Wb%+1, SPACE$(Wd%-Wb%-1), TAttr%,VideoRAM&)
CALL VPRINT(Wa%+1, 40-LEN(Prompt$) \ 2, Prompt$, TAttr%,VideoRAM&)
YorN = -1
LET YorN$ = " No "
DO
CALL VPRINT(Wa% + 2, 34, YorN$, TAttr%,VideoRAM&)
DO: A$ = IN.KEY$: LOOP WHILE A$ = ""
IF UCASE$(A$) = "Y" THEN YorN = -1
IF UCASE$(A$) = "N" THEN YorN = 0
IF A$ = CHR$(0) + CHR$(&H4D) THEN YorN = 0
IF A$ = CHR$(0) + CHR$(&H4B) THEN YorN = 1
IF A$=CHR$(27) THEN YorN = 27:EXIT LOOP
IF A$ = CHR$(13) THEN EXIT LOOP
IF YorN THEN LET YorN$ = " No " ELSE LET YorN$ = " Yes "

LOOP
YesOrNo = YorN
CALL RestoreScreen(Temp$)
END FUNCTION
' *** LINE FEED


SUB Message (E$)
CALL SingleBox(14, 20, 16, 60)
LOCATE 15, 40 - (LEN(E$) \ 2)
PRINT E$;
END SUB

FUNCTION IN.KEY$
SHARED Macro%,KBuffer$,Macro$
IF LEN(KBuffer$) THEN
IK$=LEFT$(KBuffer$,1)
IF IK$=CHR$(0) THEN IK$=LEFT$(KBuffer$,2)
KBuffer$=MID$(KBuffer$,1+LEN(IK$))
ELSE
IK$=INKEY$
END IF

IF IK$=CHR$(0,50) THEN IF Macro% THEN Macro%=0:SOUND 3000,1:SOUND 2000,1:SOUND 1000,1
IF Macro% THEN MACRO$=MACRO$+IK$
IF LEN(IK$)=2 THEN
IF LEN(MACRO$) THEN
IF INSTR(MACRO$,"MACRO:"+IK$) THEN
M$=MID$(MACRO$,INSTR(MACRO$,CHR$(13,10)+"MACRO:"+IK$)+9)
IF INSTR(M$,"MACRO") THEN
M$=LEFT$(M$,INSTR(M$,CHR$(13,10)+"MACRO")-1)
END IF
KEYIN M$
IK$=""
END IF
END IF
END IF
IN.KEY$=IK$
END FUNCTION

SUB KEYIN(instring$)
SHARED Macro%,KBuffer$
KBuffer$=instring$+KBuffer$
END SUB

SUB TASK.MANAGER
' This sub does not do anything right now, however it will be
' called many times a second while PBWRITE is running. In here
' you can be running background processes like running a print
' job or printing several copies of ED$ as they are merged with
' fields and records from a large database, thus allowing the
' user to keep on working while the printing is taking place.
' be sure that the events which take place here or the other
' subs and functions called by this sub are extremely brief
' and repetetive in order to not interfere with the smooth
' operation of PBWRITE. Also, if something goes wrong and you
' need to interact with the user (such as an error message) you
' must save and restore the screen. TASK.MANAGER can also be
' monitoring for network messages, performing an Xmodem download,
' or even writing video ram to a ram disk file every few seconds
' in order to allow another network workstation to monitor what
' the user is doing. There are a great many neat possibilities.


END SUB