#{
	import: [
		video
		timer
	] from: (sdl subsystems)
	
	import: [
		quit
	] from: (sdl eventTypes)
	
	import: [
		streaming
	] from: (sdl textureAccess)
	
	import: [
		bgra8888
	] from: (sdl pixelFormats)
	
	import: [
		render
		linearDesign
		noHinting
	] from: (freetype loadFlags)
	
	makeAtlas <- :renderer face fontSize dpi color {
		face setCharSize: fontSize res: dpi
		slot <- face glyphSlot
		
		glyphs <- #[]
		//TODO: Use a bytearray once that has an append method
		pixels <- #[]
		foreach: (face charmap) :char glyphIdx {
			face loadGlyph: glyphIdx flags: (render or linearDesign or noHinting)
			pixelStart <- pixels length
			_width <- slot bitmapWidth
			_height <- slot bitmapRows
			pitch <- slot bitmapPitch
			buffer <- slot bitmapData
			
			y <- 0
			while: { y < _height } do: {
				x <- 0
				idx <- y * pitch
				while: { x < _width } do: {
					pixels append: (buffer get: idx)
				
					x <- x + 1
					idx <- idx + 1
				}
				y <- y + 1
			}
			
			glyphs append: #{
				width <- _width
				height <- _height
				pixelOffset <- pixelStart
				hAdvance <- slot linearHoriAdvance
				vAdvance <- slot linearVertAdvance
				leftOffset <- (slot bitmapLeft)
				topOffset <- (slot bitmapTop)
				charCode <- char
				glyphIndex <- glyphIdx
				
				atlasX <- -1
				atlasY <- -1
				atlasRect <- {
					sdl rect: atlasX atlasY size: width height
				}
				destRect <- :x y {
					sdl rect: x + leftOffset y - topOffset size: width height
				}
				
				<= <- :other {
					if: height > (other height) {
						true
					} else: {
						if: height < (other height) {
							false
						} else: {
							width >= (other width)
						}
					}
				}
			}
		}
		glyphs sort
		maxDim <- 2048
		aWidth <- 128
		minSize <- maxDim * maxDim
		minSizeWidth <- -1
		aHeight <- maxDim
		
		while: { aWidth <= maxDim } do: {
			print: "Checking width: " . aWidth . "\n"
			curX <- 0
			curY <- 0
			minHeight <- 0
			avail <- glyphs foldr: [] with: :acc val {
				val | acc
			}
			while: { (not: (avail empty?)) && curY <= maxDim } do: {
				curGlyph <- avail value
				if: curX + (curGlyph width) < aWidth {
					if: curY + (curGlyph height) < maxDim {
						curX <- curX + (curGlyph width)
						avail <- avail tail
						if: (curGlyph height) > minHeight {
							minHeight <- curGlyph height
						}
					} else: {
						curY <- maxDim + 1
					}
				} else: {
					skinny <- option none
					if: aWidth > curX {
						availPixels <- aWidth - curX
						
						skinny <- avail find: :val {
							(val width) <= availPixels
						}
					}
					
					skinny value: :curGlyph {
						curX <- curX + (curGlyph width)
						if: (curGlyph height) > minHeight {
							minHeight <- curGlyph height
						}
						avail <- avail filter: :glyph {
							(glyph charCode) != (curGlyph charCode)
						}
					} none: {
						curY <- curY + minHeight
						minHeight <- 0
						curX <- 0
					}
				}
			}
			if: (avail empty?) {
				aHeight <- curY + minHeight
				p2Height <- 1
				while: { p2Height < aHeight } do: {
					p2Height <- lshift: p2Height by: 1
				}
				
				size <- aWidth * p2Height
				if: size < minSize {
					minSize <- size
					minSizeWidth <- aWidth
				}
			}
			aWidth <- aWidth * 2
		}
		if: minSizeWidth > -1 {
			print: "Best width: " . minSizeWidth . ", height: " . (minSize / minSizeWidth) . "\n"
			aWidth <- minSizeWidth
			aHeight <- minSize / minSizeWidth
			
			(renderer createTexture: bgra8888 access: streaming width: aWidth height: aHeight) value: :drawTex {
				drawTex blendMode!: ((sdl blendModes) blend)
				//TODO: Use "update" with a static texture
				drawTex lockRect: (sdl rect: 0 0 size: aWidth aHeight) with: :bytearr pitch {
					n <- aHeight * pitch
					i <- 0
					while: { i < n } do: {
						bytearr set: i 0u8
						i <- i + 1
					}
					curX <- 0
					curY <- 0
					minHeight <- 0
					avail <- glyphs foldr: [] with: :acc val {
						val | acc
					}
					while: { not: (avail empty?) } do: {
						curGlyph <- avail value
						if: curX + (curGlyph width) < aWidth {
							curGlyph atlasX!: curX
							curGlyph atlasY!: curY
							y <- 0
							dstY <- curY
							idx <- curGlyph pixelOffset
							while: { y < (curGlyph height) } do: {
								dstIdx <- dstY * pitch + curX * 4
								x <- 0
								while: { x < (curGlyph width) } do: {
									//FIXME: This will probably only work on little endian machines
									bytearr set: dstIdx (pixels get: idx)
									dstIdx <- dstIdx + 1
									bytearr set: dstIdx (color r)
									dstIdx <- dstIdx + 1
									bytearr set: dstIdx (color g)
									dstIdx <- dstIdx + 1
									bytearr set: dstIdx (color b)
									dstIdx <- dstIdx + 1
									
									idx <- idx + 1
									x <- x + 1
								}
								y <- y + 1
								dstY <- dstY + 1
							}
							
							curX <- curX + (curGlyph width)
							avail <- avail tail
							if: (curGlyph height) > minHeight {
								minHeight <- curGlyph height
							}
						} else: {
							skinny <- option none
							if: aWidth > curX {
								availPixels <- aWidth - curX
								skinny <- avail find: :val {
									(val width) <= availPixels
								}
							}
							
							skinny value: :curGlyph {
								curGlyph atlasX!: curX
								curGlyph atlasY!: curY
								y <- 0
								dstY <- curY
								idx <- curGlyph pixelOffset
								while: { y < (curGlyph height) } do: {
									dstIdx <- dstY * pitch + curX * 4
									x <- 0
									while: { x < (curGlyph width) } do: {
										//FIXME: This will probably only work on little endian machines
										bytearr set: dstIdx (pixels get: idx)
										dstIdx <- dstIdx + 1
										bytearr set: dstIdx (color r)
										dstIdx <- dstIdx + 1
										bytearr set: dstIdx (color g)
										dstIdx <- dstIdx + 1
										bytearr set: dstIdx (color b)
										dstIdx <- dstIdx + 1
										
										idx <- idx + 1
										x <- x + 1
									}
									y <- y + 1
									dstY <- dstY + 1
								}
							
								curX <- curX + (curGlyph width)
								if: (curGlyph height) > minHeight {
									minHeight <- curGlyph height
								}
								avail <- avail filter: :glyph {
									(glyph charCode) != (curGlyph charCode)
								}
							} none: {
								curY <- curY + minHeight
								minHeight <- 0
								curX <- 0
							}
						}
					}
				}
				glyphDict <- dict hash
				foreach: glyphs :idx glyph {
					glyphDict set: (glyph charCode) glyph
				}
				_pixelFactor <- ((face unitsPerEm) f64) * 72.0 / (fontSize * (dpi f64))
				option value: #{
					texture <- drawTex
					width <- aWidth
					height <- aHeight
					glyphs <- glyphDict
					drawString:at:useKerning? <- :str :xPos yPos :kern? {
						//pixels to font units
						designPosition <- (xPos f64) * _pixelFactor
						charIdx <- 0
						last <- 0u32
						useKerning? <- kern? && (face hasKerning?)
						
						while: { charIdx < (str byte_length) } do: {
							//TODO: UTF-8
							char <- (str byte: charIdx) uint32
							glyph <- glyphs get: char else: {
								glyphs get: 0u32 else: { false }
							}
							texture copyRect: (glyph atlasRect) To: (glyph destRect: xPos yPos)
							
							designPosition <- designPosition + ((glyph hAdvance) f64)
							if: charIdx > 0 && useKerning? {
								(face getKerning: last (glyph glyphIndex) mode: ((freetype kerning) unscaled)) value: :kern {
									designPosition <- designPosition + ((kern x) f64)
								} none: {}
							}
							xPos <- (designPosition / _pixelFactor + 0.5) truncInt32
							
							last <- glyph glyphIndex
							charIdx <- charIdx + 1
						}
					}
				}
			} none: {
				print: "Failed to create texture for atlas"
				option none
			}
		} else: {
			print: "Font is too big for a 2048x2048 texture!"
			option none
		}
	}
	
	hex2 <- :num {
		val <- hex: num
		if: (val length) < 2 {
			val <- "0" . val
		}
		val
	}
	
	main <- :args {
		retcode <- 0
		dpi <- 96
		arg <- 1
		expectVal <- false
		optName <- ""
		windowWidth <- 512
		windowHeight <- 512
		posArgs <- #[]
		while: { arg < (args length) } do: {
			curArg <- args get: arg
			if: expectVal {
				if: optName = "--dpi" || optName = "-d" {
					dpi <- curArg int32
				} else: {
					if: optName = "--height" {
						windowHeight <- curArg int32
					} else: {
						if: optName = "--width" {
							windowWidth <- curArg int32
						} else: {
							print: "Unrecognized option: " . optName . "\n"
						}
					}
				}
				expectVal <- false
			} else: {
				if: (curArg startsWith?: "-") {
					expectVal <- true
					optName <- curArg
				} else: {
					posArgs append: curArg
				}
			}
			arg <- arg + 1
		}
		path <- posArgs get: 0
		str <- if: (posArgs length) > 1 { posArgs get: 1 } else: { "" }
		ft <- freetype init
		maybeFace <- ft faceFromPath: path index: 0
		charCodes <- #[]
		maybeFace value: :face {
			charMap <- face charmap
			foreach: charMap :char glyph {
				print: "Char: " . char . ", glyph index: " . glyph . "\n"
				charCodes append: char
			}
			
			if: (sdl init: (video or timer)) = 0 {
				(sdl createWindow: "Freetype Test" pos: 0 0 size: windowWidth windowHeight flags: 0u32) value: :window {
					(window createRenderer: -1 flags: ((window renderOpts) accelerated)) value: :renderer {
						renderer drawColor!: (sdl r: 255u8 g: 255u8 b: 255u8)
						
						(makeAtlas: renderer face 12.0 dpi (sdl r: 0u8 g: 0u8 b: 0u8)) value: :atlas {
							continue? <- true
							while: { continue? } do: {
								renderer clear
								if: (str length) > 0 {
									atlas drawString: str at: 0 windowHeight / 3 useKerning?: true
									atlas drawString: str at: 0 windowHeight * 2 / 3 useKerning?: false
								} else: {
									y <- 0
									x <- 0
									while: { y < (atlas height) } do: {
										copyWidth <- if: (atlas width) < windowWidth { atlas width } else: { windowWidth }
										copyHeight <- if: (atlas height) < windowHeight { atlas height } else: { windowHeight }
										(atlas texture) copyRect: (sdl rect: 0 y size: copyWidth copyHeight) To: (sdl rect: x 0 size: copyWidth copyHeight)
										y <- y + windowHeight
										x <- x + copyWidth
									}
								}
								renderer present
								event <- option none
								while: {
									event <- sdl pollEvent
									event value?
								} do: {
									event value: :ev {
										if: (ev type) = quit {
											continue? <- false
										}
									} none: {}
								}
							}
						} none: {
							retcode <- -1
						}
					} none: {
						print: "Failed to create renderer\n"
						retcode <- 1
					}
					window destroy
				} none: {
					print: "Failed to create window\n"
					retcode <- 1
				}
			} else: {
				print: "Failed to initialize SDL\n"
				retcode <- 1
			}
		} none: {
			retcode <- 1
			print: "Failed to load font face from " . path . "\n"
		}
		
		ft destroy
		retcode
	}
}