Compute! Gazette 1992 January/1992-01.d64/lisa

Commodore BASIC | 2022-09-20 | 6KB | 182 lines

10 rem copyright 1992 - compute publications intl ltd - all rights reserved
20 if dk=0 then dk=1:load"lisa.ml",8,1
30 y=int(32768/256):x=int((32768/256-y)*256+.5):poke55,x:poke56,y:clr
40 dim pt(300,2),ln(300,2),rp(300,3):poke53280,6:poke53281,6:print"[147]"
50 pi=3.14159265:np=1:nl=1:cs=sqr(3)/2:sn=.5:an=pi/6:md=0:pc=0
60 :
70 if md=1 then md=0:sys 49152+6:rem text mode
80 print"[147]":a$="[204][201][211][193] - [204]ittle [201]sometric [193]rtist":gosub 1760:print"[159]"
90 print:a$="[195]opyright 1992":gosub 1760
100 a$="[195][207][205][208][213][212][197] [208]ublications [201]ntl, [204]td":gosub 1760
110 a$="[193]ll [210]ights [210]eserved":gosub 1760:print:print
120 a$="[208]lease choose:":gosub1760:print
130 a$="([206])ew [198]igure":gosub1760:a$="([199])raphic [211]creen":gosub1760
140 a$="([211])ave [208]icture":gosub 1760:a$="[211]et ([193])ngle of [212]urn":gosub 1760
150 a$="([204])oad [208]icture":gosub 1760:a$="([205])ake [211]lide [211]et":gosub 1760
160 a$="([197])dit":gosub 1760:a$="([200])elp":gosub 1760:a$="([196])emo":gosub 1760
170 get a$:if a$="" then 170
180 fl=0:b$="nghdsamel"
190 for x=1 to len(b$):if a$=mid$(b$,x,1) then fl=x
200 next:if fl=0 then 170
210 on fl goto 230,570,630,810,850,910,1020,350,520
220 rem -------------------
230 rem input a new figure
240 input"[147][159][200]ow many points are you entering";np
250 for x=1 to np:print"[147]":for y=asc("x") to asc("z")
260 print"[197]nter the ";chr$(y);" value for point";x;": ";
270 input rp(x,y-asc("w")):next y,x
280 input"[147][200]ow many edges are you entering";nl
290 for x=1 to nl:print"[147]"
300 print"[197]nter the starting point for edge";x;": ":input ln(x,1)
310 print"[197]nter the ending point for edge";x;": ":input ln(x,2)
320 next:print"[158]":a$="[195]alculating...":gosub 1760:goto 1150
330 rem -------------------
340 rem edit the data
350 for x=1 to np:print"[147]":for y=asc("x") to asc("z")
360 print"[212]he ";chr$(y);" value for point";x;": ";rp(x,y-asc("w")):next y
370 print:print"[210]eenter this point? ([217]/[206])":gosub 1800
380 if a$<>"y" then 420
390 print"":for y=asc("x") to asc("z")
400 print"[197]nter the ";chr$(y);" value for point";x;": ";
410 input rp(x,y-asc("w")):next y
420 next x:for x=1 to nl:print"[147]"
430 print"[212]he starting point for edge";x;": ";ln(x,1)
440 print"[212]he ending point for edge";x;": ";ln(x,2)
450 print:print"[210]eenter this edge? ([217]/[206])":gosub 1800
460 if a$<>"y" then 490
470 print:print"[197]nter the starting point for edge";x;": ":input ln(x,1)
480 print:print"[197]nter the ending point for edge";x;": ":input ln(x,2)
490 goto 320
500 rem -------------------
510 rem load the picture
520 print"[147][215]hat is the name of the picture?":input a$
530 x=len(a$):poke 53050,x:for y=1 to x:poke 53050+y,asc(mid$(a$,y,1)):next
540 if md=0 then md=1:sys 49152+3
550 sys 49152+18:pc=0:goto600
560 rem -------------------
570 rem go to the graphic screen
580 if md=0 then md=1:sys 49152+3:if pc then 1500
590 gosub 1800
600 if md=1 then md=0:print"[147]":sys 49152+6:rem text mode
610 goto 70
620 rem -------------------
630 rem post help screen
640 print"[147]":a$="[205]ain [205]enu [200]elp":gosub 1760:print"[159]"
650 a$="[195]reate a new figure by choosing '[206]' at":gosub 1760
660 a$="the main menu and entering point and":gosub 1760
670 a$="edge data when prompted.":gosub 1760
680 a$="[201]f a figure exists on the graphic":gosub 1760
690 a$="screen, it will be displayed by":gosub 1760
700 a$="pressing '[199]' at the main menu.":gosub 1760
710 a$="[195]hoosing '[196]' at the main menu will":gosub 1760
720 a$="cause a demo figure to be created,":gosub 1760
730 a$="with all the normal figure options":gosub 1760
740 a$="afterward.":gosub 1760
750 a$="[212]he ([204])oad and ([211])ave options work":gosub 1760
760 a$="with a high-resolution image.":gosub 1760
770 a$="[212]he slide set option saves a":gosub 1760
780 a$="full rotation sequence.":gosub 1760:print
790 gosub 1790:goto 70
800 rem -------------------
810 rem run demo
820 print:print"[158]":a$="[199]etting [196]ata...":gosub 1760:gosub 1640
830 goto 1150
840 rem -------------------
850 rem save the picture
860 if md=0 then md=1:sys 49152+3
870 sys 49152+15
880 if md=1 then md=0:print"[147]":sys 49152+6:rem text mode
890 goto 70
900 rem -------------------
910 rem set the angle of turn
920 print"[147][159]":a$="[215]hen first run, this program uses a":gosub 1760
930 a$="default turning increment of 1/12 of a":gosub 1760
940 a$="complete rotation. [208]lease either enter":gosub 1760
950 a$="a new increment (in radians), or a":gosub 1760
960 a$="negative value to abort.":gosub 1760
970 print:input"angle";x:print:print"[158]":if x<0 then 70
980 if x>2*pi then a$="[212]oo large... using default":gosub 1760:an=pi/6:goto 790
990 x=int(2*pi/x+.5):if x<=1 then x=2
1000 an=2*pi/x:a$="using"+str$(x)+" steps per rotation":gosub 1760:goto 790
1010 rem -------------------
1020 rem make the set of slides
1030 print"[147][158]":if pc then 1050
1040 a$="[212]here is no entered figure":gosub 1760:goto 790
1050 if 2*pi/an > 20 then an = 2*pi/20
1060 a$="[212]his slide set will take"+str$(int(2*pi/an+.5)*32)
1070 a$=a$+" blocks.":gosub 1760:gosub 1790
1080 sys 49152+3:for sx=1 to 2*pi/an
1090 sys 49152+15
1100 gosub 1570:gosub 1180:next
1110 if md=1 then md=0:print"[147]":sys 49152+6:rem text mode
1120 goto 70
1130 rem -------------------
1140 rem drawing the figure
1150 gosub 1180:goto 1500
1160 rem -------------------
1170 rem calculating the geometric center
1180 ax=0:ay=0:az=0
1190 for x=1 to np:ax=ax+rp(x,1):ay=ay+rp(x,2):az=az+rp(x,3):next
1200 ax=ax/np:ay=ay/np:az=az/np
1210 :
1220 for x=1 to np:rem convert to isometric image
1230 pt(x,1)=(rp(x,2)-rp(x,1)-ay+ax)*cs
1240 pt(x,2)=rp(x,3)-az-sn*(rp(x,2)+rp(x,1)-ax-ay)
1250 next
1260 :
1270 max=pt(1,1):min=max:rem initialize extrema
1280 for x=1 to np:for y=1 to 2
1290 if pt(x,y)>max then max=pt(x,y)
1300 if pt(x,y)<min then min=pt(x,y)
1310 next y,x
1320 sr=199/(max-min):rem the scale ratio
1330 ar=152/115:rem the aspect ratio
1340 os=160+min*sr*ar:rem x-offset to center the drawing
1350 for x=1 to np:for y=1 to 2
1360 pt(x,y) = (pt(x,y)-min)*sr
1370 next y,x
1380 if md=0 then md=1:sys 49152+3:rem switch to the graphics screen
1390 sys 49152+12:rem clear screen
1400 for x=1 to nl
1410 x1 = int(pt(ln(x,1),1)*ar+os+.5):y1 = int(pt(ln(x,1),2)+.5)
1420 x2 = int(pt(ln(x,2),1)*ar+os+.5):y2 = int(pt(ln(x,2),2)+.5)
1430 v(2)=int(x1/256):v(1)=int((x1/256-v(2))*256+.5)
1440 v(4)=int(y1/256):v(3)=int((y1/256-v(4))*256+.5)
1450 v(6)=int(x2/256):v(5)=int((x2/256-v(6))*256+.5)
1460 v(8)=int(y2/256):v(7)=int((y2/256-v(8))*256+.5)
1470 for y=0 to 7:poke 53000+y,v(y+1):next
1480 pc=-1:sys 49152+9:rem draw the line
1490 next:return
1500 get a$:if a$="" then 1500
1510 if a$="" then an = abs(an):gosub 1570:gosub 1180:goto 1500
1520 if a$="[157]" then an = -abs(an):gosub 1570:gosub 1180:goto 1500
1530 if md=1 then md=0:print"[147]":sys 49152+6:rem text mode
1540 goto 70
1550 :
1560 rem rotating the object
1570 for x=1 to np
1580 xx=rp(x,1):yy=rp(x,2)
1590 rp(x,1)=xx*cos(an)-yy*sin(an)
1600 rp(x,2)=xx*sin(an)+yy*cos(an)
1610 next:md=1:return
1620 :
1630 rem generating data for demo figure
1640 np=1:nl=1:a=10:b=5
1650 for th=0 to 3:for ph=0 to 9:gosub 1710
1660 ln(nl,1)=np:ln(nl,2)=np+1:ln(nl+1,1)=np:ln(nl+1,2)=np+10:nl=nl+2:np=np+1
1670 next ph:nl=nl-1:ln(nl-1,1)=np-1:ln(nl-1,2)=np+9:next th
1680 th=4:for ph=0 to 9:gosub 1710
1690 ln(nl,1)=np:ln(nl,2)=np+1:nl=nl+1:np=np+1:next ph
1700 np=np-1:nl=nl-1:ln(nl,1)=np:ln(nl,2)=np-9:return
1710 rp(np,1)=a*cos(th*pi/10)*cos(ph*pi/5)
1720 rp(np,2)=a*cos(th*pi/10)*sin(ph*pi/5)
1730 rp(np,3)=b*sin(th*pi/10):return
1740 :
1750 rem center print
1760 if len(a$)<38 then for lp=1 to 20-len(a$)/2:print chr$(32);:next
1770 printa$:return
1780 :
1790 print:print"[158]":a$="[208]ress any key":gosub 1760
1800 get a$:if a$="" then 1800
1810 return