home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1989 February / 64er_Magazin_89-02_1989_Markt__Technik_de_Disk_1_of_2_Side_B.d64 / ram-font-lader (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  2KB  |  97 lines
  1. 100 rem *** ram-font-lader ***
  2. 120 rem ***** 12.5.1988 ******
  3. 130 :
  4. 1100 gn=peek(186):if gn<8 then gn=8
  5. 1130 cb=64:ct=66:ci=68:co=70:ef=72
  6. 1200 open 4,4,15:open2,4,0
  7. 1210 open 8,gn,15
  8. 1220 rem *** font-liste einlesen
  9. 1230 open1,gn,2,"font-liste,s,r"
  10. 1240 gosub7000:if a then gosub7200:run
  11. 1260 input#1,fa
  12. 1300 dim ft$(fa),fl(fa)
  13. 1340 for x=1 to fa
  14. 1360 input#1,fl(x),ft$(x) :next
  15. 1400 :
  16. 1420 rem *** font-nr erfragen
  17. 1450 print"":for x=1 to fa
  18. 1470 printx"[157].",ft$(x) :next
  19. 1500 print"welcher font soll
  20. 1530 [133]"geladen werden (nr.) ";n$
  21. 1550 n[178][197](n$):[139] n[178]0 [167] 1450
  22. 1560 ad[178]ct:[141]6600
  23. 1570 [139] fl(n)[177]wo[171]2048[171]100 [167] [153]"  die font-datei ist zu lang !":[137]1500
  24. 1590 :
  25. 1595 [143] *** font laden
  26. 1600 [158] 57812 (ft$(n)[170]",s"),gn
  27. 1620 [151]781,0:[151]782,48
  28. 1640 [151]780,0:[158]65493:[141]7000
  29. 1660 [139] a [167][141]7220:[137]1600
  30. 1680 :
  31. 1690 [143] *** empty-flag abfragen
  32. 1700 ad[178]ef:[141]6200:[139] by [167] 1900
  33. 1720 [153]"  der druckpuffer ist noch nicht leer.
  34. 1750 input"   soll das ende des druckvorgangs abge-  wartet werden (j/n) ";a$
  35. 1780 if a$="n" then 1900
  36. 1800 if a$<>"j" then 1700
  37. 1820 ad=ef:gosub6200:if by=0 then1820
  38. 1850 :
  39. 1890 rem *** pufferanfang auf $0800
  40. 1900 print#4,"u:"
  41. 1940 print#4,"p0"
  42. 1980 :
  43. 1990 rem *** font senden
  44. 2000 a$="[199][211][198]88-":for x=1 to 6
  45. 2020 print#2,mid$(a$,x,1);:next
  46. 2030 cmd2
  47. 2070 for x=3*4096 to x+fl(n)+4
  48. 2100 printchr$(peek(x));:next
  49. 2110 print#2:close2
  50. 2130 :
  51. 2160 rem *** neuen puffer-anfang setzen
  52. 2200 ad=ci:gosub6600
  53. 2230 ad=cb:gosub6800
  54. 2260 print#4,"c"
  55. 2280 print#4,"p1"
  56. 2300 print" der [198]ont ist uebertragen."
  57. 2320 input"   probeausdruck (j/n) ";a$
  58. 2350 if a$<>"j" then 3000
  59. 2380 open 6,4,6:print#6,"f00";
  60. 2400 for x=32 to 127
  61. 2430 print#6,chr$(x);:next:print#6
  62. 2460 close6
  63. 3000 close4:close8
  64. 3030 end
  65. 5900 :
  66. 6190 *** byte (ad) aus interface lesen
  67. 6200 h=int(ad/256):l=ad-256*h
  68. 6230 print#4,"m-r"chr$(l)chr$(h)chr$(1)
  69. 6260 get#4,b$:by=asc(b$+chr$(0))
  70. 6290 return
  71. 6350 :
  72. 6390 *** byte (ad) schreiben
  73. 6400 h=int(ad/256):l=ad-256*h
  74. 6430 print#4,"m-w"chr$(l)chr$(h)chr$(1)chr$(by):return
  75. 6550 :
  76. 6590 *** wort auslesen
  77. 6600 gosub6200:wo=by:ad=ad+1
  78. 6630 gosub6200:wo=wo+256*by
  79. 6650 return
  80. 6700 :
  81. 6750 *** wort schreiben
  82. 6800 wh=int(wo/256):by=wo-wh*256
  83. 6830 gosub6400:by=wh:ad=ad+1
  84. 6860 goto6400
  85. 6900 :
  86. 7000 input#8,a,b$,c,d
  87. 7030 print ""a;b$;c;d
  88. 7060 return
  89. 7090 :
  90. 7200 a$="font-liste":goto7300
  91. 7220 a$="font"
  92. 7300 print"   "a$" nicht gefunden !
  93. 7330 [153]"bitte richtige diskette
  94. 7360 print"einlegen & taste druecken.
  95. 7380 [151]198,0:[146]203,63:[161]a$
  96. 7400 [142]
  97.