ð<ÐSyntax10.Scn.Fnt:Žÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.Fnt logON logOFF logOFFlogON$Syntax10b.Scn.FntONlogOFFSyntax10b.Scn.Fntp°VersionElemsAllocEndûÿÿ€8ÀÔFoldElemsNew#Syntax10.Scn.FntÅÅ original code from D. Bauer RS, Wed, 16-Jul-1994: added GIF89a RS, Wed, 17-Aug-1994: added transparent gif's RS, Sat, 3-Sep-1994: faster, no log jm, 2.3.95 support for Windows tk, 20.5.95 support for PowerMac ak, 11.8.96 changed for V4 (linz-version) ak, 15.8.96 added abilty to run under tasks mah, 20.9.96 added support for animated gif's ak, 12.11.96 added memory- and size-check for animated gif's ak, 18.11.96 changed to "copy"_less animation ak, 11.12.96 only one init of picture in proper dimensions (animated gif's) ak, 11.12.96 drawing of smaller pictures at the right position (animated gif's) ak, 12.12.96 added disposal method of pictures (animated gif's) ak, 11.4.97 changed animation method (broadcasts) mah, ak, 18.4.97 tuned procedures "LZWDecompression" and "ReadNextCode" ak, 18.4.97 added ability of logging picture information ak, 24.4.97 now drawing with new "Pictures.SetScanLine" ak, 29.4.97 fixed bugs with transparency and background color ak, 23.10.97 added check of image dimensions szamcsi, 31.10.97 added support for encoding and storing cs, 16.2.98 changed some "SYS.LSH(1" to "SYS.LSH(LONG(1)" ak, 9.9.98 overwriting typebound Proc 'DrawStretched' instead of 'Draw' ÿÿÿÿ€8ÀÔ_aÿÿÿp°#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.Fnt00, TextFrames, MenuViewers, Fonts, FoldElems, OutlogOFFp° \ýÿÿ€8ÀÔ{Syntax10.Scn.FntSyntax10i.Scn.Fnt:+* extStart = "!"; (* GIF Extension Introducer *) imgStart = ","; (* GIF Image Descriptor Identifier *) screenDesc = 1; globalColors = 2; switch = 3; extension = 4; imageDesc = 5; localColors = 6; initImage = 7; initLZW = 8; doLZW = 9; clearTable = 10; done = 12; error = 11; eof = Pictures.needData; ok = Pictures.done; failed = Pictures.error; (* function results *) notDef = 0; noDisp = 1; backGnd = 2; prevPic = 4; (* disposal methods for graphics *) bgCol = Display.black; bitsin = 8; (* CHAR has 8 bits *) hashTableSize = 4096; ÿÿÿÿ€8ÀÔíÿÿ€8ÀÔ¨Syntax10.Scn.Fntmÿÿÿ€8ÀÔFoldElemsNew#Syntax10.Scn.Fntqq width, height : INTEGER; globalColMap : BOOLEAN; colResolution, pixel : INTEGER; bgColor : INTEGER END;ÿÿÿÿ€8ÀÔÄÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt R, G, B : INTEGER END;ÿÿÿÿ€8ÀÔ)Syntax10i.Scn.Fnt@*ÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt´´ left, top, bot, width, height : INTEGER; localColMap : BOOLEAN; sequential : BOOLEAN; pixel : INTEGER; dispM : INTEGER; tColIdx : INTEGER; (* tCol : RGBType *) END;ÿÿÿÿ€8ÀÔ(—ÿÿÿ€8ÀÔ#Syntax10.Scn.FntGG AnimationDesc = RECORD (Oberon.TaskDesc) installed : BOOLEAN; END;ÿÿÿÿ€8ÀÔ$rÿÿÿ€8ÀÔ#Syntax10.Scn.Fntll PictureDesc = RECORD (Pictures.PictureDesc) next : Picture; anim : Animation; delay : LONGINT; END;ÿÿÿÿ€8ÀÔ+³ÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt++ pic : Picture; anim : Animation; END;ÿÿÿÿ€8ÀÔ,˜ÿÿÿ€8ÀÔ#Syntax10.Scn.FntFF WipeOutAreaDesc = RECORD left, bot, width, height : INTEGER; END;ÿÿÿÿ€8ÀÔ&üÿÿ€8ÀÔSyntax10.Scn.FntSyntax10i.Scn.Fnt ÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.Fnt; log : Texts.TextlogOFFp°VersionElemsAllocEndÔ LoadInfoDesc = RECORD (Pictures.LoadInfoDesc) riderStart : LONGINT; r : Files.Rider; state, pixel, map, actMap, tx : INTEGER; colMap : ColorMap; scrDsc : ScrDscType; imgDsc : ImgDscType; pCount, dispM : INTEGER; table : ARRAY 4096 OF RECORD c, ref : INTEGER; END; (* LZW Decompression *) codesize, startcodesize : INTEGER; buf : INTEGER; buffer : ARRAY 256 OF CHAR; inbuf, bufpos : INTEGER; bitsleft, clearcode, endcode : INTEGER; code, oldcode, incode, intab, codestart, fin : INTEGER; dots, scanLine : ImageLine; interlace, x, y, w : INTEGER; updBot, updTop : INTEGER; lastUpd : LONGINT; prevPic : Pictures.Picture; wipeOut : WipeOutArea; pics : Picture; delay : LONGINT END;ÿÿÿÿ€8ÀÔ)gÿÿÿ€8ÀÔ#Syntax10.Scn.Fntww StoreInfoDesc = RECORD r : Files.Rider; imgDsc : ImgDscType; scrDsc : ScrDscType; map : ColorMap; END;ÿÿÿÿ€8ÀÔ+ÿÿÿ€8ÀÔQSyntax10.Scn.Fnt2Syntax10i.Scn.Fnt4$® BlockStreamDesc = RECORD store : StoreInfo; (* the output rider is here *) buffer : ARRAY 256 OF CHAR; bufsize: INTEGER; (* size of the data in the buffer *) END;ÿÿÿÿ€8ÀÔ(÷þÿÿ€8ÀÔ_Syntax10.Scn.Fnt1Syntax10i.Scn.Fnt#« BitStreamDesc = RECORD bs : BlockStream; (* output *) bufsize : INTEGER; (* number of bits in the buffer *) buffer : LONGINT; (* buffer for bits *) END;ÿÿÿÿ€8ÀÔ(.þÿÿ€8ÀÔcSyntax10.Scn.Fntÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogONUSyntax10b.Scn.FntSyntax10.Scn.Fnt#Syntax10i.Scn.Fnt%Mfull- : BOOLEAN; size : INTEGER; (* number of elements in the table *)p°VersionElemsAllocEndSp HashTableDesc = RECORD table : ARRAY hashTableSize OF RECORD key : LONGINT; code : INTEGER; END; END;ÿÿÿÿ€8ÀÔ^ýÿÿ€8ÀÔ#Syntax10.Scn.Fnt€€ LZWDesc = RECORD ht : HashTable; bt : BitStream; store : StoreInfo; codesize : INTEGER; (* code size in bits *) startcodesize : INTEGER; (* size of the first code *) clearcode : INTEGER; (* clear message for the decompressor *) endcode : INTEGER; (* EOF code for the decompressor *) startcode : INTEGER; (* first code after (re)start *) maxcode : INTEGER; (* maximal code, which can be fit into the actual codesize *) code : INTEGER; (* actual code *) nextcode : INTEGER; (* next usable code *) start : BOOLEAN; (* the encoder has to be started *) END;ÿÿÿÿ€8ÀÔI ScrDscType = RECORD RGBType = RECORD ColorMap = ARRAY 2, 256 OF RGBType; (* Max. Color-Map-Size *) ImageLine = POINTER TO ARRAY OF CHAR; ImgDscType = RECORD Animation = POINTER TO AnimationDesc; Picture = POINTER TO PictureDesc; SearchPicMsg = RECORD (PElems.ModifyMsg) WipeOutArea = POINTER TO WipeOutAreaDesc; LoadInfo = POINTER TO LoadInfoDesc; StoreInfo = POINTER TO StoreInfoDesc; BlockStream = POINTER TO BlockStreamDesc; BitStream = POINTER TO BitStreamDesc; HashTable = POINTER TO HashTableDesc; LZW = POINTER TO LZWDesc; ÿÿÿÿ€8ÀÔïþÿÿp°#Syntax10.Scn.Fnt logON logOFF logOFFlogON¿Syntax10.Scn.Fnt“ÿÿÿ€8ÀÔFoldElemsNew#Syntax10.Scn.FntKK w, wExt : Texts.Writer; head, norm : Fonts.Font; fold : FoldElems.Elem;ÿÿÿÿ€8ÀÔVAR logOFFp°Y&ÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt¸¸ BEGIN p.DrawStretched^(sx, sy, sw, sh, dx, dy, dw, dh, mode); IF (p.anim # NIL) & ~ p.anim.installed THEN Oberon.Install(p.anim); p.anim.installed := TRUE END END DrawStretched;ÿÿÿÿ€8ÀÔ@ÿÿÿÿ€8ÀÔÑÿÿÿÿ€8ÀÔ7•ÿÿÿ€8ÀÔ#Syntax10.Scn.FntII BEGIN RETURN Files.Length(Files.Base(r)) - Files.Pos(r) END Available;ÿÿÿÿ€8ÀÔ;§ÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt77 BEGIN Files.Set(r, Files.Base(r), pos) END SetRider;ÿÿÿÿ€8ÀÔDNùÿÿ€8ÀÔñSyntax10.Scn.Fnt¯Syntax10i.Scn.Fnt ‘³ûÿÿp°VersionElemsAllocBeg#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.FntÞÞ Texts.SetFont(w, head); Texts.WriteLn(w); Texts.WriteString(w, "Logical Screen Descriptor:"); Texts.WriteLn(w); Texts.SetFont(w, Fonts.Default); Texts.Write(w, 09X); Texts.WriteString(w, "ScreenWidth x ScreenHeight: "); Texts.WriteInt(w, dsc.width, 0); Texts.WriteString(w, " x "); Texts.WriteInt(w, dsc.height, 0); Texts.WriteLn(w); Texts.Write(w, 09X); Texts.WriteString(w, "Size of GlobalColorTable: "); Texts.WriteInt(w, dsc.pixel, 0); Texts.WriteString(w, " ("); Texts.WriteInt(w, ASH(1, dsc.pixel) - 1, 0); Texts.Write(w, ")"); Texts.WriteLn(w); Texts.Write(w, 09X); Texts.WriteString(w, "Color Resolution: "); Texts.WriteInt(w, dsc.colResolution, 0); Texts.WriteLn(w); Texts.Write(w, 09X); Texts.WriteString(w, "GlobalColorTable Flag: "); IF ~ dsc.globalColMap THEN Texts.WriteString(w, "not ") END; Texts.WriteString(w, "set"); Texts.WriteLn(w); Texts.Write(w, 09X); Texts.WriteString(w, "BackgroundColor Index: "); Texts.WriteInt(w, dsc.bgColor, 0); Texts.WriteLn(w); logOFFp°VersionElemsAllocEndoÂ VAR c : CHAR; i : INTEGER; BEGIN Files.ReadInt(r, dsc.width); Files.ReadInt(r, dsc.height); Files.Read(r, c); i := ORD(c); dsc.pixel := (i MOD 8) + 1; i := i DIV 16; (* ! *) (* GCCC 0PPP *) dsc.colResolution := (i MOD 8) + 1; i := i DIV 8; dsc.globalColMap := i # 0; Files.Read(r, c); dsc.bgColor := ORD(c); Files.Read(r, c); IF dsc.globalColMap & (dsc.colResolution < dsc.pixel) THEN dsc.colResolution := dsc.pixel END END ScanScrDsc;ÿÿÿÿ€8ÀÔB‚ÿÿÿp°#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.Fnt; pNr : INTEGERlogOFFp°2ùÿÿ€8ÀÔvSyntax10.Scn.FntçSyntax10i.Scn.Fnt O.ûÿÿp°VersionElemsAllocBeg#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.Fntcc; Texts.SetFont(w, head); Texts.WriteLn(w); Texts.WriteString(w, "Logical Image Descriptor ("); Texts.WriteInt(w, pNr, 0); Texts.WriteString(w, "):"); Texts.WriteLn(w); Texts.SetFont(w, Fonts.Default); Texts.Write(w, 09X); Texts.WriteString(w, "Left x Top: "); Texts.WriteInt(w, dsc.left, 0); Texts.WriteString(w, " x "); Texts.WriteInt(w, dsc.top, 0); Texts.WriteLn(w); Texts.Write(w, 09X); Texts.WriteString(w, "Width x Height: "); Texts.WriteInt(w, dsc.width, 0); Texts.WriteString(w, " x "); Texts.WriteInt(w, dsc.height, 0); Texts.WriteLn(w); Texts.Write(w, 09X); Texts.WriteString(w, "LocalColorTable Flag: "); IF ~ dsc.localColMap THEN Texts.WriteString(w, "not ") END; Texts.WriteString(w, "set"); Texts.WriteLn(w); Texts.Write(w, 09X); Texts.WriteString(w, "Interlace Flag: "); IF dsc.sequential THEN Texts.WriteString(w, "not ") END; Texts.WriteString(w, "set"); Texts.WriteLn(w); Texts.Write(w, 09X); Texts.WriteString(w, "Size Of LocalColorTable: "); Texts.WriteInt(w, dsc.pixel, 0); Texts.WriteString(w, " ("); Texts.WriteInt(w, ASH(1, dsc.pixel) - 1, 0); Texts.Write(w, ")"); Texts.WriteLn(w); logOFFp°VersionElemsAllocEndY VAR c : CHAR; i : INTEGER; BEGIN Files.ReadInt(r, dsc.left); Files.ReadInt(r, dsc.top); Files.ReadInt(r, dsc.width); Files.ReadInt(r, dsc.height); Files.Read(r, c); i := ORD(c); dsc.pixel := (i MOD 8) + 1; i := i DIV 64; (* ! *) (* LS00 0PPP *) dsc.sequential := (i MOD 2) = 0; i := i DIV 2; dsc.localColMap := i = 1 END ScanImgDsc;ÿÿÿÿ€8ÀÔZ«÷ÿÿ€8ÀÔZSyntax10.Scn.Fnt|þÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogON logOFFlogOFFlogONSyntax10.Scn.Fnt%Hÿÿÿ€8ÀÔFoldElemsNew#Syntax10.Scn.Fnt–– BEGIN Texts.Write(w, CHR(x DIV 100 + 30H)); Texts.Write(w, CHR(x MOD 100 DIV 10 + 30H)); Texts.Write(w, CHR(x MOD 10 + 30H)) END WriteTriple;ÿÿÿÿ€8ÀÔ( PROCEDURE WriteTriple(x: LONGINT); logOFFp°VersionElemsAllocEnd þÿÿp°#Syntax10.Scn.FntlogON logOFFlogOFFlogON#Syntax10.Scn.Fnt…… Texts.SetFont(w, head); Texts.WriteLn(w); Texts.WriteString(w, "ColorTable"); Texts.Write(w, 09X); Texts.SetFont(w, Fonts.Default); NEW(fold); fold.mode := FoldElems.expLeft; fold.W := FoldElems.elemW; fold.H := FoldElems.elemH; fold.visible := TRUE; fold.handle := FoldElems.FoldHandler; NEW(fold.hidden); Texts.OpenBuf(fold.hidden); Texts.WriteElem(w, fold); Texts.WriteLn(w); logOFFp°µrþÿÿp°#Syntax10.Scn.FntlogON logOFFlogOFFlogON#Syntax10.Scn.Fnt ; Texts.Write(w, 09X); WriteTriple(i);Texts.WriteString(w, " = ("); WriteTriple(map[idx, i].R); Texts.WriteString(w, ", "); WriteTriple(map[idx, i].G); Texts.WriteString(w, ", "); WriteTriple(map[idx, i].B); Texts.Write(w, ")"); IF (i + 1) MOD 4 = 0 THEN Texts.WriteLn(w) END logOFFp°–þÿÿp°#Syntax10.Scn.FntlogON logOFFlogOFFlogON#Syntax10.Scn.Fntüü; IF i MOD 4 # 0 THEN Texts.WriteLn(w) END; NEW(fold); fold.mode := FoldElems.expRight; fold.W := FoldElems.elemW; fold.H := FoldElems.elemH; fold.visible := TRUE; fold.handle := FoldElems.FoldHandler; Texts.WriteElem(w, fold); Texts.WriteLn(w); logOFFp°ü VAR c : CHAR; i : INTEGER; BEGIN FOR i := 0 TO SHORT(ASH(1, pixel)) - 1 DO Files.Read(r, c); map[idx, i].R := ORD(c); Files.Read(r, c); map[idx, i].G := ORD(c); Files.Read(r, c); map[idx, i].B := ORD(c) END END ScanColTable;ÿÿÿÿ€8ÀÔ]Aÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt VAR i : INTEGER; BEGIN FOR i := 0 TO SHORT(ASH(1, pixel)) - 1 DO pict.SetPalette(i, map[idx, i].R, map[idx, i].G, map[idx, i].B) END END SetColTable;ÿÿÿÿ€8ÀÔNÃþÿÿ€8ÀÔ#Syntax10.Scn.Fnt VAR file : Files.File; r2 : Files.Rider; pos : LONGINT; c : CHAR; BEGIN file := Files.Base(r); pos := Files.Pos(r) + 1; c := 1X; WHILE (c # 0X) & (len > pos) DO Files.Set(r2, file, pos); Files.Read(r2, c); pos := pos + ORD(c) + 1; END; RETURN c = 0X END ExtBlockAvailable;ÿÿÿÿ€8ÀÔ^¶óÿÿ€8ÀÔE Syntax10.Scn.Fntäýÿÿ€8ÀÔFoldElemsNew<Syntax10.Scn.FntSyntax10i.Scn.Fntàá Fx {len {byte}*len} 0X FE {len {byte}*len} 0X text F9 04 YY ZZ ZZ 2B color 2B is transparent -- F9: Graphic Control Label 04: len YY: packed (0 is LSB) Bit 0: transparent color flag Bit 1: user input flag Bits 2-4: disposal method 00h = not difined 01h = do not dispose of graphic 02h = overwrite graphic with background color 04h = overwrite graphic with previous graphic Bits 5-7: reserved ZZ ZZ: delay time 2B: index of "transparent" color Syntax10i.Scn.Fnt'ÿÿÿÿ€8ÀÔ‡ áþÿÿp°VersionElemsAllocBeg#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.Fnt°° Texts.SetFont(wExt, head); Texts.WriteLn(wExt); Texts.WriteString(wExt, "Graphics Control Extension Block:"); Texts.WriteLn(wExt); Texts.SetFont(wExt, Fonts.Default); logOFFp°VersionElemsAllocEndè ?ÿÿÿp°#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.FntRR Texts.Write(wExt, 09X); Texts.WriteString(wExt, "Transparent Color Flag: "); logOFFp°)pÿÿÿp°#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.Fnt!!; Texts.WriteString(wExt, "not ")logOFFp° Çüÿÿp°#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.FntÊÊ Texts.WriteString(wExt, "set"); Texts.WriteLn(wExt); Texts.Write(wExt, 09X); Texts.WriteString(wExt, "Disposal Method: "); Texts.WriteInt(wExt, dispM, 0); CASE dispM OF notDef : Texts.WriteString(wExt, " (not specified)") | noDisp : Texts.WriteString(wExt, " (no disposal)") | backGnd : Texts.WriteString(wExt, " (overwrite with background)") | prevPic : Texts.WriteString(wExt, " (overwrite with previous picture)") END; Texts.WriteLn(wExt); Texts.Write(wExt, 09X); Texts.WriteString(wExt, "Delay Time: "); Texts.WriteInt(wExt, delay, 0); Texts.WriteLn(wExt); Texts.Write(wExt, 09X); Texts.WriteString(wExt, "Transparent Color Index: "); Texts.WriteInt(wExt, tx, 0); Texts.WriteLn(wExt); logOFFp°“ (* structure of a graphics extension block *) VAR t, x, y : CHAR; pos : LONGINT; i : INTEGER; BEGIN delay := 0; Files.Read(r, t); Files.Read(r, x); pos := Files.Pos(r); (* label len *) IF t = 0F9X THEN Files.Read(r, y); i := ORD(y); dispM := (i DIV 4) MOD 8; IF ~ (dispM IN {notDef, noDisp, backGnd, prevPic}) THEN dispM := notDef END; Files.Read(r, y); delay := ORD(y); Files.Read(r, y); delay := delay + 256 * ORD(y); (* delay time *) IF i MOD 2 = 1 THEN (* transparent color flag set *) Files.Read(r, y); tx := ORD(y) (* index of transparent color *) ELSE tx := -1 END; SetRider(r, pos + ORD(x)); Files.Read(r, x) END; WHILE x # 0X DO SetRider(r, Files.Pos(r) + ORD(x)); Files.Read(r, x) END END ScanExtBlock;ÿÿÿÿ€8ÀÔ52úÿÿ€8ÀÔ·Syntax10.Scn.FntSyntax10i.Scn.Fntiv%Syntax10b.Scn.Fntr–”ä (* produce next code until end *) CONST bitsin = 8; (* CHAR has 8 bits *) VAR a, b, d, bitsneed, newbits : INTEGER; c : CHAR; BEGIN IF ldr.bitsleft < ldr.codesize THEN (* fewer bits than needed... *) bitsneed := ldr.codesize - ldr.bitsleft; b := 0; WHILE (bitsneed > 0) DO IF ldr.bufpos = ldr.inbuf THEN (* read next data block *) IF Available(ldr.r) < 1 THEN RETURN eof END; Files.Read(ldr.r, c); IF Available(ldr.r) < ORD(c) THEN SetRider (ldr.r, Files.Pos(ldr.r) - 1); RETURN eof END; ldr.inbuf := ORD(c); ldr.bufpos := 0; Files.ReadBytes(ldr.r, ldr.buffer, ldr.inbuf) END; IF ldr.inbuf = 0 THEN ldr.code := 0; RETURN failed END; a := ORD(ldr.buffer[ldr.bufpos]); INC(ldr.bufpos); IF bitsneed < bitsin THEN b := SYS.LSH(a, -bitsneed); DEC(a, SYS.LSH(b, bitsneed)); newbits := bitsneed ELSE newbits := bitsin; END; INC(ldr.buf, SYS.LSH(a, ldr.bitsleft)); INC(ldr.bitsleft, bitsin); DEC(bitsneed, newbits); END; ldr.code := ldr.buf; DEC(ldr.bitsleft, ldr.codesize); ldr.buf := b; ELSE (* enough bits *) d := SYS.LSH(ldr.buf, -ldr.codesize); d := SYS.LSH(d, ldr.codesize); a := ldr.buf - d; ldr.buf := SYS.LSH(ldr.buf, -ldr.codesize); DEC(ldr.bitsleft, ldr.codesize); ldr.code := a; END; RETURN ok; END ReadNextCode;ÿÿÿÿ€8ÀÔF/þÿÿ€8ÀÔ#Syntax10.Scn.Fnt¯¯ BEGIN IF b < ldr.updBot THEN ldr.updBot := b END; IF t > ldr.updTop THEN ldr.updTop := t END; IF (ldr.updTop >= ldr.updBot) & (force OR (ldr.lastUpd + Input.TimeUnit DIV 2 <= Input.Time())) THEN ldr.picture.Update(NIL, ldr.imgDsc.left, ldr.imgDsc.bot + ldr.updBot, ldr.imgDsc.width, ldr.updTop - ldr.imgDsc.bot - ldr.updBot + 1); ldr.updBot := MAX(INTEGER); ldr.updTop := - 1; ldr.lastUpd := Input.Time() END END Update;ÿÿÿÿ€8ÀÔ1tùÿÿ€8ÀÔ‰Syntax10.Scn.Fnt|Syntax10i.Scn.Fnt£6Y<D¾ Ù VAR h, i : INTEGER; tColIdx : CHAR; BEGIN ldr.dots[ldr.x] := CHR(col); INC(ldr.x); DEC(ldr.w); IF ldr.w = 0 THEN (* dotline complete *) ldr.w := ldr.imgDsc.width; ldr.x := 0; IF ldr.y - ldr.interlace < - 1 THEN h := ldr.y + 1 ELSE h := ldr.interlace END; IF ldr.imgDsc.tColIdx < 0 THEN (* no transparency *) IF ldr.imgDsc.width = ldr.scrDsc.width THEN (* draw whole line *) ldr.picture.SetScanLine(ldr.dots^, ldr.imgDsc.bot + ldr.y - h + 1, h) ELSE (* draw part of line; drawing height is 1, even when interlaced *) ldr.picture.GetScanLine(ldr.scanLine^, ldr.imgDsc.bot + ldr.y); FOR i := 0 TO ldr.imgDsc.width - 1 DO ldr.scanLine[i + ldr.imgDsc.left] := ldr.dots[i] END; ldr.picture.SetScanLine(ldr.scanLine^, ldr.imgDsc.bot + ldr.y, 1) END ELSE (* copy non-transparent dots; drawing height is 1, even when interlaced *) ldr.picture.GetScanLine(ldr.scanLine^, ldr.imgDsc.bot + ldr.y); tColIdx := CHR(ldr.imgDsc.tColIdx); FOR i := 0 TO ldr.imgDsc.width - 1 DO IF ldr.dots[i] # tColIdx THEN ldr.scanLine[i + ldr.imgDsc.left] := ldr.dots[i] END END; ldr.picture.SetScanLine(ldr.scanLine^, ldr.imgDsc.bot + ldr.y, 1) END; IF ldr.pCount = 1 THEN Update(ldr.y - h + 1, ldr.y, FALSE, ldr) END; IF ldr.imgDsc.sequential THEN DEC(ldr.y) ELSE (* interlace *) IF ldr.interlace >= 8 THEN DEC(ldr.y, 2*4) ELSE DEC(ldr.y, 2*ldr.interlace) END; IF ldr.y < 0 THEN ldr.interlace := ldr.interlace DIV 2; ldr.y := ldr.imgDsc.height - 1 - ldr.interlace END END END END Dot;ÿÿÿÿ€8ÀÔ0Ìúÿÿ€8ÀÔ©Syntax10.Scn.FntnSyntax10b.Scn.FntÈSyntax10i.Scn.Fnt¾1072‰Œ VAR c : CHAR; res : INTEGER; pos : LONGINT; BEGIN pos := Files.Pos(ldr.r); IF Available(ldr.r) < 1 THEN RETURN eof END; Files.Read(ldr.r,c); ldr.codesize := ORD(c); ldr.clearcode := SYS.LSH(LONG(1), ldr.codesize); ldr.endcode := ldr.clearcode + 1; INC(ldr.codesize); ldr.startcodesize := ldr.codesize; (* effective codesize *) ldr.bitsleft := 0; ldr.buf := 0; ldr.incode := 0; ldr.inbuf := 0; ldr.bufpos := 0; ldr.intab := 0; ldr.codestart := ldr.clearcode + 2; res := ReadNextCode(ldr); IF res = failed THEN RETURN res ELSIF res = eof THEN SetRider(ldr.r, pos); RETURN res END; IF ldr.code = ldr.clearcode THEN (* table already cleared *) res := ReadNextCode(ldr); IF res = failed THEN RETURN res ELSIF res = eof THEN SetRider(ldr.r, pos); RETURN res END END; ldr.x := 0; ldr.y := ldr.imgDsc.height-1; ldr.interlace := 1; ldr.w := ldr.imgDsc.width; NEW(ldr.dots, ldr.w); IF ~ ldr.imgDsc.sequential THEN WHILE (ldr.interlace < 8 ) & (ldr.interlace < ldr.imgDsc.height) DO INC(ldr.interlace, ldr.interlace) END END; ldr.oldcode := ldr.code; ldr.fin := ldr.code; Dot(ldr.code, ldr); ldr.incode := ldr.code; RETURN ok END InitLZW;ÿÿÿÿ€8ÀÔ8Jóÿÿ€8ÀÔñSyntax10.Scn.FntSyntax10i.Scn.FntvÁþÿÿ€8ÀÔFoldElemsNewCSyntax10.Scn.FntSyntax10i.Scn.Fnt&? (* init local variables *) instack := - 1; intab := ldr.intab; endcode := ldr.endcode; clearcode := ldr.clearcode; code := ldr.code; oldcode := ldr.oldcode; incode := ldr.incode; codestart := ldr.codestart; codesize := ldr.codesize; fin := ldr.fin; state := ldr.state; w := ldr.w; x := ldr.x; dots := ldr.dots; ÿÿÿÿ€8ÀÔžC¥§ÿÿÿ€8ÀÔCSyntax10.Scn.FntSyntax10i.Scn.Fnt Ÿ° (* tuned version *) IF w > 1 THEN dots[x] := CHR(code); INC(x); DEC(w) ELSE ldr.x := x; ldr.w := w; Dot(code, ldr); w := ldr.w; x := ldr.x END; ÿÿÿÿ€8ÀÔ"óþÿÿ€8ÀÔCSyntax10.Scn.FntSyntax10i.Scn.Fnt ºË (* tuned version *) IF w > 1 THEN dots[x] := CHR(stack[instack]); INC(x); DEC(w) ELSE ldr.x := x; ldr.w := w; Dot(stack[instack], ldr); w := ldr.w; x := ldr.x END; ÿÿÿÿ€8ÀÔ§ÁÔþÿÿ€8ÀÔCSyntax10.Scn.FntSyntax10i.Scn.FntÐê (* reset loader variables *) ldr.intab := intab; ldr.code := code; ldr.oldcode := oldcode; ldr.incode := incode; ldr.codestart := codestart; ldr.codesize := codesize; ldr.fin := fin; ldr.state := state; ldr.x := x; ldr.w := w; ÿÿÿÿ€8ÀÔ'Æ (* -> Terry A. Welch, "A Technique for High Performance Data Compression", IEEE Computer, vol 17, June 1984, Page 8-19 *) VAR instack, intab, endcode, clearcode, code, oldcode, incode, codestart, codesize, fin, state, cDiff, w, x, res : INTEGER; dots : ImageLine; stack : ARRAY 1024 OF INTEGER; BEGIN init local variables REPEAT ldr.codesize := codesize; res := ReadNextCode(ldr); code := ldr.code; IF res = ok THEN IF code = endcode THEN state := switch; ldr.picture.Update(NIL, 0, 0, ldr.picture.width, ldr.picture.height); ldr.updBot := MAX(INTEGER); ldr.updTop := - 1; ldr.lastUpd := Input.Time() ELSIF code = clearcode THEN state := clearTable; intab := 0; codesize := ldr.startcodesize ELSE (* real decompression *) incode := code; IF (code >= intab + codestart) THEN (* abnormal case : unknown code ! *) INC(instack); stack[instack] := fin; code := oldcode; incode := codestart + intab END; cDiff := code - codestart; WHILE (cDiff >= 0) DO (* recursive develop code *) INC(instack); stack[instack] := ldr.table[cDiff].c; cDiff := ldr.table[cDiff].ref-codestart END; code := cDiff + codestart; fin := code; Dot(code, ldr); WHILE (instack >= 0) DO Dot(stack[instack], ldr); DEC(instack) END; ldr.table[intab].c := code; ldr.table[intab].ref := oldcode; INC(intab); IF intab + codestart = SYS.LSH(LONG(1), codesize) THEN (* new codesize *) INC(codesize); IF codesize = 13 THEN codesize := 12 END END; oldcode := incode; END ELSIF res = failed THEN state := error END UNTIL (res # ok) OR (state # doLZW); reset loader variables RETURN res # eof END LZWDecompressed;ÿÿÿÿ€8ÀÔ8Îþÿÿ€8ÀÔ#Syntax10.Scn.Fnt VAR col, red, green, blue: INTEGER; BEGIN FOR col := 0 TO SHORT(ASH(1, src.depth)) - 1 DO src.GetPalette(col, red, green, blue); dest.SetPalette(col, red, green, blue) END; src.CopyBlock(dest, 0, 0, src.width, src.height, 0, 0, Display.replace) END CopyPicture;ÿÿÿÿ€8ÀÔ-¦üÿÿ€8ÀÔ_Syntax10.Scn.Fnt(Syntax10i.Scn.Fnto7,Ôü BEGIN IF ldr.dispM = prevPic THEN (* save displayed picture *) IF ldr.prevPic = NIL THEN NEW(ldr.prevPic); ldr.prevPic.Init(ldr.picture.width, ldr.picture.height, ldr.picture.depth); IF ldr.prevPic.depth = 0 THEN ldr.prevPic := NIL END END; IF ldr.prevPic # NIL THEN CopyPicture(ldr.picture, ldr.prevPic) END END; IF ldr.imgDsc.dispM > noDisp THEN IF (ldr.imgDsc.dispM = prevPic) & (ldr.prevPic # NIL) THEN (* restore previous picture *) CopyPicture(ldr.prevPic, ldr.picture) ELSE (* overwrite with background = default disposal *) NEW(ldr.wipeOut); ldr.wipeOut.left := ldr.imgDsc.left; ldr.wipeOut.bot := ldr.imgDsc.bot; ldr.wipeOut.width := ldr.imgDsc.width; ldr.wipeOut.height := ldr.imgDsc.height END END END DisposePicture;ÿÿÿÿ€8ÀÔ;¥þÿÿ€8ÀÔ#Syntax10.Scn.Fnt99 VAR prev : Picture; BEGIN IF ldr.delay = 0 THEN new.delay := Input.TimeUnit DIV 8 ELSE new.delay := ldr.delay * (Input.TimeUnit DIV 100) END; IF ldr.pics = NIL THEN ldr.pics := new ELSE prev := ldr.pics; WHILE prev.next # NIL DO prev := prev.next END; prev.next := new END END AppendAnimPic;ÿÿÿÿ€8ÀÔ-ÿÿÿ€8ÀÔ#Syntax10.Scn.FntÖÖ VAR new : Picture; BEGIN NEW(new); new.Init(ldr.picture.width, ldr.picture.height, ldr.picture.depth); IF new.depth > 0 THEN CopyPicture(ldr.picture, new); AppendAnimPic(ldr, new) END END SavePicForAnim;ÿÿÿÿ€8ÀÔ2ÿÿÿ€8ÀÔ#Syntax10.Scn.FntÂÂ BEGIN WITH m : SearchPicMsg DO IF (m.pic = NIL) & (m.e.pic # NIL) & (m.e.pic IS Picture) & (m.e.pic(Picture).anim = m.anim) THEN m.pic := m.e.pic(Picture) END ELSE END END SearchPic;ÿÿÿÿ€8ÀÔ„þÿÿ€8ÀÔ#Syntax10.Scn.FntZZ VAR next : Picture; m : SearchPicMsg; BEGIN m.check := SearchPic; m.anim := Oberon.CurTask(Animation); Viewers.Broadcast(m); IF m.pic # NIL THEN next := m.pic.next; m.pic.Update(next, 0, 0, next.width, next.height); m.anim.time := Oberon.Time() + m.pic.delay ELSE Oberon.Remove(m.anim); m.anim.installed := FALSE END END Animate;ÿÿÿÿ€8ÀÔ(¬þÿÿ€8ÀÔ#Syntax10.Scn.Fnt22 VAR anim : Animation; pic : Picture; BEGIN NEW(anim); anim.safe := FALSE; anim.handle := Animate; anim.time := 0; pic := ldr.pics; WHILE pic.next # NIL DO pic.anim := anim; pic := pic.next END; pic.anim := anim; pic.next := ldr.pics; Oberon.Install (anim); anim.installed := TRUE END StartAnim;ÿÿÿÿ€8ÀÔ™ûÿÿp°#Syntax10.Scn.Fnt logON logOFF logOFFlogONÇSyntax10.Scn.Fnt'Äþÿÿ€8ÀÔFoldElemsNew#Syntax10.Scn.Fnt VAR x, y : INTEGER; v : MenuViewers.Viewer; BEGIN Oberon.AllocateUserViewer(0, x, y); ldr.log := TextFrames.Text(""); v := MenuViewers.New( TextFrames.NewMenu("GIF.Debug.Text", "^Edit.Menu.Text"), TextFrames.NewText(ldr.log, 0), TextFrames.menuH, x, y) END OpenViewer;ÿÿÿÿ€8ÀÔ)ïýÿÿ€8ÀÔ#Syntax10.Scn.Fntïï VAR pic : Pictures.Picture; BEGIN NEW(pic); pic.Init(ldr.picture.width, ldr.picture.height, ldr.picture.depth); IF pic.depth > 0 THEN CopyPicture(ldr.picture, pic); PElems.Alloc; Texts.new(PElems.Elem).pic := pic; Texts.SetFont(w, head); Texts.WriteLn(w); Texts.WriteString(w, "Image "); Texts.WriteInt(w, ldr.pCount - 1, 0); Texts.WriteLn(w); Texts.SetFont(w, Fonts.Default); Texts.WriteElem(w, Texts.new); Texts.WriteLn(w); Texts.Append(ldr.log, w.buf) END END LogPicture;ÿÿÿÿ€8ÀÔTPROCEDURE OpenViewer (ldr : LoadInfo); PROCEDURE LogPicture (ldr : LoadInfo); logOFFp°0cæÿÿ€8ÀÔSyntax10.Scn.Fnt•üÿÿ€8ÀÔFoldElemsNewPSyntax10.Scn.FntEtÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.FntTexts.Append(ldr.log, w.buf);logOFFp°VersionElemsAllocEnd1Syntax10i.Scn.Fnt-J Syntax10b.Scn.Fnt® IF Available(ldr.r) >= 7 THEN ScanScrDsc(ldr.r, ldr.scrDsc); NEW(ldr.scanLine, ldr.scrDsc.width); (* initialize picture with the proper dimensions *) IF ldr.scrDsc.colResolution > 4 THEN pixl := 8 ELSIF ldr.scrDsc.colResolution > 1 THEN pixl := 4 ELSE pixl := ldr.scrDsc.colResolution END; IF ldr.picture = NIL THEN NEW(ldr.picture) END; ldr.picture.Init(ldr.scrDsc.width, ldr.scrDsc.height, pixl); IF ldr.picture.depth = 0 THEN ldr.state := error (* not enough memory *) ELSIF ldr.scrDsc.globalColMap THEN ldr.map := 0; ldr.pixel := ldr.scrDsc.pixel; ldr.state := globalColors ELSE ldr.state := switch END ELSE RETURN eof ENDÿÿÿÿ€8ÀÔ þÿÿ€8ÀÔ>Syntax10.Scn.FntŠXÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogON logOFFlogOFFlogON#Syntax10.Scn.Fnt::; Texts.Append(ldr.log, w.buf); FoldElems.Switch(fold)logOFFp°VersionElemsAllocEnd Syntax10b.Scn.Fnt£ IF Available(ldr.r) >= SHORT(ASH(1, ldr.pixel)) * 3 THEN ScanColTable(ldr.r, ldr.map, ldr.pixel, ldr.colMap); ldr.state := switch ELSE RETURN eof ENDÿÿÿÿ€8ÀÔªûÿÿ€8ÀÔ„Syntax10.Scn.Fntðÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.FntLogPicture(ldr);logOFFp°VersionElemsAllocEndApÿÿÿp°#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.Fnt!!; Texts.Append(ldr.log, wExt.buf)logOFFp°toÿÿÿp°#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.Fnt""; INC(ldr.pCount); LogPicture(ldr)logOFFp°Syntax10b.Scn.FntÓ IF Available(ldr.r) >= 1 THEN Files.Read(ldr.r, c); IF c # 0X THEN IF c = extStart THEN ldr.state := extension ELSIF c = imgStart THEN ldr.state := imageDesc; INC(ldr.pCount); IF ldr.pCount > 1 THEN SavePicForAnim(ldr); DisposePicture(ldr) END ELSE ldr.state := done; IF ldr.pCount > 1 THEN AppendAnimPic(ldr, ldr.picture(Picture)) END END END ELSE RETURN eof ENDÿÿÿÿ€8ÀÔÿÿÿ€8ÀÔCSyntax10.Scn.Fnt™Syntax10b.Scn.Fnt§ IF ExtBlockAvailable(ldr.r, Files.Length(Files.Base(ldr.r))) THEN ScanExtBlock(ldr.r, ldr.tx, ldr.dispM, ldr.delay); ldr.state := switch ELSE RETURN eof ENDÿÿÿÿ€8ÀÔMüÿÿ€8ÀÔXSyntax10.Scn.FntCeÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.Fnt,,, ldr.pCount); Texts.Append(ldr.log, w.buf);logOFFp°VersionElemsAllocEndSyntax10i.Scn.FntéSyntax10b.Scn.Fnt\ IF Available(ldr.r) >= 9 THEN ScanImgDsc(ldr.r, ldr.imgDsc ); (* image dimensions check *) IF (ldr.imgDsc.top + ldr.imgDsc.height > ldr.scrDsc.height) OR (ldr.imgDsc.left + ldr.imgDsc.width > ldr.scrDsc.width) THEN ldr.state := error ELSE ldr.imgDsc.bot := ldr.scrDsc.height - ldr.imgDsc.height - ldr.imgDsc.top; ldr.imgDsc.dispM := ldr.dispM; ldr.imgDsc.tColIdx := ldr.tx; IF ldr.imgDsc.localColMap THEN ldr.map := 1; ldr.pixel := ldr.imgDsc.pixel; ldr.state := localColors ELSE ldr.map := 0; ldr.state := initImage END END ELSE RETURN eof ENDÿÿÿÿ€8ÀÔþÿÿ€8ÀÔ>Syntax10.Scn.FntXÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogON logOFFlogOFFlogON#Syntax10.Scn.Fnt::; Texts.Append(ldr.log, w.buf); FoldElems.Switch(fold)logOFFp°VersionElemsAllocEnd Syntax10b.Scn.Fnt¦ IF Available(ldr.r) >= SHORT(ASH(1, ldr.pixel)) * 3 THEN ScanColTable(ldr.r, ldr.map, ldr.pixel, ldr.colMap); ldr.state := initImage ELSE RETURN eof ENDÿÿÿÿ€8ÀÔÜüÿÿ€8ÀÔQSyntax10.Scn.FntçSyntax10i.Scn.Fnt¡Ô IF (ldr.map = 1) OR (ldr.map # ldr.actMap) THEN SetColTable(ldr.picture, ldr.map, ldr.pixel, ldr.colMap) END; ldr.actMap := ldr.map; IF (ldr.wipeOut # NIL) OR ((ldr.pCount = 1) & (ldr.imgDsc.tColIdx >= 0)) THEN (* fill image with background *) Display.GetColor(bgCol, red, green, blue); ldr.picture.SetColorRGB(red, green, blue); IF (ldr.wipeOut = NIL) OR (ldr.imgDsc.localColMap) THEN (* heuristical enhancement? *) ldr.picture.ReplConst(0, 0, ldr.scrDsc.width, ldr.scrDsc.height, Display.replace) ELSE ldr.picture.ReplConst(ldr.wipeOut.left, ldr.wipeOut.bot, ldr.wipeOut.width, ldr.wipeOut.height, Display.replace); END; ldr.wipeOut := NIL END; ldr.state := initLZWÿÿÿÿ€8ÀÔ9ÿÿÿ€8ÀÔCSyntax10.Scn.Fnt\Syntax10b.Scn.Fnt#… res := InitLZW(ldr); IF res = failed THEN ldr.state := error ELSIF res = eof THEN RETURN eof ELSE ldr.state := doLZW ENDÿÿÿÿ€8ÀÔ ÿÿÿ€8ÀÔCSyntax10.Scn.Fnt#Syntax10b.Scn.Fnt1 IF ~ LZWDecompressed(ldr) THEN RETURN eof ENDÿÿÿÿ€8ÀÔÆþÿÿ€8ÀÔCSyntax10.Scn.FntbSyntax10b.Scn.Fntø res := ReadNextCode (ldr); IF res = failed THEN ldr.state := error ELSIF res = eof THEN RETURN eof ELSE ldr.oldcode := ldr.code; ldr.fin := ldr.code; Dot(ldr.code, ldr); ldr.incode := ldr.code; ldr.state := doLZW ENDÿÿÿÿ€8ÀÔT“ VAR c : CHAR; res, pixl, red, green, blue : INTEGER; BEGIN WHILE (ldr.state # error) & (ldr.state # done) DO CASE ldr.state OF screenDesc : | globalColors : | switch : | extension : | imageDesc : | localColors : | initImage : | initLZW : | doLZW : | clearTable : END END; IF ldr.state = done THEN RETURN ok ELSE RETURN failed END END LoadGif;ÿÿÿÿ€8ÀÔ{þÿÿ€8ÀÔCSyntax10.Scn.FntSyntax10i.Scn.Fnt C (* Load at least part of GIF file *) BEGIN IF ldr.res # failed THEN ldr.lastUpd := Input.Time(); ldr.res := LoadGif(ldr); Update(MAX(INTEGER), - 1, TRUE, ldr); ldr.usedBytes := Files.Pos(ldr.r) - ldr.riderStart; IF (ldr.res = ok) & (ldr.pics # NIL) & (ldr.pics.next # NIL) THEN StartAnim(ldr) END END END Do;ÿÿÿÿ€8ÀÔFrýÿÿ€8ÀÔöSyntax10.Scn.Fnty€ÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.Fnt; OpenViewer(ldr)logOFFp°VersionElemsAllocEnd™ VAR ldr : LoadInfo; pic : Picture; BEGIN IF CheckGif (f, pos) THEN NEW(ldr); ldr.res := eof; ldr.usedBytes := 6; NEW(pic); pic.Init(1, 1, 1); ldr.picture := pic; ldr.riderStart := pos; Files.Set(ldr.r, f, pos + 6); ldr.state := screenDesc; ldr.pCount := 0; ldr.dispM := notDef; ldr.tx := - 1; ldr.actMap := - 1; ldr.updBot := MAX(INTEGER); ldr.updTop := - 1 END; RETURN ldr END Loader;ÿÿÿÿ€8ÀÔÿÿÿ€8ÀÔCSyntax10.Scn.FntSyntax10i.Scn.Fnt$? BEGIN (* only used to force loading of module *) END Install;ÿÿÿÿ€8ÀÔ/>ÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt CONST signature = "GIF87a"; VAR signatureA : ARRAY 7 OF CHAR; BEGIN signatureA := signature; Files.WriteBytes(store.r, signatureA, 6); END StoreSignature; ÿÿÿÿ€8ÀÔ+ÿÿÿ€8ÀÔ#Syntax10.Scn.FntOO CONST trailer = 3BX; BEGIN Files.Write(store.r, trailer); END StoreTrailer; ÿÿÿÿ€8ÀÔ+¡ýÿÿ€8ÀÔQSyntax10.Scn.FntýSyntax10i.Scn.Fnt"“&7 VAR ch : CHAR; i : INTEGER; BEGIN Files.WriteInt(store.r, store.scrDsc.width); Files.WriteInt(store.r, store.scrDsc.height); i := 0; IF store.scrDsc.globalColMap THEN i := i + 1 END; i := i * 8 + store.scrDsc.colResolution - 1; i := i * 2; (* color table sorted flag is 0 *) i := i * 8 + store.scrDsc.pixel - 1; ch := CHR(i); Files.Write(store.r, ch); ch := CHR(store.scrDsc.bgColor); Files.Write(store.r, ch); (* Aspect Ratio: 0 means "not used" *) ch := 0X; Files.Write(store.r,ch); END StoreScrDsc; ÿÿÿÿ€8ÀÔBç÷ÿÿ€8ÀÔŸSyntax10.Scn.FntáSyntax10i.Scn.Fnt/p ÏÏÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogON logOFFlogOFFlogON#Syntax10.Scn.Fnt‚‚Out.String("Store::GetScrDsc( count="); Out.Int(count, 0); Out.String(", maxpos="); Out.Int(maxpos, 0); Out.String(")"); Out.Ln;logOFFp°VersionElemsAllocEndjÿÿÿ€8ÀÔFoldElemsNew#Syntax10.Scn.Fntttstore.scrDsc.pixel := 1; WHILE count - SYS.LSH(LONG(1), store.scrDsc.pixel) > 0 DO INC(store.scrDsc.pixel); END;*ÿÿÿÿ€8ÀÔg){ CONST idx = 1; VAR line : ImageLine; x,y : INTEGER; count : INTEGER; i : INTEGER; maxpos: INTEGER; BEGIN store.scrDsc.width := pict.width; store.scrDsc.height := pict.height; store.scrDsc.globalColMap := TRUE; (* scan the picture to count the actual number of colours the colours, in the second colourmap will be used for other purposes: R = number of occurences found in the picture from this colour G = index in the reduced colour map B = reverse index *) NEW(line, store.scrDsc.width); count := 0; (* for the number of colours *) maxpos := -1; (* for the background colour *) FOR i := 0 TO 255 DO store.map[idx, i].R := 0; store.map[idx, i].G := 255; store.map[idx, i].B := 255; (* useful for the GetColTable *) END; FOR y := 0 TO store.scrDsc.height - 1 DO pict.GetScanLine(line^, y); FOR x := 0 TO store.scrDsc.width - 1 DO i := ORD(line[x]); INC(store.map[idx, i].R); IF store.map[idx, i].R = 1 THEN (* first occurence *) store.map[idx, i].G := count; store.map[idx, count].B := i; INC(count); END; IF (maxpos < 0) OR (store.map[idx, maxpos].R < store.map[idx, i].R) THEN maxpos := i; END; END; END; store.scrDsc.pixel := upper(log(2, count)) store.scrDsc.colResolution := store.scrDsc.pixel; store.scrDsc.bgColor := store.map[idx, maxpos].G; (* background is the most used colour *) END GetScrDsc; -ÿÿÿÿ€8ÀÔ+ƒýÿÿ€8ÀÔQSyntax10.Scn.FntGSyntax10i.Scn.FntC.a- VAR ch : CHAR; i : INTEGER; BEGIN Files.Write(store.r, imgStart); (* writes out "," *) Files.WriteInt(store.r, store.imgDsc.left); Files.WriteInt(store.r, store.imgDsc.top); Files.WriteInt(store.r, store.imgDsc.width); Files.WriteInt(store.r, store.imgDsc.height); i := 0; IF store.imgDsc.localColMap THEN i := i + 1 END; i := i * 2; IF ~ store.imgDsc.sequential THEN i := i + 1 END; i := i * 8; (* sort flag and two bits for reserved data *) i := i * 8 + store.imgDsc.pixel -1; ch := CHR(i); Files.Write(store.r, ch); END StoreImgDsc; ÿÿÿÿ€8ÀÔA©þÿÿ€8ÀÔCSyntax10.Scn.FntòSyntax10i.Scn.Fnt BEGIN store.imgDsc.left := 0; store.imgDsc.top := 0; store.imgDsc.width := pict.width; store.imgDsc.height := pict.height; store.imgDsc.localColMap := FALSE; store.imgDsc.sequential := TRUE; store.imgDsc.pixel := store.scrDsc.pixel; (* see GetScrDsc *) END GetImgDsc; -ÿÿÿÿ€8ÀÔ-”þÿÿ€8ÀÔ#Syntax10.Scn.FntJJ CONST colour = 0; VAR ch : CHAR; i : INTEGER; BEGIN FOR i := 0 TO SHORT(ASH(1, store.scrDsc.pixel)) - 1 DO ch := CHR(store.map[colour, i].R); Files.Write(store.r, ch); ch := CHR(store.map[colour, i].G); Files.Write(store.r, ch); ch := CHR(store.map[colour, i].B); Files.Write(store.r, ch); END ; END StoreColTable; ÿÿÿÿ€8ÀÔDHþÿÿ€8ÀÔQSyntax10.Scn.FntuSyntax10i.Scn.Fnt:(rh CONST colour = 0; index = 1; VAR i,j : INTEGER; BEGIN FOR i := 0 TO SHORT(ASH(1, store.scrDsc.pixel)) - 1 DO (* remapping from the reduced colourmap to the original *) j := store.map[index, i].B; (* for extra elements see GetScrDsc *) pict.GetPalette(j, store.map[colour, i].R, store.map[colour, i].G, store.map[colour, i].B) END END GetColTable; %ÿÿÿÿ€8ÀÔ7§ÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt77 BEGIN bs.store := store; bs.bufsize := 0; END Open; ÿÿÿÿ€8ÀÔ$>ÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt BEGIN Files.Write(bs.store.r, CHR(bs.bufsize)); IF bs.bufsize > 0 THEN Files.WriteBytes(bs.store.r, bs.buffer, bs.bufsize) END; bs.bufsize := 0; END Flush; ÿÿÿÿ€8ÀÔ/4þÿÿ€8ÀÔSyntax10.Scn.FntSyntax10i.Scn.Fnt?yÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogON#Syntax10.Scn.FntASSERT(bs.bufsize < 255);p°VersionElemsAllocEndf° BEGIN (* assumes the buffer was flushed previously if it was full *) bs.buffer[bs.bufsize] := ch; INC(bs.bufsize); IF bs.bufsize = 255 THEN bs.Flush END; END Store; ÿÿÿÿ€8ÀÔ$Lÿÿÿ€8ÀÔCSyntax10.Scn.FntKSyntax10i.Scn.Fntr BEGIN IF bs.bufsize > 0 THEN bs.Flush END; Files.Write(bs.store.r, 0X); (* null block at the end *) END Close; ÿÿÿÿ€8ÀÔ5œþÿÿ€8ÀÔSyntax10.Scn.Fntjÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogON#Syntax10.Scn.Fnt((Out.String("BitStream::Open()"); Out.Ln;p°VersionElemsAllocEndOY BEGIN NEW(bt.bs); bt.bs.Open(store); bt.bufsize := 0; bt.buffer := 0; END Open; ÿÿÿÿ€8ÀÔJÿÿÿÿ€8ÀÔÿÿÿp°#Syntax10.Scn.FntlogON logOFFlogOFFlogON#Syntax10.Scn.FntŠŠOut.String("BitStream::Store(bits="); Out.Int(bits,0); Out.String(", numberOfBits="); Out.Int(numberOfBits,0); Out.String(")"); Out.Ln;logOFFp°Syntax10i.Scn.Fnt bÿÿÿp°#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogON#Syntax10.Scn.Fnt00ASSERT(numberOfBits + bt.bufsize <= 4 * bitsin);p°_"—ÿÿÿÿ€8ÀÔ"Ÿýÿÿ€8ÀÔ9Syntax10.Scn.Fntkÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogON logOFFlogOFFlogON#Syntax10.Scn.Fnt''Out.String("BitStream::Close"); Out.Ln;logOFFp°VersionElemsAllocEndSyntax10i.Scn.FntÈ) VAR b : LONGINT; BEGIN (* flush the rest *) WHILE bt.bufsize > 0 DO (* storing bytes *) b := SYS.LSH(bt.buffer, -bitsin); bt.bs.Store(CHR(bt.buffer - SYS.LSH(b, bitsin))); bt.buffer := b; DEC(bt.bufsize, bitsin); END; bt.bs.Close; bt.bufsize := 0; bt.buffer := 0; END Close; ÿÿÿÿ€8ÀÔ"|þÿÿ€8ÀÔSyntax10.Scn.Fnttÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogON#Syntax10.Scn.Fnth.size := 0; h.full := FALSE;p°VersionElemsAllocEndgƒ VAR i : INTEGER; BEGIN FOR i := 0 TO hashTableSize - 1 DO h.table[i].key := -1; h.table[i].code := -1; END; END Clear; ÿÿÿÿ€8ÀÔPüÿÿ€8ÀÔþSyntax10.Scn.Fnt|ÿÿÿ€8ÀÔFoldElemsNew#Syntax10.Scn.Fntbbhkey := SYS.VAL(INTEGER, (SYS.VAL(SET, SYS.LSH(key, -12)) / SYS.VAL(SET, key))) MOD hashTableSize;ÿÿÿÿ€8ÀÔf/ÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogON#Syntax10.Scn.FntccOut.String("exists("); Out.Int(key, 0); Out.String(","); Out.Int(code, 0); Out.String(")"); Out.Ln;p°VersionElemsAllocEndG1ÿÿÿp°#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogON#Syntax10.Scn.FntaaOut.String("exists("); Out.Int(key, 0); Out.String(","); Out.Int(-1, 0); Out.String(")"); Out.Ln;p° VAR hkey : INTEGER; BEGIN hkey := h.KeyItem(key); WHILE h.table[hkey].key # -1 DO IF h.table[hkey].key = key THEN code := h.table[hkey].code; RETURN TRUE; END; hkey := (hkey + 1) MOD hashTableSize; END; RETURN FALSE; END Exists; (ÿÿÿÿ€8ÀÔA·ûÿÿ€8ÀÔrSyntax10.Scn.Fntÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogON#Syntax10.Scn.FntASSERT(~ h.full);p°VersionElemsAllocEnd/ÿÿÿp°#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogON#Syntax10.Scn.FntccOut.String("insert("); Out.Int(key, 0); Out.String(","); Out.Int(code, 0); Out.String(")"); Out.Ln;p°|ÿÿÿ€8ÀÔFoldElemsNew#Syntax10.Scn.Fntbbhkey := SYS.VAL(INTEGER, (SYS.VAL(SET, SYS.LSH(key, -12)) / SYS.VAL(SET, key))) MOD hashTableSize;ÿÿÿÿ€8ÀÔŠcÿÿÿp°#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogON#Syntax10.Scn.Fnt//INC(h.size); h.full := h.size = hashTableSize;p°Ø VAR hkey : INTEGER; BEGIN hkey := h.KeyItem(key); WHILE h.table[hkey].key # -1 DO hkey := (hkey + 1) MOD hashTableSize; END; h.table[hkey].key := key; h.table[hkey].code := code; END Insert; ÿÿÿÿ€8ÀÔ0¿ýÿÿ€8ÀÔCSyntax10.Scn.Fnt†Syntax10i.Scn.Fnt%Tÿ VAR ht : HashTable; bt : BitStream; BEGIN NEW(ht); NEW(bt); bt.Open(store); lzw.ht := ht; lzw.bt := bt; lzw.store := store; (* just for remapping the colours *) lzw.codesize := store.imgDsc.pixel; IF lzw.codesize < 2 THEN lzw.codesize := 2 END; Files.Write(store.r, CHR(lzw.codesize)); lzw.clearcode := SYS.LSH(LONG(1), lzw.codesize); lzw.endcode := lzw.clearcode + 1; lzw.startcode := lzw.clearcode + 2; INC(lzw.codesize); lzw.startcodesize := lzw.codesize; lzw.start := TRUE; END Open; ÿÿÿÿ€8ÀÔ;óöÿÿ€8ÀÔ¾Syntax10.Scn.Fnt’Žÿÿÿ€8ÀÔFoldElemsNew#Syntax10.Scn.FntPPcode, nextcode, codesize, maxcode : INTEGER; ht : HashTable; bt : BitStream;5ÿÿÿÿ€8ÀÔ`ÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt~~code := lzw.code; nextcode := lzw.nextcode; codesize := lzw.codesize; maxcode := lzw.maxcode; ht := lzw.ht; bt := lzw.bt; ÿÿÿÿ€8ÀÔ)þÿÿ€8ÀÔJSyntax10i.Scn.FntDSyntax10.Scn.Fnt™lX¡(* clear the HashTable and force the decomressor to do the same *) ht.Clear; bt.Store(lzw.clearcode, codesize); codesize := lzw.startcodesize; nextcode := lzw.startcode; maxcode := SYS.LSH(LONG(1), codesize); (* remapping to the reduced colour table is done here, although it is not part of th LZW compression! *) code := lzw.store.map[index, ORD(chA[0])].G; lzw.start := FALSE; INC(startIndex);%ÿÿÿÿ€8ÀÔ:Syntax10i.Scn.FntDc `ÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt~~lzw.code := code; lzw.nextcode := nextcode; lzw.codesize := codesize; lzw.maxcode := maxcode; lzw.ht := ht; lzw.bt := bt; ÿÿÿÿ€8ÀÔP CONST index = 1; lzwMaxCode = 4095; VAR idx : INTEGER; nextch : INTEGER; newkey : LONGINT; newcode : INTEGER; startIndex: INTEGER; local variables for the mostly used lzw record fields BEGIN * := lzw.* startIndex := 0; IF lzw.start THEN initialization at the very first call END; FOR idx := startIndex TO SHORT(LEN(chA)) - 1 DO (* prefix is the current code and postfix is the next character *) nextch := lzw.store.map[index, ORD(chA[idx])].G; newkey := SYS.LSH(LONG(code), 8) + LONG(nextch); IF ht.Exists(newkey, newcode) THEN code := newcode; ELSE bt.Store(code, codesize); IF (nextcode >= maxcode) & (code <= lzwMaxCode) THEN INC(codesize); maxcode := SYS.LSH(LONG(1), codesize); END; code := nextch; IF nextcode >= lzwMaxCode THEN bt.Store(lzw.clearcode, codesize); nextcode := lzw.startcode; codesize := lzw.startcodesize; maxcode := SYS.LSH(LONG(1), codesize); ht.Clear; ELSE ht.Insert(newkey, nextcode); INC(nextcode); END; END; (* ht.Exists() *) END; (* WHILE *) lzw.* := * END StoreBytes; ÿÿÿÿ€8ÀÔTÿÿÿ€8ÀÔ#Syntax10.Scn.FntŠŠ BEGIN IF ~ lzw.start THEN lzw.bt.Store(lzw.code, lzw.codesize) END; lzw.bt.Store(lzw.endcode, lzw.codesize); lzw.bt.Close; END Close; $ÿÿÿÿ€8ÀÔCþÿÿ€8ÀÔùSyntax10.Scn.Fnt©}ÿÿÿp°VersionElemsAllocBeg#Syntax10.Scn.FntlogOFF logONlogOFFlogOFFlogON#Syntax10.Scn.FntOut.Int(y,4); Out.Ln;p°VersionElemsAllocEnd[ VAR lzw : LZW; line : ImageLine; y : INTEGER; BEGIN NEW(lzw); lzw.Open(store); NEW(line, store.imgDsc.width); FOR y := store.imgDsc.height - 1 TO 0 BY -1 DO pict.GetScanLine(line^, y ); lzw.StoreBytes(line^); END; lzw.Close; END StoreImage; ÿÿÿÿ€8ÀÔL¨ÿÿÿ€8ÀÔ#Syntax10.Scn.Fnt66stores a pict as gif to the given file; ok for successÿÿÿÿ€8ÀÔ Dÿÿÿ€8ÀÔ#Syntax10.Scn.Fntšš saves the selected PElem under the name sepcified after the command, if it is a WebElems.ImageElem, then it sets the source to the filename as well Uÿÿÿÿ€8ÀÔ+;ÿÿÿp°#Syntax10.Scn.Fnt logON logOFF logOFFlogON#Syntax10.Scn.FntVV; Texts.OpenWriter(w); Texts.OpenWriter(wExt); head := Fonts.This("Syntax12b.Scn.Fnt")logOFFp°ÐMODULE GIF; (* Debugging of Information about picture(s): OFF *) (* GIF History *) IMPORT SYS := SYSTEM, Display, Files, Pictures, PElems, Viewers, Input, Texts, In, Oberon ; CONST TYPE PROCEDURE (p : Picture) DrawStretched (sx, sy, sw, sh, dx, dy, dw, dh, mode: INTEGER); PROCEDURE CheckGif (f : Files.File; pos : LONGINT) : BOOLEAN; VAR r : Files.Rider; signature : ARRAY 7 OF CHAR; BEGIN Files.Set(r, f, pos); Files.ReadBytes(r, signature, 6); signature[6] := 0X; RETURN (signature = "GIF87a") OR (signature = "GIF89a") END CheckGif; PROCEDURE Available (VAR r : Files.Rider) : LONGINT; PROCEDURE SetRider (VAR r : Files.Rider; pos : LONGINT); PROCEDURE ScanScrDsc (VAR r : Files.Rider; VAR dsc : ScrDscType); PROCEDURE ScanImgDsc (VAR r : Files.Rider; VAR dsc : ImgDscType ); PROCEDURE ScanColTable (VAR r : Files.Rider; idx, pixel : INTEGER; VAR map : ColorMap); PROCEDURE SetColTable (pict : Pictures.Picture; idx, pixel : INTEGER; VAR map : ColorMap); PROCEDURE ExtBlockAvailable (VAR r : Files.Rider; len : LONGINT) : BOOLEAN; PROCEDURE ScanExtBlock (VAR r : Files.Rider; VAR tx, dispM : INTEGER; VAR delay : LONGINT); PROCEDURE ReadNextCode (ldr : LoadInfo) : INTEGER; PROCEDURE Update (b, t : INTEGER; force : BOOLEAN; ldr : LoadInfo); PROCEDURE Dot (col : INTEGER; ldr : LoadInfo); PROCEDURE InitLZW (ldr : LoadInfo) : INTEGER; PROCEDURE LZWDecompressed (ldr : LoadInfo) : BOOLEAN; PROCEDURE CopyPicture (src, dest : Pictures.Picture); PROCEDURE DisposePicture (ldr : LoadInfo); PROCEDURE AppendAnimPic (ldr : LoadInfo; new : Picture); PROCEDURE SavePicForAnim (ldr : LoadInfo); PROCEDURE SearchPic (VAR m : Display.FrameMsg); PROCEDURE Animate; PROCEDURE StartAnim (ldr : LoadInfo); PROCEDURE LoadGif (ldr : LoadInfo) : INTEGER; PROCEDURE (ldr : LoadInfo) Do*; PROCEDURE Loader (f: Files.File; pos: LONGINT) : Pictures.LoadInfo; PROCEDURE Install*; PROCEDURE StoreSignature(store : StoreInfo);Stores the "GIF87a" string. PROCEDURE StoreTrailer(store : StoreInfo); stores ";" at the end PROCEDURE StoreScrDsc(store : StoreInfo);Stores the ScreenDescription. PROCEDURE GetScrDsc(pict : Pictures.Picture; store : StoreInfo); fills in dsc attributes from pict information PROCEDURE StoreImgDsc(store : StoreInfo); Stores an ImageDescription PROCEDURE GetImgDsc(pict : Pictures.Picture; store : StoreInfo);fills in dsc attributes from pict information PROCEDURE StoreColTable(store : StoreInfo);Stores a given colormap. PROCEDURE GetColTable(pict : Pictures.Picture; store : StoreInfo); copies a color table from pict to map PROCEDURE (bs : BlockStream) Open(store : StoreInfo); PROCEDURE (bs : BlockStream) Flush; PROCEDURE (bs : BlockStream) Store(ch : CHAR); PROCEDURE (bs : BlockStream) Close; PROCEDURE (bt : BitStream) Open(store : StoreInfo); PROCEDURE (bt : BitStream) Store(bits : INTEGER; numberOfBits : INTEGER); VAR b : LONGINT; BEGIN (* buffer capacity is 4 bytes *) bt.buffer := bt.buffer + SYS.LSH(LONG(bits), bt.bufsize); INC(bt.bufsize, numberOfBits); (* flush the rest *) WHILE bt.bufsize >= bitsin DO (* storing whole bytes *) b := SYS.LSH(bt.buffer, -bitsin); bt.bs.Store(CHR(bt.buffer - SYS.LSH(b, bitsin))); bt.buffer := b; DEC(bt.bufsize, bitsin); END; END Store; PROCEDURE (bt : BitStream) Close; PROCEDURE (h : HashTable) Clear; initializes PROCEDURE (h : HashTable) Exists(key : LONGINT; VAR code : INTEGER) : BOOLEAN;it returns the element in code if exists PROCEDURE (h : HashTable) Insert(key : LONGINT; code : INTEGER);the table should not be full! PROCEDURE (lzw : LZW) Open(store : StoreInfo);initializes some variables PROCEDURE (lzw : LZW) StoreBytes(VAR chA : ARRAY OF CHAR);does the real compression PROCEDURE (lzw : LZW) Close;flushes the last code and writes EOF PROCEDURE StoreImage(pict : Pictures.Picture; store : StoreInfo);stores the lines in an image PROCEDURE Save*(pict : Pictures.Picture; f : Files.File; pos : LONGINT; VAR ok : BOOLEAN); VAR store : StoreInfo; p: Pictures.Picture; BEGIN ok := FALSE; NEW(store); IF (pict.depth > 8) THEN NEW(p); p.Init(pict.width, pict.height, 8); pict.CopyBlock(p, 0,0,pict.width, p.height, 0,0,Display.replace); pict := p; END; Files.Set(store.r, f, pos); StoreSignature(store); GetScrDsc(pict, store); StoreScrDsc(store); GetColTable(pict, store); StoreColTable(store); GetImgDsc(pict, store); StoreImgDsc(store); StoreImage(pict, store); StoreTrailer(store); ok := TRUE; END Save; PROCEDURE Store*; CONST NameSize = 50; VAR f : Files.File; fname : ARRAY NameSize OF CHAR; ok : BOOLEAN; pelem : PElems.Elem; begin : LONGINT; end : LONGINT; time : LONGINT; text : Texts.Text; reader : Texts.Reader; BEGIN In.Open; In.Name(fname); Oberon.GetSelection(text, begin, end, time); IF (time >= 0) & In.Done THEN Texts.OpenReader(reader, text, begin); Texts.ReadElem(reader); IF reader.elem IS PElems.Elem THEN pelem := reader.elem(PElems.Elem); f := Files.New(fname); Save(pelem.pic,f,0,ok); IF ok THEN Files.Register(f) END END END END Store; BEGIN Pictures.RegisterFormat(Loader) END GIF. GIF.Store xx.gif