' ' Laden von verschiedenen Grafikformaten in GFA-BASIC 3.x ' ' von Gregor Duchalski, Baueracker 15a, 4690 Herne 1 ' eMail an GREGOR DUCHALSKI @ DO im MausNet ' ' last change 10.09.92 ' ------------------------------------------------------------------------------ ' Die vorliegenden Routinen erm”glichen das Laden folgender Grafikformate: ' ' PI3,PI2,PI1 : DEGAS/ELITE, ungepackt, 640*400, 640*200, 320*200, 32KB ' PC3 : DEGAS ELITE, komprimiert, 640*400, 32KB ' PIC/DOO : ST-Bildschirm, ungepackt, 640*400, 32KB ' NEO : NEOCHROME, ungepackt, 320*200, 32KB ' PAC : STAD, komprimiert, 640*400, 32KB ' IMG : GEM-IMAGE, komprimiert, Gr”že beliebig ' ' Die Unterscheidung wird dabei nach dem Datei-Extender getroffen. Das ausge- ' w„hlte Bild wird zun„chst in einen Speicherbereich namens quelle% geladen. ' Dann wird, je nach Format, das endgltige (entpackte) Bild in den Bereich ' ziel% gebracht. Die Ausmaže des Bildes stehen in w& und h&. ' Das Bild wird mit einem BITBLT (sprich vro_cpyfm) auf den Screen gefetzt. ' ' Die Formate werden nicht konvertiert, d.h. ein Farbbild kann auch nur in ' einer Farbaufl”sung sinvoll angezeigt werden. Die Routinen sind in nahezu ' jeder Hinsicht sauber und GEM-Komform. ' ' Bitte vor dem Benutzen die INLINE-Bereiche einladen. ' ------------------------------------------------------------------------------ $m50000 ' init DO ' bild_laden ! Bild laden und entpacken ' EXIT IF ziel%=0 ! Nu' is' Schluž ' ! Clipping auf den Bildschirm... CLIP 0,0,SUCC(WORK_OUT(0)),SUCC(WORK_OUT(1)) bitblt(ziel%,w&,h&,planes&,0,0,0,0,0,0,w&,h&,0,0,3) CLIP OFF ' ~MFREE(ziel%) ! Zielbereich freigeben ' ~EVNT_KEYBD() ! Tastendruck ' LOOP > PROCEDURE init ' RESERVE 50000 ! Damit MALLOC was leisten kann ' DIM q_ras%(5),z_ras%(5),par%(9) ! Fr den BITLBT ' ' IMG_LOAD.INL: INLINE img_asm%,372 ' ' PAC_LOAD.INL: INLINE pac_load_asm%,212 ' ' PC3_LOAD.INL: INLINE pc3_load_asm%,58 ' ' Ersatz fr den BASIC-GETSIZE. Berechnet aus Breite, H”he und Bitplanes den ' Speicherbedarf eines Rasterblockes. DEFFN getsize(w&,h&,max_p&)=MUL(MUL(MUL(DIV(ADD(w&,15),16),2),h&),max_p&) ' DEFMOUSE 0 ' RETURN ' -------------------------------------- > PROCEDURE bild_laden ' CLS ! Unsauber, aber so sch”n einfach :-( ziel%=0 ' ' Hier muž natrlich IHR Pfad rein... FILESELECT #"Bild laden...","H:\BILDER\*.*","",file$ IF file$<>"" ' OPEN "I",#1,file$ lof%=LOF(#1) ! L„nge der Datei ' quelle%=MALLOC(lof%) ! Quellbereich ' BGET #1,quelle%,lof% CLOSE #1 ' a&=INSTR(file$,".") ext$=MID$(file$,SUCC(a&)) ! Unterscheidung nach dem Extender ' IF ext$="IMG" ! GEM-IMG-Format w&=INT{quelle%+12} ! ...Ausmaže aus dem Header holen h&=INT{quelle%+14} l%=@getsize(w&,h&,1) ' ELSE ! Jedes andere... w&=640 ! ...diese Werte nehmen wir an h&=400 l%=32000 ' ENDIF ' planes&=1 ! Bitplanes der Grafik ' SELECT ext$ ! Bildformat... CASE "PI3","PI2","PI1" ! ...Degas/Elite ' farben$=SPACE$(32) BMOVE quelle%+2,V:farben$,32 ! ...das sind die Farben ' ' Theroretisch w„re es m”glich, diese Farben mit ' ~XBIOS(6,L:V:farben$) ' zu setzen. Da ich aber mit sauberem Beispiel vorangehen m”chte, ' lassen wir diesen Schmutz bleiben! ' ziel%=MALLOC(32000) ! ...Zielbereich anfordern BMOVE quelle%+34,ziel%,32000 ! ...und Daten hinein kopieren ' IF ext$="PI2" ! ...mittlere Aufl”sung h&=200 ! ...andere H”he planes&=2 ' ELSE IF ext$="PI1" ! ...niedrige Aufl”sung w&=320 ! ...alles anders h&=200 planes&=4 ENDIF ' CASE "NEO" ! ...Neochrome ' ziel%=MALLOC(32000) ! ...Zielbereich anfordern BMOVE quelle%+128,ziel%,32000 ! ...und Daten hinein kopieren ' w&=320 ! ...Ausmaže h&=200 planes&=4 ! ...und Bitplanes ' CASE "PC3" ! ...Degas Elite gepackt ziel%=@pc3_entpacken(quelle%,lof%) ' CASE "PIC","DOO" ! ...ST Bildschirm ziel%=quelle% ' CASE "IMG" ! ...GEM-IMG ziel%=@img_laden(quelle%,w&,h&,l%) ' CASE "PAC" ! ...STAD ziel%=@stad_entpacken(quelle%) ' DEFAULT ! ...unbekannt ALERT 3,"|Kein bekanntes Format... ",1,"Abbruch",b& ' ENDSELECT ' ~MFREE(quelle%) ! Den Quellbereich brauchen wir nicht mehr ' ENDIF RETURN ' > FUNCTION pc3_entpacken(quelle%,l%) ' ziel%=MALLOC(32000) ! Zielspeicher anfordern ' ~C:pc3_load_asm%(L:l%-66,L:quelle%+34,L:ziel%) ! ...entpacken ' RETURN ziel% ENDFUNC > FUNCTION stad_entpacken(quelle%) $F% LOCAL a|,b& ' ! Richtigess Format... IF MKL$({quelle%})="pM85" OR MKL$({quelle%})="pM86" ' ziel%=MALLOC(32000) ! Zielspeicher anfordern... ' IF ziel% ! Hat geklappt... ' $C+ a|=BYTE(C:pac_load_asm%(L:ziel%,L:quelle%)) ! ...entpacken $C- ' ELSE ! Kein Speicher frei... ALERT 3," | Nicht genug Speicher... ",1,"Abbruch",b& ENDIF ' IF a|<>0 ! Ging schief... ~MFREE(ziel%) ! ...Zielspeicher freigeben ziel%=0 ALERT 3," |Fehler beim Entpacken... ",1,"Abbruch",b& ENDIF ' ENDIF ' RETURN ziel% ENDFUNC > FUNCTION img_laden(quelle%,w&,h&,l%) $F% LOCAL a%,b& ' ! Richtiges Format... IF CARD{ADD(quelle%,2)}=8 AND CARD{ADD(quelle%,4)}=1 AND CARD{ADD(quelle%,6)}=2 ' ziel%=MALLOC(l%) ! Speicher anfordern ' IF ziel% ! Hat geklappt... ' $C+ a%=C:img_asm%(L:quelle%,L:ziel%,w&,h&,L:l%) ! ...entpacken $C- ' IF a%<>0 ! Ging daneben... ~MFREE(ziel%) ! ...Zielbereich freigeben ziel%=0 ALERT 3," |Fehler beim Entpacken... ",1,"Abbruch",b& ENDIF ' ELSE ! Nicht genug Speicher ALERT 3," | Nicht genug Speicher... ",1,"Abbruch",b& ENDIF ' ENDIF ' RETURN ziel% ENDFUNC ' -------------------------------------- > PROCEDURE bitblt(a%,w&,h&,a&,b%,rb&,rh&,b&,ax&,ay&,ab&,ah&,gx&,gy&,m&) ' ' Universaler Raster-Kopier-Befehl, Ersatz fr RC_COPY, GET/PUT usw. ' Bitte im Sinne von sauberen GEM-Programmen und Aufl”sungsunabh„ngigkeit ' IMMER diesen Befehl vorziehen. ' ' Die šbergabeparameter sind: ' ' a%,w&,h&,a& ' Adresse, Breite, H”he und Bitplanes des Quellrasters ' Fr den Bildschirm 0 bergeben, nicht XBIOS(2) !!! ' ' b%,rb&,rh&,b& ' Adresse, Breite, H”he und Bitplanes des Zielrasters ' Aich hier fr den Bildschirm 0 bergeben. ' ' ax&,ay&,ab&,ah& ' Ausmaže des Quellrechteckes ' (vergl. GET ax&,ay&,ab&,ah&,a$) ' ' gx&,gy& ' Zielposition ' (vergl. PUT a$,gx&,gy&) ' ' m& ' Kopiermodus ' (vergl. PUT a$,gx&,gy&,m&) ' IF ab&>0 AND ah&>0 ! šberhaupt vorhanden... ' q_ras%(0)=a% ! Adresse des Quellrasters... q_ras%(1)=w& ! ...Breite q_ras%(2)=h& ! ...H”he q_ras%(3)=DIV(ADD(w&,15),16) ! ...Breite in Words q_ras%(4)=0 ! ...Immer 0 q_ras%(5)=a& ! ...Bitplanes ' z_ras%(0)=b% ! Adresse des Zielrasters... z_ras%(1)=rb& ! Breite z_ras%(2)=rh& ! ...H”he z_ras%(3)=DIV(ADD(rb&,15),16) ! ...Breite in Words z_ras%(4)=0 ! ...Immer 0 z_ras%(5)=b& ! ...Bitplanes ' par%(0)=ax& ! X1-Quelle par%(1)=ay& ! Y1-Quelle par%(2)=ADD(ax&,PRED(ab&)) ! X2-Quelle par%(3)=ADD(ay&,PRED(ah&)) ! Y2-Quelle par%(4)=gx& ! X1-Ziel par%(5)=gy& ! Y1-Ziel par%(6)=ADD(gx&,PRED(ab&)) ! X2-Ziel par%(7)=ADD(gy&,PRED(ah&)) ! Y2-Ziel par%(8)=m& ! Modus ' ~WIND_UPDATE(1) ! BEG_UPDATE ~GRAF_MOUSE(256,0) ! HIDEM ' BITBLT q_ras%(),z_ras%(),par%() ' ~GRAF_MOUSE(257,0) ! SHOWM ~WIND_UPDATE(0) ! END_UPDATE ' ENDIF ' RETURN