(*******************************************************************************
 : Program.         BlitTest.mod
 : Author.          Carsten Wartmann (Crazy Video)
 : Address.         Wutzkyallee 83, 12353 Berlin
 : Phone.           030/6614776
 : Version.         0.5
 : Date.            16.Aug.1994
 : Copyright.       PD
 : Language.        Modula-2
 : Compiler.        M2Amiga V4.3
 : Contents.        Test des Blitters auf der Picasso (Speed) .
*******************************************************************************)

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

MODULE BlitTest1 ;


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 ;



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

    time      : TimeVal ;
    tags      : ARRAY [0..40] OF LONGCARD ;
    scr       : ScreenPtr ;

    start     : ADDRESS ;
    kugeln    : ARRAY [0..9] OF ADDRESS ;
    copy      : VilCopyRecord ;

    mode,x,y,
    i         : LONGCARD ;

    ok        : 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(delay : INTEGER) ;
BEGIN
  WHILE (6 IN cia) DO
  END ;
  Delay(delay) ;
END WaitMaus ;


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


(* Liest BMP in einen Speicherbereich *)
PROCEDURE ReadBMP(name : ARRAY OF CHAR ; w,h : LONGCARD) : ADDRESS ;
VAR f      : File ;
    act,i,
    y      : 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,
    col    : 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 ;



PROCEDURE CPUCopy(scr : ScreenPtr ; source : ADDRESS ;
                                    dest   : ADDRESS ;
                                    w,h,xd,yd : LONGINT) ;
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
          dest^ := source^ ;
        INC(dest,1) ;
        INC(source,1) ;
      END ;
      INC(dest,sw-w) ;
    END ;

  END CPUCopy ;



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,tavisScreenWidth,  640,
                                           tavisScreenHeight, 512,
                                           tavisScreenDepth,    8,
                                           tagDone)) ;
  Assert(scr#NIL,ADR("Kann PICASSO Screen nicht öffnen !")) ;

  start := LockVillageScreen(scr) ;

  ReadPAL("sq0:pics/sequenz/auto.0001",scr) ;

  kugeln[0] := ReadBMP("pics/sequenz/auto.0001",84,67) ;
  kugeln[1] := ReadBMP("pics/sequenz/auto.0002",84,67) ;
  kugeln[2] := ReadBMP("pics/sequenz/auto.0003",84,67) ;
  kugeln[3] := ReadBMP("pics/sequenz/auto.0004",84,67) ;
  kugeln[4] := ReadBMP("pics/sequenz/auto.0005",84,67) ;
  kugeln[5] := ReadBMP("pics/sequenz/auto.0006",84,67) ;
  kugeln[6] := ReadBMP("pics/sequenz/auto.0007",84,67) ;
  kugeln[7] := ReadBMP("pics/sequenz/auto.0008",84,67) ;
  kugeln[8] := ReadBMP("pics/sequenz/auto.0009",84,67) ;
  kugeln[9] := ReadBMP("pics/sequenz/auto.0010",84,67) ;

  Forbid() ;
   ScreenToFront(scr) ;
   start := LockVillageScreen(scr) ;
  Permit() ;

      copy.scrPitch := 84 ;
      copy.dstPitch := scr^.width ;
      copy.width    := 84 ;
      copy.height   := 67 ;
      copy.rop      := VilScrCopy ;

  Forbid() ;
  StartTime() ;
  FOR x:=0 TO 200 DO

  copy.scrAdr   := kugeln[x MOD 10] ;
  copy.dstAdr   := start ;

  WaitVillageBlit ;
  ok := VillageBlitCopy(scr,ADR(copy)) ;

  END ;
  StopTime(time) ;
  Permit() ;
  Erg(time) ;


  Forbid() ;
  StartTime() ;
  FOR x:=0 TO 200 DO
    CPUCopy(scr,kugeln[x MOD 10],
                start,
                84,67,0,0) ;
  END ;
  StopTime(time) ;
  Permit() ;
  Erg(time) ;



CLOSE
  IF scr#NIL THEN
    UnLockVillageScreen(scr) ;
    CloseVillageScreen(scr) ;
  END ;
  FOR i:=0 TO 9 DO
    IF kugeln[i]#NIL THEN
      FreeMem(kugeln[i],84*67) ;
    END ;
  END ;

END BlitTest1.