Janilabo | MSSL New Memory Management

{
  type MSSL_TMMObjectKind = (mmok_Bitmap, mmok_DTM, mmok_Font);
  type MSSL_TMMBitmap
  type MSSL_TMMDTM
  type MSSL_TMMFont
  type MSSL_TMemoryManagement
  function MSSL_CreateMMSet(var MM: MSSL_TMemoryManagement; name, genre, description: string): Integer;
  function MSSL_AddMMObject(var MM: MSSL_TMemoryManagement; set_ID: Integer; objKind: MSSL_TMMObjectKind; name, genre, description, D: string): Integer;
  function MSSL_LoadMMObject(var MM: MSSL_TMemoryManagement; set_ID: Integer; objKind: MSSL_TMMObjectKind; obj_ID: Integer): Boolean;
  function MSSL_FreeMMObject(var MM: MSSL_TMemoryManagement; set_ID: Integer; objKind: MSSL_TMMObjectKind; obj_ID: Integer): Boolean;
  procedure MSSL_FreeMMObjectMulti(var MM: MSSL_TMemoryManagement; set_ID: Integer; objKind: MSSL_TMMObjectKind; obj_IDs: TIntArray);
  procedure MSSL_FreeMMObjects(var MM: MSSL_TMemoryManagement);
}

type
  MSSL_TMMObjectKind = (mmok_Bitmap, mmok_DTM, mmok_Font);
  MSSL_TMMBitmap = record
    name, genre, description, data: string;
    obj: TSCARBitmap;
    loaded: Boolean;
  end;
  MSSL_TMMDTM = record
    name, genre, description, data: string;
    obj: Integer;
    loaded: Boolean;
  end;
  MSSL_TMMFont = record
    name, genre, description, directory: string;
    obj: Integer;
    loaded: Boolean;
  end;
  MSSL_TMemoryManagement = record
    st: array of record
      bitmap: array of MSSL_TMMBitmap;
      DTM: array of MSSL_TMMDTM;
      font: array of MSSL_TMMFont;
      name, genre, description: string;
    end;
  end;

function MSSL_CreateMMSet(var MM: MSSL_TMemoryManagement; name, genre, description: string): Integer;
begin
  Result := (High(MM.st) + 1);
  SetLength(MM.st, (Result + 1));
  MM.st[Result].name := name;
  MM.st[Result].genre := genre;
  MM.st[Result].description := description;
end;

function MSSL_AddMMObject(var MM: MSSL_TMemoryManagement; set_ID: Integer; objKind: MSSL_TMMObjectKind; name, genre, description, D: string): Integer;
var
  h: Integer;
begin
  h := High(MM.st);
  if not InRange(set_ID, 0, h) or (D = '') then
    Exit;
  case objKind of
    mmok_Bitmap:
    begin
      h := High(MM.st[set_ID].bitmap);
      SetLength(MM.st[set_ID].bitmap, (h + 2));
      MM.st[set_ID].bitmap[(h + 1)].name := name;
      MM.st[set_ID].bitmap[(h + 1)].genre := genre;
      MM.st[set_ID].bitmap[(h + 1)].description := description;
      MM.st[set_ID].bitmap[(h + 1)].data := D;
    end;
    mmok_DTM:
    begin
      h := High(MM.st[set_ID].DTM);
      SetLength(MM.st[set_ID].DTM, (h + 2));
      MM.st[set_ID].DTM[(h + 1)].name := name;
      MM.st[set_ID].DTM[(h + 1)].genre := genre;
      MM.st[set_ID].DTM[(h + 1)].description := description;
      MM.st[set_ID].DTM[(h + 1)].data := D;
    end;
    mmok_Font:
    begin
      h := High(MM.st[set_ID].font);
      SetLength(MM.st[set_ID].font, (h + 2));
      MM.st[set_ID].font[(h + 1)].name := name;
      MM.st[set_ID].font[(h + 1)].genre := genre;
      MM.st[set_ID].font[(h + 1)].description := description;
      MM.st[set_ID].font[(h + 1)].directory := D;
    end;
  end;
  Result := (h + 1);
end;

function MSSL_LoadMMObject(var MM: MSSL_TMemoryManagement; set_ID: Integer; objKind: MSSL_TMMObjectKind; obj_ID: Integer): Boolean;
begin
  case objKind of
    mmok_Bitmap:
    if InRange(set_ID, 0, High(MM.st)) and InRange(obj_ID, 0, High(MM.st[set_ID].bitmap)) then
      if not MM.st[set_ID].bitmap[obj_ID].loaded then
      try
        MM.st[set_ID].bitmap[obj_ID].obj.LoadFromStr(MM.st[set_ID].bitmap[obj_ID].data);
        MM.st[set_ID].bitmap[obj_ID].loaded := True;
        Result := True;
      except
        try
          MM.st[set_ID].bitmap[obj_ID].obj.Free;
        except
        end;
        MM.st[set_ID].bitmap[obj_ID].loaded := False;
        Result := False;
      end;
    mmok_DTM:
    if InRange(set_ID, 0, High(MM.st)) and InRange(obj_ID, 0, High(MM.st[set_ID].DTM)) then
      if not MM.st[set_ID].DTM[obj_ID].loaded then
      try
        MM.st[set_ID].DTM[obj_ID].obj := DTMFromString(MM.st[set_ID].DTM[obj_ID].data);
        MM.st[set_ID].DTM[obj_ID].loaded := True;
        Result := True;
      except
        try
          FreeDTM(MM.st[set_ID].DTM[obj_ID].obj);
        except
        end;
        MM.st[set_ID].DTM[obj_ID].loaded := False;
        Result := False;
      end;
    mmok_Font:
    if (InRange(set_ID, 0, High(MM.st)) and InRange(obj_ID, 0, High(MM.st[set_ID].font))) then
      if not MM.st[set_ID].font[obj_ID].loaded then
      try
        if not DirectoryExists(MM.st[set_ID].font[obj_ID].directory) then
          Exit;
        MM.st[set_ID].font[obj_ID].obj := LoadChars2(MM.st[set_ID].font[obj_ID].directory);
        MM.st[set_ID].font[obj_ID].loaded := True;
        Result := True;
      except
        try
          FreeChars2(MM.st[set_ID].font[obj_ID].obj);
        except
        end;
        MM.st[set_ID].font[obj_ID].loaded := False;
        Result := False;
      end;
  end;
end;

function MSSL_FreeMMObject(var MM: MSSL_TMemoryManagement; set_ID: Integer; objKind: MSSL_TMMObjectKind; obj_ID: Integer): Boolean;
begin
  case objKind of
    mmok_Bitmap:
    if MM.st[set_ID].bitmap[obj_ID].loaded then
    try
      MM.st[set_ID].bitmap[obj_ID].obj.Free;
      MM.st[set_ID].bitmap[obj_ID].loaded := False;
      Result := True;
    except
      MM.st[set_ID].bitmap[obj_ID].loaded := True;
      Result := False;
    end;
    mmok_DTM:
    if InRange(set_ID, 0, High(MM.st)) and InRange(obj_ID, 0, High(MM.st[set_ID].DTM)) then
      if MM.st[set_ID].DTM[obj_ID].loaded then
      try
        FreeDTM(MM.st[set_ID].DTM[obj_ID].obj);
        MM.st[set_ID].DTM[obj_ID].loaded := False;
        Result := True;
      except
        MM.st[set_ID].DTM[obj_ID].loaded := True;
        Result := False;
      end;
    mmok_Font:
    if (InRange(set_ID, 0, High(MM.st)) and InRange(obj_ID, 0, High(MM.st[set_ID].font))) then
      if MM.st[set_ID].font[obj_ID].loaded then
      try
        FreeChars2(MM.st[set_ID].font[obj_ID].obj);
        MM.st[set_ID].font[obj_ID].loaded := False;
        Result := True;
      except
        MM.st[set_ID].font[obj_ID].loaded := True;
        Result := False;
      end;
  end;
end;

procedure MSSL_FreeMMObjectMulti(var MM: MSSL_TMemoryManagement; set_ID: Integer; objKind: MSSL_TMMObjectKind; obj_IDs: TIntArray);
var
  h, h2, i: Integer;
begin
  h2 := High(obj_IDs);
  if ((h2 < 0) or not InRange(set_ID, 0, High(MM.st))) then
    Exit;
  case objKind of
    mmok_Bitmap:
    begin
      h := High(MM.st[set_ID].bitmap);
      if (h < 0) then
        Exit;
      for i := 0 to h2 do
      try
        if InRange(obj_IDs[i], 0, h) then
          if MM.st[set_ID].bitmap[obj_IDs[i]].loaded then
          begin
            MM.st[set_ID].bitmap[obj_IDs[i]].obj.Free;
            MM.st[set_ID].bitmap[obj_IDs[i]].loaded := False;
          end;
      except
        MM.st[set_ID].bitmap[obj_IDs[i]].loaded := True;
      end;
    end;
    mmok_DTM:
    begin
      h := High(MM.st[set_ID].DTM);
      for i := 0 to h do
      try
        if MM.st[set_ID].DTM[obj_IDs[i]].loaded then
        begin
          FreeDTM(MM.st[set_ID].DTM[obj_IDs[i]].obj);
          MM.st[set_ID].DTM[obj_IDs[i]].loaded := False;
        end;
      except
        MM.st[set_ID].DTM[obj_IDs[i]].loaded := True;
      end;
    end;
    mmok_Font:
    begin
      h := High(MM.st[set_ID].font);
      if (h < 0) then
        Exit;
      for i := 0 to h2 do
      try
        if InRange(obj_IDs[i], 0, h) then
          if MM.st[set_ID].font[obj_IDs[i]].loaded then
          begin
            FreeChars2(MM.st[set_ID].font[obj_IDs[i]].obj);
            MM.st[set_ID].font[obj_IDs[i]].loaded := False;
          end;
      except
        MM.st[set_ID].font[obj_IDs[i]].loaded := True;
      end;
    end;
  end;
end;

procedure MSSL_FreeMMObjects(var MM: MSSL_TMemoryManagement);
var
  set_ID, h, h2, i, i2: Integer;
  tmpOK: array of MSSL_TMMObjectKind;
  tmpWM: TStrArray;
begin
  h2 := High(MM.st);
  if (h2 < 0) then
    Exit;
  tmpOK := [mmok_Bitmap, mmok_DTM, mmok_Font];
  for set_ID := 0 to h2 do
  begin
    tmpWM := ['Bitmap "' + MM.st[set_ID].bitmap[i].name + '" (set[' + IntToStr(set_ID) + '] - bitmap[' + IntToStr(i) + '])',
              'DTM "' + MM.st[set_ID].DTM[i].name + '" (set[' + IntToStr(set_ID) + '] - DTM[' + IntToStr(i) + '])',
              'Font "' + MM.st[set_ID].font[i].name + '" (set[' + IntToStr(set_ID) + '] - font[' + IntToStr(i) + '])'];
    for i2 := 0 to 2 do
    begin
      case tmpOK of
        mmok_Bitmap: h := High(MM.st[set_ID].bitmap);
        mmok_DTM: h := High(MM.st[set_ID].DTM);
        mmok_Font: h := High(MM.st[set_ID].font);
      end;
      for i := 0 to h do
        if not MSSL_FreeMMObject(MM, set_ID, tmpOK[i], i) then
          WriteLn('WARNING: Failed to free ' + tmpWM[i] + '!');
    end;
    SetLength(tmpWM, 0);
  end;
  SetLength(tmpOK, 0);
end;