home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / MISC / SPE.ZIP / FONTEDIT.BAS < prev    next >
Encoding:
BASIC Source File  |  1987-06-14  |  7.2 KB  |  290 lines
  1. 00005  REM Basic Program
  2. 00007  REM                 created                  :  13.06.87
  3. 00009  REM                 from                     :  Volker Sasse
  4. 00011  REM Structogram     saved on disk            :  Basic-Sicher
  5. 00013  REM                 filename                 :  fontedit.spe
  6. 00015  REM
  7. 00017  REM This program is a font editor for the structogram printer
  8. 00023  REM Druckmatrix : Hight = 9 Points, Wwidth = 8 Points
  9. 00025      Hight = 10 : Wwidth = 8
  10. 00027  DIM Char$(10, 12)
  11. 00029      Free$  = CHR$(249) : Taken$ = CHR$(178)
  12. 00031  DIM High$(255), Low$(255)
  13. 00033      Number = 0 : Vorschub1 = 5 : Vorschub2 = 5 : Font$ = ""
  14. 00035      PWwidth = 4 : PHight = 2 : Oben = 4 : Links = 15
  15. 00041  REM Initialisierungen
  16. 00043  COLOR 7,0 : CLS : KEY OFF
  17. 00045 gosub 00497
  18. 00053   FOR T=1 TO Wwidth
  19. 00063   Hilf$=Hilf$ + CHR$(0)
  20. 00065 next
  21. 00066 rem 
  22. 00073   FOR T=0 TO 255
  23. 00083   High$(T)=Hilf$ : Low$(T)=High$(T)
  24. 00085 next
  25. 00086 rem 
  26. 00095   FOR Z=1 TO Hight
  27. 00107   FOR S=1 TO Wwidth
  28. 00117  Char$( Z, S) = Free$
  29. 00119 next
  30. 00120 rem 
  31. 00121 next
  32. 00122 rem 
  33. 00129 gosub 00533
  34. 00131  Z=1 : S=1
  35. 00133 gosub 00587
  36. 00139 rem 
  37. 00151  REM Main menu
  38. 00153  a$=INKEY$
  39. 00165 rem 
  40. 00169      IF LEN(a$)=1 AND a$="q"  goto 00173 else goto 00211 
  41. 00173 rem 
  42. 00177  LOCATE 4,1 : PRINT STRING$(79," ")
  43. 00179  LOCATE 4,1 : INPUT "Do you want to leave (y)"; a$
  44. 00187   IF a$="y" goto 00191 else goto 00199 
  45. 00191 rem 
  46. 00193  CLS
  47. 00195  goto 00250
  48. 00198  goto 00203
  49. 00199 rem 
  50. 00201 gosub 00497
  51. 00203 rem 
  52. 00207  goto 00245
  53. 00211 rem 
  54. 00215      IF LEN(a$)=1  goto 00219 else goto 00227 
  55. 00219 rem 
  56. 00221 gosub 00261
  57. 00223  goto 00245
  58. 00227 rem 
  59. 00231      IF LEN(a$)=2  goto 00235 else goto 00243 
  60. 00235 rem 
  61. 00237 gosub 00381
  62. 00239  goto 00245
  63. 00243 rem 
  64. 00245 rem 
  65. 00249  goto 00139
  66. 00250 rem 
  67. 00255  END
  68. 00260  end
  69. 00261 rem 
  70. 00263 rem  Befehl
  71. 00281 rem 
  72. 00285   IF a$=   "+"  goto 00289 else goto 00299 
  73. 00289 rem 
  74. 00291  Char$(Z,S)=Taken$ 
  75. 00293 gosub 00587
  76. 00295  goto 00367
  77. 00299 rem 
  78. 00303   IF a$=   "-"  goto 00307 else goto 00317 
  79. 00307 rem 
  80. 00309  Char$(Z,S)=Free$
  81. 00311 gosub 00587
  82. 00313  goto 00367
  83. 00317 rem 
  84. 00321   IF a$=   "l"  goto 00325 else goto 00333 
  85. 00325 rem 
  86. 00327 gosub 00975
  87. 00329  goto 00367
  88. 00333 rem 
  89. 00337   IF a$=   "s"  goto 00341 else goto 00349 
  90. 00341 rem 
  91. 00343 gosub 01071
  92. 00345  goto 00367
  93. 00349 rem 
  94. 00353   IF a$=   CHR$(13) goto 00357 else goto 00365 
  95. 00357 rem 
  96. 00359 gosub 00677
  97. 00361  goto 00367
  98. 00365 rem 
  99. 00367 rem 
  100. 00375 return
  101. 00380  end
  102. 00381 rem 
  103. 00383 rem  Cursorsteuerung
  104. 00401 rem 
  105. 00405   IF MID$(a$, 2, 1)=   CHR$(80) AND Z>1  goto 00409 else goto 00421 
  106. 00409 rem 
  107. 00411 gosub 00619
  108. 00413  Z=Z-1
  109. 00415 gosub 00587
  110. 00417  goto 00483
  111. 00421 rem 
  112. 00425   IF MID$(a$, 2, 1)=   CHR$(72) AND Z<Hight  goto 00429 else goto 00441 
  113. 00429 rem 
  114. 00431 gosub 00619
  115. 00433  Z=Z+1
  116. 00435 gosub 00587
  117. 00437  goto 00483
  118. 00441 rem 
  119. 00445   IF MID$(a$, 2, 1)=   CHR$(77) AND S<Wwidth  goto 00449 else goto 00461 
  120. 00449 rem 
  121. 00451 gosub 00619
  122. 00453  S=S+1
  123. 00455 gosub 00587
  124. 00457  goto 00483
  125. 00461 rem 
  126. 00465   IF MID$(a$, 2, 1)=   CHR$(75) AND S>1  goto 00469 else goto 00481 
  127. 00469 rem 
  128. 00471 gosub 00619
  129. 00473  S=S-1
  130. 00475 gosub 00587
  131. 00477  goto 00483
  132. 00481 rem 
  133. 00483 rem 
  134. 00491 return
  135. 00496  end
  136. 00497 rem 
  137. 00499 rem  HeadLine
  138. 00509  LOCATE 1,1
  139. 00511  PRINT "Cursor=move field, Return=choose char, +=field on, -=field off" 
  140. 00513  PRINT "q=quit, l=load font, s=save font" 
  141. 00515  PRINT
  142. 00517  PRINT STRING$(79, " ")
  143. 00519  LOCATE 4,1
  144. 00521  PRINT "Font="; Font$; ".fon"; "  shown char="; Number; "  screen char "; CHR$(Number);
  145. 00527 return
  146. 00532  end
  147. 00533 rem 
  148. 00535 rem  PrintChar
  149. 00547   FOR BZ=PHight TO PHight * (Hight + 1) - 1
  150. 00559   LOCATE BZ + Oben, Links
  151. 00561   FOR BS=PWwidth TO PWwidth * (Wwidth + 1) - 1
  152. 00571   PRINT Char$( Hight + 1 - INT(BZ / PHight), INT(BS / PWwidth));
  153. 00573 next
  154. 00574 rem 
  155. 00575 next
  156. 00576 rem 
  157. 00581 return
  158. 00586  end
  159. 00587 rem 
  160. 00589 rem  PrintCurField
  161. 00601   COLOR 0, 7
  162. 00603 gosub 00619
  163. 00605   COLOR 7, 0
  164. 00613 return
  165. 00618  end
  166. 00619 rem 
  167. 00621 rem  HideCurField
  168. 00635   FOR BZ=PHight * Z   TO  PHight * (Z + 1) - 1
  169. 00647   LOCATE (Hight + 1) * PHight - BZ + Oben + 1, PWwidth * (S - 1) + Links
  170. 00649   FOR BS=PWwidth * S   TO   PWwidth * (S + 1) - 1
  171. 00659   PRINT Char$( INT(BZ / PHight), INT(BS / PWwidth));
  172. 00661 next
  173. 00662 rem 
  174. 00663 next
  175. 00664 rem 
  176. 00671 return
  177. 00676  end
  178. 00677 rem 
  179. 00679 rem  Charwaehlen
  180. 00689 gosub 00715
  181. 00691  LOCATE 4,1 : PRINT STRING$(79, " ")
  182. 00693  LOCATE 4,1 : INPUT "Which char "; Number
  183. 00695 gosub 00497
  184. 00697 gosub 00851
  185. 00699 gosub 00533
  186. 00701  Z=1 : S=1
  187. 00703 gosub 00587
  188. 00709 return
  189. 00714  end
  190. 00715 rem 
  191. 00717 rem  SaveChar
  192. 00729  High$(Number)="" : Low$(Number)=""
  193. 00739   FOR t=1 to Wwidth
  194. 00753   Summe=0
  195. 00755   FOR g=Vorschub1 + 1 TO Hight
  196. 00767   IF Char$(g, t)=Taken$ goto 00771 else goto 00781 
  197. 00771 rem 
  198. 00775  Summe=Summe + 2^(g - Vorschub1 - 1) 
  199. 00781 rem 
  200. 00783 rem 
  201. 00785 next
  202. 00786 rem 
  203. 00793   High$(Number)=High$(Number) + CHR$(Summe)
  204. 00795   Summe=0
  205. 00797   FOR g=1 TO Hight - Vorschub1
  206. 00809   IF Char$(g, t)=Taken$ goto 00813 else goto 00819 
  207. 00813 rem 
  208. 00815  Summe=Summe + 2^(g - 1) 
  209. 00818  goto 00823
  210. 00819 rem 
  211. 00821  REM Leer
  212. 00823 rem 
  213. 00825 next
  214. 00826 rem 
  215. 00831   Low$(Number)=Low$(Number) + CHR$(Summe)
  216. 00835 next
  217. 00836 rem 
  218. 00845 return
  219. 00850  end
  220. 00851 rem 
  221. 00853 rem  GetChar
  222. 00867   FOR t=1 to Wwidth
  223. 00881   Summe=ASC(MID$(High$(Number), t, 1))
  224. 00883   FOR g=Hight TO Vorschub1 + 1 STEP -1
  225. 00895   IF Summe>=2^(g - Vorschub1 - 1) goto 00899 else goto 00911 
  226. 00899 rem 
  227. 00903  Summe=Summe - 2^(g - Vorschub1 - 1) 
  228. 00905  Char$(g, t)=Taken$ 
  229. 00910  goto 00915
  230. 00911 rem 
  231. 00913  Char$(g, t)=Free$
  232. 00915 rem 
  233. 00917 next
  234. 00918 rem 
  235. 00925   Summe=ASC(MID$(Low$(Number), t, 1))
  236. 00927   FOR g=Hight - Vorschub1 TO 1 STEP -1
  237. 00939   IF Summe>=2^(g - 1) goto 00943 else goto 00951 
  238. 00943 rem 
  239. 00945  Summe=Summe - 2^(g - 1) 
  240. 00947  Char$(g, t)=Taken$ 
  241. 00950  goto 00955
  242. 00951 rem 
  243. 00953  Char$(g, t)=Free$
  244. 00955 rem 
  245. 00957 next
  246. 00958 rem 
  247. 00961 next
  248. 00962 rem 
  249. 00969 return
  250. 00974  end
  251. 00975 rem 
  252. 00977 rem  LoadFont
  253. 00989  LOCATE 4,1 : PRINT STRING$(79, " ")
  254. 00991  LOCATE 4,1 : INPUT "Which font "; Font$
  255. 00993  LOCATE 4,1 : PRINT "Loading font : "; Font$; ".fon                                    "
  256. 00995  OPEN Font$ + ".fon" FOR INPUT AS #2
  257. 01003   FOR T=0 TO 255
  258. 01015   High$(T)="" : Low$(T)=""
  259. 01023   FOR Q=1 TO Wwidth
  260. 01033  INPUT #2, High% : High$(T)=High$(T) + CHR$(High%)
  261. 01035  INPUT #2, Low%  : Low$(T) =Low$(T)  + CHR$(Low%)
  262. 01037 next
  263. 01038 rem 
  264. 01041 next
  265. 01042 rem 
  266. 01047  CLOSE #2
  267. 01049 gosub 00497
  268. 01051 gosub 00851
  269. 01053 gosub 00533
  270. 01055  Z=1 : S=1
  271. 01057 gosub 00587
  272. 01065 return
  273. 01070  end
  274. 01071 rem 
  275. 01073 rem  SaveFont
  276. 01085 gosub 00715
  277. 01087  LOCATE 4,1 : PRINT "Saving font : "; Font$; ".fon                                    "
  278. 01089  OPEN Font$ + ".fon" FOR OUTPUT AS #2
  279. 01097   FOR T=0 TO 255
  280. 01111   FOR Q=1 TO Wwidth
  281. 01121  High%=ASC(MID$(High$(T), Q, 1)) : PRINT #2, High% 
  282. 01123  Low% =ASC(MID$(Low$(T) , Q, 1)) : PRINT #2, Low% 
  283. 01125 next
  284. 01126 rem 
  285. 01129 next
  286. 01130 rem 
  287. 01135  CLOSE #2
  288. 01137 gosub 00497
  289. 01145 return
  290.