Rem Example Text Editor Program For The DB Classic Challenge
Rem By TDK_Man April 2007
 
Sync On: Sync Rate 60: CLS 0
SET WINDOW ON
SET WINDOW TITLE "TDK's Text Editor"
SET WINDOW SIZE 642,489: Rem Window slightly larger than the display (640x480)
Show Window
Rem The default 640x480 display gives us an area with 71 characters across and 29 characters down
 
Set Text Font "Courier",1
Set Text Size 16
Set Text Transparent
 
True = 1: False = 0
MaxLines = 1000
Dim Lines$(MaxLines): Rem up to 1000 lines, but we will have to handle scrolling manually
CursorX = 0: CursorY=0: Rem Initial cursor starting position
NumLines = 1: Rem New doc always has a min of 1 line - even if not used
LineOffset = 0 : Rem for scrolling the lines of text
CharWidth = 9
ScrnCharWidth = 71
 
Gosub UpdateMenu
 
Ink RGB(255,255,255),0
Set Cursor CursorX,CursorY
Text CursorX*CharWidth,CursorY*16,"_"
 
Rem Main Loop
Do
  KeyPressed = Asc(Inkey$())
  Gosub ReadKeyPresses
  Sync
Loop
End
 
ReadKeyPresses:
  Rem ***************************
  Rem   Handle ASCII Keypresses
  Rem ***************************
 
  If KeyPressed > 31 And KeyPressed < 123
    Rem Handle all keypresses here
    Rem For example: 97 - 122 = a .. z      65 - 90 = A .. Z      48 - 57 = 0 .. 9
    BeforeCursor$ = Left$(Lines$(CursorY+LineOffset),CursorX)
    CurrentLineLen = Len(Lines$(CursorY+LineOffset))
    AfterCursor$ = Right$(Lines$(CursorY+LineOffset),CurrentLineLen-CursorX)
    Ink 0,0: Text CursorX*CharWidth,CursorY*16,"_"
    If CursorX < ScrnCharWidth-1
      Lines$(CursorY+LineOffset) = BeforeCursor$ + Chr$(KeyPressed) + AfterCursor$
      Inc CursorX
    Else
      Rem Reached end of line so wordwrap here...
      Lines$(CursorY+LineOffset) = BeforeCursor$+Chr$(KeyPressed)
      ScanPos = Len(BeforeCursor$)+1: LineLen = ScanPos
      While Mid$(Lines$(CursorY+LineOffset),ScanPos)<>" "
        Dec ScanPos
      EndWhile
      LastWord$ = Right$(Lines$(CursorY+LineOffset),LineLen-ScanPos)
      Lines$(CursorY+LineOffset) = Left$(BeforeCursor$,ScanPos-1)
      CursorX = Len(LastWord$): Inc CursorY: Rem Drop to start of the next line
      Gosub CheckScroll
      Lines$(CursorY+LineOffset) = LastWord$
      Inc NumLines: Rem Just started a new line
    Endif
    Gosub UpdateAllLines
    Gosub UpdateMenu
    Sleep 120
  Endif
 
  Rem ***** Backspace Key *****
  If KeyPressed = 8
    If CursorX > 0
      CurrentLineLen = Len(Lines$(CursorY+LineOffset))
      If CursorX = CurrentLineLen
        Rem Currently at the end of the line
        Lines$(CursorY+LineOffset) = Left$(Lines$(CursorY+LineOffset),CurrentLineLen-1)
      Else
        Rem Currently somewhere in the middle of the line
        BeforeCursor$ = Left$(Lines$(CursorY+LineOffset),CursorX-1)
        AfterCursor$ = Right$(Lines$(CursorY+LineOffset),CurrentLineLen-CursorX)
        Lines$(CursorY+LineOffset) = BeforeCursor$ + AfterCursor$
      Endif
      Dec CursorX
    Else
      Rem At left edge of screen
      If Len(Lines$(CursorY+LineOffset))=0
        For N = CursorY To NumLines-2
          Lines$(N) = Lines$(N+1)
        Next N
        Dec NumLines
        Lines$(NumLines) =""
        Dec CursorY: CurrentLineLen = Len(Lines$(CursorY+LineOffset))
        If CursorX < CurrentLineLen Then CursorX = CurrentLineLen
      Else
        Rem There are characters after cursor
        AfterCursor$ = Right$(Lines$(CursorY+LineOffset),CurrentLineLen-CursorX)
        For N = CursorY To NumLines-2
          Lines$(N) = Lines$(N+1)
        Next N
        Dec NumLines
        Lines$(NumLines) = ""
        If CursorY>0 Then Dec CursorY: CurrentLineLen = Len(Lines$(CursorY+LineOffset))
        If CursorX < CurrentLineLen Then CursorX = CurrentLineLen
        Lines$(CursorY+LineOffset) = Lines$(CursorY+LineOffset)+AfterCursor$
        Rem Check new line length
        CurrentLineLen = Len(Lines$(CursorY+LineOffset))
        If CurrentLineLen > ScrnCharWidth
          AfterCursor$ = Right$(Lines$(CursorY+LineOffset),CurrentLineLen - ScrnCharWidth): Rem characters after right edge of window
          Lines$(CursorY+LineOffset) = Left$(Lines$(CursorY+LineOffset),ScrnCharWidth): Rem keep characters inside window
          Lines$(CursorY+1) = AfterCursor$ + Lines$(CursorY+1)
        Endif
      Endif
    Endif
    Gosub UpdateAllLines
    Gosub UpdateMenu
    Sleep 140
  Endif
 
  Rem *******************************
  Rem   Handle NON-ASCII Keypresses
  Rem *******************************
 
  Rem ***** Return Key *****
  If Returnkey()=1
    Rem Drop to next line
    Ink 0,0: Text CursorX*CharWidth,CursorY*16,"_"
    CurrentLineLen = Len(Lines$(CursorY+LineOffset))
    BeforeCursor$ = Left$(Lines$(CursorY+LineOffset),CursorX)
    AfterCursor$ = Right$(Lines$(CursorY+LineOffset),CurrentLineLen-CursorX)
    Rem Shuffle All Following Lines Down One (Will lose very last line but unlikely to be used)
    For N = MaxLines-1 To CursorY+1 Step -1
      Lines$(N) = Lines$(N-1)
    Next N
    Lines$(CursorY+LineOffset) = BeforeCursor$: Rem Set current line to text before cursor
    Lines$(CursorY+LineOffset+1) = AfterCursor$: Rem Set following line to text after cursor
    CursorX = 0
    Inc CursorY: Rem New cursor position
    Gosub CheckScroll
    Inc NumLines: Rem We just added a new line
    Ink 0,0: Text CursorX*CharWidth,(CursorY)*16,"_"
    Ink RGB(255,255,255),0: Text CursorX*CharWidth,CursorY*16,"_"
    Gosub UpdateAllLines
    Gosub UpdateMenu
    Sleep 140
  Endif
 
  Rem ***** Home Key ***** 199
  If Scancode() = 199
    Ink 0,0: Text CursorX*CharWidth,CursorY*16,"_"
    CursorX = 0
    Ink RGB(255,255,255),0: Text CursorX*CharWidth,CursorY*16,"_"
  Endif
 
  Rem ***** End Key ***** 207
  If Scancode() = 207
    Ink 0,0: Text CursorX*CharWidth,CursorY*16,"_"
    CursorX = Len(Lines$(CursorY+LineOffset))
    Ink RGB(255,255,255),0: Text CursorX*CharWidth,(CursorY)*16,"_"
  Endif
 
  Rem ***** Cursor Keys *****
  If Upkey()=1 And CursorY >= 0: Rem Move Cursor Up
    Ink 0,0: Text CursorX*CharWidth,CursorY*16,"_"
    Dec CursorY: Gosub CheckScroll
    CurrentLineLen = Len(Lines$(CursorY+LineOffset))
    If CursorX > CurrentLineLen Then CursorX = CurrentLineLen
    Ink RGB(255,255,255),0: Text CursorX*CharWidth,CursorY*16,"_"
    Gosub UpdateMenu
    Sleep 80
  Endif
 
  If Downkey()=1
    If CursorY <= 28 And CursorY+LineOffset+1 < NumLines: Rem Move Cursor Down
      Ink 0,0: Text CursorX*CharWidth,CursorY*16,"_"
      Inc CursorY: Gosub CheckScroll
      CurrentLineLen = Len(Lines$(CursorY+LineOffset))
      If CursorX > CurrentLineLen Then CursorX = CurrentLineLen
      Ink RGB(255,255,255),0: Text CursorX*CharWidth,CursorY*16,"_"
      Gosub UpdateMenu
      Sleep 80
    Endif
  Endif
 
  If Leftkey()=1 And CursorX >= 0: Rem Move Cursor Left
    Ink 0,0: Text CursorX*CharWidth,CursorY*16,"_"
    If CursorX >=1
      Dec CursorX
    Else
      If CursorY>0
        Dec CursorY: Gosub CheckScroll
        CurrentLineLen = Len(Lines$(CursorY+LineOffset))
        CursorX=CurrentLineLen: Rem New position at end of previous line
      Endif
    Endif
    Ink RGB(255,255,255),0: Text CursorX*CharWidth,CursorY*16,"_"
    Gosub UpdateMenu
    Sleep 50
  Endif
 
  If Rightkey()=1: Rem Move Cursor Right
    Ink 0,0: Text CursorX*CharWidth,CursorY*16,"_"
    CurrentLineLen = Len(Lines$(CursorY+LineOffset))
    If CursorX < ScrnCharWidth and CursorX < CurrentLineLen
      Inc CursorX
    Else
      If NumLines > CursorY+1+LineOffset
        Inc CursorY: Gosub CheckScroll
        CursorX=0: Rem New position at start of next line
      Endif
    Endif
    Ink RGB(255,255,255),0: Text CursorX*CharWidth,CursorY*16,"_"
    Gosub UpdateMenu
    Sleep 50
  Endif
 
  Rem ***** Load (Ctrl-L) *****
  If KeyState(38) = 1 And Scancode() = 29
    Rem Load A File
    Set Text Transparent
    Ink RGB(0,100,0),0: Box 0,465,639,479
    Ink RGB(255,255,255),RGB(0,100,0)
    Set Cursor 0,29*16: Input " Please Enter A Filename To Load (No Extension Required): ";FName$
    Repeat
    Until ReturnKey()=0
    FName$=FName$+".TXT": Rem <<< Choose your own filename extension here
    If File Exist(FName$) = 1
      UnDim Lines$(MaxLines): Rem Erase current string array
      Dim Lines$(MaxLines): Rem Recreate array (empty)
      Open To Read 1,FName$
        Read String 1, Temp$: NumLines=Val(Temp$)
        For N = 0 To NumLines-1
          Read String 1, Lines$(N)
        Next N
      Close File 1
      CursorX = 0: CursorY = 0: LineOffset=0
    Else
      Ink RGB(0,100,0),0: Box 0,465,639,479
      Ink RGB(255,255,0),RGB(0,100,0)
      Text 0,464," Sorry - That File Does Not Exist!"
      Sleep 4000
    Endif
    Gosub UpdateAllLines
    Gosub UpdateMenu
    rem Set Text Transparent: Sync
  Endif
 
  Rem ***** Save (Ctrl-S) *****
  If KeyState(31) = 1 And Scancode() = 29
    Rem Save A File
    Set Text Opaque: Sync
    Ink RGB(0,100,0),0: Box 0,465,639,479
    Ink RGB(255,255,255),RGB(0,100,0)
    Set Cursor 0,29*16: Input " Please Enter A Filename To Save (No Extension Required): ";FName$
    Repeat
    Until ReturnKey()=0
    FName$=FName$+".TXT": Rem <<< Choose your own filename extension here
    If File Exist(FName$) = 1 Then Delete File FName$
    Open To Write 1,FName$
      Write String 1, Str$(NumLines)
      For N = 0 To NumLines-1
        Write String 1, Lines$(N)
      Next N
    Close File 1
    Gosub UpdateAllLines
    Gosub UpdateMenu
    Set Text Transparent: Sync
  Endif
 
  Rem ***** Clear (Ctrl-C) *****
  If KeyState(46) = 1 And Scancode() = 29
    Rem Clear File
    Set Text Opaque: Sync
    Ink RGB(0,100,0),0: Box 0,465,639,479
    Ink RGB(255,255,255),RGB(0,100,0)
    Repeat
    Until Scancode() = 0
    CursorX=0: CursorY=0: NumLines=1
    UnDim Lines$(MaxLines): Rem Erase current string array
    Dim Lines$(MaxLines): Rem Recreate array (empty)
    Gosub UpdateAllLines
    Gosub UpdateMenu
    Set Text Transparent: Sync
  Endif
 
  Rem ***** Exit (Ctrl-X) *****
  If KeyState(45) = 1 And Scancode() = 29
    Rem Exit
    UnDim Lines$(MaxLines): Rem Erase current string array
    End
  Endif
Return
 
UpdateAllLines:
  Set Text Opaque
  Ink 0,0: Box 0,0,639,464
  Ink RGB(255,255,255),0
  For N = 0 To 28: Rem 28 Lines
    Text 0,N*16,Lines$(N+LineOffset): Rem Correct lines if scrolled
  Next N
  Set Text Transparent
  Text CursorX*CharWidth,CursorY*16,"_"
Return
 
UpdateMenu:
  Set Text Opaque: Sync
  Ink RGB(255,255,255),RGB(0,100,0)
  Text 0,464," Ctrl-S Save  Ctrl-L Load  Ctrl-C Clear  Ctrl-X Exit  L:"+Str$(NumLines)+"  CPos:"+Str$(CursorX+1)+"/"+Str$(CursorY+LineOffset+1)+"      ": Rem Bottom line reserved for menu commands
  Set Text Transparent: Sync
Return
 
CheckScroll:
  If CursorY > 28
    If CursorY+LineOffset < NumLines Then Inc LineOffset
    CursorY = 28
    Gosub UpdateAllLines
  Endif
  If CursorY < 0
    If LineOffset > 0 Then Dec LineOffset
    CursorY = 0
    Gosub UpdateAllLines
  Endif
Return