Commit 755dccc9 authored by Diederik van Arkel's avatar Diederik van Arkel

Clean 2.0 changes remaining projects

parent e736ddd7
......@@ -61,5 +61,11 @@ getCurrentLink :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentVers :: !*(PSt *General) -> (!Int,!*PSt *General)
getCurrentMeth :: !*(PSt *General) -> (!CompileMethod,!*PSt *General)
//-- boolean that indicates if user interaction is allowed
getInteract :: !*(PSt *General) -> (!Bool,!*PSt *General)
//-- log functions for batch build
writeLog :: !String !*(PSt *General) -> !*PSt *General
abortLog :: !Bool !String !*(PSt *General) -> !*PSt *General
......@@ -170,6 +170,9 @@ getCurrentMeth ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_meth,ps)
getInteract :: !*(PSt *General) -> (!Bool,!*PSt *General)
getInteract ps = (False,ps)
writeLog :: !String !*(PSt *General) -> !*PSt *General
writeLog message ps
= appPLoc (\ls=:{logfile} -> {ls & logfile = writeLogfile message logfile}) ps
......
......@@ -5,7 +5,7 @@ import StdWindowDef
import StdPSt
//import IdeState
updateTypeWindow :: !String [Int] ![String] !*(PSt *b) -> *PSt *b | Typer b
updateTypeWindow :: !Bool !String [Int] ![String] !*(PSt *b) -> *PSt *b | Typer b
tw_safe_close :: !*(PSt *b) -> *PSt *b | Typer b
......
......@@ -5,8 +5,8 @@ import StdWindowDef
import StdPSt
//import IdeState
updateTypeWindow :: !String [Int] ![String] !*(PSt *b) -> *PSt *b | Typer b
updateTypeWindow _ _ _ ps = ps
updateTypeWindow :: !Bool !String [Int] ![String] !*(PSt *b) -> *PSt *b | Typer b
updateTypeWindow _ _ _ _ ps = ps
tw_safe_close :: !*(PSt *b) -> *PSt *b | Typer b
tw_safe_close ps = ps
......
......@@ -11,19 +11,19 @@ import StdId, StdPSt, StdWindow, StdTimer
instance Dialogs Notice
where
openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
// openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openDialog ls (noticeToDialog wId okId notice) ps
openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
// openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openModalDialog ls (noticeToDialog wId okId notice) ps
getDialogType :: (Notice .ls .ps) -> WindowType
// getDialogType :: (Notice .ls .ps) -> WindowType
getDialogType _
= "Notice"
......@@ -65,19 +65,19 @@ okNotice text ps :== openNotice (Notice text (NoticeButton "OK" (\x->x)) []) ps
instance Dialogs TimedNotice
where
openDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
// openDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openDialog ls (timednoticeToDialog wId okId notice) ps
openModalDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
// openModalDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openModalDialog ls (timednoticeToDialog wId okId notice) ps
getDialogType :: (TimedNotice .ls .ps) -> WindowType
// getDialogType :: (TimedNotice .ls .ps) -> WindowType
getDialogType _
= "TimerNotice"
......
......@@ -9,7 +9,7 @@ import StdPicture, StdPrint
, application_name :: String
}
empty_progstate :: .PrintSetup -> *ProgState [.a];
empty_progstate :: PrintSetup -> *ProgState [.a];
:: SizeByNodeKindElem
......@@ -21,7 +21,7 @@ compare_function_name :: !.SizeByNodeKindElem !.SizeByNodeKindElem -> Bool;
compare_module_name :: !.SizeByNodeKindElem !.SizeByNodeKindElem -> Bool;
compare_heap_use :: !.SizeByNodeKindElem !.SizeByNodeKindElem -> Bool;
printTable :: .Font .(ProgState [SizeByNodeKindElem]) *a -> *(.ProgState [SizeByNodeKindElem],*a) | PrintEnvironments a;
printTable :: Font .(ProgState [SizeByNodeKindElem]) *a -> *(.ProgState [SizeByNodeKindElem],*a) | PrintEnvironments a;
show_next_page :: u:(ProgState [.SizeByNodeKindElem]) *a -> *(v:ProgState [SizeByNodeKindElem],*a) | FileEnv a, [u <= v];
show_prev_page :: u:(ProgState [.SizeByNodeKindElem]) *a -> *(v:ProgState [SizeByNodeKindElem],*a) | FileEnv a, [u <= v];
......
......@@ -65,7 +65,7 @@ empty_header = {
FileExists _ =
code {
ccall FileExists "S-I"
}
};
import expand_8_3_names_in_path,ArgEnv;//,handler;
/*
......@@ -781,10 +781,10 @@ compute_sizes_by_node_kind :: !.Header .Descriptors !*{#.Char} !{#.Char} {#.Char
compute_sizes_by_node_kind header descriptors heap heap2 data text stack
#! size_heap=size heap;
= let
bits1::.{#Int};
bits1:: .{#Int};
bits1=createArray ((size_heap+63)>>6) 0;
bits2::.{#Int};
bits2:: .{#Int};
bits2=createArray ((size heap2+63)>>6) 0;
in
size_stack descriptors 0 NilSizeByNodeKind bits1 bits2 heap;
......@@ -926,7 +926,7 @@ compute_sizes_by_node_kind header descriptors heap heap2 data text stack
// dus arrays met bijv. record als elementen worden niet ondersteund?
= abort "compute_size_graph_by_node_kind: array";
// waarom kom ik hier?
= abort "compute_size_graph_by_node_kind: arity 0";
= abort "compute_size_graph_by_node_kind: arity 0";
// arity <> 0
# a_size=data WORD (data_offset+2);
| arity>=256 && a_size==0
......@@ -1189,15 +1189,14 @@ where
draw_profile_line background_box name heap_size y_pos picture
//*
# picture = case background_box of {
True
-> picture >: setPenColour MyGrey
>: FillRectangle ((positions!!0,y_pos-line_height + delta_text),(positions!!5,y_pos + delta_text))
>: DrawLine ((0,y_pos + delta_text), (positions!!4, y_pos + delta_text))
>: setPenColour Black;
False
-> unfill {corner1={x=positions!!0,y=y_pos-line_height + delta_text},corner2={x=positions!!5,y=y_pos + delta_text}} picture;
};
# picture = case background_box of
True
-> picture >: setPenColour MyGrey
>: FillRectangle ((positions!!0,y_pos-line_height + delta_text),(positions!!5,y_pos + delta_text))
>: DrawLine ((0,y_pos + delta_text), (positions!!4, y_pos + delta_text))
>: setPenColour Black;
False
-> unfill {corner1={x=positions!!0,y=y_pos-line_height + delta_text},corner2={x=positions!!5,y=y_pos + delta_text}} picture;
//*/
= picture >: draw_clipped_string_at (positions!!0+5,y_pos) function_name (positions!!1 - positions!!0-10)
>: draw_clipped_string_at (positions!!1+5,y_pos) module_name (positions!!2 - positions!!1-10)
......@@ -1234,7 +1233,7 @@ where
:: ProgState a = { node_size_list::a, node_size_sum::Int, printingSetup :: PrintSetup, application_name :: String};
empty_progstate :: .PrintSetup -> *ProgState [.a];
empty_progstate :: PrintSetup -> *ProgState [.a];
empty_progstate default_ps
= { ProgState |
node_size_list=[],
......@@ -1529,7 +1528,7 @@ open_file_function file_name s io
= p_open_file_function2 file_name s io;
*/
printTable :: .Font .(ProgState [SizeByNodeKindElem]) *a -> *(.ProgState [SizeByNodeKindElem],*a) | PrintEnvironments a;
printTable :: Font .(ProgState [SizeByNodeKindElem]) *a -> *(.ProgState [SizeByNodeKindElem],*a) | PrintEnvironments a;
printTable printFont s=:{node_size_list,node_size_sum,printingSetup,application_name} env
# (usedPrintSetup,env) = print True True generate_pages printingSetup env;
= ({s & printingSetup=usedPrintSetup},env);
......
......@@ -21,7 +21,7 @@ noPS :: .(.a -> .b) !(.a,.c) -> (.b,.c)
drawLeft :: !.Point2 a !*Picture -> *Picture | toString a
drawCenter :: !.Point2 a !*Picture -> *Picture | toString a
drawRight :: !.Point2 a !*Picture -> *Picture | toString a
setCheckControlItem :: !.Id .Index !.Bool !*(IOSt .a) -> *IOSt .a;
setCheckControlItem :: !Id .Index !.Bool !*(IOSt .a) -> *IOSt .a;
zip3::![.a] [.b] [.c] -> [(.a,.b,.c)]
//unzip3 ::![(.a,.b,.c)] -> ([.a],[.b],[.c]) // now in ObjectIO/commondef
getPenAttributeFont :: ![.PenAttribute] -> FontDef;
......
......@@ -95,7 +95,7 @@ drawRight {x,y} info picture
(width,picture) = getPenFontStringWidth text picture
= drawAt {x=x-width,y=y} text picture
setCheckControlItem :: !.Id .Index !.Bool !*(IOSt .a) -> *IOSt .a
setCheckControlItem :: !Id .Index !.Bool !*(IOSt .a) -> *IOSt .a
setCheckControlItem id idx True io = markCheckControlItems id [idx] io
setCheckControlItem id idx False io = unmarkCheckControlItems id [idx] io
......
......@@ -11,19 +11,19 @@ import StdId, StdPSt, StdWindow, StdTimer
instance Dialogs Notice
where
openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
// openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openDialog ls (noticeToDialog wId okId notice) ps
openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
// openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openModalDialog ls (noticeToDialog wId okId notice) ps
getDialogType :: (Notice .ls .ps) -> WindowType
// getDialogType :: (Notice .ls .ps) -> WindowType
getDialogType _
= "Notice"
......@@ -65,19 +65,19 @@ okNotice text ps :== openNotice (Notice text (NoticeButton "OK" (\x->x)) []) ps
instance Dialogs TimedNotice
where
openDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
// openDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openDialog ls (timednoticeToDialog wId okId notice) ps
openModalDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
// openModalDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openModalDialog ls (timednoticeToDialog wId okId notice) ps
getDialogType :: (TimedNotice .ls .ps) -> WindowType
// getDialogType :: (TimedNotice .ls .ps) -> WindowType
getDialogType _
= "TimerNotice"
......
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