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