Change font textures from classic 320x200 to 256x256

refont.fs

open System

open System.Drawing
open System.Drawing.Drawing2D
open System.Drawing.Imaging
open System.Runtime.InteropServices

let message (cc : ConsoleColor) (msg : string) =
  let occ = Console.ForegroundColor
  try
    Console.ForegroundColor <- cc
    Console.WriteLine msg
  finally
    Console.ForegroundColor <- occ

let info  msg = message ConsoleColor.Gray msg
let error msg = message ConsoleColor.Red  msg

let infof   fmt = Printf.kprintf info   fmt
let errorf  fmt = Printf.kprintf error  fmt

[<EntryPoint>]
let main argv =
  let input   = @"C:\Users\marte\OneDrive\impulse\rgbreine\font.png"
  let output  = @"C:\Users\marte\OneDrive\impulse\rgbreine\refont.png"

  try
    infof "Processing file: %s" input

    use bmp = new Bitmap (input)
    if bmp.Width  <> 320                              then failwithf "Input width is %d but expected to be 320" bmp.Width
    if bmp.Height <> 200                              then failwithf "Input height is %d but expected to be 200" bmp.Height

    use nbmp  = new Bitmap (256, 256, bmp.PixelFormat)

    let bmpd  = bmp.LockBits (Rectangle(0, 0, 320, 200), ImageLockMode.ReadOnly , PixelFormat.Format32bppArgb)
    let nbmpd = nbmp.LockBits (Rectangle(0, 0, 256, 256), ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb)

    if bmpd.Width*4 <> bmpd.Stride    then failwithf "Stride and Width doesn't match up: %d <> %d" (bmpd.Width*4)  (bmpd.Stride)
    if nbmpd.Width*4 <> nbmpd.Stride  then failwithf "Stride and Width doesn't match up: %d <> %d" (nbmpd.Width*4) (nbmpd.Stride)

    let pxs   : int32 array = Array.zeroCreate (bmpd.Width*bmpd.Height)
    let npxs  : int32 array = Array.zeroCreate (nbmpd.Width*nbmpd.Height)

    Marshal.Copy (bmpd.Scan0, pxs, 0, pxs.Length)

    let blit32x25 fx fy tx ty =
      let fi = fx + fy*320
      let ti = tx + ty*256
      let rec loop fi ti y =
        if y < 25 then
          for x = 0 to 31 do
            npxs.[ti + x] <- pxs.[fi + x]
          loop (fi + 320) (ti + 256) (y + 1)
      loop fi ti 0

    infof "Processing pixels"
    for i = 0 to 69 do
      let fc, fr = i % 10, i / 10
      let tc, tr = i % 8, i / 8
      let fx, fy = 32*fc, 25*fr
      let tx, ty = 32*tc, 25*tr
      blit32x25 fx fy tx ty

    Marshal.Copy (npxs, 0, nbmpd.Scan0, npxs.Length)

    nbmp.UnlockBits (nbmpd)
    bmp.UnlockBits (bmpd)

    infof "Writing file: %s" output
    nbmp.Save output

    ()

  with
    | e -> error (e.Message)

  0