'#Editor Programm
$IF 0
                       PowerBASIC Subroutine Library
ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ
Þ Ûßß ÛßÛ Ûßß Ûßß ßÛß ÛßÛ ÛßÛ  ßÛß Ûßß Ûßß Û Û  Ûßß Û Û ÛßÛ ÛßÛ ÛßÛ ÛßÛ ßÛß Ý
Þ ßþÜ ÛÜÛ ÛÜ  Û    Û  ÛÜÝ ÛÜÛ   Û  ÛÜ  Û   ÛÛÛ  ßþÜ Û Û ÛÜÛ ÛÜÛ ÛþÛ ÛÜÝ  Û  Ý
Þ ÜÜÛ Û   ÛÜÜ ÛÜÜ  Û  Û Û Û Û   Û  ÛÜÜ ÛÜÜ Û Û  ÜÜÛ ÛÜÛ Û   Û   ÛÜÛ Û Û  Û  Ý
ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ
 Compuserve #    : GO PCVENB, Vendor #12/Spectra, Tech Support ID 71530,2640
 BBS: 813-625-1721 or 813-629-9145  FAX: 813-625-1698  MANKIND: 813-625-1172
 ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
   THIS FILE: EDITOR.BAS
      AUTHOR: Erik Olson
 DESCRIPTION: A full featured word processor-style text editor to demonstrate
	      many of the routines found in this toolbox


 $ENDIF



$STRING 1
DECLARE SUB SoundEffect (STRING)
DECLARE SUB SingleBox (integer,integer,integer,integer)
DECLARE FUNCTION YesOrNo! (STRING)
DECLARE SUB ErrorWindow (STRING)
DECLARE SUB Edit ()
DECLARE SUB PrintDoc ()
DECLARE SUB status ()
DECLARE SUB ErrorWindow (STRING)

DIM Doc$(5000)
DIM Macro$(30)
PUBLIC Doc$(), MaxLine%, Macro$(), CapsLock%, NumLock%, Ins%, Currfile$

Macro$(1) =  "Erik Lee Olson"             '  SHIFT - F1
Macro$(10) = "Spectra Tech Support"       '  SHIFT - F10
Macro$(11) = "Port Charlotte, Florida"    '  CTRL  - F1
Macro$(21) = "(813) 625-1172"		  '  ALT   - F1


ON ERROR GOTO ErrorFlag

start:
CALL Edit       ' This is the EDITOR routine.  This routine edits the array
' DOC$(5000) in a normal word-processor format.


END


ErrorFlag:                        ' Error handline routine
E = ERR                   ' Get the error number and then RESUME
RESUME ErrorResume        ' immediately, so we don't have any chance
' at generating an error within the error
' handling routine.  I just prefer it that
' way.

ErrorResume:			  ' we handle the error AFTER the RESUME
RESTORE                   ' just incase we are OUT OF DATA
DO                        ' Read the data statements to get a
   READ ee, E$               ' string representation of the error
   IF E = ee THEN EXIT LOOP  ' number.  Keep going until we find it
LOOP WHILE ee <> 999      ' or run out of data.  Then, display the
CALL ErrorWindow(E$)      ' error message in a box, play a couple of
A$ = "O1 A O0 A"          ' sad notes...
PLAY A$                   '
'
GOTO Refresh                      ' and then go back to the beginning of the
' Edit Subroutine

DATA 1,SYSTEM RESET
DATA 6,OVERFLOW,7,OUT OF MEMORY,9,SEGMENT OR STACK EXPIRED,11,DIVIDE BY 0,14,OUT OF VARIABLE SPACE,24,DEVICE TIMEOUT,25,DEVICE FAULT
DATA 27,NO PAPER,52,IMPROPER FILE LOGIC,53,FILE NOT ACCESSABLE,54,BAD FILE MODE,55,FILE IS OPEN,57,DEVICE I/O
DATA 61,DISK IS FULL,62,UNEXPECTED END OF FILE,64,BAD FILE NAME,68,DEVICE UNNAVAILABLE
DATA 70,FILE LOCK,71,DISK IS NOT READY,72,DISK MEDIA ERROR,75,BAD PATH/FILE,76,PATH NOT FOUND
DATA 3,CANNOT RETURN FROM NEAR SEGMENT,4,DATA SEGMENT EXPIRED,5,ILLEGAL FUNCTION CALL
DATA 16,FORMULA TOO COMPLEX,19,RUN TIME ERROR HANDLING ERROR,20,RUNTIME ERROR HANDLING ERROR
DATA 39,CASE ELSE EXPECTED,40,VARIABLE REQUIRED,50,FIELD OVERFLOW,51,THREAD IS BROKEN
DATA 56,FIELD STATEMENT ACTIVE,58,FILE EXISTS,59,BAD RECORD LENGTH,63,RECORD HAS NO REFERENCE
DATA 67,TOO MANY FILES OPEN,69,COMMUNICATIONS BUFFER OVERFLOW,73,ADVANCED FEATURE UNNAVAILABLE
DATA 74,RENAME ACROSS DISKS
DATA 999,ENKRELFINATED TRANSMOGRIFYER

' Error 999 means that we could not ID the error.  Make up an error message?

DEFINT A-Z
SUB Edit STATIC
   CLS
   
   doc$ = P$     ' P$ is a temporary variable.  Make it PUBLIC if you like
   ' and put a valid filename into it.  If P$ contains a filename
   ' at this point, it will be loaded, and P$ will be reset to ""
   
   DIM v$(10)    ' temporary array to save the screen behind message box
   
   COLOR 0, 7
   LOCATE 1, 1, 1:     ' create a visible cursor
   ' display the TOPLINE menu
   PRINT "F2 SAVEÛF3 LOADÛF4 NEW ÛF5 PRNTÛ       Û       Û       Û       Û       ÛESC=Quit";
   
   LOCATE 24,1 : PRINT SPACE$(80);     ' create a white bar at the bottom
   
   Refresh:
   ' if we do something to screw up the screen, we can simply GOTO here.
   
   COLOR 4, 0
   LOCATE 21, 1: PRINT "================================================================================";
   COLOR 7, 0
   x = 2              ' Cursor position at start, vertical
   Y = 1              ' Cursor position at start, horizontal
   LOCATE X, Y, 1
   TopLine% = 1      ' The current line of the document appearing at the top
   Scrol = 1         ' Whether or not it is necessary to refresh the screen
   LeftMargin% = 1   ' Cursor Position at left (start, wrap, home)
   RightMargin% = 61 '
   
   TED:
   ' TextEDit.  This is the TOP of the TEXT EDIT loop.
   '	This text editor starts out by scrolling the display (if required)
   '       and wrapping any text that goes outside the right margin.
   '
   
   IF LEN(P$) THEN CALL LoadTX(P$):P$="": m = 0: Scrol = 1
   IF Y > RightMargin% - 1 THEN Y = LeftMargin%: x = x + 1: GOTO WRAP
   IF Y < LeftMargin% THEN Y = RightMargin%: x = x - 1
   IF x > 20 THEN x = 20: TopLine% = TopLine% + 1: Scrol = 1
   IF x < 2 THEN x = 2: TopLine% = TopLine% - 1: Scrol = 1
   IF TopLine% < 1 THEN TopLine% = 1: Scrol = 1
   IF TopLine% > 4480 THEN TopLine% = 4480: Scrol = 1
   IF Scrol = 0 THEN GOTO getaround
   FOR z% = 1 TO 19
      LOCATE z% + 1, 1, 0
      PRINT SPACE$(80);
      LOCATE z% + 1, 1, 0
      IF LEN(Doc$(TopLine% + z% - 1)) > 80 THEN
         PRINT LEFT$(Doc$(TopLine% + z% - 1), 80);
      ELSE
         PRINT Doc$(TopLine% + z% - 1);
      END IF
      NEXT z%: Scrol = 0
      GOTO getaround
      
      
      WRAP:
      ' Text that goes outside of the right margin will be wrapped here.
      ' this routine currently operates only on the current line being edited.
      ' it needs to be expanded to run down the array continuing to wrap text
      ' until the paragraph ends or a line doesn't wrap.
      
      IF MID$(Doc$(x + TopLine% - 3), 1, RightMargin% - 4) <> " " AND LEN(Doc$(x + TopLine% - 3)) >= RightMargin% - LeftMargin% THEN
         
         SpaceLocator% = 0
         DO
            SpaceLocatorOld% = SpaceLocator%
            SpaceLocator% = INSTR(SpaceLocator% + 1, Doc$(x + TopLine% - 3), " ")
         LOOP WHILE SpaceLocator% <> 0 AND SpaceLocator% < RightMargin%
         
         IF SpaceLocatorOld% > 0 THEN
            Doc$(x + TopLine% - 2) = RTRIM$(MID$(Doc$(x + TopLine% - 3), SpaceLocatorOld% + 1)) + Doc$(x + TopLine% - 2)
            IF LEN(Doc$(x + TopLine% - 2)) > RightMargin% THEN Doc$(x + TopLine% - 2) = LEFT$(Doc$(x + TopLine% - 2), RightMargin%)
            Doc$(x + TopLine% - 3) = LEFT$(Doc$(x + TopLine% - 3), SpaceLocatorOld% - 1)
            LOCATE x - 1, SpaceLocatorOld% + 1, 0: PRINT SPACE$(RightMargin% - SpaceLocatorOld%)
            Y = RightMargin% - SpaceLocatorOld% + LeftMargin% - 1
         END IF
         
      END IF
      
      IF x + TopLine% - 2 > MaxLine% THEN MaxLine% = x + TopLine% - 2
      
      GOTO REDRAW
      
      getaround:
      ' We arrive here after a screen scroll or after a REDRAW
      '
      ' This part of the loop updates the x/y, doc size status info on the screen
      LOCATE 22, 6, 0
      PRINT "Status: Line"; x + TopLine% - 2; "  Column"; Y - (LeftMargin% - 1); "  Max="; MaxLine%; "  Free:";FRE(-1)
      
      ' flash a warning if the doc has been changed but not saved on status line
      IF nosave THEN COLOR 20, 0: LOCATE 22, 60: PRINT "NOT SAVED": COLOR 7, 0 ELSE LOCATE 22, 60: PRINT "         "
      
      ' Create a visible cursor.  To make this program easier, pad a new line with
      ' spaces equal to the rightmargin - leftmargin.
      LOCATE x, Y, 1
      IF Doc$(x + TopLine% - 2) = "" THEN Doc$(x + TopLine% - 2) = SPACE$(RightMargin% - (LeftMargin% - 1)): IF x + TopLine% - 2 > MaxLine% THEN MaxLine% = x + TopLine% - 2
      
      textinputloop:
      'TEXT INPUT LOOP
      ' This is the top of a character input loop that continues until the screen
      ' needs to wrap, or a control/function key is pressed.
      CALL status        ' update the white bar on the bottom of the screen
      COLOR 7, 0         ' the color of text
      LOCATE x, Y, 1     ' current cursor position
      A$ = ""		   ' A$ will contain the next keystroke
      ' now, loop until the user presses a key
      WHILE A$ = ""
         CALL GETKBD(Ins2%, cap2%, NUM2%, scr2%)
         IF Cap2%<>CapsLock% or NUM2% <> NumLock% THEN CALL STATUS:LOCATE X,Y,1
         A$ = INKEY$
      WEND
      
      IF LEN(A$) = 1 THEN nosave = 1      ' Keep track if the doc has been changed
      
      InsertMacro:
      'INSERT MACRO
      '  here is where the keys are individually inserted into the loop when
      '  a macro key is pressed.  The code continues independant of whether
      '  A$ came from the keyboard or from the macro string.
      
      'SOUND 500 + (15 * ASC(A$)), .05   ' Add sound effects to keyboard
      
      CALL status    ' make sure the status bar is updated with the current
      ' keyboard shift state, directory, and doc file name.
      COLOR 7, 0
      LOCATE x, Y, 0
      
      IF A$ = " " AND Y > RightMargin% - 1 THEN A$ = CHR$(13)
      ' if the entire line has no SPACES, we must force a wrap by pretending
      ' the user pressed ENTER at the right margin.
      
      IF A$ = CHR$(13) AND Y = LeftMargin% AND ins% THEN LET A$ = CHR$(9)
      ' Just ENTER with INSERT will insert a blank line, so we just pretend
      ' the user pressed CTRL-I (insert a line)
      
      IF A$ = CHR$(13) THEN
         ' ENTER will wrap the cursor, but if the insert is on, we need
         ' to wrap the cursor and also insert a new line.
         LET ChopLine% = Y   ' so we know where to break the text
         LET Y = LeftMargin% ' wrap the cursor
         X=X+1               ' to the left of the next line.
         IF Ins% THEN
            ' Here is the hard part.  If the INSERT mode is on, we
            ' need to chop the current line at the cursor and wrap
            ' it, while also inserting a new line into the document.
            MaxLine% = MaxLine% + 1
            FOR Yy = MaxLine% TO x + TopLine% - 2 STEP -1
               Doc$(Yy + 1) = Doc$(Yy)
            NEXT Yy
            Doc$(Yy + 1) = MID$(Doc$(Yy),ChopLine%) + SPACE$(ChopLine%-1)
            Doc$(Yy) = LEFT$(Doc$(Yy),ChopLine% -1)
            Scrol = 1
         ELSE
            ' otherwise, OVERTYPE is easy.  Just move the cursor and
            ' get on with your life.
            GOTO TED
         END IF
         
      END IF
      
      ' Now, there are many other conditions which will effect the way in which
      ' a word processor will handle different editing keys.  For example, the
      ' DELETE key needs to be able to squish out an entire line once it is
      ' empty.  In this case, we just change the key from DEL to CTRL-Y.
      IF A$ = CHR$(0) + CHR$(83) AND_
      LEN(RTRIM$(Doc$(x + TopLine% - 2))) = 0 THEN A$ = CHR$(25)
      
      ' ...So CTRL-Y Just packs the current line out of the array.
      IF A$ = CHR$(25) THEN FOR Yy = x + TopLine% - 2 TO MaxLine%:_
      Doc$(Yy) = Doc$(Yy + 1): NEXT Yy: Doc$(MaxLine%) = "":_
      MaxLine% = MaxLine% - 1: Scrol = 1: GOTO TED
      
      ' ...The opposite is CTRL-I, which inserts a blank line into the array
      IF A$ = CHR$(9) THEN MaxLine% = MaxLine% + 1:_
      FOR Yy = MaxLine% TO x + TopLine% - 2 STEP -1:_
      Doc$(Yy + 1) = Doc$(Yy): NEXT Yy:_
      Doc$(Yy + 1) = SPACE$(RightMargin% - (LeftMargin% - 1)):_
      x = x + 1: Scrol = 1: GOTO TED
      
      ' now just to tidy things up, if A$ is empty, then go back to the start
      
      IF A$ = "" THEN GOTO textinputloop
      
      
      ' Backspace!  This key behaves differently depending on where the cursor
      ' is located.
      IF A$ = CHR$(8) THEN
         'beyond the left margin, backspace has the effect of
         'left-arrow and DEL., so we move the cursor back, and
         'change A$ to DEL
         IF Y > LeftMargin% THEN
            Y = Y - 1: A$ = CHR$(0) + CHR$(83)
         ELSE
            ' right at the left margin, the backspace has the
            ' ability to wrap the text backwards to the line above it.
            ' Since I don't feel like doing that yet, I'll give backspace
            ' the same effect as UP ARROW at the left margin.  This
            ' backwards wrapping is CRUCIAL to make a proper editor
            A$ = CHR$(0) + CHR$(72)
         END IF
      END IF
      
      
      ' The ESCAPE key will exit the program.  Ask the user to save if not saved.
      IF A$ = CHR$(27) THEN
         'IF NoSave then IF YesOrNo("Save " + Doc$ + "?") THEN CALL SaveDoc(Doc$)
         IF YesOrNo!("Exit to DOS?") THEN GOTO endnotescreensub ELSE GOTO Refresh
      END IF
      
      IF ASC(A$) < 27 AND LEN(A$) = 1 THEN A$ = CHR$(0) + A$
      IF LEN(A$) = 2 THEN GOTO arrowfunctionkeys:
      
      IF A$ = " " THEN GOTO around
      around:
      IF Y - 4 > LEN(Doc$(x + TopLine% - 2)) THEN
         Doc$(x + TopLine% - 2) = Doc$(x + TopLine% - 2) + A$
      ELSE
         IF Ins% = 0 THEN Doc$(x + TopLine% - 2) = LEFT$(Doc$(x + TopLine% - 2), Y - LeftMargin%) + A$ + MID$(Doc$(x + TopLine% - 2), Y - (LeftMargin% - 2))
         IF Ins% THEN Doc$(x + TopLine% - 2) = LEFT$(Doc$(x + TopLine% - 2), Y - LeftMargin%) + A$ + MID$(Doc$(x + TopLine% - 2), Y - (LeftMargin% - 1)): Doc$(x + TopLine% - 2) = LEFT$(Doc$(x + TopLine% - 2), LEN(Doc$(x+ TopLine%- 2)))
      END IF
      Y = Y + 1
      REDRAW:
      IF x < 21 THEN
         IF LEN(Doc$(x + TopLine% - 2)) < 62 THEN LOCATE x, LeftMargin%, 0: PRINT Doc$(x + TopLine% - 2);  ELSE LOCATE x, LeftMargin%, 0: PRINT LEFT$(Doc$(x + TopLine% - 2), RightMargin%)
      END IF
      IF Macro THEN RETURN
      GOTO TED:
      
      arrowfunctionkeys:
      A = ASC(MID$(A$, 2))
      IF A > 58 AND A < 69 THEN
         SELECT CASE A
            
         CASE 60 'save    F1
            A = 23
         CASE 61 'load    F2
            A = 7
         CASE 62 'new     F3
            A = 14
         CASE 63 'print   F4
            A = 16
         CASE 64 '        F5
         CASE 65 '        F6
         CASE 66 '        F7
         CASE 67 '        F8
         CASE 68 '        F9
            ERROR 999
         CASE ELSE
         END SELECT
      END IF
      
      IF A > 83 AND A < 114 THEN             ' The array MACRO$(30) can contain
      Macro$ = Macro$(A - 83)                ' macros for ALT/CTRL/SHFT - F keys
      FOR Macro = 1 TO LEN(Macro$)           ' These macros only type chars into
         A$ = MID$(Macro$, Macro, 1)    ' the editor window and do not generate
         GOSUB InsertMacro              ' function key codes
      NEXT Macro                     '
      Macro = 0                      '
   END IF
   IF A = 72 THEN x = x - 1
   IF A = 80 and (x+topline%-2) < MaxLine% THEN x = x + 1
   IF A = 75 THEN Y = Y - 1
   IF A = 83 THEN Doc$(x + TopLine% - 2) = LEFT$(Doc$(x + TopLine% - 2), Y - LeftMargin%) + MID$(Doc$(x + TopLine% - 2), Y - (LeftMargin% - 2)) + " ": GOTO REDRAW
   
   IF A = 71 THEN Y = LeftMargin%
   IF A = 79 THEN Y = LEN(RTRIM$(Doc$(x + TopLine% - 2))) + LeftMargin%
   IF A = 77 THEN Y = Y + 1
   IF A = 73 AND x > 2 THEN x = 2: GOTO TED
   IF A = 73 AND x = 2 THEN TopLine% = TopLine% - 18: x = 1
   IF A = 81 AND x < 20 THEN x = 20: GOTO TED
   
   
   IF A = 81 AND x = 20 THEN TopLine% = TopLine% + 18: x = 21 :IF Topline%>MaxLine%-19 THEN Topline%=Maxline%-19
   IF A = 119 THEN TopLine% = 1: x = 1: Y = LeftMargin%
   IF A = 16 THEN GOSUB printnotes  ' CTRL-P or F5
   IF A = 23 THEN GOSUB savenotes   ' CTRL-W or F2
   IF A = 7 THEN GOSUB loadnotes    ' CTRL-G or F3
   IF A = 14 THEN GOSUB clearnotes  ' CTRL-N or F4
   
   GOTO TED
   
   
   clearnotes:
   GOSUB bluewindow
   
   LOCATE 11, 25: PRINT "About to clear text screen..."
   LOCATE 13, 25: PRINT "Press ENTER to confirm"
   LOCATE 15, 25: PRINT "Any other key escapes!"
   A$ = "": WHILE A$ = "": A$ = INKEY$: WEND
   
   IF A$ = CHR$(13) THEN
      FOR yy%=1 to 5000:LET Doc$(Yy%)="":NEXT Yy%
      Scrol = 1: x = 1: Y = LeftMargin%: TopLine% = 1
      FOR Yy = 1 TO 10: v$(Yy) = SPACE$(40): NEXT Yy: nosave = 0: MaxLine% = 1
      GOTO exitprintnotes
   ELSE
      GOTO exitprintnotes
   END IF
   
   
   loadnotes:
   CALL ErrorWindow("Enter filename to edit...")
   LET Doc$=EditBox$(CurrFile$+SPACE$(25-LEN(Currfile$)))
   IF LEN(Doc$) THEN CALL LoadTX(Doc$): Currfile$=Doc$
   GOTO Refresh
   savenotes:
   CALL ErrorWindow("Save file as...")
   LET Doc$=EditBox$(Currfile$+SPACE$(25-LEN(Currfile$)))
   IF LEN(Doc$) THEN CALL SaveDoc(Doc$):Currfile$=Doc$
   GOTO Refresh
   
   printnotes:
   GOSUB bluewindow
   IF MaxLine% = 1 AND Doc$(1) = SPACE$(79) THEN GOSUB error2: GOTO exitprintnotes
   CALL PrintDoc
   GOTO exitprintnotes
   
   error1:
   
   error2:
   
   error3:
   
   error4:
   clearwindow:
   FOR T = 9 TO 16
      LOCATE T, 20: PRINT SPACE$(38);
   NEXT T
   RETURN
   
   exitprintnotes:
   COLOR 7, 0: CALL SoundEffect("CAPTURE OFF"): CALL SoundEffect("PRINTER OFF")
   FOR T = 8 TO 17
      LOCATE T, 20: PRINT v$(T - 7);
   NEXT T
   doc$ = b$: eofchek = 0
   Scrol = 1
   RETURN
   
   bluewindow:
   COLOR 0, 7: CALL SoundEffect("PRINTER ON")
   FOR T = 8 TO 17
      IF Doc$(T + TopLine% - 2) <> "" THEN v$(T - 7) = MID$(Doc$(T + TopLine% - 2), 15, 40) ELSE v$(T - 7) = SPACE$(40)
      LOCATE T, 20: PRINT SPACE$(40)
   NEXT T
   RETURN
   
   
   endnotescreensub:
   LOCATE , , 0
   COLOR 7, 0
END SUB

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

SUB LoadTX (Doc$)
   
   COLOR 0, 7: CALL SoundEffect("PRINTER ON")
   FOR T = 8 TO 17
      LOCATE T, 20: PRINT SPACE$(40)
   NEXT T
   
   LOCATE 11, 25: PRINT "LOAD DOCUMENT FROM DISK..."
   
   LOCATE 14, 25: PRINT "Getting...";
   
   Yy = 0
   DocBuffer = FREEFILE
   CALL SoundEffect("CAPTURE ON")
   OPEN "i", #DocBuffer, Doc$
   
   DO
      Yy = Yy + 1: IF Yy > 4999 THEN EXIT LOOP
      LINE INPUT #DocBuffer, Doc$(Yy)
   LOOP WHILE NOT EOF(DocBuffer)
   CLOSE #DocBuffer
   MaxLine% = Yy + 1: FOR Yy = MaxLine% TO 5000: Doc$(Yy) = "": NEXT Yy: nosave = 0
   COLOR 7, 0: CALL SoundEffect("CAPTURE OFF"): CALL SoundEffect("PRINTER OFF")
   EndLoadTXSub:
END SUB

SUB SaveDoc(Doc$)
   COLOR 0, 7: CALL SoundEffect("PRINTER ON")
   FOR T = 8 TO 17
      LOCATE T, 20: PRINT SPACE$(40)
   NEXT T
   
   LOCATE 11,25:PRINT "  SAVE DOCUMENT TO DISK..."
   LET Currfile$ = Doc$: CALL SoundEffect("CAPTURE ON")
   OPEN "o", #2, Doc$
   FOR Yy=1 to MaxLine%:PRINT #2, RTRIM$(Doc$(Yy)):NEXT Yy
   CLOSE #2
END SUB

SUB PrintDoc
   SHARED Doc$()
   COLOR 0, 7
   LET PrintBuffer = FREEFILE
   COLOR 0, 7: CALL SoundEffect("PRINTER ON")
   
   FOR T = 8 TO 17
      LOCATE T, 20: PRINT SPACE$(40)
   NEXT T
   
   
   LOCATE 8, 32: PRINT "PRINT DOCUMENT"
   LOCATE 9, 20: PRINT STRING$(40, 196)
   LOCATE 11, 25: PRINT "Output to " + "LPT1:"
   '                     ------------------------------
   LOCATE 13, 25: PRINT "Prepare your printer and press"
   LOCATE 14, 25: PRINT "ENTER to print or press ESCAPE"
   LOCATE 15, 25: PRINT "to abandon print operation..."
   
   A$ = "": WHILE A$ = "": A$ = INKEY$: WEND
   IF A$ = CHR$(27) THEN GOTO ExitPrintDoc
   
   IF A$ = CHR$(13) THEN
      OPEN "o", #PrintBuffer, "LPT1:": CALL SoundEffect("PRINTER ON")
      GOSUB head
      FOR Yy = 1 TO MaxLine%
         Doc$ = Doc$(Yy)
         IF RTRIM$(Doc$) = "$ENDTYPE" THEN EXIT FOR
         'Doc$ = GetVar$(Doc$) '''' For mail merge facility
         PRINT #PrintBuffer, SPACE$(10) + Doc$    ' space$(10) can be a margin variable
         A$ = INKEY$: IF A$ = CHR$(27) THEN EXIT FOR
         IF v > 0 THEN EXIT FOR
         l = l + 1: IF l = 66 - VAL(HeaderSize$) THEN l = 0: GOSUB head
      NEXT Yy
      IF RTRIM$(Doc$) = "$ENDTYPE" THEN GOTO ExitPrintDoc
      PRINT #PrintBuffer, CHR$(12)
      
   ELSE
      SOUND 50, .1: SOUND 1000, .5: SOUND 500, .5: SOUND 100, .5: SOUND 50, .5
   END IF
   GOTO ExitPrintDoc
   
   head:
   IF VAL(HeaderSize$) THEN FOR z = 1 TO VAL(HeaderSize$): PRINT #PrintBuffer, "": NEXT z
   RETURN
   
   
   ExitPrintDoc:
   CLOSE #PrintBuffer
   CALL SoundEffect("PRINTER OFF")
END SUB

DEFSNG A-Z
SUB SingleBox (Wa%, Wb%, Wc%, Wd%)
   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)
   NEXT zxy%
   
END SUB

DEFINT A-Z
SUB SoundEffect (ef$)
   ef$ = UCASE$(ef$)
   SELECT CASE ef$
   CASE "CAPTURE ON"
      FOR x = 1 TO 3: FOR Y = 500 TO 5500 STEP 500: SOUND Y, .2: NEXT Y: NEXT x
   CASE "CAPTURE OFF"
      FOR x = 1 TO 3: FOR Y = 5500 TO 500 STEP -500: SOUND Y, .2: NEXT Y: NEXT x
   CASE "PRINTER ON"
      SOUND 50, 4
      SOUND 1000, 1: SOUND 2000, 1: SOUND 3000, 1
   CASE "PRINTER OFF"
      SOUND 50, 4
      SOUND 3000, 1: SOUND 2000, 1: SOUND 1000, 1
   CASE "C"
      FOR Y% = 100 TO 1000 STEP 50: SOUND Y%, .2: SOUND 500, .1: NEXT Y%
   CASE "W"
      FOR Y% = 2500 TO 3000 STEP 50: SOUND Y%, .1: NEXT Y%
      SOUND 5000, .5: SOUND 100, .5: SOUND 50, .1
   CASE "FWEEP"
      FOR Y% = 500 TO 1500 STEP 200: SOUND Y%, .1: NEXT Y%
   CASE "FWOP"
      FOR Y% = 1500 TO 100 STEP -400: SOUND Y%, .1: NEXT Y%
   CASE "OPEN"
      FOR Y% = 100 TO 1600 STEP 200: SOUND INT(RND(1) * 500) + Y%, RND(1) + .1: SOUND Y%, .3: NEXT Y%
      FOR Y% = 1100 TO 100 STEP -200: SOUND Y%, .5: NEXT Y%
      
      
      
      
      
      
   CASE ELSE
      SOUND 1000, 1: SOUND 2000, 1: SOUND 3000, 1
   END SELECT
END SUB

SUB status
   SHARED Currfile$
   IF Currfile$="" THEN Currfile$="NONAME."
   CALL GETKBD(Ins%, CAPSLOCK%, numlock%, scrolllock%)
   COLOR 0, 7
   LOCATE 24, 1, 0: PRINT CURDRV$+CURDIR$;
   LOCATE 24, 27: PRINT "º " + Currfile$ + "               ";
   LOCATE 24, 55: PRINT "º ";
   IF Ins% THEN PRINT "INS ";  ELSE PRINT "    ";
   IF CAPSLOCK% THEN PRINT "CAPS ";  ELSE PRINT "     ";
   IF numlock% THEN PRINT "NUM ";  ELSE PRINT "    ";
   IF scrolllock% THEN PRINT "SLK ";  ELSE PRINT "    ";
   COLOR 0, 7
END SUB

DEFSNG A-Z
FUNCTION YesOrNo (Prompt$)
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 SingleBox(Wa%, Wb%, Wc%, Wd%)
LOCATE Wa% + 1, 40 - LEN(Prompt$) \ 2: PRINT Prompt$
YorN = 1
LET YorN$ = "<Yes>    No "
DO
   LOCATE Wa% + 2, 34: PRINT YorN$
   DO: A$ = INKEY$: 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$(13) THEN EXIT LOOP
   IF YorN THEN LET YorN$ = "<Yes>    No " ELSE LET YorN$ = " Yes    <No>"
   
LOOP
YesOrNo = YorN

END FUNCTION

SUB GetKBD(Ins%, CAPSLOCK%, numlock%, scrolllock%)
   REG 1,&h1200
   CALL INTERRUPT &h16
   b=ABS(REG(1))
   
   'The keyboard shift states can also return the current state of ALT,CTRL, etc.
   'and can be used to flip the topline menu display
   
   'if (b AND  1) =  1 then '''Right Shift On
   'if (b and  2) =  2 then '''Left Shift On
   'if (b and  4) =  4 then '''Ctl Key On
   'if (b and  8) =  8 then '''Alt Key On
   
   IF (b AND 16) = 16 THEN ScrollLock% = 1 ELSE ScrollLock% = 0
   IF (b and 32) = 32 THEN NumLock% = 1 ELSE NumLock% = 0
   IF (b and 64) = 64 THEN CapsLock% = 1 ELSE CapsLock% = 0
   IF (b and 128)=128 THEN Ins% = 1 ELSE Ins% = 0
   
   'if (b and 256)=256 then      ''''Ctl Key On
   'if (b and 512)=512 then      ''''Alt Key is Down
   'if (b and 1024)=1024 then    ''''Ctl Key is Down
   'if (b and 2048)=2048 then    ''''Alt Key is Down
   'if (b and 4196)=4196 then    ''''Key is Down
   'if (b and 8192)=8192 then    ''''Lock Key is Down
   'if (b and 16384)=16384 then  ''''CapsLock Key is Down
   
END SUB


FUNCTION EditBox$(Default$)

CALL SoundEffect("x")
COLOR 0,7
CALL SingleBox(19, 38-(LEN(Default$)\2), 21, 42+(LEN(Default$)\2))
y = 40 - (LEN(Default$) \ 2) : YY=0
DO
   LOCATE 20,Y,0:PRINT Default$
   LOCATE  20,Y+yy,1
   DO:A$=INKEY$:LOOP WHILE LEN(A$)=0
   IF LEN(A$) THEN
      SELECT CASE(A$)
      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 YY=YY+1
      CASE CHR$(0)+CHR$(&H4B)
         IF YY THEN YY=YY-1
      CASE CHR$(0)+CHR$(79) 'end
         yy=LEN(RTRIM$(default$))
      CASE CHR$(0)+CHR$(71)
         yy=0
         
      CASE ELSE
         IF LEN(A$)=1 and YY=0 THEN Default$=SPACE$(LEN(default$))
         IF LEN(A$)=1 and YY < LEN(Default$) THEN_
         MID$(Default$,YY+1,1) = A$ : YY=YY+1
         
      END SELECT
      IF A$=CHR$(27) THEN EditBox$="":EXIT LOOP
      IF A$=CHR$(13) THEN EditBox$=RTRIM$(Default$):EXIT LOOP
      
   END IF
LOOP
END FUNCTION


' *** FORM FEED        
' *** CONDENSED OFF