Multi Zoom Master#

General Information

Author: Carsten Strotmann
Language: TURBO-BASIC
Compiler/Interpreter: Turbo-Basic
Published: ABBUC Magazin

How to use#

This is a program to edit Graphics 15 pictures (62 Sec) in pixel by pixel zoom mode. The Programm is in english, the Manual however is in german language. Write a mail to carsten@strotmann.de if you like to see an english translated version.

The MultiZoomMaster Sourcecode is Free Software under the GNU Public License

ATR-File with Turbo-Basic Source and compiled version is in the Attachments.

Source (Main Program)#

1000 DIM SAVE$(7680),IN$(40),FN$(17)
1010 POKE 106,192
1020 OPEN #%1,4,%0,"D:MULTIZOO.BIN"
1030 BGET #%1,1024,65
1040 BGET #%1,1536,180
1050 CLOSE #%1
1060 OPEN #%1,4,%0,"D:MZM.PIC"
1070 BGET #1,ADR(SAVE$),7680
1080 CLOSE #%1
1090 POKE 106,PEEK(106)-16
1100 GRAPHICS %0
1110 PLT=PEEK(106)*256
1120 POKE PLT,%0
1130 MOVE PLT,PLT+%1,2047
1140 POKE 559,58
1150 POKE 54279,PEEK(106)
1160 POKE 53277,%2
1170 DPOKE 53256,771
1180 DPOKE 704,2056
1190 EXEC FULLPIC
1200 MOVE ADR(SAVE$),DPEEK(88),7680
1210 EXEC BALKEN
1220 EXEC TFOFF
1230 # PIC
1240 POKE 623,4
1250 POKE 53250,%0
1260 EXEC FARBEN
1270 EXEC FBALKEN
1280 EXEC BALKEN
1290 # HAUPT
1300 REPEAT 
1310	TRAP 1220
1320	KEY=ASC(INKEY$)
1330	POKE 1472,%0
1340	ST=STICK(%0)
1350	IF KEY=68 THEN GO# LINE
1360	IF KEY=85 THEN EXEC UNDO
1370	IF KEY=70 THEN GO# FILL
1380	IF KEY=73 THEN GO# DIR
1390	IF KEY=67 THEN GO# CIRCLE
1400	IF KEY=69 THEN EXEC EXIT:GO# PIC
1410	IF KEY=76
1420	  EXEC TFON
1430	  INPUT " LOAD  FILENAME :",IN$
1440	  FN$(%1,%2)="D:"
1450	  FN$(%3)=IN$
1460	  CLOSE #%1
1470	  OPEN #%1,4,%0,FN$
1480	  EXEC TFOFF
1490	  BGET #%1,DPEEK(88),7680
1500	  CLOSE #%1
1510	  MOVE DPEEK(88),ADR(SAVE$),7680
1520	ENDIF 
1530	IF KEY=83
1540	  EXEC TFON
1550	  INPUT " SAVE  FILENAME :",IN$
1560	  FN$(%1,%2)="D:"
1570	  FN$(%3)=IN$
1580	  CLOSE #%1
1590	  OPEN #%1,8,%0,FN$
1600	  EXEC TFOFF
1610	  BPUT #%1,DPEEK(88),7680
1620	  CLOSE #%1
1630	ENDIF 
1640	IF KEY>48 AND KEY<53
1650	  WC=KEY-49
1660	  EXEC FBALKEN
1670	ENDIF 
1680	IF KEY=45 OR NOT ST&%1
1690	  IF PY>%0
1700		 EXEC PLCLR
1710		 PY=PY-%1
1720		 EXEC BALKEN
1730	  ENDIF 
1740	ENDIF 
1750	IF KEY=61 OR NOT ST&%2
1760	  IF PY<86
1770		 EXEC PLCLR
1780		 PY=PY+%1
1790		 EXEC BALKEN
1800	  ENDIF 
1810	ENDIF 
1820	IF KEY=43 OR NOT ST&4
1830	  IF PX>%0
1840		 PX=PX-%1
1850		 EXEC BALKEN
1860	  ENDIF 
1870	ENDIF 
1880	IF KEY=42 OR NOT ST&8
1890	  IF PX<24
1900		 PX=PX+%1
1910		 EXEC BALKEN
1920	  ENDIF 
1930	ENDIF 
1940	IF KEY=32
1950	  IF PEEK(623)=4
1960		 POKE 623,%1
1970	  ELSE 
1980		 POKE 623,4
1990	  ENDIF 
2000	ENDIF 
2010 UNTIL KEY=90 OR KEY=155 OR STRIG(%0)=%0
2020 EXEC MCLR
2030 MOVE DPEEK(88),ADR(SAVE$),7680
2040 CLS #6
2050 EXEC ZOOM
2060 EXEC FARBEN
2070 EXEC ZOOMLOAD
2080 REPEAT 
2090	KEY=ASC(INKEY$)
2100	POKE 1472,%0
2110	ST=STICK(%0)
2120	IF KEY=28 AND PY>%0
2130	  PY=PY-%1
2140	  EXEC ZOOMLOAD
2150	ENDIF 
2160	IF KEY=29 AND PY<85
2170	  PY=PY+%1
2180	  EXEC ZOOMLOAD
2190	ENDIF 
2200	IF KEY=30 AND PX>%0
2210	  PX=PX-%1
2220	  EXEC ZOOMLOAD
2230	ENDIF 
2240	IF KEY=31 AND PX<24
2250	  PX=PX+%1
2260	  EXEC ZOOMLOAD
2270	ENDIF 
2280	IF KEY=45 OR NOT ST&%1
2290	  IF CY>%0
2300		 CY=CY-%1
2310	  ENDIF 
2320	ENDIF 
2330	IF KEY=61 OR NOT ST&%2
2340	  IF CY<20
2350		 CY=CY+%1
2360	  ENDIF 
2370	ENDIF 
2380	IF KEY=43 OR NOT ST&4
2390	  IF CX>%0
2400		 CX=CX-%1
2410	  ENDIF 
2420	ENDIF 
2430	IF KEY=42 OR NOT ST&8
2440	  IF CX<63
2450		 CX=CX+%1
2460	  ENDIF 
2470	ENDIF 
2480	IF CY/%2<>INT(CY/%2)
2490	  RX=CX+80+8
2500	ELSE 
2510	  RX=CX+8
2520	ENDIF 
2530	RY=INT(CY/%2)
2540	LOCATE RX,RY,RC
2550	COLOR RC+%1
2560	PLOT RX,RY
2570	PAUSE %1
2580	COLOR RC
2590	PLOT RX,RY
2600	IF KEY>48 AND KEY<53
2610	  WC=KEY-49
2620	  COLOR WC
2630	  PLOT 4,32
2640	  DRAWTO 35,32
2650	ENDIF 
2660	IF KEY=32 OR KEY=155 OR STRIG(%0)=%0
2670	  COLOR WC
2680	  PLOT RX,RY
2690	  SOUND %0,40,10,10
2700	  PAUSE %1
2710	  DSOUND 
2720	  PAUSE %1
2730	  EXEC UPDATE
2740	ENDIF 
2750 UNTIL KEY=80 OR KEY=27
2760 EXEC FULLPIC
2770 MOVE ADR(SAVE$),DPEEK(88),7680
2780 GO# PIC
2790 ------------------------------
2800 # LINE
2810 EXEC MCLR
2820 POKE 623,%1
2830 EXEC KREUZ
2840 COLOR WC
2850 PLOT KX,KY
2860 PAUSE 10
2870 EXEC KREUZ
2880 DRAWTO KX,KY
2890 PAUSE 30
2900 GO# LINE
2910 ------------------------------
2920 # FILL
2930 EXEC MCLR
2940 POKE 623,%1
2950 EXEC KREUZ
2960 COLOR WC
2970 PAINT KX,KY
2980 PAUSE 10
2990 GO# FILL
3000 ------------------------------
3010 # CIRCLE
3020 EXEC MCLR
3030 POKE 623,%1
3040 EXEC KREUZ
3050 PAUSE 20
3060 SX=KX
3070 SY=KY
3080 EXEC KREUZ
3090 XR=(ABS(SX-KX))
3100 YR=(ABS(SY-KY))
3110 COLOR WC
3120 CIRCLE SX,SY,XR,YR
3130 PAUSE 20
3140 GO# CIRCLE
3150 ------------------------------
3160 # DIR
3170 EXEC TFON
3180 CLOSE #%1
3190 OPEN #%1,6,%0,"D:*.PIC"
3200 TRAP 3300
3210 POKE 752,%1
3220 DO 
3230	INPUT #%1,IN$
3240	? "		  ";IN$
3250	GET KEY
3260	IF KEY=155 THEN EXIT 
3270	CLS 
3280 LOOP 
3290 CLS 
3300 ? "	NO MORE FILES"
3310 GET KEY
3320 EXEC TFOFF
3330 GO# PIC
3340 ------------------------------
3350 PROC UNDO
3360	MOVE ADR(SAVE$),DPEEK(88),7680
3370 ENDPROC 
3380 ------------------------------
3390 PROC FULLPIC
3400	GRAPHICS 31
3410	POKE 559,58
3420	DL=DPEEK(560)
3430	DPOKE 1621,DL+%3
3440	POKE DL,%1
3450	DPOKE DL+%1,1616
3460 ENDPROC 
3470 ------------------------------
3480 PROC TFON
3490	POKE 703,4
3500	CLS 
3510	DPOKE 1617,DPEEK(660)
3520 ENDPROC 
3530 ------------------------------
3540 PROC TFOFF
3550	DPOKE 1617,1636
3560 ENDPROC 
3570 ------------------------------
3580 PROC ZOOM
3590	DPOKE 560,1024
3600	DPOKE 1033,DPEEK(88)
3610	COLOR WC
3620	PLOT 4,32
3630	DRAWTO 35,32
3640	POKE 707,%0
3650 ENDPROC 
3660 ------------------------------
3670 PROC PLCLR
3680	DPOKE PLT+1024+24+PY*%2,%0
3690	DPOKE PLT+1024+27+PY*%2+20,%0
3700	DPOKE PLT+1280+24+PY*%2,%0
3710	DPOKE PLT+1280+27+PY*%2+20,%0
3720 ENDPROC 
3730 ------------------------------
3740 PROC MCLR
3750	POKE PLT+1024,%0
3760	MOVE PLT+1024,PLT+1025,512
3770 ENDPROC 
3780 ------------------------------
3790 PROC BALKEN
3800	POKE 53248,48+PX*4
3810	POKE 53249,80+PX*4
3820	POKE PLT+1024+26+PY*%2,255
3830	POKE PLT+1280+26+PY*%2,255
3840	MOVE PLT+1024+26+PY*%2,PLT+1024+27+PY*%2,20
3850	MOVE PLT+1280+26+PY*%2,PLT+1280+27+PY*%2,20
3860 ENDPROC 
3870 ------------------------------
3880 PROC ZOOMLOAD
3890	FOR U=%0 TO 20
3900	  SM=DPEEK(88)
3910	  AM=ADR(SAVE$)
3920	  MOVE AM+PX+(PY*%2+U)*40,SM+%2+U*20,16
3930	  MOVE AM+PX+(PY*%2+U)*40,SM+452+U*40,16
3940	NEXT U
3950 ENDPROC 
3960 ------------------------------
3970 PROC FARBEN
3980	POKE 708,196
3990	POKE 709,53
4000	POKE 710,106
4010 ENDPROC 
4020 ------------------------------
4030 PROC UPDATE
4040	SM=DPEEK(88)
4050	AM=ADR(SAVE$)
4060	MOVE SM+%2+CY*20,AM+PX+(PY*%2+CY)*40,16
4070	MOVE SM+%2+CY*20,SM+452+CY*40,16
4080 ENDPROC 
4090 ------------------------------
4100 PROC KREUZ
4110	IN$=""
4120	REPEAT 
4130	  IF PEEK(732)=17
4140		 POKE 732,%0
4150		 GO# PIC
4160	  ENDIF 
4170	  ST=STICK(%0)
4180	  KEY=ASC(INKEY$)
4190	  POKE 1472,%0
4200	  IF NOT ST&%1 AND KY>%0 OR KEY=45 AND KY>%0 THEN KY=KY-%1
4210	  IF NOT ST&%2 AND KY<191 OR KEY=61 AND KY<191 THEN KY=KY+%1
4220	  IF NOT ST&4 AND KX>%0 OR KEY=43 AND KX>%0 THEN KX=KX-%1
4230	  IF NOT ST&8 AND KX<159 OR KEY=42 AND KX<159 THEN KX=KX+%1
4240	  POKE 53250,KX+46
4250	  MOVE ADR(IN$),PLT+1536+23+KY,7
4260	  POKE 706,PEEK(53770)
4270	UNTIL STRIG(%0)=%0 OR KEY=155
4280 ENDPROC 
4290 ------------------------------
4300 PROC FBALKEN
4310	POKE PLT+1793+220,255
4320	POKE 53259,%0
4330	MOVE PLT+1793+220,PLT+1793+221,6
4340	POKE 53251,116
4350	POKE 707,PEEK(707+WC)
4360	IF WC=%0 THEN POKE 707,PEEK(712)
4370 ENDPROC 
4380 ------------------------------
4390 PROC EXIT
4400	GRAPHICS %0
4410	POKE 53277,%0
4420	POKE 710,99
4430	POKE 709,14
4440	POKE 752,%1
4450	POSITION %0,%0:? "	  TPP'S MULTI ZOOM MASTER"
4460	POSITION %0,%1:? "---------------------------------"
4470	POSITION 5,5:? "Exit to"
4480	POSITION 10,10:? "Dos"
4490	POSITION 10,12:? "Basic"
4500	POSITION 10,14:? "Or Boot"
4510	GET KEY
4520	IF KEY=66 THEN GRAPHICS %0:NEW 
4530	IF KEY=68 THEN DOS 
4540	IF KEY=79 THEN X=USR(58487)
4550 ENDPROC 
4560 ------------------------------

Add new attachment

Only authorized users are allowed to upload new attachments.

List of attachments

Kind Attachment Name Size Version Date Modified Author Change note
atr
multizm.atr 92.2 kB 1 08-Mar-2010 20:20 Carsten Strotmann
« This page (revision-1) was last changed on 08-Mar-2010 20:20 by Carsten Strotmann