forked from milliluk/display
-
Notifications
You must be signed in to change notification settings - Fork 0
/
listing1.bas
93 lines (93 loc) · 5.53 KB
/
listing1.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
100 REM PROGRAM DISPLAY
110 REM COPYRIGHT DAVID MEREDITH L983
120 REM BASIC PROGRAM PERMITS INPUT OF A 3-D PICTURE AS POINTS AND LINE SEGMENTS. MACHINE LANGUAGE COMPONENT DISPLAYS THE PICTURE
130 REM AND ALLOWS PANNING, SCALING, AND ROTATING
140 CLS:PRINT@73,"D I S P L A Y":PRINT@135,"BY DAVID MEREDITH":PRINT@201,"COPYRIGHT 1983"
145 PRINT@416,"READING MACHINE LANGUAGE PART..."
150 CLOADM"DISPLAYM":PCLEAR8:CLEAR 100,&H7000
160 PO=&H7000:LI=PO+9*26:MA=LI+121:REM ADDRESSES OF POINTS BUFFER, LINES BUFFER, AND MAIN DISPLAY ROUTINE
165 DIM CH(25)
170 GOSUB 1000: REM NEW PICTURE
175 CS$="HELPNEWDISPLAY":LD$="LOAD":SV$="SAVE":AA=ASC("A"):QU$=CHR$(34)
180 CLS:PRINT"ENTER help ANYTIME FOR GUIDANCE"
190 LINEINPUT A$:REM GET NEW POINT, LINE, OR COMMAND
200 I=INSTR(A$," "):IFI<>0THENA$=LEFT$(A$,I-1)+RIGHT$(A$,LEN(A$)-I):GOTO200:REM ELIMINATE BLANKS
210 IFLEN(A$)>2THENI=INSTR(CS$,A$):IFI=0THEN215ELSEIFI=1THENGOSUB1600:GOTO190ELSEIFI=5THENGOSUB1000:GOTO190ELSEIFI=8THENGOSUB1800:GOTO190
215 IF INSTR(A$,LD$)=1THENGOSUB1200:GOTO190ELSEIFINSTR(A$,SV$)=1THENGOSUB1400:GOTO190
220 IFINSTR(A$,"=")=2THENGOSUB2000:GOTO190:REM DEFINE A POINT
230 IFINSTR(A$,"??")=1 THEN GOSUB 2200:GOTO190:REM PRINT LINE SEGMENTS
240 IFINSTR(A$,"?")=1 THENGOSUB2400:GOTO190:REM PRINT POINTS
250 REM AT THIS POINT A$ EITHER DEFINES LINES OR IS INCORRECT
260 L=LEN(A$):IFL<2THENGOSUB2600:GOTO190:REM IF LEN(A$) <2 THEN LINE INCORRECT
270 IFL<2THEN190ELSEA1=ASC(LEFT$(A$,1))-AA:A2=ASC(MID$(A$,2,1))-AA:IF A1<0 OR A1>25 OR A2<0 OR A2>25 THEN GOSUB2600:GOTO190ELSEL=L-2:A$=RIGHT$(A$,L)
274 IFA1=A2 THENPRINT:PRINT"ENDPOINTS MUST BE DISTINCT":PRINT:GOTO190
275 IFINSTR(A$,"#")=1THENL=L-1:A$=RIGHT$(A$,L):GOTO400:REM DELETE A POINT
280 I=LI:A1=9*A1:A2=9*A2
290 P=PEEK(I):Q=PEEK(I+1):IFP<>255THENIF(P=A1 ANDQ=A2)OR(P=A2 ANDQ=A1)THENPRINT:PRINT"LINE ";CHR$(AA+A1/9);CHR$(AA+A2/9);" ALREADY DEFINED":PRINT:GOTO190ELSEI=I+2:GOTO290:REM FIND NEXT OPEN SPACE IN LINES BUFFERCHECKING FOR DUPLICATION
300 IF I=MA-1 THENPRINT:PRINT"NO ROOM FOR ANOTHER LINE":PRINT:GOTO190
310 IFPEEK(PO+A1)=128THENPRINT:PRINT"POINT ";CHR$(A1/9+AA);" NOT DEFINED":PRINT:GOTO270
320 IFPEEK(PO+A2)=128THENPRINT:PRINT"POINT ";CHR$(A2/9+AA);" NOT DEFINED":PRINT:GOTO270
330 POKEI,A1:POKEI+1,A2:POKEI+2,255:IFL>0THEN270ELSE190:REM PUT LINE SEGMENT IN LINE BUFFER AND GET NEXT SEGMENT IF ANY
400 REM DELETE A LINE SEGMENT A1,A2
410 I=LI:A1=9*A1:A2=9*A2
420 IFPEEK(I)=255 THENPRINT:PRINT"LINE SEGMENT ";CHR$(A1/9+AA);CHR$(A2/9+AA);" NOT DEFINED":PRINT:GOTO270
430 P=PEEK(I):Q=PEEK(I+1):IF(P<>A1 ORQ<>A2)AND(P<>A2 ORQ<>A1)THENI=I+2:GOTO420
440 P=PEEK(I+2):POKEI,P:IFP=255THEN270ELSEI=I+1:GOTO440:REM DELETE THE POINT BY MOVING DATA DOWN THE BUFFER
1000 REM MAKE A BLANK PICTURE
1010 FORI=PO TO PO+9*25 STEP 9:POKEI,128:NEXT:REM MARK ALL POINTS AS UNDEFINED
1020 POKELI,255:REM CLEAR LINE BUFFER
1030 RETURN
1200 REM LOAD A PICTURE FROM TAPE
1210 I=INSTR(A$,QU$):IFI<>0THENJ=INSTR(I+1,A$,QU$):IFJ<>0THENNA$=MID$(A$,I,J-I+1)ELSENA$=RIGHT$(A$,LEN(A$)-I)ELSENA$=""
1220 IFLEN(NA$)>8THENNA$=LEFT$(NA$,8)
1230 CLOADM NA$:GOTO1800:REM DISPLAY PICTURE AFTER LOADING
1400 REM SAVE CURRENT PICTURE ON TAPE
1410 I=INSTR(A$,QU$):IFI<>0THENJ=INSTR(I+1,A$,QU$):IFJ<>0THENNA$=MID$(A$,I,J-I+1)ELSENA$=RIGHT$(A$,LEN(A$)-I)ELSENA$=""
1420 IFLEN(NA$)>8THENNA$=LEFT$(NA$,8)
1430 CSAVEM NA$,PO,MA-1,PO:RETURN
1600 REM HELP ROUTINE
1610 CLS:PRINT"DISPLAY PICTURE: display"
1620 PRINT"ERASE PICTURE: new"
1630 PRINT"SAVE PIX ON TAPE: save";QU$;"NAME";QU$
1640 PRINT"READ PIX FROM TAPE: load";QU$;"NAME";QU$
1650 PRINT"ENTER POINT P: P = X,Y,Z"
1660 PRINT"ENTER LINE SEGMENT AB: AB"
1670 PRINT"DELETE LINE SEGEMENT CD: CD#"
1680 PRINT"PRINT POINTS A TO H: ?A-H"
1690 PRINT"PRINT LINE SEGMENTS: ??"
1700 PRINT:RETURN
1800 REM DISPLAY THE PICTURE
1810 REM FIRST DECLARE ALL UNUSED POINTS AS UNDEFINED
1820 FORI=0TO25:CH(I)=0:NEXT
1830 I=LI
1840 P=PEEK(I):IFP<>255THENCH(P/9)=1:I=I+1:GOTO1840:REM MARK ALL POINT NAMES USED
1850 FORI=0TO25:IFCH(I)=0THENPOKEPO+9*I,128:NEXT:REM MARK UNUSED POINTS AS UNDEFINED
1860 POKE 282,0:EXEC MA:POKE282,255:PRINT:RETURN
2000 REM INPUT A POINT
2010 A=ASC(LEFT$(A$,1))-AA:IFA<0ORA>25THENGOSUB 2600:RETURN
2020 AD=PO+9*A
2030 A$=RIGHT$(A$,LEN(A$)-2)
2040 IFA$=""THENGOSUB2600:RETURN
2050 VA=VAL(A$):IFABS(VA)>80THENPRINT:PRINT"COORDINATES MUST BE BETWEEN -80 AND 80":PRINT:RETURNELSEB=LEN(A$)-LEN(STR$(VA)):IFVA<0THENB=B-1
2055 IFB<3THENGOSUB2600:GOTO190ELSEA$=RIGHT$(A$,B):IFVA>=0THENV1=0:V2=VA ELSEV1=255:V2=256+VA
2060 POKE AD,V1:POKEAD+1,V2:POKEAD+2,0:AD=AD+3
2070 IFA$=""THENGOSUB2600:RETURN
2080 VA=VAL(A$):IFABS(VA)>80THENPRINT:PRINT"COORDINATES MUST BE BETWEEN -80 AND 80":PRINT:RETURNELSEB=LEN(A$)-LEN(STR$(VA)):IFVA<0THENB=B-1
2085 IFB<1THENGOSUB2600:GOTO190ELSEA$=RIGHT$(A$,B):IFVA>=0THENV1=0:V2=VA ELSE V1=255:V2=256+VA
2090 POKE AD,V1:POKEAD+1,V2:POKEAD+2,0:AD=AD+3
2140 VA=VAL(A$):IFABS(VA)>80 THEN PRINT:PRINT"COORDINATES MUST BE BETWEEN -80 AND 80":PRINT:RETURN
2145 IFVA>=0THENV1=0:V2=VA ELSEV1=255:V2=256+VA
2150 POKE AD,V1:POKEAD+1,V2:POKEAD+2,0:RETURN
2200 REM PRINT LINES
2210 I=LI
2220 P=PEEK(I):IF P=255 THEN PRINT:RETURN
2230 PRINTCHR$(P/9+AA);CHR$(PEEK(I+1)/9+AA);" ";:I=I+2:GOTO2220
2400 REM PRINT POINTS
2410 A1=0:A2=25:I=INSTR(A$,"-"):IFI=3THENA1=ASC(MID$(A$,2,1))-AA:IFA1<0ORA1>25THENA1=0:GOTO2030
2420 IFI<LEN(A$)ANDI<=3THENA2=ASC(MID$(A$,I+1,1))-AA:IFA2<0ORA2>25THENA2=25
2430 FORI=A1 TO A2:AD=PO+9*I:IFPEEK(AD)=128THENNEXT:RETURN
2440 PRINTCHR$(I+AA);" = ";:FORJ=0TO6STEP3
2450 VA=PEEK(AD+J)*256+PEEK(AD+J+1)+PEEK(AD+J+2)/256:IFVA>32767THENVA=VA-65536
2460 V$=STR$(VA):PRINTV$;:IFJ<>6THENPRINT",";
2465 NEXT:PRINT:NEXT:RETURN
2600 PRINT:PRINT"UNRECOGNIZED COMMAND":PRINT:RETURN