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.DISPLAY.bas < prev    next >
BASIC Source File  |  2000-01-01  |  4KB  |  46 lines
  1. 0  REM <CTRL-M><CTRL-M>===============<CTRL-M> FONT DISPLAY<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.DISPLAY"
  3. 2  SPEED= 255: NOTRACE : LOMEM: 24576: PRINT  CHR$(21): TEXT : NORMAL :D$ =  CHR$(4)
  4. 3  PRINT D$"BLOAD FONT.DISPLAY.ML"
  5. 4  POKE 230,32: ROT= 0: SCALE= 1: DIM A$(34):F0 = 128:Z =  -958: GOTO 25
  6. 5  GET B$:B$ =  CHR$( ASC(B$) -32 *( ASC(B$) >95)): RETURN 
  7. 6  FOR I = 1 TO  LEN(A$): POKE 639 +I, ASC( MID$ (A$,I,1)) -31: NEXT :KFLAG = 0: CALL 7168
  8. 7  VTAB 21: HTAB 1: GOSUB 33: INVERSE : PRINT  LEFT$(A$,15);: CALL Z: NORMAL : HTAB 19: PRINT "<C> CHARACTER CODES": HTAB 19: PRINT "<M> MENU": PRINT "SELECT:";: HTAB 17: PRINT "<ESC> QUIT";: IF KFLAG  THEN  VTAB 22: HTAB 23: PRINT "CHANGE/ERASE CODES"
  9. 8  REM 
  10. 9  POKE  -16301,0
  11. 10  VTAB 24: HTAB 8: GOSUB 5:K$ = B$: IF K$ < >"M"  AND K$ < > CHR$(27)  AND K$ < >"C"  THEN 10
  12. 11  REM 
  13. 12 N$ = "": VTAB 24: HTAB 8: PRINT K$;: IF K$ =  CHR$(27)  THEN  VTAB 22: HTAB 1: CALL Z: PRINT "QUIT NOW? (Y/N): ";: GOSUB 5: ON B$ < >"Y" GOTO 7: POKE 34,0: VTAB 22: HTAB 1: CALL Z: DEL 3,3: END 
  14. 13  IF K$ = "C"  AND KFLAG = 0  THEN  VTAB 22: HTAB 18: CALL Z: VTAB 23: HTAB 18: PRINT "<A> ASCII NUMBERS      ADD A OR S?      <S> SHAPE NUMBERS";: HTAB 12: GOSUB 5:N$ = B$: PRINT N$;: IF N$ < >"A"  AND N$ < >"S"  THEN 13
  15. 14  IF N$ = "S"  AND KFLAG = 0  THEN KFLAG = 1:E$ = N$: CALL 7168 +3: GOTO 7
  16. 15  IF N$ = "A"  AND KFLAG = 0  THEN KFLAG = 1:E$ = N$: CALL 7168 +6: GOTO 7
  17. 16  IF K$ = "C"  AND KFLAG = 1  AND E$ = "S"  THEN KFLAG = 0: CALL 7168 +3: GOTO 7
  18. 17  IF K$ = "C"  AND KFLAG = 1  AND E$ = "A"  THEN KFLAG = 0: CALL 7168 +6: GOTO 7
  19. 18  TEXT 
  20. 19  VTAB 22: HTAB 1: POKE 34,21: CALL Z: PRINT : PRINT "< > SELECT FONT FOR DISPLAY  (ESC=QUIT)": HTAB 28: PRINT "(/=NEW DISK)";
  21. 20  VTAB 23: HTAB 2: GOSUB 5:K$ = B$:K =  ASC(K$) +F0: IF K < >155  AND K < >175  AND (K <192  OR K >218)  AND (K <177  OR K >183)  THEN 20
  22. 21  VTAB 23: HTAB 1: CALL Z: ON K = 175 GOTO 25: IF K = 155  THEN  HOME : PRINT : PRINT "QUIT NOW? (Y/N): ";: GOSUB 5: ON B$ < >"Y" GOTO 19: TEXT : VTAB 23: HTAB 1: CALL Z: DEL 3,3: END 
  23. 22  VTAB 22: HTAB 1: CALL Z: PRINT :II = (K -192 +42 *(K <192)):A$ = A$(II): IF   NOT  LEN(A$)  THEN 19
  24. 23  VTAB 22: CALL Z: IF A$ < >O$  THEN O$ = A$: PRINT D$"BLOAD ";A$;"   ,A$4000"
  25. 24  GOTO 6
  26. 25  TEXT : ONERR  GOTO 27
  27. 26  HOME : PRINT "INSERT DISK CONTAINING FONTS TO BE": PRINT "DISPLAYED AND PRESS RETURN (OR ENTER A": PRINT "PREFIX): ";: GOSUB 43: TEXT : NORMAL : GOTO 28
  28. 27  CALL  -3288: PRINT : INVERSE : PRINT "PATH NOT FOUND ERROR" CHR$(7): NORMAL : VTAB 24: PRINT "ANY KEY: ";: GET B$: GOTO 25
  29. 28  HOME : INVERSE : PRINT : PRINT " FONT DISPLAY ": NORMAL : GOSUB 33: VTAB 21: GOSUB 33: FOR I = 1 TO 17: VTAB I +3: PRINT "<" CHR$(I +64)">" SPC( 17)"<" CHR$(I +81 -42 *(I +17 >26))">": NEXT : ONERR  GOTO 34
  30. 29  VTAB 22: POKE 34,21: GOSUB 38: TEXT 
  31. 30  FOR I = 1 TO FI: VTAB I +3 -17 *(I >17): HTAB 5 +20 *(I >17): PRINT  LEFT$(A$(I),15): NEXT 
  32. 31  IF FI <34  THEN  FOR I = FI +1 TO 34: VTAB I +3 -17 *(I >17): HTAB 1 +19 *(I >17): CALL  -868: NEXT 
  33. 32  GOTO 19
  34. 33  FOR I = 1 TO 40: PRINT "-";: NEXT : RETURN 
  35. 34  PRINT  CHR$(7);: VTAB 22: HTAB 1: CALL Z: IF  PEEK(222) = 6  THEN  PRINT A$: INVERSE : PRINT " NOT FOUND ";: NORMAL : FOR I = 1 TO 999: NEXT : GOTO 37
  36. 35  IF  PEEK(222) = 255  THEN  POKE 34,0: VTAB 23: DEL 3,3: END 
  37. 36  PRINT "ERROR"
  38. 37 A$ = "":O$ = A$: FOR I = 1 TO 999: NEXT : GOTO 18
  39. 38  PRINT D$"PREFIX": INPUT P$: PRINT D$"OPEN "P$",TDIR": PRINT D$"READ "P$: INPUT L$: INPUT L$: INPUT L$:FI = 0
  40. 39  INPUT L$: IF L$ = ""  THEN 42
  41. 40  IF  MID$ (L$,2,2) = "F."  AND  MID$ (L$,18,3) = "BIN"  THEN FI = FI +1:A$(FI) =  MID$ (L$,2,15)
  42. 41  IF FI <34  THEN 39
  43. 42  PRINT D$"CLOSE "P$: RETURN 
  44. 43  CALL  -657:B$ = "": FOR I = 512 TO 767: IF  PEEK(I) < >141  THEN B$ = B$ + CHR$( PEEK(I) -128): NEXT 
  45. 44  ON B$ = "" GOTO 45: PRINT  CHR$(4)"PREFIX"B$
  46. 45  RETURN