open Utilsopen Configopen Uiutils module U = struct let dopen = '\023' let cs = '\024' let freepage = '\025' let freetile = '\026' let search = '\027' let geometry = '\028' let reqlayout = '\029' let page = '\030' let tile = '\031' let trimset = '\032' let settrim = '\033' let sliceh = '\034' let interrupt = '\035' let pgscale h = truncate (float h *. conf.pgscale) let nogeomcmds = function | s, [] -> emptystr s | _ -> false let maxy () = !S.maxy - if conf.maxhfit then !S.winh else 0 let scalecolor c = let c = c *. conf.colorscale in (c, c, c) let panbound x = bound x (- !S.w) !S.winw let pagevisible layout n = List.exists (fun l -> l.pageno = n) layout let add_to_y_and_clamp inc = bound (!S.y + inc) 0 @@ maxy ()end let debugrect (x0, y0, x1, y1, x2, y2, x3, y3) = dolog {|rect { x0,y0=(% f, % f) x1,y1=(% f, % f) x2,y2=(% f, % f) x3,y3=(% f, % f) }|} x0 y0 x1 y1 x2 y2 x3 y3 let hscrollh () = if ((conf.scrollb land scrollbhv != 0) && (!S.w > !S.winw)) || !S.uioh#alwaysscrolly then conf.scrollbw else 0 let setfontsize n = fstate.fontsize <- n; fstate.wwidth <- Ffi.measurestr fstate.fontsize "w"; fstate.maxrows <- (!S.winh - fstate.fontsize - 1) / (fstate.fontsize + 1) let showtext c s = S.text := Printf.sprintf "%c%s" c s; Glutils.postRedisplay "showtext" let adderrmsg src msg = Buffer.add_string S.errmsgs msg; S.newerrmsgs := true; Glutils.postRedisplay src let settextfmt fmt = Printf.kprintf (fun s -> S.text := s) fmtlet impmsg fmt = Printf.ksprintf (fun s -> showtext '!' s) fmtlet adderrfmt src fmt = Printf.ksprintf (fun s -> adderrmsg src s) fmt let launchpath () = if emptystr conf.pathlauncher then adderrmsg "path launcher" "command set" else let n = match !S.layout with | l :: _ -> string_of_int l.pageno | _ -> E.s in let cmd = Str.global_replace Re.percents !S.path conf.pathlauncher in let cmd = if nonemptystr n then Str.global_replace Re.percentp n cmd else cmd in match spawn cmd [] with | exception exn -> adderrfmt "spawn" "failed to execute `%s': %s" cmd @@ exntos exn | _pid -> () let getopaque pageno = Hashtbl.find S.pagemap (pageno, !S.gen) let pagetranslatepoint l x y = let dy = y - l.pagedispy in let y = dy + l.pagey in let dx = x - l.pagedispx in let x = dx + l.pagex in (x, y) let onppundermouse g x y d = let rec f = function | [] -> d | l :: rest -> match getopaque l.pageno with | exception Not_found -> f rest | opaque -> let x0 = l.pagedispx in let x1 = x0 + l.pagevw in let y0 = l.pagedispy in let y1 = y0 + l.pagevh in if y >= y0 && y <= y1 && x >= x0 && x <= x1 then let px, py = pagetranslatepoint l x y in match g opaque l px py with | Some res -> res | None -> f rest else f rest in f !S.layout let getunder x y = let g opaque l px py = if !S.bzoom then ( match Ffi.rectofblock opaque px py with | Some [|x0;x1;y0;y1|] -> let rect = (x0, y0, x1, y0, x1, y1, x0, y1) in let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in S.rects := [l.pageno, color, rect]; Glutils.postRedisplay "getunder"; | _ -> () ); let under = Ffi.whatsunder opaque px py in if under = Unone then None else Some under in onppundermouse g x y Unone let unproject x y = let g opaque l x y = match Ffi.unproject opaque x y with | Some (x, y) -> Some (Some (opaque, l.pageno, x, y)) | None -> None in onppundermouse g x y None let pipesel opaque cmd = if Ffi.hassel opaque then pipef ~closew:false "pipesel" (fun w -> Ffi.copysel w opaque; Glutils.postRedisplay "pipesel" ) cmd let paxunder x y = let g opaque l px py = if Ffi.markunder opaque px py conf.paxmark then Some (fun () -> match getopaque l.pageno with | exception Not_found -> () | opaque -> pipesel opaque conf.paxcmd ) else None in Glutils.postRedisplay "paxunder"; if conf.paxmark = MarkPage then List.iter (fun l -> match getopaque l.pageno with | exception Not_found -> () | opaque -> Ffi.clearmark opaque) !S.layout; S.roamf := onppundermouse g x y (fun () -> impmsg "whoopsie daisy") let undertext = function | Unone -> "none" | Ulinkuri s -> s | Utext s -> "font: " ^ s | Utextannot (opaque, slinkindex) -> "text annotation: " ^ Ffi.gettextannot opaque slinkindex | Ufileannot (opaque, slinkindex) -> "file annotation: " ^ Ffi.getfileannot opaque slinkindex let updateunder x y = match getunder x y with | Unone -> Wsi.setcursor Wsi.CURSOR_INHERIT | Ulinkuri uri -> if conf.underinfo then showtext 'u' ("ri: " ^ uri); Wsi.setcursor Wsi.CURSOR_INFO | Utext s -> if conf.underinfo then showtext 'f' ("ont: " ^ s); Wsi.setcursor Wsi.CURSOR_TEXT | Utextannot _ -> if conf.underinfo then showtext 't' "ext annotation"; Wsi.setcursor Wsi.CURSOR_INFO | Ufileannot _ -> if conf.underinfo then showtext 'f' "ile annotation"; Wsi.setcursor Wsi.CURSOR_INFO let showlinktype under = if conf.underinfo && under != Unone then showtext ' ' @@ undertext under let intentry_with_suffix text key = let text = match [@warning "-fragile-match"] key with | Keys.Ascii ('0'..'9' as c) -> addchar text c | Keys.Ascii ('k' | 'm' | 'g' | 'K' | 'M' | 'G' as c) -> addchar text @@ Char.lowercase_ascii c | _ -> S.text := "invalid key"; text in TEcont text let wcmd cmd fmt = let b = Buffer.create 16 in Printf.kbprintf (fun b -> Buffer.add_char b cmd; let b = Buffer.to_bytes b in Ffi.wcmd !S.ss b @@ Bytes.length b ) b fmt let wcmd1 cmd opaque = let s = Opaque.to_string opaque in let l = String.length s in let b = Bytes.create (l+1) in Bytes.set b l cmd; Bytes.blit_string s 0 b 0 l; Ffi.wcmd !S.ss b @@ l + 1 let layoutN ((columns, coverA, coverB), b) x y sw sh = let rec fold accu n = if n = Array.length b then accu else let pdimno, dx, vy, (_, w, h, xoff) = b.(n) in if (vy - y) > sh && (n = coverA - 1 || n = !S.pagecount - coverB || (n - coverA) mod columns = columns - 1) then accu else let accu = if vy + h > y then let pagey = max 0 (y - vy) in let pagedispy = if pagey > 0 then 0 else vy - y in let pagedispx, pagex = let pdx = if n = coverA - 1 || n = !S.pagecount - coverB then x + (sw - w) / 2 else dx + xoff + x in if pdx < 0 then 0, -pdx else pdx, 0 in let pagevw = let vw = sw - pagedispx in let pw = w - pagex in min vw pw in let pagevh = min (h - pagey) (sh - pagedispy) in if pagevw > 0 && pagevh > 0 then { pageno = n ; pagecol = 0 ; pagedimno = pdimno ; pagew = w ; pageh = h ; pagex ; pagey ; pagevw ; pagevh ; pagedispx ; pagedispy } :: accu else accu else accu in fold accu (n+1) in if Array.length b = 0 then [] else List.rev (fold [] (page_of_y y)) let layoutS (columns, b) x y sw sh = let rec fold accu n = if n = Array.length b then accu else let pdimno, px, vy, (_, pagew, pageh, xoff) = b.(n) in if (vy - y) > sh then accu else let accu = if vy + pageh > y then let x = xoff + x in let pagey = max 0 (y - vy) in let pagedispy = if pagey > 0 then 0 else vy - y in let pagedispx, pagex = if px = 0 then ( if x < 0 then 0, -x else x, 0 ) else ( let px = px - x in if px < 0 then -px, 0 else 0, px ) in let pagecolw = pagew/columns in let pagedispx = if pagecolw < sw then pagedispx + ((sw - pagecolw) / 2) else pagedispx in let pagevw = let vw = sw - pagedispx in let pw = pagew - pagex in min vw pw in let pagevw = min pagevw pagecolw in let pagevh = min (pageh - pagey) (sh - pagedispy) in if pagevw > 0 && pagevh > 0 then { pageno = n/columns ; pagedimno = pdimno ; pagecol = n mod columns ; pagew ; pageh ; pagex ; pagey ; pagedispx ; pagedispy ; pagevw ; pagevh } :: accu else accu else accu in fold accu (n+1) in List.rev (fold [] 0) let layout x y sw sh = if U.nogeomcmds !S.geomcmds then match conf.columns with | Csingle b -> layoutN ((1, 0, 0), b) x y sw sh | Cmulti c -> layoutN c x y sw sh | Csplit s -> layoutS s x y sw sh else [] let itertiles l f = let tilex = l.pagex mod conf.tilew in let tiley = l.pagey mod conf.tileh in let col = l.pagex / conf.tilew in let row = l.pagey / conf.tileh in let rec rowloop row y0 dispy h = if h != 0 then let dh = conf.tileh - y0 in let dh = min h dh in let rec colloop col x0 dispx w = if w != 0 then let dw = conf.tilew - x0 in let dw = min w dw in f col row dispx dispy x0 y0 dw dh; colloop (col+1) 0 (dispx+dw) (w-dw) in colloop col tilex l.pagedispx l.pagevw; rowloop (row+1) 0 (dispy+dh) (h-dh) in if l.pagevw > 0 && l.pagevh > 0 then rowloop row tiley l.pagedispy l.pagevh let gettileopaque l col row = let key = l.pageno, !S.gen, conf.colorspace, conf.angle, l.pagew, l.pageh, col, row in Hashtbl.find_opt S.tilemap key let puttileopaque l col row gen colorspace angle opaque size elapsed = let key = l.pageno, gen, colorspace, angle, l.pagew, l.pageh, col, row in Hashtbl.add S.tilemap key (opaque, size, elapsed) let drawtiles l color = let texe e = if conf.invert then GlTex.env (`mode e) in GlDraw.color color; Ffi.begintiles (); let f col row x y tilex tiley w h = match gettileopaque l col row with | Some (opaque, _, t) -> let params = x, y, w, h, tilex, tiley in texe `blend; Ffi.drawtile params opaque; texe `modulate; if conf.debug then ( Ffi.endtiles (); let s = Printf.sprintf "%d[%d,%d] %f sec" l.pageno col row t in let w = Ffi.measurestr fstate.fontsize s in GlDraw.color (0.0, 0.0, 0.0); Glutils.filledrect (float (x-2)) (float (y-2)) (float (x+2) +. w) (float (y + fstate.fontsize + 2)); GlDraw.color color; Glutils.drawstring fstate.fontsize x (y + fstate.fontsize - 1) s; Ffi.begintiles (); ); | None -> Ffi.endtiles (); let w = let lw = !S.winw - x in min lw w and h = let lh = !S.winh - y in min lh h in texe `blend; let c = if conf.invert then 0.2 else 0.8 in GlDraw.color (c, c, c); Glutils.filledrect (float x) (float y) (float (x+w)) (float (y+h)); texe `modulate; if w > 128 && h > fstate.fontsize + 10 then ( let c = if conf.invert then 1.0 else 0.0 in GlDraw.color (c, c, c); let c, r = if conf.verbose then (col*conf.tilew, row*conf.tileh) else col, row in Glutils.drawstringf fstate.fontsize x y "Loading %d [%d,%d]" l.pageno c r; ); GlDraw.color color; Ffi.begintiles (); in itertiles l f; Ffi.endtiles () let tilevisible1 l x y = let ax0 = l.pagex and ax1 = l.pagex + l.pagevw and ay0 = l.pagey and ay1 = l.pagey + l.pagevh in let bx0 = x and by0 = y in let bx1 = min (bx0 + conf.tilew) l.pagew and by1 = min (by0 + conf.tileh) l.pageh in let rx0 = max ax0 bx0 and ry0 = max ay0 by0 and rx1 = min ax1 bx1 and ry1 = min ay1 by1 in let nonemptyintersection = rx1 > rx0 && ry1 > ry0 in nonemptyintersection let tilevisible layout n x y = let rec findpageinlayout m = function | l :: rest when l.pageno = n -> tilevisible1 l x y || ( match conf.columns with | Csplit (c, _) when c > m -> findpageinlayout (m+1) rest | Csplit _ | Csingle _ | Cmulti _ -> false ) | _ :: rest -> findpageinlayout 0 rest | [] -> false in findpageinlayout 0 layout let tileready l x y = tilevisible1 l x y && gettileopaque l (x/conf.tilew) (y/conf.tileh) != None let tilepage n p layout = let rec loop = function | l :: rest -> if l.pageno = n then let f col row _ _ _ _ _ _ = if !S.currently = Idle then match gettileopaque l col row with | Some _ -> () | None -> let x = col*conf.tilew and y = row*conf.tileh in let w = let w = l.pagew - x in min w conf.tilew in let h = let h = l.pageh - y in min h conf.tileh in wcmd U.tile "%s %d %d %d %d" (Opaque.to_string p) x y w h; S.currently := Tiling ( l, p, conf.colorspace, conf.angle, !S.gen, col, row, conf.tilew, conf.tileh ); in itertiles l f; else loop rest | [] -> () in if U.nogeomcmds !S.geomcmds then loop layout let preloadlayout x y sw sh = let y = if y < sh then 0 else y - sh in let x = min 0 (x + sw) in let h = sh*3 inLines 1–500 of 4897. Load more
open Utils open Config open Uiutils module U = struct let dopen = '\023' let cs = '\024' let freepage = '\025' let freetile = '\026' let search = '\027' let geometry = '\028' let reqlayout = '\029' let page = '\030' let tile = '\031' let trimset = '\032' let settrim = '\033' let sliceh = '\034' let interrupt = '\035' let pgscale h = truncate (float h *. conf.pgscale) let nogeomcmds = function | s, [] -> emptystr s | _ -> false let maxy () = !S.maxy - if conf.maxhfit then !S.winh else 0 let scalecolor c = let c = c *. conf.colorscale in (c, c, c) let panbound x = bound x (- !S.w) !S.winw let pagevisible layout n = List.exists (fun l -> l.pageno = n) layout let add_to_y_and_clamp inc = bound (!S.y + inc) 0 @@ maxy () end let debugrect (x0, y0, x1, y1, x2, y2, x3, y3) = dolog {|rect { x0,y0=(% f, % f) x1,y1=(% f, % f) x2,y2=(% f, % f) x3,y3=(% f, % f) }|} x0 y0 x1 y1 x2 y2 x3 y3 let hscrollh () = if ((conf.scrollb land scrollbhv != 0) && (!S.w > !S.winw)) || !S.uioh#alwaysscrolly then conf.scrollbw else 0 let setfontsize n = fstate.fontsize <- n; fstate.wwidth <- Ffi.measurestr fstate.fontsize "w"; fstate.maxrows <- (!S.winh - fstate.fontsize - 1) / (fstate.fontsize + 1) let showtext c s = S.text := Printf.sprintf "%c%s" c s; Glutils.postRedisplay "showtext" let adderrmsg src msg = Buffer.add_string S.errmsgs msg; S.newerrmsgs := true; Glutils.postRedisplay src let settextfmt fmt = Printf.kprintf (fun s -> S.text := s) fmt let impmsg fmt = Printf.ksprintf (fun s -> showtext '!' s) fmt let adderrfmt src fmt = Printf.ksprintf (fun s -> adderrmsg src s) fmt let launchpath () = if emptystr conf.pathlauncher then adderrmsg "path launcher" "command set" else let n = match !S.layout with | l :: _ -> string_of_int l.pageno | _ -> E.s in let cmd = Str.global_replace Re.percents !S.path conf.pathlauncher in let cmd = if nonemptystr n then Str.global_replace Re.percentp n cmd else cmd in match spawn cmd [] with | exception exn -> adderrfmt "spawn" "failed to execute `%s': %s" cmd @@ exntos exn | _pid -> () let getopaque pageno = Hashtbl.find S.pagemap (pageno, !S.gen) let pagetranslatepoint l x y = let dy = y - l.pagedispy in let y = dy + l.pagey in let dx = x - l.pagedispx in let x = dx + l.pagex in (x, y) let onppundermouse g x y d = let rec f = function | [] -> d | l :: rest -> match getopaque l.pageno with | exception Not_found -> f rest | opaque -> let x0 = l.pagedispx in let x1 = x0 + l.pagevw in let y0 = l.pagedispy in let y1 = y0 + l.pagevh in if y >= y0 && y <= y1 && x >= x0 && x <= x1 then let px, py = pagetranslatepoint l x y in match g opaque l px py with | Some res -> res | None -> f rest else f rest in f !S.layout let getunder x y = let g opaque l px py = if !S.bzoom then ( match Ffi.rectofblock opaque px py with | Some [|x0;x1;y0;y1|] -> let rect = (x0, y0, x1, y0, x1, y1, x0, y1) in let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in S.rects := [l.pageno, color, rect]; Glutils.postRedisplay "getunder"; | _ -> () ); let under = Ffi.whatsunder opaque px py in if under = Unone then None else Some under in onppundermouse g x y Unone let unproject x y = let g opaque l x y = match Ffi.unproject opaque x y with | Some (x, y) -> Some (Some (opaque, l.pageno, x, y)) | None -> None in onppundermouse g x y None let pipesel opaque cmd = if Ffi.hassel opaque then pipef ~closew:false "pipesel" (fun w -> Ffi.copysel w opaque; Glutils.postRedisplay "pipesel" ) cmd let paxunder x y = let g opaque l px py = if Ffi.markunder opaque px py conf.paxmark then Some (fun () -> match getopaque l.pageno with | exception Not_found -> () | opaque -> pipesel opaque conf.paxcmd ) else None in Glutils.postRedisplay "paxunder"; if conf.paxmark = MarkPage then List.iter (fun l -> match getopaque l.pageno with | exception Not_found -> () | opaque -> Ffi.clearmark opaque) !S.layout; S.roamf := onppundermouse g x y (fun () -> impmsg "whoopsie daisy") let undertext = function | Unone -> "none" | Ulinkuri s -> s | Utext s -> "font: " ^ s | Utextannot (opaque, slinkindex) -> "text annotation: " ^ Ffi.gettextannot opaque slinkindex | Ufileannot (opaque, slinkindex) -> "file annotation: " ^ Ffi.getfileannot opaque slinkindex let updateunder x y = match getunder x y with | Unone -> Wsi.setcursor Wsi.CURSOR_INHERIT | Ulinkuri uri -> if conf.underinfo then showtext 'u' ("ri: " ^ uri); Wsi.setcursor Wsi.CURSOR_INFO | Utext s -> if conf.underinfo then showtext 'f' ("ont: " ^ s); Wsi.setcursor Wsi.CURSOR_TEXT | Utextannot _ -> if conf.underinfo then showtext 't' "ext annotation"; Wsi.setcursor Wsi.CURSOR_INFO | Ufileannot _ -> if conf.underinfo then showtext 'f' "ile annotation"; Wsi.setcursor Wsi.CURSOR_INFO let showlinktype under = if conf.underinfo && under != Unone then showtext ' ' @@ undertext under let intentry_with_suffix text key = let text = match [@warning "-fragile-match"] key with | Keys.Ascii ('0'..'9' as c) -> addchar text c | Keys.Ascii ('k' | 'm' | 'g' | 'K' | 'M' | 'G' as c) -> addchar text @@ Char.lowercase_ascii c | _ -> S.text := "invalid key"; text in TEcont text let wcmd cmd fmt = let b = Buffer.create 16 in Printf.kbprintf (fun b -> Buffer.add_char b cmd; let b = Buffer.to_bytes b in Ffi.wcmd !S.ss b @@ Bytes.length b ) b fmt let wcmd1 cmd opaque = let s = Opaque.to_string opaque in let l = String.length s in let b = Bytes.create (l+1) in Bytes.set b l cmd; Bytes.blit_string s 0 b 0 l; Ffi.wcmd !S.ss b @@ l + 1 let layoutN ((columns, coverA, coverB), b) x y sw sh = let rec fold accu n = if n = Array.length b then accu else let pdimno, dx, vy, (_, w, h, xoff) = b.(n) in if (vy - y) > sh && (n = coverA - 1 || n = !S.pagecount - coverB || (n - coverA) mod columns = columns - 1) then accu else let accu = if vy + h > y then let pagey = max 0 (y - vy) in let pagedispy = if pagey > 0 then 0 else vy - y in let pagedispx, pagex = let pdx = if n = coverA - 1 || n = !S.pagecount - coverB then x + (sw - w) / 2 else dx + xoff + x in if pdx < 0 then 0, -pdx else pdx, 0 in let pagevw = let vw = sw - pagedispx in let pw = w - pagex in min vw pw in let pagevh = min (h - pagey) (sh - pagedispy) in if pagevw > 0 && pagevh > 0 then { pageno = n ; pagecol = 0 ; pagedimno = pdimno ; pagew = w ; pageh = h ; pagex ; pagey ; pagevw ; pagevh ; pagedispx ; pagedispy } :: accu else accu else accu in fold accu (n+1) in if Array.length b = 0 then [] else List.rev (fold [] (page_of_y y)) let layoutS (columns, b) x y sw sh = let rec fold accu n = if n = Array.length b then accu else let pdimno, px, vy, (_, pagew, pageh, xoff) = b.(n) in if (vy - y) > sh then accu else let accu = if vy + pageh > y then let x = xoff + x in let pagey = max 0 (y - vy) in let pagedispy = if pagey > 0 then 0 else vy - y in let pagedispx, pagex = if px = 0 then ( if x < 0 then 0, -x else x, 0 ) else ( let px = px - x in if px < 0 then -px, 0 else 0, px ) in let pagecolw = pagew/columns in let pagedispx = if pagecolw < sw then pagedispx + ((sw - pagecolw) / 2) else pagedispx in let pagevw = let vw = sw - pagedispx in let pw = pagew - pagex in min vw pw in let pagevw = min pagevw pagecolw in let pagevh = min (pageh - pagey) (sh - pagedispy) in if pagevw > 0 && pagevh > 0 then { pageno = n/columns ; pagedimno = pdimno ; pagecol = n mod columns ; pagew ; pageh ; pagex ; pagey ; pagedispx ; pagedispy ; pagevw ; pagevh } :: accu else accu else accu in fold accu (n+1) in List.rev (fold [] 0) let layout x y sw sh = if U.nogeomcmds !S.geomcmds then match conf.columns with | Csingle b -> layoutN ((1, 0, 0), b) x y sw sh | Cmulti c -> layoutN c x y sw sh | Csplit s -> layoutS s x y sw sh else [] let itertiles l f = let tilex = l.pagex mod conf.tilew in let tiley = l.pagey mod conf.tileh in let col = l.pagex / conf.tilew in let row = l.pagey / conf.tileh in let rec rowloop row y0 dispy h = if h != 0 then let dh = conf.tileh - y0 in let dh = min h dh in let rec colloop col x0 dispx w = if w != 0 then let dw = conf.tilew - x0 in let dw = min w dw in f col row dispx dispy x0 y0 dw dh; colloop (col+1) 0 (dispx+dw) (w-dw) in colloop col tilex l.pagedispx l.pagevw; rowloop (row+1) 0 (dispy+dh) (h-dh) in if l.pagevw > 0 && l.pagevh > 0 then rowloop row tiley l.pagedispy l.pagevh let gettileopaque l col row = let key = l.pageno, !S.gen, conf.colorspace, conf.angle, l.pagew, l.pageh, col, row in Hashtbl.find_opt S.tilemap key let puttileopaque l col row gen colorspace angle opaque size elapsed = let key = l.pageno, gen, colorspace, angle, l.pagew, l.pageh, col, row in Hashtbl.add S.tilemap key (opaque, size, elapsed) let drawtiles l color = let texe e = if conf.invert then GlTex.env (`mode e) in GlDraw.color color; Ffi.begintiles (); let f col row x y tilex tiley w h = match gettileopaque l col row with | Some (opaque, _, t) -> let params = x, y, w, h, tilex, tiley in texe `blend; Ffi.drawtile params opaque; texe `modulate; if conf.debug then ( Ffi.endtiles (); let s = Printf.sprintf "%d[%d,%d] %f sec" l.pageno col row t in let w = Ffi.measurestr fstate.fontsize s in GlDraw.color (0.0, 0.0, 0.0); Glutils.filledrect (float (x-2)) (float (y-2)) (float (x+2) +. w) (float (y + fstate.fontsize + 2)); GlDraw.color color; Glutils.drawstring fstate.fontsize x (y + fstate.fontsize - 1) s; Ffi.begintiles (); ); | None -> Ffi.endtiles (); let w = let lw = !S.winw - x in min lw w and h = let lh = !S.winh - y in min lh h in texe `blend; let c = if conf.invert then 0.2 else 0.8 in GlDraw.color (c, c, c); Glutils.filledrect (float x) (float y) (float (x+w)) (float (y+h)); texe `modulate; if w > 128 && h > fstate.fontsize + 10 then ( let c = if conf.invert then 1.0 else 0.0 in GlDraw.color (c, c, c); let c, r = if conf.verbose then (col*conf.tilew, row*conf.tileh) else col, row in Glutils.drawstringf fstate.fontsize x y "Loading %d [%d,%d]" l.pageno c r; ); GlDraw.color color; Ffi.begintiles (); in itertiles l f; Ffi.endtiles () let tilevisible1 l x y = let ax0 = l.pagex and ax1 = l.pagex + l.pagevw and ay0 = l.pagey and ay1 = l.pagey + l.pagevh in let bx0 = x and by0 = y in let bx1 = min (bx0 + conf.tilew) l.pagew and by1 = min (by0 + conf.tileh) l.pageh in let rx0 = max ax0 bx0 and ry0 = max ay0 by0 and rx1 = min ax1 bx1 and ry1 = min ay1 by1 in let nonemptyintersection = rx1 > rx0 && ry1 > ry0 in nonemptyintersection let tilevisible layout n x y = let rec findpageinlayout m = function | l :: rest when l.pageno = n -> tilevisible1 l x y || ( match conf.columns with | Csplit (c, _) when c > m -> findpageinlayout (m+1) rest | Csplit _ | Csingle _ | Cmulti _ -> false ) | _ :: rest -> findpageinlayout 0 rest | [] -> false in findpageinlayout 0 layout let tileready l x y = tilevisible1 l x y && gettileopaque l (x/conf.tilew) (y/conf.tileh) != None let tilepage n p layout = let rec loop = function | l :: rest -> if l.pageno = n then let f col row _ _ _ _ _ _ = if !S.currently = Idle then match gettileopaque l col row with | Some _ -> () | None -> let x = col*conf.tilew and y = row*conf.tileh in let w = let w = l.pagew - x in min w conf.tilew in let h = let h = l.pageh - y in min h conf.tileh in wcmd U.tile "%s %d %d %d %d" (Opaque.to_string p) x y w h; S.currently := Tiling ( l, p, conf.colorspace, conf.angle, !S.gen, col, row, conf.tilew, conf.tileh ); in itertiles l f; else loop rest | [] -> () in if U.nogeomcmds !S.geomcmds then loop layout let preloadlayout x y sw sh = let y = if y < sh then 0 else y - sh in let x = min 0 (x + sw) in let h = sh*3 in