Compucolor.org – Virtual Media

Listing of file='CHECK.BAS;01' on disk='vmedia/ncc_17-sector.ccvf'

10 REM  ***  CHECKBOOK ACCOUNTING SYSTEM  ***
100 REM       4/15/81  VERSION
110 GOSUB 3300:REM SCROLL ROUTINE
120 CLEAR 1000
130 GOSUB 1550
160 XS= 0:YS= 26:HS= 4:WS= 64:CS= 1:YY= YS+ HS- 1:GOSUB 3250
170 DEF FN F1(X)= INT (VAL (AM$)* 100+ .5)
180 DEF FN F2(Y)= 32* M+ D+ 416* Y
190 HD$= "REC CK#/D  DATE=M,D  [-PAYEE/PAYER-]"
200 HD$= HD$+ "    AMOUNT  CAT     BALANCE"
210 PLOT 12,6,6:PRINT "CHECKBOOK ACCOUNTING SYSTEM"
220 PRINT "________________________________________________________________"
230 PLOT 3,0,18,11:INPUT "ENTER PASSWORD:";CK$:PLOT 3,23,18
240 IF 48= ASC (CK$)THEN PRINT "O.K.":T= 200:GOSUB 2540:GOTO 270
250 REM                              
260 PRINT "WRONG PASSWORD";:T= 500:GOSUB 2540:GOTO 230
270 PLOT 6,3,3,0,18,11:INPUT "ENTER TODAY'S DATE (M,D,Y): ";M,D,Y:TD= FN F2(Y)
280 PLOT 3,0,18:INPUT "ENTER MONTH AND YEAR TO BE WORKED (M,Y): ";CM,CY
290 FILE "T",630
300 FILE "R",1,"BAL"+ RIGHT$ (STR$ (CY),2)+ ".CKB",1:R= 0
310 IF ER= 14AND CM< > 1THEN PUT 1,CM- 1;BF,BF
320 RESTORE 370:FOR I= 1TO CM:READ F$:NEXT I
330 FILE "R",2,F$+ RIGHT$ (STR$ (CY),2)+ ".CKB",16:R= 0
340 IF CM= 1AND ER= 14THEN 1430
350 IF ER= 14THEN GET 1,CM- 1,5;PB
360 IF ER= 14THEN PUT 1,CM;0,PB
370 DATA JA,FB,MR,AP,MY,JE,JL,AG,SP,OC,NV,DC
380 REM  **   RESTART ADDRESS
390 PLOT 12
400 PRINT "CHECKBOOK MENU"
410 PRINT "________________________________________________________________"
420 PLOT 15,6,6,3,0,6
430 PRINT "1) ENTER NEW CHECKS/DEPOSITS":PRINT
440 PRINT "2) UPDATE/CORRECT ENTRIES":PRINT
450 PRINT "3) DISPLAY MONTH - ";F$:PRINT
460 PRINT "4) DISPLAY YEAR 19";RIGHT$ (STR$ (CY),2);" BY CATEGORY":PRINT
470 PRINT "5) CHANGE TO ANOTHER MONTH":PRINT
480 PRINT "6) PRINTER OUTPUT PROGRAM":PRINT
490 PRINT "7) END THIS PROGRAM":PRINT
500 IF  FG= 1THEN  FILE "D",1,2
510 PLOT 10,10,10:PRINT "WHICH DO YOU WISH TO DO? ";:GOSUB 980:SB= VAL (CHR$ (A)):PRINT
520 IF SB= 1OR SB= 2 THEN FG= 1
530 ON SBGOTO 1010,1475,1770,2030,560,2550,540
540 PRINT "END OF WORK SESSION":LOAD "MENU":RUN
550 GOTO 380
560 FILE "C",2:FG= 0:INPUT "MONTH DESIRED (M)? ";CM:GOTO 320
570 Y= INT (MDY/ 416):M= INT ((MDY- Y* 416)/ 32):D= MDY- 416* Y- 32* M:RETURN
580 SG$= "":IF AM< 0THEN SG$= "-":AM= ABS (AM)
590 A1$= STR$ (INT (AM/ 100))
600 A2$= "."+ RIGHT$ (STR$ (AM+ 100- INT (AM/ 100)* 100),2)
610 AM$= RIGHT$ ("          "+ SG$+ A1$+ A2$,10):RETURN
620 DT$= RIGHT$ (STR$ (M),2)+ "/"+ RIGHT$ (STR$ (D),2)+ "/"+ RIGHT$ (STR$ (Y),2)+ " ":RETURN
630 FILE "E",FL,ER,LN
640 IF ER= 12THEN PRINT "FILE FULL. UNDERESTIMATED # ITEMS":PRINT :INPUT "PRESS RETURN ";AN$:GOTO 380
650 IF ER= 14GOTO 680
660 PRINT "DISK ERROR= ";ER,"FILE ";FL,"LINE # ";LN,",PROGRAM TERMINATED"
670 PRINT "GOTO 100 TO RESTART ":END
680 ON FLGOTO 690,840,780
690 IF R= 1GOTO 760
700 PRINT :PRINT "BAL";CY;" NOT ON THIS DISK."
710 IF PR$= "Y"GOTO 730
720 PRINT "IF FILE CANNOT BE FOUND AGAIN A NEW FILE WILL BE STARTED."
730 PRINT "LOAD CORRECT DISK AND/OR PRESS RETURN TO CONTINUE.":INPUT "";AN$
740 IF PR$= "Y"GOTO 930
750 ER= 0:R= 1:GOTO 300
760 FILE "N","BAL"+ RIGHT$ (STR$ (CY),2)+ ".CKB",12,10,12
770 FILE "R",3,"BAL"+ RIGHT$ (STR$ (CY- 1),2)+ ".CKB",1:GET 3,12,5;BF:FILE "C",3:GOTO 300
780 PRINT "CAN'T FIND BAL";CY- 1;" FILE."
790 PRINT "LOAD CORRECT DISK AND PRESS RETURN TO CONTINUE OR"
800 PRINT "ENTER PREVIOUS YEAR BAL FORWARD (00.00) ";
810 INPUT "$";AN$
820 IF 48= ASC (AN$)AND LEN (AN$)= 1GOTO 770
830 BF= INT ((VAL (AN$))* 100+ .5):GOTO 300
840 IF R= 1GOTO 890
850 PLOT 3,0,20,11,10,11,10,11,10,11,10,11,10,11,10,11,10,11
860 PLOT 3,0,20:PRINT "CAN'T FIND ";F$+ RIGHT$ (STR$ (CY),2);" FILE."
870 PRINT "LOAD CORRECT DISK AND/OR PRESS RETURN TO CONTINUE.":INPUT "";AN$:R= 1:IF PR$= "Y"THEN R= 0
880 GOTO 930
890 PLOT 3,0,20,11,10,11,10,11,10,11,10,11,10,11,10,11,10,11,10,11
900 PLOT 3,0,20:INPUT "NUMBER OF ITEMS ANTICIPATED FOR MONTH (CHECKS + DEPOSITS): ";NC
910 FILE "N",F$+ RIGHT$ (STR$ (CY),2)+ ".CKB",INT ((NC/ 4)+ .8)* 4,32,4
920 PUT 1,CM;0,0,CHR$ (0)[1],"V"[1]
930 RESTORE 940
940 DATA  70,6070,6620,8070,12486,12495
950 FOR I= 1TO 6:READ  X:IF LN< > XTHEN NEXT
960 ON IGOTO 330,2140,2300,2520,12486,2870
970 GOTO 660
980 POKE 33278,0:REM  GET KEYBD
990 A= PEEK (33278):IF A= 0GOTO 990
1000 RETURN
1010 PLOT 6,6,12,10
1020 PRINT C$(0)TAB( 30)D$(0)
1030 PRINT "____________________________  __________________________________"
1040 PRINT C$(1)TAB( 30)D$(1):PRINT C$(2)TAB( 30)D$(2)
1050 PRINT C$(3)TAB( 30)D$(3):PRINT C$(4)TAB( 30)D$(4)
1060 PRINT C$(5)TAB( 30)D$(5):PRINT C$(6)TAB( 30)D$(6)
1070 PRINT C$(7):PRINT C$(8):PRINT C$(9):PRINT C$(10):PRINT C$(11):PRINT C$(12):PRINT C$(13)
1080 PRINT C$(14)TAB( 20)C$(18):PRINT C$(15)TAB( 20)C$(19)
1090 PRINT C$(16)TAB( 20)C$(20):PRINT C$(17)TAB( 20)C$(21)
1100 IF  PR$= "Y"THEN RETURN
1110 PRINT :PRINT "IN 'CK#/D' FIELD ENTER: CK#, OR D FOR DEPOSIT, OR E TO END ENTRY"
1120 GET 1,CM,9;NC$[1]:NC= ASC (NC$)+ 1
1130 PRINT HD$:PLOT 3,XS,YY
1140 DATA 4,11,21,40,48,53
1150 PRINT RIGHT$ ("  "+ STR$ (NC)+ " ",3)
1160 RESTORE 1140:FOR I= 1TO 5:READ X
1170 PLOT 3,X,YY:A$(I)= ""
1180 GOSUB 980
1190 IF A= 26THEN PLOT 3,X,YY:PRINT SPC( 63- X):GOTO 1170
1200 IF I= 1AND A= 69GOTO 390:REM  "E" FOR END
1210 IF I= 1AND SB= 2AND (A= 11OR A= 4)GOTO 1760:REM DELETE/ERASE LINE KEY
1220 IF A= 43OR A= 13GOTO 1250
1230 A$(I)= A$(I)+ CHR$ (A):IF I= 1AND A= 68GOTO 1260
1240 GOTO 1180
1250 IF A= 43THEN PLOT 26,32
1260 NEXT I:PLOT 3,64,29
1270 IF "D"= A$(1)THEN A$(1)= CHR$ (0)
1280 IF ""< > A$(1)THEN CN= VAL (A$(1))
1290 IF ""= A$(2)GOTO 1330
1300 FOR I= 1TO LEN (A$(2)):IF ","= MID$ (A$(2),I,1) OR  "."= MID$ (A$(2),I,1)GOTO 1320
1310 NEXT I:INPUT "INCORRECT M,D --- RE-ENTER";A$(2):GOTO 1300
1320 M= VAL (LEFT$ (A$(2),I- 1)):D= VAL (RIGHT$ (A$(2),LEN (A$(2))- I)):MDY= FN F2(CY)
1330 IF ""< > A$(3)THEN PY$= A$(3)
1340 IF ""< > A$(4)THEN AM$= A$(4):AM= FN F1(1)
1350 IF CN> 0THEN AM= - ABS (AM)
1360 IF ""< > A$(5)THEN CT= VAL (A$(5))
1370 IF M< > CMGOTO 2470
1380 PUT 2,NC;MDY,CN,PY$[15],CHR$ (CT)[1],AM
1390 PUT 1,CM,9;CHR$ (NC)[1]
1400 GOSUB 2330:AM= PB:GOSUB 580:READ X:PLOT 3,X,YY:PRINT AM$
1410 IF SB= 2GOTO 1460
1420 NC= NC+ 1:GOSUB 3210:GOTO 1150
1430 PUT 1,1;BF,BF,CHR$ (1)[1],"V"[1]
1440 PUT 2,1;416* CY+ 32,0,"BAL FROM LST YR"[15],CHR$ (0)[1],BF,BF
1450 GOTO 380
1460 PRINT :INPUT "TO CORRECT ANOTHER LINE USE RETURN KEY. TO END USE E KEY.";AN$
1470 IF "E"= AN$GOTO 380
1475 PRINT :INPUT "RECORD NUMBER? ";NC:I= NC:RC= NC:PRINT
1480 PLOT 12,3,0,10:PRINT "TO DELETE ENTIRE LINE USE ERASE LINE KEY."
1490 PRINT "TO SKIP OVER FIELDS THAT ARE O.K. USE + OR RETURN KEY."
1500 PRINT "TO END USE E KEY."
1520 GET 1,CM,9;NC$[1]:IF NC> ASC (NC$)THEN PRINT "INVALID RECORD NUMBER":T= 500:GOSUB 2540:GOTO 1475
1530 GET 2,RC;MDY,CN,PY$[15],CT$[1],AM
1540 PLOT 3,0,27:PRINT HD$:PRINT :GOTO 1880
1550 DIM C$(21):REM CATEGORY DEFINITIONS
1560 REM  * * * * * * * * * * * * * * * * * * *
1570 C$(0)= "CHECKS":D$(0)= "DEPOSITS"
1580 C$(1)= "1)AUTO EXPENSES":D$(1)= "1)WAGES,SALARY"
1590 C$(2)= "2)BANK CHARGES":D$(2)= "2)INTEREST INCOME"
1600 C$(3)= "3)CHARITABLE CONTRIBUTIONS":D$(3)= "3)DIVIDEND INCOME"
1610 C$(4)= "4)DOCTORS,DENTISTS,DRUGS,ETC":D$(4)= "4)CAPITAL GAINS"
1620 C$(5)= "5)ENTERTAINMENT":D$(5)= "5)LOAN"
1630 C$(6)= "6)FOOD":D$(6)= "6)MISCELLANEOUS"
1640 C$(7)= "7)HOUSING (RENT OR MORTGAGE)":C$(8)= "8)CLOTHING"
1650 C$(9)= "9)HOME IMPROVEMENT":C$(10)= "10)LOAN PAYMENTS OTHER THAN AUTO OR MORTGAGE"
1660 C$(11)= "11)CASH":C$(12)= "12)BUSINESS TRAVEL":C$(13)= "13)VACATION":C$(14)= "14)UTILITIES"
1670 C$(15)= "15)PERSONAL/MISC.":C$(16)= "16)EDUCATION":C$(17)= "17)COMPUTER":C$(18)= "18)GIFT
1680 C$(19)= "19)VISA/MASTERCHG.":C$(20)= "20)LICENSES":C$(21)= "21)TAXES"
1685 REM
         ADD YOUR OWN CATEGORIES HERE
1690 RETURN
1699 RETURN
1700 GET 1,CM,9;NC$[1]:NC= ASC (NC$):REM DELETE RECORD
1710 IF RC= NCGOTO 1740
1720 FOR I= RC+ 1TO NC:GET 2,I;R$[32]:PUT 2,I- 1;R$[32]:NEXT I
1730 IF CN> 0THEN AM= - ABS (AM)
1740 GET 1,CM;PB,BL:PUT 1,CM;PB- AM,BL- AM,CHR$ (NC- 1)[1]
1750 GOSUB 2420:GOTO 1160
1760 PRINT "REC   ";RC;" DELETED":T= 999:GOSUB 2540:GOTO 390
1770 PLOT 12,10:PRINT HD$:PRINT :GOTO 1790:REM DISPLAY MONTH
1780 PLOT 12:PRINT "PRINTING":PLOT 27,13:PRINT HD$:PRINT
1790 GET 1,CM,9;NC$[1],V$[1]:IF V$< > "V"THEN PRINT "NO RECORDS IN MONTH";CM
1800 IF V$< > "V"THEN T= 300:GOSUB 2540:GOTO 2010
1810 IF CM= 1THEN BL= 0:GOTO 1830
1820 GET 1,CM- 1,5;BL
1830 NC= ASC (NC$)
1840 AM= BL:GOSUB 580:PRINT "BALANCE FROM PREVIOUS MONTH";TAB( 52)AM$
1850 PLOT 6,7:FOR I= 1TO NC
1860 GET 2,I;MDY,CN,PY$[15],CT$[1],AM
1870 BL= AM+ BL
1880 AM= ABS (AM)
1890 GOSUB 570:GOSUB 580:GOSUB 620
1900 IF CN> 0THEN CN$= RIGHT$ ("      "+ STR$ (CN)+ " ",7)
1910 IF CN= 0THEN CN$= "DEPOSIT"
1920 PLOT 6,7
1930 PRINT RIGHT$ (" "+ STR$ (I)+ " ",3);
1940 PRINT CN$;DT$;"  ";PY$;AM$;RIGHT$ ("   "+ STR$ (ASC (CT$))+ "  ",6);
1950 IF SB= 2THEN PRINT :PRINT :GOTO 1700
1960 AM= BL:GOSUB 580:IF SG$= "-"THEN PLOT 6,1
1970 PRINT AM$:PLOT 6,7
1980 IF SB= 4THEN RETURN
1990 IF SB= 7AND WD= 4THEN RETURN
2000 NEXT I
2010 IF PR$= "Y"THEN RETURN
2020 PRINT :INPUT "PRESS RETURN WHEN THROUGH";A$:GOTO 380
2030 PRINT :INPUT "DISPLAY CHECKS OR DEPOSITS? ";T$
2040 T= 1:IF LEFT$ (T$,1)= "C"THEN T= - 1
2050 INPUT "CATEGORY NUMBER: ";SK
2060 BL= 0:YT= 0:PB= 0:RESTORE 370
2070 PLOT 12:IF PR$= "Y"THEN PLOT 27,13
2080 PRINT HD$:PRINT
2090 FOR J= 1TO 12
2100 GET 1,J,9;NC$[1],V$[1]
2110 READ F$
2120 IF V$< > "V"THEN 2260
2130 FILE "C",2:FG= 0:MT= 0
2140 FILE "R",2,F$+ RIGHT$ (STR$ (CY),2)+ ".CKB",16:R= 0
2150 NC= ASC (NC$)
2160 FOR I= 1TO NC
2170 GET 2,I;MDY,CN,PY$[15],CT$[1],AM
2180 IF ASC (CT$)< > SKTHEN 2220
2190 IF AM= 0GOTO 2220
2200 IF AM/ ABS (AM)< > TTHEN 2220
2210 AM= ABS (AM):GOSUB 1870
2220 NEXT I
2230 MT= BL- YT:AM= MT:GOSUB 580
2240 PRINT :PRINT TAB( 38)"MONTH ";F$;" TOTAL";AM$
2250 PLOT 10:YT= YT+ MT
2260 NEXT J
2270 AM= YT:GOSUB 580
2280 PRINT TAB( 40)"YEARLY TOTAL";AM$
2290 FILE "C",2:FG= 0:RESTORE 370:FOR I= 1TO CM:READ F$:NEXT I
2300 FILE "R",2,F$+ RIGHT$ (STR$ (CY),2)+ ".CKB",16:R= 0
2310 IF PR$= "Y"THEN RETURN
2320 INPUT "PRESS RETURN WHEN THROUGH ";A$:GOTO 380
2330 REM  INSERT CHECK WHERE IT BELONGS
2340 IF NC= 1GOTO 2400
2350 FOR I= NC- 1TO 1STEP - 1:GET  2,I;ND,NN,DV$[20]
2360 IF ND> MDY OR  (ND= MDYAND NN> CN)THEN GOSUB 2390:GOTO 2380
2370 PUT 2,I+ 1;MDY,CN,PY$[15],CHR$ (CT)[1],AM:GOTO 2400
2380 NEXT I:GOTO 2370
2390 PUT 2,I+ 1;ND,NN,DV$[20]:RETURN
2400 GET 1,CM;PB:PB= PB+ AM:PUT 1,CM;PB
2410 IF CM= 1THEN PUT 1,CM,5;PB
2420 FOR I= CMTO 12:IF I= 1THEN NEXT I
2430 GET 1,I;B1,BL,N$[1],V$[1]
2440 IF V$< > "V"THEN RETURN
2450 GET 1,I- 1,5;B2:BL= B2+ B1:PUT 1,I,5;BL
2460 NEXT I:RETURN
2470 REM  CHANGE MONTH
2480 FILE "C",2:FG= 0
2490 CM= M
2500 RESTORE 370
2510 FOR I= 1TO M:READ F$:NEXT I
2520 FILE "R",2,F$+ RIGHT$ (STR$ (CY),2)+ ".CKB",16:R= 0
2530 GET 1,CM,9;NC$[1]:NC= ASC (NC$)+ 1:GOTO 1380
2540 PLOT 3,64,0:FOR I= 1TO T:NEXT I:RETURN :REM TIME DELAY
2550 PLOT 12:PR$= "Y"
2560 PRINT "PRINTER OUTPUT PROGRAM"
2570 PRINT "________________________________________________________________"
2580 R= 3:BR= 300
2590 PRINT :PRINT "BAUD RATE IS ";BR,:INPUT "CHANGE? (Y,N) ";AN$
2600 IF  LEFT$ (AN$,1)< > "Y" GOTO 2670
2610 PRINT :INPUT "WHAT BAUD RATE? (110,150,300,1200,2400,4800,9600) ";BR
2620 DATA 110,150,300,1200,2400,4800,9600
2630 RESTORE 2620:FOR  R= 1TO 7:READ B:IF BR= BGOTO 2670
2640 NEXT R
2650 PRINT "ENTRY ERROR. BAUD RATE YOU ENTERED IS ";BR,". ENTER AGAIN!":T= 999:GOSUB 2540
2660 PLOT 12:GOTO 2610
2670 PLOT 27,18,R
2680 PLOT 12,3,0,12
2690 PRINT "SELECT OPTION:":PRINT
2700 PRINT "1) PRINT A MONTH ":PRINT
2710 PRINT "2) PRINT ENTIRE YEAR (DETAIL BY MONTH)":PRINT
2720 PRINT "3) PRINT A MONTH BY CATEGORY NOT OPERATIONAL":PRINT
2730 PRINT "4) PRINT ENTIRE YEAR BY CATEGORY":PRINT
2740 PRINT "5) PRINT KEY TO CATEGORY'S ":PRINT
2760 PRINT "6) RETURN TO MENU":PRINT :PRINT
2770 GOSUB 980:WD= VAL (CHR$ (A))
2780 Z= 0:PRINT
2790 ON WDGOTO 2820,2970,2810,2830,2930,3030
2800 GOTO 2680
2810 INPUT "WHICH CATEGORY? ";SK
2820 INPUT "WHAT MONTH? (1,2,..12) ";M:IF CM< > MTHEN Z= 1
2830 INPUT "WHAT YEAR? (79,80,81,ETC) ";Y:IF CY< > YTHEN Z= 2
2840 ON Z+ 1GOTO 2880,2860
2850 CY= Y:FILE "C",1:FILE "R",1,"BAL"+ RIGHT$ (STR$ (CY),2)+ ".CKB",1
2860 CM= M:FILE "C",2:RESTORE 370:FOR I= 1TO M:READ F$:NEXT  I
2870 FILE "R",2,F$+ RIGHT$ (STR$ (CY),2)+ ".CKB",16:R= 0
2880 IF WD= 2AND M> 1GOTO 2900
2890 PLOT 27,13:GOSUB 3050:POKE 33265,0
2900 ON WDGOSUB 1780,1780,3040,2030
2910 IF  WD= 2GOTO 2990
2920 GOTO 2680
2930 PLOT 27,13,10,10,10,10:PRINT "KEY TO CATEGORY'S"+ CHR$ (13)+ CHR$ (10)+ "================="
2940 PLOT 27,80,65,27,92,27,80,67,27,92:GOSUB 1020:PLOT 12
2950 POKE 33265,0
2960 GOTO 2680
2970 M= 1:INPUT "WHAT YEAR? (79,80,81,ETC) ";Y:IF CY< > YTHEN Z= 2:GOTO 2840
2980 GOTO 2860
2990 M= M+ 1:GET 1,M,10;V$[1]:IF V$< > "V"GOTO 3020
3000 PLOT 10,10,10,10
3010 IF  M< = 12GOTO 2860
3020 POKE 33265,0:GOTO 2680
3030 PR$= "N":GOTO 380:REM  RETURN TO  MENU
3040 RETURN :REM  TEMPORARY FOR 12500
3050 PLOT 1,28:REM OUTPUT HEADER
3060 H$= "CHECKBOOK ACCOUNTING SYSTEM"+ CHR$ (13)+ CHR$ (10)+ "______________________________"
3070 PRINT H$
3080 PLOT 10,10,10,2,29
3090 MDY= TD:GOSUB 570:GOSUB 620
3100 PRINT "REPORT MONTH/YEAR: ";CM;"/";CYTAB( 34)"REPORT CURRENT AS OF: ";DT$
3110 PLOT 10,10
3120 RETURN
3130 GET 1,CM;TM,TY
3140 PLOT 27,13:GOSUB 3050
3150 PRINT F$" MONTHLY TOTAL =  $";
3160 AM= TM:GOSUB 580:PRINT AM$:PRINT
3170 PRINT TAB( 5);
3180 PRINT "YTD BALANCE = $";:AM= TY:GOSUB 580:PRINT AM$
3190 POKE 33265,0
3200 INPUT "PRESS RETURN TO CONTINUE ";AN$:GOTO 2680
3210 Y1= CALL (0):REM CALL SCROLL ROUTINE
3220 PLOT 3,XS,YY:PRINT SPC( WS)""
3230 PLOT 3,XS,YY
3240 RETURN
3250 GOSUB 3420
3260 Z= 28672+ 128* YS+ XS+ XS:AD= TM+ 2:GOSUB 3410
3270 Z= 128- WS- WS:AD= TM+ 25:GOSUB 3410
3280 POKE TM+ 5,HS- 1:POKE TM+ 7,WS* (CS+ 1):POKE TM+ 19,35* (1- CS)
3290 RETURN
3300 GOSUB 3420:RESTORE 3310
3310 DATA 33,-1,-1,6,-1,14,-1,17,128,0,25,126
3320 DATA 17,128,255,25,119,35,-1,13,194,-1,-1
3330 DATA 17,-1,-1,25,5,194,-1,-1,201
3340 IF TM> 49150THEN TM= TM- 32:REM  FOR 16K
3350 FOR I= 1TO 32:READ A:POKE TM+ I,A- (A< 0):NEXT
3360 Z= TM+ 1:AD= 33283:GOSUB 3410
3370 Z= TM:AD= ER:GOSUB 3410
3380 Z= TM+ 6:AD= TM+ 30:GOSUB 3410
3390 Z= TM+ 8:AD= TM+ 22:GOSUB 3410
3400 RETURN :REM  LINE 1
3410 ZZ= INT (Z/ 256):POKE AD,Z- 256* ZZ:POKE AD+ 1,ZZ:RETURN
3420 ER= 32940:TM= 256* PEEK (ER+ 1)+ PEEK (ER):RETURN
3430 END