PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #371)
[PCjs Machine "ibm5170"]
Waiting for machine "ibm5170" to load....
Information about “BASIC AIDS NO 2”
Utilities to assist the programmer in writing and debugging BASIC
programs. Files include a BASIC source code compressor, a BASIC cross
reference utility, and a BASIC to Fortran converter. The programs on
this disk are useful to the experienced programer as well as the
novice.
System Requirements: BASIC
How to Start: To read the files with the DOC or TXT extensions, enter
TYPE filename.DOC and press <ENTER>. To run BASIC programs, refer to
the GETTING STARTED section in this catalog.
File Descriptions:
BASCONV BAS Fortran to BASIC conversion
BASBUG BAS Information on BASIC screen bug
BASICDOS BAS Information on different commands
BASCONV DOC Documentation for BASCONV.BAS
KEYIN ASM Source code for KEYIN.EXE
KB_FLAG BAS Demo program shows BASIC access to DOS Keyboard flag
HIRESCOL BAS 640 X 200 B/W graphics demo program
GS-UNUM6 DOC Documentation for GS - BASIC utilities
GS-VAREN EXE GS - BASIC utilities
GS-UNNUM EXE GS - BASIC utilities
GS-RENUM EXE GS - BASIC utilities
FC BAS File compare utility
DITHRING TXT Where instead of solid color, you have every-other-dot
CR-LF TXT Info on Epson printers in graphics mode
COREFIX BAS Display/change memory
COMPRESS DOC Documentation for COMPRESS.BAS
COMPRESS BAS Compresses a BASIC program by taking out extra spaces
BASICREF BAS BASIC cross reference utility
COMPILER ERR Info on "string space corrupt" error in compiled program:
BASICREF DOC Documentation for BASICREF.BAS
KEYIN EXE Places parameter characters into the keyboard buffer
MONITOR DQC Documentation for MONITOR.BAS
MONITOR BAS Series of routines that provide a user interface for
LINEBUG DOC Documentation for LINEBUG.BAS
LINEBUG BAS Utility to check BASIC source files for errors
LBL-SAMP BAS Sample file for LBL-BAS.BAS
LBL-BAS BAS BASIC source file label checker
LBAS EXE Label BASIC translator program
LBAS DOC Documentation for LBAS.EXE
PAL80 BAS 80 column palette prompter
PROFILE BAS Utility that logs how much time is spent executing each
POKEPEEK TXT Commonly used BASIC peeks, pokes and subroutines
SAVEBAS COM Creates a file from a BASIC program that was "lost"
READBAS BAS Read BASIC files save in BINARY
PROFILE MEM Part of PROFILE.BAS
PROFILE DOC Documentation for PROFILE.BAS
TRACE BAS Helps debug BASIC programs
STARTBAS BAS A BASIC file menu program
SQUISHER DOC Documentation for SQUISHER.BAS
SQUISHER BAS Compresses BASIC programs
SCRN-MAP BAS Print a form for graphic screen layout
SAVEBAS DOC Documentation for SAVEBAS.COM
UNP-IBM EXE Unprotects a BASIC program on the IBM computer
UNP-IBM DOC Documentation for UNP-IBM.EXE
UN-NEW DOC How to recover a BASIC program after typing 'NEW'
UN-COMPQ EXE Unprotects a BASIC program on the COMPAQ computer
UN-COMPQ DOC Documentation for UN-COMPQ.EXE
TRACE DOC Documentation for TRACE.BAS
READ ME Notes on GS-??? programs
BASBUG.BAS
10 '***********************************************************************
20 '
30 ' A PROBLEM LOOKING FOR A SOLUTION
40 '
50 '
60 ' (OR A BUG IN BASIC)
70 '
80 ' SUBMITTED BY
90 '
100 ' JAMES P MORGAN
110 ' 1749 AMERICANA BLVD APT 23-G
120 ' ORLANDO FLA. 32809
130 '
140 ' WORK PH : (305) 826-7297
150 ' HOME PH : (305) 859-5658
160 '
170 '
180 ' THIS STARTED OUT TRYING TO GET RID OF THE CURSOR
190 ' FLICKER, WHEN LOCATING TO LINE 25 AND THEN BACK TO THE
200 ' ORIGINAL CURSOR LOCATION I CAME FROM, EVEN WITH THE
210 ' CURSOR TURNED OFF (LOCATE ,,0).
220 '
230 ' WELL THE ONLY THING THAT WOULD SEEM TO WORK WAS
240 ' TO PUT THESE TWO STATEMENTS BACK-TO-BACK AT THE START
250 ' OF THE PROGRAM, THEY ARE EITHER :
260 '
270 ' XXXX SCREEN 0,0,0
280 ' YYYY SCREEN 0,0,0
290 '
300 ' OR
310 '
320 ' XXXX SCREEN 0,0,0
330 ' YYYY SCREEN 0,1,0
340 '
350 ' THIS SEEMED TO WORK MOST OF THE TIME, DEPENDING ON HOW YOU
360 ' ENTERED "BASIC" , EITHER "A>BASIC TEST" OR "A>BASIC" AND THEN LOAD THE PROGRAM
370 '
380 ' THE REALLY WEIRD THING IS HOW THE PROGRAM RUNS. I USE
390 ' VARIOUS "LOCATE ,,X" WHERE "X" IS EITHER 0 OR 1 TO TURN
400 ' THE CURSOR ON OR OFF.
410 '
420 ' THE PROGRAM IS SMALL AND STRAIGHT FORWARD. IT SHOULD PRINT
430 ' "ABC" CONSECUTIVELY ON LINES 1 TO 24 , IF ANY "KEY" WAS
440 ' DEPRESSED (NOTE THAT THE CURSOR IS TURNED OFF THEN BACK ON)
450 ' IF A KEY WAS PRESSED.
460 '
470 ' ON LINE 25, THERE ARE TWO MESSAGES THAT ALTERNATELY OVERLAY
480 ' EACH OTHER. SO YOU WOULD THINK, RIGHT. JUST PRESS A FEW KEYS
490 ' AND SEE WHAT HAPPENS.
500 '
510 ' !!!! WHAT HAPPENS TO THE ALTERNATING MESSAGES !!!!
520 '
530 ' I GIVE UP
540 '
550 ' WANT TO KNOW HOW I GOT IT TO CONTINUE TO WORK RIGHT.
560 '
570 ' SIMPLY REPLACE ALL "LOCATE ,,X" WITH "LOCATE CSRLIN,POS(0),X"
580 ' OR INSTEAD OF "CSRLIN" OR "POS(0)' SPECIFY SOME COORDINATES.
590 '
600 ' IT VARIES FROM PURE SILLY TO WEIRD TO I WISH I HAD AN ASPIRIN.
610 '
620 ' MACHINE CONFIGURATION IS :
630 '
640 ' IBMPC UNDER DOS 1.1 ALSO 2.0
650 ' FX.80 PRINTER
660 ' QUADRAM BOARD WITH 256K
670 ' IBM RS232 SERIAL BOARD (QUADRAM WOULD NOT RUN 9600 BAUD)
680 ' IBM COLOR/GRAPHICS BOARD
690 ' PGS (PRINCETON GRAPHIS SYSTEM) COLOR MONITOR
700 ' IBM 320K AND 160K DRIVES WITH IBM ADAPTER BOARD
710 '
720 ' IF ANY ONE KNOWS OF THE PROBLEM AND/OR SOLUTION (FIX) PLEASE
730 ' LEAVE A MESSAGE ON RICH'S BBS OR DROP ME A LINE.
740 '
750 ' NOTE THAT I HAVEN'T RAN THIS ON A MONOCHROME DISPLAY YET, SO
760 ' SO I DON'T KNOW IF IT WILL DO THE SAME THING.
770 '
780 CLEAR
790 DEFINT A-Z
800 KEY OFF
810 FOR I=1 TO 10:KEY I,"":NEXT
820 ' REMOVE THE NEXT TWO CONSECUTIVE "SCREEN" STATEMENTS
830 ' AND YOU SHOULD GET THE CURSOR FLICKER BACK (MAYBE).
840 SCREEN 0,1,0
850 SCREEN 0,0,0
860 COLOR 7,0
870 CLS
880 GOSUB 1000
890 GOSUB 1060
900 GOTO 880
910 '
920 ' FOR SOME MORE WEIRD RESULTS EITHER COMMENT OUT THE NEXT "LOCATE"
930 ' (FOLLOWING THESE REMARK LINES) OR CHANGE THE LOCATE TO AN ON(1)
940 ' OR AN OFF(0) AND RUN, WATCH WHAT IS DOES NOW.
950 '
960 ' FOR SOME MORE WEIRD RESULTS... IF YOU ARE FAST ENOUGH......
970 ' DEPRESS THE "SPACE" BAR JUST ENOUGH AND QUICK ENOUGH TO "MAKE"
980 ' THE KEY. THE MESSAGES ON LINE 25 SHOULD NOT CHANGE.. IF
990 ' YOU HAVE THE NEXT LOCATE COMMENTED OUT.
1000 'LOCATE ,,1
1010 IF INKEY$="" GOTO 1050
1020 LOCATE ,,0
1030 PRINT "ABC";
1040 LOCATE ,,1
1050 RETURN
1060 GOSUB 1080
1070 RETURN
1080 R=CSRLIN
1090 C=POS(0)
1100 LOCATE ,,0
1110 LOCATE 25,40
1120 PRINT " X ";
1130 LOCATE 25,40
1140 PRINT "BOO";
1150 LOCATE 25,60
1160 PRINT " Y ";
1170 LOCATE 25,60
1180 PRINT "TOO";
1190 LOCATE R,C,0
1200 LOCATE ,,1
1210 COLOR 7,0
1220 RETURN
BASCONV.BAS
10 REM IBM-PC BASIC-TO-FORTRAN CONVERTER V. 1.0
20 REM COPYRIGHT (C) JIM GLASS, MAY 1983
30 REM * NOT FOR SALE * THIS SOFTWARE IS
40 REM IN THE PUBLIC DOMAIN AND IS FREE
50 REM FOR USE, MODIFICATION, AND DISTRIBUTION
60 REM
1000 DEFINT A-Z
1050 DEF FNUM(Q$)=ASC(LEFT$(Q$,1))>47 AND ASC(LEFT$(Q$,1))<58
1100 DEF FNTOGGLE(X$,Y$,FLG)=FLG XOR X$=Y$
1150 DEF FNREP$(X$,Y$,A,B)=LEFT$(X$,A-1)+Y$+MID$(X$,B)
1200 DEF FNINS$(X$,Y$,A,B)=LEFT$(X$,A)+Y$+MID$(X$,B)
1250 TST$(1)="$":TST$(2)="%":TST$(3)="#":TST$(4)="!"
1300 DIM REFLIN!(500),VALPH$(200),VINT$(200),VDBL$(200),VSNGL$(200)
1350 DIM POINT4!(200,2),STACK4(25),CSTK$(25),TOKLST$(20),PTLST(20),AA(20),BB(20)
1400 DATA " ","(",")","^","*","-","+","=","<",">"
1450 RESTORE 1400:FOR I=1 TO 10:READ DELIM$(I):NEXT
1550 NEXTLIN!=0
1600 NN=71
1601 KEY OFF
1650 IREF=0:JREF=0:IINT=0:IALPH=0:IDBL=0:ISNGL=0
1700 TRUE=-1:FALSE=0:PT4=0
1750 IMPFLG=FALSE:XORFLG=FALSE:EQVFLG=FALSE
1800 REM
1850 DIM KFOR$(80),PNTR(1150)
1900 DIM KBAS$(80),TWOS(6)
1950 DIM BUF$(10),CP(10)
2000 DATA ABS,AND,ASC,ATN,BEEP,CDBL,CHR$,CINT,CLOSE,CLS,COMMON
2050 DATA COS,CSNG,DATA,DEF,DEFSNG,DEFDBL,DEFINT,DEFSTR,DIM,ELSE,END
2100 DATA EOF,EQV,EXP,FIX,FN,FOR,GOSUB,GOTO,IF,IMP,INKEY$,INPUT
2150 DATA INPUT#,INPUT$,INT,LET,LOG,LPRINT,MOD,NEXT,NOT,ON,OPEN,OPTION
2200 DATA OR,PRINT,PRINT#,READ,REM,RESTORE,RETURN,SGN,SIN,SPACE$
2250 DATA SPC(,SQR,STEP,STOP,SWAP,TAN,THEN,then,TO,USING,WEND,WHILE,WRITE
2300 DATA WRITE#,XOR
2350 REM unhandled:data,gosub,inkey$,input$,option,read,restore,space$,spc(
2400 REM
2450 DATA 1,2,4,8,16,32
2500 REM
2550 REM
2600 DATA ABS,.AND.,ICHAR,ATAN,*,DBLE,CHAR,ANINT,CLOSE(,*,COMMON
2650 DATA COS,SNGL,DATA,*,IMPLICIT REAL (,IMPLICIT REAL*8 ( ,IMPLICIT INTEGER ( ,CHARACTER*127,DIMENSION,ELSE,END
2700 DATA EOF,*,EXP,IFIX,*,DO,CALL,GOTO,IF(,*,*,"READ(*,*)"
2750 DATA "READ(*,*)",READ,INT,*,ALOG,"WRITE(6,*)",MOD,CONTINUE,.NOT.,ON,OPEN,*
2800 DATA .OR.,"WRITE(*,*)",WRITE,*,C,*,RETURN,SIGN,SIN,*
2850 DATA *,SQRT,",",STOP,*,TAN,],] THEN,",",",",*,CONTINUE,"WRITE(*,*)",WRITE,*
2900 REM
2950 RESTORE 2000
3000 FOR I=1 TO NN:READ X$:KBAS$(I)=SPACE$(8):LSET KBAS$(I)=X$:NEXT
3050 RESTORE 2450:FOR I=1 TO 6:READ TWOS(I):NEXT
3100 RESTORE 2600:FOR I=1 TO NN:READ X$:KFOR$(I)=X$:NEXT
3150 FOR I=1 TO NN
3200 TOKEN$=KBAS$(I)
3250 GOSUB 6900
3350 IF PNTR(S)=0 THEN PNTR(S)=I
3400 NEXT I
3450 PRINT"Enter name of BASIC Program ";:INPUT F$
3500 OPEN F$ FOR INPUT AS #1
3550 PRINT "Enter name of FORTRAN Program ";:INPUT G$
3600 OPEN G$ FOR OUTPUT AS #2
3650 PRINT "Do you wish to have source displayed? ";:INPUT X$
3700 PRINT
3750 IF LEFT$(X$,1)="Y" OR LEFT$(X$,1)="y" THEN SHOW=TRUE ELSE SHOW=FALSE
3800 IF SHOW THEN CLS
3850 ON ERROR GOTO 6850
3900 H$="c:WORK":OPEN H$ FOR OUTPUT AS #3: GOTO 4000
3950 H$="b:WORK":OPEN H$ FOR OUTPUT AS #3
4000 ON ERROR GOTO 0
4001 OLIN=0
4002 LOCATE 2,50:COLOR 5,0:PRINT"PASS 1: PARSING"
4050 FOR Z!=1 TO 1000000!
4100 IF EOF(1) THEN 6101
4150 IF INSTR(BUF$(0),"XOR")<>0 THEN XORFLG=TRUE
4200 IF INSTR(BUF$(0),"IMP")<>0 THEN IMPFLG=TRUE
4250 IF INSTR(BUF$(0),"EQV")<>0 THEN EQVFLG=TRUE
4300 LINE INPUT#1,BUF$(0)
4350 FC=INSTR(1,BUF$(0)," ")+1
4400 I=1:LLINES=1:OLIN=OLIN+1:QUOTFLG=FALSE
4450 CM=0
4500 REM
4550 REM fix ELSEs
4600 REM
4650 GOSUB 7800:L=LEN(BUF$(0))
4700 P=0:FOR J=I TO L:X$=MID$(BUF$(0),J,1):QUOTFLG=FNTOGGLE(X$,CHR$(34),QUOTFLG) :IF (NOT QUOTFLG) AND X$=":" THEN P=J:GOTO 4800
4750 NEXT J
4800 IF P=0 THEN P=(INSTR(FC,BUF$(0),"'"))-FC:IF P>0 THEN CM=LLINES
4850 IF P>0 THEN CP(LLINES)=P:LLINES=LLINES+1:OLIN=OLIN+1:I=P+1-(CM<>0):GOTO 4700 ELSE GOTO 4900
4900 CP(LLINES)=L+1:CP(0)=0
4950 REM
5000 FOR M=LLINES TO 1 STEP-1
5050 BUF$(M)=MID$(BUF$(0),CP(M-1)+1,CP(M)-CP(M-1)-1-(CM=M))
5100 NEXT
5150 LINEO!=VAL(BUF$(1)):IF LINEO!<=NEXTLIN! THEN PRINT"ERROR":BEEP:STOP
5200 IF LLINES<2 THEN 5300
5250 FOR K=2 TO LLINES:NEXTLIN!=LINEO!-1+K:L$=STRING$(5," "):BUF$(K)=L$+" " +BUF$(K):NEXT
5300 IF FC=7 THEN 5400
5350 BUF$(1)=LEFT$(BUF$(1),FC-1)+" "+MID$(BUF$(1),FC):FC=FC+1:GOTO 5300
5400 RMFLG=FALSE
5450 FOR I=1 TO LLINES 'for each logical line...
5500 IF MID$(BUF$(1),FC,3)="REM" OR MID$(BUF$(1),FC,1)="'" THEN RMFLG=TRUE
5550 IF (NOT RMFLG) AND MID$(BUF$(I),FC,1)="'" THEN BUF$(I)="C"+BUF$(I)
5600 IF RMFLG THEN BUF$(I)="C"+BUF$(I)
5650 NEXT
5700 IF RMFLG THEN 5950
5750 ON ERROR GOTO 13000
5800 GOSUB 8300 'BUILD TABLE OF REFERENCED LINES
5850 GOSUB 9500 'BUILD TABLE OF CHAR, INT, AND DBL VARS [SINGLE NOT DETECTABLE]
5900 GOSUB 11950 'BUILD FOR/NEXT REF TABLE
5950 FOR I=1 TO LLINES:PRINT#3,BUF$(I)
6000 IF SHOW THEN COLOR 3,1:PRINT BUF$(I):COLOR 7,0
6050 BUF$(I)="":NEXT I
6100 NEXT Z!
6101 GOSUB 30000
6150 CLOSE 1:CLOSE 3:OPEN H$ FOR INPUT AS #1
6200 IF SP<>0 THEN ERROR 82
6250 IF SHOW THEN PRINT
6300 LOCATE 2,50:COLOR 3,0:PRINT"PASS 2: EDITING "
6350 GOSUB 13200 'VAR DEFS
6351 LOUT=0
6400 WHILE NOT EOF(1)
6450 LINE INPUT#1,BUF$(0)
6451 LOUT=LOUT+1
6452 IF OLIN>20 AND (LOUT MOD 20)=0 OR LOUT=1 THEN CLS:GOSUB 30000:LOCATE 2,50: COLOR 3,0:PRINT "PASS 2: EDITING "
6500 FS=INSTR(BUF$(0)," "):LINEO!=VAL(LEFT$(BUF$(0),FS)):L$=MID$(STR$(LINEO!),2)
6550 X$=STRING$(6," "):IF LEFT$(BUF$(0),1)<>"C" THEN MID$(BUF$(0),1,6)=X$
6600 GOSUB 14350:GOSUB 21150:PRINT#2,BUF$(0)
6650 IF SHOW THEN COLOR 1,3:PRINT BUF$(0):COLOR 7,0
6700 WEND
6750 REM
6800 END
6850 RESUME 3950
6900 S=0
6950 FOR J=8 TO 1 STEP -1
7000 ZL=J
7050 X$=MID$(TOKEN$,J,1):IF X$<>" " THEN 7150
7100 NEXT J
7150 IF ZL>6 THEN ZL=6
7200 FOR J=1 TO ZL
7250 X$=MID$(TOKEN$,J,1):X=ASC(X$)-64
7300 S=S+X*TWOS(ZL-J+1)
7350 NEXT J
7400 S=S-23:IF S<0 OR S>1134 THEN S=0
7450 REM RESOLVE COLLISIONS
7500 IF TOKEN$="EOF " THEN S=78:RETURN
7550 IF TOKEN$="SIN " THEN S=79:RETURN
7600 IF TOKEN$="TO " THEN S=80:RETURN
7650 IF TOKEN$="IMP " THEN S=77:RETURN
7700 IF TOKEN$="INT " THEN S=76:RETURN
7750 RETURN
7800 PE=FC:ELSC=0:IF INSTR(BUF$(0),"ELSE")=0 THEN RETURN
7850 ELSP=INSTR(PE,BUF$(0),"ELSE"):IF ELSP=0 THEN 8150
7900 ELSC=ELSC+1:ND=ELSP+4
7950 IF FNUM(MID$(BUF$(0),ND+1,1)) THEN BUF$(0)=FNINS$(BUF$(0),"GOTO ",ND,ND+1)
8000 BUF$(0)=FNINS$(BUF$(0),":",ELSP-1,ELSP):BUF$(0)=FNINS$(BUF$(0),":",ND,ND+1)
8050 IF INSTR(MID$(BUF$(0),PE,ELSP-PE),":")<>0 THEN BUF$(0)=FNINS$(BUF$(0), ":ENDIF",ELSP-2,ELSP-1):ELSP=ELSP+6
8100 PE=ELSP+2:GOTO 7850
8150 FOR K=1 TO ELSC:BUF$(0)=BUF$(0)+":ENDIF":NEXT
8200 IT=INSTR(BUF$(0),"THEN"):BUF$(0)=FNREP$(BUF$(0),"then",IT,IT+4):RETURN
8250 REM
8300 T=1:FOR I=1 TO LLINES
8350 T=1
8400 IF INSTR(MID$(BUF$(I),1),"ON ERROR")=0 THEN 8500
8450 BUF$(I)="C"+BUF$(I):GOTO 9400
8500 Q=INSTR(T,BUF$(I),"GOTO "):IF Q=0 THEN Q=INSTR(T,BUF$(I),"GOSUB ")
8550 IF Q=0 THEN Q=INSTR(T,BUF$(I),"then ")
8600 IF Q<>0 THEN 9050
8650 T0=T:T=INSTR(T,BUF$(I),"THEN ")+5 'IF T=5 THEN T=INSTR(T0,BUF$(I),"then")+5 :IF T>5 THEN IFE=TRUE
8700 IF T=5 THEN T=LEN(BUF$(I))
8750 IF T=LEN(BUF$(I)) THEN 8950
8800 IF NOT FNUM(MID$(BUF$(I),T)) THEN 8950
8900 BUF$(I)=LEFT$(BUF$(I),T-1)+"GOTO "+MID$(BUF$(I),T):Q=T
8950 E=INSTR(T,BUF$(I),"ELSE ")+5:IF T=LEN(BUF$(I)) AND E=5 THEN 9400
9000 IF Q=0 THEN 9400
9050 N=INSTR(Q,BUF$(I)," ")+1
9100 M!=VAL(MID$(BUF$(I),N)):IF M!=0 THEN 9400
9150 FOR K=1 TO IREF:IF REFLIN!(K)=M! THEN 9300:NEXT
9200 IREF=IREF+1:REFLIN!(IREF)=M!
9250 JREF=JREF+1
9300 NN=INSTR(N,BUF$(I),",")+1:IF NN>N+1 THEN N=NN:GOTO 9100
9350 IF E>5 THEN T=E:GOTO 8750
9400 NEXT I
9450 RETURN
9500 FOR K=1 TO 4
9550 FOR I=1 TO LLINES
9600 P=1
9650 P=INSTR(P+1,BUF$(I),TST$(K)):IF P=0 THEN 10950
9700 T$="":FOR J=P-1 TO 1 STEP -1:X$=MID$(BUF$(I),J,1)
9750 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 9900
9800 T$=X$+T$
9850 NEXT J
9900 TOKEN$=T$+TST$(K):IF LEN(TOKEN$)=1 THEN 9650
9950 IF LEN(TOKEN$)>=8 THEN 10000 ELSE TOKEN$=TOKEN$+" ":GOTO 9950
10000 GOSUB 6900:IF S<>0 AND TOKEN$=KBAS$(PNTR(S)) THEN P=P+1:GOTO 9650
10050 P=P+1
10100 ON K GOTO 10150,10350,10500,10700
10150 REM ALPHA
10200 FOR N=1 TO IALPH:IF T$=VALPH$(N) THEN 10650
10250 NEXT
10300 IALPH=IALPH+1:VALPH$(IALPH)=T$:GOTO 10650
10350 FOR N=1 TO IINT:IF T$=VINT$(N) THEN 10650
10400 NEXT
10450 IINT=IINT+1:VINT$(IINT)=T$:GOTO 10650
10500 FOR N=1 TO IDBL:IF T$=VDBL$(N) THEN 10650
10550 NEXT
10600 IDBL=IDBL+1:VDBL$(IDBL)=T$:GOTO 10650
10650 GOTO 9650
10700 REM single
10750 FOR N=1 TO ISNGL:IF T$=VSNGL$(N) THEN 10900
10800 NEXT
10850 ISNGL=ISNGL+1:VSNGL$(ISNGL)=T$:GOTO 10900
10900 GOTO 9650
10950 NEXT I
11000 NEXT K
11050 RETURN
11100 TP=0
11150 FOR K=1 TO 10
11200 P=1
11250 P=INSTR(P,BUF$(0),DELIM$(K)):IF P=0 THEN P=LEN(BUF$(0))+1
11300 T$="":FOR J=P-1 TO 1 STEP -1:X$=MID$(BUF$(0),J,1)
11350 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 11500
11400 T$=X$+T$
11450 NEXT J
11500 TOKEN$=T$ 'TOKEN$=T$+TST$(K)
11550 IF LEN(TOKEN$)>=8 THEN 11600 ELSE TOKEN$=TOKEN$+" ":GOTO 11550
11600 GOSUB 6900:IF S=0 OR TOKEN$<>KBAS$(PNTR(S)) THEN P=P+1:IF P<=LEN(BUF$(0)) THEN 11250 ELSE 11700
11650 TP=TP+1:TOKLST$(TP)=TOKEN$:AA(TP)=P-(J-1):BB(TP)=P:PTLST(TP)=PNTR(S):P=P+1 :IF P<=LEN(BUF$(0)) THEN 11250 ELSE 11750
11700 NEXT K
11750 FOR K=1 TO TP-1:FOR J=K+1 TO TP
11800 IF AA(J)>AA(K) THEN SWAP AA(J),AA(K):SWAP BB(J),BB(K):SWAP TOKLST$(J), TOKLST$(K):SWAP PTLST(J),PTLST(K)
11850 NEXT J:NEXT K
11900 RETURN
11950 FOR I=1 TO LLINES
12000 LNO!=LINEO!+I-1:L2=LEN(BUF$(I))
12050 IF MID$(BUF$(I),FC,4)<>"FOR " THEN 12300
12100 PT4=PT4+1:POINT4!(PT4,1)=LNO!:POINT4!(PT4,2)=-PT4:SP=SP+1:STACK4(SP)=PT4
12150 IF SP<0 THEN ERROR 80 ELSE IF SP>25 THEN ERROR 81
12200 IF I=1 THEN 12300 ELSE L$=MID$(STR$(LNO!),2)
12250 GOSUB 20850:GOTO 12450
12300 IF MID$(BUF$(I),FC,5)="NEXT " OR (L2=FC+3 AND MID$(BUF$(I),FC,4)="NEXT") THEN POINT4!(STACK4(SP),2)=LNO!:SP=SP-1 ELSE 12450
12350 IF I=1 THEN 12450 ELSE L$=MID$(STR$(LNO!),2)
12400 GOSUB 20850
12450 REM WHILE/WEND
12500 IF MID$(BUF$(I),FC,6)<>"WHILE " THEN 12750
12550 PT4=PT4+1:POINT4!(PT4,1)=LNO!:POINT4!(PT4,2)=-PT4:SP=SP+1:STACK4(SP)=PT4: CSTK$(SP)=MID$(BUF$(I),FC+6)
12600 IF SP<0 THEN ERROR 80 ELSE IF SP>25 THEN ERROR 81
12650 IF I=1 THEN 12750 ELSE L$=MID$(STR$(LNO!),2)
12700 GOSUB 20850:GOTO 12900
12750 IF MID$(BUF$(I),FC,5)="WEND " OR (L2=FC+3 AND MID$(BUF$(I),FC,4)="WEND") THEN POINT4!(STACK4(SP),2)=LNO!:BUF$(I)=BUF$(I)+" "+CSTK$(SP):SP=SP-1 ELSE 12900
12800 IF I=1 THEN 12900 ELSE L$=MID$(STR$(LNO!),2)
12850 GOSUB 20850
12900 NEXT I
12950 RETURN
13000 IF ERR=80 THEN PRINT"NEXT OR WEND WITHOUT FOR OR WHILE IN: ":PRINT BUF$(0) :STOP
13050 IF ERR=81 THEN PRINT"TOO MANY NESTED LOOPS AT: ":PRINT BUF$(0):STOP
13100 IF ERR=82 THEN PRINT"FOR WITHOUT NEXT SOMEWHERE IN PROGRAM...":STOP
13150 PRINT ERR,ERL:STOP
13200 IF IALPH>0 THEN PRINT#2," CHARACTER*127 ";
13250 QL=7:CON=FALSE:FOR I=1 TO IALPH-1:QL=QL+LEN(VALPH$(I))+2
13300 IF QL<66 THEN PRINT#2,VALPH$(I)+"$"+","; ELSE QL=7:CON=TRUE:PRINT#2, VALPH$(I)+"$"
13350 IF CON THEN PRINT#2," &";:CON=FALSE
13400 NEXT I:IF IALPH>0 THEN PRINT#2,VALPH$(IALPH)+"$"
13450 IF IINT>0 THEN PRINT#2," INTEGER ";
13500 QL=7:CON=FALSE:FOR I=1 TO IINT-1:QL=QL+LEN(VINT$(I))+2
13550 IF QL<66 THEN PRINT#2,VINT$(I)+"%"+","; ELSE QL=7:CON=TRUE:PRINT#2, VINT$(I)+"%"
13600 NEXT I:IF IINT>0 THEN PRINT#2,VINT$(IINT)+"%"
13650 IF IDBL>0 THEN PRINT#2," REAL*8 ";
13700 QL=7:CON=FALSE:FOR I=1 TO IDBL-1:QL=QL+LEN(VDBL$(I))+2
13750 IF QL<66 THEN PRINT#2,VDBL$(I)+"#"+","; ELSE QL=7:CON=TRUE:PRINT#2, VDBL$(I)+"#"
13800 NEXT I:IF IDBL>0 THEN PRINT#2,VDBL$(IDBL)+"#"
13850 IF ISNGL>0 THEN PRINT#2," REAL ";
13900 QL=7:CON=FALSE:FOR I=1 TO ISNGL-1:QL=QL+LEN(VSNGL$(I))+2
13950 IF QL<66 THEN PRINT#2,VSNGL$(I)+"#"+","; ELSE QL=7:CON=TRUE:PRINT#2, VSNGL$(I)+"!"
14000 NEXT I:IF ISNGL>0 THEN PRINT#2,VSNGL$(ISNGL)+"!"
14050 IF EQVFLG THEN PRINT#2," LOGICAL FEQV"
14100 IF XORFLG THEN PRINT#2," LOGICAL FXOR"
14150 IF IMPFLG THEN PRINT#2," LOGICAL FIMP":PRINT#2," FIMP(X,Y)=((X .AND. Y) .OR. ((.NOT. X) .AND. Y))"
14200 IF XORFLG THEN PRINT#2," FXOR(X,Y)=((X .OR Y) .AND. (.NOT. (X .AND. Y)))"
14250 IF EQVFLG THEN PRINT#2," FEQV(X,Y)=((X .AND. Y) .OR. (.NOT. X) .AND. (.NOT. Y))
14300 RETURN
14350 L=LEN(BUF$(0))
14400 GOSUB 11100
14450 FOR IT=1 TO TP
14451 RW=CSRLIN:CL=POS(0)
14452 LOCATE 25,1:PRINT SPACE$(78);
14453 LOCATE 25,1:COLOR 6,0:PRINT MID$(BUF$(0),7);:LOCATE 25,70:COLOR 2,0:PRINT TIME$;
14454 LOCATE RW,CL
14500 A=AA(IT):B=BB(IT):TOKEN$=TOKLST$(IT):P=PTLST(IT)
14550 IF TOKEN$<>KBAS$(P) THEN S=0:GOTO 18200
14600 IF P>23 THEN 14800
14650 REM 1 TO 23
14700 ON P GOSUB 21800,15250,15250,15250,15300,15250,15250,15250,19000, 15350,15200,15200,15250,15250,15150,17750,17750,17750,15250,15250,15250, 15200,15200
14750 GOTO 15650
14800 IF P>57 THEN 15000
14850 REM 24 TO 57
14900 ON P-23 GOSUB 21800,15200,15250,15150,15950,15200,17250,19200,21600, 15200,15250,15400,15200,15200,15150,15250,15200,21750,19050,15250,17350, 16350,15200,15250,15250,17850,15200,15200,15200,15200,15250,15200,15200, 15200
14950 GOTO 15650
15000 IF P>71 THEN ERROR 89
15050 ON P-57 GOSUB 15250,15250,15200,18300,15200,15250,15800,15250,15200, 18600,19050,15250,17850,21700
15100 GOTO 15650
15150 BUF$(0)=FNREP$(BUF$(0),"",A,B):RETURN
15200 RETURN
15250 BUF$(0)=FNREP$(BUF$(0),KFOR$(P),A,B):RETURN
15300 BUF$(0)=LEFT$(BUF$(0),6)+"WRITE(*,*) CHAR(7)":RETURN
15350 REM CLS:RETURN
15400 REM INPUT#
15450 Q$=MID$(BUF$(0),B):X=VAL(MID$(BUF$(0),B)):BUF$(0)=MID$(BUF$(0),A,B-1)+ "READ("
15500 X$=STR$(X):BUF$(0)=BUF$(0)+X$+")"+Q$:RETURN
15550 REM WRITE#
15600 RETURN
15650 NEXT IT
15700 GOSUB 20900
15750 RETURN
15800 X$=KFOR$(P)+CHR$(13)+CHR$(10)+" "
15850 IF FNUM(MID$(BUF$(0),B+1)) THEN X$=X$+"GOTO "
15900 BUF$(0)=FNREP$(BUF$(0),X$,A,B):RETURN
15950 REM FOR
16000 IF MID$(BUF$(0),FC,4)="OPEN" THEN RETURN
16050 FOR J=1 TO PT4:K=J:IF POINT4!(J,1)=LINEO! THEN 16200
16100 NEXT J
16150 PRINT"error":STOP
16200 X$=STR$(POINT4!(K,2)):X$="DO"+X$
16250 BUF$(0)=FNREP$(BUF$(0),X$,A,B)
16300 RETURN
16350 ACC$=",ACCESS="+CHR$(34)+"SEQUENTIAL"+CHR$(34):RL$=""
16400 IF INSTR(BUF$(0),",")<>0 THEN 16850
16450 FS=INSTR(FC,BUF$(0)," "):X=INSTR(FS+1,BUF$(0)," ")
16500 X$=MID$(BUF$(0),FS+1,X-FS-1)
16550 P3=INSTR(BUF$(0),"#"):IF P3=0 THEN P3=INSTR(BUF$(0)," AS ")+3
16600 FIL=VAL(MID$(BUF$(0),P3+1))
16650 P4=INSTR(BUF$(0),"="):IF P4=0 THEN 16750
16700 RL$=",RECL="+STR$(VAL(MID$(BUF$(0),P4+1))):ACC$=",ACCESS="+CHR$(34)+ "DIRECT"+CHR$(34)
16750 BUF$(0)=" OPEN("+STR$(FIL)+",FILE="+X$+",STATUS="+CHR$(34)+"OLD"+ CHR$(34)+ACC$+RL$+")"
16800 RETURN
16850 P1=INSTR(FC,BUF$(0),","):P2=INSTR(P1+1,BUF$(0),",")
16900 P3=INSTR(P2+1,BUF$(0),","):IF P3=0 THEN P3=LEN(BUF$(0))
16950 X$=MID$(BUF$(0),P2+1,P3-P2-1)
17000 P4=INSTR(BUF$(0),"#"):IF P4=0 THEN P4=P1
17050 FIL=VAL(MID$(BUF$(0),P4+1))
17100 IF P3<LEN(BUF$(0)) THEN RL$=",RECL="+STR$(VAL(MID$(BUF$(0),P3+1))):ACC$= ",ACCESS="+CHR$(34)+"DIRECT"+CHR$(34)
17150 GOTO 16750
17200 RETURN
17250 REM GOTO
17300 RETURN
17350 REM ON
17400 BL(1)=INSTR(FC,BUF$(0)," ")
17450 FOR M=2 TO 3:BL(M)=INSTR(BL(M-1)+1,BUF$(0)," "):NEXT
17500 IF MID$(BUF$(0),BL(2)+1,BL(3)-BL(2)-1)<>"GOTO" THEN RETURN
17550 X$=MID$(BUF$(0),BL(1)+1,BL(2)-BL(1)-1)
17600 Y$="("+MID$(BUF$(0),BL(3)+1)+") "
17650 BUF$(0)=" GOTO "+Y$+X$:RETURN
17700 RETURN
17750 REM DEF---
17800 GOSUB 15250:BUF$(0)=BUF$(0)+")":RETURN
17850 REM PRINT#
17900 P2=INSTR(BUF$(0),","):P1=INSTR(BUF$(0),"#"):FIL$=STR$(VAL(MID$(BUF$(0), P1+1,P2-P1-1)))
17950 FIL$=MID$(FIL$,2)
18000 BUF$(0)=FNREP$(BUF$(0),"WRITE("+FIL$+",*)",FC,P2+1)
18050 RETURN
18100 REM
18150 RETURN
18200 REM SPECIAL ACTION
18250 GOTO 15650
18300 P1=INSTR(FC,BUF$(0)," "):P2=INSTR(BUF$(0),",")
18350 X$=MID$(BUF$(0),P1+1,P2-P1-1):Y$=MID$(BUF$(0),P2+1)
18400 Z$="TEMP$$="+X$+CHR$(13)+CHR$(10)+" "+X$+"="+Y$
18450 Z$=Z$+CHR$(13)+CHR$(10)+" "+Y$+"="+"TEMP$$"
18500 BUF$(0)=LEFT$(BUF$(0),6)+Z$:RETURN
18550 RETURN
18600 REM WEND
18650 BUF$(0)=FNREP$(BUF$(0),"IF(",A,B):GOSUB 19300
18700 FOR J=1 TO PT4:K=J:IF POINT4!(J,2)=LINEO! THEN 18850
18750 NEXT J
18800 PRINT"ERROR":STOP
18850 X$=STR$(POINT4!(K,1))
18900 BUF$(0)=BUF$(0)+")"+" GOTO "+X$
18950 RETURN
19000 GOSUB 15250:BUF$(0)=BUF$(0)+")":RETURN
19050 BUF$(0)=LEFT$(BUF$(0),6)+"CONTINUE"
19150 I=0:GOSUB 20850:RETURN
19200 REM
19250 GOSUB 15250:IFFLG=TRUE
19300 M=0:X=INSTR(BUF$(0),"ELSE"):IF X=0 THEN X=LEN(BUF$(0))
19350 M=M+1:IF M>X THEN 20750
19400 IF MID$(BUF$(0),M,1)="]" THEN IFFLG=FALSE:MID$(BUF$(0),M,1)=")"
19450 P=INSTR("<>=",MID$(BUF$(0),M,1))
19500 IF MID$(BUF$(0),M,3)="IF(" THEN IFFLG=TRUE
19550 IF P=0 OR NOT IFFLG THEN 19350
19600 MM=M+1
19650 Q=INSTR("<>=",MID$(BUF$(0),MM,1)):IF Q=0 THEN MM=M
19700 R=4*Q+P:ON R+1 GOTO 20650,19750,19900,20050,20650,20650,20200,20350,20650, 20200,20650,20500,20650,20350,20500,20650
19750 REM <
19800 BUF$(0)=FNREP$(BUF$(0),".LT.",M,MM+1)
19850 M=MM+2:GOTO 19400
19900 REM >
19950 BUF$(0)=FNREP$(BUF$(0),".GT.",M,MM+1)
20000 M=MM+2:GOTO 19400
20050 REM =
20100 BUF$(0)=FNREP$(BUF$(0),".EQ.",M,MM+1)
20150 M=MM+2:GOTO 19400
20200 REM <>
20250 BUF$(0)=FNREP$(BUF$(0),".NE.",M,MM+1)
20300 M=MM+2:GOTO 19400
20350 REM <=
20400 BUF$(0)=FNREP$(BUF$(0),".LE.",M,MM+1)
20450 M=MM+2:GOTO 19400
20500 REM >=
20550 BUF$(0)=FNREP$(BUF$(0),".GE.",M,MM+1)
20600 M=MM+2:GOTO 19400
20650 REM IMPOSSIBLE...?
20700 GOTO 19400
20750 RETURN
20800 RETURN
20850 FOR NN=1 TO LEN(L$):MID$(BUF$(I),NN,1)=MID$(L$,NN,1):NEXT NN:RETURN
20900 REM SEARCH
20950 FOR J=1 TO IREF:K=J:IF REFLIN!(J)=LINEO! THEN 21100
21000 NEXT J
21050 RETURN
21100 I=0:GOSUB 20850:RETURN
21150 REM FINAL SCAN
21200 L=LEN(BUF$(0))
21250 I=0
21300 I=I+1:IF I>L THEN 21550
21350 X$=MID$(BUF$(0),I,1)
21400 IF X$=CHR$(34) THEN MID$(BUF$(0),I,1)="'" ELSE IF X$="^" THEN BUF$(0)= FNREP$(BUF$(0),"**",I,I+1)
21450 L=LEN(BUF$(0))
21500 GOTO 21300
21550 RETURN
21600 REM IMP
21650 FUN$=" IMP":FUN2$="FIMP(":GOSUB 21850:RETURN
21700 FUN$=" XOR":FUN2$="FXOR(":GOSUB 21850:RETURN
21750 FUN$=" MOD":FUN2$="AMOD(":GOSUB 21850:RETURN
21800 FUN$=" EQV":FUN2$="FEQV(":GOSUB 21850:RETURN
21850 REM general
21900 P=INSTR(BUF$(0),FUN$)
21950 Y$="":FOR I=P-1 TO 1 STEP -1:X$=MID$(BUF$(0),I,1)
22000 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 22100
22050 Y$=X$+Y$:NEXT I
22100 R=P+5:FOR Q=R TO LEN(BUF$(0)):X$=MID$(BUF$(0),Q,1)
22150 IF(INSTR("=, +*/\()^:<>;-",X$)<>0) THEN 22250
22200 NEXT Q
22250 X$=")":Z$=MID$(BUF$(0),R,Q-R+1):IF Z$="(" THEN Z$="":X$=""
22300 BUF$(0)=FNREP$(BUF$(0),FUN2$+Y$+","+Z$+X$,I+1,Q):RETURN
30000 LOCATE 3,50:COLOR 4,0:PRINT"SOURCE LINES:";Z!
30001 LOCATE 4,50:COLOR 6,0:PRINT"OUTPUT LINES:";OLIN
30002 RETURN
BASCONV.DOC
BASCONV--A FORTRAN-TO-BASIC CONVERSION AID
BY JIM GLASS
BASCONV is a program for converting IBM-PC Basic programs into
Microsoft or IBM Fortran. It will not perform every detail of the
conversion for you, but will perform the bulk of the drudgery.
Careful inspection and editing of the resulting output file are
vital if you wish to obtain a working Fortran program.
BASCONV is easy to use. It asks you for the name of the source
(Basic) file, the target (Fortran) file, and if you wish to have
the source displayed as it is being converted. All file names
must be supplied complete with drive identifier and extension, if
any. In addition to these files, BASCONV also builds a working
file, called WORK, on the current default drive. It DOES NOT
delete the WORK file when the conversion is complete.
BASCONV is fairly smart. Among the things it can do are:
Change FOR/NEXT loops into DO loops.
BASCONV supplies target line numbers for
the terminating CONTINUE if necessary.
Change WHILE/WEND loops into IF..CONTINUE
loops.
Change ON n GOTO statements into GOTO
(...) n type statements. ON...GOSUB and
GOSUBS in general are NOT converted.
Fully parse IF..THEN..ELSE statements and
convert into equivalent Fortran logical
IF statements or IF blocks. An IF without
an ELSE becomes a pure logical IF.
Handle OPEN..FOR..AS and OPEN
mode,file,... statements, converting them
into Fortran OPEN statements.
Detect ALL implicit declarations of
variables, and provide explicit
declarations at the beginning of the
Fortran source.
Convert all keywords, such as ATN, to
equivalents, such as ATAN. Also parse
statements such as x MOD y and convert
into statements such as AMOD(x,y).
Remove all Basic line numbers, except
where lines are explicitly referenced.
These line numbers become Fortran
statement labels.
Break all mulit-statement Basic lines
into single statements and move all
source code into column seven as required
by Fortran.
Convert all double-quotes (") into single
quotes (').
Convert Basic exponentiation (^) into
Fortran exponentiation (**).
Provide Fortran statement functions for
the Basic logical functions IMP, XOR, and
EQV.
Converts PRINT and LPRINT as well as
PRINT# and WRITE# statements into Fortran
equivalents.
Inserts appropriate code to convert the
Basic SWAP keyword into Fortran
statements.
Converts all Basic relational operators
such as <,>,=,NOT,AND,OR into equivalent
Fortran such as
.LE.,.GT.,.EQ.,.NOT.,.AND.,.OR.
Some things BASCONV (at least version 1.0) CANNOT do are:
Convert Basic graphics commands such as
LINE, PSET, PRESET.
Convert GOSUBS into CALLS
Convert PRINT USING into WRITE with
FORMAT.
Handle DATA/RESTORE/READ statements.
Handle CHAIN, LSET, MKI$, CVI,
statements.
Handle sceen positioning statements like
POS(0), CSRLIN.
Here is a list of the Basic keywords which ARE NOT converted by
BASCONV:
AUTO BLOAD BSAVE CALL CHAIN CIRCLE CLEAR CLS
COLOR COM COMMON CONT CSRLIN CVD CVI DATA
DATE$ DELETE DRAW EDIT ERASE ERL ERR ERROR
FIELD FILES FRE GET GOSUB HEX$ INKEY$ INP
INPUT$ INSTR KEY KEY$ KILL LEFT$ LEN LINE
LIST LLIST LOAD LOC LOCATE LOF LPOS LSET
MERGE MID$ MKD$ MKI$ MKS$ MOTOR NAME NEW
OCT$ OFF OPTION OUT PAINT PEEK PEN PLAY
POINT POS PRESET PSET PUT RANDOMIZE RENUM
RESTORE RESUME RIGHT$ RND RESET RUN SAVE SCREEN
SOUND SPACE$ SPC( STICK STRIG STRING$ SYSTEM TAB(
TIME$ TROFF TRON USING USR VAL VARPTR VARPTR$
WAIT WIDTH
Finally, here is a list of the Basic keywords which ARE handled
by BASCONV:
ABS AND ASC ATN CDBL CHR$ CINT CLOSE
COS CSNG DEF DEFDBL DEFINT DEFSNG DEFSTR DIM
ELSE END EQV EXP FIX FNxxxx FOR GOTO
IF IMP INPUT INPUT# INT LET LOG LPRINT
MOD NEXT NOT ON..GOTO OPEN OR PRINT PRINT#
REM RETURN SGN SIN SQR STEP STOP STR$
SWAP TAN THEN TO WEND WHILE WRITE WRITE#
XOR
Although the list of keywords recognized by BASCONV is shorter
than those not recognized, the most important are there. Many of
the unrecognized words are those with no Fortran equivalents,
such as LINE or PAINT. A few are not handled due to the
difficulty of programming the conversion, such as
DATA/READ/RESTORE. Perhaps in Version 1.1...
BASICDOS.BAS
1000 ON KEY (1) GOSUB 4140:KEY (1) ON
1010 REM *********************************************************************** * PROGRAM1 *
1020 REM * by Phil Grier * * Laurel Maryland *
1030 REM * (301) 498-2226 * ***********************************************************************
1040 DEF SEG:POKE 106,0:FALSE=0:TRUE=NOT FALSE:RESET
1050 CLS:PRINT"MUSIC? (Y OR N)"
1060 MUSIC$=INKEY$
1070 FOR I=1 TO 2:IF MUSIC$=MID$("Yy",I,1) THEN MUSIC=TRUE:GOTO 1100 ELSE NEXT
1080 IF MUSIC$="" THEN 1060
1090 MUSIC=FALSE
1100 IF MUSIC=FALSE THEN 1120
1110 S$="O3L16B.L16AL16G.L8GL16GL16AL16BO4L16CL8DDDO3B.":PLAY "XS$;"
1120 DEF SEG:POKE 106,0:SCREEN 0,1,0,0:COLOR 7,0,0:WIDTH 80:CLS:FOR I=1 TO 20:A$=INKEY$:NEXT
1130 KEY OFF:KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34)+"B:":KEY 4,"SAVE"+CHR$(34)+"B:":KEY 5,"GOSUB ":KEY 9,"CLS":KEY 7,"FILES "+CHR$(34)+"B:*.*":KEY 8,"EDIT ":KEY 6,"RETURN":KEY 10,"SYSTEM"
1140 KEY 5, CHR$(27)+"SYSTEM"+CHR$(13)
1150 GOTO 1160
1160 LOCATE 2,30:PRINT "Phil Grier's":LOCATE 4,31,0:COLOR 0,15:PRINT "PROGRAM 1":COLOR 7,0:FOR I=1 TO 3000:NEXT
1170 PRINT:PRINT
1180 PRINT"THE ";:COLOR 1,0:PRINT "COLOR";:COLOR 7,0:PRINT " STATEMENT IN MONOCHROME:
1190 PRINT:PRINT"THE NORMAL COLOR SETTING IS 7,0";:LOCATE ,50:PRINT"NORMAL
1200 PRINT "REVERSE COLOR IS 0,7";:COLOR 0,7:LOCATE ,50:PRINT"REVERSE
1210 COLOR 7,0:PRINT "UNDERSCORE IS 1,0";:LOCATE ,50:COLOR 1,0:PRINT"UNDERSCORE
1220 COLOR 7,0:PRINT "HIGH INTENSITY IS 15,0";:LOCATE ,50:COLOR 15,0:PRINT"HI-INTEN
1230 COLOR 7,0:PRINT"BLINKING IS 18,0";:LOCATE ,50:COLOR 18,0:PRINT"BLINK
1240 COLOR 7,0:PRINT "BLINKING UNDERLINED IS 17,0";:LOCATE ,50:COLOR 17,0:PRINT "BLINK & UNDERSCORE
1250 COLOR 7,0:PRINT "HIGH INTENSITY BLINKING IS 26,0";:LOCATE ,50:COLOR 26,0:PRINT "HI-INTEN & BLINK
1260 COLOR 7,0:PRINT "BLINK & UNDERSCORE & HI INTENSITY IS 25,0";:LOCATE ,50:COLOR 25,0:PRINT "BLINK & HI & UNDRSCR
1270 COLOR 7,0
1280 GOSUB 3950:GOSUB 3990:GOSUB 3950
1290 CLS:LOCATE 1,25:COLOR 0,7:PRINT " A L T E R N A T I V E S ":COLOR 7,0:PRINT :PRINT "ALT + A = AUTO
1300 PRINT "ALT + B = BSAVE
1310 PRINT "ALT + C = COLOR
1320 PRINT "ALT + D = DELETE
1330 PRINT "ALT + E = ELSE
1340 PRINT "ALT + F = FOR
1350 PRINT "ALT + G = GOTO
1360 PRINT "ALT + H = HEX$
1370 PRINT "ALT + I = INPUT
1380 PRINT "ALT + K = KEY
1390 PRINT "ALT + L = LOCATE
1400 PRINT "ALT + M = MOTOR
1410 PRINT "ALT + N = NEXT
1420 PRINT "ALT + O = OPEN
1430 PRINT "ALT + P = PRINT
1440 PRINT "ALT + R = RUN
1450 PRINT "ALT + S = SCREEN
1460 PRINT "ALT + T = THEN
1470 PRINT "ALT + U = USING
1480 PRINT "ALT + V = VAL
1490 PRINT "ALT + W = WIDTH
1500 PRINT "ALT + X = XOR";
1510 LOCATE 3,40:PRINT "CTRL + G = BEL
1520 LOCATE 5,40:PRINT "CTRL + Break = EXIT PROGRAM - EXIT AUTO
1530 LOCATE 7,40:PRINT "Ctrl + Alt + Del = SYSTEM RESET
1540 LOCATE 9,40:PRINT "Ctrl + Num Lock = PAUSE
1550 LOCATE 10,58:PRINT "(any key to continue)
1560 LOCATE 12,40:PRINT "Ctrl + Home = CLEAR SCREEN
1570 LOCATE 14,40:PRINT "Ctrl + (CURSOR RIGHT) = NEXT WORD
1580 LOCATE 16,40:PRINT "Ctrl + (CURSOR LEFT) = PREVIOUS WORD
1590 LOCATE 18,40:PRINT "Ctrl + End = ERASE TO NEXT ENTER
1600 GOSUB 3950
1610 CLS:LOCATE 1,15:COLOR 0,7:PRINT " B A S I C : G E N E R A L S T A T E M E N T S ";:COLOR 7,0
1620 PRINT:PRINT:PRINT"COMMON":LOCATE 3,15:PRINT"var list":LOCATE 3,30:PRINT"statement":LOCATE 3,52:PRINT"pass var to chained pgm
1630 PRINT"DATA":LOCATE 4,15:PRINT"data list":LOCATE 4,30:PRINT"statement":LOCATE 4,52:PRINT"create data table
1640 PRINT"DATE$":LOCATE 5,30:PRINT"function":LOCATE 5,52:PRINT"set system date
1650 PRINT"DEF FN":LOCATE 6,15:PRINT"variable":LOCATE 6,30:PRINT"function":LOCATE 6,52:PRINT"define function
1660 PRINT"DEF":LOCATE 7,15:PRINT"variable":LOCATE 7,30:PRINT"function":LOCATE 7,52:PRINT"define variable
1670 PRINT"DIM":LOCATE 8,15:PRINT"var list":LOCATE 8,30:PRINT"statement":LOCATE 8,52:PRINT"allocate dimension space
1680 PRINT"END":LOCATE 9,30:PRINT"statement":LOCATE 9,52:PRINT"return to command level
1690 PRINT"ERASE":LOCATE 10,30:PRINT"statement":LOCATE 10,52:PRINT"eliminate arrays values
1700 PRINT"ERROR":LOCATE 11,15:PRINT"number":LOCATE 11,30:PRINT"statement":LOCATE 11,52:PRINT"simulate error
1710 PRINT"FOR X=A TO B":LOCATE 12,30:PRINT"statement":LOCATE 12,52:PRINT"program loop
1720 PRINT"IF V THEN N ELSE M":LOCATE 13,30:PRINT"statement":LOCATE 13,52:PRINT"decision & transfer
1730 PRINT"LET X=V":LOCATE 14,30:PRINT"statement":LOCATE 14,52:PRINT"evaluate expression
1740 PRINT"NEXT":LOCATE 15,30:PRINT"statement":LOCATE 15,52:PRINT"terminates a for loop
1750 PRINT"OPTION BASE":LOCATE 16,15:PRINT"(0 or 1)":LOCATE 16,30:PRINT"statement":LOCATE 16,52:PRINT"set minimum array subscript
1760 PRINT"PEEK":LOCATE 17,30:PRINT"statement & function":LOCATE 17,52:PRINT"observe byte in memory
1770 PRINT"POKE":LOCATE 18,30:PRINT"statement & function":LOCATE 18,52:PRINT"put byte in memory
1780 PRINT"RANDOMIZE":LOCATE 19,15:PRINT"numeric":LOCATE 19,30:PRINT"statement":LOCATE 19,52:PRINT"generate random number
1790 PRINT"RND":LOCATE 20,15:PRINT"(X)":LOCATE 20,30:PRINT"function":LOCATE 20,52:PRINT"random number generation
1800 PRINT"READ":LOCATE 21,30:PRINT"statement":LOCATE 21,52:PRINT"read DATA statements
1810 PRINT"REM":LOCATE 22,30:PRINT"statement":LOCATE 22,52:PRINT"listing remarks
1820 PRINT"RESTORE":LOCATE 23,30:PRINT"statement":LOCATE 23,52:PRINT"reset data pointer
1830 GOSUB 3950
1840 CLS:PRINT"cont":LOCATE 1,15:COLOR 0,7:PRINT " B A S I C : G E N E R A L S T A T E M E N T S ";:COLOR 7,0
1850 LOCATE 5,1:PRINT "STOP":LOCATE 5,30:PRINT"statement":LOCATE 5,50:PRINT"halt program execution
1860 LOCATE 7,1:PRINT"SWAP":LOCATE 7,15:PRINT"numeric":LOCATE 7,30:PRINT"statement":LOCATE 7,50:PRINT"exchange values
1870 LOCATE 9,1:PRINT"TIME$":LOCATE 9,15:PRINT"string":LOCATE 9,30:PRINT"function":LOCATE 9,50:PRINT"set system time
1880 LOCATE 11,1:PRINT"WEND":LOCATE 11,30:PRINT"statement":LOCATE 11,50:PRINT"close while loop
1890 LOCATE 13,1:PRINT"WHILE":LOCATE 13,15:PRINT"variable":LOCATE 13,30:PRINT"statement":LOCATE 13,50:PRINT"loop as long as true
1900 GOSUB 3950
1910 CLS:LOCATE 1,15:COLOR 0,7:PRINT " B A S I C : C O N T R O L S T A T E M E N T S ";:COLOR 7,0
1920 PRINT:PRINT:PRINT"CALL":LOCATE 3,17:PRINT"(X,X,X)":LOCATE 3,30:PRINT"statement":LOCATE 3,50:PRINT"call M/L subroutine
1930 PRINT"CHAIN":LOCATE 4,17:PRINT"file spec.":LOCATE 4,30:PRINT"statement":LOCATE 4,50:PRINT"overlay programs
1940 PRINT"GOSUB":LOCATE 5,17:PRINT"line #":LOCATE 5,30:PRINT"statement":LOCATE 5,50:PRINT"call BASIC subroutine
1950 PRINT"GOTO":LOCATE 6,17:PRINT"line #":LOCATE 6,30:PRINT"statement":LOCATE 6,50:PRINT"transfer control
1960 PRINT"ON COM N GOSUB":LOCATE 7,17:PRINT"line #":LOCATE 7,30:PRINT"adv. statement":LOCATE 7,50:PRINT"communications trap
1970 PRINT"ON ERR GOSUB":LOCATE 8,17:PRINT"line #":LOCATE 8,30:PRINT"statement":LOCATE 8,50:PRINT"error trap
1980 PRINT"ON V GOTO":LOCATE 9,17:PRINT"line #":LOCATE 9,30:PRINT"statement":LOCATE 9,50:PRINT"conditional branch
1990 PRINT"ON KEY N GOSUB":LOCATE 10,17:PRINT"line #":LOCATE 10,30:PRINT"adv. statement":LOCATE 10,50:PRINT"function key trap
2000 PRINT"ON PEN GOSUB":LOCATE 11,17:PRINT"line #":LOCATE 11,30:PRINT"adv. statement":LOCATE 11,50:PRINT"trap off light pen
2010 PRINT"ON STRIG N GOSUB":LOCATE 12,17:PRINT"line #":LOCATE 12,30:PRINT"adv. statement":LOCATE 12,50:PRINT"trap off joystick
2020 PRINT"RESUME":LOCATE 13,17:PRINT"line #":LOCATE 13,30:PRINT"statement":LOCATE 13,50:PRINT"return from error trap
2030 PRINT"RETURN":LOCATE 14,30:PRINT"statement":LOCATE 14,50:PRINT"return from subroutine
2040 PRINT"USR":LOCATE 15,17:PRINT"var. list":LOCATE 15,30:PRINT"function":LOCATE 15,50:PRINT"call M/L subroutine
2050 PRINT"VARPTR":LOCATE 16,17:PRINT"numeric":LOCATE 16,30:PRINT"function":LOCATE 16,50:PRINT"gives address of variable
2060 GOSUB 3950
2070 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : F I L E S T A T E M E N T S ";:COLOR 7,0
2080 PRINT:PRINT:PRINT"CLOSE","numeric",,"statement","close file
2090 PRINT:PRINT"EOF","numeric",,"function","end of file condition
2100 PRINT:PRINT"ERL",,,"function","error line number
2110 PRINT:PRINT"ERR",,,"function","error number code
2120 PRINT:PRINT"FIELD","function: N AS X$","statement","format a buffer
2130 PRINT:PRINT"GET",,,"function","read rand. file record
2140 PRINT:PRINT"LSET","x$ = y$",,"func & stmnt","left justify a field
2150 PRINT:PRINT"OPEN","FS for md as fl#","statement","open file
2160 PRINT:PRINT"PUT",,,"statement","write from rand file rec
2170 PRINT"RSET","x$ = y$",,"func & stmnt","right justify a field
2180 GOSUB 3950
2190 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : I / O S T A T E M E N T S ";:COLOR 7,0
2200 PRINT:PRINT:PRINT"BEEP",,"statement","beep speaker (bel)
2210 PRINT"COM N","on/off/stop","statement","on/off comm trap
2220 PRINT"KEY","on/off","statement","function keys display
2230 PRINT"KEY","n,x$","statement","set function key
2240 PRINT"KEY","on/off/stop","statement","on/off function key trap
2250 PRINT"LOC","numeric","function","file pointer position
2260 PRINT"LOF","numeric","function","# of 128 byte blocks in file
2270 PRINT"LPOS","numeric","function","printer carrage position
2280 PRINT"MOTOR","numeric","statement","cassette motor switch
2290 PRINT"OPEN COM","n:parms","statement","open communications file
2300 PRINT"OUT","port,byte","statement","output byte to port
2310 PRINT"PEN","numeric","function","read light pen
2320 PRINT"PEN","on/off/stop","statement","on/off light pen trap
2330 PRINT"SOUND","f:duration","statement","generate speaker sound
2340 PRINT"STICK","(n)","function","joystick coordinates
2350 PRINT"STRIG","(n)","function","state of joystick button
2360 PRINT"WAIT","port/mask","function","suspend port until mask
2370 GOSUB 3950
2380 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : K E Y B O A R D & S C R E E N ";:COLOR 7,0
2390 PRINT:PRINT:PRINT"CIRCLE","(x,y),z","statement","draw circle on screen
2400 PRINT"CLS",,"statement","clear screen
2410 PRINT"COLOR","x,y","statement","set screen colors
2420 PRINT"DRAW","x$","statement","draw figure in string
2430 PRINT"GET","(x1,y1)-(x2,y2) statement","read graphics from screen
2440 PRINT"INPUT","x$","statement","read from keyboard
2450 PRINT"LINE","(x1,y1)-(x2,y2) statement","draw line on display
2460 PRINT"LINE INPUT","x$","statement","read entire line from keyboard
2470 PRINT"LOCATE","n,m","statement","position cursor row & column
2480 PRINT"LPRINT","vl","statement","output to printer
2490 PRINT"LPRINT USING","vl","statement","formatted output to printer
2500 PRINT"PAINT","(n,m)x1,x2","statement","color an area on display
2510 PRINT"PRINT","vl","statement","display data on screen
2520 PRINT"PRESET","(n,m) x","statement","display color point background
2530 PRINT"PSET","(n,m) x","statement","display color point
2540 PRINT"PUT","(x1,y1)-(x2,y2) statement","put graphics to screen
2550 PRINT"SCREEN","m,n,pg1,pg2","statement","set screen paramenters
2560 PRINT"WRITE","vl","statement","display to screen
2570 GOSUB 3950
2580 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : S T R I N G F U N C T I O N S ";:COLOR 7,0
2590 PRINT:PRINT:PRINT:PRINT:PRINT"ASC","(x$)","function","ASCII code for 1st character
2600 PRINT"CVI$/CVS$/CVD$ (x$)","function","convert value to ASCII
2610 PRINT"CHR$","(x$)","function","character with ASCII code
2620 PRINT"HEX$","x","function","convert to ASCII hex string
2630 PRINT"INSTR","(N,X$,Y$)","statement","compare string & give position
2640 PRINT"LEFT$","(x$,n)","function","left most n characters
2650 PRINT"MID$","(x$,m,n,)","function","n characters in x$ starting at m
2660 PRINT"MKI$/MKS$/MKD$ (x)","function","convert ASCII to value
2670 PRINT"OCT$","(n)","function","convert to octal string
2680 PRINT"RIGHT$","(x$,n)","function","right most n characters
2690 PRINT"SPACE$","(n)","function","string of n spaces
2700 PRINT"STR$","(x)","function","convert to string
2710 PRINT"STRING$","(n,x$)","function","repeat 1st character
2720 GOSUB 3950
2730 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : M A T H F U N C T I O N S ";:COLOR 7,0
2740 PRINT:PRINT:PRINT:PRINT"ABS","(x)","function","absolute value
2750 PRINT"ATN","(x)","function","arctangent (radians)
2760 PRINT"COBL","(x)","function","convert to double precision
2770 PRINT"CINT","(x)","function","convert to integer
2780 PRINT"COS","(x)","function","cosine (radians)
2790 PRINT"CSGN","(x)","function","convert to single precision
2800 PRINT"EXP","(x)","function","exponential base e
2810 PRINT"FIX","(x)","function","truncate to integer
2820 PRINT"INT","(x)","function","convert to integer
2830 PRINT"LOG","(x)","function","natural logarithm
2840 PRINT"RND","(x)","function","random number generator
2850 PRINT"SGN","(x)","function","sign of number
2860 PRINT"SQR","(x)","function","square root of number
2870 PRINT"TAN","(x)","function","tangent (radians)
2880 GOSUB 3950
2890 CLS:LOCATE 1,17:COLOR 0,7:PRINT " B A S I C : C O M M A N D S ";:COLOR 7,0
2900 PRINT:PRINT"AUTO","(n,m)","generate automatic line numbers
2910 PRINT"BLOAD","filespec","load binary data file
2920 PRINT"BSAVE","filespec","save binary data file
2930 PRINT"CLEAR",",x,y","clear variables & set memory
2940 PRINT"CONT",,"continue program execution
2950 PRINT"DELETE","n-m","delete lines
2960 PRINT"EDIT","n","display & edit a line
2970 PRINT"FILES","filespec","list files that match
2980 PRINT"KILL","filespec","delete files
2990 PRINT"LIST","n-m","display program lines
3000 PRINT"LLIST","n-m","print program lines
3010 PRINT"LOAD","filespec","load file
3020 PRINT"MERGE","filespec","overlay program from file
3030 PRINT"NAME","fs as fs","rename file
3040 PRINT"NEW",,"delete current program from memory
3050 PRINT"RENUM","i,j,k","renumber lines
3060 PRINT"RESET",,"close all files
3070 PRINT"RUN",,"execute program in memory
3080 PRINT"SAVE","filespec","dump program to disk file
3090 PRINT"SYSTEM",,"end basic & return to DOS
3100 PRINT"TRON",,"turn trace on
3110 PRINT"TROFF",,"turn trace off
3120 GOSUB 3950
3130 CLS:LOCATE 1,19:COLOR 0,7:PRINT " D O S : C O M M A N D S ";:COLOR 7,0
3140 PRINT:PRINT:PRINT"BATCH","(d:) fn param",,"execute batch file
3150 PRINT"CHKDSK","(d:)",,"display disk status
3160 PRINT"COMP","(fs)(d:)fn(ext)","compare files
3170 PRINT"COPY","(fs)(d:)fn(ext)","copy files
3180 PRINT"DATE","mm/dd/yy",,"enter system date
3190 PRINT"DIR","(d:)fn(ext)",,"display disk directory
3200 PRINT"DISKCOMP","(d:)(d:)",,"compare disks
3210 PRINT"DISKCOPY","(d:)(d:)",,"copy disks
3220 PRINT"ERASE","filespec",,"delete file
3230 PRINT"FORMAT","(d:)(/s)",,"format disk
3240 PRINT"MODE","(dev)(,n)(,m)(,t)","set mode for printer & display
3250 PRINT"PAUSE","(rem)",,"system pause
3260 PRINT"REM","(rem)",,"display remarks
3270 PRINT"RENAME","fs fn (ext)",,"rename file
3280 PRINT"SYS",,,"transfer DOS
3290 PRINT"TIME","hr:min:sec.ms",,"enter system time
3300 PRINT"TYPE","filespec",,"display file
3310 PRINT"EDLIN","filespec",,"execute editor
3320 PRINT"LINK",,,"execute linker
3330 PRINT"DEBUG","filespec",,"ececute debug program
3340 GOSUB 3950
3350 CLS:LOCATE 1,19:COLOR 0,7:PRINT " D E B U G : C O M M A N D S ";:COLOR 7,0
3360 PRINT:PRINT:PRINT:PRINT"D(ADR)",,"display address
3370 PRINT"D(RNG)",,"display range of address
3380 PRINT"A ADR(LIST)",,"alter memory
3390 PRINT"F RNG LIST",,"fill range with list
3400 PRINT"G (ADR) (ADR)",,"execute until break point
3410 PRINT"H VAL VAL",,"hex arithmetic
3420 PRINT"I PORT",,"input & display byte
3430 PRINT"L(ADR)(D SECT SECT)","load file or disk sectors
3440 PRINT"M RNG ADR",,"move memory block
3450 PRINT"N FS(FS)",,"define files
3460 PRINT"O PORT BYTE",,"output byte to port
3470 PRINT"Q",,"quit debug program
3480 PRINT"R(REG)",,"display registers & flags
3490 PRINT"S RNG LIST",,"search for characters
3500 PRINT"T(=ADR)(VALUE)","execute instr. & display register
3510 PRINT"U ADR",,"disassemble addresss
3520 PRINT"U RNG",,"disassemble range
3530 PRINT"W(ADR)(D SECT SECT)","write file of disk sector
3540 GOSUB 3950
3550 CLS:LOCATE 1,19:COLOR 0,7:PRINT " E D L I N : C O M M A N D S ";:COLOR 7,0
3560 PRINT:PRINT:PRINT"(N)",:COLOR 0,7:PRINT"A";:COLOR 7,0:PRINT,":append lines
3570 PRINT:PRINT"(LN)(,LN)",:COLOR 0,7:PRINT"D";:COLOR 7,0:PRINT,":delete lines (begin ,end)
3580 PRINT:PRINT,:COLOR 0,7:PRINT"(LN)";:COLOR 7,0:PRINT,":edit line
3590 PRINT:PRINT,:COLOR 0,7:PRINT"E";:COLOR 7,0:PRINT,":end edit (save BAK)
3600 PRINT:PRINT"(LN)",:COLOR 0,7:PRINT"I";:COLOR 7,0:PRINT,":insert line
3610 PRINT:PRINT"(LN)(,LN)",:COLOR 0,7:PRINT"L";:COLOR 7,0:PRINT,":list lines (begin ,end)
3620 PRINT:PRINT,:COLOR 0,7:PRINT"Q";:COLOR 7,0:PRINT,":quit - abort edit
3630 PRINT:PRINT"(LN)(,LN)(?)",:COLOR 0,7:PRINT"R STR F6 STR";:COLOR 7,0:PRINT,":replace text (preceeded with [begin][,end][?]
3640 PRINT:PRINT"(LN)(,LN)(?)",:COLOR 0,7:PRINT"S STR";:COLOR 7,0:PRINT,":search text (preceeded with [begin][,end][?]
3650 PRINT:PRINT"(N)",:COLOR 0,7:PRINT"W";:COLOR 7,0:PRINT,":write lines to disk
3660 GOSUB 3950
3670 CLS:LOCATE ,10:COLOR 0,7:PRINT" E A S Y W R I T E R E M B E D D E D C O M M A N D S ";:COLOR 7,0:PRINT
3680 PRINT:PRINT:PRINT:PRINT".EJECT",,"Page eject
3690 PRINT".EJECTnn",,"Eject page within nn lines from the bottom
3700 PRINT".EOL",,"Programmable end of line character
3710 PRINT".FORMSTOP",,"Stops printer at page breaks
3720 PRINT".FORMSTOPOFF",,"Turns off .FORMSTOP
3730 PRINT".LINESnn",,"Number of printed lines per page
3740 PRINT".MARGINn",,"Sets the left margin
3750 PRINT".PAGErr,cc",,"Page numbering. rr = row, cc = column
3760 PRINT".PAGELINESnn",,"Page length. nn = number of lines per page
3770 PRINT".SPACEn",,"Sets additional spaces between lines
3780 PRINT".TITLEA,nn,text","Sets headers & footers
3790 PRINT".TITLEB,nn,text","Up to 3 titles per page
3800 PRINT".TITLEC,nn,text",,"
3810 PRINT".TOPn",,"Sets number of spaces at top of page
3820 PRINT".USER",,"User defined command
3830 GOSUB 3950
3840 CLS:LOCATE ,25:COLOR 0,7:PRINT" P R I N T I N G M O D E S ";:COLOR 7,0:PRINT
3850 LOCATE 8,1:PRINT"COMPRESSED ON",,"CTRL O - CTRL O
3860 PRINT"COMPRESSED OFF","CTRL O - CTRL R
3870 PRINT:PRINT"DOUBLE STRIKE ON","CTRL O - ESC G
3880 PRINT"DOUBLE STRIKE OFF","CTRL O - ESC H
3890 PRINT:PRINT"DOUBLE WIDTH ON","CTRL O - CTRL N
3900 PRINT"DOUBLE WIDTH OFF","CTRL O - CTRL T
3910 PRINT:PRINT"EMPHASIZED ON",,"CTRL O - ESC E
3920 PRINT"EMPHASIZED OFF","CTRL O - ESC F
3930 GOSUB 3950
3940 GOTO 4090
3950 KEY OFF:PN=PN+1:LOCATE 1,72:PRINT"page"PN:LOCATE 25,65:COLOR 18,0:PRINT "PRESS ANY KEY";:COLOR 7,0
3960 A$=INKEY$:IF A$<>"" THEN 3960
3970 A$=INKEY$:IF A$="" THEN 3970
3980 IF A$=CHR$(27) THEN 4090 ELSE CLS:RETURN
3990 CLS:X=0:COLOR ,0
4000 FOR I=0 TO 31
4010 IF X=0 THEN COLOR I:PRINT"COLOR"I",0";:X=1:GOTO 4030
4020 IF X THEN PRINT TAB(40);:COLOR I:PRINT"COLOR"I",0":X=0
4030 NEXT:COLOR 7,0:GOSUB 3950
4040 CLS:X=0:COLOR ,7
4050 FOR I=0 TO 31
4060 IF X=0 THEN COLOR I:PRINT"COLOR"I",7";:X=1:GOTO 4080
4070 IF X THEN PRINT TAB(40);:COLOR I:PRINT"COLOR"I",7":X=0
4080 NEXT:COLOR 7,0:RETURN
4090 IF MUSIC=FALSE THEN 4110
4100 S$="O3L8GD16D-16D16D+DP4L8F+.L8G.":PLAY "XS$;"
4110 CLS:COLOR 7,0:KEY ON:GOTO 4140
4120 'SAVE"B:PROGRAM1
4130 GOTO 4110
4140 END
BASICREF.BAS
1 REM ***********************************************************************
2 REM * *
3 REM * CROSS-REFERENCE LISTING UTILITY FOR BASIC PROGRAMS *
4 REM * FOR THE IBM PERSONAL COMPUTER *
5 REM * from BYTE MAGIZINE August 1983 *
6 REM * *
7 REM * This program reads a tokenized BASIC program file, finds and sorts *
8 REM * all variable names and line references, and lists them on a disk *
9 REM * file. Each name and line reference is cross-referenced to the *
10 REM * line where it appears. *
11 REM * *
12 REM * IBM PC BASIC JUNE 26, 1982 *
13 REM * *
14 REM ************************************************************************
15 REM
100 REM************ INITIALIZATION AND DEFINITIONS **************************
110 DIM LABEL$(500), LINE.REF%(500), C$(128)
120 LABEL.NUMBER = 0 : FALSE = 0 : TRUE = NOT FALSE : POINTER = 129
130 REM
200 REM************ GET FILE NAME OF BASIC PROGRAM **************************
210 CLS : KEY OFF : PRINT "BASIC CROSS REFERENCE GENERATOR" : PRINT
220 INPUT "ENTER FILE NAME: ", FILENAME$ : PRINT
230 OPEN FILENAME$ AS #1 LEN = 128
240 REM
300 REM*********************** INITIALIZE INPUT FILE ************************
310 FOR I = 1 TO 128 'set up file buffer as an array
320 FIELD #1, (I-1) AS X$, 1 AS C$(I) 'of 128 single characters
330 NEXT I
340 REM
400 REM****** READ FIRST THREE CHARACTERS OF BASIC PROGRAM FILE *************
420 GOSUB 7000 : IF C<>255 THEN PRINT "NOT A TOKENIZED PROGRAM FILE" : END
430 GOSUB 4000 'subroutine to get value for BASIC's offset address
440 REM
500 REM****** CONTINUE READING THE FILE: FILL ARRAYS LABEL$ AND LINE% *******
510 REM************** WITH VARIABLE NAMES AND LINE NUMBERS ******************
520 WHILE ADR<>0 'ADR=0 indicates end of program file
530 REM****** GET LINE NUMBER (A TWO-BYTE INTEGER VALUE) ***************
540 GOSUB 7000 : LOW.BYTE = C
550 GOSUB 7000 : HIGH.BYTE = C
560 LINE.NO% = (HIGH.BYTE * 256) + LOW.BYTE
570 LOCATE 10,1 : PRINT "PROCESSING LINE NUMBER"; LINE.NO%;
580 GOSUB 7000 'get first character after line number
590 REM********* NOW READ REST OF LINE ********************************
600 WHILE C<>0 'C=0 indicates end of line
610 IF C=143 OR C=132 THEN WHILE C<>0 : GOSUB 7000 : WEND : GOTO 720 'remark or data statement--skip to end of line
620 IF C=209 THEN LABEL.NUMBER=LABEL.NUMBER+1 : LABEL$(LABEL.NUMBER)= "FN" : GOSUB 5030 : GOTO 720 'get variable name
630 IF C>127 GOTO 710 'skip any other tokens
640 IF (C>64 AND C<91) THEN GOSUB 5000 : GOTO 720 'get variable name
650 IF C=14 THEN GOSUB 6000 : GOTO 720 'get line number reference
660 IF C=34 THEN GOSUB 7000 : WHILE C<>34 AND C<>0 : GOSUB 7000 : WEND : IF C=0 GOTO 720 : GOTO 710 'skip string constant
670 IF C=15 THEN GOSUB 7000 : GOTO 710 'skip one-byte number
680 IF (C>10 AND C<14) OR C=28 THEN GOSUB 7000 : GOSUB 7000 : GOTO 710 'skip two-byte number that follows
690 IF C=29 THEN FOR I=1 TO 4 : GOSUB 7000 : NEXT I : GOTO 710 'skip four-byte number
700 IF C=31 THEN FOR I=1 TO 8 : GOSUB 7000 : NEXT I 'skip eight-byte number
710 GOSUB 7000
720 WEND
730 GOSUB 4000 'begin new line; get next value for offset address
740 WEND
750 REM
800 REM*************** SORT LABLES AND LINE NUMBERS *************************
810 LOCATE 12,1 : PRINT "PROCESSING COMPLETE . . . "
820 PASS=0
830 G%=LABEL.NUMBER
840 PASSES=INT(LOG(G%)/LOG(2))
850 WHILE G%>1
860 PASS=PASS+1
870 LOCATE 14,1:PRINT "SORTING: PASS ";PASS;" OF ";PASSES;" PASSES";
880 SORTED=FALSE
890 G%=G%/2
900 WHILE NOT SORTED
910 SORTED=TRUE
920 FOR I%=1 TO LABEL.NUMBER-G%
930 IG%=I%+G%
940 IF LABEL$(I%)<LABEL$(IG%) GOTO 1030
950 IF LABEL$(I%)=LABEL$(IG%) GOTO 1000
960 SWAP LABEL$(I%),LABEL$(IG%)
970 SWAP LINE.REF%(I%),LINE.REF%(IG%)
980 SORTED=FALSE
990 GOTO 1030
1000 IF LINE.REF%(I%)=<LINE.REF%(IG%) GOTO 1030
1010 SWAP LINE.REF%(I%),LINE.REF%(IG%)
1020 SORTED=FALSE
1030 NEXT I%
1040 WEND
1050 WEND
1060 LOCATE 16,1 : PRINT "SORT COMPLETE . . . WRITING FILE" : PRINT
1070 REM
2000 REM*********** CREATE FILE NAME FOR LISTING ****************************
2010 PERPOS = INSTR(FILENAME$,".") 'find position of period in filename
2020 IF PERPOS=0 THEN PERPOS=LEN(FILENAME$)+1 'if no period - pretend there is
2030 LISTFILE$ = LEFT$(FILENAME$,PERPOS-1)+".CRF" 'create filename for listing
2040 OPEN LISTFILE$ FOR OUTPUT AS #2 'open sequential file for listing
2050 PRINT #2,"CROSS REFERENCE LISTING FOR PROGRAM FILE: ";FILENAME$
2060 PRINT #2,"CREATED AT "; TIME$; " ON "; DATE$
2070 REM
3000 REM*********** WRITE CROSS REFERENCE TABLE TO FILE *********************
3010 I = 1 : PRINT #2, '* NOTE FOR LINE 3070
3020 WHILE I =< LABEL.NUMBER '* N>3 gives 40 col
3030 PRINT #2, : PRINT #2, LABEL$(I); TAB(18); '* N>8 gives 80 col
3040 CURRENT.LABEL$ = LABEL$(I) : N=1 '* N>16 gives 132 col
3050 WHILE LABEL$(I) = CURRENT.LABEL$ '********************
3060 PRINT #2, USING "##### "; LINE.REF%(I);
3070 I=I+1 : N=N+1 : IF N>8 THEN PRINT #2, : PRINT #2, TAB(18); : N=1
3080 WEND
3090 PRINT #2, 'begin new line
3100 WEND
3110 PRINT #2, : KEY ON : BEEP : END
3120 REM
4000 REM***** SUBROUTINE TO OBTAIN BASIC'S OFFSET ADDRESS FOR THIS LINE *****
4010 GOSUB 7000 : LOW.BYTE = C
4020 GOSUB 7000 : HIGH.BYTE = C
4030 ADR = HIGH.BYTE + LOW.BYTE 'not really correct, but address is only
4040 RETURN 'of interest when zero, so this will do
4050 REM
5000 REM********** SUBROUTINE TO GET VARIABLE NAME **************************
5010 LABEL.NUMBER = LABEL.NUMBER + 1
5020 LABEL$(LABEL.NUMBER) = CHR$(C) 'put first character in label
5030 GOSUB 7000 'get second character
5040 WHILE (C>47 AND C<58) OR (C>64 AND C<91) OR C=46 'add legal characters:
5050 LABEL$(LABEL.NUMBER) = LABEL$(LABEL.NUMBER) + CHR$(C)
5060 GOSUB 7000
5070 WEND
5080 IF (C>34 AND C<38) OR C=33 THEN LABEL$(LABEL.NUMBER)=LABEL$(LABEL.NUMBER)+ CHR$(C) : GOSUB 7000 'get variable type symbol if any
5090 WHILE C=32 : GOSUB 7000 : WEND 'skip over any blanks
5100 IF C=40 THEN LABEL$(LABEL.NUMBER)=LABEL$(LABEL.NUMBER)+"(SUB)": GOSUB 7000 'identify as a subscripted variable if it is
5110 LINE.REF%(LABEL.NUMBER) = LINE.NO% 'store current line number where this label appears
5120 RETURN
5130 REM
6000 REM************** SUBROUTINE TO GET LINE NUMBER REFERENCE **************
6010 LABEL.NUMBER = LABEL.NUMBER + 1
6020 LINE.REF%(LABEL.NUMBER) = LINE.NO%
6030 GOSUB 7000 : LOW.BYTE = C
6040 GOSUB 7000 : HIGH.BYTE = C
6050 LABEL$(LABEL.NUMBER) = SPACE$(5)
6060 RSET LABEL$(LABEL.NUMBER) = STR$((HIGH.BYTE*256)+LOW.BYTE)
6070 GOSUB 7000
6080 RETURN
6090 REM
7000 REM******* SUBROUTINE TO GET ASCII VALUE FOR NEST CHARACTER (C) ********
7010 IF POINTER < 128 GOTO 7040
7020 GET #1 'refill buffer
7030 POINTER=0 'and reset pointer
7040 POINTER = POINTER + 1
7050 C = ASC(C$(POINTER)) 'get next character ASCII value
7060 RETURN
BASICREF.DOC
CROSS-REFERENCE UTILITY FOR IBM PC BASIC PROGRAMS
To produce a cross-reference listing for BASIC programs running on the IBM
Personal Computer, I wrote a program that scans a BASIC program file and
builds a list of variable names and the locations where they occur. The
program then sorts that list and writes it to a file.
The program expects a standard BASIC program file, that is, one saved without
the special A (ASCII - American National Standard Code for Information
Interchange) or P (protect) options. The standard save procedure stores the
program in a tokenized format in which all reserved BASIC words are
represented by tokens, 1 or 2-byte codes. For instance, the RANDOMIZE
statement is represented by a single ASCII value of 185. This tokenized
format saves space because multiple-character reserved words are represented
by only one or two characters.
All tokenized characters have a value of 128 or greater, outside the range of
ASCII values legal in variable names. Only capital letters, numerals, and the
period are legal in variable names, and these have values between 46 and 90.
(Variables can be entered in lowercase, but BASIC converts them to capitals.)
The restrictions on legal variable names simplify the work of the cross
reference program because it can usually just skip tokens in its search for
valid variable names. Two exceptions are the tokens for a remark (ASCII 143)
or data statement (ASCII 132). In both these cases the program skips to the
end of the line so as not to confuse words in remarks, or literals in data
statements, with valid variable names.
All numbers used in a program - constants, initial values, line-number
references, and so on - are also encoded. For instance, an ASCII 28 code
indicates that an integer value follows in the next 2 bytes in the file. An
ASCII 29 indicates a single - precision number in the next 4 bytes. Other
prefixes indicate various types of double - precision numbers, octal numbers,
or hexadecimal numbers.
The program skips over all coded numbers except those prefixed by an ASCII 14.
This code signifies a 2-byte number that is a program line number reference,
following a GOTO or GOSUB, for instance. The cross-reference listing program
treats line number references as labels and lists all lines referenced by
other lines. This can help you find all the places in a program that call a
certain subroutine.
H O W I T W O R K S
The format of the lines in a tokenized program file is shown in figure 1. The
first 2 bytes are the BASIC offset address to the next program line. Our only
interest in it is when it is 0 because a 0 offset signifies the end of the
program. The next 2 bytes contain the line number, with the least significant
byte first. These are followed by a series of bytes, including tokens, coded
numbers, and variable names, up to the end of the line, indicated by an ASCII
value of 0.
The approach of the cross reference utility, then, is very simple. It makes a
note of the line number being scanned at the moment, then skips over tokens
and encoded numbers, looking for variable names and references to other
program lines. When it finds the beginning of a variable name, it builds the
name, character by character, until it comes to an ASCII code that can't be
part of a variable name. If the variable has been explicitly typed (marked by
a $, #, !, %), that character is added to the end of the name. If the
variable is subscripted, then "(SUB)" is added. Once complete, the variable
name is stored in an array; the line number where it appears is stored in a
parallel array of line numbers.
Once the entire program file has been scanned, the label and line number
arrays are sorted using a Shell sort. Then they are written to a disk file.
The only real problem is that all the scanning and sorting takes time. The
program took nearly 7 minutes to process and sort labels for its own 145 lines
and 245 label references. For a smaller program (123 references and 133
labels), it required 3 minutes 45 seconds. You can get a modest increase in
speed of about 5 to 10 percent by eliminating comments and consolidating
statements in to one line where possible. This will have the greatest effect
in the WHILE loop beginning at line 600 and the sort routine beginning at line
800.
B E W A R Y
In order not to slow the program down further, I kept it as simple as
possible. Because of this, a few bogus variables may creep into your listing.
These are words used as part of BASIC statements that are not tokenized. They
include the following: ALL in a CHAIN statement, BASE in an OPTION BASE
statement, B or BF in a LINE statement, R in a LOAD statement, AS in APPEND,
or OUTPUT in an OPEN statement. None of these is a reserved word, and they
are therefore not tokenized. Thus, if you use them in a program, the cross
reference utility will treat them as variable names. Note that both AS and
OUTPUT appear in listing 2.
The cross reference listing is written to a sequential disk file, which may be
read later. The file name for the listing is the file name of the program
file with an extension of CRF. If the original program file were MYPROG.BAS,
the listing would appear on file MYPROG.CRF. To display the listing on your
monitor, you first need access to the DOS (disk operating system) - execute
SYSTEM from BASIC. When in DOS, execute TYPE MYPROG.CRF. If you want a hard
copy, press the Ctrl and PrtSc keys simultaneously prior to execution the TYPE
command; the listing on the monitor will then be output to the printer.
M O D I F I C A T I O N S
The output is formatted for an 80 - column screen or printer as the program
appears in listing 1. To format for a 40 - column screen, change N>8 in line
3070 to N>3. To format for a 132 - column printer width, change it to N>16.
You may also want to redimension the arrays in statement 110. They are large
enough for modest programs, but larger programs with more references will need
more space.
This disk copy was originally provided by "The Public Library",
the software library of the Houston Area League of PC Users.
Programs are available from the Public Library at $2 per disk
on user-provided disks. To get a listing of the disks in the
Public Library, send a self-addressed, stamped envelope to
Nelson Ford, P.O.Box 61565, Houston, TX 77208.
COMPRESS.BAS
100 CLS
110 A$=STRING$(80,205)
120 PRINT A$
130 PRINT TAB(30)"COMPRESS 7003-A.BAS"
140 COLOR 23,0,0
150 PRINT :PRINT :PRINT TAB(39)"IPCO"
160 COLOR 7,0,0
170 PRINT :PRINT :PRINT TAB(25)"PERSONAL COMPUTER OWNERS GROUP"
180 PRINT :PRINT :PRINT TAB(19)"p.o. box 10426, pittsburgh, pennsylvania 15234"
190 PRINT A$
200 PRINT :PRINT :PRINT :PRINT :PRINT
210 PRINT TAB(28)"PRESS ANY KEY TO CONTINUE"
220 A$=INKEY$:IF A$="" THEN 220
230 CLS
240 '*****************************************************************
250 '*********** ***********
260 '*********** COMPRESS [Any BASIC Program] ***********
270 '*********** ***********
280 '*****************************************************************
290 ' * COPYRIGHT 1982 - CRAIG W. UTHE *
300 ' * WRITTEN 3/13/82 BY CRAIG W. UTHE *
310 ' * * * * * *
320 ' * ANY INDIVIDUAL MAY COPY THIS PROGRAM *
330 ' * AND MAKE MODIFICATIONS TO IT IF THAT *
340 ' * INDIVIDUAL ARRANGES TO CONTRIBUTE ONE *
350 ' * OTHER PROGRAM TO THE IPCO SOFTWARE *
360 ' * EXCHANGE LIBRARY. HOWEVER, COPIES *
370 ' * ARE NOT ALLOWED TO BE SOLD, NOT IN *
380 ' * WHOLE NOR IN PART, NOT SEPARATELY *
390 ' * NOR JOINTLY WITH OTHER SOFTWARE. *
400 ' *********************************************
410 '
420 '
430 'This is a preprocessor for BASIC which deletes all
440 ' '-comments and extra spaces (except when in quotes).
450 'All '-comment-only lines are deleted. Line numbers will
460 'be displayed as lines are compressed, except for deleted lines.
470 '
480 '**An early test-run on a very-structured program reduced the
490 '**program from 20,600 B to 9,600 B. (ASCII format storage
500 '**was about 1 K greater for each.) Apparently, COMPRESS
510 '**cut the size of the program to LESS than HALF!!!!
520 '**BUT, it takes a LONG time: 2 to 3 seconds/line
530 '
540 '
550 'BE SURE that the BASIC uncompressed file is stored as an
560 'ASCII file -- this program does not check for this!!!
570 '
580 'Mainflow-control routine
590 PRINT : PRINT "ENTER NAME OF FILE TO BE COMPRESSED."
600 PRINT "MUST have extention .BAS (Do not give extention)."
610 PRINT "Result will be stored in <filename>.CMP ."
620 PRINT "(MUST have been stored as ASCII file):";
630 INPUT FILENAME$
640 PRINT : PRINT "ENTER LINE NUMBER OF FIRST LINE TO BE COMPRESSED."
650 PRINT "COMPRESS starts compression after this number is"
660 PRINT "reached or passed. You may respond with 0:";
670 INPUT START.LINE.NUMBER% : PRINT
680 OPEN FILENAME$+".BAS" FOR INPUT AS #1
690 OPEN FILENAME$+".CMP" FOR OUTPUT AS #2
700 WHILE NOT EOF(1)
710 OUTLINE$ = STRING$(255,0) : J% = 1
720 LINE INPUT#1, INLINE$
730 IF VAL(MID$(INLINE$,1, INSTR(INLINE$," "))) < START.LINE.NUMBER% THEN PRINT#2, INLINE$ : PRINT LEFT$(INLINE$, INSTR(INLINE$, " ")) : GOTO 790
740 I% = 1
750 WHILE I% <= LEN(INLINE$)
760 IF MID$(INLINE$,I%,1) = CHR$(34) THEN GOSUB 820 ELSE GOSUB 900 '1000 = in-quotes rtn; 2000 = out-of-quotes rtn
770 WEND
780 IF NOT MID$(OUTLINE$, (1 + INSTR(OUTLINE$," ")), 1) = "'" THEN PRINT#2, LEFT$(OUTLINE$,J%-1) : PRINT LEFT$(OUTLINE$, INSTR(OUTLINE$, " "))
790 WEND
800 BEEP : PRINT "COMPRESSED PROGRAM STORED AS "FILENAME$+".CMP" : END
810 '
820 'In-quotes-preprocessing routine
830 CHARS.TIL.NEXT.QUOTE% = INSTR(MID$(INLINE$,I%+1), CHR$(34))
840 IF CHARS.TIL.NEXT.QUOTE% = 0 THEN CHARS.TIL.NEXT.QUOTE% = LEN(INLINE$) - I%
850 MID$(OUTLINE$,J%, CHARS.TIL.NEXT.QUOTE% + 1) = MID$(INLINE$,I%, CHARS.TIL.NEXT.QUOTE% + 1)
860 I% = I% + CHARS.TIL.NEXT.QUOTE% + 1
870 J% = J% + CHARS.TIL.NEXT.QUOTE% + 1
880 RETURN
890 '
900 'Out-of-quotes-preprocessing routine
910 IF MID$(INLINE$, I%, 1) = "'" THEN MID$(OUTLINE$,J%,1) = "'" : J% = J% + ABS(J% = (1+INSTR(OUTLINE$," "))) : I% = I% + LEN(INLINE$) + 1 : GOTO 950 'RETURN
920 IF MID$(INLINE$, I%, 1) = " " AND MID$(INLINE$, I% + 1, 1) = " " THEN I% = I% + 1 : GOTO 950 'RETURN
930 'ELSE
940 MID$(OUTLINE$, J%, 1) = MID$(INLINE$, I%, 1) : J% = J% + 1 : I% = I% + 1
950 RETURN
COMPRESS.DOC
Compresses a BASIC program by taking out extra spaces and remarks.
1. Save the BASIC program in ASCII.
2. RUN "COMPRESS"
(Works slowly.)
COREFIX.BAS
7999 GOSUB 8000: END
8000 DEF SEG: BCOLS%=PEEK(&H29): D$=" ": F$="|"
8010 IF BCOLS%=80 THEN DCOL1%=1:DLEN%=67:P$=" " ELSE DCOL1%=8:DLEN%=39:P$=""
8020 HD$=" dec hex "+P$+" 0 1 2 3 4 5 6 7 8 9 A B C D E F 0123456789ABCDEF"
8030 I%=0: INPUT "What segment address (&Hnnnn or -1 for Basic)";B
8040 IF B=-1 THEN DEF SEG: ELSE DEF SEG=B
8045 CLS: PRINT SPC((DLEN%-12)/2);
8050 IF B=-1 THEN PRINT "Basic Segment"; ELSE PRINT "Segment ";RIGHT$("0000"+HEX$(B),4);
8060 PRINT:PRINT:PRINT MID$(HD$,DCOL1%,DLEN%);: IF DLEN%<BCOLS% THEN PRINT
8065 PRINT STRING$(DLEN%,"-");: IF DLEN%<BCOLS% THEN PRINT
8070 FOR I%=I% TO I%+15:II%=16*I%
8080 RSET D$=STR$(II%):H$=D$:RSET D$=HEX$(II%):H$=H$+D$+P$:A$=" "+F$
8090 FOR J%=0 TO 15
8100 IF J% AND 3 THEN ELSE H$=H$+" "
8110 C%=PEEK(II%+J%): IF C%<16 THEN H$=H$+"0"
8120 H$=H$+HEX$(C%)
8130 IF (C%>31) AND (C%<126) THEN A$=A$+CHR$(C%):ELSE A$=A$+"."
8140 NEXT J%
8150 PRINT MID$(H$+A$+F$,DCOL1%,DLEN%);: IF DLEN%<BCOLS% THEN PRINT
8160 NEXT I%
8170 PRINT "Use q to quit, r to restart, = to redisplay, null for next page:"
8172 PRINT "Edit the hex display and `enter' each line to modify storage."
8175 LOCATE 12,30,1
8180 B$=INKEY$:IF B$="" THEN 8180
8182 IF ASC(B$)>0 THEN GOTO 8190 'Not a cursor key, so no patching to do.
8184 CO%=CSRLIN: LINE INPUT B$: C%=CSRLIN
8185 'Due to LINE INPUT features we must play games to get the whole line the user modified if he modifies the line the cursor starts on.
8186 IF CO%=C%-1 THEN DEF SEG=&H40: POKE &H1E,0:POKE &H1F,72:POKE &H20,13:POKE &H21,0:POKE &H1A,&H1E:POKE &H1C,&H22: DEF SEG=B: GOTO 8184
8187 LOCATE C%-1,30,1 'To put the cursor in a more convenient place.
8188 IF C%>21 OR C%<4 THEN B$=LEFT$(B$,1): GOTO 8195 ELSE GOSUB 8300: GOTO 8180
8190 DEF SEG=&H40: POKE &H1A,PEEK(&H1C)
8195 IF B$="q" OR B$="/" THEN LOCATE 23,1:DEF SEG:RETURN
8197 IF B$="=" THEN I%=I%-16: GOTO 8040
8198 IF B$=CHR$(13) THEN GOTO 8040
8200 IF B$="r" THEN LOCATE 23,1: GOTO 8030 ELSE PRINT CHR$(7);: GOTO 8180
8299 REM -----------Subroutine to do the core patching -------------
8300 IF BCOLS%=80 THEN B$=MID$(B$,8,40)
8310 AT$=LEFT$(B$,3):IF ASC(AT$)=32 THEN AT$=RIGHT$(AT$,2)
8315 IF AT$=" 0" THEN AT$="0"
8320 OFFSET%=VAL("&H"+AT$): IF BCOLS%=80 THEN B$=MID$(B$,6) ELSE B$=MID$(B$,5)
8340 FOR II%=0 TO 15: POKE OFFSET%+II%,VAL("&H"+LEFT$(B$,2)): B$=MID$(B$,3)
8345 IF LEN(B$)<2 THEN RETURN
8350 IF ASC(B$)=32 THEN B$=MID$(B$,2)
8360 NEXT II%
8370 RETURN
CR-LF.TXT
Sb: #38907-#Epson MX & FX Graphics
06-May-84 02:05:11
Fm: Phil Bornemeier 72356,3033
To: Jim Gainsley 70346,457 (X)
My problem with CR/LF was that when I was using bit graphics and sent an ascii
13, it was always followed by an ascii 10. Also under DOS 2.0 ascii 26 would
not be sent to the printer. * This program is an example of one way to bypass
the DOS 1.1 and DOS 2.0 limitations in printing ASCII 26 and the ASCII 13,10
pair. * 10 FOR VALUE = 0 TO 255 20 OUT &H3BC,VALUE 30 A=INP(&H3BD):B=A AND
128:IF B THEN 40 ELSE 30 40 OUT &H3BE,237:OUT &H3BE,236 50 NEXT 60 END * Thanks
for your help.
DITHRING.TXT
"dithering": This is where instead of a solid color, you have an
every-other-dot mix of two (or more) colors.
For example, with the "light blue" background, and red yellow green palette,
you can get colors such as turquoise (half blue, half green), purple
(red/blue), orange (red/yellow), etc. Try this:
screen 1:color 17,0:paint(100,100),chr$(&hbb)+chr$(&hee)
You'll see the gol' dernest ORANGE you've ever seen. How did I do it? Well,
each color is 2 bits. 00 = blue, 01 = green, 10 = red, 11 = yellow. So,
orange is RY in one row, YR in the next, or binary 1011 1011 in one, 1110 1110
the other. In hex, these are bb ee. Voila.
If you want to have proportionally darker colors when dithering, i.e. a
"little yellow on a lot of blue", just turn on one dot in 16. Two dots in 16 is
a bit more, etc. As to the "order" to turn on the dots, consider a 4 x 4 box,
and turn on subsequent dots in the following order:
+----+----+----+----+
| 1 | 13 | 3 | 15 |
+----+----+----+----+
| 9 | 5 | 11 | 7 |
+----+----+----+----+
| 4 | 16 | 2 | 14 |
+----+----+----+----+
| 12 | 8 | 10 | 6 |
+----+----+----+----+
Note how if you turn on dots 1-2, it will be a uniform pattern across a large
area. Similarly 1-2-3-4 makes a slightly more dense pattern (25% foreground,
75% background).
I have used this technique to get grey scale on a printer - and it works VERY
well. Bands going from 0 on to all 16 on, quite nicely moved from white to
black.
FC.BAS
10 INPUT "Enter original file name-",IF1$:OPEN IF1$ FOR INPUT AS 1
20 INPUT "Enter modified file name-",IF2$:OPEN IF2$ FOR INPUT AS 2
30 INPUT "Enter change file name-",OF$: OPEN OF$ FOR OUTPUT AS 3
40 GOSUB 500:GOSUB 700
50 IF N1=N2 THEN IF L1$=L2$ THEN 40 ELSE PRINT #3,L2$:GOTO 40
60 IF N1>N2 THEN PRINT #3,L2$: GOSUB 700: GOTO 50
70 PRINT #3,N1
80 GOSUB 500: GOTO 50
500 IF EOF(1) THEN 600
510 LINE INPUT #1,L1$: N1=VAL(L1$): RETURN
600 IF NOT EOF(2) THEN PRINT #3,L2$
610 WHILE NOT EOF(2)
620 LINE INPUT #2,L2$:PRINT #3,L2$
630 WEND
640 GOTO 900
700 IF EOF(2) THEN 800
710 LINE INPUT #2,L2$: N2=VAL(L2$): RETURN
800 PRINT #3,N1
810 WHILE NOT EOF(1)
820 LINE INPUT #1,L1$: N2=VAL(L1$):PRINT #3,N1
830 WEND
900 CLOSE:PRINT "End of scan"
910 END
FILES371.TXT
------------------------------------------------------------------------
Disk No 371 BASIC Programming Aids V1.1
------------------------------------------------------------------------
Utilities to assist the programmer in writing and debugging BASIC
programs.
BASBUG BAS Information on BASIC screen bug.
BASCONV BAS Fortran to BASIC conversion.
BASCONV DOC Documentation for BASCONV.BAS.
BASICDOS BAS Information on different commands.
BASICREF BAS BASIC cross reference utility.
BASICREF DOC Documentation for BASICREF.BAS.
COMPILER ERR Info about "string space corrupt" error in a compiled program:
COMPRESS BAS Compresses a BASIC program by taking out extra spaces and
remarks.
COMPRESS DOC Documentation for COMPRESS.BAS.
COREFIX BAS Display/change memory.
CR-LF TXT Info on Epson printers in graphics mode.
DITHRING TXT Where instead of a solid color, you have an every-other-dot
mix of two (or more) colors.
FC BAS File compare utility.
GS-RENUM EXE GS - BASIC utilities.
GS-UNNUM EXE GS - BASIC utilities.
GS-UNUM6 DOC Documentation for GS-?????? files
GS-VAREN EXE GS - BASIC utilities.
READ ME Indicates changes made in GS files
HIRESCOL BAS 640 X 200 B/W graphics demo program.
KB_FLAG BAS Demo program shows BASIC access to DOS Keyboard flag.
KEYIN ASM Source code for KEYIN.EXE.
KEYIN EXE Places up to parameter characters into the keyboard buffer
for the program to read.
LBAS DOC Documentation for LBAS.EXE.
LBAS EXE Label BASIC translator program.
LBL-BAS BAS BASIC source file label checker.
LBL-SAMP BAS Sample file for LBL-BAS.BAS.
LINEBUG BAS Utility to check BASIC source files for errors.
LINEBUG DOC Documentation for LINEBUG.BAS.
MONITOR BAS Series of routines that provide a user interface for
application development.
MONITOR DQC Documentation for MONITOR.BAS.
PAL80 BAS 80 column palette prompter.
POKEPEEK TXT Commonly used BASIC peeks, pokes and subroutines.
PROFILE BAS Utility that logs how much time is spent executing each
part of a program.
PROFILE DOC Documentation for PROFILE.BAS.
PROFILE MEM Part of PROFILE.BAS.
READBAS BAS Read BASIC files save in BINARY.
SAVEBAS COM Creates a file from a BASIC program that was "lost"
through use of the SYSTEM command.
SAVEBAS DOC Documentation for SAVEBAS.COM
SCRN-MAP BAS Print a form for graphic screen layout.
SQUISHER BAS Compresses BASIC programs.
SQUISHER DOC Documentation for SQUISHER.BAS.
STARTBAS BAS A BASIC file menu program.
TRACE BAS Helps debug BASIC programs.
TRACE DOC Documentation for TRACE.BAS.
UN-COMPQ DOC Documentation for UN-COMPQ.EXE.
UN-COMPQ EXE Unprotects a BASIC program on the COMPAQ computer.
UN-NEW DOC How to recover a BASIC program after typing 'NEW'.
UNP-IBM DOC Documentation for UNP-IBM.EXE.
UNP-IBM EXE Unprotects a BASIC program on the IBM computer.
PC-SIG
1030D E Duane Ave
Sunnyvale, CA 94086
(408) 730-9291
(c) copyright 1987 PC-SIG
GS-UNUM6.DOC
Documentation for:
GS-UNNUM.EXE version 6.00 (formerly version 5.00)
GS-RENUM.EXE version 4.00 (formerly version 3.10)
GS-VAREN.EXE version 3.00 (formerly version 2.10)
All programs written by Charles B. Gilmore
All programs - (C)Copyright GILMORE SYSTEMS, 1984, 1985, 1986
____
| |
| GS |
|____|
GILMORE SYSTEMS
P.O. Box 3831
Beverly Hills, CA 90212-0831 U.S.A.
Ph 213/276-5997
You are hereby granted a license to use, share, copy, and distribute
these three programs and this documentation, provided that this notice,
and the Copyright information is not removed or altered in any way from
this notice or accompanying programs. No fee or consideration is to be
charged for the distribution. These three programs are provided on an
AS-IS basis without warranty of any kind expressed or implied.
The entire risk as to quality and performance of these programs rests
solely with the user. In no event will Gilmore Systems be liable to you
for any damages, consequential or inconsequential. By operating any of
the above programs, you acknowledge you have read and understand this
agreement and agree to be bound by its terms and conditions.
GS - BASIC Optimizing Utilities Page 1
Background Information
Being a software developer, I wrote my first commercial program for
the IBM personal computer in compiled BASIC. Little did I know that
it would be a nightmare. Being used to mainframe systems with
hardly any memory limitations, I started coding away. Everything
went fine until the program was in its final stages and just a few
more modifications and enhancements were added. All of a sudden, the
nightmare begins with the BASIC compiler - Out of workspace, "Too
Complex", and other error messages from the compiler not only made
it impossible to add anymore code, but nearly impossible to fix what
was already written! More time was spent getting the program to compile
than it was writing it (About 1000 lines of packed code)! As a spinoff
for writing the programs, I had to write new utility programs to
Un-number the program from any non-referenced lines to get it to
compile with the "/N" option. To make a long story short, I found many
tricks to cut down on compiler problems, and to cut down on the
resultant '.EXE' size:
- EVERY byte of source code uses compiler workspace,
including comments! Although comments aren't used
by the compiler except for metacommands, they indeed
take up workspace. The more bytes of source code, the
more workspace used up - this includes variable names.
- Branching to a comment is a branch to an unecessary
line number - more space used not only in bytes, but
in the compiler's table for line numbers.
- The code generated from a "RETURN" from a gosub takes
more bytes in the resultant '.EXE' than a "GOTO", hence -
larger executable file size, and longer load time. This
was in bad need of optimization.
The solution was to switch to a different language from that point on.
Unfortunately, I had invested too much time and effort into that
particular program to do that, so I wrote 3 utility programs that
would produce an intermediate BASIC source file prior to compiling,
and also re-number this intermediate file so that it may be run in
the interpreter along with savings in interpreter workspace.
The use of the device driver ANSI.SYS is no longer required. All of
the version numbers of these programs have been incremented by 1 to
reflect this change. This is in preparation for running under the
Topview environment since Topview does not support ANSI.SYS. If you will
be running under the Topview environment, please contact us for
information regarding this usage. Since Topview is not publicly released
at the time of this writing, we cannot publish information regarding it.
The following pages contain brief documentation on using each of the
three programs. You may obtain a brief program synopsis for any of
these programs by typing the program name on the DOS command line
followed by a question mark. For instance, if you wanted information
on GS-UNNUM you would simply type "GS-UNNUM ?" (without the quotation
marks). Note that 192K RAM should be available when using DOS 3.00.
(C)Copyright GILMORE Systems, 1984, 1985, 1986
GS - BASIC Optimizing Utilities Page 2
Background Information
GS-UNNUM version 5.00
This program will not only un-number your BASIC source program, but will
optionally scan for lowercase BASIC verbs, Un-comment your BASIC source
program, remove branches to commented lines wherever possible by moving
the line number to the next line if it has been un-numbered, and re-work
all of your RETURN statements in a more efficient manner. I was inspired
to write this program because similar un-numbering programs only
un-numbered the source code, and not only missed things, but were
extremely slow! GS-UNNUM is very fast, however, the more options you
choose, the longer it will take to run. It still runs faster than most
programs that only un-number even with all options chosen.
One note about continuation of lines (Compiler only) - The BASIC
compiler will accept continuation of a line by placing an underscore
character as the last character of the line to be continued. GS-UNNUM
will support this feature only if the first character of the continued
line starts with a blank as the first character.
Changes since version 3.00
The '/R' option has been changed. A parameter must now accompany the use
of this option. '/R' optimizes the RETURN statements in your output file
so that only one RETURN will be present in the file. Version 3.00 added
this return statement as line 2 which has caused problems when using
metacommands such as COMMON. Version 4 corrects this by having you tell
it which line number has the RETURN statement to be used. If you want
GS-UNNUM to pick which RETURN statement is to be used, tell it to use
line 0. Regardless of which method you use for '/R', it will no longer
interfere with the use of metacommands such as COMMON. RETURN statements
in the form of "RETURN nnnnn" will be left alone, and the program will
terminate with an error message if you specify the line number of
a RETURN statement of the above form.
Clarifications
'/T' was not explained. What '/T' does is remove the actual " REM "
and " ' " that '/C' couldn't. '/C' removes the actual written
comment. '/T' also removes all unnecessary spaces, and puts a
physical end of line mark after the last nonspace character in the
line ('/C' does not). '/T' further eliminates branches to a numbered
comment when possible - this is done by checking to see if the next
line has a line number, if it doesn't, the comment is eliminated and
the line number is moved to the next line.
REMINDER
Remember to use the '/L' option if your input file has any lowercase
BASIC verbs, or important branching information will be missed and
you will end up with undefined line numbers in the output file when
you try to compile.
(C)Copyright GILMORE Systems, 1984, 1985, 1986
GS - BASIC Optimizing Utilities Page 3
Background Information
GS-VAREN version 2.10
This program will rename the variables in your BASIC source file to
shorter names, and optionally produce a report of your variable names
and what they have been renamed to. This program is the slowest running
of all three programs, but is very efficient in its search. To save
time, the use of this program is suggested on the intermediate file
produced by GS-UNNUM.
Changes since version 1.00
This program now looks for a file called GS-VAREN.TBL on the default
drive. If it finds it, it will use this file for the BASIC reserved
word list instead of the built-in default table. If it does not find
this file, it will create it with all the reserved words in the
built-in default table. You may eliminate words that you are not using
or modify the file in any other way. The fewer words in this table, the
faster the program will run. Words in this file must meet certain
requirements: 1) first character must be alphabetic, 2) total length
of word must not exceed 10 characters, 3) no imbedded spaces are
allowed, and 4) only one entry per line is allowed. Violation of any of
these rules will result in program termination with an error message.
Upper/Lowercase is unimportant. Note that reserved words requiring an
imbedded space are considered to be 2 separate words. For example, LINE
INPUT consists of 2 words, LINE and INPUT, which require 2 separate
entries. ON KEY would be another example.
If you start this program with an input filename only (no output
filename and no report filename), GS-VAREN will scan through your
input file with its built-in default table, and produce the file
GS-VAREN.TBL containing a list of all the BASIC reserved words it
found in your input file.
(C)Copyright GILMORE Systems, 1984, 1985, 1986
GS - BASIC Optimizing Utilities Page 4
Background Information
GS-RENUM version 3.10
This program will re-number the intermediate file produced by GS-UNNUM
so that it may be loaded into the BASIC interpreter. This is the fastest
running of all the programs. It does 1000 lines of code in about 60
seconds on an IBM with a hard disk.
CLOSING REMARKS FROM THE AUTHOR
Ironically, these three programs were written in the "C" programming
language. BASIC is an excellent language for small to intermediate size
programs, but when it comes to writing something major, nothing in my
opinion beats the "C" language short of assembler. After encountering
the aforementioned nightmare, I have permanently switched to "C". This
way I can devote my time to writing software products, instead of
devising ways to get around compiler and language limitations. All
future software products from GILMORE SYSTEMS will be written in "C",
assembler, or a combination of both.
Much time has been spent developing the above three programs, and
GS-UNNUM alone does much more than commercially available un-numbering
software. If you find this program of use, please send a small monetary
donation to GILMORE SYSTEMS for time and effort involved. A donation of
$20 or more will get you a customer number that entitles you to updates
and telephone assistance from GILMORE SYSTEMS.
GILMORE SYSTEMS develops commercial software (not public domain), and
is offering these 3 programs to the public domain as a test for market
response. Should this test be successful, many sophisticated software
products will be made available to the public domain by GILMORE
SYSTEMS. The more people that donate, the more successful the test will
be!
GILMORE SYSTEMS specializes in custom software development and
consulting. Corporations in need of these services should feel free to
contact us for your developmental needs.
(C)Copyright GILMORE Systems, 1984, 1985, 1986
GS-UNNUM Page 5
Background Information
GS-UNNUM version 6.00 - BASIC Un-numbering utility
(C)Copyright GILMORE SYSTEMS, 1984, 1985, 1986
P.O. Box 3831; Beverly Hills, CA 90212-0831
Ph 213/276-5997
Usage: GS-UNNUM [d:][path]infile [d:][path]outfile [/c][/i][/l][/t][/r:nnnnn]
where [d:][path]infile is the input file,
[d:][path]outfile is the output file,
[/c] will remove COMMENTS in the output file,
[/i] will INDENT lines having removed numbers in the output file,
[/l] will scan for LOWERCASE BASIC verbs (otherwise lowercase ignored),
[/t] will TRIM excess space and optimize what /C couldn't,
[/r:nnnnn] optimizes RETURNs to just one RETURN. 'nnnnn' is the line no
of the stmt containing the RETURN. If nnnnn=0, GS-UNNUM chooses line.
NOTES: 1) DOS version 2.00 or higher and 128K RAM (Note: ANSI.SYS not required)
2) Input file MUST be an ASCII file!
3) Separate infile, outfile, and option fields with one or more spaces.
4) /T can only be used when /C specified but not with /I.
5) Error return codes are 0=No Errors, 1=Errors - Ideal for batch files.
6) Disk free space should be 1x input file size, and 2x when /T is used.
(C)Copyright GILMORE Systems, 1984, 1985, 1986
GS-VAREN Page 6
Background Information
GS-VAREN version 3.00 - BASIC Variable Renaming utility
(C)Copyright GILMORE SYSTEMS, 1984, 1985, 1986
P.O. Box 3831; Beverly Hills, CA 90212-0831
Ph 213/276-5997
Usage is: GS-VAREN [d:][path]infile [d:][path]outfile [d:][path]report
Where [d:][path]infile is the input file,
[d:][path]outfile is the output file,
[d:][path]report is the report file (optional).
If program is started with input filename only, the file GS-VAREN.TBL will be
created with a list of BASIC reserved words used in your input file.
For normal usage, if GS-VAREN.TBL exists, the entries in this file will be used
for the BASIC reserved word list instead of the built in default list - if it
doesn't exist, it will be created from the built in default list.
NOTES: 1) DOS version 2.00 or higher and 128K RAM (Note: ANSI.SYS not required)
2) Input file MUST be an ASCII file! Line numbers in file are optional.
3) If disk space is low and you want a report, use 'LPT1' for report.
4) Error return codes are 0=No Errors, 1=Errors - Ideal for batch files.
5) Disk free space should be 1x input file size (with no report).
(C)Copyright GILMORE Systems, 1984, 1985, 1986
GS-RENUM Page 7
Background Information
GS-RENUM version 4.00 - BASIC Re-numbering utility pgm.
(C)Copyright GILMORE SYSTEMS, 1984, 1985, 1986
P.O. Box 3831
Beverly Hills, CA 90212-0831
Ph 213/276-5997
Usage is: GS-RENUM [d:][path]infile [d:][path]outfile
Where [d:][path]infile is the input file,
[d:][path]outfile is the output file,
This program will re-number a BASIC program that was Un-Numbered by GS-UNNUM.
NOTES: 1) DOS version 2.00 or higher and 128K RAM (Note: ANSI.SYS not required)
2) Input file MUST be an ASCII file!
3) Error return codes are 0=No Errors, 1=Errors - Ideal for batch files.
4) Disk free space should be at approximately 1x input file size + 10%
(C)Copyright GILMORE Systems, 1984, 1985, 1986
HIRESCOL.BAS
1000 SCREEN 2 : KEY OFF : CLS
1010 PRINT " 640 x 200 Black & White Graphics Mode Demonstration"
1020 PRINT
1030 PRINT
1040 PRINT " ************* I N F U L L C O L O R *************"
1050 PRINT
1060 PRINT " Technique discovered by: JAMES L JOHNSEN"
1070 PRINT
1080 PRINT " and implemented through a program originally written for the 320 x 200"
1090 PRINT "graphics mode by: MICRO-G, P.O. BOX 102, DULUTH, GEORGIA 30136, (404) 476-5779"
1100 PRINT
1110 PRINT " Just look at the letters (left edge and top) to see that we're in 640 x 200."
1130 PRINT
1140 PRINT
1150 LOCATE 13,24 :PRINT " USE CURSOR KEYS TO CHANGE COLORS"
1160 LOCATE 15,23 :PRINT " PRESS THE <ESC> KEY FOR COLOR DEMO"
1180 CLS : OUT (984),14
1190 KEY(11) ON :KEY(12) ON
1200 KEY(13) ON :KEY(14) ON
1210 ON KEY(11) GOSUB 1350
1220 ON KEY(12) GOSUB 1380
1230 ON KEY(13) GOSUB 1390
1240 ON KEY(14) GOSUB 1420
1250 CLS
1260 BACK=7
1270 OUT (985),16
1280 GOSUB 1450
1290 GOSUB 1520
1300 LOCATE 25,1:PRINT SPC(79);
1310 LOCATE 25,15:PRINT "BACKGROUND ";BACK;
1320 LOCATE 25,60:PRINT "PALATE ";PALATE / 16 - 1;
1330 QUIT$ = INKEY$ : IF QUIT$ = CHR$(27) THEN CLS: GOTO 2000
1340 GOTO 1310
1350 BACK=BACK+1: IF BACK=>32 THEN BACK=0
1360 OUT (985),BACK+PALATE
1370 RETURN
1380 GOTO 1390
1390 PALATE =PALATE+16 :IF PALATE > 32 THEN PALATE=16
1400 OUT (985),BACK+PALATE
1410 RETURN
1420 BACK=BACK-1: IF BACK<0 THEN BACK=31
1430 OUT (985),BACK+PALATE
1440 RETURN
1450 REM PRINT THE NUMBERS
1460 LOCATE 3,1 :PRINT " 0 1 2 3 0 1 2 3"
1470 LOCATE 8,1 :PRINT "0"
1480 LOCATE 13,1 :PRINT "1"
1490 LOCATE 18,1 :PRINT "2"
1500 LOCATE 23,1 :PRINT "3"
1510 RETURN
1520 V=40
1530 H=60 :AA=0 :BB=0 :GOSUB 1740
1540 H=120 :AA=0 :BB=1 :GOSUB 1740
1550 H=180 :AA=0 :BB=2 :GOSUB 1740
1560 H=240:AA=0 :BB=3 :GOSUB 1740
1570 V=80
1580 H=60 :AA=1 :BB=0 :GOSUB 1740
1590 H=120 :AA=1 :BB=1 :GOSUB 1740
1600 H=180:AA=1 :BB=2 :GOSUB 1740
1610 H=240:AA=1 :BB=3 :GOSUB 1740
1620 V=120
1630 H=60 :AA=2 :BB=0 :GOSUB 1740
1640 H=120:AA=2 :BB=1 :GOSUB 1740
1650 H=180:AA=2 :BB=2 :GOSUB 1740
1660 H=240:AA=2 :BB=3 :GOSUB 1740
1670 V=160
1680 H=60 :AA=3 :BB=0 :GOSUB 1740
1690 H=120:AA=3 :BB=1 :GOSUB 1740
1700 H=180:AA=3 :BB=2 :GOSUB 1740
1710 H=240:AA=3 :BB=3 :GOSUB 1740
1720 LOCATE 25,1 :PRINT SPC(79);
1730 RETURN
1740 REM DRAW BOXES TWICE CHANGE ORDER OF COLLOR
1750 FOR B=0 TO 60 STEP 2
1760 LINE((H+B),(V+40))-((H+B),(V)),AA
1770 LINE((H+B+1),(V+40))-((H+B+1),(V)),BB
1780 NEXT B
1790 H=H+320
1800 FOR B=0 TO 60 STEP 2
1810 LINE((H+B),(V+40))-((H+B),(V)),BB
1820 LINE((H+B+1),(V+40))-((H+B+1),(V)),AA
1830 NEXT B
1840 H=H-320
1850 RETURN
2000 OUT (984),30 : OUT (985),15
2010 PRINT " 640 x 200 Black & White Graphics Mode Demonstration"
2020 PRINT
2030 PRINT
2040 PRINT " ************* I N F U L L C O L O R *************"
2050 PRINT
2060 PRINT " Technique discovered by: JAMES L JOHNSEN"
2070 PRINT
2080 PRINT " T H E D A Z Z Z L E R Written by James L. Johnsen"
2090 PRINT
2100 PRINT " 402 Beech Street, Fort Washington, Maryland. 20744 (h) (301) 292-7169"
2110 FOR PAUSE = 1 TO 15000 : NEXT PAUSE
2120 PRINT
2130 PRINT
2140 LOCATE 14,26 :PRINT " PRESS THE <ESC> KEY TO QUIT"
2150 FOR I=0 TO 7000:NEXT I
2160 OUT (984),14:CLS:DIM T1%(70),T2%(70),Q1%(70),Q2%(70)
2170 V%=5:X2%=639:H=.5:Y2%=13:X1%=37:Y1%=199:C1=1:WHEREAT%=1:S%=350
2180 DEF SEG = &H40:X% = PEEK(&H6C) : DEF SEG
2190 RANDOMIZE X%
2200 L1% = T1%(WHEREAT%) : J1% = Q1%(WHEREAT%) : L2% = T2%(WHEREAT%) : J2% = Q2%(WHEREAT%)
2210 LINE (L1%,J1%)-(L2%,J2%),0
2220 IF C1 > 0 THEN 2290
2230 C1 = RND (X%) * S% : OUT (985),COLORVAL
2240 X3% = - V% : X4% = - V% : Y3% = - V% : Y4% = - V%
2250 IF RND(Y) > H THEN X3% = V%
2260 IF RND(X%) > H THEN X4% = V%
2270 IF RND(X%) > H THEN Y3% = V%
2280 IF RND(X%) > H THEN Y4% = V%
2290 X1% = X1% + X3%
2300 IF X1% < 1 OR X1% > 639 THEN X3% = - X3% : GOTO 2290
2310 T1% (WHEREAT%) = X1%
2320 X2% = X2% + X4%
2330 IF X2% < 1 OR X2% > 639 THEN X4% = - X4% : GOTO 2320
2340 T2%(WHEREAT%) = X2%
2350 Y1% = Y1% + Y3%
2360 IF Y1% < 1 OR Y1% > 199 THEN Y3% = - Y3% : GOTO 2350
2370 Q1%(WHEREAT%)=Y1%
2380 Y2% = Y2% + Y4%
2390 IF Y2% < 1 OR Y2% > 199 THEN Y4% = - Y4% : GOTO 2380
2400 Q2% (WHEREAT%) = Y2%
2410 L1% = T1%(WHEREAT%) : J1% = Q1%(WHEREAT%) : L2% = T2%(WHEREAT%) : J2% = Q2%(WHEREAT%)
2420 LINE (L1%,J1%)-(L2%,J2%),1
2430 WHEREAT% = WHEREAT% + 1
2440 IF WHEREAT% >= 70 THEN WHEREAT% = 1
2450 C1 = C1 - 1
2460 COLORVAL = COLORVAL + 1 : IF COLORVAL > = 64 THEN COLORVAL = 1
2470 QUITT$ = INKEY$ : IF QUITT$ = "" THEN GOTO 2180
2480 CLS: SCREEN 0,0,0 : WIDTH 80:COLOR 15,0,0:CLS
2490 END 'SYSTEM
KB_FLAG.BAS
0 ' program = ---- KB_FLAG -----
1 'Author: Herb Shear, 1590 Vineyard Dr., Los Altos, CA 94022
2 'This program demonstrates the KB_FLAG at location 0000:0417
3 'By setting bits in the KB_FLAG byte you can effective press several
4 'of the keyboard keys from your program. When the program expects a
5 'numeric response have the program `press' NumLock so you can use the
6 'keypad without further ado.
7 'A typical statement to do that would be:
8 'DEF SEG=0:POKE &H417, PEEK(&H417) OR &H20
100 ' Now, as they say in Algol, leave us BEGIN
110 CLS: KEY OFF 'let's get a clean slate.
120 GOSUB 590 ' disable CtrlBrk since we will be pressing those keys.
130 DEF SEG = &H40 'there are more ways than cats.
140 DEFINT A-Z 'cause it's even slower without this.
150 '-------Read DATA words into string array------------------
160 FOR I = 7 TO 0 STEP -1
170 READ A$(I)
180 NEXT
190 '---Function to extract selected bit from an integer or a byte.--
200 ' The function must be introduced to the interpreter before it
210 ' can be called. So, Mr. FUNCTION, meet Mr. BASIC INTERPRETER.
220 DEF FNBITVALUE(BYTE,BIT) = BYTE \ 2^BIT MOD 2
230 '------Set up the fixed portion of the screen display--------
240 LOCATE 6,10,0:PRINT "The KB_FLAG controls the following functions:"
250 LOCATE 12,10: PRINT "The KB_FLAG bit pattern "+CHR$(26);
260 LOCATE 15,8:PRINT "DEF SEG=0: POKE 417, PEEK(417) AND &H OR &H";
270 LOCATE 17,4:PRINT "To determine AND value: Turn ON the items you really want to be OFF";
280 LOCATE 19,5:PRINT "To determine OR value: Turn ON the items you want to be ON.";
290 LOCATE 25,1: PRINT "Press ESC to exit"; 'Always nice to know.
300 PRINT " (but be brave and press some other keys first)";
310 POKE &H17,0 'just to start from the same value each RUN.
320 ' note that different segement (40 vs 0) requires a different
330 ' offset (17 vs 417). Segs left shift 4 bits (one hex digit)
340 ' before offset is added. Thus 0000:0417 = 0040:0017 = 0041:0007
350 ' and that still leaves 63 decimal cats unskinned.
360 '-------Start of display loop------------
370 FLAG = PEEK(&H17) 'fetch the current KB_FLAG byte.
380 LOCATE 12,38
390 '-------Extract and print each bit-----------
400 FOR I = 7 TO 0 STEP -1
410 PRINT USING "# "; FNBITVALUE(FLAG,I);
420 NEXT
430 LOCATE 15,55: PRINT USING "\\";HEX$(FLAG);
440 LOCATE 15,45: PRINT USING "\\"; HEX$((NOT FLAG)AND &HFF);
450 '------Highlite the word for the set bits--------------
460 LOCATE 8,2
470 FOR I = 7 TO 0 STEP -1
480 IF FNBITVALUE(FLAG,I) THEN BRITE = &HF ELSE BRITE = 7
490 COLOR BRITE: PRINT A$(I);", ";
500 NEXT
510 COLOR 7 'comment this out and find the sneaky bug.
520 IF INKEY$<>CHR$(27) THEN 370 'Esc to exit
530 '-------End of display loop--------------
540 CLS: POKE &H17,0 'Don't leave a mess in your nest.
550 GOSUB 630 ' enable CtrlBrk
560 END 'every prog should have one, that's spelled O-N-E.
570 '------------------------------------------
580 DATA Ins, CapsLock, NumLock, ScrollLock ,Alt, Ctrl, LeftShift, RightShift
590 'save CtrlBrk pointer and point to F000:FF53 dummy return in ROM
600 DEF SEG = 0: FOR I = 0 TO 3: POINTER%(I) = PEEK(108 + I) : NEXT
610 POKE 111,&HF0:POKE 110,0:POKE 109,&HFF:POKE 108,&H53:RETURN
620 'restore former CtrlBrk pointer
630 DEF SEG = 0: FOR I = 0 TO 3: POKE 108+I, POINTER%(I): NEXT: RETURN
KEYIN.ASM
page ,132
; KEYIN.COM
; Dan Rollins 2/11/83
; Personal Computer Age, Vol 2.8, August 1983, p. 16-21.
; This Program places up to 15 parameter characters into the
; IBM PC keyboard buffer for the program to read.
;
; Note: does not enter the space before the characters and
; does not place the end of text delimiter.
; Use `~' (tilde) to enter a CR (0DH).
;
; Example:
;
; KEYIN 1~a:myfile.txt~
; BASIC menu
;
; This will run the BASIC program `menu.bas', answer the
; first prompt with `1' [enter], and answer the next prompt
; with `a:myfile.txt' [enter]
;
; define the labels for the assembler
bios_data segment at 40h
org 1ah
buf_head label word
org 1ch
buf_tail label word
org 1eh
kb_buf label word
bios_data ends
page
cseg segment
assume cs:cseg, ds:nothing, es:bios_data
keyin proc far
cli ;turn interrupts off
mov cx,bios_data ;
mov es,cx ;use ES as dest. segment
mov word ptr es:buf_head, offset kb_buf
mov di,offset kb_buf ;destination => buffer
mov si,80h
mov cl,[si]
xor ch,ch ;cx = count of chars
cmp cl,16
jbe k1
mov cl,16 ;if length > 16 then = 16
k1:
cmp cl,1 ;if length < 2
jbe k_exit ; then do nothing;
dec cx ;adjust for the space
mov bx,cx ;copy length in words
add bx,bx ; bx = length in bytes
add bx,offset kb_buf ; bx = value for buf_tail
inc si ;point past space
inc si ; to first character
mov ah,0 ;scan code = 0 (dummy)
k2:
lodsb ;set al=[si++]
cmp al,'~' ;do we have a tilde?
jne k3 ;use the char if not
mov al,0dh ;use CR instead if tilde
k3:
stosw ;[di++]=al, [di++]=0
loop k2 ;do for the entire string
mov es:[buf_tail],bx ;now indicate the length
k_exit:
sti ;interrupts back on
int 20h ;exit to DOS
keyin endp
cseg ends
LBAS.DOC
LBAS Label Basic Translator Program
====================================
Author: Jack Botner
Date Written: November, 1982
Last Updated: April, 1983
This program was written at home on my own time and I am
making it available for IBM Internal Use.
Changes incorporated in version 12/82:
- TAB character is now replaced with a blank so tabs may be
present in the input.
- "Between double quotes" flag turned off when a new line
is begun, to limit scope of impact if closing " is missing.
- Test inserted to make sure user has enough memory available.
- Warning issued when output file will be overwritten.
- Dependance on copy code control block storage definitions removed.
Changes incorporated in version 04/83:
- Fixed bug which caused program to fail "insufficient memory"
when system has 512K or more storage.
- Changed diskette I/O to block read and write, for up to 5 times
improved run times.
- Now allows "comment" lines where the first line is the "sun"
symbol (also known as squashed bug symbol) (character 15 decimal).
- Now ignores blank lines.
PCLIB contents:
LBAS EXEEXP is an EXPORTED version of LBAS.EXE.
LBAS EXETBH is a B3277 binary version of LBAS.EXE.
LBAS ASM is the PC-assembler source code (no tabs).
LBAS DOC is this document, in plain text.
Description:
This program translates "label basic" programs into proper
basic format acceptible to the PC Basic interpreter. It is
written in assembly language for speedy execution.
"Label basic" programs can be thought of as Basic programs
with two differences:
1. There are no sequence numbers at the beginning of each
statement.
2. Statement locations required by GOTO, GOSUB, ON ERROR, etc.
are referenced by labels instead of statement numbers.
"Label basic" programs have the following advantages:
1. The program can be entered and maintained using a PC
full-screen editor.
2. The programmer need not concern himself with statement numbers
and renumbering the program. Statements and subroutines are
referenced symbolically.
The disadvantage of "label basic", of course, is that you have to
maintain the "label basic" source and run the program through the
translator before it is useable by Basic. However, this translator
runs quite fast, more than 10 times faster than the version
which runs under the Basic interpreter. (Credit must be given
to Dave Chess, who inspired the idea of label basic.)
A label is defined as any non-blank string of characters beginning
with an '!' symbol and containing at least one additional character.
The maximum label length supported by this program is 16 characters
(including the !). The program has room for 256 labelled state-
ments. These limitations are somewhat arbitrary and could be
changed if necessary. Labels found inside literals (i.e. between
double quotes) will be ignored. Each statement can be "labelled"
only once.
The maximum file size which can be processed by this program is
64K bytes. This is because the entire file is read into one data
segment of main storage for processing, thus avoiding having to
read the file from disk twice. Therefore, your PC must have
at least 96K of memory to run LBAS. If insufficient memory is
available, the program will terminate with an error message.
Files used as input to this program should have a file extension
of "LBA". (This can be overridden, but the program will be easier
to run with the default file extension.) The output file will
be created with the same filename, and given a file extension of
"BAS". This will be in a format compatible with Basic ASCII files.
The output file will always be created on the same disk as the
input file.
To run the program, enter (from DOS):
LBAS <d:>filename<.filext>
where d: overrides the default disk drive if necessary, and
.filext overrides the default file extension (.LBA). If you
omit the filename on the command, you will be prompted for it.
Each TAB character is replaced with a blank, so tabs may be
present in the input file. No attempt is made to maintain
original spacing of the lines, however.
To report any problems or suggestions, please contact the
author at VM TOROLAB(BOTNER).
This disk copy was originally provided by "The Public Library",
the software library of the Houston Area League of PC Users.
Programs are available from the Public Library at $2 per disk
on user-provided disks. To get a listing of the disks in the
Public Library, send a self-addressed, stamped envelope to
Nelson Ford, P.O.Box 61565, Houston, TX 77208.
LBL-BAS.BAS
1000 DEFINT A-Z:DIM PTAB$(1000),LTAB(1000):TRUE=(1=1):FALSE=NOT TRUE:PTMAX=-1:CLS:INPUT "Enter input filename: ",INFILE$:INPUT "Enter output filename: ",OUTFILE$:INPUT "Enter listing filename: ",LSTFILE$:FOR PASS=1 TO 2
1001 PRINT "Beginning pass ";PASS;" ";TIME$:FILENO=2:OPEN INFILE$ FOR INPUT AS #FILENO:IF PASS=1 THEN OPEN LSTFILE$ FOR OUTPUT AS #1 ELSE OPEN OUTFILE$ FOR OUTPUT AS #1
1002 LNBR=1000:LINC=1:OU$=""
1003 GOSUB 1009:IF STMT$="" THEN 1008
1004 IF (LEN(OU$)+LEN(STMT$)>200) OR FORCENEW THEN GOSUB 1046:OU$=""
1005 IF OU$<>"" THEN OU$=OU$+":"
1006 OU$=OU$+STMT$:IF FOUNDIF THEN FORCENEW=TRUE:FOUNDIF=FALSE
1007 GOTO 1003
1008 GOSUB 1046:CLOSE #1:CLOSE #FILENO:NEXT PASS:BEEP:PRINT "End of run ";TIME$:BEEP:END
1009 STMT$="":NEWLAB=FALSE
1010 IF EOF(FILENO) THEN 1026
1011 LINE INPUT #FILENO,IN$:IF PASS=1 THEN PRINT #1,IN$
1012 INMAX=LEN(IN$):IF INMAX<1 THEN 1010
1013 W$=LEFT$(IN$,1):INIX=1:IF W$="*" THEN 1010
1014 IF W$="@" THEN GOSUB 1028
1015 GOSUB 1035:IF WORD$="COPY" THEN 1024 ELSE 1017
1016 GOSUB 1035
1017 IF LEFT$(WORD$,1)="@" THEN GOSUB 1030
1018 IF STMT$<>"" AND WORD$<>"" AND RIGHT$(STMT$,1)<>":" AND WORD$<>":" THEN STMT$=STMT$+" "
1019 STMT$=STMT$+WORD$:IF WORD$="IF" THEN FOUNDIF=TRUE
1020 IF WORD$<>"" THEN 1016
1021 IF INIX<=INMAX THEN IF W$="~" THEN 1010
1022 IF STMT$="" THEN 1010
1023 RETURN
1024 GOSUB 1035:FILENO=FILENO+1:ON ERROR GOTO 1025:OPEN WORD$ FOR INPUT AS #FILENO:ON ERROR GOTO 0:PRINT "Now copying ";WORD$:GOTO 1010
1025 ON ERROR GOTO 0:BEEP:PRINT "File ";INFILE$;" not found; ignored":FILENO=FILENO-1:GOTO 1010
1026 IF FILENO=2 THEN 1023
1027 CLOSE #FILENO:FILENO=FILENO-1:GOTO 1010
1028 FORCENEW=TRUE:GOSUB 1035:IF PASS=2 THEN RETURN
1029 PTMAX=PTMAX+1:PTAB$(PTMAX)=WORD$:LTAB(PTMAX)=LNBR+LINC:RETURN
1030 IF PASS=1 THEN WORD$="9999":RETURN
1031 PTIX=0
1032 IF PTIX>PTMAX THEN BEEP:PRINT "Unresolved label: ";WORD$:WORD$="9999":RETURN
1033 IF PTAB$(PTIX)=WORD$ THEN WORD$=RIGHT$(STR$(LTAB(PTIX)),4):RETURN
1034 PTIX=PTIX+1:GOTO 1032
1035 WORD$="":QUOTE=FALSE
1036 IF INIX>INMAX THEN RETURN
1037 IF MID$(IN$,INIX,1)=" " THEN INIX=INIX+1:GOTO 1036
1038 W$=MID$(IN$,INIX,1):IF QUOTE THEN 1042
1039 IF W$=":" THEN IF WORD$="" THEN WORD$=W$:INIX=INIX+1:RETURN
1040 IF W$=":" OR W$="'" OR W$=" " OR W$="~" THEN RETURN
1041 IF W$<" " OR W$>"z" THEN 1044
1042 IF W$=CHR$(34) THEN QUOTE=TRUE-QUOTE
1043 WORD$=WORD$+W$
1044 INIX=INIX+1:IF INIX<=INMAX THEN 1038
1045 RETURN
1046 IF PASS=2 AND OU$<>"" THEN PRINT #1,RIGHT$(STR$(LNBR),4);" ";OU$
1047 LNBR=LNBR+LINC:FORCENEW=FALSE:RETURN
LBL-SAMP.BAS
*--------------------------------------------------------------------*
* COPYRIGHT 1982 THE SOFTWARE LINK, INCORPORATED *
*--------------------------------------------------------------------*
DEFINT A-Z
DIM PTAB$(1000),LTAB(1000)
TRUE=(1=1):FALSE=NOT TRUE:PTMAX=-1:CLS
INPUT "Enter input filename: ",INFILE$
INPUT "Enter output filename: ",OUTFILE$
INPUT "Enter listing filename: ",LSTFILE$
*--------------------------------------------------------------------*
* START MAIN LOOP *
*--------------------------------------------------------------------*
FOR PASS=1 TO 2
PRINT "Beginning pass ";PASS;" ";TIME$
FILENO=2
OPEN INFILE$ FOR INPUT AS #FILENO
IF PASS=1 THEN ~
OPEN LSTFILE$ FOR OUTPUT AS #1 ~
ELSE ~
OPEN OUTFILE$ FOR OUTPUT AS #1
LNBR=1000:LINC=1:OU$=""
@STATEMENT-LOOP
GOSUB @GET-A-STATEMENT
IF STMT$="" THEN @END-OF-PASS
IF (LEN(OU$)+LEN(STMT$)>250) OR FORCENEW THEN ~
GOSUB @WRITE-A-LINE:OU$=""
IF OU$<>"" THEN OU$=OU$+":"
OU$=OU$+STMT$
IF FOUNDIF THEN FORCENEW=TRUE:FOUNDIF=FALSE
GOTO @STATEMENT-LOOP
@END-OF-PASS
GOSUB @WRITE-A-LINE
CLOSE #1
CLOSE #FILENO
NEXT PASS
BEEP
PRINT "End of run ";TIME$
BEEP
END
*--------------------------------------------------------------------*
* EXTRACT NEXT STATEMENT *
*--------------------------------------------------------------------*
@GET-A-STATEMENT
STMT$="":NEWLAB=FALSE
@READ-NEXT-LINE
IF EOF(FILENO) THEN @END-OF-FILE
LINE INPUT #FILENO,IN$
IF PASS=1 THEN PRINT #1,IN$
INMAX=LEN(IN$):IF INMAX<1 THEN @READ-NEXT-LINE
W$=LEFT$(IN$,1):INIX=1
IF W$="*" THEN @READ-NEXT-LINE
IF W$="@" THEN GOSUB @POST-PROCEDURE-LABEL
GOSUB @GET-A-WORD
IF WORD$="COPY" THEN @START-NEW-COPY ELSE @WORD-LOOP-ENTRY
@WORD-LOOP
GOSUB @GET-A-WORD
@WORD-LOOP-ENTRY
IF LEFT$(WORD$,1)="@" THEN GOSUB @TRANSLATE-PROCEDURE-LABEL
IF STMT$<>"" AND WORD$<>"" AND RIGHT$(STMT$,1)<>":" AND WORD$<>":" THEN STMT$=STMT$+" "
STMT$=STMT$+WORD$
IF WORD$="IF" THEN FOUNDIF=TRUE
IF WORD$<>"" THEN @WORD-LOOP
IF INIX<=INMAX THEN IF W$="~" THEN @READ-NEXT-LINE
IF STMT$="" THEN @READ-NEXT-LINE
@GOT-THE-STATEMENT
RETURN
@START-NEW-COPY
GOSUB @GET-A-WORD
FILENO=FILENO+1
ON ERROR GOTO @FILE-NOT-FOUND
OPEN WORD$ FOR INPUT AS #FILENO
ON ERROR GOTO 0
PRINT "Now copying ";WORD$
GOTO @READ-NEXT-LINE
@FILE-NOT-FOUND
ON ERROR GOTO 0
BEEP
PRINT "File ";INFILE$;" not found; ignored"
FILENO=FILENO-1
GOTO @READ-NEXT-LINE
@END-OF-FILE
IF FILENO=2 THEN @GOT-THE-STATEMENT
CLOSE #FILENO
FILENO=FILENO-1
GOTO @READ-NEXT-LINE
*--------------------------------------------------------------------*
* POST A PROCEDURE LABEL *
*--------------------------------------------------------------------*
@POST-PROCEDURE-LABEL
FORCENEW=TRUE
GOSUB @GET-A-WORD
IF PASS=2 THEN RETURN
PTMAX=PTMAX+1:PTAB$(PTMAX)=WORD$:LTAB(PTMAX)=LNBR+LINC
RETURN
*--------------------------------------------------------------------*
* TRANSLATE PROCEDURE LABEL TO INTEGER *
*--------------------------------------------------------------------*
@TRANSLATE-PROCEDURE-LABEL
IF PASS=1 THEN WORD$="9999":RETURN
PTIX=0
@TABLE-SCAN-LOOP
IF PTIX>PTMAX THEN ~
BEEP: ~
PRINT "Unresolved label: ";WORD$: ~
WORD$="9999": ~
RETURN
IF PTAB$(PTIX)=WORD$ THEN WORD$=RIGHT$(STR$(LTAB(PTIX)),4):RETURN
PTIX=PTIX+1:GOTO @TABLE-SCAN-LOOP
*--------------------------------------------------------------------*
* GET A WORD *
*--------------------------------------------------------------------*
@GET-A-WORD
WORD$="":QUOTE=FALSE
@SKIP-BLANKS-LOOP
IF INIX>INMAX THEN RETURN
IF MID$(IN$,INIX,1)=" " THEN INIX=INIX+1:GOTO @SKIP-BLANKS-LOOP
@CHARACTER-LOOP
W$=MID$(IN$,INIX,1)
IF QUOTE THEN @CHECK-FOR-QUOTE
IF W$=":" THEN IF WORD$="" THEN WORD$=W$:INIX=INIX+1:RETURN
IF W$=":" OR W$="'" OR W$=" " OR W$="~" THEN RETURN
IF W$<" " OR W$>"z" THEN @BUMP-INDEX
@CHECK-FOR-QUOTE
IF W$=CHR$(34) THEN QUOTE=TRUE-QUOTE
WORD$=WORD$+W$
@BUMP-INDEX
INIX=INIX+1:IF INIX<=INMAX THEN @CHARACTER-LOOP
RETURN
*--------------------------------------------------------------------*
* WRITE A LINE *
*--------------------------------------------------------------------*
@WRITE-A-LINE
IF PASS=2 AND OU$<>"" THEN PRINT #1,RIGHT$(STR$(LNBR),4);" ";OU$
LNBR=LNBR+LINC:FORCENEW=FALSE:RETURN
LINEBUG.BAS
10 CLS
13 LOCATE 3,29
16 PRINT "LINEBUG BY COMFAX"
20 LOCATE 5,25
30 PRINT "COPYRIGHT (C) 1984 COMFAX"
40 LOCATE 10,1
50 INPUT "ENTER PROGRAM NAME TO BE CHECKED ";PRG$
100 OPEN "I",#1,PRG$
250 OLDLINNO$="00000"
300 GOTO 500
400 IF EOF(1) GOTO 2300
500 LINE INPUT #1,IMAGE$
550 LINNO$="00000"
600 XX=1
700 IF MID$(IMAGE$,XX,1)=" " GOTO 1100
750 IF MID$(IMAGE$,XX,1) < "0" GOTO 2100
760 IF MID$(IMAGE$,XX,1) > "9" GOTO 2100
800 XX=XX+1
900 IF XX>6 GOTO 2100
1000 GOTO 700
1100 IF XX<2 GOTO 2100
1200 XX=XX-1
1300 YY=6-XX
1400 HLIN$ = MID$(IMAGE$,1,XX)
1500 MID$(LINNO$,YY)=HLIN$
1600 IF OLDLINNO$ >= LINNO$ GOTO 1900
1700 OLDLINNO$=LINNO$
1800 GOTO 400
1900 PRINT "LINE NO. ERROR ";LINNO$
2000 GOTO 1700
2100 HLD$=MID$(IMAGE$,1,20)
2150 PRINT "ILLEGAL LINE NO. ";HLD$
2200 GOTO 400
2300 CLOSE #1
2400 SYSTEM
LINEBUG.DOC
LINEBUG
Copyright (c) 1984 ComFax
This handy little utility lets you know whether or not you have
accidentally fouled-up any line numbers in a 'BASIC' program when you are not
using the BASIC Editor. If any is a duplicate, out of sequence, contains an
illegal character, or does not have the proper number of characters, this
program will display the line number for you.
This program was written for use on the IBM-PC or any compatible
computer. The program to be checked must be in ASCII format. To run the
program, simply type `BASICA'. Then RUN "LINEBUG". Enter the program name
after the prompt.
LINEBUG is a "must" for anyone who programs in BASIC, and the price is the
lowest we have ever seen on ANY program ANYWHERE!
You are permitted to reproduce and keep an unpaid-for copy of your user`s
group library master of this program for up to two weeks for the purpose of
evaluating this software, provided the copyright notice at the top of this
tutorial is included, without infringing our copyright. If after two weeks you
do not wish to keep it, simply destroy your copy of this program and owe us
nothing. However, if you like it well enough to keep it, please remit $10 (if
10 or more of your group decides to keep it, take a 20% quantity discount and
send only $8 per copy kept) to:
ComFax
P.O. Box 3523
Wichita,KS 67201
*TRUSTWARE...INNOVATION AT ECONOMY PRICES*
MONITOR.BAS
10 REM MONITOR
15 ZTITLE$="Program Title Here"
20 GOTO 30
25 END:REM Put Program Exit Here
30 ZHELPSW%=1:ZCSW%=0:ZW%=78
35 SCREEN 0,0,0:WIDTH 80:CLS:OPTION BASE 1
40 KEY OFF
45 ZB1$=STRING$(3,219):ZB2$=STRING$(79,219)
75 ZTOF$=CHR$(12):ZENT$="("+CHR$(17)+ZSHL$+ZSLR$+")":ZTFAC=425
80 DIM ZMENU$(15),ZMLEN%(15)
85 ZE$=" Not Available at this Point":ZDT$=DATE$:ZDT$=LEFT$(ZDT$,2)+"/"+MID$(ZDT$,4,2)+"/"+RIGHT$(ZDT$,2)
90 Z=6:GOSUB 100:GOTO 10000
95 REM Branch Table
100 LOCATE ,,0:ON Z GOSUB 115,675,740,750,785,805,830,850,860,880,905,915,925,935,945,975,985,1000,1015,1040,1050,1060,1070,1085,1095,1105,1120,1125,1135
105 RETURN
110 REM ZIN
115 ZD$="":ZN=0:GOSUB 1120:GOSUB 1125:ZR%=1:ZLEN%=VAL(ZFLD2$):ZTYPE%=VAL(MID$(Z$,ZPTR2%+1)):ZLEND%=LEN(ZFLD1$)
120 LOCATE 23,1:PRINT TAB(79);" ":LOCATE 23,1
125 PRINT ZFLD1$;" [";
130 IF ZPL$="" THEN 150
135 REM Pre-loaded input
140 PRINT ZPL$;STRING$(ZLEN%-LEN(ZPL$),".");"]":ZD$=ZPL$:ZCT%=LEN(ZPL$):LOCATE 23,ZLEND%+3+ZCT%,1:ZCPTR%=ZCT%+1:GOTO 170
145 REM No Preload
150 PRINT STRING$(ZLEN%,".");"]":LOCATE 23,ZLEND%+3,1
155 ZCT%=0:ZCPTR%=1
160 REM ZIN Inkey
165 LOCATE ,,1
170 ZCH$=INKEY$:IF ZCH$="" THEN 170
175 Z%=ASC(ZCH$):ZL%=LEN(ZCH$):IF Z%>126 THEN 170
180 REM Exten'd or Edit Char. Trap
185 IF ZL%>1 THEN 425
190 REM Control Char. Trap
195 IF Z%<32 THEN 285
200 REM Test Overstrike
205 IF ZINS%=1 THEN 265
210 IF ZCPTR%-1<ZCT% THEN 640
215 REM Test GT max
220 ZCT%=ZCT%+1:IF ZCT%>ZLEN% THEN ZCT%=ZCT%-1:GOTO 1140
225 ZCPTR%=ZCT%+1
230 IF ZCT%=1 THEN 240 ELSE 265
235 REM Special First Char.
240 IF (ZHELPSW%=1) AND (ZCH$="?") THEN ZR%=5:PRINT ZCH$;:GOTO 660
245 IF ZCH$="?" THEN PRINT ZCH$:Z=26:GOSUB 100:GOTO 115
250 IF ZCH$="+" THEN ZR%=2:PRINT ZCH$;:GOTO 660
255 GOTO 265
260 REM Normal Process
265 IF (Z%>96) AND (Z%<123) AND (ZCSW%=1) THEN ZCH$=CHR$(Z%-32)
270 IF ZINS%=1 THEN 550
275 PRINT ZCH$;:ZD$=ZD$+ZCH$:GOTO 170
280 REM Proc. Ctrl Char.
285 ZCTL%=Z%
290 REM ESC=abort
295 IF ZCTL%=27 THEN ZPL$="":GOTO 115
300 IF ZCTL%=3 THEN STOP:GOTO 115
305 IF ZCTL%=9 THEN 630
310 IF ZCTL%<>13 THEN 375
315 REM Proc. c/r
320 IF ZCT%=0 THEN ZR%=3:GOTO 660
325 IF ZTYPE%=1 THEN 665
330 IF ZD$="0" THEN 665
335 IF ZTYPE%=2 THEN 340 ELSE 350
340 ZT=VAL(ZD$):IF ZT=0 THEN 355
345 ZN=VAL(ZD$):IF ZN<> INT(ZN) THEN 355 ELSE 665
350 ZN=VAL(ZD$):IF ZN=0 THEN 360 ELSE 665
355 Z=21:GOTO 365
360 Z=22
365 ZSAVE$=Z$:GOSUB 100:Z$=ZSAVE$:GOTO 115
370 REM proc. B/U
375 IF ZCTL%=24 THEN ZR%=2:GOTO 660
380 REM Proc. BS
385 IF ZCTL%=8 THEN 395 ELSE 415
390 REM Short BS
395 IF ZCT%=0 THEN 1140
400 IF ZCPTR%-1<ZCT% THEN 575
405 ZCT%=ZCT%-1:ZCPTR%=ZCPTR%-1:LOCATE 23,ZLEND%+3+ZCT%:PRINT ".";:LOCATE 23,ZLEND%+3+ZCT%:ZD$=LEFT$(ZD$,LEN(ZD$)-1):GOTO 170
410 REM Pass Control Character
415 ZR%=4:ZN=ZCTL%:ZD$=" ":GOTO 665
420 REM Proc Ext'd Char.
425 ZXT%=ASC(MID$(ZCH$,2)):IF ZXT%=72 THEN ZR%=2:GOTO 660
430 REM ZIN Inner-field Editing
435 LOCATE ,,0:ZBR%=ZXT%-74:IF ZBR%<=0 THEN 445
440 ON ZBR% GOTO 470,445,485,445,500,445,445,530,575
445 GOSUB 1165:IF ZXT%=15 THEN 600
450 IF ZXT%=117 THEN 610
455 IF (ZXT%>58) AND (ZXT%<69) THEN 620
460 GOTO 170
465 REM Curs left
470 IF ZCPTR%=1 THEN 1140
475 GOSUB 1165:ZCPTR%=ZCPTR%-1:GOTO 1145
480 REM Curs right
485 IF ZCPTR%=ZCT%+1 THEN 1140
490 GOSUB 1165:ZCPTR%=ZCPTR%+1:GOTO 1145
495 REM END Key
500 Z%=23:Z=11:GOSUB 100:LOCATE 23,1:PRINT "Press END key again to End, space bar to continue [.]":LOCATE 23,52
505 ZCH9$=INKEY$:IF ZCH9$="" THEN 505
510 ZL%=LEN(ZCH9$):IF ZL%<2 THEN 115
515 ZXT%=ASC(MID$(ZCH9$,2)):IF ZXT%=79 THEN Z=15:GOSUB 100
520 GOTO 115
525 REM INS Toggle
530 IF ZCT%=ZLEN%-1 THEN 1140
535 IF ZINS%=0 THEN GOSUB 1155 ELSE GOSUB 1165
540 GOTO 170
545 REM INS Char.
550 IF ZCT%=ZLEN% THEN 1140
555 ZDL$=LEFT$(ZD$,ZCPTR%-1):ZDR$=MID$(ZD$,ZCPTR%):ZDR$=ZCH$+ZDR$
560 ZD$=ZDL$+ZDR$:ZCT%=ZCT%+1:ZCPTR%=ZCPTR%+1
565 PRINT ZDR$;STRING$(ZLEN%-LEN(ZD$),".");"]":GOTO 1145
570 REM Delete Char
575 IF ZCT%=ZCPTR%-1 THEN 1140
580 GOSUB 1165:ZDL$=LEFT$(ZD$,ZCPTR%-1):ZDR$=MID$(ZD$,ZCPTR%+1)
585 ZD$=ZDL$+ZDR$:ZCT%=ZCT%-1:PRINT ZDR$;".":GOTO 1145
590 GOTO 170
595 REM Back Tab
600 GOSUB 1165:ZCPTR%=1:GOTO 1145
605 REM Ctrl-End
610 GOSUB 1165:ZCT%=ZCPTR%-1:ZD$=LEFT$(ZD$,ZCT%):LOCATE 23,ZLEND%+2+ZCPTR%:PRINT STRING$(ZLEN%-LEN(ZD$),".");"]":GOTO 1145
615 REM Pass Function Keys
620 ZCTL%=ZXT%:GOTO 415
625 REM Forw'd Tab
630 GOSUB 1165:ZCPTR%=ZCT%+1:GOTO 1145
635 REM Overstrike
640 ZDL$=LEFT$(ZD$,ZCPTR%-1):IF ZCPTR%-1=0 THEN ZDL$=""
645 ZDR$=MID$(ZD$,ZCPTR%+1):IF ZCPTR%-1=ZCT% THEN ZDR$=""
650 ZD$=ZDL$+ZCH$+ZDR$:PRINT ZCH$;:ZCPTR%=ZCPTR%+1:GOTO 170
655 REM Common End
660 ZD$=" ":ZN=0:ZINS%=0
665 GOSUB 1165:ZPL$="":RETURN
670 REM ZMENU
675 GOSUB 1120:ZROWX%=VAL(ZFLD1$):GOSUB 1125:ZCOL%=VAL(ZFLD2$):LOCATE ZROWX%,ZCOL%:ZLTST%=LEN(Z$)
680 FOR ZMNO%=1 TO 15:ZPTR1%=ZPTR2%:IF ZPTR2%=0 THEN 705
685 IF ZPTR2%>=ZLTST% THEN 705
690 GOSUB 1125
695 IF ZMNO%<10 THEN ZPD$=" " ELSE ZPD$=""
700 PRINT TAB(ZCOL%);ZPD$;ZMNO%;"- ";ZFLD2$:NEXT ZMNO%
705 PRINT:IF ZMNO%>9 THEN ZX$="2" ELSE ZX$="1"
710 ZSAVE$=Z$:Z$=" Enter Selection,"+ZX$+",2":Z=1:GOSUB 100:ON ZR% GOTO 715,730,730,730,730
715 ZL=1:ZH=ZMNO%-1:Z$=ZSAVE$:Z=10:GOSUB 100
720 ON ZV% GOTO 730,725,725
725 ZSAVE$=Z$:ZD$=STR$(ZN):Z=20:GOSUB 100:Z$=ZSAVE$:GOTO 675
730 RETURN
735 REM ZTCLR
740 FOR Z%=1 TO 15:ZMENU$(Z%)="":NEXT Z%:RETURN
745 REM ZTMENU
750 ZPTR2%=0:ZPDL$=STRING$(((78-ZW%)/2)," "):ZPR%=(78-ZW%)/2:LOCATE ZROW%,1:FOR ZMNO%=1 TO 15:ZFLD$=ZMENU$(ZMNO%):IF ZPTR2%=LEN(Z$) THEN 775
755 ZPTR1%=ZPTR2%:GOSUB 1125:ZMD$=ZFLD2$:ZPTR1%=ZPTR2%:GOSUB 1125
760 ZTYPE%=VAL(ZFLD2$):ZMLEN%(ZMNO%)=ZTYPE%:IF ZFLD$="" THEN ZFLD$="["+STRING$(ZTYPE%,".")+"]"
765 ZCOL%=LEN(ZFLD$):IF ZMNO%<10 THEN ZPD$=" " ELSE ZPD$=""
770 PRINT ZPDL$;ZPD$;STR$(ZMNO%)+". ";ZMD$;TAB(80-ZCOL%-2-ZPR%);ZFLD$:NEXT ZMNO%
775 RETURN
780 REM ZUPTMENU
785 ZPTR1%=ZMLEN%(ZY%):ZPR%=(78-ZW%)/2:LOCATE (ZROW%+ZY%-1),(80-ZPTR1%-4-ZPR%):PRINT TAB(79)
790 ZMENU$(ZY%)=ZD$
795 ZCOL%=LEN(ZMENU$(ZY%)):LOCATE (ZROW%+ZY%-1),(80-ZCOL%-2-ZPR%):PRINT ZMENU$(ZY%);TAB(79):RETURN
800 REM ZBOX
805 PRINT ZB2$:PRINT ZB1$;CHR$(221);TAB(76);CHR$(222);ZB1$
810 PRINT ZB1$;CHR$(221);TAB(41-(LEN(ZTITLE$)/2));ZTITLE$;TAB(76);CHR$(222);ZB1$
815 PRINT ZB1$;CHR$(221);TAB(76);CHR$(222);ZB1$:PRINT ZB2$:PRINT
820 RETURN
825 REM ZLINE
830 LOCATE 1,1:COLOR 1
835 PRINT ZTITLE$;TAB(72);ZDT$:COLOR 7
840 RETURN
845 REM ZAOK
850 Z=13:GOSUB 100:Z$="All ok? Y or N,1,1":Z=1:GOSUB 100:Z=9:GOSUB 100:Z=14:GOSUB 100:RETURN
855 REM ZTESTYN
860 ZV%=3:IF (ZD$="Y") OR (ZD$="y") THEN ZV%=1
865 IF (ZD$="N") OR (ZD$="n") THEN ZV%=2
870 RETURN
875 REM ZNLIMIT
880 ZV%=1:IF ZL>ZN THEN ZV%=2
885 IF ZH<ZN THEN ZV%=3
890 IF (ZCTL%<>0) AND (ZR%>3) THEN ZV%=4
895 RETURN
900 REM ZSCREEN
905 FOR Z%=Z% TO 24:LOCATE Z%,1:PRINT TAB(80);:NEXT Z%:RETURN
910 REM ZBEEP
915 SOUND 50,3:RETURN
920 REM ZUP
925 ZCSW%=1:RETURN
930 REM ZMIX
935 ZCSW%=0:RETURN
940 REM ZEND
945 CLS:Z=6:GOSUB 100
950 LOCATE 10,32,0:PRINT "┌";STRING$(17,"─");"┐"
955 LOCATE ,32:PRINT "│";" End Program ";"│"
960 LOCATE ,32:PRINT "└";STRING$(17,"─");"┘"
965 LOCATE 21,1,0:GOTO 25
970 REM ZCTR
975 GOSUB 1030:GOTO 1025
980 REM ZCTRR
985 GOSUB 1030
990 COLOR 8,7:GOTO 1025
995 REM ZCTRB
1000 GOSUB 1030
1005 COLOR 23:GOTO 1025
1010 REM ZCTRU
1015 GOSUB 1030
1020 COLOR 1
1025 PRINT ZFLD2$;:COLOR 7:PRINT TAB(79);:RETURN
1030 LOCATE 23,1:PRINT:GOSUB 1120:ZFLD2$=MID$(Z$,ZPTR1%+1):Z%=VAL(ZFLD1$):LOCATE Z%,,0:PRINT TAB((80-LEN(ZFLD2$))/2);:RETURN
1035 REM ZERRINV
1040 Z$="24,"+ZD$+" Is Invalid":GOTO 1110
1045 REM ZERRINT
1050 Z$="24,"+ZD$+" Is Not an Integer Number":GOTO 1110
1055 REM ZERRNUM
1060 Z$="24,"+ZD$+" Is Not Numeric":GOTO 1110
1065 REM ZERRCTRL
1070 IF ZCTL%>26 THEN ZDS2%=ZCTL%-58:ZDS$="F"+MID$(STR$(ZDS2%),2) ELSE ZDS$="Control "+CHR$(ZCTL%+64)
1075 Z$="24,Function Key = "+ZDS$+ZE$:GOTO 1110
1080 REM ZERRENT
1085 Z$="24,ENTER-Only Entry "+ZE$:GOTO 1110
1090 REM ZERRBACK
1095 Z$="24,Field Backup Entry "+ZE$:GOTO 1110
1100 REM ZERRHELP
1105 Z$="24,HELP "+ZE$
1110 Z=17:GOSUB 100:Z=12:GOSUB 100:ZY=2:Z=29:GOSUB 100:Z%=24:Z=11:GOSUB 100:RETURN
1115 REM Routines
1120 ZPTR1%=INSTR(1,Z$,","):ZFLD1$=LEFT$(Z$,ZPTR1%-1):RETURN
1125 ZPTR2%=INSTR(ZPTR1%+1,Z$,","):ZFLD2$=MID$(Z$,ZPTR1%+1,ZPTR2%-ZPTR1%-1):RETURN
1130 REM ZDELAY
1135 FOR ZX=1 TO ZY*ZTFAC:NEXT ZX:RETURN
1140 Z=12:GOSUB 100:GOTO 165
1145 LOCATE 23,ZLEND%+2+ZCPTR%,1:GOTO 170
1150 REM INS On
1155 ZINS%=1:LOCATE ,,,4,12:RETURN
1160 REM INS Off
1165 ZINS%=0:LOCATE ,,,11,12:RETURN
9000 REM Save Program
9010 ZPROG$="program name"
9020 PRINT "Saving B:"+ZPROG$+".BAS"
9030 SAVE "B:"+ZPROG$
9040 PRINT "Saving B:"+ZPROG$+".S"
9050 SAVE "B:"+ZPROG$+".S",A
9060 RETURN
9090 REM Memory Display
9100 CLS:LOCATE 10,1,0:PRINT TAB(32);"Memory Statistics":PRINT:PRINT TAB(27);"Remaining Memory: ";FRE(0):PRINT:PRINT TAB(27);"Program Length: ";61529!-FRE(0):RETURN
10000 REM Begin Program Here
PAL80.BAS
100 'ARTWARE by Roman Verostko
110 'Mpls College of Art and Design
120 '133 East 25th Street
130 'Minneapolis, Minnesota 55404
140 '
150 '**********************
160 '* *
170 '* PALETTE PROMPTER *
180 '* *
190 '* "PAL80.BAS" *
200 '* *
210 '**********************
220 '
230 'This version for width 80
240 'Use "PAL40" for programming in width 40
250 '
260 SCREEN 0,1:KEY OFF:CLS:WIDTH 80
270 N$=STRING$(3,219)
280 FOR V=4 TO 40 STEP 4
290 C=(V/4)-1:IF C=0 THEN C=8
300 N=(V/4)-1:COLOR C,0,0
310 LOCATE 25,V-1:PRINT N;
320 IF N=0 THEN C=0:COLOR C,0,0
330 LOCATE 25,V-3:PRINT N$;
340 NEXT V
350 FOR V=50 TO 80 STEP 5
360 C=(V/5):COLOR C,0,0
370 LOCATE 25,V-7:PRINT C;
380 LOCATE 25,V-9:PRINT N$;
390 NEXT V
400 COLOR 15,0:LOCATE 1,1:END
POKEPEEK.TXT
03/03/84
COMMONLY USED BASIC PEEKS, POKES AND SUBROUTINES
DUE TO THE LACK OF A COMPREHENSIVE, PUBLISHED DIRECTORY OF COMMONLY USED
POKES, PEEKS AND SUBROUTINES THIS LIST HAS BEEN COMPILED BY THE SMUG
PROSIG AS WELL AS A MANY OTHER HARDWORKING PD SOURCES. THANKS AND A TIP
OF THE HAT TO ALL CONTRIBUTORS! ADDITIONS TO THE LIST ARE ENCOURAGED AND
SHOULD BE ADDRESS TO:
DON WATKINS, CIS IBMSIG 76003,252
THERE ARE, OF COURSE NO WARRENTIES OR GUARENTEES THAT ANY OF STUFF WORKS
AND FURTHERMORE, IF IT BLOWS UP YOUR MACHINE IT AIN'T MY FAULT.
------------------------------------------------------------------------
BY SPECIFYING A DEF SEG=&H40 IN ANY BASIC PROGRAM, IT IS POSSIBLE TO
REFERENCE THE FOLLOWING VECTORS (FIELDS) IN THE ROM BIOS AREA BY USING A
PEEK FUNCTION AND THE FOLLOWING OFFSETS FROM THE CURRENT SEGMENT AS
DEFINED BY THE DEF SEG STATEMENT.
&H0 - RS232 ADDRESSES ON YOUR IBM PC.
THIS WILL ALLOW YOU TO TELL HOW MANY (UP TO
FOUR) ASYNC CARDS ARE ATTACHED, IF ANY.
&H8 - PRINTER ADDRESSES ON YOUR IBM PC.
THIS WILL TELL YOU WHAT PRINTER ADDRESSES,
AND HOW MANY (UP TO FOUR) EXIST. EACH IS
ADDRESSED BY A TWO BYTE HEX VALUE.
&H10 - EQUIPMENT FLAG.
THIS FIELD DESCRIBES THE SETTING OF THE
OPTIONS SWITCHES. IT DESCRIBES WHAT OPTIONAL
DEVICES ARE ATTACHED TO THE SYSTEM. THE
FOLLOWING LISTS THE BIT-SIGNIFICANCE OF THIS
FIELD:
BIT 0 - INDICATES THAT THERE ARE DISKETTE
DRIVES ON THE SYSTEM.
BIT 1 - NOT USED.
BIT 2,3 - PLANAR RAM SIZE (00=16K 10=32K 01=48K
11=64K)
BIT 4,5 - INITIAL VIDEO MODE (00=UNUSED
10=40X25 COLOR
01=80X25 COLOR
11=80X25 MONO)
BIT 6,7 - NUMBER OF DISKETTE DRIVES (00=1 10=2
01=3 11=4) ONLY IF BIT 0 = 1.
BIT 8 - UNUSED
BIT 9,10,11 - NUMBER OF RS232 CARDS ATTACHED
BIT 12 - GAME I/O ATTACHED
BIT 13 - NOT USED
BIT 14,15 - NUMBER OF PRINTERS ATTACHED
&H13 - MEMORY SIZE IN K BYTES.
&H15 - I/O RAM SIZE IN K BYTES.
&H17 - KEYBOARD FLAG -- THE FOLLOWING LISTS THE MASKS
SET TO DESCRIBE CURRENT KEYBOARD STATUS:
BYTE 1;
&H80 - INSERT STATE ACTIVE
&H40 - CAPS LOCK STATE HAS BEEN TOGGLED
&H20 - NUM LOCK STATE HAS BEEN TOGGLED
&H10 - SCROLL LOCK STATE HAS BEEN TOGGLED
&H08 - ALTERNATE SHIFT KEY DEPRESSED
&H04 - CONTROL SHIFT KEY DEPRESSED
&H02 - LEFT SHIFT KEY DEPRESSED
&H01 - RIGHT SHIFT KEY DEPRESSED
BYTE 2;
&H80 - INSERT KEY IS DEPRESSED
&H40 - CAPS LOCK KEY IS DEPRESSED
&H20 - NUM LOCK KEY IS DEPRESSED
&H10 - SCROLL LOCK KEY IS DEPRESSED
&H08 - SUSPEND KEY HAS BEEN TOGGLED
&H49 - CURRENT CRT MODE
&H00 - 40X25 BW
&H01 - 40X25 COLOR
&H02 - 80X25 BW
&H03 - 80X25 COLOR
&H04 - 320X200 COLOR
&H05 - 320X200 BW
&H06 - 640X200 BW
&H07 - 80X25 B&W CARD -- SPECIALIZED USE, USED
INTERNAL TO THE VIDEO ROUTINES.
&H4A - NUMBER OF CRT COLUMNS
&H50 - CURSOR POSITION (ONE OF EIGHT)
&H60 - CURRENT CURSOR MODE
&H6C - LOW WORD OF TIMER COUNT
&H6E - HIGH WORD OF TIMER COUNT
&H71 - &H07 - BREAK KEY DEPRESSED
&HFA6E - BEGINNING OF CHARACTER REGEN MEMORY
&HFF53 - PRTSC ROUTINE ADDRESS
------------------------------------------------------------------
REAL STUFF--
TOGGLE NUM LOCK
DEG SEG = &H40 : POKE &H17, PEEK(&H17) OR 32 'TO TURN ON
DEG SEG = &H40 : POKE &H17, PEEK(&H17) AND 223 'TO TURN OFF
TOGGLE CAPS LOCK
DEG SEG = &H40 : POKE &H17, PEEK(&H17) OR 64 'TO TURN ON
DEG SEG = &H40 : POKE &H17, PEEK(&H17) AND 171 'TO TURN OFF
SET SCROLL WINDOW
10 DEF SEG : POKE 91,20 : POKE 92,25 'SETS UP WINDOW ON LINE
20 LOCATE X,20 'FORCE CURSOR TO WINDOW
SET WINDOW WIDTH
DEF SEG : POKE 41,30 'SETS WINDOW WIDTH TO 30
RESTORE FUNCTION KEYS TO DEFAULT
10 DEF SEG = &HFACE
20 K = 1
30 I = 13
40 T$ = STRING$(13,32): J = 1
50 T1 = PEEK(I):IF T1 < 0 THEN MID$(T$,J,1) = CHR$(T1):J = J + 1:
I = I + 1 : GOTO 50
60 KEY K,LEFT$(T$,J-1):IF K <10 THEN K = K + 1: I = I + 1: GOTO 40 :
ELSE KEY ON
DETERMINE MONITOR TYPE
10 DEF SEG = 0
20 MONITOR.TYPE = PEEK(&H410) AND &H40
30 IF MONITOR.TYPE = 1 PRINT "40 X 25 COLOR"
40 IF MONITOR.TYPE = 32 PRINT "80 X 25 COLOR"
50 IF MONITOR.TYPE = 48 PRINT "MONOCHROME"
DETERMINE AMOUNT OF MEMORY INSTALLED (ONLY WORKS FOR GREATER THAN 48K)
DEF SEG = 0: MEMORY% = PEEK(&H413)+(256*PEEK(&H414))
OR, PUT ANOTHER WAY:
MEMORY INFO: DEF SEG=0
((PEEK(1040) AND 12) + 4 ) * 4 - MEMORY ON MOTHER-BOARD
PEEK(1045) + 256 * PEEK(1046) - EXPANSION MEMORY (ADD ON)
PEEK(1043) + 256 * PEEK(1044) - TOTAL MEMORY
READ DRIVE SWITCHES
DEF SEG = 0: NUMBER.OF.DRIVES% = PEEK(&H410) AND &HC0
CURRENT DISK INFO: DEF SEG=64
DEF SEG=64
PEEK(69) - TRACK
PEEK(70) - HEAD
PEEK(71) - SECTOR
256^PEEK(72) - BYTES PER SECTOR
DETERMINE IF GAME ADAPTER EXISTS
10 DEF SEG = 0: GAME.ADAPTER% = PEEK(&H411) AND &H10
20 IF GAME.ADAPTER% = 0 THEN GAME.ADAPTER$ = "NO" ELSE GAME.ADAPTER$
= "YES --INSTALLED"
KEYBOARD STUFF
TO DISABLE ENTIRE KEYBOARD: DEF SEG=64: OUT 97,204
TO RE-ENABLE KEYBOARD: DEF SEG=64: OUT 97,76
PRINTER STATUS--- AT LEAST ON EPSON ---
DEF SEG=64
A=PEEK(8)+256*PEEK(9)
B=(INP(A+1) AND 248) XOR 72
IF (B AND 128)<>128 THEN PRINTER OFF LINE ELSE ON LINE
INITIALIZE PRINTER: DEF SEG: OUT A+2,8
OUT A+2,12
NOTE: THE A TO INITIALIZE IS FROM PRINTER STATUS ROUTINE
A SHORT PROGRAM TO DISABLE AND RE-ENABLE CTRL BREAK FOLLOWS.
100 DIM OLD%(4)
110 DEF SEG=0
120 ' SAVE THE OLD CONTROL BREAK ADDRESS
130 FOR I=&H6C TO &H6F
140 OLD%(I-&H6C)=PEEK(I)
150 NEXT
160 ' ESTABLISH NEW CONTROL BREAK ADDRESS (POINT TO IRET)
170 POKE &H6C,&H53
180 POKE &H6D,&HFF
190 POKE &H6E,&H0
200 POKE &H6F,&HF0
210 DEF SEG
220 ' RESET OLD CONTROL BREAK ADDRESS
230 DEF SEG=0
240 FOR I=&H6C TO &H6F
250 POKE I,OLD%(I-&H6C)
260 NEXT
SAVE AND RESTORE A SCREEN IMAGE
1 DEF SEG = &HB800 'SAVE SCREEN IMAGE...CHANGE FOR
2 INPUT FILENAME$ 'MONOCHROME.
3 BSAVE FILENAME$,0,&H4000
1000 INPUT "FILENAME";FILENAME$ 'RESTORE IMAGE
1010 CLS
1020 DEF SEG = &HB800 'CHANGE TO &HB000 TO MONO
1030 BLOAD FILENAME$
NICE TO KNOW
BASIC UNPROTECT
ENTER BASICA
TYPE BSAVE "UN.P",1124,1
LOAD "MYPROG
BLOAD "UN.P",1124
THE PROGRAM CAN NOW BE LISTED, EDITED AND SAVED AS A NORMAL FILE.
THE LIST IS GROWING BUT COULD BE LONGER! ANY AND ALL ADDITIONS OF
COMMONLY USED SUBROUTINES AND PEEK/POKE LOCATIONS WILL BE GLADLY ADDED.
ADDRESS ALL ADDITIONS TO: DON WATKINS CIS 76003,252 (IBMSIG). WITH A
BIT OF YOUR ASSISTANCE THIS DOCUMENT CAN BECOME AN EFFECTIVE TOOL FOR THE
BASIC PROGRAMMER.... SO CHIP IN.
PROFILE.BAS
10 REM prog = profile
20 REM PC Magazine [Oct 1982 pg 102]
30 DEF SEG = &HC00: BLOAD "PROFILE.MEM",0: KEY OFF
40 STARTP% = 0: ENDP% = 3: GETP% = 6
50 MAXLINE% = 140: CALL START%(MAXLINE%)
60 ' dummy demo prog follows:
70 FOR LOOP = 1 TO 24
80 X=0: R= RND * 1000
90 PRINT R,
100 X = X + 1
110 R = R/2
120 IF R>1 THEN 100
130 PRINT X
140 NEXT
150 CALL ENDP%
160 ' following section produces a graph
170 WID% = 80
180 FOR L% = 70 TO MAXLINE% STEP 10
190 PRINT USING "###";L%;
200 N% = L%: CALL GETP%(N%)
210 IF N%>WID%-5 THEN N% = WID%-5
220 FOR I% = 1 TO N%
230 IF I% MOD 10 THEN PRINT "-";: ELSE PRINT "+";
240 NEXT
250 PRINT
260 NEXT
270 END
PROFILE.DOC
See PC Magazine #6, Oct. 82, pg.102-106
This is a utility that resides in memory and logs how much time is spent
executing each part of a program.
READBAS.BAS
1 '' READBAS 1.4 - READS BASIC PROGRAMS SAVED IN BINARY
2 '' NELSON FORD (713) 960-1300 (713) 721-6104 MAY 10, 1984
3 ''
4 '' PUBLIC DOMAIN. The idea is to compile this program and use it while in
5 '' DOS to look at BASIC programs that have been saved in compacted binary.
6 '' This code may also be added to other programs that need to read BASIC
7 '' programs that may not be saved in ASCII.
8 ''
10 DEFINT A-Z: CLS: INPUT "FILE NAME"; FI$
20 INPUT "TO (1)SCREEN (2)PRINTER (3)DISK"; D
30 IF D=1 THEN F2$="SCRN:" ELSE IF D=2 THEN F2$="LPT1:" ELSE IF D=3 THEN INPUT "OUTPUT FILENAME"; F2$ ELSE 20
40 DIM X#(8): PRINT: PRINT "PRESS ANY KEY TO ABORT": PRINT
50 DIM T$(115), T3$(6), T4$(30), T5$(37)
60 FOR T=129 TO 243: READ T$(T-128): NEXT 'tokens 129-243
70 FOR T=129 TO 134: READ T3$(T-128): NEXT 'token 253 followed by 129-134
80 FOR T=129 TO 158: READ T4$(T-128): NEXT 'token 254 followed by 129-158
90 FOR T=129 TO 165: READ T5$(T-128): NEXT 'token 255 followed by 129-165
95 '
100 OPEN FI$ AS 1 LEN=1: FIELD 1, 1 AS X$
110 OPEN F2$ FOR OUTPUT AS #2: GET 1
120 IF ASC(X$) <>255 THEN PRINT "NOT A BASIC PROGRAM SAVED IN BINARY": END
125 '----get, print line number:
130 GET 1: X=ASC(X$): GET 1: IF X=0 AND ASC(X$)=0 THEN STOP
140 GET 1: N$=STR$(ASC(X$)): GET 1: X=ASC(X$)
150 IF X>0 THEN N$=STR$(X*256+VAL(N$))
160 PRINT #2, RIGHT$(N$,LEN(N$)-1) " ";
190 '----get a hex character and translate:
200 GET 1: X= ASC(X$)
210 U$=INKEY$: IF U$<>"" THEN END
220 IF X=58 THEN GET 1: X=ASC(X$): IF X=143 THEN GOSUB 910: GOTO 130 ELSE IF X<>161 THEN PRINT #2,":";
230 IF X=0 THEN PRINT #2,"": GOTO 130 'ascii 0 marks end of BASIC line
240 IF X>31 THEN 300 ELSE IF X <11 THEN STOP
250 ON X-10 GOSUB 400,440,480,500,540,580,600,600,600,600,600,600,600,600,600, 600,640,660,720,815,820
260 GOTO 200
270 RETURN
290 '------
300 IF X <128 THEN PRINT #2, X$;: IF X=34 THEN 1200 ELSE 200
310 IF X >128 AND X <244 THEN PRINT #2, T$(X-128);: GOTO 200
320 IF X >252 AND X <256 THEN GET 1: Y=ASC(X$) ELSE 200
330 IF Y <129 THEN PRINT "ERROR IN FILE": STOP
340 ON X-252 GOTO 350,360,370: GOTO 200
350 PRINT #2, T3$(Y-128);: GOTO 200
360 PRINT #2, T4$(Y-128);: GOTO 200
370 PRINT #2, T5$(Y-128);: GOTO 200
390 '
400 GET 1: N=ASC(X$): GET 1: N=ASC(X$)*256 +N '11 = OCTAL
410 PRINT #2, "&O" OCT$(N);
420 RETURN
430 '
440 GET 1: N=ASC(X$): GET 1: N=ASC(X$)*256 +N '12 = HEX
450 PRINT #2, "&H" HEX$(N);
460 RETURN
470 '
480 STOP '13 NOT USED
490 '
500 GET 1: N$=STR$(ASC(X$)) '14 INTEGERS
505 GET 1: X=ASC(X$)
510 IF X>0 THEN N$=STR$(X*256+VAL(N$))
520 PRINT #2, RIGHT$(N$,LEN(N$)-1);
530 RETURN
535 '
540 GET 1: N$=STR$(ASC(X$)) '15 = NUMBERS 10 TO 255
550 PRINT #2, RIGHT$(N$,LEN(N$)-1);
560 RETURN
570 '
580 STOP '16 NOT USED
590 '
600 N$=STR$(X-17) '17 - 26 = NUMBERS 0 TO 9
610 PRINT #2, RIGHT$(N$,LEN(N$)-1);
620 RETURN
630 '
640 STOP '27 NOT USED
650 '
660 GET 1: N=ASC(X$): GET 1 '28 = NUMBERS > 255 AND <32267
670 N$= STR$(256*ASC(X$) +N)
680 PRINT #2, RIGHT$(N$,LEN(N$)-1);
690 RETURN
700 '
710 '29 = NUMBERS >32267 AND < ?
720 N$="": FOR I=1 TO 4: GET 1: N$=N$+X$: NEXT
730 N$=STR$(CVS(N$))
740 PRINT #2, RIGHT$(N$,LEN(N$)-1); "!";
750 RETURN
815 ' 30 NOT USED
816 '
819 ' 31 = DOUBLE PRECISION
820 N$="": FOR I=1 TO 8: GET 1: N$=N$+X$: NEXT
830 N$=STR$(CVD(N$))
840 PRINT #2, RIGHT$(N$,LEN(N$)-1); "#";
850 RETURN
905 ' read from ' to end of line:
910 PRINT #2, "'";: GET 1:
920 GET 1: IF ASC(X$) >0 THEN PRINT #2, X$;: GOTO 920
950 PRINT #2, "": RETURN
955 '
960 'tokens 129-244:
970 DATA END,FOR,NEXT,DATA,INPUT,DIM,READ,LET,GOTO,RUN,IF,RESTORE,GOSUB,RETURN
980 DATA REM,STOP,PRINT,CLEAR,LIST,NEW,ON,WAIT,DEF,POKE,CONT,NU,NU,OUT,LPRINT
990 DATA LLIST,NU,WIDTH,ELSE,TRON,TROFF,SWAP,ERASE,EDIT,ERROR,RESUME,DELETE
1000 DATA AUTO,RENUM,DEFSTR,DEFINT,DEFSNG,DEFDBL,LINE,WHILE,WEND,CALL,NU,NU,NU
1010 DATA WRITE,OPTION,RANDOMIZE,OPEN,CLOSE,LOAD,MERGE,SAVE,COLOR,CLS,MOTOR
1020 DATA BSAVE,BLOAD,SOUND,BEEP,PSET,PRESET,SCREEN,KEY,LOCATE,NU,TO,THEN,TAB(
1030 DATA STEP,USR,FN,SPC,NOT,ERL,ERR,STRING$,USING,INSTR,"'",VARPTR,CSRLIN
1040 DATA POINT,OFF,INKEY$,NU,NU,NU,NU,NU,NU,NU,>,=,<,+,-,*,/,^,AND,OR,XOR,EQV
1050 DATA IMP,MOD
1060 'pre-token 253, tokens 129-134:
1070 DATA CVI,CVS,CVD,MKI$,MKS$,MKD$
1080 'pre-token 254, tokens 129-158:
1090 DATA FILES,FIELD,SYSTEM,NAME,LSET,RSET,KILL,PUT,GET,RESET,COMMON,CHAIN
1100 DATA DATE$,TIME$,PAINT,COM,CIRCLE,DRAW,PLAY,TIMER,ERDEV,IOCTL,CHDIR,MKDIR
1110 DATA RMDIR,SHELL,ENVIRON,VIEW,WINDOW,PMAP
1120 'pre-token 255, tokens 129-165:
1130 DATA LEFT$,RIGHT$,MID$,SGN,INT,ABS,SQR,RND,SIN,LOG,EXP,COS,TAN,ATN,FRE
1140 DATA INP,POS,LEN,STR$,VAL,ASC,CHR$,PEEK,SPACE$,OCT$,HEX$,LPOS,CINT,CSNG
1150 DATA CDBL,FIX,PEN,STICK,STRIG,EOF,LOC,LOF
1200 'print stuff in quotes:
1210 GET 1: X=ASC(X$): IF X=0 THEN PRINT #2,"": GOTO 130
1220 IF X=34 THEN PRINT #2, CHR$(34);: GOTO 200
1230 PRINT X$;: GOTO 1210
SCRN-MAP.BAS
1 ' (PC)^3 Software Submission SCNMAP authored on February 4, 1983 by
2 '
3 ' Michael Csontos, 3228 Livonia Center Road, Lima, New York 14485
4 '
5 ' Copyright 1983 Michael Csontos
6 '
7 ' This program is made freely available non-exclusively to the Picture
8 ' City Personal Computer Programmers' Club for distribution to its members
9 ' and through software exchange to other users groups as long as credit is
10 ' given to the author and (PC)^3.
11 '
15 '
16 '
10000 CLS:SCREEN 0,0,0:WIDTH 80:KEY OFF:WIDTH "lpt1:",255:DEFINT A-Z
10100 PRINT "This program will cause the Epson printer (with script capability) to make
10200 PRINT "a form that can be used to lay-out screen formats for the IBM color-graphics
10300 PRINT "adapter card in the alpha-numeric mode in either the 40 or 80 column width.
10400 PRINT "You may choose either a blank form or one with each character position filled
10500 PRINT "with the address of the memory location corresponding to that position.
10600 PRINT
10700 PRINT "Do you want: 1) a blank 40 width form,
10800 PRINT " or 2) a filled 40 width form,
10900 PRINT " or 3) a blank 80 width form,
11000 PRINT " or 4) a filled 80 width form,
11100 PRINT " or <Esc> to end the program.
11200 PRINT:PRINT "Please press 1, 2, 3, 4, or <Esc>.
11300 X$=INKEY$:IF X$="" THEN 11300 ELSE IF X$=CHR$(27) THEN 11700 ELSE A=VAL(X$)
11350 ON ERROR GOTO 11650
11400 IF A>4 OR A<1 THEN 11200
11500 IF A=1 OR A=2 THEN 11800
11600 IF A=3 OR A=4 THEN 14500
11650 RESUME
11700 CLS:KEY ON:END
11800 LPRINT CHR$(27)CHR$(64)CHR$(15)CHR$(27)CHR$(48)'reset;compressed;1/8" lines
11900 IF A=1 THEN LPRINT "Blank layout for screen graphics for the IBM Personal Computer Color Graphics Adapter Card in the 40 column width mode.":LPRINT:GOTO 12100
12000 LPRINT "Memory map of the screen graphics RAM for the IBM Personal Computer Color Graphics Adapter Card in the 40 column width A/N mode.":LPRINT
12100 LPRINT CHR$(27)CHR$(45)CHR$(1);:FOR L=25 TO 1 STEP -1:LPRINT USING "| ##";L;:NEXT L:LPRINT CHR$(27)CHR$(45)CHR$(0)'underlined
12200 FOR M=1 TO 40
12300 LPRINT CHR$(27)CHR$(51)CHR$(1);'1/216" lines (effectively no LF)
12400 FOR N=1 TO 26:LPRINT CHR$(156);:LPRINT STRING$(4," ");:NEXT N:LPRINT
12500 IF A=1 THEN LPRINT:GOTO 12800
12600 LPRINT CHR$(27)CHR$(83)CHR$(1);'subscript
12700 FOR L=0 TO 24 STEP 1:LPRINT USING " ####";(80*(25-L))-(80-2*M+1)-1;:NEXT L:LPRINT
12800 LPRINT CHR$(27)CHR$(49)CHR$(27)CHR$(84)CHR$(27)CHR$(72)'7/72" lines;cancel script; cancel double strike;line feed
12900 LPRINT CHR$(27)CHR$(51)CHR$(1):LPRINT:LPRINT '1/216" lines (effectively no LF)
13000 LPRINT CHR$(27)CHR$(45)CHR$(1);'underline
13100 FOR N=1 TO 26:LPRINT CHR$(156);:LPRINT STRING$(4," ");:NEXT N:LPRINT USING "##";M
13200 LPRINT CHR$(27)CHR$(45)CHR$(0);'cancel underline
13300 IF A=1 THEN LPRINT:GOTO 13600
13400 LPRINT CHR$(27)CHR$(83)CHR$(0);'superscript
13500 FOR L=0 TO 24 STEP 1:LPRINT USING " ####";(80*(25-L))-(80-2*M)-1;:NEXT L:LPRINT
13600 LPRINT CHR$(27)CHR$(49)CHR$(27)CHR$(84)CHR$(27)CHR$(72) '7/72" lines;cancel script; cancel double strike;line feed
13700 NEXT M
13800 LPRINT CHR$(27)CHR$(65)CHR$(2)'line feed 2/72"
13900 FOR L=25 TO 1 STEP -1:LPRINT USING "| ##";L;:NEXT L:LPRINT
14000 LPRINT CHR$(15)CHR$(27)CHR$(48);'compressed;1/8" lines
14100 IF A=1 THEN LPRINT:LPRINT "In the above chart each block represents a character (pel).":GOTO 14400
14200 LPRINT:LPRINT "In the above chart each block represents a character (pel). The upper number is the address of the character, the lower is the
14300 LPRINT "address of the attribute. To access these bytes in BASIC, use the instruction DEF SEG=&HB800 then PEEK(n) or POKE n,data.
14400 LPRINT CHR$(12);:ON ERROR GOTO 0:RUN
14500 C=80:R=25
14600 LPRINT CHR$(27)CHR$(64)CHR$(15)CHR$(27)CHR$(48)'reset;compressed;1/8" lines
14700 IF A=3 THEN LPRINT "Blank layout for screen graphics for the IBM Personal Computer Color Graphics Adapter Card in the 80 column width mode.":LPRINT:GOTO 14900
14800 LPRINT "Memory map of the screen graphics RAM for the IBM Personal Computer Color Graphics Adapter Card in the 80 column width A/N mode.":LPRINT
14900 LPRINT CHR$(27)CHR$(45)CHR$(1);:FOR L=25 TO 1 STEP -1:LPRINT USING "| ##";L;:NEXT L:LPRINT CHR$(27)CHR$(45)CHR$(0);'underlined
15000 LPRINT CHR$(27)CHR$(65)CHR$(1)'1/72" lines
15100 FOR P=1 TO 5:LPRINT :NEXT P
15200 FOR M=1 TO C
15300 FOR N=1 TO R+1:LPRINT CHR$(156);:LPRINT STRING$(4," ");:NEXT N:LPRINT
15400 LPRINT CHR$(27)CHR$(83)CHR$(1);'subscript
15500 IF A=3 THEN FOR L=0 TO R-1 STEP 1:LPRINT " ";:NEXT L:LPRINT USING " ##";M:GOTO 15700
15600 FOR L=0 TO R-1 STEP 1:LPRINT USING " ####";(2*C*(R-L))-(2*C-2*M+1)-1;:NEXT L:LPRINT USING " ##";M
15700 LPRINT CHR$(27)CHR$(84)CHR$(27)CHR$(72);'cancel script; cancel double strike
15800 LPRINT CHR$(27)CHR$(45)CHR$(1);'underline
15900 FOR N=1 TO R+1:LPRINT CHR$(156);:LPRINT STRING$(4," ");:NEXT N:LPRINT "_"
16000 LPRINT CHR$(27)CHR$(45)CHR$(0);'cancel underline
16100 LPRINT CHR$(27)CHR$(83)CHR$(0);'superscript
16200 FOR P=1 TO 5:LPRINT:NEXT P
16300 LPRINT CHR$(27)CHR$(84)CHR$(27)CHR$(72);'cancel script; cancel double strike
16400 NEXT M
16500 FOR P=1 TO 6:LPRINT:NEXT P
16600 LPRINT CHR$(15)CHR$(27)CHR$(48);'reset;compressed;1/8" lines
16700 FOR L=R TO 1 STEP -1:LPRINT USING "| ##";L;:NEXT L:LPRINT
16800 IF A=3 THEN LPRINT:LPRINT "In the above chart each block represents a character (pel).":GOTO 17100
16900 LPRINT:LPRINT "In the above chart each block represents a character (pel). The number is the address of the character, add one to this number for
17000 LPRINT "the address of the attribute. To access these bytes in BASIC, use the instruction DEF SEG=&HB800 then PEEK(n) or POKE n,data.
17100 LPRINT CHR$(12);:ON ERROR GOTO 0:RUN
17200 ' SAVE"scnmap.bas",a
SQUISHER.BAS
10 DEF FNI$(A$)=CHR$(ASC(LEFT$(A$,1))+32*(LEFT$(A$,1)>"Z")):DEFINT B-K,S-Z:A=0:AZ=0:A$="":C$="":D=0:DS=100:DT=0:G1=0:G2=0:G3=0:G4=0:G5=0:G6=0:HH=0:I$="":IP$="":J$="":LN=0:L$="":L1$="":N$="":P=0:PJ=0:PP=0:PV=0:Q$="":R=0:RD=0:RE=0:S=0:S1=0
20 SD=0:SQ$="":SV$="":T=0:T1=0:T2=0:V$="":X=0:XC$="":XS$="":XP$="":ZC=0:DIM REF(DS*2),PRO(DS):SCREEN 0,0,0:WIDTH 80:COLOR 11,0:KEY OFF:CLS:LINE INPUT"ENTER THE NAME OF THE PROGRAM TO BE SQUISHED: ";SQ$
30 XS$="N":IP$="N":XC$="N":XP$="N":PRINT:LINE INPUT"ENTER THE NAME FOR THE FINAL SQUISHED PROGRAM: ";SV$:PRINT:LINE INPUT"WOULD YOU LIKE EXTRA SPACES DELSTED? (Y/N) ";XS$:IF XS$="" THEN XS$="N"
40 PRINT:LINE INPUT"WOULD YOU LIKE REM STATEMENTS DELETED? (Y/N) ";IP$:IF IP$="" THEN IP$="N"
50 PRINT:LINE INPUT"WOULD YOU LIKE TO COMBINE LINES? (Y/N) ";XC$:IF XC$="" THEN XC$="N"
60 PRINT:LINE INPUT "WOULD YOU LIKE TO PROTECT ANY LINES? (Y/N) ";XP$:IF XP$="" THEN XP$="N"
70 ON ERROR GOTO 560:XS$=FNI$(XS$):IP$=FNI$(IP$):XC$=FNI$(XC$):XP$=FNI$(XP$)
80 IF XS$="N" AND IP$="N" AND XC$="N" AND XP$="N" THEN RUN
90 IF XP$="Y" THEN INPUT"ENTER LINE NUMBER TO PROTECT (0 TO EXIT) ";PRO(PV):IF PRO(PV)>0 AND PV<DS THEN PV=PV+1: GOTO 90
100 OPEN SQ$ FOR INPUT AS #1
110 IF EOF(1) THEN 240
120 LINE INPUT #1,A$:IF ASC(A$)>58 THEN COLOR 12,0:PRINT:PRINT"**** '";SQ$;"` IS NOT AN ASCII FILE ***":PRINT:COLOR 11,0:END
130 G1=1:G2=1:G3=1:G4=1:G5=1:G6=1
140 D=4:T=INSTR(G1,A$,"THEN"):IF T THEN G1=T+D:GOTO 210
150 T=INSTR(G2,A$,"GOTO"):IF T THEN G2=T+D:GOTO 210
160 T=INSTR(G3,A$,"ELSE"):IF T THEN G3=T+D:GOTO 210
170 T=INSTR(G4,A$,"GOSUB"):IF T THEN D=5:G4=T+D:GOTO 210
180 T=INSTR(G5,A$,"RESUME"):IF T THEN D=6:G5=T+D:GOTO 210
190 T=INSTR(G6,A$,"RUN"):IF T THEN D=3:G6=T+D:GOTO 210
200 GOTO 110
210 A=VAL(MID$(A$,T+D)):IF A THEN FOR HH=1 TO R:IF REF(HH)<>A THEN NEXT:R=R+1:REF(R)=A
220 IF A>0 THEN T=T+D:D=1:T1=INSTR(T,A$,","):T2=INSTR(T,A$,":"):IF T1>0 AND (T2=0 OR T1<T2) THEN T=T1:GOTO 210
230 GOTO 140
240 CLOSE:FOR S=1 TO R:FOR S1=S TO R:IF REF(S)<REF(S1) THEN SWAP REF(S),REF(S1)
250 NEXT S1,S:FOR S=0 TO PV:FOR S1=S TO PV:IF PRO(S)>PRO(S1) THEN SWAP PRO(S),PRO(S1)
260 NEXT S1,S:OPEN SQ$ FOR INPUT AS #1:OPEN SV$ FOR OUTPUT AS #2:CLS
270 IF EOF(1) THEN 380
280 LINE INPUT #1,A$:FOR HH=INSTR(A$," ") TO LEN(A$)-1:IF MID$(A$,HH+1,1)=" " THEN NEXT
290 PP=HH:X=PP:LN=VAL(A$):LOCATE 1,1:COLOR 11,0:PRINT"SCANNING LINE:";:COLOR 12,0:PRINT LN:PRINT:PRINT STRING$(255,32):LOCATE 3,1:COLOR 14,0:PRINT A$:LOCATE 8,1:COLOR 11,0:PRINT"SCANNING POSITION : ":PRINT
300 PRINT"NUMBER OF LINES COMBINED:";:COLOR 12,0:PRINT RE:COLOR 11,0:PRINT:PRINT"NUMBER OF SPACES DELETED:";:COLOR 12,0:PRINT SD:COLOR 11,0:PRINT:PRINT"NUMBER OF REM STATEMENTS DELETED:";:COLOR 12,0:PRINT RD:COLOR 11,0:GOTO 410
310 IF XC$<>"Y" THEN PRINT #2,A$:GOTO 270
320 IF C$="" THEN C$=A$:GOTO 270
330 IF R>0 THEN IF LN=REF(R) THEN R=R-1:GOTO 370 ELSE IF LN>REF(R) THEN R=R-1:GOTO 330
340 IF INSTR(C$,"IF") OR INSTR(C$,"RETURN") THEN 370
350 V$=RIGHT$(A$,LEN(A$)-X):IF LEN(C$)+LEN(V$)<240 THEN C$=C$+":"+V$:RE=RE+1 ELSE 370
360 GOTO 270
370 PRINT #2,C$:C$=A$:GOTO 270
380 PRINT #2,C$:CLOSE:COLOR 12,0:LOCATE 8,19:PRINT T:LOCATE 10,26:PRINT RE:LOCATE 12,26:PRINT SD:LOCATE 14,34:PRINT RD
390 LOCATE 3,1:PRINT STRING$(255,32):LOCATE 3,1:COLOR 14,0:PRINT"PRESS 'L' TO LOAD THE SQUISHED PROGRAM":SOUND 1000,6:SOUND 660,5:COLOR 11,0
400 Q$=INKEY$:IF Q$="" THEN 400 ELSE CLS:IF Q$="L" THEN LOAD SV$ ELSE END
410 N$=LEFT$(A$,PP):ZC=160+PP:PP=PP+1:P=0:J$="":DT=0:FOR T=PP TO LEN(A$):L$=MID$(A$,T,1):AZ=INT(ZC/80):LOCATE AZ+1,ZC-AZ*80+1:COLOR 10,0:PRINT MID$(A$,T,1);:ZC=ZC+1:COLOR 12,0:LOCATE 8,19:PRINT T
420 COLOR 11,0:IF L$=CHR$(34) THEN IF P THEN P=0 ELSE P=1
430 IF P THEN 520
440 IF MID$(A$,T,4)="DATA" THEN DT=1 ELSE IF L$=":" THEN DT=0
450 IF DT THEN 520
460 IF L$<>" " OR XS$<>"Y" THEN 500 ELSE IF J$>"" THEN L1$=RIGHT$(J$,1):IF L1$="^" OR (L1$>")" AND L1$<"0") OR (L1$>"9" AND L1$<"A") THEN L$=""
470 L1$="X":IF T<LEN(A$) THEN L1$=MID$(A$,T+1,1)
480 IF L1$="^" OR L1$=CHR$(34) OR L1$=" " OR (L1$>")" AND L1$<"0") OR (L1$>"9" AND L1$<"A") THEN L$=""
490 IF L$="" THEN SD=SD+1
500 IF PV>PJ THEN IF LN=PRO(PH) THEN PJ=PJ+1:GOTO 540 ELSE IF LN>PRO(PJ) THEN PJ=PJ+1
510 IF MID$(A$,T,3)="REM" OR L$="'" THEN IF IP$<>"Y" THEN A$=N$+J$+MID$(A$,T,255):GOTO 540 ELSE RD=RD+1:IF LN=REF(R) THEN R=R-1:A$=N$+J$+"'":GOTO 540 ELSE IF J$="" THEN 270 ELSE 530
520 J$=J$+L$:NEXT:IF P THEN J$=J$+CHR$(34)
530 A$=N$+J$:GOTO 310
540 IF C$<>"" THEN PRINT #2,C$:C$=""
550 PRINT #2,A$:GOTO 270
560 IF ERR=53 THEN RUN ELSE ON ERROR GOTO 0
SQUISHER.DOC
COMPRESSES BASIC PROGRAMS BY REMOVING UNNECESSARY SPACES, REMARKS AND COMBINING
LINES.
PROGRAM MUST BE STORED IN ASCII FIRST.
STARTBAS.BAS
10 REM Listing from PC World, vol 1, #6, p 254 (*.*)
20 REM Easily modified to skip the instructions at the begining
25 REM by having CLS: Files "*.BAS" then skipping to 170
30 REM Allows you to view the basic programs on your disk and easily
40 REM select one to run.
100 PRINT "This program displays all basic files on the selected disk."
110 PRINT "One program will be in reverse video. Press <- to chain to it."
120 PRINT "Position the selected program with the cursor control keys."
130 PRINT "Press E to end, B to select Drive B, or other key to continue.
140 K$=INPUT$(1): IF K$="E" OR K$="e" THEN END
150 IF K$="B" OR K$="b" THEN B=1
160 CLS: IF B=1 THEN FILES "B:*.BAS" ELSE FILES "*.BAS"
170 Y=1: X=0
180 COLOR 0,7
190 FOR L=1 TO 12 'HIGHLITES THE PROGRAM NAME AT LOCATION Y,X
200 LOCATE Y,X+L
210 C$=CHR$(SCREEN (Y,X+L))
220 PRINT C$: F$=F$+C$
230 NEXT
240 COLOR 7,0
250 K$=INKEY$: IF LEN(K$)=0 THEN 250 'WAIT FOR KEYSTROKE
260 IF LEN(K$)=2 THEN 300 'EXTENDED CHARACTER
270 IF ASC(K$)=13 THEN 360 'ENTER
280 IF ASC(K$)=27 THEN STOP 'ESCAPE
290 GOTO 250
300 R$=RIGHT$(K$,1): A=ASC(R$)
310 IF A=72 AND Y>1 THEN GOSUB 370: Y=Y-1: GOTO 180 ' UP CURSOR
320 IF A=80 AND Y<23 THEN GOSUB 370: Y=Y+1: GOTO 180 'DOWN CURSOR
330 IF A=75 AND X>12 THEN GOSUB 370: X=X-13: GOTO 180 'LEFT CURSOR
340 IF A=77 AND X<59 THEN GOSUB 370: X=X+13: GOTO 180 'RIGHT CURSOR
350 GOTO 250
360 CLS: IF B=1 THEN CHAIN "B:"+F$ ELSE CHAIN F$
370 FOR L=1 TO 12 ' REMOVES HIGHLITE
380 LOCATE Y,X+L: PRINT CHR$(SCREEN (Y,X+L))
390 NEXT: F$=LEFT$(F$,0)
400 RETURN
TRACE.BAS
105 ' ********* BASIC version of RatBas program *********
110 DEFINT I-N
180 '
185 GOTO 25000 ' Jump to program
200 '------------------------ PROCEDURE ERROR
205 '
210 ' This procedure handles errors, including operator input error
215 '
220 IERROR=TRUE
225 SOUND 800,20
230 PRINT
235 COLOR 23,0
240 PRINT "E";
245 COLOR 7,0
250 ' CASE ERR OF
255 IF ( ERR =13) THEN ELSE GOTO 280
260 PRINT "* You have entered an invalid character, please ";
263 PRINT" check"
265 PRINT" your entry."
270 RESUME NEXT
275 GOTO 575
280 IF ( ERR =24) THEN ELSE GOTO 310
285 PRINT"* The printer is unavailable, Please check and";
287 PRINT"press any "
290 PRINT" key to continue: ":AN$=INPUT$(1)
295 IERROR=FALSE
300 RESUME
305 GOTO 575
310 IF ( ERR =27) THEN ELSE GOTO 340
315 PRINT"* The printer is out of paper, Please check and";
317 PRINT"press any "
320 PRINT" key to continue: ":AN$=INPUT$(1)
325 IERROR=FALSE
330 RESUME
335 GOTO 575
340 IF ( ERR =53) THEN ELSE GOTO 360
345 PRINT"* File does not currently exist."
350 RESUME NEXT
355 GOTO 575
360 IF ( ERR =55) THEN ELSE GOTO 380
365 PRINT"* File is already open, processing halted."
370 END
375 GOTO 575
380 IF ( ERR =61) THEN ELSE 405
385 PRINT"* Disk is full, insert new formated disk and";
387 PRINT" re-run program."
390 PRINT" Processing halted."
395 END
400 GOTO 575
405 IF ( ERR =67) THEN ELSE GOTO 435
410 PRINT"* Too many files are on the disk."
415 PRINT" Insert new formated disk and re-run program."
420 PRINT" Processing halted."
425 END
430 GOTO 575
435 IF ( ERR =71) THEN ELSE GOTO 465
440 PRINT"* The drive door is open, pleasse close."
445 PRINT" Press any key when ready. ":AN$=INPUT$(1)
450 IERROR=FALSE
455 RESUME
460 GOTO 575
465 IF ( ERR =200) THEN ELSE GOTO 485
470 PRINT"* This is an invalid drive spec, please re-enter."
475 RESUME NEXT
480 GOTO 575
485 IF ( ERR =201) THEN ELSE GOTO 510
490 PRINT"* This is an invalid filenumber, please enter a";
493 PRINT" number."
495 PRINT" between 0 and 13, inclusive."
500 RESUME NEXT
505 GOTO 575
510 IF ( ERR =202) THEN ELSE GOTO 530
515 PRINT"* You have already specified a disk drive, please";
517 PRINT" re-enter."
520 RESUME NEXT
525 GOTO 575
530 IF (ERR =203) THEN ELSE GOTO 555
535 PRINT"* This isan invalid NUMBER, please enter a number";
537 PRINT" between"
540 PRINT" 10 and 59999, inclusive."
545 RESUME NEXT
550 GOTO 575
555 ' OTHERWISE
560 PRINT"* An unexpected error #";ERR;" has occurred in";
563 PRINT" line #";ERL;"."
565 PRINT" Processing halted."
570 END
575 ' CEND
580 RESUME NEXT ' ---------------------
22637 5 '
24531 IF LEN(DRV$)=2 THEN DRV$=LEFT$(DRV$,1)
25000 ' =================== PROCEDURE LOCATIONS ===========
25005 ' 200 ERROR
25010 ' ================== PROGRAM ========================
25015 FALSE = 0: TRUE = NOT FALSE
25020 ON ERROR GOTO 200
25025 '
25030 ' Constants:
25035 '
25040 DEFAULT.DRV$="E"
25045 DEFAULT.FILENAME$="DTEST"
25050 DEFAULT.EXT$="BAS"
25055 DEFAULT.FIRST=10
25060 DEFAULT.LAST!=59999!
25065 EOL$=CHR$(13)+CHR$(10)
25070 '
25075 ' Logo
25080 '
25085 CLS
25090 KEY OFF
25095 LOCATE 4,24
25100 COLOR 0,7
25105 PRINT" Single Step and Trace Facility "
25110 COLOR 7,0
25115 LOCATE 6,38
25120 PRINT "by"
25125 LOCATE 8,34
25130 PRINT "D. Z. Korkut"
25135 LOCATE 10,33
25140 PRINT "version 1.1"
25145 FOR I=1 TO 10000
25150 NEXT
25155 CLS
25160 '
25165 ' Ask about the program to be traced
25170 '
25175 LOCATE 2,25
25180 COLOR 0,7
25185 PRINT " *** IMPORTANT *** "
25190 COLOR 7,0
25195 LOCATE 5,1
25200 PRINT"1) Have you renumbered the program to be traced so";
25201 PRINT" that all line"
25205 PRINT" numbers are between 10 and 59999, inclusive?"
25210 PRINT
25215 PRINT"2) Is there at least one vacant line number between";
25216 PRINT" each line"
25220 PRINT" (i.e. did you use an increment of at least 2 when";
25221 PRINT" renumbering)?"
25225 PRINT
25230 PRINT"3) Did you save the program to be traced in ASCII";
25231 PRINT" format?"
25235 PRINT
25240 PRINT"4) If there are <n> files in the program to be";
25241 PRINT" traced, did you "
25245 PRINT" initialize BASIC with enough memory for <n+2>";
25246 PRINT" files?"
25250 PRINT
25255 PRINT"5) Does the program to be traced have any variables";
25256 PRINT" of the form"
25260 PRINT" <vname>.. (i.e. variable names with 2 trailing";
25261 PRINT" periods)? If so,"
25265 PRINT" change them."
25270 PRINT
25275 PRINT
25280 PRINT"If you have not done these items, then press 'e' for";
25281 PRINT" exit else press"
25285 PRINT" any other key to continue: ";
25290 ANS$=INPUT$(1)
25295 IF LEFT$(ANS$,1)="e" OR LEFT$(ANS$,1)="E" THEN END
25300 CLS
25305 '
25310 ' Operator entry
25315 '
25320 LOCATE 12,1
25325 IERROR=TRUE
25330 WHILE IERROR=TRUE
25335 CLS
25340 IERROR=FALSE
25345 LOCATE 12,10
25350 PRINT"Please enter the last file number used by the";
25351 PRINT" program to be"
25355 LOCATE 13,10
25360 INPUT" traced: ",FILENO$
25365 FILENO%=VAL(FILENO$)
25370 IF FILENO%<0 OR FILENO%>13 THEN ELSE GOTO 25390
25375 ERROR 201
25380 FOR I=1 TO 10000
25385 NEXT
25390 ' IFEnd]
25395 WEND
25400 '
25405 IERROR=TRUE
25410 WHILE IERROR=TRUE
25415 CLS
25420 IERROR=FALSE
25425 LOCATE 12,10
25430 PRINT"Please enter the drive where files will be read";
25431 INPUT" and written: ",DRV$
25432 IF LEN(DRV$)=2 THEN DRV$=LEFT$(DRV$,1)
25435 IF DRV$="" THEN DRV$=DEFAULT.DRV$
25440 IF INSTR("abcdeABCDE",LEFT$(DRV$,1))=0 THEN ELSE GOTO 25460
25445 ERROR 200
25450 FOR I=1 TO 10000
25455 NEXT
25460 ' IFEnd]
25465 WEND
25470 FLN$=STR$(FILENO%+1)
25475 FLN2$=STR$(FILENO%+2)
25480 '
25485 IERROR=TRUE
25490 WHILE IERROR=TRUE
25495 CLS
25500 IERROR=FALSE
25505 LOCATE 12,10
25510 PRINT"Please enter the filename (and extension if you";
25511 PRINT" wish) of"
25515 INPUT" the program file you wish to trace: ",ANS$
25520 ANS$=LEFT$(ANS$,12)
25525 DELIMIT%=INSTR(ANS$,".")
25530 IF INSTR(ANS$,":")<>0 THEN ELSE GOTO 25545
25535 ERROR 202
25540 GOTO 25605
25545 ' ELSE]
25550 IF DELIMIT%=0 THEN ELSE GOTO 25570
25555 IF ANS$="" THEN FILENAME$=DEFAULT.FILENAME$ ELSE FILENAME$=ANS$
25560 EXT$=DEFAULT.EXT$
25565 GOTO 25590
25570 ' ELSE]
25575 FILENAME$=LEFT$(ANS$,DELIMIT%-1)
25580 EXT$=RIGHT$(ANS$,LEN(ANS$)-DELIMIT%)
25585 EXT$=LEFT$(EXT$,3)
25590 ' IFEnd]
25595 INPUT.FILESPEC$=DRV$+":"+FILENAME$+"."+EXT$
25600 OPEN INPUT.FILESPEC$ FOR INPUT AS #1
25605 ' IFEnd]
25610 IF IERROR=TRUE THEN ELSE GOTO 25625
25615 FOR I=1 TO 10000
25620 NEXT
25625 ' IFEnd]
25630 WEND
25635 '
25640 IERROR=TRUE
25645 WHILE IERROR=TRUE
25650 CLS
25655 IERROR=FALSE
25660 LOCATE 12,10
25665 PRINT"Please enter the line of the program to be traced";
25666 PRINT" where you want"
25670 INPUT" debug statements to start: ",FIRST$
25675 FIRST=VAL(FIRST$)
25680 IF IERRROR=FALSE THEN ELSE GOTO 25715
25685 IF FIRST=0 THEN FIRST=DEFAULT.FIRST
25690 IF FIRST<10 OR FIRST>59999! THEN ELSE GOTO 25710
25695 ERROR 203
25700 FOR I=1 TO 10000
25705 NEXT I
25710 ' IFEnd]
25715 ' IFEnd]
25720 WEND
25725 '
25730 IERROR=TRUE
25735 WHILE IERROR=TRUE
25740 CLS
25745 IERROR=FALSE
25750 LOCATE 12,10
25755 PRINT"Please enter the line of the program to be traced";
25756 PRINT" where you want"
25760 INPUT" debug statements to end: ",LAST$
25765 LAST!=VAL(LAST$)
25770 IF IERROR =FALSE THEN ELSE GOTO 25805
25775 IF LAST!=0 THEN LAST!=DEFAULT.LAST!
25780 IF LAST!<10 OR LAST!>59999! THEN ELSE GOTO 25800
25785 ERROR 203
25790 FOR I=1 TO 10000
25795 NEXT I
25800 ' IFEnd]
25805 ' IFEnd]
25810 WEND
25815 IF FIRST>LAST! THEN SWAP FIRST,LAST!
25820 '
25825 OUTPUT.FILESPEC$=DRV$+":"+FILENAME$+"."+"DBG"
25830 OPEN OUTPUT.FILESPEC$ FOR OUTPUT AS #2
25835 '
25840 ' Print the first line in the debug version
25845 '
25850 PRINT #2,"1 cls:key off:open ";CHR$(34);DRV$;":TRACE.DBG";
25851 PRINT #2,CHR$(34);
25855 PRINT #2," for output as #";FLN$;":pr..%=0:pr..$=";CHR$(34);
25856 PRINT #2,CHR$(34);
25860 PRINT #2,":ns..%=0:vs..%=0:eol..$=chr$(13)+chr$(10)";EOL$;
25865 '
25870 ' Record the range where debug statements exist in the output file
25875 '
25880 PRINT #2,"2 first..!=";FIRST;":last..!=";LAST!;EOL$;
25885 '
25890 ' Ask for the trace range
25895 '
25900 PRINT #2,"3 gosub 63010"
25905 '
25910 PRINT #2,"5 ' ************* BEGIN DEBUG *************";EOL$;
25915 '
25920 ' Read each line of the input file, derive the line number
25925 ' and write to the output file
25930 '
25935 CLS
25940 WHILE NOT EOF(1)
25945 LINE INPUT#1,TEXT$
25950 PRINT #2,TEXT$;EOL$;
25955 SPC.LOC=INSTR(TEXT$," ")
25960 IF SPC.LOC=1 THEN SPC.LOC=INSTR(2,TEXT$," ")
25965 LN$=LEFT$(TEXT$,SPC.LOC)
25970 LN!=VAL(LN$)
25975 IF LN!>=FIRST AND LN!<=LAST! THEN ELSE GOTO 26000
25980 PRINT #2,STR$(LN!+1);" ln..!=";LN$;":gosub 60010";EOL$;
25985 MID$(TEXT$,SPC.LOC,1)="*"
25990 PRINT TEXT$
25995 GOTO 26010
26000 ' ELSE]
26005 PRINT TEXT$
26010 ' IFEnd]
26015 WEND
26020 '
26025 ' Write the debug module on the end of the input file
26030 '
26035 PRINT #2,"60000 end";EOL$;
26040 '
26045 PRINT #2,"60010 if ln..!<begin..! or ln..!>stop..! then";
26046 PRINT #2," return";EOL$;
26050 '
26055 PRINT #2,"60015 print p..$";CHR$(34);" [";CHR$(34);
26060 PRINT #2,"ln..!";CHR$(34);"]";CHR$(34);EOL$;
26065 '
26070 PRINT #2,"60020 if pr..% then print #";FLN$;",";CHR$(34);
26071 PRINT #2," [";CHR$(34);
26075 PRINT #2,"ln..!";CHR$(34);"]";CHR$(34);EOL$;
26080 '
26085 PRINT #2,"60030 if vs..% then gosub 62000";EOL$;
26090 '
26095 PRINT #2,"60040 if ns..% then a..$=inkey$:if a..$<>";
26096 PRINT #2,CHR$(34);" ";CHR$(34);
26100 PRINT #2," then return else ns..%=0";EOL$;
26105 '
26110 PRINT #2,"60050 a..$=input$(1)";EOL$;
26115 '
26120 PRINT #2,"60055 if a..$=";CHR$(34);"D";CHR$(34);
26125 PRINT #2," or a..$=";CHR$(34);"d";CHR$(34);
26130 PRINT #2," then pr..%=-1:p..$=";
26135 PRINT #2,CHR$(34);"D*";CHR$(34);"gosub 63500";EOL$;
26140 '
26145 PRINT #2,"60060 if a..$=";CHR$(34);"P";CHR$(34);
26150 PRINT #2," or a..$=";CHR$(34);"p";CHR$(34);
26155 PRINT #2," then pr..%=-1:p..$=";
26160 PRINT #2,CHR$(34);"P*";CHR$(34);":gosub 63600";EOL$;
26165 '
26170 PRINT #2,"60070 if a..$=";CHR$(34);"N";CHR$(34);
26175 PRINT #2," or a..$=";CHR$(34);"n";CHR$(34);
26180 PRINT #2," then ns..%=-1";EOL$;
26185 '
26190 PRINT #2,"60080 if a..$=";CHR$(34);"V";CHR$(34);
26195 PRINT #2," or a..$=";CHR$(34);"v";CHR$(34);
26200 PRINT #2," then vs..%=-1";EOL$;
26205 '
26210 PRINT #2,"60090 if a..$=";CHR$(34);"R";CHR$(34);
26215 PRINT #2," or a..$=";CHR$(34);"r";CHR$(34);
26220 PRINT #2," then ns..%=0:pr..%=0:vs..%=0:";
26225 PRINT #2,"p..$=";CHR$(34);CHR$(34);EOL$;
26230 '
26235 PRINT #2,"60100 if a..$=";CHR$(34);"C";CHR$(34);
26240 PRINT #2," or a..$=";CHR$(34);"c";CHR$(34);
26245 PRINT #2," then gosub 61120";EOL$;
26250 '
26255 PRINT #2,"60105 if a..$=";CHR$(34);"T";CHR$(34);
26260 PRINT #2," or a..$=";CHR$(34);"t";CHR$(34);
26265 PRINT #2," then gosub 63010";EOL$;
26270 '
26275 PRINT #2,"60110 return";EOL$;
26280 '
26285 PRINT #2,"61120 vln..!=62010";EOL$;
26290 '
26295 PRINT #2,"61130 open ";CHR$(34);DRV$;":";"variable.mrg";
26296 PRINT #2,CHR$(34);" for ";
26300 PRINT #2,"output as #";FLN2$;EOL$;
26305 '
26310 PRINT #2,"61140 print #";FLN2$;",";CHR$(34);"62000 rem";
26311 PRINT #2,CHR$(34);";eol..$";
26315 PRINT #2,EOL$;
26320 '
26325 PRINT #2,"61150 input";CHR$(34);"Enter variable name: ";
26326 PRINT #2,CHR$(34);",vb..$";
26330 PRINT #2,EOL$;
26335 '
26340 PRINT #2,"61160 if vb..$=";CHR$(34);CHR$(34);
26341 PRINT #2," then goto 61230";EOL$;
26345 '
26350 PRINT #2,"61170 vln..!=vln..!+10";EOL$;
26355 '
26360 PRINT #2,"61180 print #";FLN2$;",str$(vln..!);";CHR$(34);
26361 PRINT #2," print p..$;";
26365 PRINT #2,CHR$(34);";chr$(34);vb..$;";CHR$(34);"=";CHR$(34);
26370 PRINT #2,";chr$(34);vb..$;eol..$;";EOL$;
26380 PRINT #2,"61190 vln..!=vln..!+10";EOL$;
26385 '
26390 PRINT #2,"61200 print #";FLN2$;",str$(vln..!);";CHR$(34);
26391 PRINT #2," if pr..% then ";
26395 PRINT #2," print #";FLN$;",";CHR$(34);";chr$(34);vb..$;";
26396 PRINT #2,CHR$(34);"=";
26400 PRINT #2,CHR$(34);";chr$(34);vb..$;eol..$;";EOL$;
26405 '
26410 PRINT #2,"61210 vln..!=vln..!+10";EOL$;
26415 '
26420 PRINT #2,"61220 goto 61150";EOL$;
26425 '
26430 PRINT #2,"61230 print #";FLN2$;",";CHR$(34);"63000 return";
26431 PRINT #2,CHR$(34);
26435 PRINT #2,";eol..$;";EOL$;
26440 '
26445 PRINT #2,"61240 close #";FLN2$;EOL$;
26450 '
26455 PRINT #2,"61250 chain merge ";CHR$(34);DRV$;":";
26456 PRINT #2,"variable.mrg";
26460 PRINT #2,CHR$(34);",ln..!+1,all,delete 62000-63000";EOL$;
26465 '
26470 PRINT #2,"61260 return";EOL$;
26475 '
26480 PRINT #2,"62000 rem";EOL$;
26485 PRINT #2,"63000 return";EOL$;
26490 '
26495 PRINT #2,"63010 input";CHR$(34);"Please enter the line";
26496 PRINT #2," number where";
26500 PRINT #2," the trace ";
26505 PRINT #2,"will begin: ";CHR$(34);",an..$:if (val(an..$)<10";
26506 PRINT #2," or val(an..$)";
26510 PRINT #2,">59999) and an..$<>";CHR$(34);CHR$(34);
26515 PRINT #2," then print";CHR$(34);"Invalid entry!";CHR$(34);
26520 PRINT #2,":goto 63010 else if an..$=";CHR$(34);CHR$(34);
26521 PRINT #2," then begin..!=";
26525 PRINT #2,"first..! else begin..!=val(an..$)";EOL$;
26530 '
26535 PRINT #2,"63020 input";CHR$(34);"Please enter the line";
26536 PRINT #2," number where";
26540 PRINT #2," the trace ";
26545 PRINT #2,"will stop: ";CHR$(34);",an..$:if (val(an..$)<10";
26546 PRINT #2," or val(an..$)";
26550 PRINT #2,">59999) and an..$<>";CHR$(34);CHR$(34);
26555 PRINT #2," then print";CHR$(34);"Invalid entry!";CHR$(34);
26560 PRINT #2,":goto 63010 else if an..$=";CHR$(34);CHR$(34);
26561 PRINT #2," then stop..!=";
26565 PRINT #2,"last..! else stop..!=val(an..$)";EOL$;
26570 '
26575 PRINT #2,"63030 if begin..!>stop..! then swap";
26576 PRINT #2," begin..!,stop..!";EOL$;
26580 '
26585 PRINT #2,"63040 return";EOL$;
26590 '
26595 PRINT #2,"63500 close #";FLN$;EOL$;
26600 '
26605 PRINT #2,"63510 open ";CHR$(34);DRV$;":";"trace.dbg";
26606 PRINT #2,CHR$(34);
26610 PRINT #2," for append as #";FLN$;EOL$;
26615 '
26620 PRINT #2,"63520 return";EOL$;
26625 '
26630 PRINT #2,"63600 close #";FLN$;EOL$;
26635 '
26640 PRINT #2,"63610 open ";CHR$(34);"lpt1:";CHR$(34);
26641 PRINT #2," for output as #";FLN$;EOL$;
26650 '
26655 PRINT #2,"63620 return";EOL$;
26660 '
26665 ' Ask if to continue
26670 '
26675 CLOSE
26680 PRINT
26685 PRINT
26690 INPUT"Do you wish to run the trace version of your program";ANS$
26695 ANS$=LEFT$(ANS$,1)
26700 IF ANS$="Y" OR ANS$="y" THEN RUN DRV$+":"+FILENAME$+"."+"dbg"
26705 END
TRACE.DOC
August 6, 1984
SINGLE-STEPPING AND TRACING
A simple program called TRACE that helps debug BASIC programs.
D. Z. KORKUT
Programmers often want to trace Basic programs without losing the
result of the trace, which they can't necessarily do with the TRON
command. They also often want to single-step through a program,
observing the value of variables. There are currently no commands that
allow single-stepping. What's a programer to do? Try TRACE.
TRACE is a simple BASIC program that reads an ASCII version of a
program. It then produces a version of the program with trace
statements inserted between lines. This trace version allows the
programer to:
1. Single-step using the space bar.
2. Print the trace using a line printer.
3. Print the trace on a disk to be viewed with an editor.
4. Spcify where the trace is to start and end.
5. Specify variable names to be traced.
When TRACE reads a line of the input program, it determines the
line number and then writes that line, plus an extra line, to the output
file. The extra line contains a trace statement, which consists of a
variable-assignment statement that stores the line number in a variable,
and a GOSUB statement, which jumps to a subroutine that TRACE appends to
the end of the output program file. The subroutine contains code that
interprets commands issued while running the trace version of the
program. The program file is not modified.
RUNNING TRACE
TRACE produces an executable BASIC program, so there are some
limitations involved. The first thing TRACE will do is to remind the
user of these limitations:
1. Since TRACE will insert lines between the lines of the program, it
is important that the program be renumbered such that there is at
least one vacant line number between each line. TRACE also appends
a small module to the beginning and end of the program, so no line
numbers less than 10 or greater than 59999 can be used. I
recommend that command RENUM 10,5 be used.
2. Remember to save the program in ASCII format. This is important.
3. The trace version of the program will use two disk files. Remember
to initialize BASIC with enough file buffer memory to handle the
program's files plus two extra files.
4. The modules that TRACE appends use variable names with two trailing
periods (i.e., <name>..).
5. Do not use the CLOSE statement in the program without specifying a
file number; doing so will cause the files required by the trace
modules to be closed.
After confirming that these requirements have been met, TRACE will
ask some questions. The user must enter the last file number used by
his program, so TRACE will know which file numbers to use. A null entry
will be assumed to mean that the program does not use files. Next, the
drive where the program file resides must be entered. The trace version
of the program will be written on this drive. A null entry will be
assumed to mean drive B.
Enter the file name of the program next, including an extension if
desired. If no extension is provided, one of .BAS is asssumed. Then
enter the line where trace statements should start. Since for large
programs the overhead created by TRACE will be large, it may be
desirable to insert trace statements only on a fixed range of
statements. A null entry will be taken to mean that trace statements
should start at the first line of the program. After this, enter the
line where trace statements should stop. A null entry will be assumed
to mean that trace statements should stop at the end of the program.
Next, TRACE will list each line of the program file. An "*" will
appear after each line number where a trace statement has been added.
When the list is finished, TRACE will ask if the user wishes to run the
trace version of the program. If the user says yes, the trace version
will automatically be loaded and executed. If the user elects to run
the trace version later, it is stored with the same file name of the
input program, but with an extension of ".DBG".
COMMANDS AVAILABLE WHILE RUNNING A TRACED PROGRAM
When the trace version of the program is executed, the user must
first enter where tracing should begin and end. If trace statements
have been added to every line of the program, every line may be traced
selectively, one block at a time. If, because of lack of memory, trace
statements were inserted on only part of the program, any block of
statements in that part may be traced. For example, if a user decided
to insert trace statements beginning with line 1000 and ending with line
5000, when he ran the trace version of the program he could selectively
trace any block of statements between lines 1000 and 5000 inclusive. A
null entry to these first two prompts will be assumed to mean that all
lines should be traced with trace statements.
After the first two prompts are answered, the trace version of the
program will execute normally until a trace statement is encountered.
It will then display, in brackets, the number of the line that was just
executed, after which it will pause, waiting for one of these commands:
<space bar> - single-step to the next statement.
D - single-step to the next statement and start dumping the trace
toa file named TRACE.DBG. The line numbers displayed on the CRT will
now be dumped to the disk file beginning with the current line. Line
numbers on the CRT will be displayed with a "D*" prefix. This is to
remind the user that the trace is dumping to disk.
P - single-step to the next statement and start dumping the trace
to the line printer. The line numbers displayed on the CRT will now be
printed on the line printer. Line numbers on the CRT will be displayed
with a "P*" prefix as a reminder that the trace is dumping to the line
printer. If TRACE is currently dumping to the disk the disk file will
be closed.
(NOTE: It is impossible to dump to the disk and to the printer at once.)
V - display values of those variables chosen with the C command.
If the trace is dumping to the disk or line printer, the variable values
will also be included.
N - do not single-step; instead, execute (N)onstop. While running
nonstop, the user can press the <space bar> to stop and start execution.
If the trace is dumping to the disk or line printer, the dump will still
continue. Use the R command to resume single-stepping.
R - (R)esets the D, P, V, and N commands. All dumping of the trace
to disk and line printer will halt. Variable values will no longer be
shown on the CRT. If the program is running nonstop, single-step will
resume.
T - allows the user to change the block of statements currently
being traced. This does not affect any other command.
C - allow the user to (C)hange the variables that will be traced.
Variable names should be entered one at a time. If a null variable name
is entered, tracing will continue. The V command can then be used to
begin tracing the new variables.
One word of caution: the C command creates an overlay module that
is CHAIN MERGEd into the traced program. All variable values are
preserved. However, BASIC does not remember if the program was in a
WHILE/WEND or FOR/NEXT loop when the overlay was merged. Thus if the C
command is used while the program is in a loop, an error may result.
Simply type RUN and continue. Although it may be necessary to start
tracing from the beginning, the new trace variables are present. A
simpler solution is to make sure the current line number is not within
any loops before using the C command.
Remember that the trace version of the program is a standard BASIC
program; CTRL-BREAK can be used to halt execution at any time.
RECOMMENDED PROCEDURE FOR DEBUGGING.
To use TRACE as a debugging aid, begin by RENUMbering the program
with line 10 and using an increment of at least two. Then SAVE the
program using the A option, LList the program so that it is always clear
where execution is taking place, and decide (based on the program's
length) which parts of the program need to be traced.
It is helpful in judging how many lines to trace to know the
approximate overhead required by a traced program. It is as follows:
OVERHEAD = 2080 + 1*19 + V*50 BYTES
where 1 equals the number of lines to which trace statements should be
added, and V equals the number of variables to be traced. Thus a 100-
line program with all lines and 10 variables traced needs about 4480
extra bytes in the trace version.
After deciding how much of the program to trace, run TRACE,
answering the questions according to the guidelines above. Then execute
the trace version, being careful to change the traced variables only
while outside any loops. Use the trace commands to perform any
debugging and CTRL-BREAK and EDIT to make any changes; note any such
changes on the program listing.
Next, reload the original program and post all changes made while
debugging. If the trace requires much output, use the D command to dump
it to a disk file. Then use EDLIN in conjunction with the program
listing to review the result of the trace.
TRACE was written using the RATBAS translator (see PC Magazine,
vol. 1, no. 6, p. 121). The listing given is in standard IBM PC BASIC,
generated by the translator, which is , by the way, a great piece of
software.
Using TRACE, programmers will find it easier to trace BASIC
programs and to single-step through programs while observing the values
of the variables. This should result in better programs, achieved less
painfully.
The TRACE.BAS program was resurrected from the from the static
pages of the May 1984 issue of the PC TECH JOURNAL. With only a limited
experience using this program it appears to interrupt the GOSUB-RETURN
function if the "C" command is invoked after a GOSUB command has been
issued. I hope this program proves useful to others and any bugs,
improvements, modifications, or comments will be passed back to me via:
HAL-PC
Roy G. Browning
This disk copy was originally provided by "The Public Library",
the software library of the Houston Area League of PC Users.
Programs are available from the Public Library at $2 per disk
on user-provided disks. To get a listing of the disks in the
Public Library, send a self-addressed, stamped envelope to
Nelson Ford, P.O.Box 61565, Houston, TX 77208.
UN-COMPQ.DOC
TO UNPROTECT A BASIC PROGRAM SAVED WITH THE ,P OPTION ON THE COMPAQ COMPUTER
ENTER UN-COMPQ BEFORE ENTERING BASIC.
UN-NEW.DOC
TO GET BACK A BASIC PROGRAM AFTER ENTERING "NEW":
enter DEF SEG=&HB000 if using a mono display or DEF SEG=&HB800 for color graphic
enter Ctrl-L Ctrl-M
enter POKE 0,12: POKE 1,255
enter Ctrl-K Ctrl-R
enter 0?"+CHR$(34);
NOTE: PRINT THESE INSTRUCTIONS. YOU CAN'T READ THIS FILE WHEN YOU WILL
NEED IT THE MOST.
UNP-IBM.DOC
TO UNPROTECT A BASIC PROGRAM SAVED WITH THE ,P OPTION ON THE IBM PC
ENTER UNP-IBM BEFORE ENTERING BASIC.
Directory of PC-SIG Library Disk #0371
Volume in drive A has no label
Directory of A:\
HIRESCOL BAS 4850 3-05-84 9:13p
MONITOR DQC 27729 12-04-82 12:59a
BASBUG BAS 4302 1-02-84 8:32p
LBAS DOC 4850 12-20-83 6:45p
LBAS EXE 8832 12-20-83 7:18a
DITHRING TXT 1494 9-25-84 5:18p
POKEPEEK TXT 7343 3-11-84 10:53a
COMPRESS BAS 4692 2-26-84 2:03p
COMPRESS DOC 146 2-26-84 2:05p
PAL80 BAS 840 4-29-84 5:10p
KEYIN ASM 2703 11-28-83 9:37a
KEYIN EXE 640 3-05-84 1:23p
SQUISHER BAS 3589 2-26-84 2:33p
SQUISHER DOC 136 2-26-84 2:34p
PROFILE DOC 153 4-10-83 9:46a
UN-NEW DOC 337 2-26-84 3:10p
PROFILE MEM 256 3-27-83 12:37p
CR-LF TXT 622 5-06-84 7:45a
BASCONV BAS 18843 6-11-83 12:41a
BASCONV DOC 4761 6-11-83 12:41a
LBL-SAMP BAS 5120 5-14-83 8:41a
LBL-BAS BAS 2688 5-14-83 8:39a
MONITOR BAS 7296 12-04-82 3:08a
STARTBAS BAS 2048 8-30-83 7:05a
FC BAS 578 3-05-84 8:25p
KB_FLAG BAS 3162 3-05-84 7:42p
COREFIX BAS 1974 3-05-84 7:54p
SCRN-MAP BAS 4753 3-05-84 7:56p
PROFILE BAS 640 11-21-82 6:03p
BASICREF BAS 7936 1-01-80 12:04a
BASICREF DOC 6732 8-17-83 6:45p
UN-COMPQ EXE 1280 8-02-83 8:57a
UNP-IBM EXE 1280 8-02-83 9:01a
UN-COMPQ DOC 119 1-01-84 5:20p
UNP-IBM DOC 109 1-01-84 5:22p
READBAS BAS 5303 5-10-84 10:48a
BASICDOS BAS 15724 10-27-84 12:58a
GS-UNUM6 DOC 17705 1-15-87 12:29p
GS-UNNUM EXE 31309 1-15-87 12:09p
LINEBUG DOC 1632 5-26-84 3:15p
LINEBUG BAS 849 5-26-84 2:52p
TRACE DOC 12033 10-28-84 6:44p
TRACE BAS 12160 10-25-84 4:31p
SAVEBAS COM 256 11-14-84 10:04p
SAVEBAS DOC 2816 11-14-84 10:06p
COMPILER ERR 1924 7-29-84 7:59a
GS-RENUM EXE 20336 1-15-87 12:12p
GS-VAREN EXE 31776 1-15-87 12:20p
FILES371 TXT 3157 1-27-87 6:24p
READ ME 1437 8-27-86 4:31a
50 file(s) 301250 bytes
34816 bytes free