home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpmug
/
cpmug044.ark
/
CRTFM.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
9KB
|
329 lines
REMARK *****************************************\
* CRTFM.BAS CRT MASK FILE MAINTENANCE *\
* 7/31/79 1:20 PM *\
*****************************************
%INCLUDE CURSOR
REMARK ** SPECIAL CHARACTERS FOR CRT POSITIONING DEFINED HERE ** \
THE CODES BELOW ARE NOT CURSOR CONTROL CHARACTERS. THEY \
ARE EQUATE STATEMENTS FOR KEYBOARD ENTRIES, WHICH IN TURN\
TRIGGER CURSOR MOVEMENT(CONTROLLED BY CURSOR.BAS).
UP.CRSR%=15H REMARK CONTROL-U
DOWN.CRSR%=04H REMARK CONTROL-D
HOME.CRSR%=14H REMARK CONTROL-T
LEFT.CRSR%=08H REMARK CONTROL-H
RIGHT.CRSR%=12H REMARK CONTROL-R
CTRL.I%=09H REMARK CONTROL-I
ESCAPE%=1BH REMARK ESCAPE KEY
REMARK CRT DIMENSIONS AND MASK RECORD LENGTH DEFINED HERE
VERTICAL.LINES%=16
CRT.WIDTH%=64
MASK.LENGTH%=1100
DIM CRTMASK$(VERTICAL.LINES%),SCRATCH$(VERTICAL.LINES%)
REMARK ***************************************************\
* IN ORDER TO CHANGE THIS PROGRAM FOR A CRT WITH *\
* OTHER X-Y DIMENSIONS, YOU MUST ALSO CHANGE THE *\
* MASK FILE ACCESS ROUTINES IN 1000 AND 1200.ADD *\
* OR DECREASE THE NUMBER OF CRT MASK LINES TO BE *\
* READ FROM OR WRITTEN TO THE FILE AS NEEDED. *\
***************************************************
BLANK$=CHR$(20H)
FOR I%=1 TO 7:BLANK$=BLANK$+BLANK$:NEXT I%
REMARK SET UP BLANK FILLER SPACE (128 SPACES HERE)
GOTO 6000
%INCLUDE SUBS1
1000 REMARK ********** READ CRT MASK FILE RECORD **********
READ #1,MASK%; CRTMASK$(1),CRTMASK$(2),CRTMASK$(3),CRTMASK$(4),\
CRTMASK$(5),CRTMASK$(6),CRTMASK$(7),CRTMASK$(8),CRTMASK$(9),\
CRTMASK$(10),CRTMASK$(11),CRTMASK$(12),CRTMASK$(13),CRTMASK$(14),\
CRTMASK$(15),CRTMASK$(16)
FOR I%=1 TO VERTICAL.LINES%
SCRATCH$(I%)=CRTMASK$(I%)
REMARK SAVE CRT MASK ELEMENTS IN SCRATCH ARRAY
NEXT I%
RETURN
1200 REMARK ********** SAVE CRT MASK FILE RECORD **********
PRINT #1,MASK%; CRTMASK$(1),CRTMASK$(2),CRTMASK$(3),CRTMASK$(4),\
CRTMASK$(5),CRTMASK$(6),CRTMASK$(7),CRTMASK$(8),CRTMASK$(9),\
CRTMASK$(10),CRTMASK$(11),CRTMASK$(12),CRTMASK$(13),CRTMASK$(14),\
CRTMASK$(15),CRTMASK$(16)
IF NEW.RECORD%=YES% THEN NEW.RECORD%=0:\
CLOSE 1:OPEN FILENAME$ RECL MASK.LENGTH% AS 1
RETURN
2100 REMARK +++++++++++++++++CURSOR POSITIONING SUBROUTINE++++++++++++++++++
CONSOLE
LINEFEEDS%= INT(X1/CRT.WIDTH%)+96 REMARK CALCULATE ROW
HORIZONTAL%=X1- (LINEFEEDS% * CRT.WIDTH%) REMARK CALCULATE COLUMN
IF HORIZONTAL% < 31 THEN HORIZONTAL%=HORIZONTAL%+96
REMARK ADD SPECIAL OFFSET WHERE 0<= X <= 31
CHAR%=LEAD.IN%:GOSUB 801
REMARK SEND LEAD-IN CODE
CHAR%=CURS.ADDR%:GOSUB 801
REMARK SEND CURSOR ADDRESS CODE
CHAR%=HORIZONTAL%:GOSUB 801
REMARK SEND X-COORDINATE
CHAR%=LINEFEEDS%:GOSUB 801
REMARK SEND Y-COORDINATE
RETURN
6000 PRINT CLEAR.SCREEN$
X2$="ENTER NAME OF FILE":X2=13:X3=0:X4=0
GOSUB 665 REMARK ENTER CRT MASK FILENAME
IF END #1 THEN 6000 REMARK REJECT INVALID FILENAME
FILENAME$=X0$
OPEN FILENAME$ RECL MASK.LENGTH% AS 1 REMARK OPEN CRT MASK FILE
PRINT "WORKING...DO NOT INTERRUPT"
RECS%=0
IF END #1 THEN 6007
FOR F%=10 TO 1 STEP -1
READ #1,(2^F%)+RECS%; X$
RECS%=RECS% + 2^F%
6007 NEXT F%
EXTENT%=RECS%
6010 PRINT CLEAR.SCREEN$;"CRT MASK FILE MAINTENANCE"
REMARK PRINT PRORAM ID
PRINT
PRINT
PRINT
PRINT "(0) END"
PRINT "(1) INQUIRE"
PRINT "(2) CHANGE-ADD-REPLACE"
PRINT "(3) PRINT"
X2=1:X3=0:X4=3:X2$="ENTER OPERATION CODE":GOSUB 665
REMARK ENTER OPERATION CODE
IF X0=0 THEN\
PRINT CLEAR.SCREEN$;"CRTFM EXITING":STOP
REMARK RETURN TO O/S IF OPERATION IS ZERO
F%=X0
WHILE F%=1 REMARK CRT MASK FILE INQUIRY ROUTINE
6021 PRINT CLEAR.SCREEN$;"MASK FILE INQUIRY"
X2=3:X3=0:X4=999:X2$="ENTER FIRST MASK NUMBER"
GOSUB 665 REMARK ENTER FIRST MASK NUMBER TO DISPLAY
IF X0=0 THEN F%=0:GOTO 6050
REMARK IF ZERO, EXIT TO OPERATION CODE PROMPT
IF X0>EXTENT% THEN GOTO 6021
MASK%=X0
6030 GOSUB 1000 REMARK READ CRT MASK FROM DISK
PRINT CLEAR.SCREEN$;
FOR I%=1 TO VERTICAL.LINES%
PRINT CRTMASK$(I%) REMARK DISPLAY CRT MASK
NEXT I%
6035 IF CONSTAT%=0 THEN GOTO 6035 ELSE A%=CONCHAR%
REMARK WAIT FOR OPERATOR ENTRY
IF A%=ASC("E") THEN F%=0:GOTO 6050
REMARK IF "E" WAS ENTERED, TERMINATE ROUTINE
IF A% <> 0DH THEN GOTO 6035
REMARK WAIT FOR <RETURN> BEFORE CONTINUING
MASK%=MASK% + 1
IF MASK% > EXTENT% THEN F%=0:GOTO 6050
GOTO 6030
REMARK GET NEXT CRT MASK
6050 WEND REMARK END OF INQUIRY ROUTINE
WHILE F%=2
REMARK ROUTINE TO CHANGE, ADD OR REPLACE CRT MASK ON FILE
PRINT CLEAR.SCREEN$;"CRT MASK FILE CHANGE-ADD-REPLACE"
REMARK IDENTIFY ROUTINE ON CRT
ROW%=0:COL%=0
X2$="ENTER MASK NUMBER TO CHANGE (OR 'NEW')"
X2=3:X3=0:X4=0:GOSUB 665
REMARK ENTER MASK NUMBER
IF X0$="NEW"\
THEN EXTENT%=EXTENT%+1:\
MASK%=EXTENT%:\
NEW.RECORD%=YES%:\
FOR I%=1 TO VERTICAL.LINES%:\
CRTMASK$(I%)=LEFT$(BLANK$,CRT.WIDTH%):\
NEXT I%:\
PRINT CLEAR.SCREEN$:GOTO 6130
IF MATCH("!",X0$,1) > 0 THEN GOTO 6150
REMARK RE-PROMPT IF INCORRECT ENTRY
MASK%=VAL(X0$)
REMARK CONVERT ALPHA ENTRY TO MASK NUMBER
IF MASK%=0 THEN F%=0:GOTO 6150
REMARK IF ZERO WAS ENTERED, GET OUT OF ROUTINE
IF MASK% > EXTENT% THEN GOTO 6150
PRINT CLEAR.SCREEN$
X2$="LINE OR COMPOUND POSITION TO START CHANGES"
X2=4
X3=0:X4=(CRT.WIDTH%*VERTICAL.LINES%)-1
GOSUB 665
REMARK ENTER SCREEN POSITION
ADDR%=X0
REMARK IF ADDRESS WAS ENTERED, SET SCREEN LOCATION
IF ADDR% > 15 THEN ROW%=(ADDR% / CRT.WIDTH%):\
COL%=ADDR% - (ROW% * CRT.WIDTH%):\
X1=ADDR% \
ELSE\
ROW%=ADDR%:\
X2=2:X3=0:X4=CRT.WIDTH%-1:\
X2$="COLUMN TO START CHANGES":\
GOSUB 665:\ REMARK ENTER X-COORD FOR CHANGES
COL%=X0:\
X1=(ROW% * CRT.WIDTH%) + COL%
6125 GOSUB 1000 REMARK READ CRT MASK FROM FILE
PRINT CLEAR.SCREEN$;
FOR I%=1 TO VERTICAL.LINES%
PRINT CRTMASK$(I%) REMARK DISPLAY THE MASK BEING CHANGED
NEXT I%
GOSUB 2100 REMARK POSITION THE CURSOR TO CHANGE POINT
6130 IF CONSTAT%=0 THEN GOTO 6130
A%=CONCHAR% REMARK ACCEPT CHARACTER FROM KEYBOARD
IF A% >= 20H AND A% <= 7EH THEN GOTO 6140
REMARK IF ENTRY WAS VALID ASCII, THEN PROCESS IT
IF A%=UP.CRSR% AND ROW% > 0\
THEN CHAR%=LEAD.IN%:GOSUB 801:\ REMARK MOVE CURSOR UP IF CONTROL-U PRESSED
CHAR%=UP.CURSOR%:GOSUB 801:\
ROW%=ROW%-1:GOTO 6130
IF A%=DOWN.CRSR% AND ROW% < VERTICAL.LINES%-1\
THEN\
CHAR%=LEAD.IN%:GOSUB 801:\
CHAR%=DOWN.CURSOR%:GOSUB 801:\ REMARK PRINT DOWN-CURSOR IF CTRL-D
ROW%=ROW%+1:\
GOTO 6130
IF A%=LEFT.CRSR% AND COL% > 0 THEN\
CHAR%=BACKSPACE%:\ REMARK MOVE CURSOR LEFT IF BACKSPACE WAS DEPRESSED
GOSUB 801:\
COL%=COL% - 1:\
GOTO 6130
IF A% = RIGHT.CRSR% AND COL% < CRT.WIDTH%-1\ REMARK IF CTRL-R WAS DEPRESSED, MOVE CURSOR RIGHT
THEN\
CHAR%=RIGHT.CURSOR%:GOSUB 801:\
COL%=COL%+1:\
GOTO 6130
IF A% = 0DH AND ROW% >= VERTICAL.LINES% -1 THEN\ REMARK SAVE THE MASK IF DONE WITH CHANGES
GOSUB 1200:F%=0:GOTO 6150 REMARK THEN PROMPT FOR OPERATION CODE
IF A% = 0DH THEN\
ROW%=ROW% + 1:\
CHAR%=0DH:GOSUB 801:CHAR%=0AH:GOSUB 801:\ REMARK IF CARRIAGE RETURN, MOVE CURSOR TO NEW LINE
COL%=0:\
GOTO 6130
IF A% = HOME.CRSR% THEN CHAR%=LEAD.IN%:\ REMARK SEND CURSOR HOME AND RESET X-Y COORDINATES
GOSUB 801:\
CHAR%=CURSOR.HOME%:GOSUB 801:\
ROW%=0:\
COL%=0:\
GOTO 6130
IF A% = CTRL.I% THEN \ REMARK IF TAB CHARACTER WAS HIT, IGNORE CHANGES AND
PRINT CLEAR.SCREEN$;:\ REMARK RE-DISPLAY MASK FOR ANOTHER CHANGE ATTEMPT
FOR I%=1 TO 16:\
CRTMASK$(I%)=SCRATCH$(I%):\
PRINT CRTMASK$(I%):\
NEXT I%:\
ROW%=0:COL%=0:\
X1=0:GOSUB 2100
GOTO 6130
6140 IF A% < 20H OR A% > 7AH THEN GOTO 6130
IF COL% > CRT.WIDTH%-1 THEN\ REMARK ACCEPT VALID ASCII CHARACTER ENTRY
CHAR%=BACKSPACE%:GOSUB 801:\
CHAR%=20H:GOSUB 801:\ REMARK REJECT ENTRIES PAST X-AXIS BOUNDARY
CHAR%=BACKSPACE%:GOSUB 801:\
GOTO 6130
D%=COL%+2
IF COL% < 1 THEN\
CRTMASK$(ROW%+1)=CHR$(A%)+MID$(CRTMASK$(ROW%+1),2,CRT.WIDTH%)\
ELSE\
CRTMASK$(ROW%+1)=LEFT$(CRTMASK$(ROW%+1),COL%)\
+CHR$(A%)+MID$(CRTMASK$(ROW%+1),D%,CRT.WIDTH%)
COL%=COL%+1
GOTO 6130
6150 WEND
WHILE F%=3
CONSOLE
PRINT CLEAR.SCREEN$;"CRT MASK FILE PRINT"
X2$="ENTER FIRST MASK NUMBER (0 IF NONE)"
X2=3:X3=0:X4=999:GOSUB 665 REMARK ENTER FIRST MASK TO PRINT
IF X0=0 THEN F%=0:GOTO 6200 REMARK EXIT ROUTINE IF ZERO WAS ENTERED
FIRST%=X0
X3=FIRST%
X2$="ENTER LAST MASK NUMBER"
GOSUB 665 REMARK ENTER LAST MASK TO PRINT
LAST%=X0
IF LAST% > EXTENT% THEN LAST% = EXTENT%
IF FIRST% > EXTENT% THEN GOTO 6200
LPRINTER
MASK%=FIRST%
WHILE MASK% <= LAST%
IF CONSTAT% <> 0 THEN\
MASK%=LAST%+1:GOTO 6180
GOSUB 1000 REMARK READ MASK FROM FILE
PRINT CHR$(0CH) REMARK PRINT FORM FEED
FOR I%=1 TO VERTICAL.LINES%
PRINT CRTMASK$(I%) REMARK PRINT CRT MASK ON PRINTER
NEXT I%
MASK%=MASK%+1
6180 WEND
6200 WEND
GOTO 6010