'===========================================================================
' Subject: PB EDITOR                          Date: 04-24-96 (10:58)       
'  Author: Alexander Podkolzin                Code: PB32                   
'  Origin: APP@nw.sbank.e-burg.su           Packet: TEXT.ABC
'===========================================================================
'
' Simple Editor. Author: Alexander Podkolzin <APP@nw.sbank.e-burg.su>
' Use it as you want...
' PowerBASIC 3.2+
' I'v deleted all block operations from the Editor, as they were
' very ... don't know how to name them (may be "dummy": initial file
' was 2 times longer).
' PLEASE, share with me your experience if you'll rewrite this code !
' I'll appreciate any respond of You !
' Thanks for paying attention to that Editor!
'
'----------------------------------------------------------------------
  $LIB ALL OFF
'----------------------------------------------------------------------
'
  %FALSE=0
  %TRUE=NOT %FALSE
  %MaxLines= 10000
  %MaxLen= 240
  %FastCur= 8
  %NormAttrib = &H07
  %BlockAttrib= &H17
  %KeyAttrib = &H1B
  %PathAttrib = &H0B
  %BlnkAttrib = %BlockAttrib +&H80
  %HelpAttrib = &H17
  %HotAttrib = &H15
  %LineAttrib = &H0A
'
  DEFINT a-z
'
  DIM Txt(%MaxLines) AS SHARED STRING
  DIM Ins AS SHARED INTEGER
  DIM nlines AS SHARED INTEGER
  DIM ScrnSeg AS INTEGER
'
  IF (pbvScrnCard AND 1) = 0 THEN
    ScrnSeg = &HB800              ' color monitor
  ELSE
    ScrnSeg = &HB000              ' mono monitor
  END IF
'
  y=CSRLIN
  x=POS(0)
  FileName$=COMMAND$
  IF LEN(FileName$)=0 THEN
     Cprint x,y,"USING: PBEDIT <File Name>",%NormAttrib
     END
  END IF
'
  IF NOT FileHere(FileName$) then
     Cprint x,y,"File not found !",%NormAttrib
     END
  END IF
'
  InsKey$=CHR$(0,82)
  Esc$=CHR$(27)
  Home$=CHR$(0,71)
  PgUp$=CHR$(0,73)
  PgDn$=CHR$(0,81)
  Up$=CHR$(0,72)
  Down$=CHR$(0,80)
  LeftKey$=CHR$(0,75)
  RightKey$=CHR$(0,77)
  CtrlPgUp$=CHR$(0,132)
  CtrlPgDn$=CHR$(0,118)
  CtrlHome$=CHR$(0,119)
  CtrlEnd$=CHR$(0,117)
  TabKey$=CHR$(9)
  EndKey$=CHR$(0,79)
  AltX$=CHR$(0,45)                ' Quit
'
  BcSp$ = CHR$(8)
  Enter$=CHR$(13)
  DelKey$=CHR$(0,83)
'
  CtrlB$=CHR$(2)
  CtrlC$=CHR$(3)
  CtrlK$=CHR$(11)
  CtrlL$=CHR$(12)
  CtrlN$=CHR$(14)
  CtrlQ$=CHR$(17)
  CtrlV$=CHR$(22)
  CtrlY$=CHR$(25)
'
  Ins=1
  IsChanged=%FALSE
'
  xb=1 : yb=1 : xe=80 : ye=24     ' Editor's window coordinates
'                                 ' "ye" has to be less then 25!
'
  Cprint 1,ye+1,space$(80),%BlockAttrib
'
  Win 1,xb,yb,xe,ye,7,0
'
  FOR i=yb+1 to ye-1
     Cprint xe,i,CHR$(177),%NormAttrib
  NEXT
'
  MYXA=1
'
  GOSUB LoadFile
'
  Cprint 3,ye,"<     :   =   >",%NormAttrib
'
  Cprint xe,yb+MYXA,CHR$(219),%NormAttrib
  DO
     Numerer nlines,lpage,begy,endy
     GOSUB PrepareScreen
     GOSUB ShowPage               ' lpage- length of window (page)
     Show=1                       ' begy - first line to show,
     IF nlines <1 then exit loop  ' endy - last line to show (array)
     WHILE NOT INSTAT: WEND       ' CurY - the cursor line
     Simb$=INKEY$
     DEF SEG=0
     POKE &H41C , peek(&H41A)     ' clear keyboard buffer
     DEF SEG
     SELECT CASE Simb$
        CASE InsKey$
           Ins = Ins xor 1
           Show=0
        CASE Home$
           CurX=2
           begx=1
        CASE EndKey$
           l=LEN(Txt(LineN))
           CurX=MIN(l+1,wpage)+1
           endx=MAX(l+1,wpage)+1
           begx=endx-wpage
        CASE Up$
           IF CurY >1 then
              decr CurY
              Show=0
           ELSE
              IF begy=1 then
                 Show=0
              END IF
              begy=begy-1
              endy=endy-1
              EXIT SELECT
           END IF
        CASE Down$
           IF CurY <lpage then
              INCR CurY
              Show=0
           ELSE
              IF endy=nlines then exit SELECT
              INCR begy
              INCR endy
           END IF
        CASE PgUp$
           begy=begy-lpage
           IF begy<=0 then begy=1
        CASE PgDn$
           begy=begy+lpage
           IF begy>=nlines-lpage+1 THEN begy=nlines-lpage+1
        CASE LeftKey$
           IF CurX >2 then
              decr CurX
              Show=0
           ELSE
              decr begx
              IF begx <1 then
                 begx=1
                 Show=0
              END IF
           END IF
        CASE TabKey$
           IF CurX <79-%FastCur then
              INCR CurX,%FastCur
              Show=0
           ELSE
              begx=begx+%FastCur
              IF begx >%MaxLen-79 then begx=%MaxLen-79
           END IF
        CASE RightKey$
           IF CurX <79 then
              INCR CurX
              Show=0
           ELSE
              INCR begx
              IF begx >%MaxLen-79 then begx=%MaxLen-79
           END IF
        CASE CtrlPgUp$
           begy=1
           CurX=2
           CurY=1
        CASE CtrlPgDn$
           begy=nlines-lpage+1
           CurX=xb+1
           CurY=ye-2
        CASE CtrlHome$
           CurY=1
           Show=0
        CASE CtrlEnd$
           CurY=ye-2
           Show=0
        CASE AltX$,Esc$
           EXIT LOOP
'
'~~~~~~~~~~~~~~   All other chars will change Txt()   ~~~~~~~~~~~~~~
        CASE Enter$
           IF Ins=1 then          ' IF "Ins" is ON
              IsChanged=%TRUE         ' Txt() is changed
              IF nlines=%MaxLines then
                 BEEP             ' too many strings
                 EXIT SELECT
              END IF
              BreakLine LineN,SimbN
           END IF
           CurX=2
           IF CurY < lpage then
              INCR CurY
           ELSE
              INCR begy
           END IF
           begx=1
'
        CASE DelKey$
           IsChanged=%TRUE
           l=LEN(Txt(LineN))
           IF SimbN=1 and l=0 then
              IF nlines>1 and LineN<>nlines THEN
                 DelLine LineN
                 INCR nlines
                 CurX=2
              END IF
           ELSEIF SimbN>l and LineN=nlines THEN
              EXIT SELECT
           ELSE
              IF SimbN>l then
                 f$=Txt(LineN)+space$(SimbN-l-1)
                 IF len(f$+Txt(LineN+1))>%MaxLen THEN
                    BEEP
                    EXIT SELECT
                 END IF
                 Txt(LineN)=f$+Txt(LineN+1)
                 INCR LineN
                 DelLine LineN
              ELSEIF l=1 then
                 Txt(LineN)=""
              ELSE
                 DelChar LineN,SimbN
              END IF
           END IF
'
        CASE BcSp$
           IsChanged=%TRUE
           IF SimbN=1 AND LineN=1 THEN EXIT SELECT
           IF SimbN=1 THEN
              IF nlines>1 THEN
                 sa$=Txt(LineN-1)
                 sb$=Txt(LineN)
                 DelLine LineN
                 Txt(LineN-1)=sa$+sb$
                 CurX=LEN(sa$)+2
                 IF LineN>1 THEN
                    IF endy=<nlines THEN DECR CurY
                    IF CurY<1 then
                       INCR CurY
                       DECR begy
                    END IF
                 END IF
              END IF
           ELSEIF SimbN>LEN(Txt(LineN))+1 THEN
              DECR CurX
           ELSE
              DECR SimbN
              DelChar LineN,SimbN
              DECR CurX
           END IF
'
        CASE CtrlY$
           IsChanged=%TRUE
           DelLine LineN
           begx=1
           CurX=2
'
        CASE CtrlN$
           IsChanged=%TRUE
           InsLine LineN
'
        CASE CtrlK$
           Cprint xb+1,ye+1,"^K",%BlockAttrib
           Cprint xb+4,ye+1,"more...",%BlnkAttrib
           LOCATE ye+1,xb+3
           WHILE NOT INSTAT: wend
           k$=INKEY$
           Cprint xb+1,ye+1,SPACE$(10),%BlockAttrib
           SELECT CASE k$
'
           END SELECT
        CASE CtrlQ$
'
        CASE ELSE
           IF LEN(Simb$)=1 and asc(Simb$)>31 THEN
              IsChanged=%TRUE
              Txt(LineN)=Txt(LineN)+space$(%MaxLen)
              IF Ins=1 THEN
                 InsChar LineN,SimbN,Simb$
              ELSE
                 ReplaceChar LineN,SimbN,Simb$
              END IF
              INCR CurX
              IF CurX=xe THEN
                 INCR begx
                 CurX=xe-1
              END IF
              Txt(LineN)=RTRIM$(Txt(LineN))
           END IF

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     END SELECT
  LOOP
  IF IsChanged THEN
     Win 1,xb+1,yb+1,xe-1,yb+3,7,1
     Cprint xb+3,yb+2,"File is changed, save ? (Y/N) ",%HelpAttrib
     DO
        WHILE NOT INSTAT: wend
        s$=INKEY$
        SELECT CASE s$
           CASE "Y","y"
              GOSUB SaveFile
              EXIT LOOP
           CASE "N","n"
              EXIT LOOP
        END SELECT
     LOOP
  END IF
'
' Clear screen before exit
'
  Cprint 1,1,space$(2000),%NormAttrib
  LOCATE ,,,11,12
  END
'----------------------------------------------------------------------

ShowPage:
  IF Show=0 THEN RETURN
  FOR i=1 TO lpage
     n = begy+i-1
     Txt(n)=RTRIM$(Txt(n))
     l = LEN(Txt(n))
     s$=MID$(Txt(n)+space$(%MaxLen - l),begx,wpage)
     Cprint xb+1,yb+i,s$,%NormAttrib
  NEXT i
  RETURN
'----------------------------------------------------------------------

PrepareScreen:
'
' Show Cursor:
'
  LineN=begy+CurY-1
  SimbN=begx+Curx-2
  Cprint 4,ye,RIGHT$("0000"+LTRIM$(STR$(LineN)),5),%PathAttrib
  Cprint 10,ye,RIGHT$("00"+LTRIM$(STR$(SimbN)),3),%PathAttrib
  Cprint 14,ye,RIGHT$("00"+LTRIM$(STR$(SCREEN(CurY+1,CurX ))),3),%PathAttrib
  IF CurX < xb+1 THEN CurX= xb+1
  IF CurX >xe-1 THEN CurX=xe-1
  IF CurY >nlines then CurY=nlines
  LOCATE yb+CurY,CurX,1
'
' Make Ruler:
'
  IF Nlines > lpage then
     om=MYXA
     MYXA=((begy+CurY-1)/nlines )*(ye-yb-1)
     IF MYXA=0 then MYXA=1
     IF om <> MYXA then
        Cprint xe,yb+om,CHR$(177),%NormAttrib
        Cprint xe,yb+MYXA,CHR$(219),%NormAttrib
     END IF
  END IF
'
' Show Keys:
'
  IF Ins=1 THEN
     LOCATE ,,,4,12
     sa$="INS"
  ELSE
     locate ,,,11,12
     sa$ = "   "
  END IF
  Cprint 71,ye+1,sa$,%BlockAttrib
'
' Show Size:
'
  Size&=-1
  FOR i=1 to nlines
     Size&=Size&+LEN(Txt(i))+2
  NEXT
  Cprint 35,ye,"<Lines:     >",%NormAttrib
  Cprint 65,ye,"<Size:",%NormAttrib
  Cprint 78,ye,">",%NormAttrib
  Cprint 42,ye,RIGHT$("      "+STR$(nlines),5),%PathAttrib
  Cprint 71,ye,RIGHT$("      "+STR$( Size&),7),%PathAttrib
'
' Check if the editor file is changed
'
  IF NOT IsChanged THEN
     Cprint 19,ye,"=",%NormAttrib
  ELSE
     Cprint 19,ye,"ö",%PathAttrib
  END IF
  RETURN
'----------------------------------------------------------------------
  FUNCTION FileHere (FileNAME$)
     S$=DIR$(FileNAME$)
     IF LEN(S$)=0 THEN
        FileHere = 0
     ELSE
        FileHere =-1
     END IF
  END FUNCTION
'----------------------------------------------------------------------
  SUB BreakLine(LineN,SimbN)      ' Separates LineN-th string for two
'                                 ' at SimbN-th position
     sa$=MID$(Txt(LineN),1,SimbN-1)
     sb$=MID$(Txt(LineN),SimbN,%MaxLen)
     ARRAY INSERT Txt(LineN)
     Txt(LineN)=sa$
     Txt(LineN+1)=sb$
     INCR nlines
  END SUB
'----------------------------------------------------------------------
  SUB DelLine(LineN)              ' Deletes LineN-th line
     ARRAY DELETE Txt(LineN)
     DECR nlines
  END SUB
'----------------------------------------------------------------------
  SUB InsLine(LineN)
     BreakLine LineN,LEN(Txt(LineN))+1
  END SUB
'----------------------------------------------------------------------
  SUB InsChar(LineN,SimbN,Simb$)
     s$=Txt(LineN)
     Txt(LineN)=LEFT$(s$,SimbN-1)+Simb$+RIGHT$(s$,LEN(s$)-SimbN+1)
  END SUB
'----------------------------------------------------------------------
' Replacement of a char
  SUB ReplaceChar(LineN,SimbN,Simb$)
     MID$(Txt(LineN),SimbN)=Simb$
  END SUB
'----------------------------------------------------------------------
  SUB DelChar(LineN,SimbN)
     s$=Txt(LineN)
     Txt(LineN)=LEFT$(s$,SimbN-1) + RIGHT$(s$,LEN(s$)-SimbN)
  END SUB
'---------------------------------------------------------------------------

SaveFile:
  IF NOT IsChanged THEN RETURN
  Cprint 3,ye+1,"Saving...",%BlnkAttrib
  n=INSTR(FileName$,".")
  IF n<>0 THEN
     n$=LEFT$(FileName$,n-1)      '
     e$=".APP"                    ' Extension for changed file.
  ELSE                            '
     n$=FileName$
     e$=".APP"
  END IF
  IF FileHere(n$+e$) THEN
     KILL n$+e$
  END IF
  DestFile=FREEFILE
  OPEN n$+e$ FOR OUTPUT AS DestFile
  FOR i=1 to nlines
     PRINT #DestFile,Txt(i)
  NEXT
  CLOSE DestFile
  Cprint 3,ye+1,SPACE$(10),%BlockAttrib
  IsChanged=%FALSE
  GOSUB PrepareScreen
  RETURN
'---------------------------------------------------------------------------

LoadFile:
  redim Txt(%MaxLines)
  Cprint 3,yb+1,"Loading...",%NormAttrib + &H80
  src=FREEFILE
  OPEN FileName$ FOR INPUT as src
  i=0
  DO WHILE EOF(src )=0 AND i < %MaxLines
     INCR i
     LINE INPUT #src,Txt(i)
' Double load time
     REPLACE CHR$(9) with "        " IN Txt(i )
  LOOP
  Size&= LOF(src )+1
  CLOSE src
  nlines=i+1
  Txt(nlines )=""
'
  x=(80- LEN(FileName$)) \ 2
  Cprint x-1,yb,repeat$(LEN(FileName$)+2,CHR$(196)),%NormAttrib
  Cprint x,yb,UCASE$(FileName$),%PathAttrib
  begx=1
  begy=1
  lpage=ye-yb-1
  wpage=xe-xb-1
  endy=MIN(lpage,nlines )
  CurY=1
  CurX=2
  SimbN=1
  Show=1
  LOCATE yb+1,xb+1
  RETURN
'---------------------------------------------------------------------------
' "Numerer" normalizes begy% and begx%
  SUB Numerer(nlines%,lpage%,begy%,endy%)
     IF nlines%<=lpage% THEN
        begy%=1
        endy%=nlines%
        EXIT SUB
     END IF
     IF begy%<1 THEN
        begy%=1
        endy%=begy%+lpage%-1
        EXIT SUB
     END IF
     IF begy%+lpage%-1>=nlines% THEN
        endy%=nlines%
        begy%=nlines%-lpage%+1
        EXIT SUB
     END IF
     endy%=begy%+lpage%-1
  END SUB
'----------------------------------------------------------------------------
  SUB Win(t%,xb%,yb%,xe%,ye%,ct%,cb%)
'
     OldColor% = pbvScrnTxtAttr   ' Internal PB variable
'
     SELECT CASE t%               ' Window types
'                                 ' (you can make as much types,
'                                 ' as you want):
        CASE 1
           a%=218:b%=196:c%=191   ' Single frame
           h%=179:      :d%=179
           g%=192:f%=196:e%=217
        CASE 2
           a%=201:b%=205:c%=187   ' Double frame
           h%=186:      :d%=186
           g%=200:f%=205:e%=188
        CASE ELSE
           a%=032:b%= a%:c%=a%    ' Blanks only
           h%= a%:      :d%=a%
           g%= a%:f%= a%:e%=a%
     END SELECT
'
     COLOR ct%,cb%
'
     LOCATE yb%,xb%
     PRINT CHR$(a%)+REPEAT$(xe%-xb%-1,CHR$(b%))+CHR$(c%);
'
     FOR i%=yb%+1 TO ye%-1
        LOCATE i%,xb%
        PRINT CHR$(h%) + SPACE$(xe%-xb%-1) +CHR$(d%);
     NEXT
'
     LOCATE ye%,xb%
     PRINT CHR$(g%)+REPEAT$(xe%-xb%-1,CHR$(f%))+CHR$(e%);
'
     ct%=OldColor% AND 15         ' restore colors
     cb%=OldColor% \ 16
     COLOR ct%,cb%
  END SUB
'----------------------------------------------------------------------------
  SUB PutAttribute(x%,y%,t%,b%)   ' Puts attribute byte to video memory
     LOCAL c%                     ' directly to Colomn, Row position
     c% = b%*16+t%
     DEF SEG = ScrnSeg
     POKE 160*(y%-1)+x%+x%-1,c%
     DEF SEG
  END SUB
'----------------------------------------------------------------------------
  SUB Cprint(x%,y%,s$,attr%)      ' Color printing
     LOCATE ,,0                   ' For more speed better to use
     REG 1,&H1300                 ' ASSEMBLER subroutine
     REG 2,attr%
     REG 3,LEN(s$)
     REG 4,(y%-1)*256+x%-1
     REG 9,STRSEG(s$)
     REG 7,STRPTR(s$)
     CALL INTERRUPT &H10
     LOCATE ,,1
  END SUB
'----------------------------------------------------------------------