{
  Color Picker by Bostjan Gorisek
  16.10.2015
}
uses crt, dos, pmg, graph, sysutils;

var
  i : Byte;
  y : Byte = 3;
  stop: Boolean;
  stick : byte absolute $278;
  // Memory location map
  pcol : array[0..6] of word = ($2C6, $2C8, $2C5, $02C0, $02C1, $02C2, $02C3);

  // Player data
  p0Data : array [0.._P_MAX] of byte = (255, 255, 255, 255, 255, 255, 255, 255, 255, 0, 0, 0, 0, 0, 0);
  p1Data : array [0.._P_MAX] of byte = (255, 255, 255, 255, 255, 255, 255, 255, 255, 0, 0, 0, 0, 0, 0);
  p2Data : array [0.._P_MAX] of byte = (255, 255, 255, 255, 255, 255, 255, 255, 255, 0, 0, 0, 0, 0, 0);
  p3Data : array [0.._P_MAX] of byte = (255, 255, 255, 255, 255, 255, 255, 255, 255, 0, 0, 0, 0, 0, 0);
  
  // Selected color memory location
  CurrPlyr : byte = 0;

procedure SetColors;
begin
  poke(pcol[0], 0);   // Background color
  poke(pcol[1], 160);  // Border color
  poke(pcol[2], 10);  // Text color
  poke(pcol[3], 50);  // Player 0 color
  poke(pcol[4], 134);  // Player 1 color
  poke(pcol[5], 164);  // Player 2 color
  poke(pcol[6], 232);  // Player 3 color
  GotoXY(3, y);     Write('Background  710 $2C6  dec:', peek(pcol[0]), ' hex:', IntToHex(peek(pcol[0]), 0));
  GotoXY(3, y+3);   Write('Border      712 $2C8  dec:', peek(pcol[1]), ' hex:', IntToHex(peek(pcol[1]), 0));
  GotoXY(3, y+3*2); Write('Text        709 $2C5  dec:', peek(pcol[2]), ' hex:', IntToHex(peek(pcol[2]), 0));
  GotoXY(6, y+3*3); Write('Player 0 704 $02C0 dec:', peek(pcol[3]), ' hex:', IntToHex(peek(pcol[3]), 0));
  GotoXY(6, y+3*4); Write('Player 1 705 $02C1 dec:', peek(pcol[4]), ' hex:', IntToHex(peek(pcol[4]), 0));
  GotoXY(6, y+3*5); Write('Player 2 706 $02C2 dec:', peek(pcol[5]), ' hex:', IntToHex(peek(pcol[5]), 0));
  GotoXY(6, y+3*6); Write('Player 3 707 $02C3 dec:', peek(pcol[6]), ' hex:', IntToHex(peek(pcol[6]), 0));
end;
  
Procedure KeyScan;
var
  ch : char;
  n : byte;
begin
  If KeyPressed or (stick <> 15) then begin    
    if Keypressed then
      ch := UpCase(ReadKey)
    else begin
      if stick = 14 then ch := #28
      else if stick = 13 then ch := #29
      else if stick = 11 then ch := #30
      else if stick = 7 then ch := #31;
      Delay(160);
    end;
    n := Peek(pcol[CurrPlyr]);    
	  if (ch = #28) then begin  {up}
      Inc(n, 10);
      Poke(pcol[CurrPlyr], n);
    end else if (ch = #29) then begin  {down}
      Dec(n, 10);
      Poke(pcol[CurrPlyr], n);
    end else if (ch = #30) then begin   {left}
      Dec(n, 2);
      Poke(pcol[CurrPlyr], n);
    end else if (ch = #31) then begin   {right}
      Inc(n, 2);
      Poke(pcol[CurrPlyr], n);
    end else if ch = #68 then begin
      SetColors;
    end;
    n := Peek(pcol[CurrPlyr]);
    GotoXY(25, y+3*(CurrPlyr));
    Write('dec:', n, ' hex:', IntToHex(n, 0), ' ');
  end
end;

procedure SetCursor;
begin
  if CurrPlyr = 0 then
    GotoXY(1, y+3*6)
  else begin
    GotoXY(1, y+3*(CurrPlyr-1))
  end;
  Write('  ');
  GotoXY(1, y+3*CurrPlyr);
  Write('=>');
end;

procedure ConsoleKeys;
var
  CONSOL : byte absolute $D01F;
begin
  if CONSOL = 5 then begin
    Inc(CurrPlyr);
    if CurrPlyr = 7 then
      CurrPlyr := 0
    else if CurrPlyr = 0 then begin
      CurrPlyr := 6;
    end;
    SetCursor;
    Delay(400);
  end;
end;

procedure SetupPM;
begin
  // Initialize P/M custom variables
  p_data[0] := @p0Data;
  p_data[1] := @p1Data;
  p_data[2] := @p2Data;
  p_data[3] := @p3Data;

  // Initialize P/M graphics
  SetPM(_PM_DOUBLE_RES);
  InitPM(_PM_DOUBLE_RES); 

  // Turn on P/M graphics
  ShowPM(_PM_SHOW_ON);

  // Set player sizes
  SizeP(0, _PM_NORMAL_SIZE);
  SizeP(1, _PM_NORMAL_SIZE);
  SizeP(2, _PM_NORMAL_SIZE);
  SizeP(3, _PM_NORMAL_SIZE);
  
  // Position and show players
  MoveP(0, 57, 57);
  MoveP(1, 57, 69);
  MoveP(2, 57, 81);
  MoveP(3, 57, 93);
end;

// Inverse text
procedure InvText(str : string);
var
  i : Byte;
begin
  for i := 1 to Length(str) do begin
    str[i] := Chr(Ord(str[i]) + $80);
  end;
  write(str);
end;

procedure SetText;
begin
  GotoXY(14,0); InvText('Color Picker');
  SetColors;
  GotoXY(1, 23); InvText(' Select '); Write(' Select color location');
  GotoXY(1, 24); InvText(' D '); Write(' Default colors');
  Write('  ', Chr(160), Chr(27), Chr(156), Chr(27), Chr(157), Chr(27), Chr(158), Chr(27), Chr(159), Chr(160));
  Write(' Select color')
end;

begin
  InitGraph(0); CursorOff;
  SetupPM;  
  SetText; SetCursor;  
  // Main loop
  repeat
    ConsoleKeys;
  	KeyScan;
  until false;
  // Reset P/M graphics
  ShowPM(_PM_SHOW_OFF);
end.