(*-------------------------------------------------------------------------- :Program. IconToM2.mod :Author. Norbert Süßdorf :Address. Körnerstraße 6, D 6840 Lampertheim 1 :Phone. 06206/2212 :History. V1.0, 10-September-1989 :Copyright. Norbert Süßdorf 1989.(program freely distributable) :Language. Modula-II :Translator. M2Amiga 3.2d :Contents. erzeugt INLINE-sourcecode von beliebigem Icon. :Usage. Anwendung: IconToM2 <(Pfad/)Icon-Name (ohne '.info')> :Remark. Ordner- und Disk-Icons können nicht über Workbench :Remark. übergeben werden ! ---------------------------------------------------------------------------*) MODULE IconToM2; (* $R- $V- $S- $F- *) FROM SYSTEM IMPORT ADR,INLINE; FROM ASCII IMPORT eol,cr; FROM Arts IMPORT Requester,Terminate; FROM Arguments IMPORT GetArg; FROM Conversions IMPORT ValToStr; FROM Dos IMPORT Open,Close,Read,Write,Seek,FileHandlePtr, oldFile,newFile,DeleteFile; FROM Icon IMPORT GetDiskObject,PutDiskObject,FreeDiskObject; FROM Workbench IMPORT noIconPosition,DiskObjectPtr; TYPE String = ARRAY [0..79] OF CHAR; VAR IconFile,ObjectFile,Console : FileHandlePtr; MyObject : DiskObjectPtr; IconName : ARRAY [0..255] OF CHAR; x,y,IconSize,MessLen : CARDINAL; len : INTEGER; written,MyIconSize : LONGINT; OutMessage : ARRAY [0..13] OF String; Header,Food,LineHead, LineEnd,HexNum,NoLine : String; done,err : BOOLEAN; Data : ARRAY [0..3] OF CHAR; PROCEDURE IconData; (* $E- *) BEGIN INLINE (0E310H,00001H,00000H,00000H,00000H,00000H,00025H,00019H); INLINE (00004H,00003H,00001H,00005H,064D0H,00000H,00000H,00000H); INLINE (00000H,00000H,00000H,00000H,00000H,00000H,00000H,00000H); INLINE (00424H,00001H,0D710H,00000H,00000H,08000H,00000H,08000H); INLINE (00000H,00000H,00000H,00000H,00000H,00000H,061A8H,00000H); INLINE (00000H,00025H,00019H,00002H,00006H,0CFC8H,00300H,00000H); INLINE (00000H,05555H,05500H,00000H,05555H,05500H,00000H,05555H); INLINE (05510H,00000H,05014H,00114H,00000H,05555H,05515H,00000H); INLINE (05045H,05500H,00000H,05541H,05555H,05000H,05540H,05555H); INLINE (05000H,05547H,01555H,05000H,0554FH,00555H,05000H,05543H); INLINE (04555H,05000H,05F80H,00000H,01000H,04600H,00000H,01000H); INLINE (0460FH,00F1FH,01000H,04619H,09999H,09000H,04618H,01999H); INLINE (09000H,04619H,09999H,09000H,05F8FH,00F19H,09000H,04000H); INLINE (00000H,01000H,05555H,041F1H,05000H,05555H,04319H,05000H); INLINE (05555H,051F1H,05000H,05555H,05405H,05000H,05555H,05555H); INLINE (05000H,00000H,00000H,00000H,00000H,00000H,00000H,00000H); INLINE (00000H,00000H,00000H,00000H,00000H,00FE3H,0FE00H,00000H); INLINE (00000H,00000H,00000H,00FB8H,00000H,00000H,0003EH,00000H); INLINE (00000H,0003FH,08000H,00000H,00038H,0C000H,00000H,00030H); INLINE (0F000H,00000H,0003CH,0D800H,00000H,01F80H,00000H,00000H); INLINE (00FC0H,00000H,00000H,0070FH,00F1FH,00000H,0071FH,09F9FH); INLINE (08000H,0071CH,0DDDDH,0C000H,0071DH,09DDDH,0C000H,01F8FH); INLINE (0CFDDH,0C000H,00FC7H,0878CH,0C000H,00000H,0360CH,00000H); INLINE (00000H,01CE6H,00000H,00000H,00E0CH,00000H,00000H,003F8H); INLINE (00000H,00000H,00000H,00000H,00000H,00000H,00000H,00000H); INLINE (0000BH,04D32H,03A6DH,03265H,06D61H,06373H,00030H); END IconData; PROCEDURE MakeMessage(mode : CARDINAL); BEGIN CASE mode OF 1: OutMessage[5]:="* DONE. Please open RAM DISK and copy Icon-source *"; OutMessage[6]:="* where needed ! *"; OutMessage[7]:="* *"; OutMessage[8]:="* FERTIG. Bitte RAM DISK öffnen und Icon-Quellcode *"; OutMessage[9]:="* auf Diskette kopieren ! *";| 2: OutMessage[5]:="* ERROR! couldn't open icon file on 'RAM:' ! *"; OutMessage[6]:="* May be, that RAM DISK is full. *"; OutMessage[7]:="* *"; OutMessage[8]:="* FEHLER! Konnte Icon-Datei in 'RAM:' nicht öffnen ! *"; OutMessage[9]:="* Möglicherweise ist die RAM DISK voll. *";| 3: OutMessage[5]:="* ERROR! Couldn't get Icon ! Drawer- and Disk-icons *"; OutMessage[6]:="* only through CLI/SHELL (without '.info') ! *"; OutMessage[7]:="* *"; OutMessage[8]:="* FEHLER! Icon nicht gefunden ! Ordner- und Disk- *"; OutMessage[9]:="* Icons nur über CLI/SHELL (ohne '.info') ! *";| 4: OutMessage[5]:="* ERROR! Please pass name of icon file as argument *"; OutMessage[6]:="* (Drawer/Disk-icons only through CLI/SHELL)!*"; OutMessage[7]:="* *"; OutMessage[8]:="* FEHLER! Bitte Name des Icons als Argument übergeben*"; OutMessage[9]:="* (Ordner-/Disk-Icons nur über CLI/SHELL)! *";| ELSE END (*CASE*); FOR x:=5 TO 12 DO OutMessage[x,MessLen]:=eol; written:=Write(Console,ADR(OutMessage[x]),MessLen+1); END; written:=Write(Console,ADR(OutMessage[13]),16); written:=Read(Console,ADR(LineEnd),1); Close(Console); END MakeMessage; BEGIN MyIconSize := 414; OutMessage[0]:="******************************************************"; OutMessage[1]:="* IconToM2 version 1.0 *"; OutMessage[2]:="******************************************************"; OutMessage[3]:="* Copyrights by N.Süßdorf '89 (freely distributable) *"; OutMessage[4]:="* -------------------------------------------------- *"; OutMessage[10]:="* *"; OutMessage[11]:="******************************************************"; OutMessage[12]:=" "; OutMessage[13]:="Quit = "; MessLen:=54; NoLine:=" "; NoLine[0]:=cr; NoLine[29]:=cr; Header:=" PROCEDURE IconData; (* $E- *) BEGIN "; Header[22]:=eol; Header[23]:=eol; Header[53]:=eol; Header[54]:=eol; Header[60]:=eol; Header[61]:=eol; LineHead:=" INLINE ("; LineEnd:="H); "; LineEnd[3]:=eol; Food:=" END IconData; "; Food[0]:=eol; Food[14]:=eol; Console:=Open(ADR("CON:10/25/580/160/ IconToM2 1.0 "),newFile); IF Console = NIL THEN done:=Requester(ADR("IconToM2: No CON:-window !"), ADR("IconToM2: Kein CON:-Fenster !"),NIL,ADR("QUIT")); Terminate(0); END; FOR x:=0 TO 4 DO OutMessage[x,MessLen]:=eol; written:=Write(Console,ADR(OutMessage[x]),MessLen+1); END; GetArg(1,IconName,len); IF len>0 THEN MyObject:=GetDiskObject(ADR(IconName)); IF MyObject # NIL THEN MyObject^.currentX:=noIconPosition; MyObject^.currentY:=noIconPosition; len:=PutDiskObject(ADR("ram:tmp"),MyObject); IF len>0 THEN written:=Write(Console,ADR("copying icon to RAM DISK.."),26); written:=Write(Console,ADR(NoLine),1); END; ObjectFile:=Open(ADR("ram:tmp.info"),oldFile); IF ObjectFile # NIL THEN IconFile:=Open(ADR("ram:M2Icon.mod"),newFile); IF IconFile # NIL THEN written:=Write(Console,ADR(NoLine),30); written:=Write(Console,ADR("creating source file.."),22); written:=Write(IconFile,ADR(Header),62); len:=2; IconSize:=0; WHILE len>1 DO written:=Write(IconFile,ADR(LineHead),9); FOR y:=0 TO 7 DO len:=Read(ObjectFile,ADR(Data),2); IF len>0 THEN IF y>0 THEN written:=Write(IconFile,ADR("H,0"),3); ELSE written:=Write(IconFile,ADR("0 "),1); END; FOR x:=0 TO 1 DO IF (len=1) THEN Data[1]:="0"; y:=8; ELSIF len=0 THEN y:=8; END; IF (len>0) THEN INC(IconSize); ValToStr(LONGINT(Data[x]),FALSE,HexNum,16,2,"0",err); written:=Write(IconFile,ADR(HexNum),2); END; END(*FOR*); END; END(*FOR*); written:=Write(Console,ADR(NoLine),30); written:=Write(Console,ADR("writing code"),12); written:=Write(Console,ADR(NoLine),1); written:=Write(IconFile,ADR(LineEnd),4); END(*WHILE*); written:=Write(IconFile,ADR(Food),15); written:=Seek(IconFile,0,-1); written:=Write(IconFile,ADR("CONST IconSize ="),16); ValToStr(LONGINT(IconSize),FALSE,HexNum,10,5," ",err); LineEnd:="; "; LineEnd[1]:=eol; written:=Write(IconFile,ADR(HexNum),5); written:=Write(IconFile,ADR(LineEnd),2); Close(IconFile); Close(ObjectFile); done:=DeleteFile(ADR("ram:tmp.info")); ObjectFile:=Open(ADR("ram:M2Icon.mod.info"),newFile); IF ObjectFile # NIL THEN written:=Write(ObjectFile,ADR(IconData),MyIconSize); Close(ObjectFile); END; END; ELSE FreeDiskObject(MyObject); MakeMessage(2); Terminate(0); END; FreeDiskObject(MyObject); ELSE MakeMessage(3); Terminate(0); END; ELSIF len=0 THEN MakeMessage(4); Terminate(0); END; MakeMessage(1); END IconToM2.