open Utils let irect_of_string s = Scanf.sscanf s "%d/%d/%d/%d" (fun x0 y0 x1 y1 -> (x0,y0,x1,y1)) let irect_to_string (x0,y0,x1,y1) = Printf.sprintf "%d/%d/%d/%d" x0 y0 x1 y1 let multicolumns_to_string (n, a, b) = if a = 0 && b = 0 then Printf.sprintf "%d" n else Printf.sprintf "%d,%d,%d" n a b let multicolumns_of_string s = try (int_of_string s, 0, 0) with _ -> Scanf.sscanf s "%u,%u,%u" (fun n a b -> if a > 1 || b > 1 then error "subtly broken"; (n, a, b) ) include Confstruct type angle = intand opaque = Opaque.tand rectcolor = rgbaand pixmapsize = intand gen = intand top = floatand dtop = floatand fontpath = stringand trimmargins = booland trimparams = (trimmargins * irect)and uri = stringand caption = stringand tilex = intand tiley = intand tileparams = (x * y * w * h * tilex * tiley)and under = | Unone | Ulinkuri of string | Utext of facename | Utextannot of (opaque * slinkindex) | Ufileannot of (opaque * slinkindex)and slinkindex = intand facename = stringand launchcommand = stringand filename = stringand linkno = intand destname = stringand link = | Lnotfound | Lfound of intand linkdir = | LDfirst | LDlast | LDfirstvisible of (int * int * int) | LDleft of int | LDright of int | LDdown of int | LDup of intand pagewithlinks = | Pwlnotfound | Pwl of intand anchor = pageno * top * dtopand rect = float * float * float * float * float * float * float * floatand infochange = | Memused | Docinfo | Pdimand redirstderr = booland fontstate = { mutable fontsize : int ; mutable wwidth : float ; mutable maxrows : int } let fstate = { fontsize = Wsi.fontsizescale 20 ; wwidth = nan ; maxrows = -1 } class type uioh = object method display : unit method key : int -> int -> uioh method button : int -> bool -> int -> int -> int -> uioh method multiclick : int -> int -> int -> int -> uioh method motion : int -> int -> uioh method pmotion : int -> int -> uioh method infochanged : infochange -> unit method scrollpw : (int * float * float) method scrollph : (int * float * float) method modehash : keyhash method eformsgs : bool method alwaysscrolly : bool method scroll : int -> int -> uioh method zoom : float -> int -> int -> unit end module type TextEnumType = sig type t val name : string val names : string arrayend module TextEnumMake (Ten : TextEnumType) = struct let names = Ten.names let to_int (t : Ten.t) = Obj.magic t let to_string t = names.(to_int t) let of_int n : Ten.t = Obj.magic n let of_string s = let rec find i = if i = Array.length names then error "invalid %s: %s" Ten.name s else ( if Ten.names.(i) = s then of_int i else find (i+1) ) in find 0end module CSTE = TextEnumMake (struct type t = colorspace let name = "colorspace" let names = [|"rgb"; "gray"|] end) module MTE = TextEnumMake (struct type t = mark let name = "mark" let names = [|"page"; "block"; "line"; "word"|] end) module FMTE = TextEnumMake (struct type t = fitmodel let name = "fitmodel" let names = [|"width"; "proportional"; "page"|] end) type outlinekind = | Onone | Oanchor of anchor | Ouri of uri | Olaunch of launchcommand | Oremote of (filename * pageno) | Oremotedest of (filename * destname) | Ohistory of (filename * conf * outline list * x * anchor * filename)and outline = (caption * outlinelevel * outlinekind)and outlinelevel = int type page = { pageno : int ; pagedimno : int ; pagew : int ; pageh : int ; pagex : int ; pagey : int ; pagevw : int ; pagevh : int ; pagedispx : int ; pagedispy : int ; pagecol : int } type tile = opaque * pixmapsize * elapsedand elapsed = floatand pagemapkey = pageno * genand tilemapkey = pageno * gen * colorspace * angle * w * h * col * rowand row = intand col = intand currently = | Idle | Loading of (page * gen) | Tiling of (page * opaque * colorspace * angle * gen * col * row * w * h) | Outlining of outline listand mpos = int * intand mstate = | Mnone | Msel of (mpos * mpos) | Mpan of mpos | Mscrolly | Mscrollx | Mzoom of (buttonno * step * mpos) | Mzoomrect of (mpos * mpos)and buttonno = intand step = intand mode = | View | Birdseye of (conf * leftx * pageno * pageno * anchor) | Textentry of (textentry * onleave) | LinkNav of linktargetand onleave = leavetextentrystatus -> unitand leavetextentrystatus = | Cancel | Confirmand helpitem = string * int * actionand action = (uioh -> uioh) optionand linktarget = | Ltexact of (pageno * direction) | Ltgendir of direction | Ltnotready of (pageno * direction)and direction = int (* -1, 0, 1 *)and textentry = string * string * onhist option * onkey * ondone * cancelonemptyand onkey = string -> Keys.t -> teand ondone = string -> unitand histcancel = unit -> unitand onhist = ((histcmd -> string) * histcancel)and histcmd = HCnext | HCprev | HCfirst | HClastand cancelonempty = booland te = | TEstop | TEdone of string | TEcont of string | TEswitch of textentryand 'a circbuf = { store : 'a array ; mutable rc : int ; mutable wc : int ; mutable len : int }and 'a nav = { past : 'a list ; future : 'a list } let emptykeyhash = Hashtbl.create 0let noreprf () = ()let noroamf () = () let nouioh : uioh = object (self) method display = () method key _ _ = self method multiclick _ _ _ _ = self method button _ _ _ _ _ = self method motion _ _ = self method pmotion _ _ = self method infochanged _ = () method scrollpw = (0, nan, nan) method scrollph = (0, nan, nan) method modehash = emptykeyhash method eformsgs = false method alwaysscrolly = false method scroll _ _ = self method zoom _ _ _ = () end let cbnew n v = { store = Array.make n v ; rc = 0 ; wc = 0 ; len = 0 } let cbcap b = Array.length b.store let cbput ?(update_rc=true) b v = let cap = cbcap b in b.store.(b.wc) <- v; b.wc <- (b.wc + 1) mod cap; if update_rc then b.rc <- b.wc; b.len <- min (b.len + 1) cap let cbput_dont_update_rc b v = cbput ~update_rc:false b v let cbempty b = b.len = 0 let cbgetg b circular dir = if cbempty b then b.store.(0) else let rc = b.rc + dir in let rc = if circular then ( if rc = -1 then b.len-1 else ( if rc >= b.len then 0 else rc ) ) else bound rc 0 (b.len-1) in b.rc <- rc; b.store.(rc) let cbget b = cbgetg b falselet cbgetc b = cbgetg b true type hists = { pat : string circbuf ; pag : string circbuf ; sel : string circbuf } let home = try Sys.getenv "HOME" with exn -> dolog "cannot determine home directory location: %s" @@ exntos exn; E.s module S = struct let confpath = ref E.s let ss = ref Unix.stdin let wsfd = ref Unix.stdin let stderr = ref Unix.stdin let selfexec = ref E.s let ignoredoctitlte = ref false let errmsgs = Buffer.create 0 let newerrmsgs = ref false let w = ref max_int let x = ref max_int let y = ref max_int let xf = ref 0.0 let yf = ref 0.0 let anchor = ref E.j let ranchors : (string * string * string * anchor * string) list ref = ref [] let maxy = ref max_int let layout : page list ref = ref [] let pagemap : (pagemapkey, opaque) Hashtbl.t = Hashtbl.create 0 let tilemap : (tilemapkey, tile) Hashtbl.t = Hashtbl.create 0 let pdims : (pageno * w * h * leftx) list ref = ref [] let pagecount = ref max_int let currently = ref Idle let mstate = ref Mnone let searchpattern = ref E.s let rects : (pageno * rectcolor * rect) list ref = ref [] let rects1 : (pageno * rectcolor * rect) list ref = ref [] let text = ref E.s let path = ref E.s let password = ref E.s let mimetype = ref E.s let nameddest = ref E.s let origin = ref E.s let winstate : Wsi.winstate list ref = ref [] let mode : mode ref = ref View let uioh : uioh ref = ref nouioh let outlines : outline array ref = ref [||] let bookmarks : outline list ref = ref [] let geomcmds : (string * ((string * (unit -> unit)) list)) ref = ref (E.s, []) let memused : memsize ref = ref 0 let gen : gen ref = ref 0 let autoscroll : int option ref = ref None let help : helpitem array ref = ref E.a let docinfo : (int * string) list ref = ref [] let hists : hists ref = ref { pat = cbnew 10 E.s; pag = cbnew 10 E.s; sel = cbnew 10 E.s; } let prevzoom = ref (1.0, 0) let progress = ref ~-.1.0 let mpos = ref (-1, -1) let keystate = ref KSnone let glinks = ref false let prevcolumns : (columns * zoom) option ref = ref None let winw = ref ~-1 let winh = ref ~-1 let reprf = ref noreprf let roamf = ref noroamf let bzoom = ref false let lnava : (pageno * linkno) option ref = ref None let reload : (x * y * float) option ref = ref None let nav : anchor nav ref = ref { past = []; future = []; } let tilelru : (tilemapkey * opaque * pixmapsize) Queue.t = Queue.create () let fontpath = ref E.s let redirstderr = ref falseend let conf = { defconf with keyhashes = copykeyhashes defconf } let calcips h = let d = !S.winh - h in max conf.interpagespace ((d + 1) / 2) let rowyh (c, coverA, coverB) b n = if c = 1 || (n < coverA || n >= !S.pagecount - coverB) then let _, _, vy, (_, _, h, _) = b.(n) in (vy, h) else let n' = n - coverA in let d = n' mod c in let s = n - d in let e = min !S.pagecount (s + c) in let rec findminmax m miny maxh = if m = e then miny, maxh else let _, _, y, (_, _, h, _) = b.(m) in let miny = min miny y in let maxh = max maxh h in findminmax (m+1) miny maxh in findminmax s max_int 0 let page_of_y y = let ((c, coverA, coverB) as cl), b = match conf.columns with | Csplit (_, b) | Csingle b -> (1, 0, 0), b | Cmulti (c, b) -> c, b in if Array.length b = 0 then -1 else let rec bsearch nmin nmax = if nmin > nmax then bound nmin 0 (!S.pagecount-1) else let n = (nmax + nmin) / 2 in let vy, h = rowyh cl b n in let y0, y1 = if conf.presentation then let ips = calcips h in let y0 = vy - ips in let y1 = vy + h + ips in y0, y1 else ( if n = 0 then 0, vy + h + conf.interpagespace else let y0 = vy - conf.interpagespace in y0, y0 + h + conf.interpagespace ) in if y >= y0 && y < y1 then ( if c = 1 then n else ( if n > coverA then if n < !S.pagecount - coverB then ((n-coverA)/c)*c + coverA else n else n ) ) else ( if y > y0 then bsearch (n+1) nmax else bsearch nmin (n-1) ) in bsearch 0 (!S.pagecount-1) let calcheight () = match conf.columns with | Cmulti ((_, _, _) as cl, b) -> if Array.length b > 0 then let y, h = rowyh cl b (Array.length b - 1) in y + h + (if conf.presentation then calcips h else 0) else 0 | Csingle b -> if Array.length b > 0 then let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in y + h + (if conf.presentation then calcips h else 0) else 0 | Csplit (_, b) -> if Array.length b > 0 then let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in y + h else 0 let getpageywh pageno = let pageno = bound pageno 0 (!S.pagecount-1) in match conf.columns with | Csingle b -> if Array.length b = 0 then 0, 0, 0 else let (_, _, y, (_, w, h, _)) = b.(pageno) in let y = if conf.presentation then y - calcips h else y in y, w, h | Cmulti (cl, b) -> if Array.length b = 0 then 0, 0, 0 else let y, h = rowyh cl b pageno in let (_, _, _, (_, w, _, _)) = b.(pageno) in let y = if conf.presentation then y - calcips h else y in y, w, h | Csplit (c, b) -> if Array.length b = 0 then 0, 0, 0 else let n = pageno*c in let (_, _, y, (_, w, h, _)) = b.(n) inLines 1–500 of 1493. Load more
open Utils let irect_of_string s = Scanf.sscanf s "%d/%d/%d/%d" (fun x0 y0 x1 y1 -> (x0,y0,x1,y1)) let irect_to_string (x0,y0,x1,y1) = Printf.sprintf "%d/%d/%d/%d" x0 y0 x1 y1 let multicolumns_to_string (n, a, b) = if a = 0 && b = 0 then Printf.sprintf "%d" n else Printf.sprintf "%d,%d,%d" n a b let multicolumns_of_string s = try (int_of_string s, 0, 0) with _ -> Scanf.sscanf s "%u,%u,%u" (fun n a b -> if a > 1 || b > 1 then error "subtly broken"; (n, a, b) ) include Confstruct type angle = int and opaque = Opaque.t and rectcolor = rgba and pixmapsize = int and gen = int and top = float and dtop = float and fontpath = string and trimmargins = bool and trimparams = (trimmargins * irect) and uri = string and caption = string and tilex = int and tiley = int and tileparams = (x * y * w * h * tilex * tiley) and under = | Unone | Ulinkuri of string | Utext of facename | Utextannot of (opaque * slinkindex) | Ufileannot of (opaque * slinkindex) and slinkindex = int and facename = string and launchcommand = string and filename = string and linkno = int and destname = string and link = | Lnotfound | Lfound of int and linkdir = | LDfirst | LDlast | LDfirstvisible of (int * int * int) | LDleft of int | LDright of int | LDdown of int | LDup of int and pagewithlinks = | Pwlnotfound | Pwl of int and anchor = pageno * top * dtop and rect = float * float * float * float * float * float * float * float and infochange = | Memused | Docinfo | Pdim and redirstderr = bool and fontstate = { mutable fontsize : int ; mutable wwidth : float ; mutable maxrows : int } let fstate = { fontsize = Wsi.fontsizescale 20 ; wwidth = nan ; maxrows = -1 } class type uioh = object method display : unit method key : int -> int -> uioh method button : int -> bool -> int -> int -> int -> uioh method multiclick : int -> int -> int -> int -> uioh method motion : int -> int -> uioh method pmotion : int -> int -> uioh method infochanged : infochange -> unit method scrollpw : (int * float * float) method scrollph : (int * float * float) method modehash : keyhash method eformsgs : bool method alwaysscrolly : bool method scroll : int -> int -> uioh method zoom : float -> int -> int -> unit end module type TextEnumType = sig type t val name : string val names : string array end module TextEnumMake (Ten : TextEnumType) = struct let names = Ten.names let to_int (t : Ten.t) = Obj.magic t let to_string t = names.(to_int t) let of_int n : Ten.t = Obj.magic n let of_string s = let rec find i = if i = Array.length names then error "invalid %s: %s" Ten.name s else ( if Ten.names.(i) = s then of_int i else find (i+1) ) in find 0 end module CSTE = TextEnumMake (struct type t = colorspace let name = "colorspace" let names = [|"rgb"; "gray"|] end) module MTE = TextEnumMake (struct type t = mark let name = "mark" let names = [|"page"; "block"; "line"; "word"|] end) module FMTE = TextEnumMake (struct type t = fitmodel let name = "fitmodel" let names = [|"width"; "proportional"; "page"|] end) type outlinekind = | Onone | Oanchor of anchor | Ouri of uri | Olaunch of launchcommand | Oremote of (filename * pageno) | Oremotedest of (filename * destname) | Ohistory of (filename * conf * outline list * x * anchor * filename) and outline = (caption * outlinelevel * outlinekind) and outlinelevel = int type page = { pageno : int ; pagedimno : int ; pagew : int ; pageh : int ; pagex : int ; pagey : int ; pagevw : int ; pagevh : int ; pagedispx : int ; pagedispy : int ; pagecol : int } type tile = opaque * pixmapsize * elapsed and elapsed = float and pagemapkey = pageno * gen and tilemapkey = pageno * gen * colorspace * angle * w * h * col * row and row = int and col = int and currently = | Idle | Loading of (page * gen) | Tiling of (page * opaque * colorspace * angle * gen * col * row * w * h) | Outlining of outline list and mpos = int * int and mstate = | Mnone | Msel of (mpos * mpos) | Mpan of mpos | Mscrolly | Mscrollx | Mzoom of (buttonno * step * mpos) | Mzoomrect of (mpos * mpos) and buttonno = int and step = int and mode = | View | Birdseye of (conf * leftx * pageno * pageno * anchor) | Textentry of (textentry * onleave) | LinkNav of linktarget and onleave = leavetextentrystatus -> unit and leavetextentrystatus = | Cancel | Confirm and helpitem = string * int * action and action = (uioh -> uioh) option and linktarget = | Ltexact of (pageno * direction) | Ltgendir of direction | Ltnotready of (pageno * direction) and direction = int (* -1, 0, 1 *) and textentry = string * string * onhist option * onkey * ondone * cancelonempty and onkey = string -> Keys.t -> te and ondone = string -> unit and histcancel = unit -> unit and onhist = ((histcmd -> string) * histcancel) and histcmd = HCnext | HCprev | HCfirst | HClast and cancelonempty = bool and te = | TEstop | TEdone of string | TEcont of string | TEswitch of textentry and 'a circbuf = { store : 'a array ; mutable rc : int ; mutable wc : int ; mutable len : int } and 'a nav = { past : 'a list ; future : 'a list } let emptykeyhash = Hashtbl.create 0 let noreprf () = () let noroamf () = () let nouioh : uioh = object (self) method display = () method key _ _ = self method multiclick _ _ _ _ = self method button _ _ _ _ _ = self method motion _ _ = self method pmotion _ _ = self method infochanged _ = () method scrollpw = (0, nan, nan) method scrollph = (0, nan, nan) method modehash = emptykeyhash method eformsgs = false method alwaysscrolly = false method scroll _ _ = self method zoom _ _ _ = () end let cbnew n v = { store = Array.make n v ; rc = 0 ; wc = 0 ; len = 0 } let cbcap b = Array.length b.store let cbput ?(update_rc=true) b v = let cap = cbcap b in b.store.(b.wc) <- v; b.wc <- (b.wc + 1) mod cap; if update_rc then b.rc <- b.wc; b.len <- min (b.len + 1) cap let cbput_dont_update_rc b v = cbput ~update_rc:false b v let cbempty b = b.len = 0 let cbgetg b circular dir = if cbempty b then b.store.(0) else let rc = b.rc + dir in let rc = if circular then ( if rc = -1 then b.len-1 else ( if rc >= b.len then 0 else rc ) ) else bound rc 0 (b.len-1) in b.rc <- rc; b.store.(rc) let cbget b = cbgetg b false let cbgetc b = cbgetg b true type hists = { pat : string circbuf ; pag : string circbuf ; sel : string circbuf } let home = try Sys.getenv "HOME" with exn -> dolog "cannot determine home directory location: %s" @@ exntos exn; E.s module S = struct let confpath = ref E.s let ss = ref Unix.stdin let wsfd = ref Unix.stdin let stderr = ref Unix.stdin let selfexec = ref E.s let ignoredoctitlte = ref false let errmsgs = Buffer.create 0 let newerrmsgs = ref false let w = ref max_int let x = ref max_int let y = ref max_int let xf = ref 0.0 let yf = ref 0.0 let anchor = ref E.j let ranchors : (string * string * string * anchor * string) list ref = ref [] let maxy = ref max_int let layout : page list ref = ref [] let pagemap : (pagemapkey, opaque) Hashtbl.t = Hashtbl.create 0 let tilemap : (tilemapkey, tile) Hashtbl.t = Hashtbl.create 0 let pdims : (pageno * w * h * leftx) list ref = ref [] let pagecount = ref max_int let currently = ref Idle let mstate = ref Mnone let searchpattern = ref E.s let rects : (pageno * rectcolor * rect) list ref = ref [] let rects1 : (pageno * rectcolor * rect) list ref = ref [] let text = ref E.s let path = ref E.s let password = ref E.s let mimetype = ref E.s let nameddest = ref E.s let origin = ref E.s let winstate : Wsi.winstate list ref = ref [] let mode : mode ref = ref View let uioh : uioh ref = ref nouioh let outlines : outline array ref = ref [||] let bookmarks : outline list ref = ref [] let geomcmds : (string * ((string * (unit -> unit)) list)) ref = ref (E.s, []) let memused : memsize ref = ref 0 let gen : gen ref = ref 0 let autoscroll : int option ref = ref None let help : helpitem array ref = ref E.a let docinfo : (int * string) list ref = ref [] let hists : hists ref = ref { pat = cbnew 10 E.s; pag = cbnew 10 E.s; sel = cbnew 10 E.s; } let prevzoom = ref (1.0, 0) let progress = ref ~-.1.0 let mpos = ref (-1, -1) let keystate = ref KSnone let glinks = ref false let prevcolumns : (columns * zoom) option ref = ref None let winw = ref ~-1 let winh = ref ~-1 let reprf = ref noreprf let roamf = ref noroamf let bzoom = ref false let lnava : (pageno * linkno) option ref = ref None let reload : (x * y * float) option ref = ref None let nav : anchor nav ref = ref { past = []; future = []; } let tilelru : (tilemapkey * opaque * pixmapsize) Queue.t = Queue.create () let fontpath = ref E.s let redirstderr = ref false end let conf = { defconf with keyhashes = copykeyhashes defconf } let calcips h = let d = !S.winh - h in max conf.interpagespace ((d + 1) / 2) let rowyh (c, coverA, coverB) b n = if c = 1 || (n < coverA || n >= !S.pagecount - coverB) then let _, _, vy, (_, _, h, _) = b.(n) in (vy, h) else let n' = n - coverA in let d = n' mod c in let s = n - d in let e = min !S.pagecount (s + c) in let rec findminmax m miny maxh = if m = e then miny, maxh else let _, _, y, (_, _, h, _) = b.(m) in let miny = min miny y in let maxh = max maxh h in findminmax (m+1) miny maxh in findminmax s max_int 0 let page_of_y y = let ((c, coverA, coverB) as cl), b = match conf.columns with | Csplit (_, b) | Csingle b -> (1, 0, 0), b | Cmulti (c, b) -> c, b in if Array.length b = 0 then -1 else let rec bsearch nmin nmax = if nmin > nmax then bound nmin 0 (!S.pagecount-1) else let n = (nmax + nmin) / 2 in let vy, h = rowyh cl b n in let y0, y1 = if conf.presentation then let ips = calcips h in let y0 = vy - ips in let y1 = vy + h + ips in y0, y1 else ( if n = 0 then 0, vy + h + conf.interpagespace else let y0 = vy - conf.interpagespace in y0, y0 + h + conf.interpagespace ) in if y >= y0 && y < y1 then ( if c = 1 then n else ( if n > coverA then if n < !S.pagecount - coverB then ((n-coverA)/c)*c + coverA else n else n ) ) else ( if y > y0 then bsearch (n+1) nmax else bsearch nmin (n-1) ) in bsearch 0 (!S.pagecount-1) let calcheight () = match conf.columns with | Cmulti ((_, _, _) as cl, b) -> if Array.length b > 0 then let y, h = rowyh cl b (Array.length b - 1) in y + h + (if conf.presentation then calcips h else 0) else 0 | Csingle b -> if Array.length b > 0 then let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in y + h + (if conf.presentation then calcips h else 0) else 0 | Csplit (_, b) -> if Array.length b > 0 then let (_, _, y, (_, _, h, _)) = b.(Array.length b - 1) in y + h else 0 let getpageywh pageno = let pageno = bound pageno 0 (!S.pagecount-1) in match conf.columns with | Csingle b -> if Array.length b = 0 then 0, 0, 0 else let (_, _, y, (_, w, h, _)) = b.(pageno) in let y = if conf.presentation then y - calcips h else y in y, w, h | Cmulti (cl, b) -> if Array.length b = 0 then 0, 0, 0 else let y, h = rowyh cl b pageno in let (_, _, _, (_, w, _, _)) = b.(pageno) in let y = if conf.presentation then y - calcips h else y in y, w, h | Csplit (c, b) -> if Array.length b = 0 then 0, 0, 0 else let n = pageno*c in let (_, _, y, (_, w, h, _)) = b.(n) in