home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Generous Efforts of Many
/
gemcd.zip
/
GEM.CD.A.po
/
FEATURES:BEAGLE
/
FONTMECH.PRO.S1
/
FONT.MECHANIC
/
FONT.SCALER.bas
< prev
next >
Wrap
BASIC Source File
|
2000-01-01
|
4KB
|
44 lines
0 REM <CTRL-M><CTRL-M>===============<CTRL-M> FONT SCALER<CTRL-M> (C) 1985<CTRL-M> MARK SIMONSEN<CTRL-M> BEAGLE BROS<CTRL-M>===============<CTRL-M>
1 IF PEEK(103) + PEEK(104) *256 < >2049 THEN POKE 2048,0: POKE 103,1: POKE 104,8: PRINT CHR$(4)"RUN FONT.SCALER"
2 SPEED= 255: NOTRACE : LOMEM: 32768: PRINT CHR$(21): TEXT : NORMAL :D$ = CHR$(4)
3 PRINT D$"BLOAD FONT.SCALER.ML"
4 HGR : HCOLOR= 3: ROT= 0: SCALE= 1:Z = 0:SZ = 0: CALL 16384 +27: GOSUB 39
5 DIM E$(13):E$(4) = "WRITE-PROTECT":E$(6) = "PATH NOT FOUND":E$(8) = "I/O":E$(9) = "DISK FULL":E$(10) = "FILE LOCKED":E$(11) = "SYNTAX":E$(13) = "FILE TYPE MISMATCH"
6 ONERR GOTO 41
7 HOME : VTAB 21: PRINT "SELECT:": GOSUB 40: PRINT "EDIT LOAD CATALOG" SPC( 13)"QUIT SAVE PREFIX";
8 INVERSE : VTAB 23: HTAB 1: PRINT "E";: HTAB 9: PRINT "L";: HTAB 17: PRINT "C";: HTAB 37: PRINT "Q": HTAB 9: PRINT "S";: HTAB 17: PRINT "P";: NORMAL
9 VTAB 21: HTAB 8: GOSUB 44:A$ = C$: IF A$ = "Q" THEN HOME : VTAB 21: PRINT "QUIT NOW? (Y/N): ";: GOSUB 44: ON C$ < >"Y" GOTO 7: HOME : VTAB 23: DEL 3,3: END
10 ON A$ = "E" GOTO 22: ON A$ = "L" GOTO 11: ON A$ = "S" GOTO 13: ON A$ = "C" GOTO 18: ON A$ = "P" GOTO 19: GOTO 9
11 HOME : VTAB 24: PRINT "<RETURN> TO ESCAPE";: VTAB 22: HTAB 1: INPUT "LOAD FONT NAMED:";F$: CALL -958: IF NOT LEN(F$) THEN 7
12 PRINT D$"BLOAD "F$",A$6000":SZ = 0:Z = PEEK(24577): HGR : CALL 16384 +18: GOTO 7
13 IF NOT SZ THEN HOME : VTAB 22: INVERSE : PRINT CHR$(7)" NOTHING TO SAVE ": NORMAL : GOSUB 38: GOTO 7
14 IF SZ = 1 THEN CALL 16384 +24
15 IF SZ = 2 THEN CALL 16384 +21
16 HOME : VTAB 24: PRINT "<RETURN> TO ESCAPE";: VTAB 22: HTAB 1: INPUT "SAVE FONT NAMED:";F$: CALL -958: IF NOT LEN(F$) THEN 7
17 PRINT D$"BSAVE "F$",A$6000,L" PEEK(0) +( PEEK(1) -96) *256: GOTO 7
18 TEXT : HOME : PRINT : PRINT D$"CAT": PRINT : GOSUB 40: PRINT "ANY KEY:";: GET A$: POKE -16304,0: GOTO 7
19 PRINT CHR$(4)"PREFIX": INPUT A$: HOME : VTAB 24: PRINT "<RETURN> TO ESCAPE";: VTAB 22: HTAB 1: PRINT "PREFIX:"A$;: VTAB 22: HTAB 8: CALL -657:A$ = "": FOR I = 512 TO 767: IF PEEK(I) < >141 THEN A$ = A$ + CHR$( PEEK(I) -128): NEXT
20 ON A$ = "" GOTO 7: PRINT CHR$(4)"PREFIX"A$: GOTO 7
22 IF NOT Z THEN HOME : VTAB 22: INVERSE : PRINT CHR$(7)" NOTHING TO EDIT ": NORMAL : GOSUB 38: GOTO 7
23 HOME : VTAB 21: PRINT "SELECT:": GOSUB 40: PRINT "TALL SHORT WIDE NARROW"
24 INVERSE : VTAB 23: HTAB 1: PRINT "T";: HTAB 9: PRINT "S";: HTAB 18: PRINT "W";: HTAB 26: PRINT "N": NORMAL
25 VTAB 21: HTAB 8: CALL -868: GOSUB 44:A$ = C$: ON A$ = CHR$(27) GOTO 7: ON A$ < = " " GOTO 25: PRINT A$;
26 HTAB 9: CALL -868: GOSUB 44:B$ = C$: ON B$ = CHR$(8) GOTO 25: ON B$ = CHR$(27) GOTO 7: ON B$ = CHR$(13) GOTO 28: ON B$ < = " " GOTO 26: PRINT B$;:A$ = A$ +B$
27 GOSUB 44:B$ = C$: ON B$ = CHR$(8) GOTO 26: ON B$ = CHR$(27) GOTO 7: ON B$ < > CHR$(13) GOTO 27
28 I = 0: IF A$ = "T" THEN CALL 16384:I = 1
29 IF A$ = "TW" OR A$ = "WT" THEN CALL 16384: CALL 16384 +12:I = 2
30 IF A$ = "TN" OR A$ = "NT" THEN CALL 16384: CALL 16384 +15:I = 3
31 IF A$ = "S" THEN CALL 16384 +3:I = 4
32 IF A$ = "SW" OR A$ = "WS" THEN CALL 16384 +3: CALL 16384 +12:I = 5
33 IF A$ = "SN" OR A$ = "NS" THEN CALL 16384 +3: CALL 16384 +15:I = 6
34 IF A$ = "W" THEN CALL 16384 +6:I = 7
35 IF A$ = "N" THEN CALL 16384 +9:I = 8
36 IF I THEN SZ = T(Z,I)
37 GOTO 25
38 FOR I = 1 TO 1999: NEXT : RETURN
39 FOR J = 1 TO 2: FOR I = 1 TO 8: READ T(J,I): NEXT : NEXT : RETURN : DATA 2,2,2,1,2,1,2,1,2,2,2,2,2,1,2,2
40 FOR I = 1 TO 40: PRINT "-";: NEXT : RETURN
41 CALL -3288: HOME : VTAB 22:I = PEEK(222)
42 INVERSE : IF I <14 THEN PRINT CHR$(7)" "E$(I)" ERROR "
43 FOR J = 1 TO 2000 -1999 *(I = 255): NEXT : NORMAL : POKE -16304,0: GOTO 7
44 GET C$:C$ = CHR$( ASC(C$) -32 *( ASC(C$) >95)): RETURN