home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 28
/
amigaformatcd28.iso
/
-seriously_amiga-
/
programming
/
amos
/
pic2txt
/
pic2txt20.amos
/
pic2txt20.amosSourceCode
Wrap
AMOS Source Code
|
1998-05-09
|
3KB
|
87 lines
On Error Proc ERR
Resume Label _END
Dim A$(15),Z$(25),WINCON(10)
Global A$(),Z$(),WINCON()
CL$=Command Line$
Amos To Back
VER$="$VER: PIC-2-TXT V2.0 - Written by Robert Ciesnik in AMOSPro2.00"
A= Extension_24_0564(1,"CON:0/0/640/256/PIC-2-TXT V2.0 - Written by Robert Ciesnik")
A= Extension_24_05C8(1,"This program was written and compiled with AMOSPro2.00"+Chr$(10))
A= Extension_24_05C8(1,"Type 'PIC2TXT ??' for more information!"+Chr$(10))
A= Extension_24_05C8(1,"I've used three extensions to write it:"+Chr$(10))
A= Extension_24_05C8(1,"AMOSPro Turbo Extension V1.9, AMOSPro Gui Extension V1.62 and"+Chr$(10))
A= Extension_24_05C8(1,"AMOSPro JDColour Extension V1.4"+Chr$(10))
A= Extension_24_05C8(1,"I`d like to thank the authors of these extensions!"+Chr$(10)+Chr$(10))
A$(0)="#" : A$(1)="@" : A$(2)="0" : A$(3)="8" : A$(4)="%" : A$(5)="X"
A$(6)="2" : A$(7)="�" : A$(8)=Chr$(177) : A$(9)=Chr$(215) : A$(10)="+"
A$(11)="=" : A$(12)=":" : A$(13)="-" : A$(14)=Chr$(183) : A$(15)=" "
For Y=0 To 25 : Z$(Y)="" : Next Y
If CL$="?" Then A= Extension_24_05C8(1,"Usage: PIC2TXT <source> <destination>") : Repeat : Until Extension_18_0A32 : Goto _END
If CL$="??" Then HELP : Goto _END
For X=1 To Len(CL$)
B$=Mid$(CL$,X,1)
If B$=" " Then S$=Right$(CL$,Len(CL$)-X) : X=Len(CL$) Else F$=F$+B$
Next X
If CL$=""
F$= Extension_24_0162("Select an IFF-Picture","","","")
S$= Extension_24_0162("Select an Output-File","","","")
End If
If F$="" Then Goto _END
If Exist(F$)=False Then Goto _END
If S$="" Then Goto _END
A= Extension_24_05C8(1,"Converting...")
Load Iff F$,0
Screen 0
X=Screen Width : Y=Screen Height
Z=Screen Colour
Screen Open 1,320,256,Z,Lowres : Curs Off : Flash Off
Screen 1
Get Palette 0
Zoom 0,0,0,X,Y To 1,0,0,76,26
Screen Close 0
Screen 1
For Y=0 To 25
For X=0 To 75
R= Extension_12_0470(X,Y)
D=Val("$"+Right$(Hex$( Extension_20_0020(Colour(R))),1))
Z$(Y)=Z$(Y)+A$(D)
Next X
Next Y
A= Extension_24_05C8(1,"Ok"+Chr$(10))
Screen Close 1
Open Out 1,S$
For Y=0 To 25
A= Extension_24_05C8(1,Z$(Y)+Chr$(10))
Print #1,Z$(Y);
Print #1,Chr$(10);
Next Y
Print #1,"PIC-2-TXT V2.0 <-> Copyright �1998 R-SOFT Entertainment Inc.";Chr$(10);
Close 1
A= Extension_24_05C8(1,"Press left mouse button to quit")
Repeat : Until Extension_18_0A32 =0
Repeat : Until Extension_18_0A32
_END:
Extension_24_0578 : Trap Close : End
Procedure ERR
A= Extension_24_0150("PIC-2-TXT V2.0 - Error Request",Err$(Errn),"CANCEL")
Resume Label
End Proc
Procedure HELP
M$=Chr$(10)
A= Extension_24_05C8(1,"If you like this programm write me:"+M$)
A= Extension_24_05C8(1,"Robert Ciesnik"+M$)
A= Extension_24_05C8(1,"Vivaldistr. 3"+M$)
A= Extension_24_05C8(1,"30989 Gehrden"+M$)
A= Extension_24_05C8(1," GERMANY"+M$)
A= Extension_24_05C8(1,"or phone me:"+M$)
A= Extension_24_05C8(1,"+49-5108-927924"+M$)
A= Extension_24_05C8(1,"I've written really much software for the Amiga in AmigaBasic,"+M$)
A= Extension_24_05C8(1,"GFA-Basic and AMOS Professional 2.00."+M$)
A= Extension_24_05C8(1,"Now, I`m going to spread it out in the Internet!!!"+M$)
A= Extension_24_05C8(1,"You can reach me through the Internet, too:"+M$)
A= Extension_24_05C8(1,"EMail: fbuschmann@compuserve.com"+M$)
A= Extension_24_05C8(1,"WWW: http://ourworld.compuserve.com/homepages/fbuschmann"+M$)
A= Extension_24_05C8(1,"PS: I`ve written a brand new game with good SFX and GFX!"+M$)
A= Extension_24_05C8(1,"--- Press mouse button to quit ---"+M$)
Repeat : Until Extension_18_0A32
End Proc