home *** CD-ROM | disk | FTP | other *** search
- 10 rem megamorphs v2.0 by tom zdanowicz
- 80 rem copyright 1993 - compute publications intl ltd - all rights reserved
- 85 ifa=0thena=1:load"morph.ml",8,1
- 94 open15,8,15
- 95 print"[147]":poke53280,0:poke53281,0:print" please insert work disk with images"
- 96 print" and press a key to continue"
- 97 geta$:ifa$=""then97
- 100 print"[147]":poke53280,0:poke53281,0
- 110 print:print:printspc(14)"megamorphs"
- 120 print spc(14)"[183][183][183][183][183][183][183][183][183][183]":print:print
- 130 print "[159]1. load keyframes & morph (builds s/s)":print
- 140 print "2. morph existing s/s points files":print
- 155 print "3. look":print
- 157 print "5. exit"
- 160 get c$:c=val(c$):ifc<1orc>5then 160
- 170 on c goto 200,190,6021,180
- 180 sys64738
- 190 gosub 9000:goto8020
- 200 rem *set bitmap and load keyframes*
- 204 print"image file type (p[146]rg/s[146]eq)":getft$
- 205 ifft$<>"s"andft$<>"p"thenprint"[145][145]":goto204
- 206 gosub9000
- 230 rem *******load keyframe1*******
- 241 mb=n1*320:nm$="0:1pag,"+ft$+",r"
- 250 gosub6040:open5,8,5,"0:startpoints,s,w":ymax=n1*8:gosub300:l1=ct
- 252 mb=n2*320:nm$="0:2pag,"+ft$+",r"
- 253 gosub6040:open5,8,5,"0:stoppoints,s,w":ymax=n2*8:gosub 300:l2=ct
- 260 gosub 7031:goto8026
- 297 rem *** map image to disk *****
- 300 poke53280,2:ct=0:fory=0 toymax:forx=0to319
- 301 hb=int(x/256):lb=x-(256*hb)
- 310 poke 840,lb:poke841,hb:poke842,y:poke 766,0:sys49271
- 320 if peek(767)=0 then 340
- 330 print#5,x:print#5,y:ct=ct+2
- 340 next:next:close5:return
- 6010 rem ***view image file*****
- 6021 gosub6025:goto6105
- 6025 print"image file type (p[146]rg/s[146]eq)":getft$
- 6026 ifft$<>"s"andft$<>"p"thenprint"[145][145]":goto6025
- 6030 print"[147]":input"filename to view";n$:nm$="0:"+n$+","+ft$+",r"
- 6031 ifft$="p"then6055
- 6035 input"number of rows to view/save";nr:mb=nr*320
- 6040 sys49161:poke680,12:sys49220
- 6050 bc=peek(53280):poke53280,6:open5,8,5,nm$:goto6057
- 6055 sys49161:poke680,12:sys49220:poke147,0:sys57812n$,8,1:sys62631:goto6105
- 6057 ad=8192:nb=0
- 6060 get#5,x$
- 6070 ifx$=""thenx$=chr$(0)
- 6075 x=asc(x$):pokead,x:ad=ad+1:nb=nb+1:ifnb=mbthen6100
- 6076 if st=64then6100
- 6080 goto6060
- 6100 close5:poke53280,bc:return
- 6105 geta$:ifa$=""then6105
- 6107 rem ***recover text mode****** 6108 rem **************************
- 6110 poke53265,peek(53265)and223:poke53272,(peek(53272)and240)or4:goto100
- 7010 rem ** remap and equalize ****
- 7020 rem * startpoints/stoppoints *
- 7031 poke53280,7
- 7040 ifl1<l2then 7070
- 7050 ifl2<l1then 7200
- 7060 ifl1=l2then return
- 7070 open5,8,5,"0:startcopy,s,w":open6,8,6,"0:startpoints,s,r"
- 7080 input#6,x:input#6,y:su=st:print#5,x:print#5,y:ifsu=64then7100
- 7090 goto7080
- 7100 close5:close6
- 7110 open5,8,5,"0:startpoints,a":open6,8,6,"0:startcopy,s,r"
- 7120 input#6,x:input#6,y:su=st:print#5,x:print#5,y:l1=l1+2:ifl1=l2then7150
- 7121 ifsu=64then7140
- 7130 goto 7120
- 7140 close6:open6,8,6,"0:startcopy,s,r":goto7120
- 7150 close5:close6:print#15,"s0:startcopy":return
- 7200 open5,8,5,"0:stopcopy,s,w":open6,8,6,"0:stoppoints,s,r"
- 7210 input#6,x:input#6,y:su=st:print#5,x:print#5,y:ifsu=64then7230
- 7220 goto7210
- 7230 close5:close6
- 7240 open5,8,5,"0:stoppoints,a":open6,8,6,"0:stopcopy,s,r"
- 7250 input#6,x:input#6,y:su=st:print#5,x:print#5,y:l2=l2+2:ifl2=l1then7290
- 7260 ifsu=64then7280
- 7270 goto 7250
- 7280 close6:open6,8,6,"0:stopcopy,s,r":goto7250
- 7290 close5:close6:print#15,"s0:stopcopy":return
- 8000 rem ************************
- 8010 rem *** morph two images ***
- 8020 rem **** main menu option 2 here**
- 8021 print:print:open5,8,5,"0:startpoints,s,r":l1=0
- 8022 input#5,v:l1=l1+1:ifst<>64then8022
- 8023 print"[156]number of pixels in s/s files=";int(l1/2)
- 8024 print:print" press a key to continue[146][159]":close5
- 8025 geta$:ifa$=""then8025
- 8026 rem ***main menu option 1 here**
- 8027 poke53280,5
- 8030 ss=1/ns
- 8040 fori=0tons:sys49161:poke680,12:sys49220:ia=i*ss
- 8045 open5,8,5,"0:startpoints,s,r":open6,8,6,"0:stoppoints,s,r"
- 8050 forj=0tol1step2
- 8055 input#5,x:input#5,y:input#6,x2:input#6,y2
- 8060 x1=x+ia*(x2-x):y1=y+ia*(y2-y)
- 8070 hb=int(x1/256):lb=x1-(256*hb)
- 8080 poke840,lb:poke841,hb:poke842,y1:poke766,1:sys49271
- 8090 next:close5:close6
- 8091 rem ***build slide filename**
- 8092 ifi=si then gosub 8700
- 8093 gosub 8500
- 8105 bc=peek(53280):poke53280,14:sys49612:poke53280,bc:next
- 8111 rem ****recover text mode****
- 8200 poke53265,peek(53265)and223:poke53272,(peek(53272)and240)or4:print"[147]"
- 8201 print:print:print" [159]morph finished"
- 8202 print:print:print:print:print:print:print" press any key[146]"
- 8240 geta$:ifa$<>""then100
- 8242 poke54296,21:poke54277,9:poke54278,0:poke54273,48:poke54276,32:poke54276,33
- 8244 poke53280,253-(peek(53280)+1):ford=1to300:next:goto8240
- 8500 sn=i+1+os:s$=str$(sn)
- 8510 ifsn>9then8540
- 8520 s$=mid$(s$,2,1):s$="0"+s$
- 8530 goto 8550
- 8540 s$=mid$(s$,2,2)
- 8550 sn$="slide"+s$
- 8560 mm=757:forp=1to7:k$=mid$(sn$,p,1):pokemm,asc(k$):mm=mm+1:next
- 8570 ifn1>n2thenmb=n1*320
- 8580 ifn2>n1thenmb=n2*320
- 8590 ifn1=n2thenmb=n1*320
- 8600 la=8192+mb:lh=int(la/256):ll=la-(256*lh):poke755,ll:poke756,lh:return
- 8700 i1=i:o1=os:os=0
- 8710 fori=sitoei:gosub8500
- 8720 bc=peek(53280):poke53280,14:sys49612:poke53280,bc:next
- 8730 i=i1:os=o1:return
- 9000 input"#rows in imag1(1-25)";n1:ifn1<1orn1>25thenprint"[145][145]":goto9000
- 9005 input"#rows in imag2(1-25)";n2:ifn2<1orn2>25thenprint"[145][145]":goto9000
- 9010 input"number of frames(2-99)";ns:ifns<2orns>99thenprint"[145][145]":goto9010
- 9012 ns=ns-1
- 9015 os=0:input"frame offset";os$:ifval(os$)>99oros<0thenprint"[145][145]":goto9015
- 9016 os=val(os$):return
- 10060 goto100
-