module "/pliant/language/compiler.pli" module "/pliant/language/stream.pli" module "/pliant/util/pml/io.pli" module "/pliant/graphic/color/gamut.pli" module "/pliant/graphic/color/rgb888.pli" module "/pliant/graphic/image/prototype.pli" module "/pliant/graphic/layout/prototype.pli" module "/pliant/graphic/layout/text1.pli" module "/pliant/graphic/console/prototype.pli"
public
type BrowserRedraw field Int x0 y0 x1 y1
type BrowserSpace field Int x0 y0 x1 y1 ; field LayoutColor color
type BrowserWindowHistory field Str name field Int scroll_x scroll_y
type BrowserHistory field Str url ; field Dictionary context field List:BrowserWindowHistory windows
type BrowserWindow field Str name field Address session_address field Link:LayoutPrototype root overlay field LayoutArea bbox field Int scroll_x scroll_y <- 0 field Int x0 y0 x1 y1 <- undefined # visible area in the window or on the screen field CBool refresh field CBool orefresh field List:BrowserRedraw redraw # styling field Int antialiasing <- 4 field Float fraction <- 0.25 field Int padding_size <- 5 field LayoutColor padding_color <- (color rgb 255 255 255) type BrowserFocusHistory field Pointer:BrowserWindow window field Link:LayoutPrototype target field Int index
type BrowserEvent field Str id event key ; field Int buttons ; field Float x y ; field Str options ; field Pointer:BrowserWindow window
type BrowserSession field Dictionary namespace # windows field Address console_address field List:BrowserWindow windows field Int position <- 4 # control field Str url ; field Dictionary context field Link:Stream connection field (List Link:Stream) extra_connections field List:BrowserHistory history # focus field Pointer:BrowserWindow focus_window field Link:LayoutPrototype focus_target field Int focus_index field Str focus_value field Int focus_scroll_stage field Int focus_scroll_x focus_scroll_y field List:BrowserFocusHistory focus_history field Pointer:BrowserWindow over_window field Link:LayoutPrototype over_target # shortcuts field (Dictionary Str Link:LayoutPrototype) keys # styling field Int border_size <- 1
|
field LayoutColor border_color <- (color rgb 192 192 192) ; field LayoutColor border_active_color <- (color rgb 128 128 128)
|
field LayoutColor border_color <- (color rgb 192 192 192) field LayoutColor border_active_color <- (color rgb 128 128 128)
|
type BrowserLogin field Str user password ; field CBool secured <- false
type BrowserConsole field Link:ConsolePrototype console field (Array BrowserSession 12) session field Array:Int zorder field Int size_x size_y # screen or OS window size field Float unit_x unit_y # pixel size is mm field Float middle_x middle_y <- 0.5 field Link:ColorGamut gamut field CBool brefresh <- true field List:BrowserSpace spaces field Sem sem field Int hurry_count <- 0 field CBool cancelable <- false field DateTime last_full_cycle field Float force_after <- 15 # seconds field Link:LayoutStyle default_style field Dictionary fonts field Str font_server field Link:Stream font_stream field (Dictionary Str BrowserLogin) login field Str clipboard_text field Link:LayoutPrototype clipboard_target field Int clipboard_index <- undefined
|
field CBool lazy_display_mark <- false
|
method w session -> s arg BrowserWindow w ; arg_C BrowserSession s s :> w:session_address map BrowserSession
method s console -> c arg BrowserSession s ; arg_C BrowserConsole c c :> s:console_address map BrowserConsole
function build c arg_w BrowserConsole c for (var Int i) 0 11 var Pointer:BrowserSession s :> c:session i s console_address := addressof c var BrowserWindow w ; w session_address := addressof s w name := "main" ; w padding_color := color rgb 248 248 248 ; s windows += w w name := "top" ; w padding_color := color rgb 240 240 240 ; s windows += w w name := "bottom" ; w padding_color := color rgb 240 240 240 ; s windows += w w name := "left" ; w padding_color := color rgb 240 240 240 ; s windows += w w name := "right" ; w padding_color := color rgb 224 224 224 ; s windows += w c zorder += i
method s window name -> w arg BrowserSession s ; arg Str name ; arg_C BrowserWindow w each ww s:windows if ww:name=name w :> ww return w :> null map BrowserWindow
method pc window -> w arg LayoutPC pc ; arg_C Pointer:BrowserWindow w w :>> (addressof pc:window_address) map Pointer:BrowserWindow
method c canceled -> canceled arg BrowserConsole c ; arg CBool canceled canceled := c:hurry_count>0 and c:cancelable
method pc canceled -> c arg LayoutPC pc ; arg CBool c c := pc:window:session:console canceled
method dc window -> w arg LayoutDC dc ; arg_C Pointer:BrowserWindow w w :>> (addressof dc:window_address) map Pointer:BrowserWindow
method dc canceled -> c arg LayoutDC dc ; arg CBool c c := dc:window:session:console canceled
method ec window -> w arg LayoutEC ec ; arg_C Pointer:BrowserWindow w w :>> (addressof ec:window_address) map Pointer:BrowserWindow
method c request_sem arg_rw BrowserConsole c var CBool cancel := true # c:last_full_cycle=defined and datetime:seconds-c:last_full_cycle:seconds<c:force_after if cancel atomic_add c:hurry_count 1 c:sem request if cancel atomic_add c:hurry_count -1
method w redraw_hurry arg_rw BrowserWindow w w:session:console last_full_cycle := undefined
export '. window' '. canceled' '. request_sem' '. redraw_hurry'
#-------------------------------------------------------------------------------
public
type BrowserClientContext field Link:Stream connection field Pointer:BrowserSession session field CBool eos field CBool extra_thread <- false # field Pointer:LayoutPrototype parent field (Pointer Link:LayoutPrototype) chain field Pointer:LayoutPrototype current
function build c arg_w BrowserClientContext c c chain :>> null map Link:LayoutPrototype c parent :> null map LayoutPrototype c current :> null map LayoutPrototype
#-------------------------------------------------------------------------------
gvar Dictionary browser_client_instructions
named_expression browser_client_instruction_prototype function 'pliant browser client instruction function' context arg_rw BrowserClientContext context implicit context body
meta browser_client_instruction e if e:size>=2 and e:0:is_pure_ident and (e e:size-1):ident="{}" var Address mark := e:module mark var Link:Expression ee :> expression duplicate browser_client_instruction_prototype substitute parameters (e 1 e:size-2) substitute body (e e:size-1) substitute instruction (expression constant e:0:ident near e:0) near e error_push_record (var ErrorRecord er) error_filter_all ee compile if er:id<>error_id_noerror console er:message eol er id := error_id_noerror e suckup_error ee error_pull_record er var Link:Function f :> (pliant_general_dictionary first "pliant browser client instruction function") map Function e:module rewind mark if exists:f browser_client_instructions insert e:0:ident true addressof:f e set_void_result
export browser_client_instruction browser_client_instructions
#-------------------------------------------------------------------------------
constant trace true constant trace2 false
function browser_client_instruction_prototype context fun arg_rw BrowserClientContext context ; arg Function fun indirect
method c lazy_display fun arg_rw BrowserConsole c ; arg Function fun indirect
gvar Link:Function real_lazy_display_function
method c process_instruction lock arg_rw BrowserClientContext c ; arg CBool lock if not (c:connection ipick open (var Ident instruction)) if trace and not c:extra_thread console "broken connection" eol c:connection error "corrupted connection" return var Pointer:Arrow pfun :> browser_client_instructions first (cast instruction Str) if pfun=null if trace console "unsupported instruction '" (cast instruction Str) "'" eol c:connection error "unsupported instruction '"+(cast instruction Str)+"'" return if trace2 console "process instruction " (cast instruction Str) eol if lock c:session:console request_sem # console "begin " (cast instruction Str) eol browser_client_instruction_prototype c (pfun map Function) # console "end " (cast instruction Str) eol if lock
|
var Pointer:BrowserConsole bc :> c:session console thread bc lazy_display real_lazy_display_function bc:sem release
|
if c:eos c:session:console:sem release else var Pointer:BrowserConsole bc :> c:session console thread bc lazy_display real_lazy_display_function bc:sem release
|
if trace and c:connection=failure console "corrupted instruction '" (cast instruction Str) "'" eol
method c ierror msg arg_rw BrowserClientContext c ; arg Str msg if c:connection=success if trace console msg eol c:connection error msg
method s history_push arg_rw BrowserSession s var BrowserHistory h h url := s url h context := s context each w s:windows var BrowserWindowHistory wh wh name := w name wh scroll_x := w scroll_x wh scroll_y := w scroll_y h windows += wh s history += h
method s history_pull arg_rw BrowserSession s var Pointer:BrowserHistory h :> s:history last if not exists:h return s url := h url s context := h context each wh h:windows var Pointer:BrowserWindow w :> s window wh:name w scroll_x := wh scroll_x w scroll_y := wh scroll_y s:history remove h
export '. process_instruction' export '. ierror' export '. history_push' '. history_pull'
export real_lazy_display_function
|