Commit fa9774ee authored by John van Groningen's avatar John van Groningen
Browse files

heap profiler for linux using I/O 0.8

parent ea7ff7c4
definition module Help
import deltaIOSystem
from deltaEventIO import ::IOState
from StdFile import ::Files
/* General utility for handling the AboutDialog of a Clean application.
This module uses the 0.8 I/O library.
*/
MakeAboutDialog :: String String (*s -> *((IOState *s) -> (*s,IOState *s))) *Files
-> (DialogDef *s (IOState *s), *Files)
ShowHelp :: String (IOState s) -> IOState s
implementation module Help
import StdString, StdInt, StdChar, StdBool, StdFile, StdArray, StdTuple, StdList
import deltaSystem, deltaEventIO, deltaIOSystem, deltaWindow, deltaPicture, deltaFont, deltaIOState
:: InfoDef :== (Int,Int,[InfoLine])
:: InfoLine :== (InfoFontDef,Int,Int,String)
:: InfoFontDef = InfoFont Font Centred
| NoFont Centred
:: Centred :== Bool
:: Fonts :== (Font,Font,Font,Font)
:: Heights :== (Int,Int)
HelpWdID :== 30000
InfoFontName1 :== "Geneva"
InfoFontName2 :== "Helvetica"
InfoFontName3 :== "Times"
NormalSize1 :== 9
NormalSize2 :== 12
LargeSize1 :== 12
LargeSize2 :== 14
NormalStyle :== []
BoldStyle :== ["Bold"]
Margin :== 8
AboutBegin :== "\\About"
AboutEnd :== "\\EndAbout"
HelpBegin :== "\\Help"
HelpEnd :== "\\EndHelp"
About :== False
Help :== True
//
// General AboutDialog construction.
//
MakeAboutDialog :: String String (*s -> *((IOState *s) -> (*s,IOState *s))) *Files
-> (DialogDef *s (IOState *s), *Files)
MakeAboutDialog appname infofile helpf files
# ((xmax,ymax,text),files) = ReadInfo About fonts AboutBegin AboutEnd infofile files
picture = DrawAboutInfo nft (xmax,ymax,text)
aboutDialog = AboutDialog appname ((0,0),(xmax,ymax)) picture (AboutHelp "Help" helpf)
= (aboutDialog,files)
where
fonts = InfoFonts
(nft,_,_,_) = fonts
InfoFonts :: Fonts
InfoFonts
= ( selectfont [(InfoFontName1,NormalSize1),(InfoFontName2,NormalSize2)] NormalStyle
, selectfont [(InfoFontName1,LargeSize1 ),(InfoFontName2,LargeSize2 )] NormalStyle
, selectfont [(InfoFontName1,NormalSize1),(InfoFontName2,NormalSize2)] BoldStyle
, selectfont [(InfoFontName1,LargeSize1 ),(InfoFontName2,LargeSize2 )] BoldStyle
)
where
selectfont :: ![(String,Int)] ![FontStyle] -> Font
selectfont [(fontname,size):preffonts] style
# (found,font) = SelectFont fontname style size
| found
= font
| otherwise
= selectfont preffonts style
selectfont _ style
= snd (SelectFont InfoFontName3 style NormalSize2)
/* Reading and pre-processing of the file containing the about- and help-info. */
ReadInfo :: Bool Fonts String String String *Files -> ((Int,Int,[InfoLine]),*Files)
ReadInfo help fonts begin end filename files
# (succes,file,files) = fopen (ApplicationPath filename) FReadText files
| not succes && help
= ((x,y,lines),files)
with
(x,y,lines) = ProcessInfoStrings fonts [errpref+++"could not be found."]
| not succes
= ((defaultx,defaulty,defaultlines),files)
# (found,info,file) = ReadInfoFile begin end file
(_,files) = fclose file files
| not found && help
= ((x,y,lines),files)
with
(x,y,lines) = ProcessInfoStrings fonts [errpref+++"does not contain help information."]
| not found
= ((defaultx,defaulty,defaultlines),files)
| otherwise
= ((x,y,lines),files)
with
(x,y,lines) = ProcessInfoStrings fonts info
where
(defaultx,defaulty,defaultlines)
= ProcessInfoStrings fonts ["\\DThis is a Clean program."]
errpref = "The help file \'"+++filename+++"\' "
ProcessInfoStrings :: Fonts [String] -> InfoDef
ProcessInfoStrings fonts=:(nft,lft,_,_) lines
= (maxx1,maxy+Margin-lat,lines2)
where
heights = (nat+ndt+nld,lat+ldt+lld)
(maxx,maxy,lines1) = AddFontToInfoLines fonts heights 0 (Margin+lat) lines
maxx1 = Margin+maxx+Margin
lines2 = map (CenterInfoLine nft maxx1) lines1
(nat,ndt,_,nld) = FontMetrics nft
(lat,ldt,_,lld) = FontMetrics lft
AddFontToInfoLines :: Fonts Heights Int Int [String] -> InfoDef
AddFontToInfoLines fonts heights maxx maxy [line:rest]
= (maxx1,maxy1,[(font,Margin,maxy,line1):rest1])
where
(font,wid,hgt,line1)= ParseInfoLine fonts heights line
(maxx1,maxy1,rest1) = AddFontToInfoLines fonts heights (max maxx wid) (maxy+hgt) rest
ParseInfoLine :: Fonts Heights String -> (InfoFontDef,Int,Int,String)
ParseInfoLine fonts=:(nft,lft,bft,dft) heights=:(nhgt,lhgt) line
| linelen<2 || line.[0]<>'\\'
= (NoFont False, FontStringWidth line nft, nhgt,line )
| otherwise
= (infofont, FontStringWidth line1 font, height,line1)
with
line1 = line%(2,linelen-1)
(infofont,font,height) = case (line.[1]) of
'L' -> (InfoFont lft False, lft, lhgt)
'b' -> (InfoFont bft False, bft, nhgt)
'B' -> (InfoFont dft False, dft, lhgt)
'c' -> (NoFont True , nft, nhgt)
'C' -> (InfoFont lft True , lft, lhgt)
'd' -> (InfoFont bft True , bft, nhgt)
'D' -> (InfoFont dft True , dft, lhgt)
_ -> (NoFont False , nft, nhgt)
where
linelen = size line
AddFontToInfoLines _ _ maxx maxy _
= (maxx,maxy,[])
CenterInfoLine :: Font Int InfoLine -> InfoLine
CenterInfoLine nft maxx info=:(inft=:NoFont centered,x,y,line)
| centered = (inft,(maxx-FontStringWidth line nft)/2,y,line)
| otherwise = info
CenterInfoLine nft maxx info=:(inft=:InfoFont font centered,x,y,line)
| centered = (inft,(maxx-FontStringWidth line font)/2,y,line)
| otherwise = info
ReadInfoFile :: String String *File -> (Bool,[String],*File)
ReadInfoFile begin end file
# (begin_found,file)= FindInfoBegin begin file
| not begin_found
= (False,[],file)
# (lines,file) = ReadInfoUntil end file
| otherwise
= (True,lines,file)
FindInfoBegin :: String *File -> (Bool,*File)
FindInfoBegin begin file
| sfend file = (False,file)
# (line,file) = freadline file
| isPrefixOf begin line
= (True,file)
| otherwise
= FindInfoBegin begin file
ReadInfoUntil :: String *File -> ([String],*File)
ReadInfoUntil end file
| sfend file
= ([],file)
# (line,file) = freadline file
| isPrefixOf end line
= ([],file)
# (lines,file) = ReadInfoUntil end file
| otherwise
= ([StripNewline line:lines],file)
/* The drawing of the about/help info. */
DrawAboutInfo :: Font InfoDef -> [DrawFunction]
DrawAboutInfo nft (xmax,ymax,lines)
= [ SetFont nft
, DrawInfo nft 0 ymax lines
]
DrawInfo :: Font Int Int [InfoLine] Picture -> Picture
DrawInfo nft top bot [(InfoFont font c,x,y,line):rest] pic
| y>bot = pic
| y<top = DrawInfo nft top bot rest pic
| otherwise = DrawInfo nft top bot rest (SetFont nft (DrawString line (SetFont font (MovePenTo (x,y) pic))))
DrawInfo nft top bot [(NoFont c,x,y,line):rest] pic
| y>bot = pic
| y<top = DrawInfo nft top bot rest pic
| otherwise = DrawInfo nft top bot rest (DrawString line (MovePenTo (x,y) pic))
DrawInfo _ _ _ _ pic
= pic
//
// The Help function.
//
ShowHelp :: String (IOState s) -> IOState s
ShowHelp infofile io
# ((xmax,ymax,text),io) = accFiles (ReadInfo Help fonts HelpBegin HelpEnd infofile) io
window = FixedWindow HelpWdID (0,0) "Help" ((0,0),(xmax,ymax)) (UpdateHelpWd nft text) []
= OpenWindows [window] io
where
fonts = InfoFonts
(nft,_,_,_) = fonts
UpdateHelpWd :: Font [InfoLine] UpdateArea *s -> (*s,[DrawFunction])
UpdateHelpWd nft lines areas s
= ( s
, [ SetFont nft
, RedrawAreas nft lines areas
]
)
where
RedrawAreas :: Font [InfoLine] UpdateArea Picture -> Picture
RedrawAreas nft lines [area=:((l,t),(r,b)):rest] pic
= RedrawAreas nft lines rest (DrawInfo nft (t-1) (b+40) lines pic)
RedrawAreas _ _ _ pic
= pic
/* Support functions for the AboutDialog construction. */
isPrefixOf :: String String -> Bool
isPrefixOf prefix string
| prefixlen>size string = False
| otherwise = prefix==string%(0,prefixlen-1)
where
prefixlen = size prefix
StripNewline :: String -> String
StripNewline string
| string=="" = string
| string.[last]<>'\n' = string
| otherwise = string%(0,last-1)
where
last = size string-1
This diff is collapsed.
Version: 1.3
Global
Built: True
CodeGen
CheckStacks: False
CheckIndexes: False
KeepABC: False
TargetProcessor: CurrentProcessor
Application
HeapSize: 12582912
StackSize: 1048576
ExtraMemory: 256000
IntialHeapSize: 1048576
HeapSizeMultiplier: 5120
ShowExecutionTime: False
ShowGC: False
ShowStackSize: False
MarkingCollector: True
Profile
Memory: False
MemoryMinimumHeapSize: 0
Time601: False
Time: False
Output
Output: NoConsole
Font: 950
FontSize: 6
WriteStdErr: False
Project
Verbose: False
Link
DefaultSystemObjects: True
DefaultLibraries: True
Paths
Path: {Project}
Path: {Application}:Clean 2.0.2 Sources:CleanTools:IOInterface 0.8.1 plus diff
Path: {Application}:IOInterface 0.8.1
MainModule
Name: ShowHeapProfile
Dir: {Project}
IclOpen: True
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: NoTypes
ListAttributes: True
Warnings: False
Verbose: False
ReadableABC: False
ReuseUniqueNodes: False
Dcl
Editor
TabSize: 4
Font: Monaco
FontSize: 9
AutoIndent: True
WindowPosition
X: 164
Y: 195
SizeX: 912
SizeY: 445
DclOpen: False
Icl
Editor
TabSize: 4
Font: Monaco
FontSize: 9
AutoIndent: True
WindowPosition
X: 105
Y: 42
SizeX: 887
SizeY: 610
IclOpen: True
LastModified: Yes 2002 7 1 16 6 11
Dependencies
Module: Help
Module: Picture
Module: ShowHeapProfile
Module: StdArray
Module: StdBool
Module: StdChar
Module: StdClass
Module: StdEnum
Module: StdFile
Module: StdFunc
Module: StdInt
Module: StdList
Module: StdMisc
Module: StdOrdList
Module: StdOverloaded
Module: StdReal
Module: StdString
Module: Window1
Module: Window2
Module: _SystemArray
Module: _SystemEnum
Module: commonDef
Module: controls
Module: deltaDialog
Module: deltaEventIO
Module: deltaFileSelect
Module: deltaFont
Module: deltaIOState
Module: deltaIOSystem
Module: deltaMenu
Module: deltaPicture
Module: deltaPrint
Module: deltaSystem
Module: deltaWindow
Module: dialogDef
Module: dialogLayout
Module: event
Module: events
Module: files
Module: font
Module: ioState
Module: mac_types
Module: menuDef
Module: osPrint08
Module: quickdraw
Module: timerDef
Module: windowDef
OtherModules
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
#include <sys/stat.h>
#include <unistd.h>
int file_exists (char *file_name)
{
struct stat stat_buffer;
file_name+=4;
if (stat (file_name,&stat_buffer)==0)
if ((stat_buffer.st_mode & S_IFMT)==S_IFREG &&
(stat_buffer.st_mode & S_IRUSR)==S_IRUSR)
return 1;
return 0;
}
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