forked from RetroBattlestations/vectro
-
Notifications
You must be signed in to change notification settings - Fork 0
/
AppleIIgs-GSoftBASIC.txt
169 lines (155 loc) · 5.02 KB
/
AppleIIgs-GSoftBASIC.txt
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
10 BG = 5 // Green component of background gradient
110 HGR
111 DIM RE AS RECT
115 GOSUB 2000 // Draw Backround Gradient
130 SW = 320:SH = 160:SC = SW / 1750:XF = SW / 2
140 IF SH / 1000 < SC THEN SC = SH / 1000
150 REM === Read the vector graphics from DATA and draw the picture
160 READ P$
170 IF P$ = "EOI" THEN GOTO 4000
175 IF P$ = "P" THEN READ A: SetPenSize(A, A)
180 IF P$ = "C" OR P$ = "E" THEN F = 0: GOSUB 1010
181 IF P$ = "CF" OR P$ = "EF" THEN F = 1: GOSUB 1010
185 IF P$ = "COL" THEN READ A: SetSolidPenPat(A): GOTO 130
190 IF P$ = "L" THEN GOSUB 1510
200 GOTO 130
1000 REM === Draw circle or ellipse
1010 READ XC,YC,XR:YR = XR: IF P$ = "E" OR P$ = "EF" THEN READ YR
1020 READ AA,AE
1030 XC = XC * SC:YC = YC * SC:XR = XR * SC:YR = YR * SC
1040 XC = XC + XF
1050 SetRect(RE, XC - XR, XY - YR, XC + XR, YC + YR)
1055 AZ = AE - AA
1060 IF AZ = 360 THEN GOSUB 2100 : return
1070 AA = 360 - AE + 90
1080 GOSUB 2200
1090 RETURN
1500 REM === Draw a line
1510 READ X1,Y1,X2,Y2
1520 X1 = X1 * SC:Y1 = Y1 * SC:X2 = X2 * SC:Y2 = Y2 * SC
1530 HPLOT X1 + XF,Y1 TO X2 + XF,Y2
1540 RETURN
2000 REM Set up color palette and draw background
2010 FOR I = 1 to 14
2020 SetColorEntry(0, I, (16 - I) + (BG * 16) + (I * 256))
2030 SetRect(RE, 0, (I - 1) * 15, 320, I * 15)
2035 SetSolidPenPat(I)
2040 PaintRect(RE)
2050 NEXT I
2055 SetSolidPenPat(0)
2060 RETURN
2100 IF F = 1 THEN
2105 PaintOval(RE)
2110 ELSE
2115 FrameOval(RE)
2120 END IF
2125 RETURN
2200 IF F = 1 THEN
2205 PaintArc(RE, AA, AZ)
2210 ELSE
2215 FrameArc(RE, AA, AZ)
2220 END IF
2225 RETURN
4000 GET A$
4010 END
5000 REM === This is the image data
5010 DATA L,-350,24,-45,0
5020 DATA L,-450,24,-89,38
5030 DATA L,-55,77,-88,499
5040 DATA L,-129,533,-365,514
5050 DATA L,-365,517,-88,560
5060 DATA L,-11,35,-48,528
5070 DATA L,23,30,-18,529
5080 DATA L,56,99,-18,530
5090 DATA L,124,111,56,99
5100 DATA L,38,24,124,111
5110 DATA L,-64,807,101,679
5120 DATA L,-140,983,101,679
5130 DATA L,-858,786,-185,998
5140 DATA L,-864,752,-197,911
5150 DATA L,-62,687,-158,892
5160 DATA L,-226,836,-138,667
5170 DATA L,-689,586,-150,645
5180 DATA L,-340,640,-689,586
5190 DATA L,-724,633,-354,685
5200 DATA L,-360,701,-724,633
5210 DATA L,-774,676,-375,747
5220 DATA L,-380,765,-774,676
5230 DATA L,-239,796,-328,776
5240 DATA L,-320,757,-230,773
5250 DATA L,-214,729,-295,713
5260 DATA L,-286,695,-206,706
5270 DATA L,-190,663,-263,652
5280 DATA L,-365,788,-367,801
5290 DATA L,-367,801,-359,789
5300 DATA L,-225,827,-226,836
5310 DATA L,-62,687,-64,807
5320 DATA C,-41,31,31,-7,94
5330 DATA C,-90,73,36,-6,87
5340 DATA C,-126,496,38,266,354
5350 DATA C,-82,526,34,261,356
5360 DATA C,32,30,9,44,175
5370 DATA C,-261,553,461,78,93
5380 DATA C,-177,151,50,6,78
5390 DATA C,-811,219,688,-19,6
5400 DATA C,-205,420,50,269,341
5410 DATA C,-190,-999,1469,259,269
5420 DATA C,-264,-1083,1539,262,271
5430 DATA C,-212,414,41,271,339
5440 DATA C,-710,226,573,-21,8
5450 DATA C,-184,148,41,8,78
5460 DATA C,-331,859,768,78,86
5470 DATA C,-49,293,495,163,188
5480 DATA C,-256,278,295,154,196
5490 DATA C,-191,874,38,261,331
5500 DATA C,-865,759,7,80,183
5510 DATA C,-849,764,24,170,246
5520 DATA C,-175,952,47,257,318
5530 DATA C,-150,659,15,-41,89
5540 DATA C,-342,659,19,-25,81
5550 DATA C,-351,657,28,263,342
5560 DATA C,-363,721,20,-26,78
5570 DATA C,-371,721,26,260,342
5580 DATA C,-384,784,20,-12,78
5590 DATA C,-267,686,34,84,155
5600 DATA C,-285,680,15,147,267
5610 DATA C,-199,683,24,254,341
5620 DATA C,-198,683,22,-19,68
5630 DATA C,-217,747,18,-16,80
5640 DATA C,-300,746,33,82,163
5650 DATA C,-317,742,15,159,255
5660 DATA C,-226,746,28,261,347
5670 DATA C,-333,807,31,80,147
5680 DATA C,-256,824,31,-6,77
5690 DATA COL,15
5700 DATA CF,772,75,53,0,360 // Antenna Ball
5710 DATA EF,531,390,302,197,0,360 // Head
5720 DATA CF,260,298,67,0,360 // Left Ear
5730 DATA CF,806,298,67,0,360 // Right Ear
5740 DATA EF,419,708,109,132,0,360 // Left Arm
5750 DATA EF,644,708,109,132,0,360 // Right Arm
5760 DATA EF,531,673,151,313,0,360 // Body
5765 DATA EF,400,961,75,61,0,180 // Left Foot
5766 DATA EF,663,961,75,61,0,180 // Right Foot
5790 DATA COL,14
5800 DATA CF,426,351,49,0,360 // Left Eye
5810 DATA CF,639,351,49,0,360 // Right Eye
5820 DATA COL,0
5830 DATA P,2
5840 DATA C,772,75,53,0,360 // Antenna Ball
5850 DATA L,718,64,584,32 // Antenna
5860 DATA L,584,32,535,188
5870 DATA E,531,390,302,197,0,360 // Head
5880 DATA C,260,298,67,40,246 // Left Ear
5890 DATA C,806,298,67,-69,141 // Right Ear
5900 DATA C,426,351,49,0,360 // Left Eye
5910 DATA C,639,351,49,0,360 // Right Eye
5920 DATA E,533,458,115,54,200,340 // Mouth
5930 DATA E,531,673,151,313,142,263 // Left Body
5940 DATA E,531,673,151,313,-82,37 // Right Body
5950 DATA E,419,708,109,132,104,263 // Left Arm
5960 DATA E,644,708,109,132,-83,76 // Right Arm
5970 DATA E,400,961,75,61,62,192 // Left Foot
5980 DATA E,663,961,75,61,-11,118 // Right Foot
5990 DATA L,327,976,736,976
6000 DATA EOI