Commit e08a8922 authored by Bernd Paysan's avatar Bernd Paysan

Work on album viewer

parent 09451a49
Pipeline #1110 failed with stage
in 8 minutes and 49 seconds
......@@ -53,7 +53,7 @@ glue new glue-right !
: wh>tile-glue ( w h -- )
tile-glue >o
pixelsize# fm* fdup vglue-c df! dpy-h @ fm/
pixelsize# fm* fdup hglue-c df! dpy-w @ fm/ fmax 1/f fdup
pixelsize# fm* fdup hglue-c df! dpy-w @ fm/ fmax 1/f 2e fmin fdup
vglue-c df@ f* vglue-c df!
hglue-c df@ f* hglue-c df!
o> ;
......@@ -66,7 +66,7 @@ glue new glue-right !
: album-image ( addr u n -- )
imgs[] $[] @ >o image-tex
2dup "\xFF\xD8\xFF" string-prefix?
IF mem-exif [: 2dup >thumb-scan ;] catch drop
IF mem-exif [: 2dup >thumb-scan ;] catch drop nothrow
img-orient @ 1- 0 max dup to rotate# exif>
ELSE 0 THEN >r
mem>texture
......
......@@ -33,7 +33,7 @@ also soil
: >texture ( addr w h -- )
2 pick >r rgba-texture wrap-texture mipmap linear-mipmap r> free throw ;
: mem>texture ( addr u -- w h )
over >r 0 0 0 { w^ w w^ h w^ ch# }
over >r { | w^ w w^ h w^ ch# }
w h ch# SOIL_LOAD_RGBA SOIL_load_image_from_memory
r> free throw w @ h @ 2dup 2>r >texture 2r> ;
: load-texture ( addr u -- w h )
......@@ -41,7 +41,7 @@ also soil
: >subtex ( addr x y w h -- )
4 pick >r rgba-subtex wrap-texture mipmap linear-mipmap r> free throw ;
: mem>subtex ( x y addr u -- w h )
over >r 0 0 0 { w^ w w^ h w^ ch# }
over >r { | w^ w w^ h w^ ch# }
w h ch# SOIL_LOAD_RGBA SOIL_load_image_from_memory
r> free throw -rot w @ h @ 2dup 2>r >subtex 2r> ;
: load-subtex ( x y addr u -- w h )
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment