' =============================================================================
'                   Source code: PowerBASIC for DOS

'           Author: Egbert Zijlema (e.zylema@castel.nl)
' Copyright status: Public Domain

' Font editor, to modify the character set in VGA textmode.
' Modified font will be saved onto a file. Therefore you must provide
' a filename by the command line, e.g.: FONTEDIT MYFONT.FNT

' Related article at: http://www.basicguru.com/zijlema/fonts.htm
' =============================================================================

DEFINT A - Z
DIM NewFont AS SHARED STRING
DIM FileName AS SHARED STRING

' equates for keys
%ALTX  = 45 * 256
%F10   = 68 * 256
%HOME  = 71 * 256
%UP    = 72 * 256
%LEFT  = 75 * 256
%RIGHT = 77 * 256
%END   = 79 * 256
%DOWN  = 80 * 256
%DEL   = 83 * 256
%ESC   = 27
%ENTER = 13

' equates for registers
%AX = 1 : %BX = 2 : %CX = 3
%DX = 4 : %BP = 7 : %ES = 9

CLS
  COLOR 15, 0
  LOCATE 1, 1 : PRINT "FONT EDITOR by Egbert Z"; CHR$(152); "lema"
  FileName = UCASE$(COMMAND$)
  IF FileName = "" THEN
    COLOR 7
    LOCATE 2, 1 : PRINT "Usage: FONTEDIT <fontfile>"
    SYSTEM
  END IF

  IF DIR$(FileName) = "" THEN
    GetDefaultFont NewFont
  ELSE
    OPEN FileName FOR BINARY AS #1
    SEEK #1, 0
    GET$ #1, LOF(1), NewFont
    CLOSE
    LoadFont NewFont, 256, 0               ' show font
  END IF
  MainMenu
END

SUB MainMenu
  DIM pattern$(1 : 16)
  FOR count = 0 TO 255
    DisplayFnt$ = DisplayFnt$ + CHR$(count)
  NEXT
  COLOR 15, 0
  LOCATE 3, 1 : PRINT DisplayFnt$

  ' draw rectangle
  LOCATE 7, 9 : PRINT CHR$(218); STRING$(8, 196); CHR$(191)
  FOR count = 8 TO 23
    LOCATE count, 9 : PRINT CHR$(179); SPACE$(8); CHR$(179)
  NEXT
  LOCATE 24, 9: PRINT CHR$(192); STRING$(8, 196); CHR$(217)

  ' display helptext
  COLOR 11
  LOCATE  8, 25 : PRINT "Main:"
  LOCATE 13, 25 : PRINT "Editor:"
  COLOR 7
  LOCATE  9, 25 : PRINT "Use left/right/up/down arrow to select character"
  LOCATE 10, 25 : PRINT "Press [ENTER] to edit pattern"
  LOCATE 11, 25 : PRINT "Press [Alt-x] to exit"
  LOCATE 14, 25 : PRINT "Use left/right/up/down arrow to move cursor"
  LOCATE 15, 25 : PRINT "[ENTER]    = add pixel"
  LOCATE 16, 25 : PRINT "[SPACEBAR] = erase pixel"
  LOCATE 17, 25 : PRINT "[DEL]      = erase whole pattern"
  LOCATE 18, 25 : PRINT "[ESC]      = quit editor without saving pattern"
  LOCATE 19, 25 : PRINT "[F10]      = save pattern"

  cursor = -1
  DO
    LOCATE , , 0
    IF cursor = -1 THEN MenuKey = %RIGHT ELSE MenuKey = GetKey
    SELECT CASE MenuKey
      CASE %HOME
        IF cursor THEN
          oldcur = cursor
          cursor = 0
        END IF
      CASE %END
        IF cursor < 255 THEN
          oldcur = cursor
          cursor = 255
        END IF
      CASE %LEFT
        IF cursor THEN
          oldcur = cursor
          DECR cursor
        END IF
      CASE %RIGHT
        IF cursor < 255 THEN
          oldcur = cursor
          INCR cursor
        END IF
      CASE %UP
        IF cursor > 79 THEN
          oldcur = cursor
          DECR cursor, 80
        END IF
      CASE %DOWN
        IF cursor + 80 < 256 THEN
          oldcur = cursor
          INCR cursor, 80
        END IF
      CASE %ENTER
        COLOR 11
        LOCATE 24, 25
        PRINT "Modifying CHR$("; LTRIM$(RTRIM$(STR$(cursor))); ")"
        EditPattern pattern$(), cursor   ' cursor is ascii value
    END SELECT
    DEF SEG = &HB800                     ' load video-segment
    POKE oldcur * 2 + 321, 15            ' restore prev. position
    POKE cursor * 2 + 321, 63            ' selection = white on cyane
    DEF SEG
    char$ = MID$(NewFont, cursor * 16 + 1, 16)  ' grab charpattern
    FOR count = 1 TO 16
      pattern$(count) = RIGHT$("00000000" + _
                        BIN$(ASC(MID$(char$, count, 1))), 8)
      REPLACE CHR$(48) WITH CHR$(32) IN pattern$(count)
      REPLACE CHR$(49) WITH CHR$(219) IN pattern$(count)
      COLOR 7
      LOCATE count + 7, 10
      PRINT pattern$(count)
    NEXT
  LOOP UNTIL MenuKey = %ALTX
  SCREEN , 0
  SYSTEM
END SUB

FUNCTION GetKey AS INTEGER
  DO
  LOOP UNTIL INSTAT
  FUNCTION = CVI(INKEY$ + CHR$(0))
END FUNCTION

SUB EditPattern(pattern$(), aski)
  row = 8
  DO
    editor row, 10, pattern$(row - 7), pattern$()
  LOOP UNTIL row > 23
  COLOR 7
  LOCATE 24, 25 : PRINT SPACE$(19)
  IF row = 25 THEN EXIT SUB      ' don't save modifications
  char$ = ""
  FOR count = 1 TO 16
    REPLACE CHR$(32) WITH CHR$(48) IN pattern$(count)
    REPLACE CHR$(219) WITH CHR$(49) IN pattern$(count)
    char$ = char$ + CHR$(VAL("&B" + pattern$(count)))
  NEXT
  NewFont = LEFT$(NewFont, aski * 16) + _
            char$ + _
            MID$(NewFont, aski * 16 + 17)
  IF LEN(DIR$(FileName)) THEN KILL FileName    ' delete old fontfile
  OPEN FileName FOR BINARY AS #1
  SEEK #1, 0
  PUT$ #1, NewFont
  CLOSE
  LoadFont char$, 1, aski                      ' show new character
END SUB

SUB editor(row, col, text$, pattern$())
  STATIC cursor
  COLOR 7, 0
  LOCATE row, col : PRINT text$
  IF cursor = 0 THEN cursor = 1               ' start position

  DO
    IF SCREEN(row, col + cursor - 1) = 219 THEN
      ' if character on cursor position = CHR$(219)
      ' we replace it (on screen only!) by an inverse space
      ' this to assure cursor visibility

      COLOR 0, 7
      LOCATE row, col + cursor - 1
      PRINT CHR$(32)
    END IF
    COLOR 7, 0                                ' restore color
    LOCATE row, col + cursor - 1, 1           ' visible cursor
    KeyIn = GetKey
    SELECT CASE KeyIn
      CASE %HOME : cursor = 1
      CASE %END  : cursor = LEN(text$)
      CASE %LEFT
        IF cursor > 1 THEN DECR cursor
      CASE %RIGHT
        IF cursor < LEN(text$) THEN INCR cursor
      CASE %UP
        IF row > 8 THEN
          DECR row
          EXIT DO
        END IF
      CASE %DOWN
        IF row < 23 THEN INCR row
        EXIT DO
      CASE %ESC                                        ' quit
        COLOR 7                                        ' unbold
        LOCATE row, col : PRINT text$
        row = 25
        EXIT SUB
      CASE %F10                                        ' quit and save
        row = 24
        EXIT DO
      CASE %DEL                                        ' erase pattern
        FOR countrow = 8 TO 23
          pattern$(countrow - 7) = STRING$(8, 32)
          LOCATE countrow, 10 : PRINT pattern$(countrow - 7)
        NEXT
        row = 8
        EXIT DO
      CASE 32, %ENTER                                  ' SPACE/ENTER
        IF KeyIn = %ENTER THEN KeyIn = 219
        text$ = LEFT$(text$, cursor - 1) + CHR$(KeyIn) + _
                MID$(text$, cursor + 1)
    END SELECT
    LOCATE row, col : PRINT text$
  LOOP
END SUB

SUB GetDefaultFont(CharSet$)
  REG %AX, &H1130                         ' service
  REG %BX, &H0600                         ' get vga-pattern
  CALL INTERRUPT &H10
  segment = REG(%ES)                      ' segment in ES
  pointer = REG(%BP)                      ' offset in BP
  DEF SEG = segment                       ' load segment
  CharSet$ = PEEK$(pointer, 4096)         ' grab 4096 bytes (= 256 chars)
  DEF SEG
END SUB

SUB LoadFont(CharSet$, HowMany, Where)
  REG %AX, &H1100                 ' service for AX
  REG %BX, &H1000                 ' 16 bytes per char in BH
  REG %CX, HowMany                ' nbr of characters in CX
  REG %DX, Where                  ' first char in ASCII-set to modify
  REG %ES, STRSEG(CharSet$)       ' varseg in ES
  REG %BP, STRPTR(CharSet$)       ' varptr in BP
  CALL INTERRUPT &H10
END SUB