(*******************************************************************************
 : Program.         RBMP.MOD
 : Author.          Carsten Wartmann (Crazy Video)
 : Address.         Wutzkyallee 83, 12353 Berlin
 : Phone.           030/6614776
 : E-Mail           C.Wartmann@AMBO.in-berlin.de (bevorzugt)
 : E-Mail           Carsten_Wartmann@tfh-berlin.de
 : Version.         0.5
 : Date.            16.Aug.1994
 : Copyright.       PD
 : Language.        Modula-2
 : Compiler.        M2Amiga V4.3d
 : Contents.        Einlesen / Scaling von BMP (Was mache ich damit ?).
*******************************************************************************)

(*$ LargeVars := FALSE*)
(*$StackParms := FALSE*)

MODULE RBMP ;


FROM SYSTEM       IMPORT ADR,ADDRESS,TAG,BITSET,SHIFT,ASSEMBLE ;

FROM UtilityD     IMPORT tagEnd,tagDone ;

FROM Arts         IMPORT Assert ;

FROM ExecL        IMPORT Forbid,Permit,AllocMem,FreeMem,CopyMem ;
FROM ExecD        IMPORT MemReqs,MemReqSet ;

FROM DosL         IMPORT Delay ;

FROM GraphicsL    IMPORT SetRGB4 ;

FROM IntuitionD   IMPORT ScreenPtr ;
FROM IntuitionL   IMPORT ScreenToFront ;

FROM RandomNumber IMPORT RND ;

FROM VilIntuiSupL IMPORT OpenVillageScreenTagList,CloseVillageScreen,
                         LockVillageScreen,UnLockVillageScreen,
                         VillageRectFill,VillageBlitCopy,WaitVillageBlit,
                         VillageModeRequest,VillageSetDisplayBuf,VillageGetBufAddr ;
FROM VilIntuiSupD IMPORT SetPackedPixel,LinePacked,ClearScreen,ClearBuf,
                         VilFillRecord,VilCopyRecord,VilScrCopy,VilScrAnd,
                         VilDstInvert,VilScrPaint,TavisTags,InvalidID ;

FROM FileSystem   IMPORT Lookup,File,Close,ReadChar,done,ReadBytes,SetPos ;

FROM InOut        IMPORT WriteInt,WriteLn,WriteString,Write,WriteCard,WriteHex ;

FROM String       IMPORT Compare ;

FROM Break        IMPORT InstallException ;

FROM Timer2       IMPORT StartTime,StopTime,TimeVal ;

IMPORT R ;



CONST Bildname = "pics/Galerie160fp.bmp" ;
      Bildw    = 160 ;
      Bildh    = 128 ;
      Cookie   = "pics/Kugeln.bmp" ;
      Cookiew  =  16 ;
      Cookieh  =  240 ;

      Faktor   = 1 ;


VAR cia[0BFE000H]  : BITSET ;
    Joy1[0DFF00CH] : BITSET ;

    time      : TimeVal ;
    tags      : ARRAY [0..40] OF LONGCARD ;
    bufadr    : ARRAY [0..1] OF ADDRESS ;

    scr       : ScreenPtr ;
    start,
    source,
    cookie    : ADDRESS ;
    col,buf   : LONGINT ;
    mode      : LONGCARD ;
    tc        : SHORTCARD ;
    x,y,ok,
    xmit,ymit,
    xoff,yoff : LONGINT ;
    xc,yc,
    xs,ys     : LONGINT ;
    ct        : LONGINT ;






PROCEDURE Rechts() : BOOLEAN ;
   BEGIN
      RETURN (1 IN Joy1) ;
END Rechts ;

PROCEDURE Links() : BOOLEAN ;
   BEGIN
      RETURN (9 IN Joy1) ;
END Links ;

PROCEDURE XOR(a,b : BOOLEAN) : BOOLEAN ;
   BEGIN
      RETURN ((a OR b) AND NOT (a AND b)) ;
END XOR ;

PROCEDURE Unten() : BOOLEAN ;
   BEGIN
      RETURN XOR(Rechts(),(0 IN Joy1)) ;
END Unten ;

PROCEDURE Oben() : BOOLEAN ;
   BEGIN
      RETURN XOR(Links(),(8 IN Joy1)) ;
END Oben ;


PROCEDURE WaitMaus ;
BEGIN
  WHILE (6 IN cia) DO
  END ;
END WaitMaus ;


PROCEDURE Erg(elap : TimeVal) ;
  BEGIN
    WriteLn ;
    WriteString("Ergebnis : ") ;
    WriteInt(elap.secs,6) ;
    WriteInt(elap.micro,10) ;
    WriteLn ;
  END Erg ;


(* Bringt BMP direkt auf den Bildschirm *)
PROCEDURE ReadBMPS(name : ARRAY OF CHAR ; scr : ScreenPtr ; w,h : LONGCARD) ;
VAR f     : File ;
    act,i : LONGINT ;
    start : ADDRESS ;


  BEGIN
    Lookup(f,name,40000,FALSE) ;
    Assert(f.res=done,ADR("Kann File nicht öffnen !")) ;
    start := LockVillageScreen(scr) ;

    SetPos(f,1078) ;
    INC(start,LONGCARD(scr^.width)*(h-1)) ;
    FOR y:=1 TO h DO
      ReadBytes(f,start,w,act) ;
      DEC(start,scr^.width) ;
    END ;

    UnLockVillageScreen(scr) ;
    Close(f) ;
  END ReadBMPS ;


(* Liest BMP in einen Speicherbereich *)
PROCEDURE ReadBMP(name : ARRAY OF CHAR ; w,h : LONGCARD) : ADDRESS ;
VAR f     : File ;
    act,i : LONGINT ;
    start,
    cnt   : ADDRESS ;

  BEGIN
    start := AllocMem(w*h,MemReqSet{fast}) ;
    Assert(start#NIL,ADR("Kein Speicher !")) ;

    Lookup(f,name,40000,FALSE) ;
    Assert(f.res=done,ADR("Kann File nicht öffnen !")) ;

(* Warum stehen BMP-Bilder auf dem Kopf ?
    SetPos(f,1078) ;
    ReadBytes(f,start,w*h,act) ;
    IF (act<LONGINT(w*h)) THEN
      Close(f) ;
      Assert(FALSE,ADR("Fehler beim Bildlesen (w*h?) !")) ;
    END ;
*)
    cnt := start ;
    SetPos(f,1078) ;
    INC(cnt,w*(h-1)) ;
    FOR y:=1 TO h DO
      ReadBytes(f,cnt,w,act) ;
      DEC(cnt,w) ;
    END ;

    Close(f) ;
    RETURN(start) ;

  END ReadBMP ;

(* Extrahiert die Palette eines BMP *)
PROCEDURE ReadPAL(name : ARRAY OF CHAR ; scr : ScreenPtr) ;
VAR f     : File ;
    act,i : LONGINT ;
    r,g,b,
    s     : SHORTCARD ;

  BEGIN
    Lookup(f,name,10000,FALSE) ;
    Assert(f.res=done,ADR("Kann File nicht öffnen !")) ;

    SetPos(f,54) ;
    FOR col:=0 TO 255 DO
      ReadBytes(f,ADR(b),1,act) ;
      ReadBytes(f,ADR(g),1,act) ;
      ReadBytes(f,ADR(r),1,act) ;
      ReadBytes(f,ADR(s),1,act) ;
      SetRGB4(ADR(scr^.viewPort),col,r,g,b) ;
    END ;

    Close(f) ;
  END ReadPAL ;



(* Skaliert auf Screen *)
PROCEDURE ScaleS(scr : ScreenPtr ; xs,ys,w,h,xd,yd,faktor : LONGINT) ;
VAR x,y,
    xx,yy : LONGINT ;
    dst,
    srt   : ADDRESS ;

  BEGIN
    start := LockVillageScreen(scr) ;

    srt := (LONGINT(start)+xs+ys*LONGINT(scr^.width)) ;
    dst := (LONGINT(start)+xd+yd*LONGINT(scr^.width)) ;

    y:=10 ;
    WHILE (y<=h*10) DO
      x:=0 ;
      WHILE (x<w*10) DO
        xx := x DIV 16 ;
        ADDRESS(LONGINT(dst)+x DIV faktor)^ := ADDRESS(LONGINT(srt)+xx)^ ;
        INC(x,faktor) ;
      END ;
      yy := y DIV 10 ;
      srt := ADDRESS(LONGINT(start)+LONGINT(scr^.width)*yy) ;
      INC(dst,scr^.width) ;
      INC(y,faktor) ;
    END ;
    UnLockVillageScreen(scr) ;

  END ScaleS ;

(*Skaliert Bild aus Speicher auf Screen hoch/runter *)
(*Doch noch xs/ys angeben....*)
PROCEDURE Scale(source : ADDRESS ; scr : ScreenPtr ; w,h,xd,yd,faktor : LONGINT) ;
VAR x,y,
    xx,yy   : LONGINT ;
    dst,srt : ADDRESS ;

  BEGIN
    start := LockVillageScreen(scr) ;

    dst := (LONGINT(start)+xd+yd*LONGINT(scr^.width)) ;
    srt := source ;

    y:=16 ;
    WHILE (y<=SHIFT(h,4)) DO
      x:=0 ;
      WHILE (x<SHIFT(w,4)) DO
        xx := SHIFT(x,-4) ;
        ADDRESS(LONGINT(dst)+x DIV faktor)^ := ADDRESS(LONGINT(srt)+xx)^ ;
        INC(x,faktor) ;
      END ;
      srt := ADDRESS(LONGINT(source)+w*SHIFT(y,-4)) ;
      INC(dst,scr^.width) ;
      INC(y,faktor) ;
    END ;
    UnLockVillageScreen(scr) ;

  END Scale ;


(*Skaliert Bild aus Speicher auf Dest hoch/runter *)
(*Doch noch xs/ys angeben....*)
(*$StackChk := FALSE *)
(*$RangeChk := FALSE *)
(*$OverflowChk := FALSE *)
(*$NilChk := FALSE *)
(*$EntryClear := FALSE *)
(*$CaseChk := FALSE *)
(*$ReturnChk := FALSE *)
PROCEDURE ScaleM(scr : ScreenPtr ; source : ADDRESS ; dest : ADDRESS ;
                 w{R.D2},h,xd,yd,faktor{R.D0} : LONGINT) ;
VAR x{R.D3},
    xs{R.D5},
    sw{R.D1}   : LONGINT ;
    y{R.D4}    : LONGINT ;
    dst{R.A1},
    srt{R.A0}  : ADDRESS ;

  BEGIN
    sw := scr^.width ;
    y  := 16 ;
    xs := SHIFT(w,4) ;
    dst := (LONGINT(dest)+xd+yd*sw) ;
    srt := source ;

    WaitVillageBlit ;

    WHILE (y<=SHIFT(h,4)) DO
      x:=0 ;
      WHILE (x<xs) DO
        ADDRESS(dst+ADDRESS(x DIV faktor))^ := ADDRESS(srt+ADDRESS(SHIFT(x,-4)))^ ;
        INC(x,faktor) ;
      END ;
      srt := source+ADDRESS(w*SHIFT(y,-4)) ;
      INC(dst,sw) ;
      INC(y,faktor) ;
    END ;

  END ScaleM ;


PROCEDURE CookieCut(scr : ScreenPtr ; source : ADDRESS ;
                                        dest : ADDRESS ;
                                        w,h,xd,yd : LONGINT ;
                                        trans : SHORTCARD) ;
VAR x,y,sw   : LONGINT ;
    dst{R.A1},
    srt{R.A0}  : ADDRESS ;

  BEGIN
    sw := scr^.width ;
    INC(dest,xd) ;
    INC(dest,sw*yd) ;
    WaitVillageBlit ;
    FOR y:=1 TO h DO
      FOR x:=1 TO w DO
        IF SHORTCARD(source^)#trans THEN
          dest^ := source^ ;
        END ;
        INC(dest,1) ;
        INC(source,1) ;
      END ;
      INC(dest,sw-w) ;
    END ;

  END CookieCut ;




BEGIN
  InstallException ;

  mode := VillageModeRequest(TAG(tags,tavisMinDepth,    8,
                                      tavisMaxDepth,    8,
                                      tavisMinHeight, 256,
                                           tagDone)) ;
  Assert(mode#InvalidID,ADR("Kein Screenmode gewählt !")) ;

  scr := OpenVillageScreenTagList(TAG(tags,tavisScreenModeID,  mode,
                                           tavisDoubleBuffer,    2,
                                           tagDone)) ;
  Assert(scr#NIL,ADR("Kann PICASSO Screen nicht öffnen !")) ;

  start := LockVillageScreen(scr) ;
  FOR buf:=0 TO 1 DO
    bufadr[buf] := VillageGetBufAddr(scr,buf) ;
  END ;

  xmit := scr^.width  DIV 2 ;
  ymit := scr^.height DIV 4 ;   (* wg. DoubleBuffer !!!!!!! *)
  xoff := Bildw * 8 ;
  yoff := Bildh * 8 ;

  xc := 100 ;
  yc :=  80 ;
  xs := 3 ;
  ys := 2 ;

  UnLockVillageScreen(scr) ;

  ReadPAL(Bildname,scr) ;
  source := ReadBMP(Bildname,Bildw,Bildh) ;
  cookie := ReadBMP(Cookie,Cookiew,Cookieh) ;


  x := 64 ;
  buf := 0 ;
  VillageSetDisplayBuf(scr,buf) ;

  WHILE (7 IN cia) DO
   buf := (buf + 1) MOD 2 ;
   ClearBuf(scr,bufadr[buf]) ;
   IF Oben() THEN
     INC(x,Faktor) ;
   ELSIF Unten() THEN
     DEC(x,Faktor) ;
   END ;

   xc := xc + xs ;
   IF (xc<=0) OR (xc>=scr^.width-Cookiew) THEN
     xs := xs * (-1) ;
     xc := xc + xs ;
   END ;
   yc := yc + ys ;
   IF (yc<=0) OR (yc>=SHIFT(scr^.height,-1)-16) THEN
     ys := ys * (-1) ;
     yc := yc + ys ;
   END ;

   ct := (ct + 1) MOD 15 ;

   ScaleM(scr,source,bufadr[buf],Bildw,Bildh,xmit-(xoff DIV x),ymit-(yoff DIV x),x) ;
   CookieCut(scr,cookie+ADDRESS(ct*256),bufadr[buf],Cookiew,16,xc,yc,0) ;
   VillageSetDisplayBuf(scr,buf) ;
  END ;

CLOSE
  IF scr#NIL THEN
    UnLockVillageScreen(scr) ;
    CloseVillageScreen(scr) ;
  END ;
  IF source#NIL THEN
    FreeMem(source,Bildw*Bildh) ;
  END ;
  IF cookie#NIL THEN
    FreeMem(cookie,Cookiew*Cookieh) ;
  END ;

END RBMP .


(* Unlocks ändern !!!!!!!!!!!!!!!!!*)


(*
  Forbid() ;
  StartTime() ;

  FOR x :=32 TO 8 BY -1 DO
    buf := (buf + 1) MOD 2 ;
    ClearBuf(scr,bufadr[buf]) ;
    ScaleM(source,bufadr[buf],Bildw,Bildh,xmit-(xoff DIV x),ymit-(yoff DIV x),x) ;
    VillageSetDisplayBuf(scr,buf) ;
  END ;

  StopTime(time) ;
  Permit() ;
  WriteString("Alt      : ") ;
  Erg(time) ;
*)
(*
  x := 64 ;
  buf := 0 ;
  VillageSetDisplayBuf(scr,buf) ;

  WHILE (7 IN cia) DO
   IF Oben() THEN
     INC(x,Faktor) ;
     buf := (buf + 1) MOD 2 ;
     ClearBuf(scr,bufadr[buf]) ;
     ScaleM(scr,source,bufadr[buf],Bildw,Bildh,xmit-(xoff DIV x),ymit-(yoff DIV x),x) ;
   ELSIF Unten() THEN
     DEC(x,Faktor) ;
     buf := (buf + 1) MOD 2 ;
     ClearBuf(scr,bufadr[buf]) ;
     ScaleM(scr,source,bufadr[buf],Bildw,Bildh,xmit-(xoff DIV x),ymit-(yoff DIV x),x) ;
   END ;

   xc := xc + xs ;
   IF (xc<=0) OR (xc>=scr^.width-Cookiew) THEN
     xs := xs * (-1) ;
     xc := xc + xs ;
   END ;

   CookieCut(scr,cookie,bufadr[buf],Cookiew,Cookieh,xc,80,0) ;
   VillageSetDisplayBuf(scr,buf) ;
  END ;
*)