1 # Loading images from disk, rendering images to screen.
   2 #
   3 # Currently supports ASCII Netpbm formats.
   4 #   https://en.wikipedia.org/wiki/Netpbm#File_formats
   5 
   6 type image {
   7   type: int  # supported types:
   8              #  1: portable bitmap (P1) - pixels 0 or 1
   9              #  2: portable greymap (P2) - pixels 1-byte greyscale values
  10              #  3: portable pixmap (P3) - pixels 3-byte rgb values
  11   max: int
  12   width: int
  13   height: int
  14   data: (handle array byte)
  15 }
  16 
  17 fn initialize-image _self: (addr image), in: (addr stream byte) {
  18   var self/esi: (addr image) <- copy _self
  19   var mode-storage: slice
  20   var mode/ecx: (addr slice) <- address mode-storage
  21   next-word-skipping-comments in, mode
  22   {
  23     var P1?/eax: boolean <- slice-equal? mode, "P1"
  24     compare P1?, 0/false
  25     break-if-=
  26     var type-a/eax: (addr int) <- get self, type
  27     copy-to *type-a, 1/ppm
  28     initialize-image-from-pbm self, in
  29     return
  30   }
  31   {
  32     var P2?/eax: boolean <- slice-equal? mode, "P2"
  33     compare P2?, 0/false
  34     break-if-=
  35     var type-a/eax: (addr int) <- get self, type
  36     copy-to *type-a, 2/pgm
  37     initialize-image-from-pgm self, in
  38     return
  39   }
  40   {
  41     var P3?/eax: boolean <- slice-equal? mode, "P3"
  42     compare P3?, 0/false
  43     break-if-=
  44     var type-a/eax: (addr int) <- get self, type
  45     copy-to *type-a, 3/ppm
  46     initialize-image-from-ppm self, in
  47     return
  48   }
  49   abort "initialize-image: unrecognized image type"
  50 }
  51 
  52 # dispatch to a few variants with mostly identical boilerplate
  53 # TODO: if we have more resolution we could actually use it to improve
  54 # dithering
  55 fn render-image screen: (addr screen), _img: (addr image), xmin: int, ymin: int, width: int, height: int {
  56   var img/esi: (addr image) <- copy _img
  57   var type-a/eax: (addr int) <- get img, type
  58   {
  59     compare *type-a, 1/pbm
  60     break-if-!=
  61     render-pbm-image screen, img, xmin, ymin, width, height
  62     return
  63   }
  64   {
  65     compare *type-a, 2/pgm
  66     break-if-!=
  67     var img2-storage: image
  68     var img2/edi: (addr image) <- address img2-storage
  69     dither-pgm-unordered img, img2
  70     render-raw-image screen, img2, xmin, ymin, width, height
  71     return
  72   }
  73   {
  74     compare *type-a, 3/ppm
  75     break-if-!=
  76     var img2-storage: image
  77     var img2/edi: (addr image) <- address img2-storage
  78     dither-ppm-unordered img, img2
  79     render-raw-image screen, img2, xmin, ymin, width, height
  80     return
  81   }
  82 #?   abort "render-image: unrecognized image type"
  83 }
  84 
  85 ## helpers
  86 
  87 # import a black-and-white ascii bitmap (each pixel is 0 or 1)
  88 fn initialize-image-from-pbm _self: (addr image), in: (addr stream byte) {
  89   var self/esi: (addr image) <- copy _self
  90   var curr-word-storage: slice
  91   var curr-word/ecx: (addr slice) <- address curr-word-storage
  92   # load width, height
  93   next-word-skipping-comments in, curr-word
  94   var tmp/eax: int <- parse-decimal-int-from-slice curr-word
  95   var width/edx: int <- copy tmp
  96   next-word-skipping-comments in, curr-word
  97   tmp <- parse-decimal-int-from-slice curr-word
  98   var height/ebx: int <- copy tmp
  99   # save width, height
 100   var dest/eax: (addr int) <- get self, width
 101   copy-to *dest, width
 102   dest <- get self, height
 103   copy-to *dest, height
 104   # initialize data
 105   var capacity/edx: int <- copy width
 106   capacity <- multiply height
 107   var data-ah/edi: (addr handle array byte) <- get self, data
 108   populate data-ah, capacity
 109   var _data/eax: (addr array byte) <- lookup *data-ah
 110   var data/edi: (addr array byte) <- copy _data
 111   var i/ebx: int <- copy 0
 112   {
 113     compare i, capacity
 114     break-if->=
 115     next-word-skipping-comments in, curr-word
 116     var src/eax: int <- parse-decimal-int-from-slice curr-word
 117     {
 118       var dest/ecx: (addr byte) <- index data, i
 119       copy-byte-to *dest, src
 120     }
 121     i <- increment
 122     loop
 123   }
 124 }
 125 
 126 # render a black-and-white ascii bitmap (each pixel is 0 or 1)
 127 fn render-pbm-image screen: (addr screen), _img: (addr image), xmin: int, ymin: int, width: int, height: int {
 128   var img/esi: (addr image) <- copy _img
 129   # yratio = height/img->height
 130   var img-height-a/eax: (addr int) <- get img, height
 131   var img-height/xmm0: float <- convert *img-height-a
 132   var yratio/xmm1: float <- convert height
 133   yratio <- divide img-height
 134   # xratio = width/img->width
 135   var img-width-a/eax: (addr int) <- get img, width
 136   var img-width/ebx: int <- copy *img-width-a
 137   var img-width-f/xmm0: float <- convert img-width
 138   var xratio/xmm2: float <- convert width
 139   xratio <- divide img-width-f
 140   # esi = img->data
 141   var img-data-ah/eax: (addr handle array byte) <- get img, data
 142   var _img-data/eax: (addr array byte) <- lookup *img-data-ah
 143   var img-data/esi: (addr array byte) <- copy _img-data
 144   var len/edi: int <- length img-data
 145   #
 146   var one/eax: int <- copy 1
 147   var one-f/xmm3: float <- convert one
 148   var width-f/xmm4: float <- convert width
 149   var height-f/xmm5: float <- convert height
 150   var zero/eax: int <- copy 0
 151   var zero-f/xmm0: float <- convert zero
 152   var y/xmm6: float <- copy zero-f
 153   {
 154     compare y, height-f
 155     break-if-float>=
 156     var imgy-f/xmm5: float <- copy y
 157     imgy-f <- divide yratio
 158     var imgy/edx: int <- truncate imgy-f
 159     var x/xmm7: float <- copy zero-f
 160     {
 161       compare x, width-f
 162       break-if-float>=
 163       var imgx-f/xmm5: float <- copy x
 164       imgx-f <- divide xratio
 165       var imgx/ecx: int <- truncate imgx-f
 166       var idx/eax: int <- copy imgy
 167       idx <- multiply img-width
 168       idx <- add imgx
 169       # error info in case we rounded wrong and 'index' will fail bounds-check
 170       compare idx, len
 171       {
 172         break-if-<
 173         set-cursor-position 0/screen, 0x20/x 0x20/y
 174         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, imgx, 3/fg 0/bg
 175         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, imgy, 4/fg 0/bg
 176         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, idx, 5/fg 0/bg
 177       }
 178       var src-a/eax: (addr byte) <- index img-data, idx
 179       var src/eax: byte <- copy-byte *src-a
 180       var color-int/eax: int <- copy src
 181       {
 182         compare color-int, 0/black
 183         break-if-=
 184         color-int <- copy 0xf/white
 185       }
 186       var screenx/ecx: int <- convert x
 187       screenx <- add xmin
 188       var screeny/edx: int <- convert y
 189       screeny <- add ymin
 190       pixel screen, screenx, screeny, color-int
 191       x <- add one-f
 192       loop
 193     }
 194     y <- add one-f
 195     loop
 196   }
 197 }
 198 
 199 # import a greyscale ascii "greymap" (each pixel is a shade of grey from 0 to 255)
 200 fn initialize-image-from-pgm _self: (addr image), in: (addr stream byte) {
 201   var self/esi: (addr image) <- copy _self
 202   var curr-word-storage: slice
 203   var curr-word/ecx: (addr slice) <- address curr-word-storage
 204   # load width, height
 205   next-word-skipping-comments in, curr-word
 206   var tmp/eax: int <- parse-decimal-int-from-slice curr-word
 207   var width/edx: int <- copy tmp
 208   next-word-skipping-comments in, curr-word
 209   tmp <- parse-decimal-int-from-slice curr-word
 210   var height/ebx: int <- copy tmp
 211   # check and save color levels
 212   next-word-skipping-comments in, curr-word
 213   {
 214     tmp <- parse-decimal-int-from-slice curr-word
 215     compare tmp, 0xff
 216     break-if-=
 217     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "levels of grey is not 255; continuing and hoping for the best", 0x2b/fg 0/bg
 218   }
 219   var dest/edi: (addr int) <- get self, max
 220   copy-to *dest, tmp
 221   # save width, height
 222   dest <- get self, width
 223   copy-to *dest, width
 224   dest <- get self, height
 225   copy-to *dest, height
 226   # initialize data
 227   var capacity/edx: int <- copy width
 228   capacity <- multiply height
 229   var data-ah/edi: (addr handle array byte) <- get self, data
 230   populate data-ah, capacity
 231   var _data/eax: (addr array byte) <- lookup *data-ah
 232   var data/edi: (addr array byte) <- copy _data
 233   var i/ebx: int <- copy 0
 234   {
 235     compare i, capacity
 236     break-if->=
 237     next-word-skipping-comments in, curr-word
 238     var src/eax: int <- parse-decimal-int-from-slice curr-word
 239     {
 240       var dest/ecx: (addr byte) <- index data, i
 241       copy-byte-to *dest, src
 242     }
 243     i <- increment
 244     loop
 245   }
 246 }
 247 
 248 # render a greyscale ascii "greymap" (each pixel is a shade of grey from 0 to 255) by quantizing the shades
 249 fn render-pgm-image screen: (addr screen), _img: (addr image), xmin: int, ymin: int, width: int, height: int {
 250   var img/esi: (addr image) <- copy _img
 251   # yratio = height/img->height
 252   var img-height-a/eax: (addr int) <- get img, height
 253   var img-height/xmm0: float <- convert *img-height-a
 254   var yratio/xmm1: float <- convert height
 255   yratio <- divide img-height
 256   # xratio = width/img->width
 257   var img-width-a/eax: (addr int) <- get img, width
 258   var img-width/ebx: int <- copy *img-width-a
 259   var img-width-f/xmm0: float <- convert img-width
 260   var xratio/xmm2: float <- convert width
 261   xratio <- divide img-width-f
 262   # esi = img->data
 263   var img-data-ah/eax: (addr handle array byte) <- get img, data
 264   var _img-data/eax: (addr array byte) <- lookup *img-data-ah
 265   var img-data/esi: (addr array byte) <- copy _img-data
 266   var len/edi: int <- length img-data
 267   #
 268   var one/eax: int <- copy 1
 269   var one-f/xmm3: float <- convert one
 270   var width-f/xmm4: float <- convert width
 271   var height-f/xmm5: float <- convert height
 272   var zero/eax: int <- copy 0
 273   var zero-f/xmm0: float <- convert zero
 274   var y/xmm6: float <- copy zero-f
 275   {
 276     compare y, height-f
 277     break-if-float>=
 278     var imgy-f/xmm5: float <- copy y
 279     imgy-f <- divide yratio
 280     var imgy/edx: int <- truncate imgy-f
 281     var x/xmm7: float <- copy zero-f
 282     {
 283       compare x, width-f
 284       break-if-float>=
 285       var imgx-f/xmm5: float <- copy x
 286       imgx-f <- divide xratio
 287       var imgx/ecx: int <- truncate imgx-f
 288       var idx/eax: int <- copy imgy
 289       idx <- multiply img-width
 290       idx <- add imgx
 291       # error info in case we rounded wrong and 'index' will fail bounds-check
 292       compare idx, len
 293       {
 294         break-if-<
 295         set-cursor-position 0/screen, 0x20/x 0x20/y
 296         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, imgx, 3/fg 0/bg
 297         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, imgy, 4/fg 0/bg
 298         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, idx, 5/fg 0/bg
 299       }
 300       var src-a/eax: (addr byte) <- index img-data, idx
 301       var src/eax: byte <- copy-byte *src-a
 302       var color-int/eax: int <- nearest-grey src
 303       var screenx/ecx: int <- convert x
 304       screenx <- add xmin
 305       var screeny/edx: int <- convert y
 306       screeny <- add ymin
 307       pixel screen, screenx, screeny, color-int
 308       x <- add one-f
 309       loop
 310     }
 311     y <- add one-f
 312     loop
 313   }
 314 }
 315 
 316 fn nearest-grey level-255: byte -> _/eax: int {
 317   var result/eax: int <- copy level-255
 318   result <- shift-right 4
 319   result <- add 0x10
 320   return result
 321 }
 322 
 323 fn dither-pgm-unordered-monochrome _src: (addr image), _dest: (addr image) {
 324   var src/esi: (addr image) <- copy _src
 325   var dest/edi: (addr image) <- copy _dest
 326   # copy 'width'
 327   var src-width-a/eax: (addr int) <- get src, width
 328   var tmp/eax: int <- copy *src-width-a
 329   var src-width: int
 330   copy-to src-width, tmp
 331   {
 332     var dest-width-a/edx: (addr int) <- get dest, width
 333     copy-to *dest-width-a, tmp
 334   }
 335   # copy 'height'
 336   var src-height-a/eax: (addr int) <- get src, height
 337   var tmp/eax: int <- copy *src-height-a
 338   var src-height: int
 339   copy-to src-height, tmp
 340   {
 341     var dest-height-a/ecx: (addr int) <- get dest, height
 342     copy-to *dest-height-a, tmp
 343   }
 344   # transform 'data'
 345   var capacity/ebx: int <- copy src-width
 346   capacity <- multiply src-height
 347   var dest/edi: (addr image) <- copy _dest
 348   var dest-data-ah/eax: (addr handle array byte) <- get dest, data
 349   populate dest-data-ah, capacity
 350   var _dest-data/eax: (addr array byte) <- lookup *dest-data-ah
 351   var dest-data/edi: (addr array byte) <- copy _dest-data
 352   # needs a buffer to temporarily hold more than 256 levels of precision
 353   var errors-storage: (array int 0xc0000)
 354   var errors/ebx: (addr array int) <- address errors-storage
 355   var src-data-ah/eax: (addr handle array byte) <- get src, data
 356   var _src-data/eax: (addr array byte) <- lookup *src-data-ah
 357   var src-data/esi: (addr array byte) <- copy _src-data
 358   var y/edx: int <- copy 0
 359   {
 360     compare y, src-height
 361     break-if->=
 362     var x/ecx: int <- copy 0
 363     {
 364       compare x, src-width
 365       break-if->=
 366       var curr/eax: byte <- _read-pgm-buffer src-data, x, y, src-width
 367       var curr-int/eax: int <- copy curr
 368       curr-int <- shift-left 0x10  # we have 32 bits; we'll use 16 bits for the fraction and leave 8 for unanticipated overflow
 369       var error/esi: int <- _read-dithering-error errors, x, y, src-width
 370       error <- add curr-int
 371       $dither-pgm-unordered-monochrome:update-error: {
 372         compare error, 0x800000
 373         {
 374           break-if->=
 375           _write-raw-buffer dest-data, x, y, src-width, 0/black
 376           break $dither-pgm-unordered-monochrome:update-error
 377         }
 378         _write-raw-buffer dest-data, x, y, src-width, 1/white
 379         error <- subtract 0xff0000
 380       }
 381       _diffuse-dithering-error-floyd-steinberg errors, x, y, src-width, src-height, error
 382       x <- increment
 383       loop
 384     }
 385     move-cursor-to-left-margin-of-next-line 0/screen
 386     y <- increment
 387     loop
 388   }
 389 }
 390 
 391 fn dither-pgm-unordered _src: (addr image), _dest: (addr image) {
 392   var src/esi: (addr image) <- copy _src
 393   var dest/edi: (addr image) <- copy _dest
 394   # copy 'width'
 395   var src-width-a/eax: (addr int) <- get src, width
 396   var tmp/eax: int <- copy *src-width-a
 397   var src-width: int
 398   copy-to src-width, tmp
 399   {
 400     var dest-width-a/edx: (addr int) <- get dest, width
 401     copy-to *dest-width-a, tmp
 402   }
 403   # copy 'height'
 404   var src-height-a/eax: (addr int) <- get src, height
 405   var tmp/eax: int <- copy *src-height-a
 406   var src-height: int
 407   copy-to src-height, tmp
 408   {
 409     var dest-height-a/ecx: (addr int) <- get dest, height
 410     copy-to *dest-height-a, tmp
 411   }
 412   # compute scaling factor 255/max
 413   var target-scale/eax: int <- copy 0xff
 414   var scale-f/xmm7: float <- convert target-scale
 415   var src-max-a/eax: (addr int) <- get src, max
 416   var tmp-f/xmm0: float <- convert *src-max-a
 417   scale-f <- divide tmp-f
 418   # transform 'data'
 419   var capacity/ebx: int <- copy src-width
 420   capacity <- multiply src-height
 421   var dest/edi: (addr image) <- copy _dest
 422   var dest-data-ah/eax: (addr handle array byte) <- get dest, data
 423   populate dest-data-ah, capacity
 424   var _dest-data/eax: (addr array byte) <- lookup *dest-data-ah
 425   var dest-data/edi: (addr array byte) <- copy _dest-data
 426   # needs a buffer to temporarily hold more than 256 levels of precision
 427   var errors-storage: (array int 0xc0000)
 428   var errors/ebx: (addr array int) <- address errors-storage
 429   var src-data-ah/eax: (addr handle array byte) <- get src, data
 430   var _src-data/eax: (addr array byte) <- lookup *src-data-ah
 431   var src-data/esi: (addr array byte) <- copy _src-data
 432   var y/edx: int <- copy 0
 433   {
 434     compare y, src-height
 435     break-if->=
 436     var x/ecx: int <- copy 0
 437     {
 438       compare x, src-width
 439       break-if->=
 440       var initial-color/eax: byte <- _read-pgm-buffer src-data, x, y, src-width
 441       # . scale to 255 levels
 442       var initial-color-int/eax: int <- copy initial-color
 443       var initial-color-f/xmm0: float <- convert initial-color-int
 444       initial-color-f <- multiply scale-f
 445       initial-color-int <- convert initial-color-f
 446       var error/esi: int <- _read-dithering-error errors, x, y, src-width
 447       # error += (initial-color << 16)
 448       {
 449         var tmp/eax: int <- copy initial-color-int
 450         tmp <- shift-left 0x10  # we have 32 bits; we'll use 16 bits for the fraction and leave 8 for unanticipated overflow
 451         error <- add tmp
 452       }
 453       # nearest-color = nearest(error >> 16)
 454       var nearest-color/eax: int <- copy error
 455       nearest-color <- shift-right-signed 0x10
 456       {
 457         compare nearest-color, 0
 458         break-if->=
 459         nearest-color <- copy 0
 460       }
 461       {
 462         compare nearest-color, 0xf0
 463         break-if-<=
 464         nearest-color <- copy 0xf0
 465       }
 466       # . truncate last 4 bits
 467       nearest-color <- and 0xf0
 468       # error -= (nearest-color << 16)
 469       {
 470         var tmp/eax: int <- copy nearest-color
 471         tmp <- shift-left 0x10
 472         error <- subtract tmp
 473       }
 474       # color-index = (nearest-color >> 4 + 16)
 475       var color-index/eax: int <- copy nearest-color
 476       color-index <- shift-right 4
 477       color-index <- add 0x10
 478       var color-index-byte/eax: byte <- copy-byte color-index
 479       _write-raw-buffer dest-data, x, y, src-width, color-index-byte
 480       _diffuse-dithering-error-floyd-steinberg errors, x, y, src-width, src-height, error
 481       x <- increment
 482       loop
 483     }
 484     y <- increment
 485     loop
 486   }
 487 }
 488 
 489 # Use Floyd-Steinberg algorithm for diffusing error at x, y in a 2D grid of
 490 # dimensions (width, height)
 491 #
 492 # https://tannerhelland.com/2012/12/28/dithering-eleven-algorithms-source-code.html
 493 #
 494 # Error is currently a fixed-point number with 16-bit fraction. But
 495 # interestingly this function doesn't care about that.
 496 fn _diffuse-dithering-error-floyd-steinberg errors: (addr array int), x: int, y: int, width: int, height: int, error: int {
 497   {
 498     compare error, 0
 499     break-if-!=
 500     return
 501   }
 502   var width-1/esi: int <- copy width
 503   width-1 <- decrement
 504   var height-1/edi: int <- copy height
 505   height-1 <- decrement
 506   # delta = error/16
 507 #?   show-errors errors, width, height, x, y
 508   var delta/ecx: int <- copy error
 509   delta <- shift-right-signed 4
 510   # In Floyd-Steinberg, each pixel X transmits its errors to surrounding
 511   # pixels in the following proportion:
 512   #           X     7/16
 513   #     3/16  5/16  1/16
 514   var x/edx: int <- copy x
 515   {
 516     compare x, width-1
 517     break-if->=
 518     var tmp/eax: int <- copy 7
 519     tmp <- multiply delta
 520     var xright/edx: int <- copy x
 521     xright <- increment
 522     _accumulate-dithering-error errors, xright, y, width, tmp
 523   }
 524   var y/ebx: int <- copy y
 525   {
 526     compare y, height-1
 527     break-if-<
 528     return
 529   }
 530   var ybelow: int
 531   copy-to ybelow, y
 532   increment ybelow
 533   {
 534     compare x, 0
 535     break-if-<=
 536     var tmp/eax: int <- copy 3
 537     tmp <- multiply delta
 538     var xleft/edx: int <- copy x
 539     xleft <- decrement
 540     _accumulate-dithering-error errors, xleft, ybelow, width, tmp
 541   }
 542   {
 543     var tmp/eax: int <- copy 5
 544     tmp <- multiply delta
 545     _accumulate-dithering-error errors, x, ybelow, width, tmp
 546   }
 547   {
 548     compare x, width-1
 549     break-if->=
 550     var xright/edx: int <- copy x
 551     xright <- increment
 552     _accumulate-dithering-error errors, xright, ybelow, width, delta
 553   }
 554 #?   show-errors errors, width, height, x, y
 555 }
 556 
 557 fn _accumulate-dithering-error errors: (addr array int), x: int, y: int, width: int, error: int {
 558   var curr/esi: int <- _read-dithering-error errors, x, y, width
 559   curr <- add error
 560   _write-dithering-error errors, x, y, width, curr
 561 }
 562 
 563 fn _read-dithering-error _errors: (addr array int), x: int, y: int, width: int -> _/esi: int {
 564   var errors/esi: (addr array int) <- copy _errors
 565   var idx/ecx: int <- copy y
 566   idx <- multiply width
 567   idx <- add x
 568   var result-a/eax: (addr int) <- index errors, idx
 569   return *result-a
 570 }
 571 
 572 fn _write-dithering-error _errors: (addr array int), x: int, y: int, width: int, val: int {
 573   var errors/esi: (addr array int) <- copy _errors
 574   var idx/ecx: int <- copy y
 575   idx <- multiply width
 576   idx <- add x
 577 #?   draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, idx, 7/fg 0/bg
 578 #?   move-cursor-to-left-margin-of-next-line 0/screen
 579   var src/eax: int <- copy val
 580   var dest-a/edi: (addr int) <- index errors, idx
 581   copy-to *dest-a, src
 582 }
 583 
 584 fn _read-pgm-buffer _buf: (addr array byte), x: int, y: int, width: int -> _/eax: byte {
 585   var buf/esi: (addr array byte) <- copy _buf
 586   var idx/ecx: int <- copy y
 587   idx <- multiply width
 588   idx <- add x
 589   var result-a/eax: (addr byte) <- index buf, idx
 590   var result/eax: byte <- copy-byte *result-a
 591   return result
 592 }
 593 
 594 fn _write-raw-buffer _buf: (addr array byte), x: int, y: int, width: int, val: byte {
 595   var buf/esi: (addr array byte) <- copy _buf
 596   var idx/ecx: int <- copy y
 597   idx <- multiply width
 598   idx <- add x
 599   var src/eax: byte <- copy val
 600   var dest-a/edi: (addr byte) <- index buf, idx
 601   copy-byte-to *dest-a, src
 602 }
 603 
 604 # some debugging helpers
 605 fn show-errors errors: (addr array int), width: int, height: int, x: int, y: int {
 606   compare y, 1
 607   {
 608     break-if-=
 609     return
 610   }
 611   compare x, 0
 612   {
 613     break-if-=
 614     return
 615   }
 616   var y/edx: int <- copy 0
 617   {
 618     compare y, height
 619     break-if->=
 620     var x/ecx: int <- copy 0
 621     {
 622       compare x, width
 623       break-if->=
 624       var error/esi: int <- _read-dithering-error errors, x, y, width
 625       psd "e", error, 5/fg, x, y
 626       x <- increment
 627       loop
 628     }
 629     move-cursor-to-left-margin-of-next-line 0/screen
 630     y <- increment
 631     loop
 632   }
 633 }
 634 
 635 fn psd s: (addr array byte), d: int, fg: int, x: int, y: int {
 636   {
 637     compare y, 0x18
 638     break-if->=
 639     return
 640   }
 641   {
 642     compare y, 0x1c
 643     break-if-<=
 644     return
 645   }
 646   {
 647     compare x, 0x40
 648     break-if->=
 649     return
 650   }
 651 #?   {
 652 #?     compare x, 0x48
 653 #?     break-if-<=
 654 #?     return
 655 #?   }
 656   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg 0/bg
 657   draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, d, fg 0/bg
 658 }
 659 
 660 fn psx s: (addr array byte), d: int, fg: int, x: int, y: int {
 661 #?   {
 662 #?     compare y, 0x60
 663 #?     break-if->=
 664 #?     return
 665 #?   }
 666 #?   {
 667 #?     compare y, 0x6c
 668 #?     break-if-<=
 669 #?     return
 670 #?   }
 671   {
 672     compare x, 0x20
 673     break-if->=
 674     return
 675   }
 676 #?   {
 677 #?     compare x, 0x6c
 678 #?     break-if-<=
 679 #?     return
 680 #?   }
 681   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg 0/bg
 682   draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, d, fg 0/bg
 683 }
 684 
 685 # import a color ascii "pixmap" (each pixel consists of 3 shades of r/g/b from 0 to 255)
 686 fn initialize-image-from-ppm _self: (addr image), in: (addr stream byte) {
 687   var self/esi: (addr image) <- copy _self
 688   var curr-word-storage: slice
 689   var curr-word/ecx: (addr slice) <- address curr-word-storage
 690   # load width, height
 691   next-word-skipping-comments in, curr-word
 692   var tmp/eax: int <- parse-decimal-int-from-slice curr-word
 693   var width/edx: int <- copy tmp
 694   next-word-skipping-comments in, curr-word
 695   tmp <- parse-decimal-int-from-slice curr-word
 696   var height/ebx: int <- copy tmp
 697   next-word-skipping-comments in, curr-word
 698   # check color levels
 699   {
 700     tmp <- parse-decimal-int-from-slice curr-word
 701     compare tmp, 0xff
 702     break-if-=
 703     abort "initialize-image-from-ppm: supports exactly 255 levels per rgb channel"
 704   }
 705   var dest/edi: (addr int) <- get self, max
 706   copy-to *dest, tmp
 707   # save width, height
 708   dest <- get self, width
 709   copy-to *dest, width
 710   dest <- get self, height
 711   copy-to *dest, height
 712   # initialize data
 713   var capacity/edx: int <- copy width
 714   capacity <- multiply height
 715   # . multiply by 3 for the r/g/b channels
 716   var tmp/eax: int <- copy capacity
 717   tmp <- shift-left 1
 718   capacity <- add tmp
 719   #
 720   var data-ah/edi: (addr handle array byte) <- get self, data
 721   populate data-ah, capacity
 722   var _data/eax: (addr array byte) <- lookup *data-ah
 723   var data/edi: (addr array byte) <- copy _data
 724   var i/ebx: int <- copy 0
 725   {
 726     compare i, capacity
 727     break-if->=
 728     next-word-skipping-comments in, curr-word
 729     var src/eax: int <- parse-decimal-int-from-slice curr-word
 730     {
 731       var dest/ecx: (addr byte) <- index data, i
 732       copy-byte-to *dest, src
 733     }
 734     i <- increment
 735     loop
 736   }
 737 }
 738 
 739 # import a color ascii "pixmap" (each pixel consists of 3 shades of r/g/b from 0 to 255)
 740 fn render-ppm-image screen: (addr screen), _img: (addr image), xmin: int, ymin: int, width: int, height: int {
 741   var img/esi: (addr image) <- copy _img
 742   # yratio = height/img->height
 743   var img-height-a/eax: (addr int) <- get img, height
 744   var img-height/xmm0: float <- convert *img-height-a
 745   var yratio/xmm1: float <- convert height
 746   yratio <- divide img-height
 747   # xratio = width/img->width
 748   var img-width-a/eax: (addr int) <- get img, width
 749   var img-width/ebx: int <- copy *img-width-a
 750   var img-width-f/xmm0: float <- convert img-width
 751   var xratio/xmm2: float <- convert width
 752   xratio <- divide img-width-f
 753   # esi = img->data
 754   var img-data-ah/eax: (addr handle array byte) <- get img, data
 755   var _img-data/eax: (addr array byte) <- lookup *img-data-ah
 756   var img-data/esi: (addr array byte) <- copy _img-data
 757   var len/edi: int <- length img-data
 758   #
 759   var one/eax: int <- copy 1
 760   var one-f/xmm3: float <- convert one
 761   var width-f/xmm4: float <- convert width
 762   var height-f/xmm5: float <- convert height
 763   var zero/eax: int <- copy 0
 764   var zero-f/xmm0: float <- convert zero
 765   var y/xmm6: float <- copy zero-f
 766   {
 767     compare y, height-f
 768     break-if-float>=
 769     var imgy-f/xmm5: float <- copy y
 770     imgy-f <- divide yratio
 771     var imgy/edx: int <- truncate imgy-f
 772     var x/xmm7: float <- copy zero-f
 773     {
 774       compare x, width-f
 775       break-if-float>=
 776       var imgx-f/xmm5: float <- copy x
 777       imgx-f <- divide xratio
 778       var imgx/ecx: int <- truncate imgx-f
 779       var idx/eax: int <- copy imgy
 780       idx <- multiply img-width
 781       idx <- add imgx
 782       # . multiply by 3 for the r/g/b channels
 783       {
 784         var tmp/ecx: int <- copy idx
 785         tmp <- shift-left 1
 786         idx <- add tmp
 787       }
 788       # error info in case we rounded wrong and 'index' will fail bounds-check
 789       compare idx, len
 790       {
 791         break-if-<
 792         set-cursor-position 0/screen, 0x20/x 0x20/y
 793         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, imgx, 3/fg 0/bg
 794         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, imgy, 4/fg 0/bg
 795         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, idx, 5/fg 0/bg
 796       }
 797       # r channel
 798       var r: int
 799       {
 800         var src-a/eax: (addr byte) <- index img-data, idx
 801         var src/eax: byte <- copy-byte *src-a
 802         copy-to r, src
 803       }
 804       idx <- increment
 805       # g channel
 806       var g: int
 807       {
 808         var src-a/eax: (addr byte) <- index img-data, idx
 809         var src/eax: byte <- copy-byte *src-a
 810         copy-to g, src
 811       }
 812       idx <- increment
 813       # b channel
 814       var b: int
 815       {
 816         var src-a/eax: (addr byte) <- index img-data, idx
 817         var src/eax: byte <- copy-byte *src-a
 818         copy-to b, src
 819       }
 820       idx <- increment
 821       # plot nearest color
 822       var color/eax: int <- nearest-color-euclidean r, g, b
 823       var screenx/ecx: int <- convert x
 824       screenx <- add xmin
 825       var screeny/edx: int <- convert y
 826       screeny <- add ymin
 827       pixel screen, screenx, screeny, color
 828       x <- add one-f
 829       loop
 830     }
 831     y <- add one-f
 832     loop
 833   }
 834 }
 835 
 836 fn dither-ppm-unordered _src: (addr image), _dest: (addr image) {
 837   var src/esi: (addr image) <- copy _src
 838   var dest/edi: (addr image) <- copy _dest
 839   # copy 'width'
 840   var src-width-a/eax: (addr int) <- get src, width
 841   var tmp/eax: int <- copy *src-width-a
 842   var src-width: int
 843   copy-to src-width, tmp
 844   {
 845     var dest-width-a/edx: (addr int) <- get dest, width
 846     copy-to *dest-width-a, tmp
 847   }
 848   # copy 'height'
 849   var src-height-a/eax: (addr int) <- get src, height
 850   var tmp/eax: int <- copy *src-height-a
 851   var src-height: int
 852   copy-to src-height, tmp
 853   {
 854     var dest-height-a/ecx: (addr int) <- get dest, height
 855     copy-to *dest-height-a, tmp
 856   }
 857   # compute scaling factor 255/max
 858   var target-scale/eax: int <- copy 0xff
 859   var scale-f/xmm7: float <- convert target-scale
 860   var src-max-a/eax: (addr int) <- get src, max
 861   var tmp-f/xmm0: float <- convert *src-max-a
 862   scale-f <- divide tmp-f
 863   # allocate 'data'
 864   var capacity/ebx: int <- copy src-width
 865   capacity <- multiply src-height
 866   var dest/edi: (addr image) <- copy _dest
 867   var dest-data-ah/eax: (addr handle array byte) <- get dest, data
 868   populate dest-data-ah, capacity
 869   var _dest-data/eax: (addr array byte) <- lookup *dest-data-ah
 870   var dest-data/edi: (addr array byte) <- copy _dest-data
 871   # error buffers per r/g/b channel
 872   var red-errors-storage: (array int 0xc0000)
 873   var tmp/eax: (addr array int) <- address red-errors-storage
 874   var red-errors: (addr array int)
 875   copy-to red-errors, tmp
 876   var green-errors-storage: (array int 0xc0000)
 877   var tmp/eax: (addr array int) <- address green-errors-storage
 878   var green-errors: (addr array int)
 879   copy-to green-errors, tmp
 880   var blue-errors-storage: (array int 0xc0000)
 881   var tmp/eax: (addr array int) <- address blue-errors-storage
 882   var blue-errors: (addr array int)
 883   copy-to blue-errors, tmp
 884   # transform 'data'
 885   var src-data-ah/eax: (addr handle array byte) <- get src, data
 886   var _src-data/eax: (addr array byte) <- lookup *src-data-ah
 887   var src-data/esi: (addr array byte) <- copy _src-data
 888   var y/edx: int <- copy 0
 889   {
 890     compare y, src-height
 891     break-if->=
 892     var x/ecx: int <- copy 0
 893     {
 894       compare x, src-width
 895       break-if->=
 896       # - update errors and compute color levels for current pixel in each channel
 897       # update red-error with current image pixel
 898       var red-error: int
 899       {
 900         var tmp/esi: int <- _read-dithering-error red-errors, x, y, src-width
 901         copy-to red-error, tmp
 902       }
 903       {
 904         var tmp/eax: int <- _ppm-error src-data, x, y, src-width, 0/red, scale-f
 905         add-to red-error, tmp
 906       }
 907       # recompute red channel for current pixel
 908       var red-level: int
 909       {
 910         var tmp/eax: int <- _error-to-ppm-channel red-error
 911         copy-to red-level, tmp
 912       }
 913       # update green-error with current image pixel
 914       var green-error: int
 915       {
 916         var tmp/esi: int <- _read-dithering-error green-errors, x, y, src-width
 917         copy-to green-error, tmp
 918       }
 919       {
 920         var tmp/eax: int <- _ppm-error src-data, x, y, src-width, 1/green, scale-f
 921         add-to green-error, tmp
 922       }
 923       # recompute green channel for current pixel
 924       var green-level: int
 925       {
 926         var tmp/eax: int <- _error-to-ppm-channel green-error
 927         copy-to green-level, tmp
 928       }
 929       # update blue-error with current image pixel
 930       var blue-error: int
 931       {
 932         var tmp/esi: int <- _read-dithering-error blue-errors, x, y, src-width
 933         copy-to blue-error, tmp
 934       }
 935       {
 936         var tmp/eax: int <- _ppm-error src-data, x, y, src-width, 2/blue, scale-f
 937         add-to blue-error, tmp
 938       }
 939       # recompute blue channel for current pixel
 940       var blue-level: int
 941       {
 942         var tmp/eax: int <- _error-to-ppm-channel blue-error
 943         copy-to blue-level, tmp
 944       }
 945       # - figure out the nearest color
 946       var nearest-color-index/eax: int <- nearest-color-euclidean red-level, green-level, blue-level
 947       {
 948         var nearest-color-index-byte/eax: byte <- copy-byte nearest-color-index
 949         _write-raw-buffer dest-data, x, y, src-width, nearest-color-index-byte
 950       }
 951       # - diffuse errors
 952       var red-level: int
 953       var green-level: int
 954       var blue-level: int
 955       {
 956         var tmp-red-level/ecx: int <- copy 0
 957         var tmp-green-level/edx: int <- copy 0
 958         var tmp-blue-level/ebx: int <- copy 0
 959         tmp-red-level, tmp-green-level, tmp-blue-level <- color-rgb nearest-color-index
 960         copy-to red-level, tmp-red-level
 961         copy-to green-level, tmp-green-level
 962         copy-to blue-level, tmp-blue-level
 963       }
 964       # update red-error
 965       var red-level-error/eax: int <- copy red-level
 966       red-level-error <- shift-left 0x10
 967       subtract-from red-error, red-level-error
 968       _diffuse-dithering-error-floyd-steinberg red-errors, x, y, src-width, src-height, red-error
 969       # update green-error
 970       var green-level-error/eax: int <- copy green-level
 971       green-level-error <- shift-left 0x10
 972       subtract-from green-error, green-level-error
 973       _diffuse-dithering-error-floyd-steinberg green-errors, x, y, src-width, src-height, green-error
 974       # update blue-error
 975       var blue-level-error/eax: int <- copy blue-level
 976       blue-level-error <- shift-left 0x10
 977       subtract-from blue-error, blue-level-error
 978       _diffuse-dithering-error-floyd-steinberg blue-errors, x, y, src-width, src-height, blue-error
 979       #
 980       x <- increment
 981       loop
 982     }
 983     y <- increment
 984     loop
 985   }
 986 }
 987 
 988 # convert a single channel for a single image pixel to error space
 989 fn _ppm-error buf: (addr array byte), x: int, y: int, width: int, channel: int, _scale-f: float -> _/eax: int {
 990   # current image pixel
 991   var initial-level/eax: byte <- _read-ppm-buffer buf, x, y, width, channel
 992   # scale to 255 levels
 993   var initial-level-int/eax: int <- copy initial-level
 994   var initial-level-f/xmm0: float <- convert initial-level-int
 995   var scale-f/xmm1: float <- copy _scale-f
 996   initial-level-f <- multiply scale-f
 997   initial-level-int <- convert initial-level-f
 998   # switch to fixed-point with 16 bits of precision
 999   initial-level-int <- shift-left 0x10
1000   return initial-level-int
1001 }
1002 
1003 fn _error-to-ppm-channel error: int -> _/eax: int {
1004   # clamp(error >> 16)
1005   var result/esi: int <- copy error
1006   result <- shift-right-signed 0x10
1007   {
1008     compare result, 0
1009     break-if->=
1010     result <- copy 0
1011   }
1012   {
1013     compare result, 0xff
1014     break-if-<=
1015     result <- copy 0xff
1016   }
1017   return result
1018 }
1019 
1020 # read from a buffer containing alternating bytes from r/g/b channels
1021 fn _read-ppm-buffer _buf: (addr array byte), x: int, y: int, width: int, channel: int -> _/eax: byte {
1022   var buf/esi: (addr array byte) <- copy _buf
1023   var idx/ecx: int <- copy y
1024   idx <- multiply width
1025   idx <- add x
1026   var byte-idx/edx: int <- copy 3
1027   byte-idx <- multiply idx
1028   byte-idx <- add channel
1029   var result-a/eax: (addr byte) <- index buf, byte-idx
1030   var result/eax: byte <- copy-byte *result-a
1031   return result
1032 }
1033 
1034 # each byte in the image data is a color of the current palette
1035 fn render-raw-image screen: (addr screen), _img: (addr image), xmin: int, ymin: int, width: int, height: int {
1036   var img/esi: (addr image) <- copy _img
1037   # yratio = height/img->height
1038   var img-height-a/eax: (addr int) <- get img, height
1039   var img-height/xmm0: float <- convert *img-height-a
1040   var yratio/xmm1: float <- convert height
1041   yratio <- divide img-height
1042   # xratio = width/img->width
1043   var img-width-a/eax: (addr int) <- get img, width
1044   var img-width/ebx: int <- copy *img-width-a
1045   var img-width-f/xmm0: float <- convert img-width
1046   var xratio/xmm2: float <- convert width
1047   xratio <- divide img-width-f
1048   # esi = img->data
1049   var img-data-ah/eax: (addr handle array byte) <- get img, data
1050   var _img-data/eax: (addr array byte) <- lookup *img-data-ah
1051   var img-data/esi: (addr array byte) <- copy _img-data
1052   var len/edi: int <- length img-data
1053   #
1054   var one/eax: int <- copy 1
1055   var one-f/xmm3: float <- convert one
1056   var width-f/xmm4: float <- convert width
1057   var height-f/xmm5: float <- convert height
1058   var zero/eax: int <- copy 0
1059   var zero-f/xmm0: float <- convert zero
1060   var y/xmm6: float <- copy zero-f
1061   {
1062     compare y, height-f
1063     break-if-float>=
1064     var imgy-f/xmm5: float <- copy y
1065     imgy-f <- divide yratio
1066     var imgy/edx: int <- truncate imgy-f
1067     var x/xmm7: float <- copy zero-f
1068     {
1069       compare x, width-f
1070       break-if-float>=
1071       var imgx-f/xmm5: float <- copy x
1072       imgx-f <- divide xratio
1073       var imgx/ecx: int <- truncate imgx-f
1074       var idx/eax: int <- copy imgy
1075       idx <- multiply img-width
1076       idx <- add imgx
1077       # error info in case we rounded wrong and 'index' will fail bounds-check
1078       compare idx, len
1079       {
1080         break-if-<
1081         set-cursor-position 0/screen, 0x20/x 0x20/y
1082         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, imgx, 3/fg 0/bg
1083         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, imgy, 4/fg 0/bg
1084         draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, idx, 5/fg 0/bg
1085       }
1086       var color-a/eax: (addr byte) <- index img-data, idx
1087       var color/eax: byte <- copy-byte *color-a
1088       var color-int/eax: int <- copy color
1089       var screenx/ecx: int <- convert x
1090       screenx <- add xmin
1091       var screeny/edx: int <- convert y
1092       screeny <- add ymin
1093       pixel screen, screenx, screeny, color-int
1094       x <- add one-f
1095       loop
1096     }
1097     y <- add one-f
1098     loop
1099   }
1100 }
1101 
1102 fn scale-image-height _img: (addr image), width: int -> _/ebx: int {
1103   var img/esi: (addr image) <- copy _img
1104   var img-height/eax: (addr int) <- get img, height
1105   var result-f/xmm0: float <- convert *img-height
1106   var img-width/eax: (addr int) <- get img, width
1107   var img-width-f/xmm1: float <- convert *img-width
1108   result-f <- divide img-width-f
1109   var width-f/xmm1: float <- convert width
1110   result-f <- multiply width-f
1111   var result/ebx: int <- convert result-f
1112   return result
1113 }
1114 
1115 fn next-word-skipping-comments line: (addr stream byte), out: (addr slice) {
1116   next-word line, out
1117   var retry?/eax: boolean <- slice-starts-with? out, "#"
1118   compare retry?, 0/false
1119   loop-if-!=
1120 }