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 >
BASIC Source File  |  2000-01-01  |  4KB  |  44 lines
  1. 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> 
  2. 1  IF  PEEK(103) + PEEK(104) *256 < >2049  THEN  POKE 2048,0: POKE 103,1: POKE 104,8: PRINT  CHR$(4)"RUN FONT.SCALER"
  3. 2  SPEED= 255: NOTRACE : LOMEM: 32768: PRINT  CHR$(21): TEXT : NORMAL :D$ =  CHR$(4)
  4. 3  PRINT D$"BLOAD FONT.SCALER.ML"
  5. 4  HGR : HCOLOR= 3: ROT= 0: SCALE= 1:Z = 0:SZ = 0: CALL 16384 +27: GOSUB 39
  6. 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"
  7. 6  ONERR  GOTO 41
  8. 7  HOME : VTAB 21: PRINT "SELECT:": GOSUB 40: PRINT "EDIT    LOAD    CATALOG" SPC( 13)"QUIT        SAVE    PREFIX";
  9. 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 
  10. 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 
  11. 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
  12. 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
  13. 12  PRINT D$"BLOAD "F$",A$6000":SZ = 0:Z =  PEEK(24577): HGR : CALL 16384 +18: GOTO 7
  14. 13  IF   NOT SZ  THEN  HOME : VTAB 22: INVERSE : PRINT  CHR$(7)" NOTHING TO SAVE ": NORMAL : GOSUB 38: GOTO 7
  15. 14  IF SZ = 1  THEN  CALL 16384 +24
  16. 15  IF SZ = 2  THEN  CALL 16384 +21
  17. 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
  18. 17  PRINT D$"BSAVE "F$",A$6000,L" PEEK(0) +( PEEK(1) -96) *256: GOTO 7
  19. 18  TEXT : HOME : PRINT : PRINT D$"CAT": PRINT : GOSUB 40: PRINT "ANY KEY:";: GET A$: POKE  -16304,0: GOTO 7
  20. 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 
  21. 20  ON A$ = "" GOTO 7: PRINT  CHR$(4)"PREFIX"A$: GOTO 7
  22. 22  IF   NOT Z  THEN  HOME : VTAB 22: INVERSE : PRINT  CHR$(7)" NOTHING TO EDIT ": NORMAL : GOSUB 38: GOTO 7
  23. 23  HOME : VTAB 21: PRINT "SELECT:": GOSUB 40: PRINT "TALL    SHORT    WIDE    NARROW"
  24. 24  INVERSE : VTAB 23: HTAB 1: PRINT "T";: HTAB 9: PRINT "S";: HTAB 18: PRINT "W";: HTAB 26: PRINT "N": NORMAL 
  25. 25  VTAB 21: HTAB 8: CALL  -868: GOSUB 44:A$ = C$: ON A$ =  CHR$(27) GOTO 7: ON A$ < = " " GOTO 25: PRINT A$;
  26. 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. 27  GOSUB 44:B$ = C$: ON B$ =  CHR$(8) GOTO 26: ON B$ =  CHR$(27) GOTO 7: ON B$ < > CHR$(13) GOTO 27
  28. 28 I = 0: IF A$ = "T"  THEN  CALL 16384:I = 1
  29. 29  IF A$ = "TW"  OR A$ = "WT"  THEN  CALL 16384: CALL 16384 +12:I = 2
  30. 30  IF A$ = "TN"  OR A$ = "NT"  THEN  CALL 16384: CALL 16384 +15:I = 3
  31. 31  IF A$ = "S"  THEN  CALL 16384 +3:I = 4
  32. 32  IF A$ = "SW"  OR A$ = "WS"  THEN  CALL 16384 +3: CALL 16384 +12:I = 5
  33. 33  IF A$ = "SN"  OR A$ = "NS"  THEN  CALL 16384 +3: CALL 16384 +15:I = 6
  34. 34  IF A$ = "W"  THEN  CALL 16384 +6:I = 7
  35. 35  IF A$ = "N"  THEN  CALL 16384 +9:I = 8
  36. 36  IF I  THEN SZ = T(Z,I)
  37. 37  GOTO 25
  38. 38  FOR I = 1 TO 1999: NEXT : RETURN 
  39. 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. 40  FOR I = 1 TO 40: PRINT "-";: NEXT : RETURN 
  41. 41  CALL  -3288: HOME : VTAB 22:I =  PEEK(222)
  42. 42  INVERSE : IF I <14  THEN  PRINT  CHR$(7)" "E$(I)" ERROR "
  43. 43  FOR J = 1 TO 2000 -1999 *(I = 255): NEXT : NORMAL : POKE  -16304,0: GOTO 7
  44. 44  GET C$:C$ =  CHR$( ASC(C$) -32 *( ASC(C$) >95)): RETURN