home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BASIC / FUNCTION.ZIP / FUNCTION.BAS
Encoding:
BASIC Source File  |  1987-11-11  |  19.9 KB  |  428 lines
  1. 5 REM *******************
  2. 6 REM *  by Chris KING  * give a copy to a friend
  3. 7 REM *******************
  4. 10 CLS:SCREEN 2,1,0,0:KEY OFF:DEF SEG=0:POKE 1050,PEEK (1052):POKE 106,0
  5. 15 FOR A=17 TO 20:KEY A-10,CHR$(A):NEXT
  6. 17 IF (PEEK(&H410) AND &H30)=&H30 THEN 4400
  7. 18 KEY 1,STRING$ (8,17)
  8. 20 INPUT "How many functions do you want (1-10)";H%
  9. 30 IF H%<1 OR H%>10 THEN PRINT "Out of range!":GOTO 20
  10. 40 CLS:PRINT "Give me you ";H%;" functions, and press <RETURN> after every function!"
  11. 50 POKE &HF000,H%
  12. 60 FOR A=1 TO H%
  13. 70 LOCATE A+4,1:PRINT A*100+900;" Y="
  14. 80 NEXT
  15. 90 PRINT "GOTO 110 Press <RETURN> after this, too"
  16. 100 LOCATE 4,1:END
  17. 110 CLEAR 2000:H%=PEEK (&HF000):DIM A$(H%):ON ERROR GOTO 10000
  18. 115 FOR A=1 TO H%:FOR B=8 TO 39
  19. 120 A$(A)=A$(A)+CHR$ (SCREEN (A+4,B))
  20. 130 NEXT B:NEXT A
  21. 200 DIM BOX%(361),HX%(100),HY%(100),FADEN%(5),FUN%(5):CLS:LINE (3,0)-(3,6),1:LINE (0,3)-(6,3),1:GET (0,0)-(7,7),FADEN%:CLS
  22. 201 LINE (320,0)-(320,199),1:LINE (0,100)-(639,100),1:ABSCHNITT%=0
  23. 210 GOSUB 5000
  24. 220 REM                       Table contents
  25. 230 B$="           Type the letter of what you want to do:(c)hange axis, (d)raw function, (w)rite, (p)rint pict.,  (s)ave picture, (l)ist,  (o)ld picture, ":B$=B$+RIGHT$(B$,97):V%=1
  26. 235 GOSUB 5600:FLAG%=0
  27. 240 FOR A%=V% TO LEN (B$)-78
  28. 250 LOCATE 25,1:PRINT MID$(B$,A%,79);
  29. 260 A$=INKEY$:IF A$="" THEN 300
  30. 270 IF A$="C" OR A$="c" THEN 6000
  31. 275 IF A$="D" OR A$="d" THEN 6500
  32. 280 IF A$="W" OR A$="w" THEN 7000
  33. 285 IF A$="s" OR A$="S" THEN 7500
  34. 290 IF A$="L" OR A$="l" THEN 8000
  35. 291 IF A$="P" OR A$="p" THEN 4511
  36. 292 IF A$="O" OR A$="o" THEN 8500
  37. 295 BEEP
  38. 300 NEXT
  39. 310 V%=70:GOTO 240
  40. 999 END
  41. 1050 A$=INKEY$:IF A$="" THEN RETURN ELSE IF A$=CHR$ (27) THEN 6760 ELSE RETURN
  42. 1100  Y=
  43. 1150 A$=INKEY$:IF A$="" THEN RETURN ELSE IF A$=CHR$ (27) THEN 6760 ELSE RETURN
  44. 1200  Y=X^4
  45. 1250 A$=INKEY$:IF A$="" THEN RETURN ELSE IF A$=CHR$ (27) THEN 6760 ELSE RETURN
  46. 1300  Y=X+5
  47. 1350 A$=INKEY$:IF A$="" THEN RETURN ELSE IF A$=CHR$ (27) THEN 6760 ELSE RETURN
  48. 1400  Y=X^2
  49. 1450 A$=INKEY$:IF A$="" THEN RETURN ELSE IF A$=CHR$ (27) THEN 6760 ELSE RETURN
  50. 1550 A$=INKEY$:IF A$="" THEN RETURN ELSE IF A$=CHR$ (27) THEN 6760 ELSE RETURN
  51. 1650 A$=INKEY$:IF A$="" THEN RETURN ELSE IF A$=CHR$ (27) THEN 6760 ELSE RETURN
  52. 1750 A$=INKEY$:IF A$="" THEN RETURN ELSE IF A$=CHR$ (27) THEN 6760 ELSE RETURN
  53. 1850 A$=INKEY$:IF A$="" THEN RETURN ELSE IF A$=CHR$ (27) THEN 6760 ELSE RETURN
  54. 1950 A$=INKEY$:IF A$="" THEN RETURN ELSE IF A$=CHR$ (27) THEN 6760 ELSE RETURN
  55. 4400 REM                      If no grafics-cart
  56. 4405 SCREEN 0,0
  57. 4410 PRINT "You don't have a grafics-cart"
  58. 4420 PRINT "Do you want to print a grafics?"
  59. 4430 GOSUB 5200
  60. 4440 IF A$="Y" OR A$="y" THEN 4500 ELSE IF A$="n" OR A$="N" THEN END
  61. 4450 BEEP:GOTO 4430
  62. 4500 REM                      Print
  63. 4510 FLAG%=1:GOSUB 7510:OPEN NM$ FOR INPUT AS #1
  64. 4511 GOSUB 5600:PRINT "What kind of resolution do you want on the printer (1-4,6, H-help)?";
  65. 4512 GOSUB 5200
  66. 4513 IF A$="H" OR A$="h" THEN 4800
  67. 4514 IF ASC (A$)>47 AND ASC (A$)<55 AND ASC (A$)<>53 THEN RES=VAL (A$) ELSE BEEP:GOTO 4512
  68. 4515 GOSUB 5600:PRINT "Turn on the printer and press a key";
  69. 4516 GOSUB 5200:IF (PEEK(&H410) AND &H30)<>&H30 THEN 4600
  70. 4518 LPRINT CHR$ (27);"@"CHR$ (27);"1":OPEN "LPT1:" AS #2:WIDTH #2,255
  71. 4519 IF RES=4 THEN 4600
  72. 4520 FOR A%=0 TO 202 STEP 7:IF RES <>4 THEN LPRINT CHR$ (13);
  73. 4525 LPRINT CHR$ (27);"*";CHR$ (RES);CHR$ (128);CHR$ (2);:FOR B%=0 TO 639
  74. 4530 INPUT #1,P%:PRINT #2,CHR$ (P%);
  75. 4540 NEXT B%:NEXT A%:GOTO 4420
  76. 4600 REM                        Print with graphics-cart
  77. 4610 LPRINT CHR$ (27)"@"CHR$ (27)"1":OPEN "LPT1:" AS #2:WIDTH #2,255
  78. 4620 GOSUB 5500:FOR A%=0 TO 6:POT%(6-A%)=2^A%:NEXT A%
  79. 4630 FOR A%=0 TO 202 STEP 7
  80. 4640 FOR B%=0 TO 639:P%=0:FOR C%=0 TO 6
  81. 4650 P%=P%+POINT (B%,A%+C%)*POT%(C%)
  82. 4660 NEXT C%:PRINT #1,P%
  83. 4661 IF RES<>4 THEN PRINT #2,CHR$ (13);
  84. 4662 NEXT B%:NEXT A%
  85. 4675 CLOSE
  86. 4800 GOSUB 5600
  87. 4810 PRINT "Resolution 1=low-speed double density";
  88. 4820 GOSUB 5200:GOSUB 5600
  89. 4830 PRINT "Resolution 2=high-speed double density";
  90. 4840 GOSUB 5200:GOSUB 5600
  91. 4850 PRINT "Resolution 3=quadruple";
  92. 4860 GOSUB 5200:GOSUB 5600
  93. 4870 PRINT "Resolution 4=640 dots per line (you should take this one)";
  94. 4880 GOSUB 5200:GOSUB 5600
  95. 4890 PRINT "Resolution 6=720 dots per line";
  96. 4900 GOSUB 5200:GOTO 4511
  97. 5000 REM                      Save the keybox
  98. 5010 GET (0,192)-(639,199),BOX%
  99. 5020 LINE (0,192)-(639,199),0,BF
  100. 5030 LOCATE 25,1:RETURN
  101. 5200 A$=INKEY$:IF A$="" THEN 5200 ELSE RETURN
  102. 5300 ESC=0:PUFFER%=0:M$=""
  103. 5310 PRINT CHR$ (95);CHR$ (29);
  104. 5320 FOR A=0 TO 50:A$=INKEY$:IF A$="" THEN NEXT A ELSE 5360
  105. 5330 PRINT CHR$ (32);CHR$ (29);
  106. 5340 FOR A=0 TO 50:A$=INKEY$:IF A$="" THEN NEXT A ELSE 5360
  107. 5350 GOTO 5310
  108. 5360 IF A$=CHR$ (27) THEN ESC=1:RETURN ELSE IF A$=CHR$(13) THEN RETURN
  109. 5370 IF A$=CHR$ (8) THEN IF PUFFER%=0 THEN BEEP:GOTO 5310 ELSE PUFFER%=PUFFER%-1:M$=LEFT$ (M$,LEN (M$)-1):PRINT CHR$ (32)CHR$ (29)CHR$ (29);:GOTO 5310
  110. 5380 IF ASC (A$)<32 THEN BEEP:GOTO 5310
  111. 5390 IF PUFFER%=8 THEN BEEP:GOTO 5310
  112. 5400 PUFFER%=PUFFER%+1:PRINT A$;:M$=M$+A$:GOTO 5310
  113. 5500 REM                      Return keybox
  114. 5510 LINE (0,192)-(639,199),0,BF
  115. 5520 LOCATE 25,1:PUT (0,192),BOX%
  116. 5530 RETURN
  117. 5600 REM                      Clear keybox
  118. 5610 IF FLAG%=1 THEN LOCATE 25,1:PRINT "                                                                               ";ELSE LINE (0,192)-(639,199),0,BF
  119. 5620 LOCATE 25,1:RETURN
  120. 5700 ESC=0:KOMMA%=0:ZAHL$="":PUFFER%=0
  121. 5710 PRINT CHR$ (95);CHR$ (29);
  122. 5720 FOR A=0 TO 50:A$=INKEY$:IF A$="" THEN NEXT ELSE 5760
  123. 5730 PRINT CHR$ (32);CHR$ (29);
  124. 5740 FOR A=0 TO 50:A$=INKEY$:IF A$="" THEN NEXT ELSE 5760
  125. 5750 GOTO 5710
  126. 5760 IF A$=CHR$ (27) THEN ESC=1:RETURN
  127. 5770 AS=ASC (A$):IF (AS<48 OR AS>57) AND AS<>46 AND AS<>13 AND AS<>8 THEN BEEP:GOTO 5710
  128. 5780 IF AS>47 AND AS<58 THEN IF PUFFER%<15 THEN ZAHL$=ZAHL$+A$:PUFFER%=PUFFER%+1:PRINT A$;:GOTO 5710 ELSE BEEP:GOTO 5710
  129. 5785 IF A$=CHR$ (13) THEN RETURN
  130. 5786 IF A$=CHR$ (8) THEN IF PUFFER%<1 THEN BEEP:GOTO 5710 ELSE PUFFER%=PUFFER%-1:B$=RIGHT$ (ZAHL$,1):ZAHL$=LEFT$ (ZAHL$,LEN (ZAHL$)-1):PRINT CHR$(32);CHR$(29);CHR$ (29);:IF B$="." THEN KOMMA%=0:GOTO 5710 ELSE 5710
  131. 5790 IF KOMMA%=1 THEN BEEP:GOTO 5710
  132. 5800 IF PUFFER%<15 THEN ZAHL$=ZAHL$+CHR$ (46):PUFFER%=PUFFER%+1:PRINT ".";:KOMMA%=1:GOTO 5710
  133. 6000 REM                      Place the axis
  134. 6010 GOSUB 5600
  135. 6020 PRINT "T-turn axis on and off  W-wich field you want to use  Esc-main menu";
  136. 6030 GOSUB 5200
  137. 6040 IF A$="T" OR A$="t" THEN GOSUB 6100:GOTO 6020
  138. 6050 IF A$="W" OR A$="w" THEN 6200
  139. 6055 IF A$=CHR$(27) THEN 220
  140. 6060 BEEP:GOTO 6030
  141. 6100 GOSUB 5500
  142. 6110 IF ABSCHNITT%=0 THEN LINE (320,0)-(320,199),T:LINE (0,100)-(639,100),T
  143. 6112 IF ABSCHNITT%=1 THEN LINE (0,190)-(639,190),T:LINE (10,0)-(10,199),T
  144. 6114 IF ABSCHNITT%=2 THEN LINE (629,0)-(629,199),T:LINE (0,190)-(639,190),T
  145. 6116 IF ABSCHNITT%=3 THEN LINE (0,10)-(639,10),T:LINE (629,0)-(629,199),T
  146. 6118 IF ABSCHNITT%=4 THEN LINE (0,10)-(639,10),T:LINE (10,0)-(10,199),T
  147. 6120 IF ABSCHNITT%=5 THEN LINE (0,190)-(639,190),T:LINE (320,0)-(320,199),T
  148. 6122 IF ABSCHNITT%=6 THEN LINE (629,0)-(629,199),T:LINE (0,100)-(639,100),T
  149. 6124 IF ABSCHNITT%=7 THEN LINE (0,10)-(639,10),T:LINE (320,0)-(320,199),T
  150. 6126 IF ABSCHNITT%=8 THEN LINE (10,0)-(10,199),T:LINE (0,100)-(639,100),T
  151. 6130 T=T+1:IF T>1 THEN T=0
  152. 6140 GOSUB 5000
  153. 6150 RETURN
  154. 6200 GOSUB 5600:V%=1
  155. 6210 B$="Wich field: 0-all num., 1-X and Y are pos., 2-X is neg. y is pos., 3-X and Y is neg., 4-X is pos., Y is neg., 5-Y is pos., 6-X is neg., 7-Y is neg., 8-X is pos., Esc-menu "
  156. 6215 B$=B$+LEFT$ (B$,84)
  157. 6220 FOR A%=V% TO LEN (B$)-78
  158. 6230 LOCATE 25,1:PRINT MID$ (B$,A%,79);
  159. 6240 A$=INKEY$:IF A$="" THEN 6310
  160. 6250 IF ASC (A$)>47 AND ASC (A$)<57 THEN T=0:GOSUB 6100:ABSCHNITT%=VAL (A$):GOTO 6330
  161. 6260 IF A$=CHR$ (27) THEN 6000
  162. 6300 BEEP
  163. 6310 NEXT
  164. 6320 V%=14:GOTO 6220
  165. 6330 GOSUB 6100:GOTO 6000
  166. 6500 REM                      Draw functions
  167. 6510 GOSUB 5600
  168. 6520 PRINT "Esc-menu, wich function do you want to get drawn (0-";H%-1;CHR$(29);") ?";
  169. 6530 A$=INKEY$:IF A$="" THEN 6530
  170. 6540 IF A$=CHR$(27) THEN 220
  171. 6550 IF VAL (A$)<0 OR VAL (A$)>H%-1 THEN BEEP:GOTO 6530
  172. 6560 WIFU%=VAL (A$)+1
  173. 6570 GOSUB 5600:PRINT "Esc-menu, How many units on the X-axis (0-?)";
  174. 6580 GOSUB 5700
  175. 6590 IF ESC=1 THEN 6500
  176. 6620 XUNIT=VAL (ZAHL$):IF XUNIT=0 THEN XUNIT=320
  177. 6630 GOSUB 5600:PRINT "Esc-menu, How many units on the Y-axis (0-?)";
  178. 6640 GOSUB 5700
  179. 6650 IF ESC=1 THEN 6570
  180. 6660 YUNIT=VAL (ZAHL$):IF YUNIT=0 THEN YUNIT=100
  181. 6670 GOSUB 5600:PRINT "Esc-menu, shall I connect the points";
  182. 6680 GOSUB 5200
  183. 6690 IF A$=CHR$ (27) THEN 6630
  184. 6691 IF A$="y" OR A$="Y" OR A$="C" OR A$="c" THEN CONNECT%=1:GOTO 6700
  185. 6692 IF A$="N" OR A$="n" THEN CONNECT%=0:GOTO 6700
  186. 6693 BEEP:GOTO 6680
  187. 6700 GOSUB 5600:PRINT "Esc-menu, shall I connect points with X-axis";
  188. 6702 GOSUB 5200
  189. 6703 IF A$=CHR$ (27) THEN 6670
  190. 6704 IF A$="y" OR A$="Y" OR A$="c" OR A$="C" THEN CONAXIS%=1:GOTO 6710
  191. 6705 IF A$="N" OR A$="n" THEN CONAXIS%=0:GOTO 6710
  192. 6706 BEEP:GOTO 6702
  193. 6710 GOSUB 5600:PRINT "Esc-menu, what step ?";
  194. 6720 GOSUB 5700:IF ESC=1 THEN 6700
  195. 6725 STP=VAL (ZAHL$)
  196. 6730 REM                      Now really draw
  197. 6740 ON ABSCHNITT%+1 GOSUB 9800,9820,9820,9820,9820,9840,9860,9840,9860
  198. 6745 GOSUB 5500
  199. 6746 LOCATE 1,1
  200. 6750 ON ABSCHNITT%+1 GOSUB 9000,9050,9100,9150,9200,9250,9300,9350,9400
  201. 6760 GOSUB 5000:GOSUB 5600
  202. 6770 GOTO 220
  203. 7000 REM                      Write on the screen
  204. 7010 GOSUB 5600:PUT (FADX%,FADY%),FADEN%
  205. 7020 PRINT "Esc-menu, F7 F8 F9 F10-move, any for writing,^P-draw, ^C-clear screen, ^B-help";
  206. 7030 GOSUB 5200
  207. 7040 IF A$=CHR$(27) THEN PUT (FADX%,FADY%),FADEN%:GOTO 220
  208. 7041 IF A$=CHR$(16) THEN 7430 ELSE IF A$=CHR$ (2) THEN 7920
  209. 7042 IF A$=CHR$ (3) THEN 7480 ELSE IF A$=CHR$ (10) THEN OLDX%=FADX%+3:OLDY%=FADY%+3:FOR A=0 TO 1000 STEP 10:SOUND A+200,.01:NEXT:SOUND A+200,.1:GOTO 7030
  210. 7050 IF A$=CHR$(17) THEN GOSUB 7100:GOTO 7030 ELSE IF A$=CHR$(12) THEN 7950
  211. 7060 IF A$=CHR$(18) THEN GOSUB 7200:GOTO 7030
  212. 7070 IF A$=CHR$(19) THEN GOSUB 7300:GOTO 7030
  213. 7080 IF A$=CHR$(20) THEN GOSUB 7400:GOTO 7030
  214. 7081 IF ASC (A$)<32 THEN BEEP:GOTO 7030
  215. 7082 GOSUB 7083:GOTO 7020
  216. 7083 PUT (FADX%,FADY%),FADEN%:GOSUB 5600:PRINT A$;:KEY 1,STRING$ (8,17)+A$
  217. 7084 IF FADX%>632 OR FADY%>192 THEN BEEP:PUT (FADX%,FADY%),FADEN%:GOTO 7090
  218. 7085 GET (0,192)-(7,199),FUN%:GOSUB 5600
  219. 7086 GOSUB 5500:PUT (FADX%,FADY%),FUN%:GOSUB 5000
  220. 7087 FADX%=FADX%+8:IF FADX%>632 AND FADY%<184 THEN FADX%=0:FADY%=FADY%+8
  221. 7088 PUT (FADX%,FADY%),FADEN%,XOR
  222. 7090 RETURN
  223. 7100 PUT (FADX%,FADY%),FADEN%,XOR:FADX%=FADX%-1:IF FADX%<0 THEN FADX%=632
  224. 7110 PUT (FADX%,FADY%),FADEN%
  225. 7120 RETURN
  226. 7200 PUT (FADX%,FADY%),FADEN%,XOR:FADX%=FADX%+1:IF FADX%>632 THEN FADX%=0
  227. 7210 PUT (FADX%,FADY%),FADEN%
  228. 7220 RETURN
  229. 7300 PUT (FADX%,FADY%),FADEN%,XOR:FADY%=FADY%-1:IF FADY%<0 THEN FADY%=192
  230. 7310 PUT (FADX%,FADY%),FADEN%
  231. 7320 RETURN
  232. 7400 PUT (FADX%,FADY%),FADEN%,XOR:FADY%=FADY%+1:IF FADY%>192 THEN FADY%=0
  233. 7410 PUT (FADX%,FADY%),FADEN%
  234. 7420 RETURN
  235. 7430 REM                      Draw
  236. 7440 GOSUB 5600:PRINT "Esc-menu, P-plot, U-unplot, C-circle, F-paint, B-box";
  237. 7441 GOSUB 5200
  238. 7442 IF A$=CHR$(27) THEN GOSUB 5600:GOTO 7020
  239. 7443 IF A$="P" OR A$="p" THEN FARBE%=0:GOTO 7450
  240. 7444 IF A$="u" OR A$="U" THEN FARBE%=1:GOTO 7450
  241. 7445 BEEP:GOTO 7441
  242. 7450 GOSUB 5600:PRINT "Esc-menu, F7 F8 F9 10-moving";
  243. 7451 GOSUB 5200
  244. 7452 IF A$=CHR$ (27) THEN 7440
  245. 7453 IF A$=CHR$(17) THEN PSET (FADX%+3,FADY%+3),FARBE%:GOSUB 7100:GOTO 7460
  246. 7454 IF A$=CHR$(18) THEN PSET (FADX%+3,FADY%+3),FARBE%:GOSUB 7200:GOTO 7460
  247. 7455 IF A$=CHR$(19) THEN PSET (FADX%+3,FADY%+3),FARBE%:GOSUB 7300:GOTO 7460
  248. 7456 IF A$=CHR$(20) THEN PSET (FADX%+3,FADY%+3),FARBE%:GOSUB 7400:GOTO 7460
  249. 7457 GOTO 7451
  250. 7460 IF FADY%>188 THEN PUT (FADX%,FADY%),FADEN%,XOR:GOSUB 5600:GOSUB 5500:PSET (FADX%+3,FADY%+3),FARBE%+1:GOSUB 5000:PRINT "Esc-escape, F7 F8 F9 10-moving";:PUT (FADX%,FADY%),FADEN%:GOTO 7450
  251. 7461 GOTO 7451
  252. 7480 GOSUB 5600:PRINT "Are you sure (Y/N)";
  253. 7481 GOSUB 5200
  254. 7482 IF A$="y" OR A$="Y" THEN CLS:GOSUB 5000:GOTO 7000
  255. 7483 IF A$="N" OR A$="n" OR A$=CHR$ (27) THEN GOSUB 5600:GOTO 7020
  256. 7484 BEEP:GOTO 7481
  257. 7500 REM                      Save picture
  258. 7501 GOSUB 5600:PRINT "Esc-menu, (f)ast, (s)low or (h)elp";
  259. 7502 GOSUB 5200
  260. 7503 IF A$=CHR$ (27) THEN IF FLAG%<>1 THEN 220 ELSE 4420
  261. 7504 IF A$="F" OR A$="f" THEN 7800 ELSE IF A$="S" OR A$="s" THEN 7509 ELSE IF A$="H" OR A$="h" THEN GOSUB 7900:GOTO 7501 ELSE BEEP:GOTO 7502
  262. 7509 GOSUB 7510:GOTO 7560
  263. 7510 GOSUB 5600
  264. 7520 NM$="":PRINT "Esc-menu, Wich disk do you want to use A or B?";
  265. 7530 GOSUB 5200
  266. 7540 IF A$=CHR$ (27) THEN 7501
  267. 7550 IF A$="A" OR A$="a" THEN N$="A:" ELSE IF A$="B" OR A$="b" THEN N$="B:" ELSE BEEP:GOTO 7530
  268. 7551 GOSUB 5600:PRINT "Esc-menu,  type in the name, please: ";
  269. 7552 GOSUB 5300
  270. 7555 GOSUB 5600:PRINT "Esc-menu, You use disk "N$" and the name "M$". Insert disk and press a key.";
  271. 7556 GOSUB 5200:IF A$=CHR$ (27) THEN 7551
  272. 7557 NM$=N$+M$:RETURN
  273. 7560 GOSUB 5500:FOR A%=0 TO 6:POT%(6-A%)=2^A%:NEXT A%
  274. 7565 OPEN NM$ FOR OUTPUT AS #1
  275. 7570 FOR A%=0 TO 202 STEP 7
  276. 7580 FOR B%=0 TO 639:P%=0:FOR C%=0 TO 6
  277. 7590 P%=P%+POINT (B%,A%+C%)*POT%(C%)
  278. 7600 NEXT C%:PRINT #1,P%:NEXT B%:NEXT A%
  279. 7605 CLOSE
  280. 7610 GOTO 220
  281. 7800 GOSUB 7510
  282. 7810 DEF SEG=&HB800:GOSUB 5500
  283. 7820 BSAVE NM$,0,&H4000
  284. 7830 GOTO 220
  285. 7900 GOSUB 5600:PRINT "Fast save-save and load a picture. Slow save is also to print a picture";
  286. 7910 A$=INKEY$:IF A$="" THEN 7910 ELSE RETURN
  287. 7920 GOSUB 5600:PRINT "^L-draw line to old point, which was indicated by the ^ <RETURN> key";
  288. 7921 GOSUB 5200:GOSUB 5600
  289. 7922 PRINT "To write just press the charcter.";
  290. 7923 PRINT "To move the crossbar use the keys F7,F8,F9,F10."
  291. 7924 GOSUB 5200:GOSUB 5600
  292. 7930 GOTO 7020
  293. 7950 PUT (FADX%,FADY%),FADEN%,XOR:GOSUB 5500
  294. 7960 LINE (OLDX%,OLDY%)-(FADX%+3,FADY%+3),1:GOSUB 5000:GOTO 7010
  295. 8000 REM                      List functions
  296. 8010 GOSUB 5600
  297. 8020 IF SORTIERT%=1 THEN 8100
  298. 8030 SORTIERT%=1
  299. 8040 FOR A=1 TO H%:FOR B=39 TO 8 STEP -1
  300. 8050 IF MID$ (A$(A),B,1)=" " THEN A$(A)=LEFT$ (A$(A),B-1)
  301. 8060 NEXT B:NEXT A
  302. 8100 PRINT "Esc-menu,  wich function do you want to list (0-";H%-1;CHR$ (29);")?";
  303. 8110 GOSUB 5200
  304. 8120 IF A$=CHR$ (27) THEN 220
  305. 8130 IF ASC (A$)<48 OR ASC (A$)>47+H% THEN BEEP:GOTO 8110
  306. 8140 GOSUB 5600
  307. 8150 PRINT A$(1+VAL (A$));
  308. 8160 GOSUB 5200
  309. 8170 GOTO 8000
  310. 8500 REM                        Load picture
  311. 8501 GOSUB 5600:PRINT "Esc-menu,  (f)ast, (s)low load or (h)elp";
  312. 8502 GOSUB 5200
  313. 8503 IF A$=CHR$ (27) THEN 220
  314. 8504 IF A$="F" OR A$="f" THEN 8800 ELSE IF A$="S" OR A$="s" THEN 8510 ELSE IF A$="H" OR A$="h" THEN GOSUB 7900:GOTO 8501
  315. 8505 BEEP:GOTO 8502
  316. 8510 GOSUB 7510
  317. 8560 GOSUB 5500:FOR A%=0 TO 6:POT%(6-A%)=2^A%:NEXT A%
  318. 8565 OPEN NM$ FOR INPUT AS #2
  319. 8570 FOR A%=0 TO 202 STEP 7
  320. 8580 FOR B%=0 TO 639
  321. 8590 INPUT #2,P%
  322. 8591 FOR C%=0 TO 6:IF (P% AND POT%(C%))=POT%(C%) THEN PSET (B%,A%+C%)
  323. 8592 NEXT C%
  324. 8600 NEXT B%:NEXT A%
  325. 8605 CLOSE
  326. 8610 GOSUB 5000:GOTO 220
  327. 8800 GOSUB 7510
  328. 8810 DEF SEG=&HB800
  329. 8820 BLOAD NM$,0
  330. 8830 GOSUB 5000
  331. 8840 GOTO 220
  332. 9000 IF STP=0 THEN STP=XUNIT/320:X1=-XUNIT:X=X1:ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900:Y1=Y*YMASSTAB
  333. 9005 FOR X=-XUNIT TO XUNIT STEP STP
  334. 9010 ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900
  335. 9020 Y=Y*YMASSTAB
  336. 9030 IF ABS (Y)>100 THEN 9040
  337. 9032 IF CONNECT%=1 THEN IF ABS (Y1)>100 THEN 9036 ELSE LINE (320+X1*XMASSTAB,100-Y1)-(320+X*XMASSTAB,100-Y),1
  338. 9034 IF CONAXIS%=1 THEN LINE (320+X*XMASSTAB,100-Y)-(320+X*XMASSTAB,100),1:GOTO 9040
  339. 9036 PSET (320+X*XMASSTAB,100-Y),1
  340. 9040 X1=X:Y1=Y:NEXT
  341. 9045 RETURN
  342. 9050 IF STP=0 THEN STP=XUNIT/630:X1=0:X=X1:ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900:Y1=Y*YMASSTAB
  343. 9055 FOR X=0 TO XUNIT STEP STP
  344. 9060 ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900
  345. 9070 Y=Y*YMASSTAB
  346. 9080 IF Y>190 OR Y<0 THEN 9090
  347. 9082 IF CONNECT%=1 THEN IF Y1>190 OR Y1<0 THEN 9086 ELSE LINE (10+X1*XMASSTAB,190-Y1)-(10+X*XMASSTAB,190-Y),1
  348. 9084 IF CONAXIS%=1 THEN LINE (10+X*XMASSTAB,190-Y)-(10+X*XMASSTAB,190),1:GOTO 9090
  349. 9086 PSET (10+X*XMASSTAB,190-Y),1
  350. 9090 X1=X:Y1=Y:NEXT
  351. 9095 RETURN
  352. 9100 IF STP=0 THEN STP=XUNIT/630:X1=0:X=X1:ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900:Y1=Y*YMASSTAB
  353. 9105 FOR X=0 TO -XUNIT STEP -STP
  354. 9110 ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900
  355. 9120 Y=Y*YMASSTAB
  356. 9130 IF Y>190 OR Y<0 THEN 9140
  357. 9132 IF CONNECT%=1 THEN IF Y1>190 OR Y1<0 THEN 9136 ELSE LINE (630+X1*XMASSTAB,190-Y1)-(630+X*XMASSTAB,190-Y),1
  358. 9134 IF CONAXIS%=1 THEN LINE (630+X*XMASSTAB,190-Y)-(630+X*XMASSTAB,190),1:GOTO 9140
  359. 9136 PSET (630+X*XMASSTAB,190-Y),1
  360. 9140 X1=X:Y1=Y:NEXT
  361. 9145 RETURN
  362. 9150 IF STP=0 THEN STP=XUNIT/630:X1=0:X=X1:ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900:Y1=Y*YMASSTAB
  363. 9155 FOR X=0 TO -XUNIT STEP -STP
  364. 9160 ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900
  365. 9170 Y=Y*YMASSTAB
  366. 9180 IF Y>0 OR Y<-190 THEN 9190
  367. 9182 IF CONNECT%=1 THEN IF Y1>0 OR Y1<-190 THEN 9186 ELSE LINE (630+X1*XMASSTAB,10-Y1)-(630+X*XMASSTAB,10-Y),1
  368. 9184 IF CONAXIS%=1 THEN LINE (630+X*XMASSTAB,10-Y)-(630+X*XMASSTAB,10),1:GOTO 9190
  369. 9186 PSET (630+X*XMASSTAB,10-Y),1
  370. 9190 X1=X:Y1=Y:NEXT
  371. 9195 RETURN
  372. 9200 IF STP=0 THEN STP=XUNIT/630:X1=0:X=X1:ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900:Y1=Y*YMASSTAB
  373. 9205 FOR X=0 TO XUNIT STEP STP
  374. 9210 ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900
  375. 9220 Y=Y*YMASSTAB
  376. 9230 IF Y>0 OR Y<-190 THEN 9240
  377. 9232 IF CONNECT%=1 THEN IF Y1>0 OR Y1<-190 THEN 9236 ELSE LINE (10+X1*XMASSTAB,10-Y1)-(10+X*XMASSTAB,10-Y),1
  378. 9234 IF CONAXIS%=1 THEN LINE (10+X*XMASSTAB,10-Y)-(10+X*XMASSTAB,10),1:GOTO 9240
  379. 9236 PSET (10+X*XMASSTAB,10-Y),1
  380. 9240 X1=X:Y1=Y:NEXT
  381. 9245 RETURN
  382. 9250 IF STP=0 THEN STP=XUNIT/320:X1=-XUNIT:X=X1:ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900:Y1=Y*YMASSTAB
  383. 9255 FOR X=-XUNIT TO XUNIT STEP STP
  384. 9260 ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900
  385. 9270 Y=Y*YMASSTAB
  386. 9280 IF Y<0 OR Y>190 THEN 9290
  387. 9282 IF CONNECT%=1 THEN IF Y1<0 OR Y1>190 THEN 9286 ELSE LINE (320+X1*XMASSTAB,190-Y1)-(320+X*XMASSTAB,190-Y),1
  388. 9284 IF CONAXIS%=1 THEN LINE (320+X*XMASSTAB,190-Y)-(320+X*XMASSTAB,190),1:GOTO 9290
  389. 9286 PSET (320+X*XMASSTAB,190-Y),1
  390. 9290 X1=X:Y1=Y:NEXT
  391. 9295 RETURN
  392. 9300 IF STP=0 THEN STP=XUNIT/630:X1=0:X=X1:ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900:Y1=Y*YMASSTAB
  393. 9305 FOR X=0 TO -XUNIT STEP -STP
  394. 9310 ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900
  395. 9320 Y=Y*YMASSTAB
  396. 9330 IF ABS (Y)>100 THEN 9340
  397. 9332 IF CONNECT%=1 THEN IF ABS (Y1)>100 THEN 9336 ELSE LINE (630+X1*XMASSTAB,100-Y1)-(630+X*XMASSTAB,100-Y),1
  398. 9334 IF CONAXIS%=1 THEN LINE (630+X*XMASSTAB,100-Y)-(630+X*XMASSTAB,100),1:GOTO 9340
  399. 9336 PSET (630+X*XMASSTAB,100-Y),1
  400. 9340 X1=X:Y1=Y:NEXT
  401. 9345 RETURN
  402. 9350 IF STP=0 THEN STP=XUNIT/320:X1=-XUNIT:X=X1:ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900:Y1=Y*YMASSTAB
  403. 9355 FOR X=-XUNIT TO XUNIT STEP STP
  404. 9360 ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900
  405. 9370 Y=Y*YMASSTAB
  406. 9380 IF Y>0 OR Y<-190 THEN 9390
  407. 9382 IF CONNECT%=1 THEN IF Y1>0 OR Y1<-190 THEN 9386 ELSE LINE (320+X1*XMASSTAB,10-Y1)-(320+X*XMASSTAB,10-Y),1
  408. 9384 IF CONAXIS%=1 THEN LINE (320+X*XMASSTAB,10-Y)-(320+X*XMASSTAB,10),1:GOTO 9390
  409. 9386 PSET (320+X*XMASSTAB,10-Y),1
  410. 9390 X1=X:Y1=Y:NEXT
  411. 9395 RETURN
  412. 9400 IF STP=0 THEN STP=XUNIT/630:X1=0:X=X1:ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900:Y1=Y*YMASSTAB
  413. 9405 FOR X=0 TO XUNIT STEP STP
  414. 9410 ON WIFU% GOSUB 1000,1100,1200,1300,1400,1500,1600,1700,1800,1900
  415. 9420 Y=Y*YMASSTAB
  416. 9430 IF ABS (Y)>190 THEN 9440
  417. 9432 IF CONNECT%=1 THEN IF ABS (Y)>190 THEN 9436 ELSE LINE (10+X1*XMASSTAB,100-Y1)-(10+X*XMASSTAB,100-Y),1
  418. 9434 IF CONAXIS%=1 THEN LINE (10+X*XMASSTAB,100-Y)-(10+X*XMASSTAB,100),1:GOTO 9440
  419. 9436 PSET (10+X*XMASSTAB,100-Y),1
  420. 9440 X1=X:Y1=Y:NEXT
  421. 9445 RETURN
  422. 9800 XMASSTAB=320/XUNIT:YMASSTAB=100/YUNIT:RETURN
  423. 9820 XMASSTAB=630/XUNIT:YMASSTAB=190/YUNIT:RETURN
  424. 9840 XMASSTAB=320/XUNIT:YMASSTAB=190/YUNIT:RETURN
  425. 9860 XMASSTAB=630/XUNIT:YMASSTAB=100/YUNIT:RETURN
  426. 10000 IF ERL>990 AND ERL<2000 THEN LOCATE 1,1:ON ERROR GOTO 10000:RESUME NEXT
  427. 10010 RESUME NEXT
  428.