UDRAW

5 REM MY UDraw - Universal Drawing Language
6 REM ATARI Version - Gibstov
10 GOTO 500:REM Start
11 GOTO 100:REM Initialize Data
12 GOTO 2000:REM Read Line
13 GOTO 2100:REM Get Next Arg
14 GOTO 2300:REM Read Program Line
15 GOTO 4000:REM Read Immediate
16 GOTO 400:REM Error Handler
17 GOTO 3500:REM Memory Manager
18 GOTO 4700:REM GET LINE INTO IO$
19 GOTO 3600:REM Garbage Collector
40 GOTO 5500:REM RUN
41 GOTO 4500:REM LIST [ST][FN]
42 GOTO 4800:REM SAVE FILE
43 GOTO 5000:REM LOAD FILE
44 GOTO 5900:REM NEW
45 GOTO 5200:REM COPY FILE
46 GOTO 5300:REM PASTE FILE
60 GOTO 6500:REM PLOT X Y
61 GOTO 6600:REM DRAWTO X Y
62 GOTO 6700:REM LINE X1 Y1 X2 Y2
63 GOTO 6900:REM CIRCLE X Y R
64 GOTO 7100:REM ELLIP X Y R1 R2
65 GOTO 7300:REM COLOR C
66 GOTO 7400:REM CLEAR
67 GOTO 7500:REM BRUSH N C
68 GOTO 6000:REM PIC H W D
69 GOTO 7600:REM ARC X Y S E R
70 GOTO 7800:REM EARC X Y S E R1 R2
100 RESTORE 9900:DEG:MM=2000:ML=255:MT=1
110 DIM LN(ML),LI(ML),LL(ML),LC(ML),LG(ML),PM$(MM):REM THESE SHOULD BE NUMBERS BUT TOO SLOW
120 DIM IO$(128),AR$(128),DC$(66),DA(10),IC$(42),CM$(6),CH$(1),PA(8),BR(2)
130 PRINT "LOADING DATA"
140 DC$=" ":DC$(66)=" ":DC$(2)=DC$:IC$=DC$
150 AR=1:NB=0:IX=0
160 READ CM$
170 IF CM$=";" THEN 230
180 DC$((IX*6)+1,(IX*6)+6)=CM$
190 READ CM
200 DA(IX)=CM
210 IX=IX+1
220 GOTO 160
230 IX=1
240 READ CM$
250 IF CM$=";" THEN 290
260 IC$(IX,IX+5)=CM$
270 IX=IX+6
280 GOTO 240
290 FOR I=0 TO 8:READ CB:PA(I)=CB:NEXT I
300 PRINT "INITIALIZING DATA"
310 GOSUB 44
330 RETURN
399 REM Error Handler
400 PRINT "ERROR ";ER
440 IF ER<100 THEN RETURN
450 END
499 PRINT "NOT IMPLEMENTED YET":RETURN
500 GOSUB 11
510 GR.0:PRINT "UDRAW":PRINT
520 GOSUB 12
530 GOSUB 13
540 IF AR$="" THEN 520
550 IF NB=0 THEN GOSUB 15:GOTO 570
560 GOSUB 14
570 GOTO 520
999 REM Verify legal X or Y
1000 IF X1<0 OR X1>HR THEN ER=10:RETURN
1010 IF Y1<0 OR Y1>VR THEN ER=11:RETURN
1020 RETURN
1999 END
2000 AR=1
2010 POKE 85,1:POKE 752,0:REM MOVE COL AND SHOW CURSOR
2020 PRINT ">";:INPUT #16;IO$
2030 POKE 752,1:POKE 85,1:?" ";:REM HIDE CURSOR AND PRINT TO ACTIVATE
2040 RETURN
2100 AR$="":NB=0
2110 IF AR > LEN(IO$) THEN RETURN
2120 IF IO$(AR,AR)=" " THEN AR = AR + 1:GOTO 2110
2130 NB=1
2140 IF AR > LEN(IO$) THEN RETURN
2150 IF IO$(AR,AR)=" " THEN RETURN
2160 AR$(LEN(AR$)+1) = IO$(AR,AR)
2170 IF ASC(IO$(AR,AR)) < 48 OR ASC(IO$(AR,AR)) > 57 THEN NB=0
2180 AR = AR + 1
2190 GOTO 2140
2299 REM Read Program Line
2300 PL = VAL(AR$)
2310 GOSUB 13
2320 IF AR$="" THEN GOSUB 3100:RETURN
2330 IF NB = 1 THEN ER=1:GOSUB 16:RETURN
2340 IX=0:CM=0:AN=0
2350 AR$(LEN(AR$)+1)="      ":AR$=AR$(1,6)
2360 CM = CM + 1
2370 IF (IX*6)+1>LEN(DC$) THEN ER=2:GOSUB 16:RETURN
2380 IF AR$=DC$((IX*6)+1,(IX*6)+6) THEN 2450
2390 IX=IX+1
2400 GOTO 2360
2450 AL=DA(IX)
2530 AC=0
2600 MR=AL+1:GOSUB 17:REM WE ADD 1 TO INCLUDE THE COMMAND BYTE TOO
2610 IF MP=-1 THEN ER=6:GOSUB 16:RETURN
2620 PM$(MP)=CHR$(CM):AC=1
2630 IF AC>AL THEN 2700
2640 GOSUB 13
2650 IF NB=0 THEN ER=3:GOSUB 16:RETURN
2660 IF AR$="" THEN ER=4:GOSUB 16:RETURN
2670 PM$(MP+AC)=CHR$(VAL(AR$))
2680 AC=AC+1
2690 GOTO 2630
2700 GOSUB 13
2710 IF AR$<>"" THEN ER=5:GOSUB 16:RETURN
2719 REM ADD LINE
2720 IF HP=-1 THEN LN(0)=PL:LI(0)=MP:LL(0)=AL+1:LC(0)=-1:HP=0:RETURN
2730 CP = HP:PP=-1
2740 IF PL=LN(CP) THEN 2800
2750 IF PL<LN(CP) THEN 2850
2760 IF LC(CP)=-1 THEN 2920
2770 PP=CP:CP=LC(CP)
2780 GOTO 2740
2800 LI(CP)=MP:LL(CP)=AL+1:RETURN
2850 GOSUB 3000:REM Create new node
2860 IF IX=-1 THEN ER=8:GOSUB 16:RETURN
2870 LN(IX)=PL:LI(IX)=MP:LL(IX)=AL+1
2880 IF CP=HP THEN HP=IX
2890 LC(IX)=CP
2900 IF PP=-1 THEN RETURN
2910 LC(PP)=IX:RETURN
2920 GOSUB 3000
2930 IF IX=-1 THEN ER=8:GOSUB 16:RETURN
2940 LN(IX)=PL:LI(IX)=MP:LL(IX)=AL+1
2950 LC(IX)=-1:LC(CP)=IX
2960 RETURN
2999 REM Add Node
3000 IX=LL
3010 IF IX <= ML THEN 3040
3020 IF LL=1 THEN IX=-1:RETURN
3030 LL=1:IX=0
3040 IF LI(IX)=-1 THEN LL=IX:RETURN
3050 IX=IX+1
3060 GOTO 3010
3099 REM Delete Node
3100 CP=HP
3110 IF CP=-1 THEN RETURN
3120 IF PL=LN(CP) THEN 3150
3130 PP=CP:CP=LC(CP)
3140 GOTO 3110
3150 LI(CP)=-1
3160 IF HP=CP THEN HP=LC(CP):GOTO 3180
3170 LC(PP)=LC(CP)
3180 RETURN
3499 REM Memory Manager
3500 IF MT+MR>MM THEN 3550
3510 MP=MT:MT=MP+MR
3520 RETURN
3550 GOSUB 19:REM Call GC
3560 IF MT+MR>MM THEN MP=-1:RETURN
3570 MP=MT:MT=MP+MR
3580 RETURN
3599 REM * GARBAGE COLLECTOR
3600 PRINT "GC..."
3610 CP=HP
3620 IF CP=-1 THEN 3660
3630 LG(CP)=LC(CP)
3640 CP=LC(CP)
3650 GOTO 3620
3660 CI=1:GH=HP
3670 CP=GH:TP=-1:LX=-1
3680 IF CP=-1 THEN 3740
3690 IF LI(CP) < CI THEN 3720
3700 IF LX =-1 THEN LX=LI(CP):LP=CP:GP=TP
3710 IF LI(CP) < LX THEN LX=LI(CP):LP=CP:GP=TP
3720 TP=CP:CP=LG(CP)
3730 GOTO 3680
3740 IF LX=-1 THEN 3840
3750 IF LI(LP)=CI THEN 3780
3760 PM$(CI,CI+LL(LP)-1)=PM$(LI(LP),LI(LP)+LL(LP)-1)
3770 LI(LP)=CI:REM POINTER TO NEW INDEX
3780 CI=CI+LL(LP)
3790 IF GP=-1 THEN 3820
3800 LG(GP)=LG(LP)
3810 GOTO 3670
3820 GH=LC(LP)
3830 GOTO 3670
3840 MT=CI
3850 PM$=PM$(1,CI-1)
3860 RETURN
3999 REM EXECUTE IMMEDIATE
4000 IX=0:CM=0
4010 CM = CM + 1
4020 IF IX>=LEN(IC$) THEN ER=2:GOSUB 16:RETURN
4030 AR$(LEN(AR$)+1)="      ":AR$=AR$(1,6)
4040 IF AR$ = IC$(IX+1,IX+6) THEN 4070
4050 IX=IX+6
4060 GOTO 4010
4070 ON CM GOTO 40,41,42,43,44,45,46
4099 REM ALL COMMANDS SHOULD RETURN, SO IT SHOULD RETURN TO CALLER SO WERE DONE
4499 REM * LIST *
4500 GOSUB 13
4510 CP=HP:TL=-1:REM -1 THEN ALL LINES
4520 IF AR$="" THEN 4630
4530 IF NB=0 THEN ER=3:GOSUB 16:RETURN
4540 TL=VAL(AR$)
4550 IF CP=-1 THEN RETURN
4560 IF LN(CP)>=TL THEN 4590
4570 CP=LC(CP)
4580 GOTO 4550
4590 GOSUB 13
4600 IF AR$="" THEN GOTO 4630
4610 IF NB=0 THEN ER=3:GOSUB 16:RETURN
4620 TL=VAL(AR$)
4630 IF CP=-1 THEN RETURN
4640 IF TL>-1 AND LN(CP)>TL THEN RETURN
4650 GOSUB 18
4660 PRINT IO$
4670 CP=LC(CP)
4680 GOTO 4630
4699 REM GET NODE INFO INTO IO$
4700 IO$=STR$(LN(CP))
4710 IO$(LEN(IO$)+1)=" "
4720 IC=ASC(PM$(LI(CP),LI(CP)))
4730 IC=(IC-1)*6+1
4740 IO$(LEN(IO$)+1)=DC$(IC,IC+5)
4750 IC=1
4760 IF IC=LL(CP) THEN RETURN
4770 IO$(LEN(IO$)+1)=" ":IO$(LEN(IO$)+1)=STR$(ASC(PM$(LI(CP)+IC,LI(CP)+IC)))
4780 IC=IC+1
4790 GOTO 4760
4799 REM * SAVE *
4800 GOSUB 13
4810 IF NB=1 THEN ER=9:GOSUB 16:RETURN
4820 TRAP 4980:REM TRAP ANY ERRORS IN SAVE
4830 IX=1:IC=1
4840 GOSUB 19:REM Call Garbage Collector
4850 OPEN #1,8,0,AR$
4860 CP=HP
4870 PRINT #1;LN(CP):PRINT #1;LI(CP):PRINT #1;LL(CP)
4880 IF LC(CP) = -1 THEN PRINT #1;-1:GOTO 4940
4890 PRINT #1;IX
4900 REM IC=IC+LL(CP)
4910 IX=IX+1
4920 CP=LC(CP)
4930 GOTO 4870
4940 PRINT #1;LEN(PM$):FOR I=1 TO LEN(PM$):PUT #1,ASC(PM$(I,I)):NEXT I
4950 CLOSE #1
4960 TRAP 40000:REM TURN TRAPS OFF
4970 RETURN
4980 CLOSE #1
4990 ER=20:GOSUB 16:RETURN
4999 REM * LOAD *
5000 GOSUB 13
5010 TRAP 5160:REM TRAP ANY ERRORS IN LOAD
5020 IX=0:IC=1
5030 OPEN #1,4,0,AR$
5040 INPUT #1,IO$:LN(IX)=VAL(IO$)
5050 INPUT #1,IO$:LI(IX)=VAL(IO$)
5060 INPUT #1,IO$:LL(IX)=VAL(IO$)
5070 INPUT #1,IO$:LC(IX)=VAL(IO$)
5080 IF VAL(IO$)=-1 THEN 5120
5100 IX=IX+1
5110 GOTO 5040
5120 INPUT #1,IC:FOR I=1 TO IC:GET #1,IO:PM$(I,I)=CHR$(IO):NEXT I
5130 MT=LEN(PM$)+1:HP=0
5140 CLOSE #1:TRAP 40000:REM TURN TRAPS OFF
5150 RETURN
5160 CLOSE #1
5170 TRAP 40000:REM TURN TRAPS OFF
5180 ER=21:GOSUB 16:RETURN
5199 REM * COPY *
5200 GOSUB 13
5210 TRAP 4980:REM TRAP ANY ERRORS ON SAVE
5220 OPEN #1,8,0,AR$
5230 CP=HP
5240 IF CP=-1 THEN 5280
5250 GOSUB 18:PRINT #1;IO$
5260 CP=LC(CP)
5270 GOTO 5240
5280 CLOSE #1:TRAP 40000:REM TURN TRAPS OFF
5290 RETURN
5299 REM * PASTE *
5300 GOSUB 13
5310 TRAP 5160:REM TRAP ANY ERRORS ON LOAD
5320 OPEN #1,4,0,AR$
5340 TRAP 5380:REM TRAP END OF FILE
5350 INPUT #1,IO$:AR=1:GOSUB 13
5360 IF AR$<>"" THEN GOSUB 14
5370 GOTO 5350
5380 CLOSE #1:TRAP 40000:REM TURN TRAPS OFF
5390 RETURN
5499 REM * RUN *
5500 GR.15+16:MH=159:MV=191:MC=3:HZ=1:VZ=1:HR=100:VR=50:X1=0:Y1=0
5510 BR(0)=PA(1):BR(1)=PA(4):BR(2)=PA(5):REM SET BRUSHES TO PALLETE 1,4,5 [RED,GREEN,BLUE]
5520 POKE 708,BR(0):POKE 709,BR(1):POKE 710,BR(2)
5530 CB=0:COLOR 1:REM Set Current Brush to 0
5540 CP=HP:ER=0
5550 IF CP=-1 THEN 5610
5560 IP = LI(CP)
5570 ON ASC(PM$(IP,IP)) GOSUB 60,61,62,63,64,65,66,67,68,69,70
5580 IF ER>0 THEN 5650
5590 CP=LC(CP)
5600 GOTO 5550
5610 OPEN #1,4,0,"K:":GET #1,IX:CLOSE #1:REM Done...Wait for key
5620 GR.0
5630 RETURN
5650 POKE 709,202:POKE 710,148
5650 PRINT "ERROR ";ER;" IN LINE ";LN(CP)
5660 RETURN
5899 REM * NEW *
5900 FOR I=0 TO 255:LI(I)=-1:LC(I)=-1:NEXT I
5910 PM$=""
5920 HP=-1:LL=0:LF=0:IX=0
5990 RETURN
5999 REM * PIC *
6000 HZ=1:XO=0:YO=0
6010 HR=ASC(PM$(IP+1,IP+1))
6020 VR=ASC(PM$(IP+2,IP+2))
6030 DM=ASC(PM$(IP+3,IP+3))
6040 IF HR>MH THEN HZ=MH/HR
6050 IF VR>MV THEN VZ=MV/VR
6060 IF DM=0 THEN 6180
6070 IF DM=1 THEN 6150
6080 IF DM=2 THEN 6100
6100 HZ=MH/HR
6110 VZ=MV/VR
6120 GOTO 6190
6150 IF HR<MH THEN XO=(MH-HR)/2
6160 IF VR<MV THEN YO=(MV-VR)/2
6170 GOTO 6190
6180 XO=O:YO=0
6190 GR.15+16:REM ERASE SCREEN AND RESET THE COLORS BACK
6200 POKE 708,BR(0):POKE 709,BR(1):POKE 710,BR(2):CB=0:REM Set Current Brush to 0
6210 X1=0:Y1=0
6220 RETURN
6499 REM * PLOT *
6500 X1=ASC(PM$(IP+1,IP+1))
6510 Y1=ASC(PM$(IP+2,IP+2))
6520 GOSUB 1000:REM Check Legal X/Y
6530 IF ER>0 THEN RETURN
6540 PLOT (X1*HZ)+XO,(Y1*VZ)+YO
6550 RETURN
6499 REM * DRAWTO *
6600 X1=ASC(PM$(IP+1,IP+1))
6610 Y1=ASC(PM$(IP+2,IP+2))
6620 GOSUB 1000:REM Check Legal X/Y
6630 IF ER>0 THEN RETURN
6640 DRAWTO (X1*HZ)+XO,(Y1*VZ)+YO
6650 RETURN
6699 REM * LINE *
6700 X1=ASC(PM$(IP+1,IP+1))
6710 Y1=ASC(PM$(IP+2,IP+2))
6720 GOSUB 1000:REM Check Legal X/Y
6730 IF ER>0 THEN RETURN
6740 PLOT (X1*HZ)+XO,(Y1*VZ)+YO
6750 X1=ASC(PM$(IP+3,IP+3))
6760 Y1=ASC(PM$(IP+4,IP+4))
6770 GOSUB 1000:REM Check Legal X/Y
6780 IF ER>0 THEN RETURN
6790 DRAWTO (X1*HZ)+XO,(Y1*VZ)+YO
6800 RETURN
6899 REM * CIRCLE *
6900 X1=ASC(PM$(IP+1,IP+1))
6910 Y1=ASC(PM$(IP+2,IP+2))
6920 A0=ASC(PM$(IP+3,IP+3))
6930 GOSUB 1000:REM Check Legal X/Y
6940 IF ER>0 THEN RETURN
6950 X2=X1:Y2=Y1
6960 X1=X2+(A0*COS(0)):Y1=Y2+(A0*SIN(0))
6970 PLOT (X1*HZ)+XO,(Y1*VZ)+YO
6980 FOR I=0 TO 360 STEP 6:REM DRAW CIRCLE
6990 X1=X2+(A0*COS(I))
7000 Y1=Y2+(A0*SIN(I))
7010 GOSUB 1000:REM Check Legal X/Y
7020 IF ER>0 THEN RETURN
7030 DRAWTO (X1*HZ)+XO,(Y1*VZ)+YO
7040 NEXT I
7050 RETURN
7099 REM * ELLIPSE *
7100 X1=ASC(PM$(IP+1,IP+1))
7110 Y1=ASC(PM$(IP+2,IP+2))
7120 A0=ASC(PM$(IP+3,IP+3))
7130 A1=ASC(PM$(IP+4,IP+4))
7140 GOSUB 1000:REM Check Legal X/Y
7150 IF ER>0 THEN RETURN
7160 X2=X1:Y2=Y1
7170 X1=X2+(A0*COS(0)):Y1=Y2+(A1*SIN(0))
7180 PLOT (X1*HZ)+XO,(Y1*VZ)+YO
7190 FOR I=0 TO 360 STEP 6:REM DRAW CIRCLE
7200 X1=X2+(A0*COS(I))
7210 Y1=Y2+(A1*SIN(I))
7230 GOSUB 1000:REM Check Legal X/Y
7240 IF ER>0 THEN RETURN
7250 DRAWTO (X1*HZ)+XO,(Y1*VZ)+YO
7260 NEXT I
7270 RETURN
7299 REM * COLOR *
7300 A0=ASC(PM$(IP+1,IP+1))
7310 A1=INT(A0/MC)
7320 A0=A0-A1*MC:REM THE COLOR SET SHOULD BE THE A0 MOD MC
7330 COLOR A0+1:CB=A0
7340 RETURN
7399 REM * CLEAR *
7400 GRA.15+16:REM ERASE SCREEN AND RESET THE COLORS BACK
7410 POKE 708,BR(0):POKE 709,BR(1):POKE 710,BR(2):CB=0:REM Set Current Brush to 0
7420 X1=0:Y1=0
7430 RETURN
7499 REM * BRUSH *
7500 A0=ASC(PM$(IP+1,IP+1))
7510 A1=ASC(PM$(IP+2,IP+2))
7520 IF A0>=MC THEN RETURN:REM IF BRUSH HIGHER THAN SYSTEM SUPPORTS RETURN (NOP)
7530 IF A1>9 THEN ER=12:RETURN
7540 BR(A0)=PA(A1):POKE 708+A0,BR(A0)
7550 RETURN
7599 REM * ARC *
7600 X1=ASC(PM$(IP+1,IP+1))
7610 Y1=ASC(PM$(IP+2,IP+2))
7620 A0=ASC(PM$(IP+3,IP+3))
7630 A1=ASC(PM$(IP+4,IP+4))
7640 A2=ASC(PM$(IP+5,IP+5))
7650 GOSUB 1000:REM Check Legal X/Y
7660 IF ER>0 THEN RETURN
7670 X2=X1:Y2=Y1
7680 IC=6:IF A0>A1 THEN IC=-6
7690 A0=A0/(256/360):A1=A1/(256/360):REM CONVERT BINDEGREES TO DEGRESS
7700 X1=X2+(A2*COS(A0)):Y1=Y2+(A2*SIN(A0))
7710 PLOT (X1*HZ)+XO,(Y1*VZ)+YO
7720 FOR I=A0 TO A1 STEP IC:REM DRAW ARC
7730 X1=X2+(A2*COS(I))
7740 Y1=Y2+(A2*SIN(I))
7750 GOSUB 1000:REM Check Legal X/Y
7760 IF ER>0 THEN RETURN
7770 DRAWTO (X1*HZ)+XO,(Y1*VZ)+YO
7780 NEXT I
7790 RETURN
7799 REM * ELLIPSE ARC *
7800 X1=ASC(PM$(IP+1,IP+1))
7810 Y1=ASC(PM$(IP+2,IP+2))
7820 A0=ASC(PM$(IP+3,IP+3))
7830 A1=ASC(PM$(IP+4,IP+4))
7840 A2=ASC(PM$(IP+5,IP+5))
7850 A3=ASC(PM$(IP+6,IP+6))
7860 GOSUB 1000:REM Check Legal X/Y
7870 IF ER>0 THEN RETURN
7880 X2=X1:Y2=Y1
7890 IC=6:IF A0>A1 THEN IC=-6
7900 A0=A0/(256/360):A1=A1/(256/360):REM CONVERT BINDEGREES TO DEGRESS
7910 X1=X2+(A2*COS(A0)):Y1=Y2+(A3*SIN(A0))
7920 PLOT (X1*HZ)+XO,(Y1*VZ)+YO
7930 FOR I=A0 TO A1 STEP IC:REM DRAW ARC
7940 X1=X2+(A2*COS(I)):Y1=Y2+(A3*SIN(I))
7950 GOSUB 1000:REM Check Legal X/Y
7960 IF ER>0 THEN RETURN
7970 DRAWTO (X1*HZ)+XO,(Y1*VZ)+YO
7980 NEXT I
7990 RETURN
9900 DATA PLOT,2,DRAWTO,2,LINE,4,CIRCLE,3,ELLIP,4,COLOR,1,CLEAR,0,BRUSH,2,PIC,3,ARC,5,EARC,6,;
9920 DATA RUN,LIST,SAVE,LOAD,NEW,COPY,PASTE,;
9930 DATA 0,55,39,215,199,119,135,87,255