summary refs log tree commit diff stats
path: root/article/purple-hibiscus.html
Commit message (Expand)AuthorAgeFilesLines
* Remove HTML smart quotesRunxi Yu2023-08-171-4/+4
* meta viewportRunxi Yu2023-08-161-0/+1
* Public-domain footer on every pageRunxi Yu2023-08-061-0/+1
* Unicode quotationsRunxi Yu2023-08-061-3/+3
* Andrew -> Runxi1337 h4xx0r2023-07-271-1/+1
* Use ``TeX-style quotes'' instead of “unicode quotes”Andrew Yu2023-07-151-3/+3
* plain.css -> style.cssAndrew Yu2023-07-151-1/+1
* Use HTML quotesAndrew Yu2023-07-151-3/+3
* TeXmacs articleAndrew Yu2023-07-151-0/+0
* Eh, suicide jokesAndrew2023-07-151-0/+0
* Purple Hibiscus - MamaAndrew2023-07-151-0/+27
123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
# Temperature Converter app
#   https://eugenkiss.github.io/7guis/tasks/#temp
#
# To build:
#   $ ./translate converter.mu
# To run:
#   $ qemu-system-i386 code.img

# todo:
#   less duplication
#   error checking for input without hard-aborting

fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) {
  # celsius numeric representation
  var zero: float
  var celsius/xmm1: float <- fahrenheit-to-celsius zero
  # celsius string representation
  var s-storage: (stream byte 0x10)
  var s/ecx: (addr stream byte) <- address s-storage
  write-float-decimal-approximate s, celsius, 2/decimal-places
  # celsius input/display
  var celsius-input-storage: gap-buffer
  var celsius-input/esi: (addr gap-buffer) <- address celsius-input-storage
  initialize-gap-buffer celsius-input, 8/capacity
  load-gap-buffer-from-stream celsius-input, s
  var cursor-in-celsius?/edx: boolean <- copy 0xffffffff/true
  # fahrenheit numeric representation
  var fahrenheit/xmm2: float <- celsius-to-fahrenheit celsius
  # fahrenheit string representation
  clear-stream s
  write-float-decimal-approximate s, fahrenheit, 2/decimal-places
  # fahrenheit input/display
  var fahrenheit-input-storage: gap-buffer
  var fahrenheit-input/edi: (addr gap-buffer) <- address fahrenheit-input-storage
  initialize-gap-buffer fahrenheit-input, 8/capacity
  load-gap-buffer-from-stream fahrenheit-input, s
  var cursor-in-fahrenheit?/ebx: boolean <- copy 0/false  # exactly one cursor boolean must be true at any time
  # widget title
  set-cursor-position screen, 0x1f/x 0xe/y
  draw-text-rightward-from-cursor-over-full-screen screen, " Converter                            ", 0xf/fg 0x16/bg
  # event loop
  {
    # draw current state to screen
    clear-rect screen, 0x1f/xmin 0xf/ymin, 0x45/xmax 0x14/ymax, 0xc5/color
    var x/eax: int <- render-gap-buffer screen, celsius-input, 0x20/x 0x10/y, cursor-in-celsius?, 7/fg 0/bg
    x <- draw-text-rightward screen, " celsius = ", x, 0x45/xmax, 0x10/y, 7/fg 0xc5/bg
    x <- render-gap-buffer screen, fahrenheit-input, x 0x10/y, cursor-in-fahrenheit?, 7/fg 0/bg
    x <- draw-text-rightward screen, " fahrenheit", x, 0x45/xmax, 0x10/y, 7/fg 0xc5/bg
    # render a menu bar
    set-cursor-position screen, 0x21/x 0x12/y
    draw-text-rightward-from-cursor-over-full-screen screen, " tab ", 0/fg 0x5c/bg=highlight
    draw-text-rightward-from-cursor-over-full-screen screen, " switch sides ", 7/fg 0xc5/bg
    draw-text-rightward-from-cursor-over-full-screen screen, " enter ", 0/fg 0x5c/bg=highlight
    draw-text-rightward-from-cursor-over-full-screen screen, " convert ", 7/fg 0xc5/bg
    # process a single keystroke
    $main:input: {
      var key/eax: byte <- read-key keyboard
      var key/eax: grapheme <- copy key
      compare key, 0
      loop-if-=
      # tab = switch cursor between input areas
      compare key, 9/tab
      {
        break-if-!=
        cursor-in-celsius? <- not
        cursor-in-fahrenheit? <- not
        break $main:input
      }
      # enter = convert in appropriate direction
      compare key, 0xa/newline
      {
        break-if-!=
        {
          compare cursor-in-celsius?, 0/false
          break-if-=
          clear-stream s
          emit-gap-buffer celsius-input, s
          celsius <- parse-float-decimal s
          fahrenheit <- celsius-to-fahrenheit celsius
          clear-stream s
          write-float-decimal-approximate s, fahrenheit, 2/decimal-places
          clear-gap-buffer fahrenheit-input
          load-gap-buffer-from-stream fahrenheit-input, s
        }
        {
          compare cursor-in-fahrenheit?, 0/false
          break-if-=
          clear-stream s
          emit-gap-buffer fahrenheit-input, s
          {
            var tmp/xmm1: float <- parse-float-decimal s
            fahrenheit <- copy tmp
          }
          celsius <- fahrenheit-to-celsius fahrenheit
          clear-stream s
          write-float-decimal-approximate s, celsius, 2/decimal-places
          clear-gap-buffer celsius-input
          load-gap-buffer-from-stream celsius-input, s
        }
        break $main:input
      }
      # otherwise pass key to appropriate input area
      compare cursor-in-celsius?, 0/false
      {
        break-if-=
        edit-gap-buffer celsius-input, key
        break $main:input
      }
      compare cursor-in-fahrenheit?, 0/false
      {
        break-if-=
        edit-gap-buffer fahrenheit-input, key
        break $main:input
      }
    }
    loop
  }
}

fn fahrenheit-to-celsius f: float -> _/xmm1: float {
  var result/xmm1: float <- copy f
  var thirty-two/eax: int <- copy 0x20
  var thirty-two-f/xmm0: float <- convert thirty-two
  result <- subtract thirty-two-f
  var factor/xmm0: float <- rational 5, 9
  result <- multiply factor
  return result
}

fn celsius-to-fahrenheit c: float -> _/xmm2: float {
  var result/xmm1: float <- copy c
  var factor/xmm0: float <- rational 9, 5
  result <- multiply factor
  var thirty-two/eax: int <- copy 0x20
  var thirty-two-f/xmm0: float <- convert thirty-two
  result <- add thirty-two-f
  return result
}
class="nv">f <- convert two hue-f <- add f break $hsl:compute-hue-normalized } } var int-256/eax: int <- copy 0x100 var scaling-factor/xmm1: float <- convert int-256 var int-6/eax: int <- copy 6 var six-f/xmm2: float <- convert int-6 scaling-factor <- divide six-f hue-f <- multiply scaling-factor var hue/eax: int <- convert hue-f # if hue < 0, hue = 256 - hue compare hue, 0 { break-if->= var tmp/ecx: int <- copy 0x100 tmp <- subtract hue hue <- copy tmp } return hue, saturation, luminance } fn test-hsl-black { var h/ecx: int <- copy 0 var s/edx: int <- copy 0 var l/ebx: int <- copy 0 h, s, l <- hsl 0, 0, 0 check-ints-equal h, 0, "F - test-hsl-black/hue" check-ints-equal s, 0, "F - test-hsl-black/saturation" check-ints-equal l, 0, "F - test-hsl-black/luminance" } fn test-hsl-white { var h/ecx: int <- copy 0 var s/edx: int <- copy 0 var l/ebx: int <- copy 0 h, s, l <- hsl 0xff, 0xff, 0xff check-ints-equal h, 0, "F - test-hsl-white/hue" check-ints-equal s, 0, "F - test-hsl-white/saturation" check-ints-equal l, 0xff, "F - test-hsl-white/luminance" } fn test-hsl-grey { var h/ecx: int <- copy 0 var s/edx: int <- copy 0 var l/ebx: int <- copy 0 h, s, l <- hsl 0x30, 0x30, 0x30 check-ints-equal h, 0, "F - test-hsl-grey/hue" check-ints-equal s, 0, "F - test-hsl-grey/saturation" check-ints-equal l, 0x30, "F - test-hsl-grey/luminance" } # red hues: 0-0x54 fn test-hsl-slightly-red { var h/ecx: int <- copy 0 var s/edx: int <- copy 0 var l/ebx: int <- copy 0 h, s, l <- hsl 0xff, 0xfe, 0xfe check-ints-equal h, 0, "F - test-hsl-slightly-red/hue" check-ints-equal s, 0xff, "F - test-hsl-slightly-red/saturation" check-ints-equal l, 0xfe, "F - test-hsl-slightly-red/luminance" # TODO: should round up } fn test-hsl-extremely-red { var h/ecx: int <- copy 0 var s/edx: int <- copy 0 var l/ebx: int <- copy 0 h, s, l <- hsl 0xff, 0, 0 check-ints-equal h, 0, "F - test-hsl-extremely-red/hue" check-ints-equal s, 0xff, "F - test-hsl-extremely-red/saturation" check-ints-equal l, 0x7f, "F - test-hsl-extremely-red/luminance" # TODO: should round up } # green hues: 0x55-0xaa fn test-hsl-slightly-green { var h/ecx: int <- copy 0 var s/edx: int <- copy 0 var l/ebx: int <- copy 0 h, s, l <- hsl 0xfe, 0xff, 0xfe check-ints-equal h, 0x55, "F - test-hsl-slightly-green/hue" check-ints-equal s, 0xff, "F - test-hsl-slightly-green/saturation" check-ints-equal l, 0xfe, "F - test-hsl-slightly-green/luminance" # TODO: should round up } fn test-hsl-extremely-green { var h/ecx: int <- copy 0 var s/edx: int <- copy 0 var l/ebx: int <- copy 0 h, s, l <- hsl 0, 0xff, 0 check-ints-equal h, 0x55, "F - test-hsl-extremely-green/hue" check-ints-equal s, 0xff, "F - test-hsl-extremely-green/saturation" check-ints-equal l, 0x7f, "F - test-hsl-extremely-green/luminance" # TODO: should round up } # blue hues: 0xab-0xff fn test-hsl-slightly-blue { var h/ecx: int <- copy 0 var s/edx: int <- copy 0 var l/ebx: int <- copy 0 h, s, l <- hsl 0xfe, 0xfe, 0xff check-ints-equal h, 0xab, "F - test-hsl-slightly-blue/hue" check-ints-equal s, 0xff, "F - test-hsl-slightly-blue/saturation" check-ints-equal l, 0xfe, "F - test-hsl-slightly-blue/luminance" # TODO: should round up } fn test-hsl-extremely-blue { var h/ecx: int <- copy 0 var s/edx: int <- copy 0 var l/ebx: int <- copy 0 h, s, l <- hsl 0, 0, 0xff check-ints-equal h, 0xab, "F - test-hsl-extremely-blue/hue" check-ints-equal s, 0xff, "F - test-hsl-extremely-blue/saturation" check-ints-equal l, 0x7f, "F - test-hsl-extremely-blue/luminance" # TODO: should round up } # cyan: 0x7f fn test-hsl-cyan { var h/ecx: int <- copy 0 var s/edx: int <- copy 0 var l/ebx: int <- copy 0 h, s, l <- hsl 0, 0xff, 0xff check-ints-equal h, 0x80, "F - test-hsl-cyan/hue" check-ints-equal s, 0xff, "F - test-hsl-cyan/saturation" check-ints-equal l, 0x7f, "F - test-hsl-cyan/luminance" # TODO: should round up } fn nearest-color-euclidean-hsl h: int, s: int, l: int -> _/eax: int { var result/edi: int <- copy 0x100/invalid var max-distance/esi: int <- copy 0x30000/max # 3 * 0x100*0x100 var a/ecx: int <- copy 0 var b/edx: int <- copy 0 var c/ebx: int <- copy 0 var color/eax: int <- copy 0 { compare color, 0x100 break-if->= $nearest-color-euclidean-hsl:body: { a, b, c <- color-rgb color a, b, c <- hsl a, b, c { var curr-distance/eax: int <- euclidean-hsl-squared a, b, c, h, s, l compare curr-distance, max-distance break-if->= $nearest-color-euclidean-hsl:body max-distance <- copy curr-distance } result <- copy color } color <- increment loop } return result } fn test-nearest-color-euclidean-hsl { # red from lightest to darkest var red/eax: int <- nearest-color-euclidean-hsl 0, 0xff, 0xff check-ints-equal red, 0x58/88, "F - test-nearest-color-euclidean-hsl/full-red1" red <- nearest-color-euclidean-hsl 0, 0xff, 0xc0 check-ints-equal red, 0x40/64, "F - test-nearest-color-euclidean-hsl/full-red2" red <- nearest-color-euclidean-hsl 0, 0xff, 0x80 check-ints-equal red, 0x28/40, "F - test-nearest-color-euclidean-hsl/full-red3" red <- nearest-color-euclidean-hsl 0, 0xff, 0x40 check-ints-equal red, 0x28/40, "F - test-nearest-color-euclidean-hsl/full-red4" red <- nearest-color-euclidean-hsl 0, 0xff, 0 check-ints-equal red, 0x28/40, "F - test-nearest-color-euclidean-hsl/full-red5" # try a number really close to red but on the other side of the cylinder red <- nearest-color-euclidean-hsl 0xff, 0xff, 0xff #? draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, red, 7/fg 0/bg check-ints-equal red, 0x57/87, "F - test-nearest-color-euclidean-hsl/other-end-of-red" # still looks red # half-saturation red from lightest to darkest red <- nearest-color-euclidean-hsl 0, 0x80, 0xff check-ints-equal red, 0xf/15, "F - test-nearest-color-euclidean-hsl/half-red1" # ?? grey ?? red <- nearest-color-euclidean-hsl 0, 0x80, 0xc0 check-ints-equal red, 4, "F - test-nearest-color-euclidean-hsl/half-red2" red <- nearest-color-euclidean-hsl 0, 0x80, 0x80 check-ints-equal red, 4, "F - test-nearest-color-euclidean-hsl/half-red3" red <- nearest-color-euclidean-hsl 0, 0x80, 0x40 check-ints-equal red, 4, "F - test-nearest-color-euclidean-hsl/half-red4" red <- nearest-color-euclidean-hsl 0, 0x80, 0 check-ints-equal red, 0x70/112, "F - test-nearest-color-euclidean-hsl/half-red5" } fn euclidean-hsl-squared h1: int, s1: int, l1: int, h2: int, s2: int, l2: int -> _/eax: int { var result/edi: int <- copy 0 # hue var tmp/eax: int <- copy h1 tmp <- subtract h2 tmp <- multiply tmp # TODO: should we do something to reflect that hue is a cylindrical space? # I can't come up with a failing test. result <- add tmp # saturation tmp <- copy s1 tmp <- subtract s2 tmp <- multiply tmp result <- add tmp # luminance tmp <- copy l1 tmp <- subtract l2 tmp <- multiply tmp result <- add tmp return result } ### fn maximum a: int, b: int -> _/eax: int { var a2/eax: int <- copy a compare a2, b { break-if-< return a } return b } fn minimum a: int, b: int -> _/eax: int { var a2/eax: int <- copy a compare a2, b { break-if-> return a } return b }