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
......
definition module IdePlatform
import StdPSt, StdString
import StdIOCommon
from IdeState import :: General
import StdPSt, StdString
import StdIOCommon
from IdeState import :: General
PlatformProcessAttributes :: [ProcessAttribute *(PSt General)]
RunProgram :: !.String !*(PSt General) -> *PSt General
PlatformProcessAttributes :: [ProcessAttribute *(PSt General)]
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)
SetWindowIcon :: !Id !Int !(PSt .l) -> PSt .l
SetProcessIcon :: !Int !(PSt .l) -> PSt .l
GetDialogBackgroundColour :: !(PSt .l) -> (!Colour, !PSt .l)
GetBitmapResource :: !Int !.env -> (!Maybe Bitmap,!.env)
winInitialiseTooltips :: !*OSToolbox -> *OSToolbox
winInitialiseTooltips :: !*OSToolbox -> *OSToolbox
CleanIcon :== 32512
ProjectIcon :== 32513
......
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
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 dodebug
trace_n` m f :== f
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