Commit e1f4cd2d authored by Diederik van Arkel's avatar Diederik van Arkel
Browse files

cleanup for Clean2 release

parent af9b4495
implementation module Table
/*
* Table.icl: implements lookup table that can be inverted
*/
// Table.icl: implements lookup table that can be inverted
import StdClass, StdArray, StdFunc
import StdMaybe, StdInt
......
......@@ -2,8 +2,6 @@ implementation module UtilDate
import StdArray, StdBool, StdChar, StdClass, StdInt, StdString
//--- StdDate
NoDate :== {exists=False,yy=0,mm=0,dd=0,h=0,m=0,s=0};
:: DATE = { exists :: !Bool,
......
implementation module colorpickcontrol
// **************************************************************************************************
//
// This program creates a windows that allows a user to create a RGB colour.
//
// The program has been written in Clean 1.3.1 and uses the Clean Standard Object I/O library 1.0.2
//
// **************************************************************************************************
import StdControl, StdControlReceiver, StdReceiver
import ioutil
......
definition module ioutil
import StdOverloaded, StdBool, StdList
import StdPicture, StdPSt, StdId, StdIOCommon, StdFile//, StdFileSelect
import StdPicture, StdPSt, StdId, StdIOCommon, StdFile
from commondef import unzip3,unzip4
......@@ -9,6 +9,7 @@ instance toString FontDef
instance accScreenPicture (PSt .l)
instance FileEnv Files
safeOpenFont :: !FontDef !(PSt .l) -> (Font,PSt .l)
safeOpenFixedFont :: !FontDef !*Picture -> (Font,*Picture);
altScrollFunction :: !Direction !Int -> ScrollFunction
alignScrollFunction :: !Direction !Int -> ScrollFunction
......
implementation module ioutil
import StdBool,StdList,StdFile
import StdControl,StdPSt//,StdFileSelect
import StdControl,StdPSt
import iostate
altScrollFunction :: !Direction !Int -> ScrollFunction
......@@ -39,6 +39,13 @@ where
SliderThumb x -> if (x == m) x (align x)
align x = (x / d) * d
safeOpenFont :: !FontDef !(PSt .l) -> (Font,PSt .l)
safeOpenFont fdef ps
# ((ok,font),ps) = accScreenPicture (openFont fdef) ps
| not ok
= accScreenPicture openDefaultFont ps
= (font,ps)
safeOpenFixedFont :: !FontDef !*Picture -> (Font,*Picture);
safeOpenFixedFont fdef pict
# ((ok,fnt),pict) = openFont fdef pict
......
implementation module logfile
import StdFile, StdPathname, StdBool
import StdFile, StdPathname, StdBool, StdString
openLogfile :: !String !*f -> (!Bool,!*File,!*f) | FileSystem f
openLogfile prj_name env
......
......@@ -10,7 +10,6 @@ RunProgram :: !.String !*(PSt General) -> *PSt General
SetWindowIcon :: !Id !Int !(PSt .l) -> PSt .l
SetProcessIcon :: !Int !(PSt .l) -> PSt .l
GetDialogBackgroundColour :: !(PSt .l) -> (!Colour, !PSt .l)
//GetBitmapResource :: !Int !(PSt .l) -> (!Maybe Bitmap,!PSt .l)
GetBitmapResource :: !Int !.env -> (!Maybe Bitmap,!.env)
winInitialiseTooltips :: !*OSToolbox -> *OSToolbox
......
implementation module IdePlatform
import StdPSt
import StdArray, StdEnum, StdList, StdTuple
import StdFunc
import StdEnv
import StdPSt, StdPStClass
import PmCleanSystem
import errwin, conswin
import UtilIO
import EdKeyboard, EdMouse
//import dodebug
trace_n` m f :== f
from iostate import appIOToolbox,accIOToolbox
from clCCall_12 import winLaunchApp,winMakeCString,:: CSTR,:: OSToolbox
import clCrossCall_12, windowaccess, iostate
import pictCCall_12, cast
import code from "Redirect.obj"
import code from "cCrossCallMaarten.obj"
import code from library "conkernel_library"
import code from library "bmpgdi_library"
PlatformProcessAttributes :: [ProcessAttribute *(PSt General)]
PlatformProcessAttributes =
// []/*
[ ProcessConsoleOpen id
, ProcessConsoleQuit consoleKill
, ProcessConsoleOut consoleMessageO
, ProcessConsoleErr consoleMessageE
]
//*/
//-- Experimental Console Handling/Redirection...
from clCCall_12 import winLaunchApp,:: OSToolbox
import StdBool
import PmCleanSystem
import errwin
import UtilIO, StdPStClass
RunProgram :: !.String !*(PSt General) -> *PSt General
RunProgram path ps
# (ret,ps) = accPIO (accIOToolbox (AddMainWindowHook True)) ps
# ps = trace_n` ("Hook",ret) ps
# (project,ps) = getProject ps
(redc,ps) = getCurrentRedc ps
ao = PR_GetApplicationOptions project
......@@ -52,23 +55,12 @@ where
| didit
= (ps,True)
= (winfun ["Error: Could not launch the application."] ps,False)
// need to investigate here...
// # (didit,_) = winLaunchApp (quoted_string path) (o<>NoConsole) 99
# (didit,_) = trace_n` "Launch" startChildProcess (quoted_string path +++. " -con") False/*True*/ 99
# (didit,_) = startChildProcess (quoted_string path +++. " -con") False/*True*/ 99
| didit
// # ps = consoleMessageE ("<"+++.path+++." launched>\n") ps
= (ps,True)
= (winfun ["Error: Could not launch the console application."] ps,False)
/*
SetWindowIcon :: !Id !Int !(PSt .l) -> PSt .l
SetWindowIcon wId icon pState = pState
*/
//*
import conswin
import EdKeyboard, EdMouse
//--
from iostate import appIOToolbox,accIOToolbox
consWinKeyboard :: .WindowAttribute *(EditState,*PSt *General);
consWinKeyboard = WindowKeyboard (\ks -> getKeyboardStateKeyState ks == KeyDown False) Able consKeyboard
......@@ -80,7 +72,7 @@ consoleMessageI :: !{#Char} !(PSt General) -> PSt General
consoleMessageI msg ps = updateConsoleWindowI msg [consWinKeyboard,consWinMouse] ps
consoleMessageO :: !{#Char} !(PSt General) -> PSt General
consoleMessageO msg ps = trace_n` msg updateConsoleWindowO msg [consWinKeyboard,consWinMouse] ps
consoleMessageO msg ps = updateConsoleWindowO msg [consWinKeyboard,consWinMouse] ps
consoleMessageE :: !{#Char} !(PSt General) -> PSt General
consoleMessageE msg ps = updateConsoleWindowE msg [consWinKeyboard,consWinMouse] ps
......@@ -114,10 +106,6 @@ consKeyboard ks (es,ps)
//-- Console bindings...
import code from library "conkernel_library"
import code from "Redirect.obj"
from clCCall_12 import winMakeCString,:: CSTR,:: OSToolbox
AddMainWindowHook :: !Bool !*OSToolbox -> (!Bool,!*OSToolbox)
AddMainWindowHook _ tb = code {
ccall AddMainWindowHook "I:I:I"
......@@ -162,9 +150,6 @@ writeChildProcess` cstr
//==
import clCrossCall_12, windowaccess, iostate
import code from "cCrossCallMaarten.obj"
winInitialiseTooltips :: !*OSToolbox -> *OSToolbox
winInitialiseTooltips _
= code
......@@ -180,9 +165,6 @@ osIgnoreCallback _ tb
//--
import pictCCall_12, StdMisc, cast
import code from library "bmpgdi_library"
CcRqGETBITMAPRESOURCE :== 1477
osGetBitmapResource :: !Int !*OSToolbox -> (!(!Int,!String,!Int,!Int),!*OSToolbox)
......@@ -195,16 +177,7 @@ winGetBitmapResource :: !Int !*OSToolbox -> (!Int,!Int,!Int,!*OSToolbox)
winGetBitmapResource _ _ = code {
ccall WinGetBitmapResource "II-IIII"
}
/*
# tb = winInitialiseTooltips tb
# (ret,tb) = (issueCleanRequest2 osIgnoreCallback (Rq1Cci CcRqGETBITMAPRESOURCE bitmap_id) tb)
| ret.p1 == 0 = ((0,"",0,0),tb)
# hbitmap = ret.p1
# data = "" //cast ret.p2
# w = ret.p3
# h = ret.p4
= ((hbitmap,data,w,h),tb)
*/
GetBitmapResource :: !Int !.env -> (!Maybe Bitmap,!.env)
GetBitmapResource bitmap_id ps
# ((hbmp,data,w,h),_) = osGetBitmapResource bitmap_id OSNewToolbox
......@@ -255,7 +228,6 @@ SetProcessIcon icon pState=:{io=ioState}
# ioState = ioStSetOSDInfo osdi ioState
= {pState & io = ioState}
//*/
CleanIcon :== 32512
ProjectIcon :== 32513
AbcmodIcon :== 32514
......
......@@ -148,10 +148,6 @@ CompilePollCompleted :: !*env -> (Maybe !(!Int,!Int), !*env) | FileEnv env
CompilePollCompleted :: !*env -> (!CompilePollCompletedResult, !*env) | FileEnv env
// ... RWS
// JVG ...
:: CompilingInfo
InitCompilingInfo :: !*CompilingInfo
......@@ -175,7 +171,6 @@ CompilePersistent ::
!*env // env
-> (!*CompilingInfo,!(!*env, !Pathname, !CompilerMsg))
| FileEnv env
// ... JVG
ClearCompilerCaches :: !Int !.a -> (!Int,!.a)
StartCodeGenerator :: !String !(WindowFun *(PSt .l)) !CodeGenerateAsmOrCode !Pathname !Int !Bool !CodeGenOptions !ApplicationOptions !Pathname !*(PSt .l) -> (!Bool,!Pathname,!*(PSt .l))
......
definition module UtilIO
import StdString, StdFile
import StdPSt, StdMaybe
import UtilDate
LaunchApplication :: !{#Char} !{#Char} !Bool !Files -> ( !Bool, !Files)
......@@ -25,8 +26,6 @@ GetShortPathName :: !String -> (!Bool,!String);
GetCurrentDirectory :: (!Bool,!String)
import StdPSt, StdMaybe
selectDirectory` :: !(PSt .l) -> (!Maybe String,!(PSt .l))
ShellDefault :: !{#Char} !(PSt .l) -> (!Int,!(PSt .l))
......@@ -10,9 +10,8 @@ import StdSystem
import code from library "util_io_kernel_lib"
import code from library "util_io_shell_lib"
//dirseparator :== '\\' // OS separator between folder- and filenames in a pathname
//--
CcRqSHELLDEFAULT :== 1476
osIgnoreCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
......
definition module UtilNewlinesFile
//1.3
from StdString import String
//3.1
from StdClass import class ==, class toString
:: NewlineConvention
......
......@@ -45,10 +45,10 @@ Global
Path: {Project}\Util
Path: {Project}\Interfaces\LinkerInterface
Path: {Project}\Interfaces\ProverOptions
Path: {Application}\ArgEnvWindows
Path: {Application}\Directory
Path: {Application}\WrapDebug
Path: {Project}\Win\PatchConsoleEvents
Path: {Project}\Win\ArgEnvWindows
Path: {Project}\Win\Directory
Path: {Project}\Registry
Precompile:
Postlink:
MainModule
......@@ -66,16 +66,16 @@ MainModule
ReuseUniqueNodes: True
Dcl
WindowPosition
X: 211
Y: 0
SizeX: 789
SizeY: 496
X: 45
Y: 69
SizeX: 955
SizeY: 549
DclOpen: False
Icl
WindowPosition
X: 57
Y: 228
SizeX: 784
SizeY: 414
X: 43
Y: 2
SizeX: 955
SizeY: 549
IclOpen: False
LastModified: No 0 0 0 0 0 0
......@@ -5,7 +5,7 @@
#define VERSION_RES_STRING "2.0.1.42\0"
#define VERSION_RES_PRODUCT_NAME "CleanIde\0"
#define VERSION_RES_COMPANY_NAME "University of Nijmegen\0"
#define VERSION_RES_COPYRIGHT "Copyright (C) 2001 University of Nijmegen.\0"
#define VERSION_RES_COPYRIGHT "Copyright (C) 1987--2001 University of Nijmegen.\0"
32512 ICON icons\clean_exe.ico
32513 ICON icons\clean_prj.ico
......
No preview for this file type
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