home *** CD-ROM | disk | FTP | other *** search
/ Generous Efforts of Many / gemcd.zip / GEM.CD.A.po / FEATURES:BEAGLE / SHAPE.MECH1.SHK / SHAPE.MECHANIC / XTYPER.bas < prev    next >
BASIC Source File  |  2000-01-01  |  5KB  |  61 lines
  1. 0  REM <CTRL-M><CTRL-M>===============<CTRL-M> XTYPER<CTRL-M> (C) 1985<CTRL-M> BERT KERSEY &<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 XTYPER"
  3. 2  SPEED= 255: NOTRACE : LOMEM: 32768: PRINT  CHR$(21): TEXT : NORMAL :D$ =  CHR$(4)
  4. 3  PRINT D$"BLOAD CURSORS,A$4000": PRINT D$"BLOAD XTYPER.ML"
  5. 4 Q =  -16384:G$ =  CHR$(7):T = 256: POKE 230,32
  6. 5  GOTO 7
  7. 6  CALL 5120: GOTO 8
  8. 7 FLOC(1) = 16640:FLOC(2) = FLOC(1):FLOC(3) = FLOC(1)
  9. 8  NORMAL : HOME : TEXT : VTAB 1: HTAB 1: PRINT "XTYPER LETS YOU TYPE CHARACTERS ONTO THEHI-RES SCREEN USING SHAPE-FONTS. YOU MAYSAVE THE COMPLETED PICTURE TO DISK AFTERPRESSING <ESC> TO RETURN TO THIS MENU.": NORMAL 
  10. 9  VTAB 6: HTAB 1: CALL  -958: INVERSE : PRINT " TYPE A NUMBER TO LOAD A FONT:": NORMAL : GOSUB 55: PRINT "<1> FONT:"FT$(1): PRINT "<2> FONT:"FT$(2): PRINT "<3> FONT:"FT$(3)
  11. 10  PRINT : INVERSE : PRINT " OR SELECT:": NORMAL : GOSUB 55: PRINT "<E> ERASE HI-RES SCREEN"
  12. 11  PRINT "<L> LOAD HI-RES PICTURE": PRINT "<S> SAVE EXISTING PICTURE": PRINT "<C> CATALOG DISK (OR LOCK/UNLOCK FILES)": PRINT "<P> PREFIX": PRINT "<Q> QUIT PROGRAM": PRINT 
  13. 12  PRINT "<RETURN> BEGIN TYPING": PRINT "<ESC>    RETURN TO THIS MENU"
  14. 13  FOR J = 1 TO 9:S =  PEEK(Q +48): NEXT 
  15. 14  POKE  -16368,0: VTAB 24: PRINT "SELECT: < >" CHR$(8) CHR$(8);: GOSUB 56:A$ = Z$: IF A$ > = " "  THEN  PRINT A$">";
  16. 15  FOR I = 1 TO 500: NEXT : FOR I = 1 TO 2: FOR J = 1 TO 9:S =  PEEK(Q +48): NEXT : FOR J = 1 TO 40: NEXT : NEXT 
  17. 16  IF A$ < > CHR$(13)  THEN 19
  18. 17  IF FT$(1) = ""  AND FT$(2) = ""  AND FT$(3) = ""  THEN  VTAB 24: HTAB 1: CALL  -958: INVERSE : PRINT G$" NO FONTS LOADED ";: NORMAL : GOSUB 54: GOTO 8
  19. 18  POKE 216,0: GOTO 6
  20. 19  IF A$ <"1"  OR A$ >"3"  THEN 34
  21. 20  ONERR  GOTO 29
  22. 21  IF (A$ = "3"  OR A$ = "2")  AND   NOT ( LEN(FT$(1)))  THEN A$ = "1"
  23. 22  IF A$ = "3"  AND   NOT ( LEN(FT$(2)))  THEN A$ = "2"
  24. 23 FT =  VAL(A$): VTAB 6: HTAB 1: CALL  -868: INVERSE : PRINT " TYPE NAME OF FONT TO BE LOADED:";: NORMAL : VTAB 7 +FT: HTAB 9: CALL  -868: INPUT ":";A$: IF   NOT  LEN(A$)  THEN 8
  25. 24 A$ =  LEFT$(A$,30)
  26. 25  VTAB 6: HTAB 1: CALL  -868: PRINT D$"BLOAD "A$",A"FL(FT): POKE 5120 +2 +FT *2,FL(FT) - INT(FL(FT)/T) *T: POKE 5120 +3 +FT *2, INT(FL(FT)/T)
  27. 26  CALL 5120 +104:FL(FT +1) = FL(FT) + PEEK(5120 +107) + PEEK(5120 +108) *T +1:FL(FT +2) = FL(FT +1):FT$(FT) = A$:FT$(FT +1) = "":FT$(FT +2) = "": POKE 5120 +3,FT
  28. 27  POKE 5120 +10 +(FT -1) *31, LEN(A$): FOR I = 1 TO  LEN(A$): POKE 5120 +10 +(FT -1) *31 +I, ASC( MID$ (A$,I,1)): NEXT 
  29. 28  GOTO 8
  30. 29  VTAB 5
  31. 30  CALL  -3288: PRINT : INVERSE : CALL  -868: PRINT G$G$;: IF  PEEK(222) = 6  THEN  PRINT " PATH NOT FOUND ";: GOTO 33
  32. 31  IF  PEEK(222) = 10  THEN  PRINT " FILE LOCKED ";: GOTO 33
  33. 32  PRINT " ERROR ";
  34. 33  CALL  -868: NORMAL : GOSUB 54: POKE 216,0: HOME : GOTO 8
  35. 34  IF A$ = "Q"  THEN  VTAB 24: HTAB 1: CALL  -868: PRINT "QUIT NOW? (Y/N): ";: GOSUB 56: ON Z$ < >"Y" GOTO 8: VTAB 24: HTAB 1: CALL  -868: VTAB 23: DEL 3,3: END 
  36. 35  IF A$ = "P"  THEN  GOSUB 57: GOTO 8
  37. 36  IF A$ < >"C"  THEN 45
  38. 37  ONERR  GOTO 30
  39. 38  VTAB 20: PRINT : CALL  -958: PRINT D$"CAT"
  40. 39  GOSUB 55: PRINT "HIT <RETURN>:   OR <L>=LOCK, <U>=UNLOCK";: HTAB 15: GOSUB 56:A$ = Z$: PRINT A$: IF A$ =  CHR$(13)  THEN 44
  41. 40  IF A$ < >"U"  AND A$ < >"L"  THEN 39
  42. 41  HTAB 1: CALL  -958:L$ = "LOCK": IF A$ = "U"  THEN L$ = "UNLOCK"
  43. 42  PRINT "NAME OF FILE TO "L$;: INPUT ":";F$
  44. 43  IF  LEN(F$)  THEN  PRINT D$L$" "F$
  45. 44  POKE 216,0: HOME : GOTO 8
  46. 45  IF A$ < >"L"  AND A$ < >"S"  THEN 50
  47. 46  VTAB 21: HTAB 1: CALL  -958: VTAB 23: PRINT "<RETURN> TO CANCEL": VTAB 21: ONERR  GOTO 30
  48. 47  IF A$ = "L"  THEN  INPUT "LOAD PICTURE NAMED:";F$: IF  LEN(F$)  THEN  CALL  -958: PRINT : PRINT D$"BLOAD "F$",A$2000"
  49. 48  IF A$ = "S"  THEN  INPUT "SAVE PICTURE NAMED:";F$: IF  LEN(F$)  THEN  CALL  -958: PRINT : PRINT D$"BSAVE "F$",A$2000,L$2000"
  50. 49  POKE 216,0: GOTO 8
  51. 50  IF A$ < >"E"  THEN 8
  52. 51  VTAB 21: HTAB 1: CALL  -958: PRINT "ERASE EXISTING HI-RES IMAGE? (Y/N):";: GOSUB 56:F$ = Z$: IF F$ = "N"  THEN 8
  53. 52  IF F$ = "Y"  THEN  HCOLOR=  PEEK(5120 +103): HPLOT 0,0: CALL 62454: POKE 5120 +109,0: POKE 5120 +110,0: POKE 5120 +111,0: GOTO 8
  54. 53  GOTO 51
  55. 54  FOR I = 1 TO 999: NEXT : RETURN 
  56. 55  FOR I = 1 TO 40: PRINT "-";: NEXT : RETURN 
  57. 56  GET Z$:Z$ =  CHR$( ASC(Z$) -32 *( ASC(Z$) >95)): RETURN 
  58. 57  VTAB 21: HTAB 1: CALL  -958: VTAB 23: PRINT "<RETURN> TO CANCEL": VTAB 21: ONERR  GOTO 30
  59. 58  PRINT  CHR$(4)"PREFIX": INPUT A$: VTAB 21: PRINT "PREFIX:"A$;: VTAB 21: HTAB 8: CALL  -657:A$ = "": FOR I = 512 TO 767: IF  PEEK(I) < >141  THEN A$ = A$ + CHR$( PEEK(I) -128): NEXT 
  60. 59  ON A$ = "" GOTO 60: PRINT  CHR$(4)"PREFIX"A$
  61. 60  POKE 216,0: RETURN