home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / games / joydraw.zip / GRAPHED.BAS next >
BASIC Source File  |  1987-06-03  |  29KB  |  579 lines
  1. 5 ON ERROR GOTO 40000
  2. 10 OPTION BASE 1:STRIG ON
  3. 20 RESOLUTION = 4
  4. 30 DIM PATTERNS$(10) ,PATTERN%(10),CUT%(9000),WRITEAREA%(2000),SPRAYMED(2,10),EXTRA%(2000),MENU%(2000),SPRAYHIGH(10)
  5. 40 DEF FNSM(XVALUE)
  6. 50 TVALUE=XVALUE
  7. 60 IF XVALUE>32767 THEN TVALUE=-32767 ELSE TVALUE=XVALUE
  8. 70 IF TVALUE>32767 THEN PRINT TVALUE: GOTO 60
  9. 75 FNSM=TVALUE
  10. 80 END DEF
  11. 100 TRUE = -1 : FLASE = 0
  12. 110 IF RESOLUTION=4 THEN MAXXRES=320:MAXYRES=200 ELSE MAXXRES=640:MAXYRES=200
  13. 120 COLOR.=1
  14. 130 CURSOR1X=MAXXRES/2: CURSOR1Y=MAXYRES/2
  15. 140 ESC=27:F1=59:F2=60:F3=61:F4=62:F5=63:F6=64:F7=65:F8=66:F9=67:F10=68
  16. 150 DELTA=1
  17. 160 INS=82: CURSLFT=75: CURSRT=77: CURSDWN=80: CURSUP=72: HOME=71: END.=79: PGUP=73:PGDWN=81: DEL=83
  18. 170 ALTF1=104: ALTF2=105: ALTF3=106: ALTF4=107: ALTF5=108: ALTF6=109:ALTF7=110:ALTF8=111:ALTF9=112:ALTF10=113
  19. 300 '
  20. 301 'set graphics mode
  21. 302 '
  22. 310 IF RESOLUTION=4 THEN SCREEN 1 ELSE SCREEN 2
  23. 320 CLS
  24. 330 KEY OFF
  25. 400 '
  26. 401 'set up
  27. 402 '
  28. 410 GOSUB 21010  'set up
  29. 500 '
  30. 501 'main loop
  31. 502 '
  32. 510 WHILE NOT FINISHED
  33. 520 GOSUB 22010   'get command
  34. 530 IF (OLDMODE<>MODE) AND (MODE<>2) AND (MODE<>3) AND (MODE<>4) THEN GOSUB 25010  'rest all
  35. 540 ON MODE GOSUB 1010,2010,3010,4010,5010,6010,7010,8010,9010,10010,11010,12010,13010,14010,15010,29500,29000
  36. 600 WEND
  37. 610 GOSUB 25010
  38. 700 END
  39. 1000 '
  40. 1001 'pencil
  41. 1002 '
  42. 1003 '      arrow keys move the pencil
  43. 1004 '      insert toggles plot/don't plot
  44. 1005 '
  45. 1010 GOSUB 23010
  46. 1020 IF INSERT THEN PLOT= NOT PLOT
  47. 1030 IF NOT PLOT THEN 1600
  48. 1040 IF CURSOR1SHOW=TRUE THEN GOSUB 24700
  49. 1050 PSET(CURSOR1X,CURSOR1Y), COLOR.
  50. 1060 IF CURSOR1SHOW=TRUE THEN GOSUB 24700
  51. 1600 RETURN
  52. 2000 '
  53. 2001 'change color
  54. 2002 '
  55. 2003 '      reads one key for color
  56. 2004 '       returns to previous mode
  57. 2005 '
  58. 2010 message$="Pick 0-4":gosub 27000:for delay=1 to delaysize:next:gosub 27500
  59. 2015 COLOR.$=INKEY$: WHILE LEN(COLOR.$)=0 : COLOR.$=INKEY$:WEND
  60. 2020 COLOR.=VAL(COLOR.$) MOD (16/RESOLUTION)
  61. 2030 MODE=OLDMODE
  62. 2600 RETURN
  63. 3000 '
  64. 3001 ' select palette
  65. 3002 '
  66. 3003 '      reads one key for palette
  67. 3004 '      returns to previous mode
  68. 3005 '
  69. 3010 IF RESOLUTION=8 THEN 3050
  70. 3015 message$="Pick 0-1":gosub 27000:for delay=1 to delaysize:next:gosub 27500
  71. 3020 PALETTE$=INKEY$: WHILE LEN(PALETTE$)=0: PALETTE$=INKEY$:WEND
  72. 3030 PALETE=VAL(PALETTE$) MOD 2
  73. 3040 COLOR , PALETE
  74. 3050 MODE= OLDMODE
  75. 3600 RETURN
  76. 4000 '
  77. 4001 ' change the background color
  78. 4002 '
  79. 4003 '       returns two digits
  80. 4004 '       return to previous mode
  81. 4005 '
  82. 4010 IF RESOLUTION=8 THEN 4600
  83. 4015 message$="TWO DIGITS 00-15":gosub 27000:for delay=1 to delaysize:next:gosub 27500
  84. 4020 BKGD$=INKEY$: WHILE LEN(BKGD$)=0: BKGD$=INKEY$:WEND
  85. 4030 BKGD2$=INKEY$:WHILE LEN(BKGD2$)=0: BKGD2$=INKEY$:WEND
  86. 4040 BKGDCOLOR=VAL(BKGD$+BKGD2$) MOD 33
  87. 4050 COLOR BKGDCOLOR
  88. 4060 MODE=OLDMODE
  89. 4600 RETURN
  90. 5000 '
  91. 5001 ' clearing the screen
  92. 5002 '
  93. 5010 CLS
  94. 5020 CURSOR1SHOW=FALSE
  95. 5030 CURSOR2SHOW=FALSE
  96. 5040 menuactive=false
  97. 5600 RETURN
  98. 6000 '
  99. 6001 ' draw lines
  100. 6002 '
  101. 6003 '         arrow keys mode dot cursors
  102. 6004 '         insert plants first cursor
  103. 6005 '         second insert draws line
  104. 6006 '         delete returns movement to first cursor
  105. 6007 '
  106. 6010 GOSUB 23010
  107. 6020 IF DELETE. THEN GOSUB 25010:CURCURSOR=0: GOTO 6600
  108. 6030 IF INSERT THEN IF INSCNT=0 THEN INSCNT=1: CURSOR2X=CURSOR1X: CURSOR2Y=CURSOR1Y:CURSOR2SHOW=FALSE: CURCURSOR=1:GOTO 6600 ELSE : ELSE GOTO 6600
  109. 6100 IF CURSOR1SHOW THEN GOSUB 24700:CURSOR1SHOW=FALSE
  110. 6110 IF CURSOR2SHOW THEN GOSUB 24720:CURSOR2SHOW=FALSE
  111. 6120 INSCNT=0:CURCURSOR=0
  112. 6130 LINE (CURSOR1X,CURSOR1Y)-(CURSOR2X,CURSOR2Y),COLOR.
  113. 6140 CURSOR1X=CURSOR2X: CURSOR1Y=CURSOR2Y
  114. 6600 RETURN
  115. 7000 '
  116. 7001 'draw rectangle with corners of cursor1 and 2
  117. 7002 '
  118. 7003 '       movement is the same as for line drawing
  119. 7004 '       but if ' ' is used instead of second insert box is filled
  120. 7005 '
  121. 7010 GOSUB 23010
  122. 7020 IF DELETE. THEN GOSUB 25010:CURCURSOR=0: GOTO 7600
  123. 7030 IF INSERT THEN IF INSCNT=0 THEN INSCNT=1: CURSOR2X=CURSOR1X: CURSOR2Y=CURSOR1Y:CURCURSOR=1:GOTO 7600 ELSE FILL=FALSE: GOTO 7100
  124. 7040 IF COMAND$=" " THEN IF INSCNT=1 THEN FILL=TRUE ELSE 7600 ELSE 7600
  125. 7100 IF CURSOR1SHOW THEN GOSUB 24700:CURSOR1SHOW=FALSE
  126. 7110 IF CURSOR2SHOW THEN GOSUB 24720:CURSOR2SHOW=FALSE
  127. 7120 INSCNT=0:CURCURSOR=0
  128. 7130 IF FILL THEN LINE (CURSOR1X,CURSOR1Y)-(CURSOR2X,CURSOR2Y),COLOR.,BF ELSE LINE (CURSOR1X,CURSOR1Y)-(CURSOR2X,CURSOR2Y),COLOR.,B
  129. 7140 CURSOR1X=CURSOR2X: CURSOR1Y=CURSOR2Y
  130. 7600 RETURN
  131. 8000 '
  132. 8001 'circles and ellipses
  133. 8002 '
  134. 8003 '         move cursors as for drawing lines
  135. 8004 '         if hit r - circle drawn with center = cursor1
  136. 8005 '                                      radius to cursor2
  137. 8006 '         if hit d - circle drawn with diameter hitting cursor 1 and 2
  138. 8007 '         if hit e - ellipse drawn with vertical axis through cursor 2
  139. 8008 '                                   and horizontal azis through cursor 1
  140. 8009 '
  141. 8010 GOSUB 23010
  142. 8020 IF INSERT THEN IF INSCNT=0 THEN INSCNT=1: CURSOR2X=CURSOR1X: CURSOR2Y=CURSOR1Y:CURCURSOR=1:GOTO 8600 ELSE CURCURSOR=1 : GOTO 8600
  143. 8030 IF DELETE. THEN GOSUB 25010:CURCURSOR=0: GOTO 8600
  144. 8040 IF INSCNT<1 THEN 8600
  145. 8045 message$="radius diamater ellipse":gosub 27000:gosub 27500
  146. 8050 IF CURSOR1SHOW THEN GOSUB 24700
  147. 8060 IF CURSOR2SHOW THEN GOSUB 24720
  148. 8070 IF COMAND$="r" THEN RADIUS=SQR((CURSOR1X-CURSOR2X)^2+(CURSOR1Y-CURSOR2Y)^2):CIRCLE (CURSOR1X,CURSOR1Y),RADIUS,COLOR.
  149. 8080 IF COMAND$="d" THEN MIDX=(CURSOR1X+CURSOR2X)/2:MIDY=(CURSOR1Y-CURSOR2Y)/2:RADIUS=SQR((CURSOR1X-MIDX)^2+(CURSOR1Y-MIDY)^2):CIRCLE(MIDX,MIDY),RADIUS,COLOR.
  150. 8090 IF COMAND$="e" THEN AXIS1=ABS(CURSOR2Y-CURSOR1Y): AXIS2=ABS(CURSOR2X-CURSOR1X): IF AXIS1/AXIS2>1 THEN CIRCLE(CURSOR2X,CURSOR1Y),AXIS1,COLOR.,,,AXIS1/AXIS2 ELSE CIRCLE (CURSOR2X,CURSOR1Y),AXIS2,COLOR.,,, AXIS1/AXIS2
  151. 8095 if comand$="e" or comand$="r" or comand$="e" then mode=oldmode
  152. 8100 IF CURSOR1SHOW THEN GOSUB 24700
  153. 8110 IF CURSOR2SHOW THEN GOSUB 24720
  154. 8600 RETURN
  155. 9000 '
  156. 9001 ' select pattern
  157. 9002 '
  158. 9003 ' reads 1 digits
  159. 9004 ' returns to previous mode
  160. 9010 message$="Pick 0-9":gosub 27000:for delay=1 to delaysize:next:gosub 27500
  161. 9015 FILL$=INKEY$:WHILE LEN(FILL$)=0:FILL$=INKEY$:WEND
  162. 9030 PATTERN=1+VAL(FILL$) MOD NUMPATTERNS
  163. 9040 MODE=OLDMODE
  164. 9600 RETURN
  165. 10000 '
  166. 10001 'paint in an area
  167. 10002 '
  168. 10003 '       move curser with arrow keys into area to fill
  169. 10010 GOSUB 23010
  170. 10020 IF NOT INSERT THEN 10600
  171. 10025 message$="Pick Border 0-3":gosub 27000:for delay=1 to delaysize:next:gosub 27500
  172. 10030 IF CURSOR1SHOW THEN GOSUB 24700
  173. 10040 BKGD$=INKEY$: WHILE LEN(BKGD$)=0 AND STRIG(3)=0: BKGD$=INKEY$:WEND:BKGD=VAL(BKGD$):IF BKGD$="" THEN BKGD=COLOR.
  174. 10050 IF PATTERN=1 THEN PAINT(CURSOR1X,CURSOR1y),0,BKGD ELSE PAINT(CURSOR1X,CURSOR1y),PATTERNS$(PATTERN),BKGD
  175. 10060 IF CURSOR1SHOW THEN GOSUB 24700
  176. 10600 RETURN
  177. 11000 '
  178. 11001 ' pen
  179. 11002 '
  180. 11003 '     set up angle and length of nib using cursors as for drawing
  181. 11004 '     lines - drawing mode beginbs after pressing second insert
  182. 11005 '     press delete at any time to restart
  183. 11006 '     when drawing move pen with arrow keys, insets toggles draw mode
  184. 11007 '
  185. 11010 GOSUB 23010    'move cursors
  186. 11020 IF DELETE. THEN CURCURSOR=0: INSCNT=0: BASEINS=0: IF CURSOR2SHOW THEN GOSUB 24720:CURSOR2SHOW=FALSE:GOTO 11600 ELSE GOTO 11600
  187. 11030 IF NOT INSERT THEN 11100
  188. 11040 INSCNT=BASEINS+(INSCNT+1) MOD 2
  189. 11050 IF INSCNT=1 THEN CURCURSOR=1: CURSOR2X=CURSOR1X:CURSOR2Y=CURSOR1Y
  190. 11060 IF INSCNT=0 THEN BASEINS=2: CURCURSOR=0: XSTEP=CURSOR2X-CURSOR1X:YSTEP=CURSOR2Y-CURSOR1Y: IF CURSOR2SHOW THEN GOSUB 24720:CURSOR2SHOW=FALSE
  191. 11100 IF INSCNT<>3 THEN 11600
  192. 11110 IF CURSOR1SHOW THEN GOSUB 24700
  193. 11120 LINE (CURSOR1X,CURSOR1Y) - STEP (XSTEP,YSTEP), COLOR.
  194. 11130 IF CURSOR1SHOW THEN GOSUB 24700
  195. 11600 RETURN
  196. 12000 '
  197. 12001 ' air brush
  198. 12002 '
  199. 12003 '      sprays part of current pattern onto screen
  200. 12004 '      move spray with arrow keys
  201. 12005 '      insert toggles spray/ don't spray
  202. 12006 '
  203. 12010 GOSUB 23010
  204. 12020 IF INSERT THEN PLOT=NOT PLOT
  205. 12030 IF NOT PLOT THEN 12600
  206. 12040 ANDPOS=CURSOR1X MOD RESOLUTION: IF RESOLUTION =4 THEN ANDPOS=ANDPOS*2
  207. 12050 FOR POSITION = 1 TO 8
  208. 12060 VALUE= (ASC(MID$(PATTERNS$(PATTERN),1+(CURSOR1Y+POSITION) MOD LEN(PATTERNS$(PATTERN)),1)))*2^ANDPOS
  209. 12070 PUSHEDVALUE=(VALUE AND &HFF) / 256
  210. 12080 VALUE=(VALUE AND &HFF) OR PUSHEDVALUE:VALUE = VALUE AND &HFFFF
  211. 12090 IF RESOLUTION=8 THEN VALUE=FNSM(VALUE) AND FNSM(SPRAYHIGH(POSITION)) ELSE VALUE = (FNSM(VALUE) AND FNSM(FNSM(SPRAYMED(2,POSITION)))+(FNSM(VALUE)) AND FNSM(SPRAYMED(1,POSITION))) *256:IF VALUE > 32766 THEN VALUE=FNSM(VALUSE)
  212. 12100 PATTERN%(2+POSITION)=VALUE
  213. 12110 NEXT
  214. 12120 IF CURSOR1SHOW THEN GOSUB 24700
  215. 12130 IF (CURSOR1X>=0) AND (CURSOR1X<(MAXXRES-PATTERN%(1)*RESOLUTION /8)) AND (CURSOR1Y>=0) AND (CURSOR1Y<MAXYRES-PATTERN%(2)) THEN PUT (CURSOR1X,CURSOR1Y),PATTERN%,OR
  216. 12140 IF CURSOR1SHOW THEN GOSUB 24700
  217. 12600 RETURN
  218. 13000 '
  219. 13001 ' cut a figure for pasting or copying
  220. 13002 '
  221. 13003 '        position cursors of corners of area to cut
  222. 13004 '        press ' ' to cut
  223. 13005 '
  224. 13010 GOSUB 23010   ' move cursors
  225. 13020 IF INSERT THEN INSCNT=INSCNT+1: IF INSCNT=1 THEN CURSOR2X=CURSOR1X: CURSOR2Y=CURSOR1Y:CURCURSOR=1:GOTO 13600 ELSE CURCURSOR=1:GOTO 13600
  226. 13030 IF DELETE. THEN CURCURSOR=0: GOTO 13600
  227. 13040 IF INSCNT<2 THEN 13600
  228. 13050 IF (CURSOR1X<0) OR (CURSOR1X>MAXXRES) OR (CURSOR1Y<0) OR (CURSOR1Y>MAXYRES) OR (CURSOR2X<0) OR (CUROSR2X>MAXXRES) OR (CURSOR2Y<0) OR (CURSOR2Y>MAXYRES) THEN 13600
  229. 13060 IF CURSOR2X< CURSOR1X THEN OLDCUTX=CURSOR2X ELSE OLDCUTX=CURSOR1X
  230. 13070 IF CURSOR2Y < CURSOR1Y THEN OLDCUTY=CURSOR2Y ELSE OLDCUTY=CURSOR1Y
  231. 13110 IF CURSOR1SHOW THEN GOSUB 24700
  232. 13120 IF CURSOR2SHOW THEN GOSUB 24720
  233. 13130 GET(CURSOR1X,CURSOR1Y)-(CURSOR2X,CURSOR2Y),CUT%:gosub 25010:mode=oldmode
  234. 13140 IF CURSOR1SHOW THEN GOSUB 24700
  235. 13150 IF CURSOR2SHOW THEN GOSUB 24720
  236. 13160 CURCUTX=OLDCUTX:CURCUTY=OLDCUTY:CUTSHOW=TRUE
  237. 13600 RETURN
  238. 14000 '
  239. 14001 ' copy
  240. 14002 '
  241. 14003 '      copy maxtix to cursor location xor until insert pressed
  242. 14004 '         then store
  243. 14005 '
  244. 14010 GOSUB 23010  ' move cursor
  245. 14020 IF LEN(COMAND$)<>2 OR CUT%(1)=0 THEN 14600
  246. 14030 IF INSERT THEN 14200
  247. 14040 IF (CURCUTX=OLDCUTX) AND (CURCUTY=OLDCUTY) THEN 14060
  248. 14050 IF CUTSHOW THEN PUT(CURCUTX,CURCUTY),CUT%:CUTSHOW=FALSE
  249. 14060 IF (CURSOR1X=OLDCUTX) AND (CURSOR1X=OLDCUTY) THEN 14600
  250. 14070 IF (CURSOR1X>=0) AND (CURSOR1X < (MAXXRES-CUT%(1)*RESOLUTION/8)) AND (CURSOR1Y>=0) AND (CURSOR1Y<MAXYRES-CUT%(2)) THEN PUT(CURSOR1X,CURSOR1Y),CUT%:CUTSHOW=TRUE
  251. 14080 CURCUTX=CURSOR1X:CURCUTY=CURSOR1Y
  252. 14090 GOTO 14600
  253. 14200 IF NOT((CURSOR1X>=0) AND (CURSOR1X < (MAXXRES-CUT%(1)*RESOLUTION/8)) AND (CURSOR1Y>=0) AND (CURSOR1Y<MAXYRES-CUT%(2))) THEN 14600
  254. 14210 IF CUTSHOW AND (CURCUTX<>OLDCUTX) AND (CURCUTY<>OLDCUTY) THEN PUT(CURCUTX,CURCUTY),CUT%
  255. 14220 PUT (CURSOR1X,CURSOR1Y),CUT%,PSET:CURSOR1SHOW=FALSE:OLDCUTX=CURSOR1X:OLDCUTY=CURSOR1Y:CUTSHOW=TRUE
  256. 14600 RETURN
  257. 15000 '
  258. 15001 ' move
  259. 15002 '
  260. 15003 '      same as copy but last drawn cut is erased
  261. 15004 '
  262. 15005 '
  263. 15010 GOSUB 23010  ' move cursor
  264. 15020 IF LEN(COMAND$)<>2 OR CUT%(1)=0 THEN 15600
  265. 15030 IF INSERT THEN 15200
  266. 15040 IF (CURCUTX=OLDCUTX) AND (CURCUTY=OLDCUTY) THEN 15060
  267. 15050 IF CUTSHOW THEN PUT(CURCUTX,CURCUTY),CUT%:CUTSHOW=FALSE
  268. 15060 IF (CURSOR1X=OLDCUTX) AND (CURSOR1X=OLDCUTY) THEN 15600
  269. 15070 IF (CURSOR1X>=0) AND (CURSOR1X < (MAXXRES-CUT%(1)*RESOLUTION/8)) AND (CURSOR1Y>=0) AND (CURSOR1Y<MAXYRES-CUT%(2)) THEN PUT(CURSOR1X,CURSOR1Y),CUT%:CUTSHOW=TRUE
  270. 15080 CURCUTX=CURSOR1X:CURCUTY=CURSOR1Y
  271. 15090 GOTO 15600
  272. 15200 PUT (OLDCUTX,OLDCUTY),CUT%
  273. 15210 IF NOT((CURSOR1X>=0) AND (CURSOR1X < (MAXXRES-CUT%(1)*RESOLUTION/8)) AND (CURSOR1Y>=0) AND (CURSOR1Y<MAXYRES-CUT%(2))) THEN 15600
  274. 15220 IF CUTSHOW AND (CURCUTX<>OLDCUTX) AND (CURCUTY<>OLDCUTY) THEN PUT(CURCUTX,CURCUTY),CUT%
  275. 15230 PUT (CURSOR1X,CURSOR1Y),CUT%,PSET:CURSOR1SHOW=FALSE:OLDCUTX=CURSOR1X:OLDCUTY=CURSOR1Y:CUTSHOW=TRUE
  276. 15600 RETURN
  277. 21000 '
  278. 21001 'set up
  279. 21002 '
  280. 21010 FOR KEY. = 1 TO 10: KEY KEY.,"": NEXT :' disable function keys
  281. 21020 DIM CURSOR1%(6) : FOR POSTION=1 TO 6: READ CURSOR1%(POSTION):NEXT 'arrow
  282. 21030 DIM CURSOR2%(6) : FOR POSTION=1 TO 6: READ CURSOR2%(POSTION):NEXT
  283. 21050 READ NUMPATTERNS
  284. 21060 FOR PATTERN=1 TO NUMPATTERNS
  285. 21070    READ PATTERNLENGTH
  286. 21080    FOR POSITION=1 TO PATTERNLENGTH
  287. 21090           READ PAT: PATTERNS$(PATTERN)=PATTERNS$(PATTERN)+CHR$(PAT)
  288. 21100    NEXT
  289. 21110 NEXT
  290. 21120 PATTERN=1
  291. 21130  PATTERN%(1)=16: PATTERN%(2)=8
  292. 21140 FOR POSITION=1 TO 8: READ SPRAYHIGH(POSITION):NEXT
  293. 21150 FOR POSITION=1 TO 8: READ SPRAYMED(1,POSITION),SPRAYMED(2,POSITION):NEXT
  294. 21200 CLS
  295. 21210 PRINT
  296. 21220 PRINT "       Joystick/Keyboard   "
  297. 21230 PRINT "          Color draw       "
  298. 21240 PRINT "     Based on drawing program "
  299. 21250 PRINT "     designed by "
  300. 21260 PRINT "     Michael L. Hyman."
  301. 21270 PRINT " in his ";CHR$(34);"Advanced IBM PC Graphics";CHR$(34)
  302. 21280 PRINT " To activate Joystick control "
  303. 21290 PRINT " and to center joystick hit J "
  304. 21295 print " Menu is activated by M, deactivated by N"
  305. 21300 WHILE INKEY$="":WEND
  306. 21310 CLS
  307. 21320 JOYSTICKACTIVE=FALSE
  308. 21330 FORCECOMAND=FALSE
  309. 21400 READ COMMANDLEN
  310. 21410 FOR POSITION=1 TO COMMANDLEN: READ MENU%(POSITION) :NEXT
  311. 21420 get(0,0)-(32,199),extra%
  312. 21430 menuactive=false
  313. 21440 delaysize=7500
  314. 21450 comand$=chr$(0)+chr$(f1)
  315. 21460 forcecomand=true
  316. 21600 RETURN
  317. 22000 '
  318. 22001 ' get command
  319. 22002 '
  320. 22010 IF FORCECOMAND THEN FORCECOMAND=FALSE ELSE COMAND$=INKEY$
  321. 22015 IF JOYSTICKACTIVE THEN GOSUB 30000
  322. 22020 IF LEN(COMAND$)=0 THEN 22600
  323. 22030 IF ASC(COMAND$)=ESC THEN FINISHED=TRUE
  324. 22040 IF COMAND$="J" OR COMAND$="j" THEN JOYSTICKACTIVE=TRUE:JOYXCENTER=STICK(0):JOYYCENTER=STICK(1)
  325. 22050 IF COMAND$="K" OR COMAND$="k" THEN JOYSTICKACTIVE=FALSE
  326. 22053 IF joystickactive and COMAND$="M" OR COMAND$="m"  and menuactive=false THEN MENUACTIVE=TRUE:GET(0,0)-(32,199),EXTRA%:PUT(0,0),MENU%,PSET
  327. 22055 IF COMAND$="N" OR COMAND$="n" and menuactive=true THEN MENUACTIVE=FALSE:PUT(0,0),EXTRA%,PSET
  328. 22060 IF LEN(COMAND$)<>2 THEN 22500 ELSE COMAND$=RIGHT$(COMAND$,1)+" "
  329. 22070 OLDMODE=MODE
  330. 22080 IF ASC(COMAND$)=F1 THEN MODE=1
  331. 22090 IF ASC(COMAND$)=F2 THEN MODE=2
  332. 22100 IF ASC(COMAND$)=F4 THEN MODE=3
  333. 22110 IF ASC(COMAND$)=F6 THEN MODE=4
  334. 22120 IF ASC(COMAND$)=F8 THEN MODE=5
  335. 22130 IF ASC(COMAND$)=F3 THEN MODE=6
  336. 22140 IF ASC(COMAND$)=F5 THEN MODE=7
  337. 22150 IF ASC(COMAND$)=F7 THEN MODE=8
  338. 22160 IF ASC(COMAND$)=ALTF2 THEN MODE=9
  339. 22170 IF ASC(COMAND$)=ALTF1 THEN MODE=10
  340. 22180 IF ASC(COMAND$)=F9 THEN MODE=11
  341. 22190 IF ASC(COMAND$)=ALTF3 THEN MODE=12
  342. 22200 IF ASC(COMAND$)=ALTF5 THEN MODE=13
  343. 22210 IF ASC(COMAND$)=ALTF7 THEN MODE=14
  344. 22220 IF ASC(COMAND$)=ALTF9 THEN MODE=15
  345. 22230 IF ASC(COMAND$)=ALTF10 THEN MODE=16
  346. 22240 IF ASC(COMAND$)=F10 THEN MODE=17
  347. 22500 IF NOT JOYSTICKACTIVE THEN DUMMY$=INKEY$: WHILE (LEN(DUMMY$)<>0) : DUMMY$=INKEY$: WEND 'clear buffer
  348. 22600 RETURN
  349. 23000 '
  350. 23001 ' move cursor
  351. 23002 '
  352. 23003 '      arrrow keys move cursor
  353. 23004 '     INSERT goes true if insert pressed
  354. 23010 IF NOT CURSOR1SHOW THEN IF (CURSOR1X>=0) AND (CURSOR1X <(MAXXRES-CURSOR1%(1)*RESOLUTION /8)) AND (CURSOR1Y >=0) AND (CURSOR1Y<MAXYRES-CURSOR1%(2)) THEN PUT (CURSOR1X,CURSOR1Y), CURSOR1% :CURSOR1SHOW=TRUE
  355. 23015 IF JOYSTICKACTIVE THEN IF LEN(COMAND$)=0 THEN COMAND$=" ":GOTO 23030 ELSE GOTO 23030
  356. 23020 IF LEN(COMAND$) <>2 THEN INSERT=FLASE: DELETE.=FALSE :GOTO 23600
  357. 23030 IF ASC(COMAND$)=INS THEN INSERT=TRUE ELSE INSERT=FALSE
  358. 23040 IF ASC(COMAND$)=DEL THEN DELETE.=TRUE ELSE DELETE.=FALSE
  359. 23070 GOSUB 24010  'read movement values
  360. 23080 IF CURCURSOR=1 THEN 23200
  361. 23100 NEWCURSOR1X=CURSOR1X+XCHANGE: NEWCURSOR1Y=CURSOR1Y+YCHANGE
  362. 23110 IF CURSOR1SHOW THEN PUT (CURSOR1X,CURSOR1Y),CURSOR1%:CURSOR1SHOW=FALSE
  363. 23120 CURSOR1X=NEWCURSOR1X: CURSOR1Y=NEWCURSOR1Y
  364. 23130 IF (CURSOR1X>=0) AND (CURSOR1X <(MAXXRES-CURSOR1%(1)*RESOLUTION /8)) AND (CURSOR1Y >=0) AND (CURSOR1Y<MAXYRES-CURSOR1%(2)) THEN PUT (CURSOR1X,CURSOR1Y), CURSOR1% :CURSOR1SHOW=TRUE
  365. 23140 GOTO 23600
  366. 23200 NEWCURSOR2X=CURSOR2X+XCHANGE: NEWCURSOR2Y=CURSOR2Y+YCHANGE
  367. 23210 IF CURSOR2SHOW THEN PUT(CURSOR2X,CURSOR2Y),CURSOR2%: CURSOR2SHOW=FALSE
  368. 23220 CURSOR2X=NEWCURSOR2X: CURSOR2Y=NEWCURSOR2Y
  369. 23230 IF (CURSOR2X>=0) AND (CURSOR2X< (MAXXRES-CURSOR2%(1)*RESOLUTION/8)) AND (CURSOR2Y >=0) AND (CURSOR2Y<MAXYRES-CURSOR2%(2)) THEN PUT(CURSOR2X,CURSOR2Y),CURSOR2%:CURSOR2SHOW=TRUE
  370. 23600 RETURN
  371. 24000 '
  372. 24001 'get movement values
  373. 24002 '
  374. 24003 '   movement according to direction of arrow keys
  375. 24004 '
  376. 24010 IF JOYSTICKACTIVE THEN GOSUB 31000:GOTO 24600
  377. 24015 IF ASC(COMAND$)=CURSLFT THEN XCHANGE=-DELTA:YCHANGE=0:GOTO 24600
  378. 24020 IF ASC(COMAND$)=CURSRT THEN XCHANGE=DELTA:YCHANGE=0:GOTO 24600
  379. 24030 IF ASC(COMAND$)=CURSUP THEN YCHANGE=-DELTA:XCHANGE=0:GOTO 24600
  380. 24040 IF ASC(COMAND$)=CURSDWN THEN YCHANGE=DELTA:XCHANGE=0:GOTO 24600
  381. 24050 IF ASC(COMAND$)=HOME THEN XCHANGE=-DELTA:YCHANGE=-DELTA:GOTO 24600
  382. 24060 IF ASC(COMAND$)=END. THEN XCHANGE=-DELTA:YCHANGE=DELTA:GOTO 24600
  383. 24070 IF ASC(COMAND$)=PGUP THEN XCHANGE=DELTA:YCHANGE=-DELTA:GOTO 24600
  384. 24080 IF ASC(COMAND$)=PGDWN THEN XCHANGE=DELTA:YCHANGE=DELTA:GOTO 24600
  385. 24090 XCHANGE=0: YCHANGE=0
  386. 24600 RETURN
  387. 24700 PUT (CURSOR1X,CURSOR1Y),CURSOR1%
  388. 24710 RETURN
  389. 24720 PUT (CURSOR2X,CURSOR2Y),CURSOR2%
  390. 24730 RETURN
  391. 25000 '
  392. 25001 ' reset parameters to clear screen of junk if mode is changed
  393. 25002 ' gets rid of any cursorts showing resets counters
  394. 25003 '
  395. 25010 IF CURSOR1SHOW THEN PUT (CURSOR1X,CURSOR1Y),CURSOR1%:CURSOR1SHOW=FALSE
  396. 25020 IF CURSOR2SHOW THEN PUT (CURSOR2X,CURSOR2Y),CURSOR2%:CURSOR2SHOW=FALSE
  397. 25030 INSCNT=0: CURCURSOR=0: INSERT=FALSE: DELETE.= FALSE
  398. 25040 BASEINS=0
  399. 25600 RETURN
  400. 26000 '
  401. 26001 'data
  402. 26002 '
  403. 26003 '
  404. 26004 ' cursor 1 Left Down Arrow. Put data type
  405. 26005 '
  406. 26010 DATA 16,4,&h55, &h50, &h44, &h41
  407. 26020 '
  408. 26021 ' cursor 2
  409. 26022 '
  410. 26030 DATA 16,4,&haa,&ha0,&h88,&h82
  411. 26040 '
  412. 26041 ' patterns for DOS 2.0 tiling
  413. 26042 '      number of patterns
  414. 26043 '
  415. 26050 DATA 9
  416. 26060 ' color 0
  417. 26061 '
  418. 26070 DATA 1,0
  419. 26080 '
  420. 26081 ' color 1
  421. 26090 DATA 1,&h55
  422. 26100 '
  423. 26101 ' color 2
  424. 26110 DATA 1,&haa
  425. 26120 '
  426. 26121 ' color 3
  427. 26130 DATA 1,&hff
  428. 26140 '
  429. 26141 ' bricks - color 2
  430. 26150 DATA 6,8,8,&haa,&h20,&h20,&haa
  431. 26160 '
  432. 26161 ' diagonal strips - color 1
  433. 26170 DATA 4, &h10,&h40,1,4
  434. 26180 '
  435. 26181 ' diamonds color 1 on color 3
  436. 26190 DATA 5,&hf7,&hf7,&hdd,&h7f,&hdd
  437. 26200 '
  438. 26201 ' squares color 2 on color 0
  439. 26210 DATA 4,0,&h28,&h28,0
  440. 26220 '
  441. 26221 ' squares color 2 on color 1
  442. 26230 DATA 4,&h55,&h69,&h69,&h55
  443. 26240 '
  444. 26241 ' data for air brush spray pattern
  445. 26242 '
  446. 26243 '     high res
  447. 26250 DATA &h81,&h24,&h30,&h1a,&h3c,&h50,&h82,&h10
  448. 26260 '
  449. 26261 '     medium res
  450. 26270 DATA &hc0,3,&hc,&h30,&h30,0,3,&hcc,&hf,&hf0,&h33,&h0,&hc0,&h0c,3,0
  451. 26300 DATA  1000
  452. 26310  DATA  70 , 196 , 21845 , 21845 , 21845 , 21845 , 16448 , 0 , 0 , 0 , 16384 , 64 , 0 , 0 , 0 , 16448 , 0 , 0 , 0 , 16384 , 64 , 0 , 0 , 0 , 16448 , 0 , 0 ,-24576 , 16384 , 64
  453. 26320  DATA  0 , 2560 , 160 , 16448 , 0 , 0 , 170 , 16384 , 64 , 0 ,-24566 , 0 , 16448 , 0 ,-22016 , 0 , 16384 , 64 , 2560 , 160 , 0 , 16448 , 0 , 170 , 0 , 16384 , 64 ,-22514 , 0 , 0
  454. 26330  DATA  16448 , 12288 , 0 , 0 , 16384 , 64 , 192 , 0 , 0 , 16448 , 3 , 0 , 0 , 16384 , 64 , 0 , 0 , 0 , 16448 , 0 , 0 , 0 , 16384 , 64 , 0 , 0 , 0 , 21824 , 21845 , 21845
  455. 26340  DATA  21845 , 16469 , 64 , 0 , 0 , 0 , 16448 , 0 , 0 , 0 , 16384 , 64 , 0 , 0 , 0 , 16448 , 48 , 0 , 0 , 16384 , 2112 , 0 , 0 , 0 , 16448 , 2 , 0 , 0 , 16384 , 64
  456. 26350  DATA  128 , 0 , 0 , 16448 , 0 , 0 , 0 , 16384 , 64 , 0 , 0 , 0 , 16448 , 512 , 0 , 0 , 16384 , 64 ,-32768 , 0 , 0 , 16448 , 0 , 32 , 0 , 16384 , 64 , 2048 , 0 , 0
  457. 26360  DATA  16448 , 0 , 0 , 0 , 16384 , 64 , 0 , 0 , 0 , 16448 , 0 , 8192 , 0 , 16384 , 64 , 0 , 8 , 0 , 16448 , 0 , 512 , 0 , 16384 , 64 , 0 ,-20480 , 0 , 21824 , 21845 , 21845
  458. 26370  DATA  21845 , 16469 , 64 , 256 , 0 , 0 , 16448 , 0 , 1 , 0 , 16384 ,-21952 ,-32342 , 0 , 0 , 16448 , 128 , 129 ,-24534 , 16384 ,-32704 ,-32512 ,-32768 , 8 , 16448 , 128 , 2689 , 512 , 16512 ,-32704
  459. 26380  DATA -32512 , 8 ,-32768 , 16448 , 128 , 2177 , 2 , 16512 ,-32704 ,-32512 , 8 ,-32768 , 16448 , 128 , 2689 , 512 , 16512 ,-32704 ,-32512 ,-32768 , 8 , 16448 , 128 , 129 ,-24534 , 16384 ,-32704 ,-32512 , 0 , 0
  460. 26390  DATA  16448 ,-21846 , 129 , 0 , 16384 , 64 , 256 , 0 , 0 , 16448 , 0 , 1 , 0 , 16384 , 21845 , 21845 , 21845 , 21845 , 16448 , 0 , 0 , 0 , 16384 , 64 , 0 , 0 , 0 , 16448 ,-22516 , 0
  461. 26400  DATA  0 , 16384 , 832 ,-22294 , 0 , 0 , 16448 , 15874 , 170 , 0 , 16384 , 576 ,-5589 , 128 , 0 , 16448 ,-22016 ,-24518 , 0 , 16384 , 64 ,-28758 , 170 , 0 , 16448 , 2560 ,-1366 , 128 , 16384 , 64
  462. 26410  DATA  10752 ,-24404 , 0 , 16448 , 0 ,-21760 , 200 , 16384 , 64 , 0 ,-17406 , 0 , 16448 , 0 , 0 ,-16381 , 16384 , 64 , 0 , 0 , 48 , 16448 , 0 , 0 , 0 , 16384 , 64 , 0 , 0 , 0
  463. 26420  DATA  21824 , 21845 , 21845 , 21845 , 16469 , 64 , 0 , 160 , 0 , 16448 , 0 , 2090 , 0 , 16384 , 64 , 2048 , 2 , 0 , 16448 , 0 , 2 , 128 , 16384 , 64 , 0 , 8320 , 0 , 16448 , 0 , 8192
  464. 26430  DATA  8 , 16384 , 64 , 0 , 520 , 0 , 16448 , 0 , 512 ,-32768 , 16384 , 64 , 0 ,-32728 , 32 , 16448 , 0 ,-32766 , 2080 , 16384 , 64 , 10240 , 2048 , 10 , 16448 , 0 , 128 , 8706 , 16512 , 64
  465. 26440  DATA  0 , 0 , 168 , 16448 , 0 , 0 , 0 , 16384 , 21845 , 21845 , 21845 , 21845 , 16448 ,-32640 ,-32640 ,-32640 , 16512 ,-32704 ,-32640 ,-32640 ,-32640 , 16448 ,-32640 ,-32640 ,-32640 , 16512 ,-32704 ,-32640 ,-32640 ,-32640
  466. 26450  DATA  32576 ,-1 ,-1 ,-1 , 16639 ,-32704 ,-32640 ,-32640 ,-32640 , 16448 ,-32640 ,-32640 ,-32640 , 16512 ,-32704 ,-32640 ,-32640 ,-32640 , 16448 ,-32640 ,-32640 ,-32640 , 16512 ,-177 ,-1 ,-1 ,-1 , 16448 ,-32640 ,-32640
  467. 26460  DATA -32640 , 16512 ,-32704 ,-32640 ,-32640 ,-32640 , 16448 ,-32640 ,-32640 ,-32640 , 16512 , 21845 , 21845 , 21845 , 21845 , 16448 , 0 , 0 , 48 , 16384 , 64 , 0 ,-16381 , 0 , 16448 , 0 , 15360 , 0 , 16384 , 64
  468. 26470  DATA  768 , 192 , 0 , 16448 , 0 , 60 , 0 , 16384 , 64 ,-32000 , 240 , 0 , 16448 , 2560 , 4008 , 192 , 16384 , 64 , 544 , 15360 , 0 , 16448 ,-22014 ,-32598 , 0 , 16384 , 576 , 0 , 128 , 0
  469. 26480  DATA  16448 , 2 ,-32768 , 0 , 16384 , 576 , 0 , 128 , 0 , 16448 , 2 ,-32768 , 0 , 16384 , 21845 , 21845 , 21845 , 21845 , 16448 , 21760 ,-21930 ,-89 , 16639 , 64 , 22101 ,-22614 ,-1 , 16448 , 21760 ,-21930
  470. 26490  DATA -89 , 16639 , 64 , 22101 ,-22614 ,-1 , 16448 , 21760 ,-21930 ,-89 , 16639 , 64 , 22101 ,-22614 ,-1 , 16448 , 21760 ,-21930 ,-89 , 16639 , 64 , 22101 ,-22614 ,-1 , 16448 , 21760 ,-21930 ,-89 , 16639 , 64
  471. 26500  DATA  22101 ,-22614 ,-1 , 16448 , 21760 ,-21930 ,-89 , 16639 , 64 , 22101 ,-22614 ,-1 , 16448 , 21760 ,-21930 ,-89 , 16639 , 21845 , 21845 , 21845 , 21845 , 16448 , 0 , 0 , 0 , 16384 , 64 , 0 , 0 , 0
  472. 26510  DATA  16448 ,-24406 , 0 ,-24576 , 16384 ,-32704 , 42 , 2560 , 160 , 16448 , 640 , 672 , 170 , 16384 ,-21952 ,-21846 ,-24406 , 0 , 16448 , 0 ,-2038 , 0 , 16384 ,-21952 ,-21846 ,-32598 , 0 , 16448 , 10880 , 672
  473. 26520  DATA  160 , 16384 ,-32192 , 168 , 10752 , 128 , 16448 ,-32598 , 0 ,-22526 , 16384 , 64 , 0 , 0 , 40 , 16448 , 0 , 0 , 0 , 16384 , 21845 , 21845 , 21845 , 21845 , 16448 , 0 , 0 , 0 , 16384 , 64
  474. 26530  DATA  0 , 2 , 0 , 16448 , 0 , 0 , 160 , 16384 , 64 , 0 ,-22528 , 0 , 16448 , 0 , 0 , 170 , 16384 , 16192 ,-1 ,-5377 , 160 , 16448 ,-193 ,-1 ,-22294 , 16384 , 16192 ,-1 ,-5377 , 160
  475. 26540  DATA  16448 , 0 , 0 ,-32598 , 16384 , 64 , 0 , 10752 , 0 , 16448 , 0 , 0 , 40 , 16384 , 64 , 0 , 8192 , 0 , 16448 , 0 , 0 , 0 , 16384 , 21845 , 21845 , 21845 , 21845 , 16448 , 0 , 0
  476. 26550  DATA  0 , 16384 , 576 , 160 , 42 , 10752 , 16448 ,-24574 , 10752 , 0 , 16426 , 576 , 160 ,-32726 ,-22016 , 16448 ,-22518 ,-22016 , 672 , 16554 , 10816 , 682 , 10410 , 10762 , 16448 ,-23902 , 10890 , 10250 , 16426 ,-32190
  477. 26560  DATA -22368 , 554 , 10912 , 16960 ,-24574 , 10784 , 0 , 16426 , 576 , 32 , 34 , 8192 , 16448 , 8194 , 8704 , 0 , 16416 , 576 , 32 , 34 , 8192 , 16448 , 10250 ,-24064 , 128 , 16544 , 64 , 0 , 0 , 0
  478. 26570  DATA  21824 , 21845 , 21845 , 21845 , 16469 , 64 , 0 , 192 , 0 , 16448 , 0 ,-16384 , 0 , 16384 , 64 , 0 , 192 , 0 , 16448 , 128 ,-15872 ,-21846 , 16544 ,-32704 , 0 , 194 , 0 , 16448 , 128 ,-15872
  479. 26580  DATA  0 , 16384 ,-32704 , 0 , 194 , 0 , 16448 , 128 ,-15872 , 0 , 16384 ,-32704 , 0 , 194 , 0 , 16448 , 128 ,-15872 , 0 , 16384 ,-32704 , 0 ,-21822 ,-24406 , 16448 , 128 ,-16384 , 0 , 16416 ,-32704
  480. 26590  DATA  0 , 192 , 8192 , 16448 , 128 ,-16384 , 0 , 16416 ,-32704 , 0 , 192 , 8192 , 16448 , 128 ,-16384 , 0 , 16416 ,-32704 , 0 , 192 , 8192 , 16448 , 128 ,-16384 , 0 , 16416 ,-21952 , 170 ,-21822 ,-24406
  481. 26600  DATA  16448 , 0 ,-16384 , 0 , 16384 , 64 , 0 , 192 , 0 , 21824 , 21845 , 21845 , 21845 , 16469 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
  482. 26610  DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
  483. 26620  DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
  484. 26630  DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
  485. 26640  DATA  0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
  486. 27000 '
  487. 27001 ' write text area
  488. 27002 '
  489. 27010 IF (CURSOR1Y)>(MAXYRES-9) THEN ALTWRITEAREA=TRUE ELSE ALTWRITEAREA=FALSE
  490. 27020 IF ALTWRITEAREA THEN TXTWINDOW=1:GRPHWINDOW=0 ELSE TXTWINDOW=25:GRPHWINDOW=190
  491. 27030 GET(0,GRPHWINDOW)-(319,GRPHWINDOW+9),WRITEAREA%
  492. 27040 LOCATE TXTWINDOW,1
  493. 27050 PRINT LEFT$(MESSAGE$,35);
  494. 27060 RETURN
  495. 27500 '
  496. 27501 ' clear txt window
  497. 27502 '
  498. 27510 IF ALTWRITEAREA THEN GRPHWINDOW=0 ELSE GRPHWINDOW=190
  499. 27520 PUT (0,GRPHWINDOW),WRITEAREA%,PSET
  500. 27530 RETURN
  501. 28000 '
  502. 28001 ' Get file name
  503. 28002 '
  504. 28010 MESSAGE$=TXTMSG$+"Filename > "
  505. 28020 GOSUB 27000
  506. 28030 B$=""
  507. 28040 KEYA$=INKEY$
  508. 28050 WHILE KEYA$<>CHR$(13) AND KEYA$<>CHR$(27)
  509. 28060 IF LEN(B$)=1 AND A$=CHR$(8) THEN B$="":GOTO 28200
  510. 28070 IF KEYA$=CHR$(8) THEN B$=LEFT$(B$,LEN(B$)-1):GOTO 28200
  511. 28090 IF KEYA$>" " AND KEYA$<="z" AND LEN(B$)<20 THEN B$=B$+KEYA$
  512. 28200 KEYA$=INKEY$
  513. 28210 MESSAGE$=TXTMSG$+"Filename > "+B$:GOSUB 27500:GOSUB 27000
  514. 28220 WEND
  515. 28230 IF KEYA$=CHR$(27) THEN B$=""
  516. 28600 RETURN
  517. 29000 '
  518. 29001 ' bsave file
  519. 29002 '
  520. 29010 TXTMSG$="Saving ":GOSUB 28000
  521. 29020 GOSUB 27500: IF B$="" THEN GOTO 29050
  522. 29025 if menuactive then put(0,0),extra%:menuactive=false
  523. 29030 DEF SEG =&HB800
  524. 29040 BSAVE B$,0,&H4000
  525. 29050 MODE=OLDMODE
  526. 29060 RETURN
  527. 29500 '
  528. 29501 ' bload file
  529. 29502 '
  530. 29510 TXTMSG$="Loading ":GOSUB 28000
  531. 29520 GOSUB 27500 : IF B$="" THEN GOTO 29550
  532. 29530 DEF SEG =&HB800
  533. 29540 BLOAD B$,0
  534. 29550 MODE=OLDMODE
  535. 29560 menuactive=false
  536. 29570 RETURN
  537. 30000 '
  538. 30001 ' joystick at comand extry alternative
  539. 30002 '
  540. 30010 IF NOT MENUACTIVE GOTO 30600
  541. 30020 IF CURSOR1X > 31 OR NOT(comand$=" ") THEN 30600
  542. 30025 forcecomand=true
  543. 30030 IF CURSOR1Y < 17 THEN comand$=chr$(0)+chr$(f1):GOTO 30600
  544. 30040 IF CURSOR1Y < 36 THEN comand$=chr$(0)+chr$(f3):GOTO 30600
  545. 30050 IF CURSOR1Y < 55 and cursor1x<17 THEN comand$=chr$(0)+chr$(f5): GOTO 30600
  546. 30060 IF CURSOR1Y < 55 then comand$=chr$(0)+chr$(f7):GOTO 30600
  547. 30070 IF CURSOR1Y < 72 THEN comand$=chr$(0)+chr$(f9):GOTO 30600
  548. 30080 IF CURSOR1Y < 87 THEN comand$=chr$(0)+chr$(altf1): GOTO 30600
  549. 30090 IF CURSOR1Y < 100 THEN comand$=chr$(0)+chr$(altf2):GOTO 30600
  550. 30100 IF CURSOR1Y < 114 THEN comand$=chr$(0)+chr$(altf3):GOTO 30600
  551. 30110 if cursor1y < 129 and cursor1x < 6 then color.=0:comand$="Z":goto 30600
  552. 30120 IF CURSOR1Y < 129 AND CURSOR1X < 12 THEN COLOR.=1:comand$="Z":GOTO 30600
  553. 30130 IF CURSOR1Y < 129 AND CURSOR1X < 20 THEN COLOR.=2:comand$="Z":GOTO 30600
  554. 30140 IF CURSOR1Y < 129 AND CURSOR1X < 30 THEN COLOR.=3:comand$="Z":GOTO 30600
  555. 30150 if cursor1y < 143 then comand$=chr$(0)+chr$(altf5):goto 30600
  556. 30160 if cursor1y < 156 then comand$=chr$(0)+chr$(altf9):goto 30600
  557. 30170 if cursor1y < 171 then comand$=chr$(0)+chr$(altf7):goto 30600
  558. 30180 if cursor1y <194 and cursor1x<14 then comand$=chr$(0)+chr$(altf10):goto 30600
  559. 30190 if cursor1y <194 then comand$=chr$(0)+chr$(f10):goto 30600
  560. 30600 RETURN
  561. 31000 '
  562. 31001 ' joystick movement
  563. 31002 '
  564. 31010 TX=STICK(0)
  565. 31020 TY=STICK(1)
  566. 31030 TX=(TX-JOYXCENTER)/(JOYXCENTER):IF ABS(TX)<.1 THEN TX=0
  567. 31040 TY=(TY-JOYYCENTER)/(JOYYCENTER):IF ABS(TY)<.1 THEN TY=0
  568. 31050 TR1=STRIG(1)
  569. 31060 TR2=STRIG(2)
  570. 31070 WHILE STRIG(1) OR STRIG(3):WEND
  571. 31075 if tr1 or tr2 then for delay=1 to 500:next delay
  572. 31080 WHILE STRIG(1) OR STRIG(3):WEND
  573. 31090 IF TR1 THEN INSERT=TRUE:beep:comand$=chr$(0)+chr$(ins) ELSE INSERT=FALSE
  574. 31100 IF TR2 THEN forcecomand=true:beep:comand$=chr$(0)+chr$(del) ELSE DELETE.=FALSE
  575. 31110 XCHANGE=TX
  576. 31120 YCHANGE=TY
  577. 31600 RETURN
  578. 40000 RESUME NEXT
  579.