Mercurial > repos > tabletprog
view modules/ui.tp @ 360:0b83f15e819d
Update llcompile for changes to llFun syntax
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Tue, 21 Apr 2015 09:00:56 -0700 |
parents | b8f721bde066 |
children | d61b1f0e1936 |
line wrap: on
line source
{ _visibleWindows <- [] _needsInit <- true _initRes <- 0 _checkInitSDL <- { if: _needsInit { _initRes <- (sdl init: ((sdl subsystems) video)) = 0 _needsInit <- true } _initRes } _applyProps <- :base properties { foreach: (object propertiesOf: base) :_ name { if: (object does: properties understand?: name) { object setProperty: name on: base to: (object sendMessage: name to: properties) } } base } _ft <- option none _getFT <- { _ft value: :ft { ft } none: { ft <- freetype init _ft <- option value: ft ft } } //TODO: Fix this for multi window _atlasDict <- dict hash _currentTex <- option none _texX <- 0 _texY <- 0 _texRowHeight <- 0 _getFontAtlas <- :path _size renderer { sizes <- _atlasDict get: path else: { new <- dict hash _atlasDict set: path new new } _getTexture <- :width height { _currentTex value: { if: _texX + width > 2048 { _texY <- _texY + _texRowHeight _texRowHeight <- 0 _texX <- 0 } if: _texY + height > 2048 { _currentTex <- renderer createTexture: ((sdl pixelFormats) bgra8888) access: ((sdl textureAccess) streaming) width: 2048 height: 2048 _currentTex value: :tex { tex blendMode!: ((sdl blendModes) blend) } none: {} _texX <- 0 _texY <- 0 _texRowHeight <- 0 } if: _texRowHeight < height { _texRowHeight <- height } } none: { _currentTex <- renderer createTexture: ((sdl pixelFormats) bgra8888) access: ((sdl textureAccess) streaming) width: 2048 height: 2048 _currentTex value: :tex { tex blendMode!: ((sdl blendModes) blend) } none: {} } _currentTex } atlas <- sizes get: _size else: { //TODO: Only load face once for all sizes a <- ((_getFT: ) faceFromPath: path index: 0) value: :_face { _textures <- #[] _charmap <- _face charmap //TODO: Feed in window system DPI or at least make this configurable dpi <- 96 _face setCharSize: _size res: dpi _pixelFactor <- ((_face unitsPerEm) f64) * 72.0 / (_size * (dpi f64)) _emUnits <- _face unitsPerEm _glyphs <- dict hash _getGlyph <- :codePoint face { _glyphs get: codePoint else: { flags <- freetype loadFlags _charmap ifget: codePoint :_glyphIndex { slot <- face glyphSlot face loadGlyph: _glyphIndex flags: ((flags render) or (flags linearDesign) or (flags noHinting)) w <- slot bitmapWidth h <- slot bitmapRows _advX <- slot linearHoriAdvance _advY <- slot linearVertAdvance _texture <- _getTexture: w h _rect <- sdl rect: _texX _texY size: w h _texture value: :tex { srcPitch <- slot bitmapPitch srcBuffer <- slot bitmapData tex lockRect: (sdl rect: _texX _texY size: w h ) with: :dstBuffer dstPitch { srcY <- 0 dstY <- 0 while: { srcY < h } do: { srcX <- 0 srcIdx <- srcY * srcPitch dstIdx <- dstY * dstPitch while: { srcX < w } do: { //Set destination pixel to white with the source pixel as alpha //This allows text color to be set using colorMod! on the texture dstBuffer set: dstIdx (srcBuffer get: srcIdx) dstBuffer set: (dstIdx + 1) 255u8 dstBuffer set: (dstIdx + 2) 255u8 dstBuffer set: (dstIdx + 3) 255u8 srcX <- srcX + 1 srcIdx <- srcIdx + 1 dstIdx <- dstIdx + 4 } srcY <- srcY + 1 dstY <- dstY + 1 } } } none: {} _texX <- _texX + w _leftOff <- slot bitmapLeft _topOff <- slot bitmapTop g <- #{ advanceX <- { _advX } advanceY <- { _advY } atlasRect <- { _rect } glyphIndex <- { _glyphIndex } drawAt:color <- :x y :color { _texture value: :tex { tex colorMod!: color tex copyRect: _rect To: (sdl rect: x+_leftOff y-_topOff size: (_rect w) (_rect h)) } none: {} } } _glyphs set: codePoint g g } else: { //get fallback _getGlyph: 0u32 face } } } _getGlyphs <- :str face { i <- 0 lines <- #[] curline <- #[] nl <- ("\n" byte: 0) uint32 while: { i < (str byte_length) } do: { //TODO: Unicode codePoint <- (str byte: i) uint32 if: codePoint = nl { lines append: curline curline <- #[] } else: { glyph <- _getGlyph: codePoint face curline append: glyph } i <- i + 1 } lines append: curline lines } _iterateGlyphs:leading:using <- :str :leading :fun { lines <- _getGlyphs: str _face y <- 0.0 maxX <- 0.0 print: "Leading: " . leading . ", EM units: " . _emUnits . "\n" leading <- leading * (_emUnits f64) / _size foreach: lines :_ glyphs { x <- 0.0 baseline <- y + (_emUnits f64) foreach: glyphs :_ glyph { fun: glyph x baseline x <- x + ((glyph advanceX) f64) //baseline <- baseline + ((glyph advanceY) f64) //TODO: kerning } y <- y + leading if: x > maxX { maxX <- x } } //convert font units into pixels x <- (maxX / _pixelFactor + 0.5) truncInt32 y <- (y / _pixelFactor + 0.5) truncInt32 vec x: x y: y } option value: #{ stringSize:leading <- :str :leading { _iterateGlyphs: str leading: leading using: :glyph x y {} } drawString:at:color:leading <- :str :xpos ypos :color :lead { _iterateGlyphs: str leading: lead using: :glyph x y { x <- ((x / _pixelFactor + 0.5) truncInt32) + xpos y <- ((y / _pixelFactor + 0.5) truncInt32) + ypos glyph drawAt: x y color: color } } } } none: { option none } sizes set: _size a a } } #{ import: [ r:g:b r:g:b:a ] from: sdl _styles <- [] window <- :properties { _wind <- option none _renderer <- option none base <- #{ title <- "Window" width <- 640 height <- 480 x <- 0 y <- 0 color <- (ui r: 255u8 g: 255u8 b: 255u8) children <- #[] show <- { if: (_checkInitSDL: ) { _wind <- sdl createWindow: title pos: x y size: width height flags: 0u32 _wind value: :window { _renderer <- window createRenderer: -1 flags: ((window renderOpts) accelerated) layout: draw: } none: { false } } } layout <- { _renderer value: :renderer { yPos <- 0 xPos <- 0 rowMaxHeight <- 0 foreach: children :_ child { softMax <- (width - xPos) child softMaxWidth: softMax maxWidth: width maxHeight: (height - yPos) renderer: renderer if: (child width) > softMax { yPos <- yPos + rowMaxHeight xPos <- 0 rowMaxHeight <- 0 } child x!: xPos child y!: yPos xPos <- xPos + (child width) if: (child height) > rowMaxHeight { rowMaxHeight <- (child height) } if: xPos >= width { yPos <- yPos + rowMaxHeight xPos <- 0 rowMaxHeight <- 0 } } } none: {} } draw <- { print: "Draw!\n" _renderer value: :renderer { print: "Rendering!\n" renderer drawColor!: color renderer clear foreach: children :_ child { child draw: renderer } renderer present true } none: { false } } styles <- { _styles } styles! <- :newstyles{ //TODO: apply styles _styles <- newstyles } } _applyProps: base properties } text <- :properties { _fontSize <- 12.0 _leading <- 15.0 _explicitLeading <- false _applyProps: #{ text <- "" //TODO: replace this with font family and style once fontconfig is hooked up font <- "/usr/share/fonts/truetype/droid/DroidSans.ttf" fontSize <- { _fontSize } fontSize! <- :newSize { _fontSize <- newSize if: (not: _explicitLeading) { _leading <- newSize * 1.25 } } leading <- { _leading } leading! <- :newLeading { _explicitLeading <- true _leading <- newLeading } color <- (ui r: 0u8 g: 0u8 b: 0u8) width <- -1 height <- -1 x <- 0 y <- 0 softMaxWidth:maxWidth:maxHeight:renderer <- :softMax :maxWidth :maxHeight :renderer { (_getFontAtlas: font fontSize renderer) value: :atlas { //TODO: word wrap bbox <- atlas stringSize: text leading: _leading width <- bbox x height <- bbox y print: "Text: " . text . " has size: " . width . ", " . height . "\n" } none: { } } draw <- :renderer { (_getFontAtlas: font fontSize renderer) value: :atlas { print: "Drawing: " . text . " at " . x . ", " . y . "\n" atlas drawString: text at: x y color: color leading: _leading } none: { } } } properties } image <- :properties { _texture <- option none _applyProps: #{ source <- "" width <- -1 height <- -1 x <- 0 y <- 0 softMaxWidth:maxWidth:maxHeight:renderer <- :softMax :maxWidth :maxHeight :renderer { _texture value: :_ { } none: { (sdl loadBMP: source) value: :surface { (surface asTexture: renderer) value: :texture { _texture <- option value: texture width <- texture width height <- texture height if: (width > maxWidth) { width <- maxWidth } if: (height > maxHeight) { height <- maxHeight } } none: { width <- 0 height <- 0 } } none: { print: "Failed to load " . source . "\n" //Should this have some kind of placeholder as a fallback? width <- 0 height <- 0 } } } draw <- :_ { _texture value: :texture { print: "Rendering bitmap to " . x . ", " . y . ", size: " . width . ", " . height . "\n" texture copyTo: (sdl rect: x y size: width height) } none: { } } } properties } enterEventLoop <- { continue? <- true _handlers <- dict hash _handlers set: ((sdl eventTypes) quit) :event { continue? <- false } _handlers set: ((sdl eventTypes) window) :event { if: (event event) = ((sdl windowEventTypes) exposed) { foreach: _visibleWindows :_ wind { print: "Redrawing window\n" wind draw } } } while: { continue? } do: { (sdl waitEvent) value: :event { _handlers ifget: (event type) :handler { handler: event } else: { print: "Unhandled event type: " . (event type) . "\n" } } none: {} } } } }