corelang/programs/main.kl

// #import "base.kl"
#load "gdi32.kl"
#load "user32.kl"
#load "os.kl"

question_mark16 :: 0x003f
String16 :: struct;; str: *U16; len: S64
String32 :: struct;; str: *U32; len: S64
UTF32_Result :: struct
  out_str: U32
  advance: S64
  error  : S64
UTF16_Result :: struct
  out_str: [2]U16
  len    : S64
  error  : S64


utf8_to_utf32 :: (c: *U8, max_advance: S64): UTF32_Result
  result: UTF32_Result
  if (c[0] & 0b10000000) == 0
    if max_advance >= 1
      c0 := c[0]->U32
      result.out_str = c0
      result.advance = 1
    else;; result.error = 1

  elif (c[0] & 0b11100000) == 0b11000000
    if (c[1] & 0b11000000) == 0b10000000 // Continuation byte required
      if max_advance >= 2
        c0 := c[0]->U32; c1 := c[1]->U32
        result.out_str = (c0 & 0b00011111) << 6 | (c1 & 0b00111111)
        result.advance = 2
      else;; result.error = 2
    else;; result.error = 2

  elif (c[0] & 0b11110000) == 0b11100000
    if (c[1] & 0b11000000) == 0b10000000 && (c[2] & 0b11000000) == 0b10000000 // Two continuation bytes required
      if max_advance >= 3
        c0 := c[0]->U32; c1 := c[1]->U32; c2 := c[2]->U32
        result.out_str = (c0 & 0b00001111) << 12 | (c1 & 0b00111111) << 6 | (c2 & 0b00111111)
        result.advance = 3
      else;; result.error = 3
    else;; result.error = 3

  elif (c[0] & 0b11111000) == 0b11110000
    if (c[1] & 0b11000000) == 0b10000000 && (c[2] & 0b11000000) == 0b10000000 && (c[3] & 0b11000000) == 0b10000000 // Three continuation bytes required
      if max_advance >= 4
        c0 := c[0]->U32; c1 := c[1]->U32; c2 := c[2]->U32; c3 := c[3]->U32
        result.out_str = (c0 & 0b00001111) << 18 | (c1 & 0b00111111) << 12 | (c2 & 0b00111111) << 6 | (c3 & 0b00111111)
        result.advance = 4
      else;; result.error = 4
    else;; result.error = 4
  else;; result.error = 4

  return result

utf32_to_utf16 :: (codepoint: U32): UTF16_Result
  result: UTF16_Result
  if codepoint < 0x10000
    result.out_str[0] = codepoint->U16
    result.out_str[1] = 0
    result.len = 1
  elif codepoint <= 0x10FFFF
    code: U32 = (codepoint - 0x10000)
    result.out_str[0] = (0xD800 | (code >> 10))->U16
    result.out_str[1] = (0xDC00 | (code & 0x3FF))->U16
    result.len = 2
  else
    result.error = 1

  return result

process_heap: HANDLE
allocate :: (size: U64): *void
  if process_heap == 0
    process_heap = GetProcessHeap()
  return HeapAlloc(process_heap, 0, size)

string_to_string16 :: (in: String): *U16, S64
  in_str := &in[0]
  // @Note(Krzosa): Should be more then enough space
  alloc_size := (length_of(in)*2)+1
  result := String16{str = allocate(alloc_size->U64)->*U16}
  for i := 0, i < length_of(in)
    decode := utf8_to_utf32(in_str + i, length_of(in) - i)
    if !decode.error
      i += decode.advance
      encode := utf32_to_utf16(decode.out_str)
      if !encode.error
        for j := 0, j < encode.len, j++
          result.str[result.len++] = encode.out_str[j]
      else
        result.str[result.len++] = question_mark16
        break
    else
      result.str[result.len++] = question_mark16
      break

  result.str[result.len] = 0
  return result.str, result.len

test_unicode :: ()
  string := "    豈 更 車 賈 滑 串 句 龜 龜 契 金 喇 奈 懶 癩 羅 蘿 螺 裸 邏 樂 洛 烙 珞 落 酪 駱 亂 卵 欄 爛 蘭 鸞 嵐 濫 藍 襤 拉 臘 蠟 廊 朗 浪 狼 郎 來 冷 勞 擄 櫓 爐 盧 老 蘆 虜 路 露 魯 鷺 碌 祿 綠 菉 錄 鹿 論 壟 弄 籠 聾 牢 磊 賂 雷 壘 屢 樓 淚 漏 累 縷 陋 勒 肋 凜 凌 稜 綾 菱 陵 讀 拏 樂 諾 丹 寧 怒 率 異 北 磻 便 復 不 泌 數 索 參 塞 省 葉 說 殺 辰 沈 拾 若 掠 略 亮 兩 凉 梁 糧 良 諒 量 勵 ..."
  string_result, string_result_len := string_to_string16(string)
  // print(string_result)

  result := utf8_to_utf32(&"A"[0], 1)
  assert(result.out_str == 'A, "Invalid decode") // '

  result  = utf8_to_utf32(&"ć"[0], 2)
  assert(result.out_str == 0x107, "Invalid decode")

  result  = utf8_to_utf32(&"ó"[0], 2)
  assert(result.out_str == 0xF3, "Invalid decode")

Vec2I :: struct;; x: S64; y: S64
Vec2  :: struct;; x: F32; y: F32
Windows_Bitmap :: struct
  size: Vec2I
  data: *U32
  hdc: HDC
  dib: HBITMAP

create_bitmap :: (size: Vec2I, bottom_up: Bool = true): Windows_Bitmap
  result: Windows_Bitmap = {size = size}
  if bottom_up == false
    result.size.y = -result.size.y

  bminfo := BITMAPINFO{
    BITMAPINFOHEADER{
      biSize          = 40, // @todo!!! size_of(BITMAPINFOHEADER),
      biWidth         = size.x->LONG,
      biHeight        = size.y->LONG,
      biPlanes        = 1,
      biBitCount      = 32,
      biCompression   = BI_RGB,
      biXPelsPerMeter = 1,
      biYPelsPerMeter = 1,
    }
  }

  hdc := GetDC(0)
  result.dib = CreateDIBSection(hdc, &bminfo, DIB_RGB_COLORS, (&result.data)->**void, 0, 0)
  result.hdc = CreateCompatibleDC(hdc)
  return result

app_is_running := true
window_procedure :: (hwnd: HWND, msg: UINT, wparam: WPARAM, lparam: LPARAM): LRESULT
  if msg == WM_DESTROY
    PostQuitMessage(0)
    app_is_running = false
    return 0
  else;; return DefWindowProcW(hwnd, msg, wparam, lparam)

WinMain :: (hInstance: HINSTANCE, hPrevInstance: HINSTANCE, lpCmdLine: LPSTR, nShowCmd: int): int
  window_name, window_name_len := string_to_string16("Have a wonderful day! 豈 更 車 賈 滑 串 句 龜 ")
  w := WNDCLASSW{
    lpfnWndProc   = window_procedure,
    hInstance     = hInstance,
    lpszClassName = window_name,
  }
  assert(RegisterClassW(&w) != 0)

  window := CreateWindowExW(
    dwExStyle = 0, hWndParent = 0, hMenu = 0, lpParam = 0,
    X = CW_USEDEFAULT, Y = CW_USEDEFAULT, nWidth = 1280, nHeight = 720,
    lpClassName = window_name,
    lpWindowName = window_name,
    dwStyle = WS_OVERLAPPEDWINDOW,
    hInstance = hInstance
  )
  assert(window != 0)
  ShowWindow(window, nShowCmd)

  window_dc := GetDC(window)
  bitmap := create_bitmap({1280, 720})
  for app_is_running
    msg: MSG
    for PeekMessageW(&msg, window, 0, 0, PM_REMOVE) > 0
      TranslateMessage(&msg)
      DispatchMessageW(&msg)

    for y := 0, y < bitmap.size.y, y+=1
      for x := 0, x < bitmap.size.x, x+=1
        bitmap.data[x + y*bitmap.size.x] = 0xFFFF0000

    SelectObject(bitmap.hdc, bitmap.dib)
    BitBlt(window_dc, 0, 0, (bitmap.size.x)->int, (bitmap.size.y)->int, bitmap.hdc, 0, 0, SRCCOPY)