// Grafikroutinen für FPGA-QVGA
procedure Delay3us;
begin
  asm;
    ldi  _ACCB, 8
    DelayLoop1:  // 2,5 µs warten
    dec _ACCB
    BRNE DelayLoop1
  endasm;
end;

{$D-}
UserDevice GraphIOS(myCmd : byte; myAdr : word; myMask, myPixel : byte) : byte;
var myIdx:Word;
begin
  (* commands passed to user defined function "GraphIOS" *)
  (*  0  display init   myAdr = none      myMask = none   myPixel = none   result = none   *)
  (*  1  display clear  myAdr = fillpatt  myMask = none   myPixel = none   result = bool   *)
  (*  2  write byte     myAdr = byte myAdr  myMask = byte   myPixel = mode   result = none   *)
  (*  3  read byte      myAdr = byte myAdr  myMask = none   myPixel = none   result = byte   *)
  (*  4  set pixel      myAdr = byte myAdr  myMask = myMask   myPixel = myPixel  result = none   *)
  (*  5  clear pixel    myAdr = byte myAdr  myMask = myMask   myPixel = myPixel  result = none   *)
  (*  6  xor pixel      myAdr = byte myAdr  myMask = myMask   myPixel = myPixel  result = none   *)
  if not qvga then
    return(255);
  endif;
  FPGAreg:=64;  // Adress-Register
  SendFPGAreg;
  FPGAsendWord:=myAdr; // Adresse ans FPGA, resettet Auto-Increment
  SendFPGA16;
  FPGAreg:=66;  // Cmd-Register
  SendFPGAreg;

  GCmd:=myCmd;
  GMask:=myMask;
  GColor:=gBlockColor;
  GPixel:=myPixel;

  case myCmd of
    0  :    // display init
       myCmd:= 0;
    |
    1  :    // display clear
       FPGAreg:=64;  // Adress-Register
       SendFPGAreg;
       FPGAsendWord:=0; // Adresse ans FPGA, resettet Auto-Increment
       SendFPGA16;
       FPGAreg:=66;  // Cmd-Register
       SendFPGAreg;
       GCmd:=2;
       GMask:=0;
       GColor:=$ff;
       GPixel:=1;
       for myIdx:=0 to 9639 do
         SendFPGA32;
         Delay3us;
       endfor;
       myCmd:= 255;
    |
    3  :    // read byte
       FPGAreg:=69;  // Lese-Register Adresse
       SendFPGAreg;
       SendFPGA8;
       myCmd:=FPGAreceiveByte;  // Schreib-Register Adresse
    |
  else // write command/byte
    SendFPGA32;
  endcase;

  return(myCmd);
end;
{$D+}


{--------------------------------------------------------------}
Procedure GraphSplashScreen;
var myIdx:Word;
begin
  gBlockColor:=$3f;
  gclrscr(0);
  gOpenView(0,1,1,320,240);
  gFillRect(40, 20, 280, 120, $FF);
  gdrawRect(45, 25, 275, 115, $00);
  gSetTextJustify(alHorCenter, alVertBottom);
  gSetTextBkGnd(bkNormal);
  gSetTextMode(wmClrPix);
  gDrawString(160, 60, 3, 3, TxtRot0, Vers3Str);
  gdrawbitmap(100, 80, @ctbitmap, wmclrpix);
  gDrawString(160, 80, 1, 1, TxtRot0, 'C.Meyer');
  gDrawString(160, 100, 1, 1, TxtRot0, '10/2008');
  gDrawString(260, 70, 1, 1, TxtRot90, 'c''t Lab');
  gSetTextMode(wmSetPix);
  gBlockColor:=%00001010;
  gDrawString(160, 160, 2, 2, TxtRot0, 'QVGA Driver');
  for i:=0 to 15 do
    gBlockColor:=i shl 2;
    gDrawString(160, 180, 2, 2, TxtRot0, '64 Colors');
    mdelay(50);
  endfor;
  gSetTextJustify(alHorLeft, alVertBottom);
  gBlockColor:=$3f;
end;
{--------------------------------------------------------------}

procedure Bargraph(myParam:float; mySize:byte);
//Balkenanzeige nachbilden
var
  Px, bgLen, bgEnd:Integer;
begin
  gSetLineMode(wmsetPix);
  if mySize=0 then
    bgEnd:=50;
  else
    bgEnd:=integer(mySize)*100;
  endif;
  myParam:=myParam*BarScale*float(bgEnd);
  bgEnd:=bgEnd+ParamColEnd-1;
  bgLen:=ParamColEnd+integer(myParam); // mySize = Vollausschlag
  gFillRect(bgLen+1, ParamLineEnd-11, bgEnd, ParamLineEnd-1, $00); // Rest löschen
  gFillRect(ParamColEnd+1, ParamLineEnd-11, bgLen, ParamLineEnd-1, $ff); // Bargraph
end;

procedure BarGraphFrame(mySize:byte);
//Balkenanzeige, Rahmen und Skala zeichnen
var
  Px, bgLen, bgEnd, mydiv:Integer;
begin
  gSetLineMode(wmsetPix);
  if mySize=0 then
    bgEnd:=50+ParamColEnd;
    mydiv:=4;
  else
    bgEnd:=integer(mySize)*100;
    mydiv:=(bgEnd div 10)-1;
    bgEnd:=bgEnd+ParamColEnd;
  endif;
  gDrawRect(ParamColEnd, ParamLineEnd-12, bgEnd, ParamLineEnd, $AA); // Bargraph
  for Px:= ParamColEnd to bgEnd do
    gDrawLine (Px, ParamLineEnd-20, Px, ParamLineEnd-12,$55);
    Px:=Px+mydiv;
  endfor;
end;

{--------------------------------------------------------------}
procedure TestQVGA;
// Display QVGA vorhanden?
begin
  FPGAreg:=64;  // Adress-Register
  SendFPGAreg;
  FPGAsendWord:=0; // Adresse ans FPGA, resettet Auto-Increment
  SendFPGA16;
  FPGAreg:=66;  // Cmd-Register
  SendFPGAreg;
  GCmd:=2;
  GMask:=$A5; // Test-Byte
  GColor:=0;
  GPixel:=1;
  SendFPGA32;
  FPGAreg:=64;  // Adress-Register
  SendFPGAreg;
  FPGAsendWord:=0; // Adresse ans FPGA, resettet Auto-Increment
  SendFPGA16;
  FPGAreg:=69;  // Lese-Register Adresse
  SendFPGAreg;
  SendFPGA8;
  qvga:=(FPGAreceiveByte=$A5);  // geschriebener Wert?
  if qvga then
    GraphSplashScreen;
  endif;
end;