100 rem BASIC Month 6: The Mandelbaum Set 110 rem http://reddit.com/r/RetroBattlestations 120 rem written by FozzTexx 125 rem Mac Chipmnunk Basic port by u/Atarimac 130 rem "You think you're better than me?" 140 dim nt(100) 141 dim om(100) 150 dim gz(100) : dim cm(100) : dim sz(100) : dim rz(100) : dim nm(100) 200 rem === Initialize variables and constants 210 pi = 3.141593 : dim pt(128) 220 gz(0) = 33 : gz(1) = 138 : gz(2) = 200 230 cm(0) = 1 : cm(1) = 0 : cm(2) = 0 240 cm(3) = 0 : cm(4) = 1 : cm(5) = 0 250 cm(6) = 0 : cm(7) = 0 : cm(8) = 1 260 gw = gz(2)*gz(2)/gz(1) 270 th = gz(2)+5 : gosub 2630 : th = th+sz(1) : gosub 2630 : th = th+sz(1) 280 rz(0) = 500 : rz(1) = 400 290 sx = (rz(0)-rz(0)*0.05)/gw : sy = (rz(1)-rz(1)*0.07)/th 300 sk = sx : if sy < sk then sk = sy 310 graphics window 10,20,600,400 : graphics 0 : cls 320 rem "What in holy hell?" 330 x = -gw/2 : y = -gz(2)/2 : gosub 2030 : rem Translate 340 x = sk : y = sk : gosub 2230 : rem Scale 350 x = rz(0)/2 : y = rz(1)/2 : gosub 2030 : rem Translate 360 gosub 2820 370 restore : rem Reset reading of DATA back to first object 380 gosub 2630 : gosub 2720 390 gosub 2630 400 x = (gw-sz(0))*sk : y = (gz(2)+sz(1)+5)*sk 410 gosub 2030 : gosub 2720 : gosub 2920 420 gosub 2630 430 gx = gz(1)/2 : gy = gz(2)/2 : gb = gy-gx : oo = gz(2)*gz(2)/gz(1)-gz(1) 440 gosub 4510 500 rem "Step aside, string bean." 510 x = -rz(0)/2 : y = -rz(1)/2 : gosub 2030 : rem Translate 520 a = pi/2 : gosub 2130 : rem Rotate 530 x = gz(1)/gz(2) : y = x : gosub 2230 : rem Scale 540 x = rz(0)/2+(gw/2-gz(1)/2)*sk : y = rz(1)/2 : gosub 2030 : rem Translate 550 gosub 4510 560 if ht > 1 then goto 510 570 gosub 4610 999 end 1000 rem === Update current transformation matrix 1010 rem - Input: 3x3 matrix in 1D array NT 1020 rem - Updates 3x3 Matrix in 1D array CM 1030 for r = 0 to 2 : for c = 0 to 2 1040 nm(r*3+c) = 0 1050 for k = 0 to 2 1060 nm(r*3+c) = nm(r*3+c)+nt(r*3+k)*cm(k*3+c) 1070 next k : next c : next r 1080 for k = 0 to 3*3-1 : cm(k) = nm(k) : next k 1090 return 2000 rem === Translate - move origin 2010 rem - Input: X, Y 2020 rem - Updates current transformation matrix in CM 2030 nt(0) = 1 : nt(1) = 0 : nt(2) = x 2040 nt(3) = 0 : nt(4) = 1 : nt(5) = y 2050 nt(6) = 0 : nt(7) = 0 : nt(8) = 1 2060 gosub 1030 2070 return 2100 rem === Rotate - rotate drawing space 2110 rem - Input: Angle in radians in A 2120 rem - Updates current transformation matrix in CM 2130 nt(0) = cos(a) : nt(1) = -sin(a) : nt(2) = 0 2140 nt(3) = -nt(1) : nt(4) = nt(0) : nt(5) = 0 2150 nt(6) = 0 : nt(7) = 0 : nt(8) = 1 2160 gosub 1030 2170 return 2200 rem === Scale - modify unit lengths of drawing 2210 rem - Input: X, Y 2220 rem - Updates current transformation matrix in CM 2230 nt(0) = x : nt(1) = 0 : nt(2) = 0 2240 nt(3) = 0 : nt(4) = y : nt(5) = 0 2250 nt(6) = 0 : nt(7) = 0 : nt(8) = 1 2260 gosub 1030 2270 return 2300 rem === Transform single point using current transformation matrix 2310 rem - Input: X, Y 2320 rem - Returns transformed point in X and Y 2330 nt(0) = x : nt(1) = y : nt(2) = 1 2340 for r = 0 to 2 2350 nm(r) = 0 2360 for k = 0 to 2 2370 nm(r) = nm(r)+nt(k)*cm(r*3+k) 2380 next k : next r 2390 x = nm(0) : y = nm(1) 2400 return 2500 rem === Draw line 2510 rem - Input: X1,Y1 X2,Y2 2520 x = x1 : y = y1 : gosub 2330 : a1 = x : b1 = y 2530 x = x2 : y = y2 : gosub 2330 : a2 = x : b2 = y 2540 graphics moveto a1,b1 : graphics lineto a2,b2 2550 return 2600 rem === Load object from DATA 2610 rem - Reads the next object from DATA and leaves size in array SZ 2620 rem and paths in array PT 2630 zi = 0 : read zx : sz(0) = zx : read zy : sz(1) = zy 2640 read zc : pt(zi) = zc : zi = zi+1 2650 if zc = 0 then return 2660 for zj = 1 to zc : read zx : read zy 2670 pt(zi) = zx : zi = zi+1 : pt(zi) = zy : zi = zi+1 2680 next zj 2690 goto 2640 2700 rem === Draw path 2710 rem - Input: paths to draw in array PT 2720 zi = 0 2730 zc = pt(zi) : zi = zi+1 : if zc = 0 then return 2740 x1 = pt(zi) : zi = zi+1 : y1 = pt(zi) : zi = zi+1 2750 for zj = 1 to zc-1 2760 x2 = pt(zi) : zi = zi+1 : y2 = pt(zi) : zi = zi+1 2770 gosub 2520 2780 x1 = x2 : y1 = y2 : next zj 2790 goto 2730 2800 rem == Save current transformation matrix 2810 rem Copies array CM to array OM 2820 for i = 0 to 8 : om(i) = cm(i) : next i 2830 return 2900 rem == Restore transformation matrix 2910 rem Copies array OM to array CM 2920 for i = 0 to 8 : cm(i) = om(i) : next i 2930 return 3000 rem Mandelbaum arc 3010 rem - Input: Arc center at CX,CY; Start/end radians in SA,EA 3020 rem "If you want to live in a butcher shop, I'm gonna treat you like a piece of meat." 3030 if (ea < sa) then ea = ea+2*pi 3040 nw = sz(0) : nh = sz(1) : ns = gz(0)/nw : sh = nh*ns 3050 ro = gz(1)/2 : ri = ro-gz(0) 3060 al = (ea-sa)*gz(1)/2 : sg = int(al/sh) 3070 ga = (ea-sa)/sg 3080 gc = cos(2*pi-ga) : gs = sin(2*pi-ga) : zc = cos(0) : zs = sin(0) 3090 f1 = cx+ri*gc : g1 = cy+ri*gs 3100 f2 = cx+ro*gc : g2 = cy+ro*gs 3110 f3 = cx+ri*zc : g3 = cy+ri*zs 3120 f4 = cx+ro*zc : g4 = cy+ro*zs 3130 d1 = f3-f1 : d2 = g3-g1 : d3 = f4-f2 : d4 = g4-g2 3140 l1 = sqr(d1*d1+d2*d2) : l2 = sqr(d3*d3+d4*d4) 3150 gosub 2820 3160 x = cx : y = cy : gosub 2330 : ax = x : ay = y 3170 rem Walk through PT and draw 3180 for sn = 0 to sg-1 3190 gosub 2920 3200 x = -ax : y = -ay : gosub 2030 : rem Translate 3210 a = 2*pi-(sa+sn*ga) : gosub 2130 : rem Rotate 3220 x = ax : y = ay : gosub 2030 : rem Translate 3230 zi = 0 3240 zc = pt(zi) : zi = zi+1 : if zc = 0 then goto 3350 3250 x1 = pt(zi)*ns : zi = zi+1 3260 y1 = pt(zi)*ns*(l1-1+(l2-l1-1)*(x1/gz(0)))/l2 : zi = zi+1 3270 x1 = x1+cx+ri : y1 = y1+cy 3280 for zj = 1 to zc-1 3290 x2 = pt(zi)*ns : zi = zi+1 3300 y2 = pt(zi)*ns*(l1-1+(l2-l1-1)*(x2/gz(0)))/l2 : zi = zi+1 3310 x2 = x2+cx+ri : y2 = y2+cy 3320 gosub 2520 3330 x1 = x2 : y1 = y2 : next zj 3340 goto 3240 3350 next sn 3360 gosub 2920 3370 return 4000 rem Mandelbaum line 4010 rem - Input: Start and end diagonal corners in X1,Y1 and X2,Y2 4020 rem "Wrong attitude, you're not bringing that trash into my house." 4030 nw = sz(0) : nh = sz(1)+1 4040 xd = x2-x1 : yd = y2-y1 4050 if xd > 0 and yd < 0 then a = 0 : wd = xd : ht = yd 4060 if xd < 0 and yd < 0 then a = 1.5*pi : ht = xd : wd = yd 4070 if xd < 0 and yd > 0 then a = pi : wd = xd : ht = yd 4080 if xd > 0 and yd > 0 then a = 0.5*pi : ht = xd : wd = yd 4090 wd = abs(wd) : ht = abs(ht) 4100 ns = wd/nw : sh = int(nh*ns) 4110 sg = int((ht+sh-1)/sh) : sh = ht/sg 4120 sx = gz(0)/nw : sy = sh/nh 4130 gosub 2820 4140 ax = x1 : ay = y1 : x = x1 : y = y1 : gosub 2330 : ox = x : oy = y 4150 x = x2 : y = y2 : gosub 2330 : xd = x-ox : yd = y-oy 4160 x = 0 : y = 0 : gosub 2330 4170 x = -x : y = -y : gosub 2030 : rem Translate 4180 gosub 2130 : rem Rotate 4190 x = sx : y = sy 4200 if (xd < 0 and yd < 0) or (xd > 0 and yd > 0) then y = sx : x = sy 4210 gosub 2230 : rem Scale 4220 x = ox : y = oy : gosub 2030 : rem Translate 4230 rem Walk through PT and draw 4240 for sn = 0 to sg-1 4250 zi = 0 4260 zc = pt(zi) : zi = zi+1 : if zc = 0 then goto 4350 4270 x1 = pt(zi) : zi = zi+1 4280 y1 = pt(zi)*(sh-1)/sh-sn*(sh/sy) : zi = zi+1 4290 for zj = 1 to zc-1 4300 x2 = pt(zi) : zi = zi+1 4310 y2 = pt(zi)*(sh-1)/sh-sn*(sh/sy) : zi = zi+1 4320 gosub 2520 4330 x1 = x2 : y1 = y2 : next zj 4340 goto 4260 4350 next sn 4360 gosub 2920 4370 rem Return height to decide if it's time to stop 4380 x = ax : y = ay+sh : gosub 2330 4390 ht = sqr((x-ox)*(x-ox)+(y-oy)*(y-oy)) 4400 return 4500 rem === G 4510 cx = gx : cy = gy-gb : sa = 0 : ea = pi : gosub 3030 4520 x1 = gz(0) : y1 = gy-gb : x2 = 0 : y2 = gy+gb : gosub 4030 4530 cx = gx : cy = gy+gb : sa = pi : ea = 0 : gosub 3030 4540 x1 = gz(1) : y1 = gy+gb : x2 = gx : y2 = gy+gb-gz(0) : gosub 4030 4550 return 4600 rem === O 4610 cx = gx+oo : cy = gy-gb : sa = 0 : ea = pi : gosub 3030 4620 x1 = gz(0)+oo : y1 = gy-gb : x2 = oo : y2 = gy+gb : gosub 4030 4630 cx = gx+oo : cy = gy+gb : sa = pi : ea = 0 : gosub 3030 4640 x1 = gz(1)-gz(0)+oo : y1 = gy+gb : x2 = gz(1)+oo : y2 = gy-gb : gosub 4030 4650 return 9000 rem "All aboard the pain train." 9010 data 39,16,15,3,-16,0,-16,0,-13,3,-13,3,-3,0,-3,0,0,10,0,10,-3,6,-3 9020 data 6,-13,10,-13,10,-16,6,-16,3,-16,11,16,-16,12,-16,12,-13,16,-13 9030 data 16,0,19,0,19,-13,23,-13,23,-16,19,-16,16,-16,5,25,-16,27,-16 9040 data 27,-13,25,-13,25,-16,19,36,-9,33,-10,32,-11,34,-13,36,-12,39 9050 data -12,34,-16,30,-14,29,-11,32,-7,35,-6,36,-5,34,-3,32,-4,29,-4 9060 data 34,0,38,-1,39,-5,36,-9,0 9070 data 53,16,15,23,-13,23,-16,20,-16,16,-16,13,-16,13,-13,16,-13,16 9080 data -3,13,-3,13,0,23,0,23,-3,20,-3,20,-13,23,-13,18,53,-13,53,-16 9090 data 46,-16,43,-16,43,-13,43,-10,43,-6,43,-3,43,0,53,0,53,-3,46,-3 9100 data 46,-6,51,-6,51,-10,46,-10,46,-13,53,-13,11,10,-16,7,-16,3,-16 9110 data 0,-16,0,-13,3,-13,3,0,7,0,7,-13,10,-13,10,-16,14,37,-16,33,-9 9120 data 29,-16,26,-16,26,0,29,0,29,-10,32,-4,34,-4,37,-10,37,0,40,0,40 9130 data -16,37,-16,0 9140 data 52,8,5,0,0,0,-8,3,-4,5,-8,5,0,3,10,0,8,-8,6,0,2,7,-4,9,-4,4,11 9150 data 0,11,-8,15,0,15,-8,6,18,-8,16,-8,16,0,18,0,20,-4,18,-8,2,23,-4 9160 data 21,-4,4,25,-8,21,-8,21,0,25,0,3,31,0,26,0,26,-8,12,32,-4,35,-4 9170 data 36,-5,36,-7,35,-8,32,-8,32,0,35,0,35,0,36,-1,36,-3,35,-4,3,41 9180 data 0,39,-8,37,0,2,38,-4,40,-4,6,42,-8,42,-1,44,0,45,0,47,-1,47,-8 9190 data 5,48,0,48,-8,50,-4,52,-8,52,0,0