Font editor

 BBS: Inland Empire Archive
Date: 02-20-93 (14:15)             Number: 393
From: JON SPRINGER                 Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Font editor                    Conf: (2) Quik_Bas

'Part 1 of Font 2.5 starts here

DEFINT A-Z
DECLARE SUB Get.input ()
DECLARE SUB editor ()
DECLARE SUB In.key ()
DECLARE SUB Out.alphabet ()
DECLARE SUB Save.font ()
DECLARE SUB Load.font ()
DECLARE SUB Put.pixel ()
DECLARE SUB Help ()
DECLARE SUB Fill ()
DECLARE SUB Insert ()
DECLARE SUB Delete ()
DECLARE SUB Gets.puts ()
DIM SHARED font(62, 16, 16), store(16, 16),box(1 TO 2), grid(16, 16)
DIM SHARED i, z, a$, k$, name$, flag, delay ,down, across, X, Y
DIM SHARED maxacross, maxdown, cell, gonk
ON ERROR GOTO Handler
LET box(1) = 16: box(2) = 16:maxacross = 64:maxdown = 35
    down = 1: across = 1:name$ = "default":delay = 60
KEY 1, CHR$(176): KEY 2, CHR$(177):SCREEN 9: COLOR 11, 8: WIDTH 80,25
'-----------------------------------------------------------------
main:
CLS:Get.input:CLS
maxacross=INT(640/box(1)):maxdown=INT(350/box(2)):z = 0: i = 0:a$ =""
edit.start:
   editor
GOTO main:
Handler:
     BEEP
     SELECT CASE ERR
     CASE 52 TO 67
     PRINT:PRINT "An error in file-handling has occurred..."
     PRINT "Any key...": a$ = INPUT$(1)
     CLOSE : SCREEN , , 0, 0: COLOR 13, 8
     CASE 6
     PRINT "Bad input...Try again"; : a$ = INPUT$(1)
     RESUME main
     CASE ELSE
     SCREEN , , 0, 0: CLS : PRINT "Unrecoverable Error #"; ERR
     IF ERR=5 THEN PRINT "256k EGA required for FONT...":a$=INPUT$(1)
     END
     END SELECT
     RESUME edit.start

SUB Delete
PALETTE 12, 13
  FOR i = cell + 1 TO 62
    FOR glom = 1 TO box(1)
      FOR glim = 1 TO box(2)
        LET font(i - 1, glom, glim) = font(i, glom, glim)
      NEXT
    NEXT
  NEXT
    FOR glom = 1 TO box(1)
      FOR glim = 1 TO box(2)
        LET font(62, glom, glim) = 0
      NEXT
    NEXT:Out.alphabet:  i = 0
END SUB

--- QuickBBS 2.76
 * Origin: Programmers Information Exchange   (206) 283-5978 (1:343/27)