{***********************************************************************
 ***                                                                 ***
 ***                      Module for Options                         ***
 ***                                                                 ***
 ***                                                                 ***
 ***********************************************************************}
{$I compdirs}
unit koptions;

interface

uses jimmys, dattime, scodes,
			tuiedit, views, dialogs,
			objects,
			kletter,
			jimprint,
			devices, forms, global,	files;

type
	T32BitMap = longint;

	TMarker = record
		Use : boolean;
		BitMap : T32Bitmap;
	end;

	PScorer = ^TScorer;
	TScorer = object(TObject)
		Disc : TSCode;
		Ess,Des : TMarker;
	end;

	PScorerCollection = ^TScorerCollection;
	TScorerCollection = object(TSortedCollection)
		function Compare(Key1, Key2: Pointer): Integer; virtual;

		function FindItem(Disc : TSCode) : PScorer;

		procedure SetEssOfCode(Disc : TScode; Bitmap : T32Bitmap);
		procedure SetDesOfCode(Disc : TScode; Bitmap : T32Bitmap);
		function GetDesOfCode(Disc : TScode) : T32Bitmap;
		function GetEssOfCode(Disc : TScode) : T32Bitmap;

		procedure LoadCodes(var S : TDataStream);
		procedure Store(var S : TDataStream);

	end;

	{*****************************************
	 ***       JIMMY DATA OBJECTS          ***
	 *****************************************}
type
	{=== COURSE BOOKING =====}
	PCourse = ^TCourse;
	TCourse = object(TJimmy)

		CoyID : longint;

		StartDate : TDate;
		CourseType : TScode;
		Desc : string[20];

		FacilitatorID : longint;

		Ptr2Students : longint;
		DiaryIdx : longint;

		Criteria : PScorerCollection;

		constructor Init(const Param : PJimmyInitParam);
		procedure CommonInit; virtual; {init procedures common to Init and Load (eg scode logging)}
		destructor done; virtual;

		{--- Editing ----}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;
		procedure EditCriteria(Caller : PView);

		{--- Viewing -----}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		function GetName(naType : byte; Maxlen : integer) : string; virtual; {used for various displays/prints -
																																					eg selection lines, window headers, etc}
		{--- Printing ----}
		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;
		procedure PrintFull(const Device : PDeviceStream; const PrintAs : word); virtual;

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual; {descendants set as fixed, so can be
																			used to identify jimmy for file operations, etc}

		procedure Storefields(var S : TDataStream); virtual;
		constructor Load(var S : TDataStream);

		{--- Indexing ----}
		function NumixTypes : byte; virtual;
		procedure GetIndex(const ixType : byte; var IdxRec : Plongint; var fiType : byte); virtual;
		function GetIndexKey(const ixType : byte) : string; virtual;

		{--- Hooking on others -----}
		function NumhkTypes : byte; virtual;
		procedure GetHookOn(const hkType : byte; var HookRec : PLongint); virtual;

		{-- Hooking to others -----}
		function NumHookTo : byte; virtual;
		procedure GetHookTo(const htType : byte; var HookToID,SubHookToID : PLongint; var hkType : byte; var Key : longint); virtual;
	end;

	{======== STUDENT =========}
	PStudent = ^TStudent;
	TStudent = object(TJimmy)
		Surname : string[20];
		Forname : string[20];
		Title : string[10];
		Age			 : byte;
		Sex      : char;

		CoyID : longint;
		JobTitle : string[20];
		JobExp   : string[10];
		FullTime : boolean;

		CourseID : longint; {pointer to course}
		FacRel   : string[10];
		TapeFreq : string[10];

		Ptr2Assessments : longint;

		constructor Init(const Param : PJimmyInitParam);

		{--- Editing ----}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		{--- Viewing -----}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		function GetName(naType : byte; Maxlen : integer) : string; virtual; {used for various displays/prints -
																																					eg selection lines, window headers, etc}
		{--- Printing ----}
		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual; {descendants set as fixed, so can be
																			used to identify jimmy for file operations, etc}

		procedure Storefields(var S : TDataStream); virtual;
		constructor Load(var S : TDataStream);

		{--- Hooking on others -----}
		function NumhkTypes : byte; virtual;
		procedure GetHookOn(const hkType : byte; var HookRec : PLongint); virtual;

		{-- Hooking to others -----}
		function NumHookTo : byte; virtual;
		procedure GetHookTo(const htType : byte; var HookToID,SubHookToID : PLongint; var hkType : byte; var Key : longint); virtual;
	end;{}

	{======== ASSESSMENT =========}
	PAssessment = ^TAssessment;
	TAssessment = object(TJimmy)
		StudentID : longint;

		Date : TDate;
		ByID : longint;

		ReportID : longint;

		Ptr2MarkSheets : longint;

		constructor Init(const Param : PJimmyInitParam);

		{--- Editing ----}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		{--- Viewing -----}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		function GetName(naType : byte; Maxlen : integer) : string; virtual; {used for various displays/prints -
																																					eg selection lines, window headers, etc}
		{--- Printing ----}
		procedure PrintGraphs;
		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual; {descendants set as fixed, so can be
																			used to identify jimmy for file operations, etc}

		procedure Storefields(var S : TDataStream); virtual;
		constructor Load(var S : TDataStream);

		{--- Hooking on others -----}
		function NumhkTypes : byte; virtual;
		procedure GetHookOn(const hkType : byte; var HookRec : PLongint); virtual;

		{-- Hooking to others -----}
		function NumHookTo : byte; virtual;
		procedure GetHookTo(const htType : byte; var HookToID,SubHookToID : PLongint; var hkType : byte; var Key : longint); virtual;
	end;{}


	{=== STUDENTS MARK SHEET =====}
	PMarkSheet = ^TMarkSheet;
	TMarkSheet = object(TJimmy)

		AssessmentID : longint;
		CourseID : longint;

		TapeRef : string[5];

		RadioData : word; {not stored - just here so that radio buttons in the editbox
										have somehwere to get a default value from}

		ManPerc : byte; {percentage mark for mannerisms}
		StyPerc : byte; {same for perc}

		Marks : PScorerCollection; {similar to criteria above - consists of discipline 3 chars and mark longint bitmap}

		Course : PCourse; {provides access to the course's criteria}

		constructor Init(const Param : PJimmyInitParam);
		procedure CommonInit; virtual;
		destructor Done; virtual;

		{--- Viewing -----}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;

		{--- Editing ----}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		{--- Printing ----}
		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual; {descendants set as fixed, so can be
																			used to identify jimmy for file operations, etc}

		procedure Storefields(var S : TDataStream); virtual;
		constructor Load(var S : TDataStream);

		{-- Hooking to others -----}
		function NumHookTo : byte; virtual;
		procedure GetHookTo(const htType : byte; var HookToID,SubHookToID : PLongint; var hkType : byte; var Key : longint); virtual;

		{--- Scoring -----}
		function GetAvEssScore(Check : string; Yes : boolean)  : word;
		function GetAvDesScore(Check : string; Yes : boolean)  : word;

		function GetAvSalesEssScore : word;
		function GetAvSalesDesScore : word;

		function GetAvNonSalesEssScore : word;
		function GetAvNonSalesDesScore : word;

		function GetEssDiscScore(const Disc : TSCode) : word;
		function GetDesDiscScore(const Disc : TSCode) : word;
	end;

 {a cut-down version of TLetter, allowing more flexibility 'n' stuff, eg
 to students (not descendant from TDirectoryItems)}
 PReport = ^TReport;
 TReport = object(TLetter)
		function  Edit(const Caller,AcceptorView : PView) : word;   virtual;  {Caller helps to set position}
{		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;{}
		function srType : word; virtual;
		procedure GetHookTo(const htType : byte; var HookToID,SubHookToID : PLongint; var hkType : byte; var Key : longint); virtual;
		function GetPrintType(var PrintType : TJimmyPrintType; PrintAs : PSItem; PrintAsLink : pointer) : word; virtual;
	end;


const
	hkstudents = 1;
	hkAssessments = 1; {hooked to students}
	hkMarksheets = 1;  {hooked to assessments}

implementation

uses
	sex,
	drivers,
	tui, tuijimmy, tuimsgs, app, tuilist,
	inpdnt, inpjimmy, kdirctry,
	{$IFDEF kusers} kusers, {$ENDIF}
	ClipBrd,
	kamsetup, editor, notes, {for reports}
	jimhooks,
	inpfname, editfile, {for linking editor type with form path}
	printers,
	tasks,
	lstrings,
	minilib;


procedure ConvertOldBitmap(OldBitmap : string; Criteria : PScorerCollection);
var P : byte;
		Scorer : PScorer;
begin
	P := 1;
	while P<length(OldBitMap) do begin
		New(Scorer, init);
		Scorer^.Disc := Copy(OldBitMap, P, 3);
		Scorer^.Ess.BitMap := UnpakLint(Copy(OldBitMap, P+3, 4));
		Scorer^.Des.BitMap := UnpakLint(Copy(OldBitMap, P+7, 4));
		Scorer^.Ess.Use := Scorer^.Ess.BitMap<>0;
		Scorer^.Des.Use := Scorer^.Des.BitMap<>0;
		Criteria^.Insert(Scorer);
		inc(P,11);
	end;
end;



{******************************************************
 ***                                                ***
 ***            SCODE OBJECTS                       ***
 ***                                                ***
 ******************************************************}
type
	PNumSCodeCollection = ^TNumSCodeCollection;
	TNumSCodeCollection = object(TSCodeCollection)
		function Compare(Key1, Key2 : pointer) : integer; virtual;
	end;

function TNumSCodeCollection.COmpare;
var S1,S2 : string[3];
begin
	S1 := ucase(PSCodeItem(Key1)^.Code);
	S2 := ucase(PSCodeItem(Key2)^.Code);

	if S1 = S2 then compare := 0
		else if S1 < S2 then compare := -1
			else if S1 > S2 then compare := 1;
end;

function NewActionCollection(Code : string) : PSCodeCollection;
begin
	NewActionCollection :=
		New(PNumSCodeCollection, init('ACT'+delspace(Code)+'.SSC', delspace(Code)+' Actions', StdSCodeCreator));
{	DebugNote('New Action Collection Code="'+Code+'"');{}
end;

{*****************************************
 ***  SCORER/CRITERIA COLLECTION       ***
 *****************************************}
function TScorerCollection.Compare(Key1, Key2: Pointer): Integer;
begin
	if PScorer(Key1)^.Disc < PScorer(Key2)^.Disc then
		Compare := -1
	else
		if PScorer(Key1)^.Disc > PScorer(Key2)^.Disc then
			Compare := 1
		else
			Compare := 1;
end;

function TScorerCollection.FindItem(Disc : TScode) : PScorer;

	function CodeMatch(Scorer : PScorer) : boolean; far;
	begin
		CodeMatch := (Disc = delspaceR(Scorer^.Disc));
	end;

begin
	Disc := DelSpaceR(Disc);
	if Disc = '' then
		FindItem := nil
	else
		FindItem := FirstThat(@CodeMatch);
end;

procedure TScorerCollection.SetEssOfCode(Disc : TScode; Bitmap : T32Bitmap);
var Scorer : PScorer;
begin
	Scorer := PScorer(FindItem(Disc));
	if Scorer=nil then begin
		if Bitmap<>0 then begin
			{add a criteria}
			New(Scorer, init);
			Scorer^.Disc := Disc;
			Scorer^.Ess.Use := True;
			Scorer^.Ess.Bitmap := Bitmap;
			Insert(Scorer);
		end;
	end else begin
		Scorer^.Ess.Use := Bitmap<>0;
		Scorer^.Ess.Bitmap := BitMap;
		if not Scorer^.Ess.Use and not Scorer^.Des.Use then
			Delete(Scorer);
	end;
end;

procedure TScorerCollection.SetDesOfCode(Disc : TScode; Bitmap : T32Bitmap);
var Scorer : PScorer;
begin
	Scorer := PScorer(FindItem(Disc));
	if Scorer=nil then begin
		if Bitmap<>0 then begin
			{add a criteria}
			New(Scorer, init);
			Scorer^.Disc := Disc;
			Scorer^.Des.Use := True;
			Scorer^.Des.Bitmap := Bitmap;
			Insert(Scorer);
		end;
	end else begin
		Scorer^.Des.Use := Bitmap<>0;
		Scorer^.Des.Bitmap := BitMap;
		if not Scorer^.Ess.Use and not Scorer^.Des.Use then
			Delete(Scorer);
	end;
end;

function TScorerCollection.GetDesOfCode(Disc : TScode) : T32BitMap;
var Scorer : PScorer;
begin
	Scorer := PScorer(FindItem(Disc));
	if Scorer=nil then
		GetDesOfCode := 0
	else
		GetDesOfCode := Scorer^.Des.Bitmap;
end;

function TScorerCollection.GetEssOfCode(Disc : TScode) : T32BitMap;
var Scorer : PScorer;
begin
	Scorer := PScorer(FindItem(Disc));
	if Scorer=nil then
		GetEssOfCode := 0
	else
		GetEssOfCode := Scorer^.Ess.Bitmap;
end;

procedure TScorerCollection.LoadCodes;
var N,B : byte;
		I : integer;
		Scorer : PScorer;
begin
	S.REad(N,1);
	for I := 0 to N-1 do begin
		New(Scorer, init);
		Scorer^.Disc := S.ReadFixedStr(3);
		S.Read(B,1);
		Scorer^.Ess.Use := (B and $01)>0;
		Scorer^.des.Use := (B and $02)>0;
		S.Read(Scorer^.Ess.Bitmap, 4);
		S.Read(Scorer^.Des.Bitmap, 4);
		Insert(Scorer);
	end;
end;

procedure TScorerCollection.Store;
var N,B : byte;
		I : integer;
		Scorer : PScorer;
begin
	if Count>20 then begin
		N := 20;
		ProgramWarning('Only 20 disciplines allowed'#13'Storing first 20',hcNoContext);
	end else
		N := Count;

	S.Write(N,1);
{	DebugNote('Storing scorer collection: N='+N2Str(N));{}

	for I := 0 to N-1 do begin
		Scorer := PScorer(At(I));
		S.WriteFixedStr(@Scorer^.Disc, 3);
		B := byte(Scorer^.Ess.Use) + byte(Scorer^.Des.Use)*$02;
		S.Write(B, 1);
		S.Write(Scorer^.Ess.BitMap, 4);
		S.Write(Scorer^.Des.Bitmap, 4);
	end;
end;


{************************************************
 ***         CRITERIA/MARK STRING PROCESSING  ***
 ************************************************}
{various routines for handling the Criteria or Marks string,
consisting of 3 bytes discipline shortcode then 4 bytes packed
longint for essential criteria or mark bitmaps and another 4 for
desirable criterai or mark bitmaps}
{function NumCodes(const S : string) : byte;
begin
	NumCodes := length(S) div 11;
end;

function PosCode(const S : string; Code : TScode) : byte;
var P : word;
begin
	PosCode := 0;
	P := 1;
	while P<length(S) do begin
		if copy(S,P,3)=padspaceR(Code,3) then begin
			PosCode := P;
			P := 999;
		end;
		inc(P,11);
	end;
end;

function GetCodeNum(const S :String; P : byte) : string;
begin
	GetCodeNum := Copy(S, (P-1)*11+1, 3);
end;

procedure ClearBitMaps(var S : string);
var P,I : word;
begin
	P := 4;
	while P<length(S) do begin
		for I := 0 to 7 do S[P+I] := char(0);
		inc(P, 11);
	end;
end;


function GetBitMap1OfCode(const S : string; Code : TScode) : longint;
var P : word;
begin
	P := PosCode(S, Code);
	if P>0 then
		GetBitMap1OfCode := UnpakLint(copy(S,P+3,4))
	else
		GetBitMap1OfCode := 0;
end;

function GetBitMap2OfCode(const S : string; Code : TScode) : longint;
var P : word;
begin
	P := PosCode(S, Code);
	if P>0 then
		GetBitMap2OfCode := UnpakLint(copy(S,P+7,4))
	else
		GetBitMap2OfCode := 0;
end;

procedure SetBitMap1OfCode(var S : String; Code : TSCode; BitMap : longint);
var P : word;
begin
	P := PosCode(S, Code);

	if BitMap<>0 then begin
		{replace/add}
{		if P=0 then
			S := S + padspaceR(Code,3) + PakLint(Bitmap) +PakLint(0) {add}
{		else
			S := copy(S,1,P+2) + PakLint(Bitmap) + copy(S,P+7,255);
	end else begin
		{delete}
{		if (P>0) and (GetBitmap2OfCode(S, Code)=0) then
			S := copy(S,1,P-1)+copy(S,P+11,255);
	end;{}
{end;

procedure SetBitMap2OfCode(var S : String; Code : TSCode; BitMap : longint);
var P : word;
begin
	P := PosCode(S, Code);

	if BitMap<>0 then begin
		{replace/add}
{		if P=0 then
			S := S + padspaceR(Code,3) + PakLint(0)+PakLint(Bitmap)
		else
			S := copy(S,1,P+6) + PakLint(Bitmap) + copy(S,P+11,255);
	end else begin
		{delete}
{		if (P>0) and (GetBitmap1OfCode(S, Code)=0) then
			S := copy(S,1,P-1)+copy(S,P+11,255);
	end;
end;


{******************************************************
 ***                                                ***
 ***            COURSE                              ***
 ***                                                ***
 ******************************************************}

constructor TCourse.Init;
begin
	inherited Init;

	StartDate.Clear;
	CoyID := -1;
	FacilitatorID := -1;

	If Param<>nil then CoyID := Param^.ForWho; {it'll have been created from the more-about list}

{	Ptr2Students := -1;
	DiaryIdx := -1;{already done in inherited}
end;

procedure TCourse.CommonInit; {init procedures common to Init and Load (eg scode logging)}
begin
	inherited CommonInit;
	SCodeCollection[scCourseType]^.LogOn;
	SCodeCollection[scDisciplines]^.LogOn;

	New(Criteria, init(10,5));
end;

destructor TCourse.Done;
begin
	dispose(Criteria, done);
	SCodeCollection[scDisciplines]^.LogOff;
	SCodeCollection[scCourseType]^.LogOff;
	inherited Done;
end;

{**************************************************************
 ***                EDIT COURSE                             ***
 **************************************************************}

procedure LinkCoyFac(const Linker : PInputLinker; const CallingView : PView); far;
begin
	PInputHookedJimmy(Linker^.TargetView[1])^.SetParent(PInputJimmy(Linker^.SourceView[1])^.ID);
end;

type
	PCriteriaButton = ^TCriteriaButton;
	TCriteriaButton = object(TOurButton)
		procedure Press; virtual;
	end;

procedure TCriteriaButton.Press;
begin
	DrawState(True);
	PCourse(DataItem)^.EditCriteria(Owner);
	DrawState(False);
end;

procedure TCourse.MakeEditBox(var EditBox : PEditBox; Caller : PView);
var R : TRect;
		CoyFacLink : PInputLinker;
		StudentList : PView;

begin
	{Create box}
	R.Assign(0, 0, 61, 13); {Size of box}
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Course Registration',Caller, @Self));

	New(CoyFacLink, init(@LinkCoyFac, EditBox));
	CoyFacLink^.ForceInitLink := True;

	with EditBox^ do begin
		inherited MakeEditBox(EditBox,Caller);

		InsTitledField(13, 1, 20, 1, 'For Compan~y~', New(PInputDirectory, Init(R,20, fiCatDirIdx, lsDirectory, 'CUS')));
{		CoyFacLink^.SetSourceView(Current, 1);{}

		InsTitledField(13, 2, 10, 1, 'D~a~te', 				New(PInputDate, init(R)));
		InsTitledField(41, 1, 17, 1, '~T~ype',        New(PInputSCode, init(R, scCoursetype)));

		InsTitledBox(  41, 2, 17, 1, '~D~esc',20);

		InsTitledField(13, 4, 19, 7, '~S~tudents',
															New(PDlgHookView,	Init(R, lsStudents, 0, hkStudents, @Self,PJImmyEditBox(EditBox))));
		Insert(PDlgHookView(Current)^.VScrollBar);
		StudentList := Current;

		{pick facilitator off company more-about list}
		InsTitledField(13,Size.Y-2, 20, 1, '~F~acilitator',
														New(PInputHookedJimmy, init(R, 20, hkStudents, lsStudents, srStudent, RecNo)));
{		CoyFacLink^.SetTargetView(Current, 1);{}

		{-- Buttons --}
		Insert(New(PCriteriaButton, init(45, Size.Y-7, 'C~r~iteria', cmNone, bfNormal, @Self)));
		Insert(New(PJimmyOKButton, Init(45,Size.Y-5, @Self)));
		Insert(New(PjimmyCancelButton, init(45,Size.Y-3, @Self)));

		EndInit;
	end;

	if Ptr2Students<>-1 then StudentList^.Focus;

end;


{*********************************
 ***      EDIT CRITERIA        ***
 *********************************}
procedure LinkDiscAction(const Linker : PInputLinker; const CallingView : PView); far;
var DiscView, ActionView : PSCodeListView;
		EssDesView : PERadioButtons;
		SCode : PScodeItem;
		NCollection, OCollection : PScodeCollection;
		P,I,EssDes : word;
		Bitmap : longint;
		ScodePos : byte;
		PS : PString;
		OCOde : string[3];
		Criteria : PScorerCollection;

	procedure BuildBitmap(Scode : PScodeItem); far;
	begin
		if Scode^.Tag then BitMap := BitMap or Exp2(ScodePos);
		inc(ScodePos);
	end;

	procedure Tag(Scode : PScodeItem); far;
	begin
		Scode^.Tag := (Bitmap and Exp2(ScodePos))>0;
		inc(ScodePos);
	end;


begin
	DiscView := PSCodeListView(Linker^.SourceView[1]);
	ActionView := PSCodeListView(Linker^.SourceView[2]);
	EssDesView := PERadioButtons(Linker^.SourceView[3]);

	{botch botch - targetview[1] points directly to criteria}
	Criteria := PScorerCollection(Linker^.TargetView[1]);

	{get data items}
	EssDesView^.GetData(EssDes);
	OCollection := PSCodeCollection(ActionView^.Collection); {old, existing one}
	if OCollection<>nil then
		OCode := Copy(OCollection^.FileName^,4,pos('.', OCollection^.FileName^)-4)
	else
		OCode := '';

	if (DiscView = pointer(CallingView)) or (EssDesView = pointer(CallingView)) then begin
		{--- Discipline changed - so change action codes & set tags ---}

		{pick out code from discipline list}
		if DiscView^.Collection^.Count>0 then
			SCode := PScodeItem(DiscView^.Collection^.At(DiscView^.Focused))
		else
			SCode := nil;

		if Scode<>nil then begin

			{if the discipline has changed, then we need to get the new	collection}
			if OCode<>SCode^.Code then begin
				{set action scode view targetview[1] - sorted by code}
				NCollection := NewActionCollection(SCode^.Code);

				{change action views' collection}
				ActionView^.SetCollection(NCollection);
				ActionView^.ViewOnly := True;{}
				if ActionView^.InRange(0) then ActionView^.FocusItem(0); {move to first one}

				if OCollection<>nil then dispose(OCollection, done); {not done by setcollection as normally it's
																														dealing with admin'd scodes}
			end else
				ActionView^.Redraw; {redraw happens automatically above}

			if SCode^.Tag then begin
				{tag all actions and untag discipline}
				Bitmap := Exp2(ActionView^.Collection^.Count)-1;
				Scode^.tag := False;
				DiscView^.redrawItem(DiscView^.Focused);
				if EssDes = 0 then {essential/desirable}
					Criteria^.SetEssOfCode(Scode^.Code, Bitmap)
				else
					Criteria^.SetDesOfCode(Scode^.Code, Bitmap);{}
			end else begin{}
				{tag scodes of ncollection from listline}
				{see if discipline in listline}
				if EssDes = 0 then
					Bitmap := Criteria^.GetEssOfCode(Scode^.Code)
				else
					Bitmap := Criteria^.GetDesOfCode(Scode^.Code);
			end;{}
			ScodePos := 0;
			ActionView^.Collection^.ForEach(@Tag);

		end;
	end;

	if ActionView = pointer(CallingView) then begin
		{--- action options changed/tagged ----}
		{set listline from existing tagged from action view}
		{make up bitmap}
		if OCollection<>nil then begin

			BitMap := 0; ScodePos := 0;
			OCollection^.ForEach(@BuildBitmap);

			if EssDes=0 then
				Criteria^.SetEssOfCode(OCode, Bitmap)
			else
				Criteria^.SetDesOfCode(OCode, Bitmap);
		end;
	end;

	if EssDesView = pointer(CallingView) then
		ActionView^.Focus; {refocus on action line, makes it easier...}
end;


type
	PActionSCodeList = ^TActionSCodeList;
	TActionSCodeList = object(TScodeListView)
	end;




{--- Editing ----}
procedure TCourse.EditCriteria(Caller : PView);
var EditBox : PEditBox;
		R : TRect;
		DiscActionLinker : PInputLinker;
		Control : word;

begin
	{Create box}
	R.Assign(0, 0, 78, 22); {Size of box}
	CentreOnView(R, Caller);
	EditBox := New(PObjectEditBox, Init(R, 'Criteria '+GetJimmyIDName(CoyID, naDisplay,0),Caller));

	New(DiscActionLinker, init(@LinkDiscAction, EditBox));
	DiscActionLinker^.ForceINitLink := True;

	with EditBox^ do begin
		inherited MakeEditBox(EditBox,Caller);

		Insert(New(PSkipBytes, init(4))); {skip companyid}

		{criteria list - not selectable - pstring}
{		R.Assign(0,0,0,0);
		Insert(New(PInputELine, init(R,255)));
		Current^.Setstate(sfDisabled, true);
		DiscActionLinker^.SetTargetView(Current, 1);{}

		{hmmm, botch botch....  so that linker has access....}
		DiscActionLinker^.TargetView[1] := pointer(Criteria);

		{disciplines}
		InsTitledField(13, 1, 40, 5, '~D~iscipline', New(PScodeListView, Init(R, SCodeCollection[scDisciplines], nil)));
		DiscActionLinker^.SetSourceView(Current, 1);
		PScodeListView(Current)^.ViewOnly := True;{}
		PScodeListView(Current)^.ForceLinkOn := flOnMoving or flOnTagging;{}
		Insert(PSCodeListView(Current)^.VScrollBar);

		{Actions - tag}
		InsTitledField(13, 7, 40,14, '~A~ctions', New(PActionSCodeList, Init(R, nil, nil)));
		DiscActionLinker^.SetSourceView(Current, 2);
		PScodeListView(Current)^.ViewOnly := True;{}
		PScodeListView(Current)^.ForceLinkOn := flOnTagging;{}
		Insert(PScodeListView(Current)^.VScrollBar);

		{essential/desirable selector}
		InsTitledField(57,11, 13, 2, '', New(PERadioButtons, init(R, NewSItem('~E~ssential', NewSItem('De~s~irable', nil)))));
{		Current^.Options := Current^.Options and not ofSelectable;{}
		DiscActionLinker^.SetSourceView(Current, 3);


		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(60,Size.Y-5, @Self)));
		Insert(New(PjimmyCancelButton, init(60,Size.Y-3, @Self)));

		EndInit;
	end;

{	DiscActionLinker^.TargetView[1]^.SetData(Criteria);{}

	Message(DiscActionLinker^.SourceView[1], evBroadCast, cmForceLink, nil);

	Control := Desktop^.ExecView(EditBox);

{	if COntrol <>cmCancel then
		DiscActionLinker^.TargetView[1]^.GetData(Criteria);{}

	dispose(EditBox, done);

end;




{--- Viewing -----}
function TCourse.DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string;
begin
	case lsType of
		lsHistory : begin
			DisplayLine := StartDate.Digit8 + ' Course ' + CourseType + ' '+Desc;
		end;
	else
		DisplayLine := 'TCourse.DisplayLine not defined for this lstype';
	end;
end;

function TCourse.GetName(naType : byte; Maxlen : integer) : string;
begin
	GetName := StartDate.Digit8 + delspaceR(' ' + CourseTYpe) + ' ' + Desc;
end;

{*****************************
 *** PRINTING              ***
 *****************************}
procedure TCourse.SetFormCodes(const FormCodes: PFormCodeCollection);
begin
	inherited SetFormCodes(formCodes);
	with FormCodes^ do begin
		Insert(New(PJimmyFormCode, Init('COY', CoyID)));
		SetDate('DT', StartDate);
		Insert(New(PJimmyFormCode, Init('FACILITATOR', FacilitatorID)));
		SetStr('TYPE', ExpandScode(scCourseType, CourseType));
		SetStr('DESC', Desc);
	end;
end;

procedure TCourse.PrintFull;
var P,bit : byte;
		Scorer : PScorer;
		Code : string;
		Actions : PSCodeCollection;
		Bitmap : longint;

begin
	with Device^ do begin
		SetFormCodes(FormCodes);
		FormCodes^.SetStr('RTITLE', 'COURSE FOR <COY.NAME/u>');
		StartPrint('COURSE','REPORT');

		{students}

		{run through criteria}
		for P := 0 to Criteria^.Count-1 do begin
			Scorer := PScorer(Criteria^.At(P));

			writeCodedStr('<B+>'+ucase(ExpandSCode(scDisciplines, Scorer^.Disc))+'<B->'#13#10);
			Actions := NewActionCollection(Code);
			Actions^.LoadCodes(lkOff);

			{for each discipline, list essential & desirables}
			BitMap := Scorer^.Ess.Bitmap;
			if BitMap<>0 then begin
				writeln('');
				writeCodedStr(' <B+>Essential<B->'#13#10);
				for Bit := 0 to 31 do
					if (BitMap and Exp2(Bit))>0 then
						writeln('  '+PSCodeItem(Actions^.At(Bit))^.Description^);
			end;

			BitMap := Scorer^.Des.BitMap;
			if BitMap<>0 then begin
				writeln('');
				writeCodedStr(' <B+>Desirable<B->'#13#10);
				for Bit := 0 to 31 do
					if (BitMap and Exp2(Bit))>0 then
						writeln('  '+PSCodeItem(Actions^.At(Bit))^.Description^);
			end;

			dispose(ACtions, done);
			writeln('');
			writeln('');
		end;

		EndPrint;
	end;
end;


{--- Database ----}
function TCourse.RecSize : word;  {space to be reserved in jimmy file}
begin RecSize := 350; end;

function TCourse.srType : word;
begin srType := srCourse; end;

const
	 {--- Required for Stream ----}
	 RCourse : TStreamRec = (
		 ObjType : srCourse;
		 VmtLink : Ofs(TypeOf(TCourse)^);
		 Load : @TCourse.Load;
		 Store : @TCourse.Store
	 );

constructor TCourse.Load(var S : TDataStream);
var Ver : byte;
		OldCriteria : string;
		Scorer : PSCorer;
begin
	S.Read(Ver, 1);
	case Ver of
		1 : begin
			inherited Load(S);

			StartDate.Load(S);
			S.Read(CourseType, 4);
			Desc := S.ReadStr;
			S.Read(CoyID, 4);
			S.REad(FacilitatorID, 4);

			{load criteria}
			OldCriteria := S.ReadStr;
			ConvertOldBitmap(OldCriteria, Criteria);

			{ptr2students stored/loaded in inherited}
		end;
		2 : begin
			inherited Load(S);

			StartDate.Load(S);
			S.Read(CourseType, 4);
			Desc := S.ReadStr;
			S.Read(CoyID, 4);
			S.REad(FacilitatorID, 4);

			{load criteria}
			Criteria^.LoadCodes(S);
			{ptr2students stored/loaded in inherited}
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not recognised'#13#10'TCourse.Load',mfError,hcNoContext);
		fail;{}
	end;
end;

procedure TCourse.StoreFields(var S : TDataStream);
var Ver : byte;
begin
	Ver :=2; S.Write(Ver, 1);
	inherited StoreFields(S);
	StartDate.Store(S);
	S.Write(CourseType, 4);
	S.WriteStr(@Desc);
	S.Write(CoyID, 4);
	S.Write(FacilitatorID, 4);

	{store criteria, with size check}
	Criteria^.Store(S);
end;


{--- Indexing ----}
function TCourse.NumixTypes : byte;
begin NumixTypes := 1; end;

procedure TCourse.GetIndex;
begin
	inherited getIndex(ixType, IdxRec, fiType);

	case ixType of
		1 : begin
			IdxRec := @DiaryIdx; {can't put this in ifdef statement as it must be stored anyway,
														in case in future diary added/removed}
			{$IFDEF KDIary}
			fitype := fiDiaryIdx;
			{$ENDIF}
		end;
	end;
end;

function TCourse.GetIndexKey;
begin
	GetIndexKey := '';
	{$IFDEF KDiary}
	case ixType of
		1 : GetIndexKey := StartDate.AsKey;
	end;
	{$ENDIF}
end;

{--- Hooking on others -----}
function TCourse.NumhkTypes;
begin NumhkTypes := 1; end; {hkStudents}

procedure TCourse.GetHookOn(const hkType : byte; var HookRec : PLongint);
begin
	inherited GetHookOn(hkType, HookRec);
	case hktype of
		hkStudents : HookRec := @Ptr2students;
	end;
end;

{-- Hooking to others -----}
function TCourse.NumHookTo;
begin NumHookTo := 1; end; {only hooked to company's history}

{for returning which jimmys ID's this jimmys should be hooked *to*}
procedure TCourse.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID,SubHookToID, hkType, Key);
	case httype of
		1 : begin
			HookToID := @CoyID;
			hkType := hkHistory;
			if StartDate.Blank then	Key := SortKeyStart {Make sure appears at beginning}
			else Key := -StartDate.Days;  							{Reverse Sort on date}
		end;
	end;
end;

{******************************************************
 ***                                                ***
 ***            Student                              ***
 ***                                                ***
 ******************************************************}

constructor TStudent.Init;
var Course, Coy : PJimmy;
begin
	inherited Init;

	CourseID := -1;
	CoyID := -1;

	If Param<>nil then begin
		Course := GetJimmy(Param^.ForWho);
		{in course's student list}
		CourseID := Course^.RecNo;
		CoyID := PCourse(Course)^.CoyID;
		dispose(Course, done);
	end;
end;



{*************************************************
 ***                   EDITING                 ***
 *************************************************}
procedure LinkCoyCourse(const Linker : PInputLinker; const CallingView : PView); far;
var Coy : PDirectoryItem;
		COurseID : longint;
begin
	with Linker^ do begin
		Coy := PDirectoryItem(PInputJimmy(SourceView[1])^.GetJimmy);

		if COy<>nil then begin
			PInputHookedJimmy(TargetView[1])^.SetParent(Coy^.RecNo);

			{get first course}
			FIleAdmin(fiHooks)^.LogOn;
			CourseID := HookFile^.FindFirst(Coy^.Ptr2History, srCourse);
			FIleAdmin(fiHooks)^.LogOff;

			TargetView[1]^.SetData(CourseID);
			TargetView[1]^.DrawView;
		end;
	end;
end;


procedure TStudent.MakeEditBox(var EditBox : PEditBox; Caller : PView);
var R : TRect;
		CoyCourseLink : PInputLinker;
		AssList : PView;

begin
	{Create box}
	R.Assign(0, 0, 65, 13); {Size of box}
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Student Registration',Caller, @Self));

	New(CoyCourseLink, init(@LinkCoyCourse, EditBox));
	CoyCourseLink^.ForceInitLink := True;

	with EditBox^ do begin
		inherited MakeEditBox(EditBox,Caller);

		InsTitledBox(  11, 1, 17, 1, '~S~urname',20);
		PInputELine(Current)^.MustInputToClose := True;
		InsTitledBox(  11, 2, 17, 1, '~F~orname',20);
		InsTitledBox(  11, 3, 10, 1, '~T~itle',10);
		InsTitledField(11, 4,  2, 1, '~A~ge', New(PInputByte, init(R,3)));
		InsTitledField(20, 4,  1, 1, 'Se~x~', New(PInputSex, init(R)));

		InsTitledField(42, 1, 20, 1, 'Compan~y~', New(PInputDirectory, Init(R,20, fiCatDirIdx, lsDirectory, 'CUS')));
		CoyCourseLink^.SetSourceView(Current, 1);
		InsTitledBox(  42, 2, 20, 1, '~J~ob',20);
		InsTitledBox(  42, 3, 10, 1, '~E~xp',10);
		InsTitledField(42, 4,  1, 1, 'F~u~ll Time', New(PInputBoolean, init(R)));

		InsTitledField(11, 6, 17, 1, 'C~o~urse', New(PInputHookedJimmy, Init(R,20, hkHistory, lsHistory, srCourse, CoyID)));
		CoyCourseLink^.SetTargetView(Current, 1);
		InsTitledBox(  11, 7, 10, 1, 'Facil. ~i~s', 10);
		InsTitledBox(  11, 8, 10, 1, 'Tape Fre~q~', 10);

		{Assessment list}
		InsTitledField(42, 6, 19, 5, '~A~s''s''ments',
											New(PDlgHookView,	Init(R, lsAssessments, 0, hkAssessments, @Self,PJImmyEditBox(EditBox))));
		Insert(PDlgHookView(Current)^.VSCrollBar);
		AssList := Current;

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(11,Size.Y-3, @Self)));
		Insert(New(PjimmyCancelButton, init(21,Size.Y-3, @Self)));

		EndInit;
	end;

	if Ptr2Assessments<>-1 then AssList^.Focus;

end;


{--- Viewing -----}
function TStudent.DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string;
begin
	case lsType of
		lsStudents,lsMoreAbout : begin
			DisplayLine := Surname+' '+Forname;
		end;
	else
		DisplayLine := 'TStudent.DisplayLine not defined for this lstype';
	end;
end;

function TStudent.GetName(naType : byte; Maxlen : integer) : string;
begin
	if Forname <> '' then
		GetName := Surname+','+Forname
	else
		GetName := Surname;
end;

{--- Printing ----}
procedure TStudent.SetFormCodes(const FormCodes: PFormCodeCollection);
begin
	inherited SetFormCodes(formCodes);

	with FormCodes^ do begin
		SetStr('NAME', Title+' '+Forname+' '+Surname);
		SetStr('NSF', Surname+', '+Forname);
		SetStr('AGE', N2Str(Age));
		SetStr('SEX', Sex);

		Insert(New(PJimmyFormCode, init('COY', CoyID)));
		SetStr('JOB', JobTitle);
		SetStr('EXP', JobExp);

		if FullTime then SetStr('JOBTIME','Full Time') else SetStr('JOBTIME','Part Time');

		Insert(New(PJimmyFormCode, init('COURSE', CourseID)));
		SetStr('FACIS', FacRel);
		SetStr('TAPEFREQ', TapeFreq);
	end;
end;

{--- Database ----}
function TStudent.RecSize : word;  {space to be reserved in jimmy file}
begin RecSize := 150; end;

function TStudent.srType : word;
begin srType := srStudent; end;

const
	 {--- Required for Stream ----}
	 RStudent : TStreamRec = (
		 ObjType : srStudent;
		 VmtLink : Ofs(TypeOf(TStudent)^);
		 Load : @TStudent.Load;
		 Store : @TStudent.Store
	 );


constructor TStudent.Load(var S : TDataStream);
var Ver : byte;
begin
	S.Read(Ver, 1);
	case Ver of
		1 : begin
			inherited Load(S);

			Surname := S.ReadStr;
			Forname := S.ReadStr;
			Title := S.ReadStr;
			S.Read(Age, 1);
			S.Read(Sex, 1);

			S.Read(CoyID, 4);

			JobTitle := S.ReadStr;
			JobExp := S.ReadStr;

			S.Read(Fulltime, 1);

			S.Read(CourseID, 4);
			FacRel := S.ReadStr;

			TapeFreq := S.ReadStr;

{			S.Read(ReportID, 4);
if ReportID=0 then ReportID := -1; {get rid of once tested}
{			S.Read(MarkSheetID, 4); done in inherited}
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not recognised'#13#10'Loading TStudent',mfError,hcNoContext);
		fail;{}
	end;
end;

procedure TStudent.StoreFields(var S : TDataStream);
var Ver : byte;
begin
	Ver :=1; S.Write(Ver, 1);
	inherited StoreFields(S);

	S.WriteStr(@Surname);
	S.WriteStr(@Forname);
	S.WriteStr(@Title);

	S.Write(Age, 1);
	S.Write(Sex, 1);

	S.Write(CoyID, 4);

	S.WriteStr(@JobTitle);
	S.WriteStr(@JobExp);

	S.Write(Fulltime, 1);
	S.Write(CourseID, 4);

	S.WriteStr(@FacRel);

	S.WriteStr(@TapeFreq);

{	S.Write(reportID, 4);

{	S.Write(MarkSheetID, 4); done in inherited}
end;


{--- Hooking on others -----}
function TStudent.NumhkTypes;
begin NumhkTypes := 1; end; {hkStudents}

procedure TStudent.GetHookOn(const hkType : byte; var HookRec : PLongint);
begin
	inherited GetHookOn(hkType, HookRec);
	case hktype of
		hkAssessments : HookRec := @Ptr2Assessments;
	end;
end;

{-- Hooking to others -----}
function TStudent.NumHookTo;
begin NumHookTo := 1; end; {only hooked to company's history}

{for returning which jimmys ID's this jimmys should be hooked *to*}
procedure TStudent.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID,SubHookToID, hkType, Key);
	case htType of
		1 : begin
			HookToID := @CourseID;
			hkType := hkStudents;
			Key := ((ord(upcase(Surname[1]))*$10000
							+ ord(upcase(Surname[2]))) * $100)
							+ ord(upcase(Surname[3])); {alphabetical, a bit}
		end;
	end;
end;

{******************************************************
 ***                                                ***
 ***            Assessment                          ***
 ***                                                ***
 ******************************************************}

constructor TAssessment.Init;
begin
	inherited Init;

	Date.SetToToday;
	ByID := -1;

	{$IFDEF Kusers} if CurrentUser<>nil then ByID := CurrentUser^.RecNo; {$ENDIF}

	If Param<>nil then
		StudentID := PAram^.ForWho;

	ReportID := -1;
end;


{*************************************************
 ***               GRAPHS                      ***
 *************************************************}
{Three graph types required:
	1 - overall scores (essential/desirable) for each discipline
	2 - overall scores (essential/desirable) for each call
	3 - mannerism & style for each call.}
procedure TAssessment.PrintGraphs;
var MarkSheet : PMarkSheet;
		W : word;
		P : integer;
		DiscScores : PScorerCollection;
		Code : TSCode;
		CriteriaScorer,MarkScorer : PScorer;
		Total,NumSheets : longint;
		BitMap : T32BitMap;
		S,S1,S2 : string;{}
		GraphOffset : byte;
		RedOn, RedOff : string;

		PrintType : TJimmyPrintType;
		PrintAs : PSItem;
		PrintAsLink : pointer;
		Control : word;

		Device : PDeviceStream;

const
	GraphTop1 = ' 0   10   20   30   40   50   60   70   80   90  100';
	GraphTop2 = ' ÚÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅ¿';

	GraphBot1 = ' ÀÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÙ';
	GraphBot2 = ' 0   10   20   30   40   50   60   70   80   90  100';

	GraphChar : PChar = #219#177#178#176;  {solid to light shading}

	function GraphLine(Len : word;  C : char; const ColOn, ColOff : string) :String;
	begin
		if (Len>100) then Len := 110;
		GraphLine := ' ³'+ColOn+setlength(chars(Len div 2, C),50)+ColOff+'³';
	end;

	procedure SplitBitMap(BitMap : T32BitMap; var Total,NumSheets : longint);
	begin
		Total := BitMap and $00FFFFFF;
		NumSheets := Bitmap shr 24;
	end;

	function BuildBitMap(Total,NumSheets : longint) : T32BitMap;
	begin
		BuildBitMap := Total or (NumSheets shl 24);
	end;


begin
	{Check there are marksheets}
	if Ptr2MarkSheets = -1 then begin
		ProgramWarning('No Marksheets',hcNoContext);
		exit;
	end;

	{Ask for print device}
	PrintAs := nil;
	PrintASLink := nil;

	PrintType := BlankPrintType;
	PrintType.DeviceName := PrinterName;
	Control := GetPrintType(PrintType, PrintAs, PrintAsLink);

	if Control = cmCancel then exit; {break;{}

	{now has Editor set (must be internal), Target as ptPrinter/ptFile,
	and DeviceName as name of file}
	Device := SetDeviceFrom(PrintType.Editor, PrintType.Target, PrintType.DeviceName);
	if Device=nil then begin
		ProgramError('Could not open that device',hcNoContext);
		exit;
	end;

	FileAdmin(fiHooks)^.LogOn;
	ThinkingOn('Printing');
	Device^.FormCodes^.SetPrefix('');
	SetFormCodes(Device^.FormCodes);

	RedOn := '<RED>'; RedOff := '<BLK>';

	{==== % SCORES BY CALL ============}
	GraphOffset := 15;
	Device^.FormCodes^.SetStr('TITLE', '% Scores by Call');
	Device^.StartPrint('ASSGRAPH','');
	Device^.writeStr(DecodeESC(PPrinterFilter(Device^.Filter)^.IBMChars));
	Device^.writeln(space(GraphOffset)+GraphTop1);
	Device^.writeln(space(GraphOffset)+GraphTop2);

	MarkSheet := PMarksheet(HookFile^.GetFirst(Ptr2Marksheets, srMarkSheet));

	while Marksheet<>nil do begin

		Device^.WriteCodedStr(PadSpaceL(MarkSheet^.TapeRef, GraphOffset)
										+GraphLine(markSheet^.GetAvEssScore('', False), GraphChar[0],RedOn,RedOff)+CRLF);

		Device^.Writeln(Space(GraphOffset)
										+GraphLine(markSheet^.GetAvDesScore('', False), GraphChar[1],'',''));

		dispose(MarkSheet, done);
		MarkSheet := PMarkSheet(HookFile^.GetNextJimmy);

		if MarkSheet<>nil then
			 Device^.writeln(space(GraphOffset)+GraphLine(0,#0,'',''));
	end;

	Device^.writeln(space(GraphOffset)+GraphBot1);
	Device^.writeln(space(GraphOffset)+GraphBot2);

	Device^.FormCodes^.SetStr('KEY', 'Key: '+RedOn+GraphChar[0]+' Essential'+RedOff+#13#10'     '+GraphChar[1]+' Desirable');


	{==== % MANNERISM & STYLES BY CALL ============}
	Device^.FormCodes^.SetStr('TITLE', '% Manner & Style by Call');
	Device^.NewPage;
	Device^.writeln(space(GraphOffset)+GraphTop1);
	Device^.writeln(space(GraphOffset)+GraphTop2);
	GraphOffset := 15;

	MarkSheet := PMarksheet(HookFile^.GetFirst(Ptr2Marksheets, srMarkSheet));

	while Marksheet<>nil do begin

		Device^.Writeln(PadSpaceL(MarkSheet^.TapeRef, GraphOffset)
										+GraphLine(markSheet^.ManPerc, GraphChar[0],'',''));

		Device^.Writeln(Space(GraphOffset)
										+GraphLine(markSheet^.StyPerc, GraphChar[1],'',''));

		dispose(MarkSheet, done);
		MarkSheet := PMarkSheet(HookFile^.GetNextJimmy);

		if MarkSheet<>nil then
			 Device^.writeln(space(GraphOffset)+GraphLine(0,#0,'',''));
	end;

	Device^.writeln(space(GraphOffset)+GraphBot1);
	Device^.writeln(space(GraphOffset)+GraphBot2);

	Device^.FormCodes^.SetStr('KEY', 'Key: '+GraphChar[0]+' Mannerisms'#13#10'     '+GraphChar[1]+' Style');


	{================ DISCIPLINES - SET UP SCORES ======================}
	GraphOffset := 22;

	{run through marksheets}
	MarkSheet := PMarksheet(HookFile^.GetFirst(Ptr2Marksheets, srMarkSheet));

	New(DiscScores, init(10,10));
	while Marksheet<>nil do begin
		{sum up discipline scores, using lower 3 bytes of bitmap for storing
		total and upper byte for number of valid sheets}
		for P := 0 to MarkSheet^.Course^.Criteria^.Count-1 do begin
			CriteriaScorer := PScorer(MarkSheet^.Course^.Criteria^.At(P));
			MarkScorer := PScorer(MarkSheet^.Marks^.FindItem(CriteriaScorer^.Disc));

			if MarkScorer<>nil then begin

{				DebugNote('Marksheet '+MarkSheet^.TapeRef+' '
									+MarkScorer^.Disc);{}

				if MarkScorer^.Ess.Use and (CriteriaScorer^.Ess.BitMap<>0)  then begin
					SplitBitMap(DiscScores^.GetEssOfCode(MarkScorer^.Disc),Total,NumSheets);

					{increment numsheets}
					inc(NumSheets);
					Total := Total + MarkSheet^.GetEssDiscScore(MarkScorer^.Disc);

{					if MarkScorer^.Disc='UTE' then
						Debugnote('UTE : '+N2Str(MarkSheet^.GetEssDiscScore(MarkScorer^.Disc))+'->'+N2Str(Total)+'/'+N2Str(NumSheets));{}

					DiscScores^.SetEssOfCode(MarkScorer^.Disc, BuildBitMap(Total, NumSheets));
				end;

				if (MarkScorer^.Des.Use) and (CriteriaScorer^.Des.BitMap<>0) then begin
					SplitBitMap(DiscScores^.GetDesOfCode(MArkScorer^.Disc), Total, NumSheets); {split bitmap}

					{increment numsheets}
					inc(NumSheets);
					Total := Total + MarkSheet^.GetDesDiscScore(MarkScorer^.Disc);

					DiscScores^.SetDesOfCode(MarkScorer^.Disc, BuildBitMap(Total, NumSheets));
				end;
			end;
		end;

		dispose(Marksheet, done);
		MarkSheet := PMarkSheet(HookFile^.GetNextJimmy);
	end; {while marksheet<>nil}

	{================== PRINT ========================}
	Device^.FormCodes^.SetStr('TITLE', '% Scores by Discipline');
	Device^.NewPage;

	Device^.writeln(space(GraphOffset)+GraphTop1);
	Device^.writeln(space(GraphOffset)+GraphTop2);

	for P := 0 to DiscScores^.Count-1 do begin
		MarkScorer := PScorer(DiscScores^.At(P));

		{split discipline description onto two lines}
		S := ExpandSCode(scDisciplines, MarkScorer^.Disc);
		S1 := delspaceR(WordBreakLine(S, GraphOffset, 0));
		S2 := delspaceR(WordBreakLine(S, GraphOffset, 1));

		{essential}
		SplitBitMap(MarkScorer^.Ess.BitMap, Total, NumSheets);
		if NumSheets>0 then Total := Total div NumSheets;

		Device^.WriteCodedStr(PadspaceL(S1, GraphOffset)
											+GraphLine(Total, GraphChar[0], RedOn,RedOff)+CRLF);

		SplitBitMap(MarkScorer^.Des.BitMap, Total, NumSheets);
		if NumSheets>0 then Total := Total div NumSheets;

		Device^.Writeln(PadspaceL(S2, GraphOffset)
											+GraphLine(Total, GraphChar[1], '',''));

		if P<>DiscScores^.Count-1 then
			 Device^.writeln(space(GraphOffset)+GraphLine(0,#0,'',''));
	end;
	dispose(DiscScores, done);

	Device^.writeln(space(GraphOffset)+GraphBot1);
	Device^.writeln(space(GraphOffset)+GraphBot2);

	Device^.FormCodes^.SetStr('KEY', 'Key: '+RedOn+GraphChar[0]+' Essential'+RedOff+#13#10'     '+GraphChar[1]+' Desirable');

	Device^.EndPrint;

	if Device<>PDeviceStream(Printer) then dispose(Printer, done);

	ThinkingOff;
	FileAdmin(fiHooks)^.LogOff;
end;

{*************************************************
 ***                   EDITING                 ***
 *************************************************}

{===== PRINT GRAPH BUTTON ========================}
type
	PGraphButton = ^TGraphButton;
	TGraphButton = object(TOurButton)
		procedure Press; virtual;
	end;

procedure TGraphButton.Press;
begin
	DrawState(true);

	PAssessment(PJimmyEditBox(Owner)^.Jimmy)^.PrintGraphs;

	DrawState(False);
end;


{===== PRINT REPORT BUTTON ======================}
type
	PPrintRptButton = ^TPrintRptButton;
	TPrintRptButton = object(TOurButton)
		procedure Press; virtual;
	end;

procedure TPrintRptButton.Press;
var	Assessment : PAssessment;
		Report : PReport;

begin
	DrawState(true);

	Assessment := PAssessment(PJimmyEditBox(Owner)^.Jimmy);

	if Assessment^.ReportID=-1 then
		MessageBox('PRINT REPORT', 'Can''t print - Report not written!',mfWarning+mfCancelButton,hcNoContext)
	else begin
		report := PReport(GetJImmy(Assessment^.ReportID));
		Report^.Print;
		dispose(Report, done);
	end;

	DrawState(False);
end;


{==== EDIT REPORT BUTTON =========================}
type
	PEditRptButton = ^TEditRptButton;
	TEditRptButton = object(TAccessJimmyButton)
		procedure Press; virtual;
	end;

const
	HdrFrame = '--------------------------------------';

procedure TEditRptButton.Press;
var Param : TJimmyInitParam;
		FormFile : text;
		Event : TEvent;
		PercE, PercD, PercSE, PercSD, PercMan, PercSty : word;
		WE,WD : word;
		NumSheets, P : integer;
		Marksheet : PMarksheet;
		Assessment : PAssessment;
		HeaderLine : string; {for marking up used headers}
		Scorer : PScorer;

const
	Tab : array[1..7] of byte = (5,7,6,7,6,8,8);


	{-- for report body, adding discipline headers}
	procedure AddHeader(S : string);
	begin
{		writeln(FormFile, HdrFrame + EndParaChar);{}
		writeln(FormFile, '<B+>'+S +'<B->'+ EndParaChar);
{		writeln(FormFile, HdrFrame + EndParaChar);{}
		writeln(FormFile, EndParaChar);
		writeln(FormFile, EndParaChar);
	end;


begin
	DrawState(True);
	Assessment := PAssessment(PJimmyEditBox(Owner)^.Jimmy);
	HeaderLine := '';

	{whether creating new or not, put results into clipboard so they can
	be re-inserted if changed}
	{Place results into clipboard for inserting}
	ThinkingOn('Making Marks');

	with Clipboard^ do begin
		LSClear(Data); {delete whole lot}

		LSAppendStr(Data, '           SALES        OTHER'+EndLine);
		LSAppendStr(Data, ' TAPE    ESS   DES    ESS   DES    MANNER   STYLE'+EndLine);
		LSAppendStr(Data, '-------------------------------------------------'+EndLine);

		{run through marksheets loading overall scores}
		FileAdmin(fiHooks)^.LogOn;
		MarkSheet := PMarksheet(HookFile^.GetLast(Assessment^.Ptr2Marksheets, srMarkSheet));
		percE 	:= 0; percD 	:= 0; percMan 	:= 0; percSty 	:= 0;	percSE 	:= 0; percSD 	:= 0;
		NumSheets := 0;

		while Marksheet<>nil do begin

			{tape reference}
			LSAppendStr(Data, PadspaceL(MarkSheet^.TapeRef,Tab[1]));

			{overall sales ess/des scores}
			WE := MarkSheet^.GetAvSalesEssScore; PercSE := PercSE + WE;
			WD := MarkSheet^.GetAvSalesDesScore; PercSD := PercSD + WD;
			LSAppendStr(Data, PadSpaceL(N2Str(WE),Tab[2])+PadSpaceL(N2Str(WD),Tab[3]));

			{overall non-sales ess/des scores}
			WE := MarkSheet^.GetAvNonSalesEssScore; PercE := PercE + WE;
			WD := MarkSheet^.GetAvNonSalesDesScore; PercD := PercD + WD;
			LSAppendStr(Data, PadSpaceL(N2Str(WE),Tab[4])+PadSpaceL(N2Str(WD),Tab[5]));

			LSAppendStr(Data, PadSpaceL(N2Str(MarkSheet^.ManPerc), Tab[6]));
			PercMan := PercMan + MarkSheet^.ManPerc;

			LSAppendStr(Data,  PadSpaceL(N2Str(MarkSheet^.StyPerc),Tab[7])+EndLine);
			PercSty := PercSty + MarkSheet^.StyPerc;

			inc(NumSheets);

			{run through criteria collection setting up used headers}
			for P := 0 to MarkSheet^.Marks^.Count-1 do begin
				Scorer := PScorer(MarkSheet^.Marks^.At(P));
				if pos(Scorer^.Disc, HeaderLine)=0 then begin
					if Scorer^.Ess.Use or Scorer^.Des.Use then
						HeaderLine := HeaderLine + Scorer^.Disc+' ';
				end;
			end;

			dispose(Marksheet, done);
			MarkSheet := PMarkSheet(HookFile^.GetPrevJimmy);
		end;
		FileAdmin(fiHooks)^.LogOff;

		{totals}
		if NumSheets=0 then begin
			LSAppendStr(Data, 'NO MARK SHEETS!');
		end else begin
			PercE := PercE div NumSheets;
			PercD := PercD div NumSheets;
			PercSE := PercSE div NumSheets;
			PercSD := PercSD div NumSheets;
			PercMan := PercMan div NumSheets;
			PercSty := PercSty div NumSheets;
		end;

		LSAppendStr(Data, '-------------------------------------------------'+EndLine);
		LSAppendStr(Data,  'Overall'
											+PadSpaceL(N2Str(PercSE),Tab[2]+Tab[1]-length('Overall'))+PadSpaceL(N2Str(PercSD),Tab[3])
											+PadSpaceL(N2Str(PercE), Tab[4])+PadSpaceL(N2Str(PercD), Tab[5])
											+PadSpaceL(N2Str(PercMan),Tab[6])+PadSpaceL(N2Str(PercSty),Tab[7])+EndLine);

{		SetSelect(0, Buflen, True);{}
	end;
	ThinkingOff;


	if JimmyID = -1 then begin

		ThinkingOn('Creating report');

		{--- create new letter jimmy -------}
		Param.ListView := nil;
		Param.ForWho := PJimmyEditBox(Owner)^.Jimmy^.RecNo;
		Param.FocusedID := -1;
		JImmy := Create(srType, @Param);

		{add results to new report}
		PLetter(Jimmy)^.header := 'MARKSRPT';
		PLetter(Jimmy)^.StdForm := 'MARKSRPT';

		{these should not hook/etc, here only to provide route for formcodes/etc}
		PLetter(Jimmy)^.ToWho :=	PAssessment(PJimmyEditBox(Owner)^.Jimmy)^.StudentID;
		PLetter(Jimmy)^.ReWho :=	PAssessment(PJimmyEditBox(Owner)^.Jimmy)^.RecNo;

		PLetter(Jimmy)^.EditorType := edInternal;

		{Std form to consist of specified headers... a little nicety...}
		Assign(FormFile, Formspath+'MARKSRPT.FRM');
		rewrite(FormFile);

		HeaderLine := delspaceR(HeaderLine);
		while HeaderLine<>'' do
			AddHeader(ucase(ExpandScode(scDisciplines, SplitByWord(HeaderLine)))); {see above}

		AddHeader('MANNER & STYLE'); {see above}

		close(FormFile);

		ThinkingOff;

	end else begin
		Jimmy := GetJimmy(JimmyID);
	end;

	{auto edit}
{	Event.What := evKeyDown;
	Event.KeyCode := kbEnter;
	QueueEvent(Event);{}


	if Jimmy<>nil then
		Jimmy^.Edit(Owner, @Self); {does editbody}

	Assessment^.ReportID := JimmyID; {set so we can now do a print straight away...}

	Jimmy := nil;

	DrawState(False);
end;


{===== ASSESSMENT EDIT BOX =====================================}
procedure TAssessment.MakeEditBox(var EditBox : PEditBox; Caller : PView);
var R : TRect;
		MarkList : PView;

begin
	{Create box}
	R.Assign(0, 0, 48, 16); {Size of box}
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Assessment '+GetJimmyIDName(StudentID, naDisplay, 0),Caller, @Self));

	with EditBox^ do begin
		inherited MakeEditBox(EditBox,Caller);

		{student - name in title, above}
		Insert(New(PSkipBytes, init(4)));
{		InsTitledField(8, 1, 20, 1, '', New(PInputHookedJimmy, init(R, 20, hkStudents, lsStudents, srStudent, -1)));
		Current^.SetState(sfDisabled, True);{}

		InsTitledField(9, 1, 10, 1, '~D~ate', New(PinputDate, init(R)));
		{$IFDEF kusers}InsTitledField(9, 2, 20, 1, '~B~y', 		New(PinputDirectory, init(R, 20, fiUserIdx, lsUsers, '')));
		{$ELSE}        InsTitledField(9, 2, 20, 1, '~B~y', 		New(PinputDirectory, init(R, 20, fiCatDirIdx, lsDirectory, 'STA')));
		{$ENDIF}

		{$IFDEF fixit}
			Insert(New(PSKipBytes, init(4))); {report id}
			R.XYLD(10, Size.Y-1, 6, 1); Insert(New(PInputLint, init(R,7))); AddLabel('Marks Hk', Current);
		{$ENDIF}

		{marks list}
		InsTitledField(9, 4, 20,11, '~M~arks',
										New(PDlgHookView,	Init(R, lsMarksheets, 0, hkMarksheets, @Self,PJImmyEditBox(EditBox))));
		Insert(PDlgHookView(Current)^.VSCrollBar);
		PDlgHookView(Current)^.ColHeader := 'Call  Ess Des  Man Sty';
		MarkList := Current;

		Insert(New(PPrintRptButton, Init(34, Size.Y-11, '~P~rint Rpt', cmNone, bfNormal, nil)));{}

		Insert(New(PEditRptButton, Init(34, Size.Y-9, '~E~dit Rpt', srReport,@Self)));{}
		Insert(New(PGraphButton, 	Init(35, Size.Y-7, '~G~raph', cmNone, bfNormal, nil)));

		{-- Buttons --}
		Insert(New(PJimmyOKButton, 			Init(35,Size.Y-5, @Self)));
		Insert(New(PjimmyCancelButton, 	init(35,Size.Y-3, @Self)));

		EndInit;
	end;

	if Ptr2Marksheets<>-1 then MarkList^.Focus;


end;


{--- Viewing -----}
function TAssessment.DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string;
begin
	case lsType of
		lsAssessments : DisplayLine := Date.Digit8+' By '+GetJimmyIDName(ByID, naRef,0);
	else
		DisplayLine := 'TAssessment.DisplayLine not defined for this lstype';
	end;
end;

function TAssessment.GetName(naType : byte; Maxlen : integer) : string;
begin
	GetName := Date.Digit8+' A''ment for '+GetJimmyIDName(StudentID, naRef, 0);
end;

{--- Printing ----}
procedure TAssessment.SetFormCodes(const FormCodes: PFormCodeCollection);
begin
	inherited SetFormCodes(formCodes);

	with FormCodes^ do begin
		SetDate('DT', Date);
		Insert(New(PJimmyFormCode, init('STUDENT', StudentID)));
		Insert(New(PJimmyFormCode, init('BY', ByID)));

		Insert(New(PJimmyFormCode, init('REPORT', ReportID)));
	end;
end;

{--- Database ----}
function TAssessment.RecSize : word;  {space to be reserved in jimmy file}
begin RecSize := 50; end;

function TAssessment.srType : word;
begin srType := srAssessment; end;

const
	 {--- Required for Stream ----}
	 RAssessment : TStreamRec = (
		 ObjType : srAssessment;
		 VmtLink : Ofs(TypeOf(TAssessment)^);
		 Load : @TAssessment.Load;
		 Store : @TAssessment.Store
	 );


constructor TAssessment.Load(var S : TDataStream);
var Ver : byte;
begin
	S.Read(Ver, 1);
	case Ver of
		1 : begin
			inherited Load(S);

			S.Read(StudentID, 4);
			Date.Load(S);
			S.Read(ByID, 4);

			S.Read(ReportID, 4);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not recognised'#13#10'TAssessment.Load',mfError,hcNoContext);
		fail;{}
	end;
end;

procedure TAssessment.StoreFields(var S : TDataStream);
var Ver : byte;
begin
	Ver :=1; S.Write(Ver, 1);
	inherited StoreFields(S);

	S.Write(StudentID, 4);
	Date.Store(S);
	S.Write(ByID, 4);

	S.Write(reportID, 4);
end;


{--- Hooking on others -----}
function TAssessment.NumhkTypes;
begin NumhkTypes := 1; end; {hkMarkSeets}

procedure TAssessment.GetHookOn(const hkType : byte; var HookRec : PLongint);
begin
	inherited GetHookOn(hkType, HookRec);
	case hktype of
		hkMarkSheets : HookRec := @Ptr2MarkSheets;
	end;
end;

{-- Hooking to others -----}
function TAssessment.NumHookTo;
begin NumHookTo := 1; end; {only hooked to company's history}

{for returning which jimmys ID's this jimmys should be hooked *to*}
procedure TAssessment.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID,SubHookToID, hkType, Key);
	case htType of
		1 : begin
			HookToID := @StudentID;
			hkType := hkAssessments;
			Key := -Date.Days; {reverse date}
		end;
	end;
end;


{******************************************************
 ***                                                ***
 ***            MARK SHEET                          ***
 ***                                                ***
 ******************************************************}

constructor TMarkSheet.Init;
var Assessment : PAssessment;
		Student : PStudent;

begin
	inherited Init;
	AssessmentID := -1;
	CourseID := -1;
	Course := nil;

	if Param<>nil then begin
		{need courseid for criteria - follow back from assessment-student-course}
		AssessmentID := Param^.ForWho;
		Assessment := PAssessment(GetJimmy(AssessmentID));
		if Assessment<>nil then begin
			Student := PStudent(GetJimmy(Assessment^.StudentID));
			if Student<>nil then begin
				Course := PCourse(GetJimmy(Student^.CourseID));
				CourseID := Course^.RecNo;
				dispose(Student, done);
			end;
			dispose(Assessment, done);
		end;
	end;

	if Course=nil then begin
		ProgramWarning('No course set',hcNoContext);
		fail;
	end else begin
		if Course^.Criteria^.Count=0 then begin
			ProgramWarning('No criteria set for course'#13'Have you saved the course?',hcNoContext);
			dispose(Course, done);
			fail;
		end;
	end;

	RadioData := 0;

end;


procedure TMarkSheet.CommonInit;
begin
	inherited CommonInit;
	Course := nil; {though should be set in load/init}
	New(Marks, init(10,5));
end;

destructor TMarkSheet.Done;
begin
	dispose(Course, done);
	dispose(Marks, done);
	inherited Done;
end;

function TMarkSheet.DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string;
begin
	case lsType of
		lsMarkSheets : begin
			DisplayLine := Setlength(TapeRef,5)
								+PadSpaceL(N2Str(GetAvEssScore('', False)),4)
								+PadSpaceL(N2Str(GetAvDesScore('', False)),4)
								+PadSpaceL(N2Str(ManPerc),5)
								+PadSpaceL(N2Str(StyPerc),4);
		end;
	else
		DisplayLine := 'TMarksheet.DisplayLine not defined for this lstype';
	end;
end;

{******************************************************
 ***         MARK SHEET - EDIT                      ***
 ******************************************************}

{--- extended check box - returns longint for more options ----}
type
	PLIntCheck = ^TLintCheck;
	TLIntCheck = object(TCheckBoxes)
		procedure GetData(var Rec); virtual;
		procedure SetData(var Rec); virtual;
		function DataSize : word; virtual;
	end;

procedure TLintCheck.GetData;
begin longint(rec) := Value; end;

procedure TLintCheck.SetData;
begin Value := longint(rec) end;

function TLintCheck.Datasize;
begin Datasize := 4; end;

{--- Mark all button - marks all items in check box -----------}
type
	PAllButton = ^TAllButton;
	TAllButton = object(Tourbutton)
		CheckBoxes : PCheckBoxes;
		constructor Init(X,Y : longint; NCheckBoxes : PCheckBoxes);
		procedure Press; virtual;
	end;

constructor TAllButton.Init;
begin
	inherited Init(X,Y, '~A~ll', cmNone, bfNormal, nil);
	CheckBoxes := NCheckBoxes;
end;

procedure TAllButton.Press;
var L : longint;
begin
	DrawState(True); {pressed}
	L := Exp2(CheckBoxes^.Strings.Count)-1; {set to exactly all (ie only options displayed}
	L := L and CheckBoxes^.EnableMask; {enabled only}
	CheckBoxes^.SetData(L);
	CheckBoxes^.DrawView;
	DrawState(False);
end;

{gets marker char for ess/des}
function GetMarkerChar(Scorer : PSCorer) : char;
begin
	if Scorer=nil then
		GetMarkerChar := ' '
	else
		if Scorer^.Ess.Use then
			if Scorer^.Des.Use then
				GetMarkerChar := '*'
			else
				GetMarkerChar := #7
		else
			if Scorer^.Des.Use then
				GetMarkerChar := #9
			else
				GetMarkerChar := ' ';
end;


type
	PMarkButton = ^TMarkButton;
	TMarkButton = object(Tourbutton)
		DiscRadio : PERadioButtons;
		Ess : boolean;
		constructor Init(X,Y : longint; NDiscRadio : PERadioButtons; NEss : boolean);
		procedure Press; virtual;
	end;

constructor TMarkButton.Init;
begin
	if NEss then
		inherited Init(X,Y, '~E~ssential', cmNone, bfNormal, nil)
	else
		inherited Init(X,Y, '~D~esirable', cmNone, bfNormal, nil);
	DiscRadio := NDiscRadio;
	Ess := NEss;
end;

procedure TMarkButton.Press;
var EditBox : PEditBox;
		SItem : PSitem;
		Mark,DisBitMap : longint;
		ActionCollection : PSCodeCollection;
		R : TRect;
		Event : TEvent;
		CheckBoxes : PCheckBoxes;
		MarkSheet : PMarkSheet;
		CriteriaScorer, MarkScorer : PScorer;
		Control : word;
		N,P : word;
		S : String;
		RadioString : PString;

	procedure BuildSItem(SCode : PSCodeItem); far;
	begin
		AddSItem(Sitem, copy(Scode^.Description^,1,32));
	end;{}

begin
	MarkSheet := PMarkSheet(PJimmyEditBox(Owner)^.Jimmy);

	{locate discipline}
	DiscRadio^.GetData(P); {gets which discipline by index}

	{get criteria scorer - which to make available}
	CriteriaScorer := PScorer(MarkSheet^.Course^.Criteria^.At(P));

	if (Ess and (CriteriaScorer^.Ess.BitMap=0))
			or ((not Ess) and (CriteriaScorer^.Des.BitMap=0)) then exit;

	DrawState(True); {pressed}

	{check boxes - to keep mark same bitmap pattern as ess & desbitmaps, do
	complete scodes but de-select ones not marked}
	{work out check box sitems}
	SItem := nil;
	ActionCollection := NewActionCollection(CriteriaScorer^.Disc);
	ActionCollection^.LoadCodes(lkIgnore);
	ActionCollection^.ForEach(@BuildSItem);
	dispose(ActionCollection, done);
	N := (NumSitems(SItem)+1) div 2;

	{disable ones ot marked in criteria bitmaps}
	if Ess then begin
		{essential button}
		DisBitMap := not CriteriaScorer^.Ess.BitMap;
		S := 'Essential';
	end else begin
		DisBitMap := not CriteriaScorer^.Des.BitMap;
		S := 'Desirable';
	end;

	{build box}
	R.Assign(0,0,78,N+6);
	CentreOnView(R, Owner);
	EditBox := New(PEditBox, init(R, S+' '+ExpandSCode(scDisciplines, CriteriaScorer^.Disc), Owner));

	with EditBox^ do begin
		InsTitledField(2, 2, 72, N, '', New(PLIntCheck, init(R, Sitem)));
		CheckBoxes := PCheckBoxes(Current);
		CheckBoxes^.EnableMask := not DisBitMap; {make only that one enabled}
		while (Exp2(CheckBoxes^.Sel) and DisBitMap) <> 0 do inc(CheckBoxes^.Sel);

		Insert(new(PAllButton, init(10, Size.Y-3, CheckBoxes)));

		InsOKButton(50, Size.Y-3, nil);
		InsCancelButton(60, Size.Y-3);

		EndInit;
	end;

	{set marks into views - which ones have been marked}
	MarkScorer 		 := PScorer(MarkSheet^.Marks^.FindItem(CriteriaScorer^.Disc));
	if MarkScorer<>nil then
		if Ess then
			Mark := MarkScorer^.Ess.Bitmap
		else
			Mark := MarkScorer^.Des.BitMap
	else
		Mark := 0;

	CheckBoxes^.SetData(Mark);
	Control := Desktop^.execview(EditBox);

	if Control=cmOK then begin
		CheckBoxes^.GetData(mark);
		if MarkScorer=nil then begin
			New(MarkScorer, init);
			MarkScorer^.Disc := CriteriaScorer^.Disc;
			MarkSheet^.Marks^.Insert(MarkScorer);
		end;
		if Ess then begin
			MarkScorer^.Ess.BitMap := Mark {and CriteriaScorer^.Ess.BitMap{};
			MarkScorer^.Ess.Use := True;
		end else begin
			MarkScorer^.Des.BitMap := Mark {and CriteriaScorer^.Des.BitMap{};
			MarkScorer^.Des.Use := True;
		end;
	end else
		if MarkScorer<>nil then begin
			{cancel - mark as don't use}
			if Ess then
				MarkScorer^.Ess.Use := False
			else
				MarkScorer^.Des.Use := False;
		end;

	{change text on discipline sitems to mark .use status...}
	if MarkScorer<>nil then begin
		RadioString := DiscRadio^.Strings.At(P);
		RadioString^[1] := GetMarkerChar(MarkScorer);
		DiscRadio^.DrawView;
	end;

	dispose(Editbox, done);

	Drawstate(False);  {unpress}

	{move on to mark next discipline}
	if not Ess then begin
		Event.What := evKeyDown;
		Event.KeyCode := kbDown;
		QueueEvent(Event);
	end;
end;

{--- Editing ----}
procedure TMarkSheet.MakeEditBox(var EditBox : PEditBox; Caller : PView);
var R : TRect;
		B,N : byte;
		P : word;
		SItem : PSitem;
		DiscRadio : PERadioButtons;

	procedure BuildSItem(scorer : PScorer); far;
	begin
		AddSItem(Sitem, GetMarkerChar(Marks^.FindItem(Scorer^.Disc))
										+Copy(ExpandSCode(scDisciplines, Scorer^.Disc),1,32));
	end;{}

begin
	{set up radio buttons for disciplines}
	SItem := nil;
	Course^.Criteria^.ForEach(@BuildSitem);
	N := (NumSitems(SItem)+1) div 2;

	{Create box}
	R.Assign(0, 0, 78, 7+N); {Size of box}
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Marking Sheet',Caller, @Self));

	with EditBox^ do begin
		inherited MakeEditBox(EditBox,Caller);

		{Display Assessment}
		InsTitledField(1, 1, 20, 1, '',New(PInputHookedJimmy, init(R, 20, hkAssessments, lsAssessments, srAssessment, -1)));
		Current^.SetState(sfDisabled, true);
		Insert(New(PSkipBytes, init(4))); {skip Courseid}

		InsTitledField(50, 1,  5, 1, 'Call Re~f~', New(PInputELine, init(R, 5)));
		PInputELine(Current)^.MustInput := True;

		{radio buttons}
		InsTitledField(2, 3, 72, N, '', New(PERadioButtons, init(R, Sitem)));
		DiscRadio := PERadioButtons(Current);

		InsTitledField(15, Size.Y-3, 3, 1, 'M~a~nnerism %', New(PInputBytePerc, init(R,3)));
		InsTitledField(15, Size.Y-2, 3, 1, '~S~tyle %', 		New(PInputBytePerc, init(R,3)));

		Insert(New(PSkipBytes, init(sizeof(String)))); {skip criteria line}

		{-- Buttons --}
		Insert(New(PMarkButton, init(22, Size.Y-3, DiscRadio,True)));
		Insert(New(PMarkButton, init(36, Size.Y-3, DiscRadio,False)));

		Insert(New(PJimmyOKButton, Init(50,Size.Y-3, @Self)));
{		POurButton(Current)^.amDefault := False; {mark button is default}
		Insert(New(PjimmyCancelButton, init(60,Size.Y-3, @Self)));

		EndInit;
		if TapeRef<>'' then SelectNext(False); {if taperef already set, move on to marking buttons}
	end;


end;


{--- Printing ----}
procedure TMarkSheet.SetFormCodes(const FormCodes: PFormCodeCollection);
begin
	inherited SetFormCodes(formCodes);

	with FormCodes^ do begin
		Insert(New(PJimmyFormCode, Init('ASS', AssessmentID)));
		Insert(New(PJimmyFormCode, Init('COURSE', CourseID)));
		SetStr('REF', TapeRef);
		SetStr('MAN', N2Str(ManPerc));
		SetStr('STY', N2Str(StyPerc));
	end;
end;

{--- Database ----}
function TMarkSheet.RecSize : word;  {space to be reserved in jimmy file}
begin RecSize := 300; end;

function TMarkSheet.srType : word;
begin srType := srMarkSheet; end;

const
	 {--- Required for Stream ----}
	 RMarkSheet : TStreamRec = (
		 ObjType : srMarkSheet;
		 VmtLink : Ofs(TypeOf(TMarkSheet)^);
		 Load : @TMarkSheet.Load;
		 Store : @TMarkSheet.Store
	 );

constructor TMarkSheet.Load(var S : TDataStream);
var Ver,B : byte;
		OldMarks : string;
		MarkScorer,CriteriaScorer : PScorer;
begin
	S.Read(Ver, 1);
	case Ver of
		1 : begin
			inherited Load(S);

			S.Read(AssessmentID, 4);
			S.Read(CourseID, 4);

			OldMarks := S.ReadStr;
			ConvertOldBitmap(OldMarks, Marks);

			TapeRef := S.ReadStr;

			S.Read(ManPerc, 1); S.Read(B,1);
			S.Read(StyPerc, 1); S.Read(B,1);

		end;
		2 : begin
			inherited Load(S);

			S.Read(AssessmentID, 4);
			S.Read(CourseID, 4);

			TapeRef := S.ReadStr;

			S.Read(ManPerc, 1); S.Read(B,1);
			S.Read(StyPerc, 1); S.Read(B,1);

			Marks^.LoadCodes(S);
		end;
		3 : begin
			inherited Load(S);

			S.Read(AssessmentID, 4);
			S.Read(CourseID, 4);

			TapeRef := S.ReadStr;

			S.Read(ManPerc, 1);
			S.Read(StyPerc, 1);

			Marks^.LoadCodes(S);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not recognised'#13#10'Loading TMarkSheet',mfError,hcNoContext);
		fail;{}
	end;

	RadioData := 0;

	{load Course line}
	Course := PCourse(GetJImmy(CourseID));

	if Course = nil then begin
		ProgramError('Could not load course '+N2Str(CourseID)+#13#10'TMarkSheet.Load',hcNoContext);
		fail;
	end;

	if Ver =1 then begin
		{run through marks splitting ess/des}
		For B := 0 to Marks^.Count-1 do begin

			MarkScorer := PScorer(Marks^.At(B));
			CriteriaScorer := PScorer(Course^.Criteria^.FindItem(MarkScorer^.Disc));

			{old marks had all marks in ess bitmap}
			MarkScorer^.Des.BitMap := MarkScorer^.Ess.BitMap and CriteriaScorer^.Des.Bitmap;
			MarkScorer^.Ess.BitMap := MarkScorer^.Ess.BitMap and CriteriaScorer^.Ess.Bitmap;

			MarkScorer^.Des.Use := MarkScorer^.Des.BitMap<>0;
			MarkScorer^.Ess.Use := MarkScorer^.Ess.BitMap<>0;

{			DebugNote('Converting '
								+PadSpaceR(N2Str(B)+' '+MarkScorer^.Disc+' '+CriteriaScorer^.Disc,10)
								+Binary(CriteriaScorer^.Ess.BitMap)+' '+Binary(CriteriaScorer^.Des.BitMap)+' '
								+Binary(MarkScorer^.Ess.BitMap)+' '+Binary(MarkScorer^.Des.BitMap));{}

		end;
	end;

end;

procedure TMarkSheet.StoreFields(var S : TDataStream);
var Ver,B : byte;
begin
	Ver :=3; S.Write(Ver, 1);
	inherited StoreFields(S);

	S.Write(AssessmentID, 4);
	S.Write(CourseID, 4);

	S.WriteStr(@TapeREf);

	S.Write(ManPerc, 1);
	S.Write(StyPerc, 1);

	Marks^.Store(S);
end;


{-- Hooking to others -----}
function TMarkSheet.NumHookTo;
begin NumHookTo := 1; end; {only hooked to company's history}

{for returning which jimmys ID's this jimmys should be hooked *to*}
procedure TMarkSheet.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID,SubHookToID, hkType, Key);
	case htType of
		1 : begin
			HookToID 	:= @AssessmentID;
			hkType 		:= hkMarkSheets;
			Key 			:=S2Num(TapeRef);
		end;
	end;
end;




{**********************************************************
 ***                                                    ***
 ***                SCORING                             ***
 ***                                                    ***
 **********************************************************}
{Put this in minilb at some point}
function NumBits(const L : longint) : byte;  {counts number of bits set in L}
var Bit,Count : byte;
begin
	Bit := 0; Count := 0;
	while Bit<31 do begin
		if (L and Exp2(Bit))>0 then inc(Count);
		inc(Bit);
	end;
	NumBits := Count;
end;

{---- SCORE FOR A PARTICULAR DISCIPLINE ---------------------}
function TMarkSheet.GetEssDiscScore;
var	CriteriaScorer,MarkScorer : PScorer;
begin
	CriteriaScorer := Course^.Criteria^.FindItem(Disc);
	MarkScorer := Marks^.FindItem(Disc);
	GetEssDiscScore := 0;

	if (MarkScorer<>nil) and (CriteriaScorer<>nil) then
		if NumBits(CriteriaScorer^.Ess.Bitmap)=0 then
			ProgramError('trying to .getessdiscscore with 0 criteria bitmap',hcNoContext)
		else
			GetEssDiscScore :=
				NumBits(MarkScorer^.Ess.Bitmap and CriteriaScorer^.Ess.Bitmap)*100
				div NumBits(CriteriaScorer^.Ess.Bitmap);
end;

function TMarkSheet.GetDesDiscScore;
var	CriteriaScorer,MarkScorer : PScorer;
begin
	CriteriaScorer := Course^.Criteria^.FindItem(Disc);
	MarkScorer := Marks^.FindItem(Disc);
	GetDesDiscScore := 0;

	if (MarkScorer<>nil) and (CriteriaScorer<>nil) then
		if NumBits(CriteriaScorer^.Des.Bitmap)=0 then
			ProgramError('trying to .getdesdiscscore with 0 criteria bitmap',hcNoContext)
		else
			GetDesDiscScore :=
				NumBits(MarkScorer^.Des.Bitmap and CriteriaScorer^.Des.Bitmap)*100
				div NumBits(CriteriaScorer^.Des.Bitmap);
end;



{------ OVERALL AVERAGE SCORE FOR CALL ----------------------}
function TMarkSheet.GetAvEssScore(Check : string; Yes : boolean) : word;
var P : integer;
		Scorer : PScorer;
		Total, Num : word;
begin
	Total := 0; Num := 0;

	for P := 0 to Marks^.Count-1 do begin
		Scorer := PScorer(Marks^.At(P));
		if Scorer^.Ess.Use then
			if (Check='')
				or ((ucase(copy(ExpandSCode(scDisciplines, Scorer^.Disc),1,5))=Check) and Yes)
				or ((ucase(copy(ExpandSCode(scDisciplines, Scorer^.Disc),1,5))<>Check) and not Yes) then

				if PScorer(Course^.Criteria^.FindItem(Scorer^.Disc))^.Ess.Bitmap <>0 then begin
					Total := Total + GetEssDiscScore(Scorer^.Disc);
					inc(Num);
				end;
	end;

	if Num = 0 then Num := 1;
	GetAvEssScore := (Total) div Num;
end;

function TMarkSheet.GetAvDesScore(Check : string; Yes : boolean) : word;
var P : integer;
		Scorer : PScorer;
		Total, Num : word;
begin
	Total := 0; Num := 0;

	for P := 0 to Marks^.Count-1 do begin
		Scorer := PScorer(Marks^.At(P));
		if Scorer^.Des.Use then
			if (Check='')
				or ((ucase(copy(ExpandSCode(scDisciplines, Scorer^.Disc),1,5))=Check) and Yes)
				or ((ucase(copy(ExpandSCode(scDisciplines, Scorer^.Disc),1,5))<>Check) and not Yes) then

				if PScorer(Course^.Criteria^.FindItem(Scorer^.Disc))^.Des.Bitmap <>0 then begin
					Total := Total + GetDesDiscScore(Scorer^.Disc);
					inc(Num);
				end;
	end;

	if Num = 0 then Num := 1;
	GetAvDesScore := (Total) div Num;
end;



{---- OVERALL SALES DISCIPLINE SCORE ------------------------}
function TMarkSheet.GetAvSalesEssScore : word;
begin
	GetAvSalesEssScore := GetAvEssScore('SALES', True);
end;

function TMarkSheet.GetAvSalesDesScore : word;
begin
	GetAvSalesDesScore := GetAvDesScore('SALES', True);
end;


{---- OVERALL NON-SALES DISCIPLINE SCORE ---------------------}
function TMarkSheet.GetAvNonSalesEssScore : word;
begin
	GetAvNonSalesEssScore := GetAvEssScore('SALES', False);
end;

function TMarkSheet.GetAvNonSalesDesScore : word;
begin
	GetAvNonSalesDesScore := GetAvDesScore('SALES', False);
end;


{******************************************
 ***       MAINTAINING ACTION CODES     ***
 ******************************************}
procedure MaintainActionCodes; far;
var EditBox : PEditBox;
		R : Trect;
		Control : word;
		Code : TSCode;
		ActionCodes : PSCodeCollection;

begin
	R.Assign(0,0,55,7);
	New(EditBox, init(R, 'Maintaining Action Codes',nil));

	with EditBox^ do begin
		Options := Options or ofCentered;

		InstitledField(13, 2,38, 1, 'Discipline',   New(PInputScode, init(R,scDisciplines)));
		PInputEline(Current)^.MustInput := True;

		InsOKButton(25, 4, @Code);
		InsCancelButton(35, 4);

		EndInit;
	end;

	Control := Desktop^.ExecView(EditBox);

	if Control = cmOK then begin
		ActionCodes := NewActionCollection(Code);
		ActionCodes^.ExecuteList(nil);
		dispose(ActionCodes, done);
		MaintainActionCodes; {and go around again}
	end;

	dispose(EditBox, done);

end;

{**************************************************
 ***                                            ***
 ***             REPORT                         ***
 ***                                            ***
 **************************************************}
function  TReport.Edit(const Caller,AcceptorView : PView) : word;
var Command : Word;
begin
	Command := EditBody;  {does storeself too}
	if Command = cmOK then
		Message(AcceptorView, evBroadCast, cmAcceptJimmy, @RecNo);

	Free;
end;



{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}

const
	{--- Required for Stream ----}
	RReport : TStreamRec = (
		ObjType : srReport;
		VmtLink : Ofs(TypeOf(TReport)^);
		Load : @TReport.Load;
		Store : @TReport.Store
	);


function TReport.srType;
begin srType := srReport; end;

{blank hooking to options - not designed to be hooked to anything}
procedure TReport.GetHookTo;
begin
	TJimmy.GetHookTo(htType, HookToID,SubHookToID, hkType, Key);
end;

function TReport.GetPrintType(var PrintType : TJimmyPrintType; PrintAs : PSItem; PrintAsLink : pointer) : word;
begin
	PrintType.PlusLabel := False;
	GetPrintType := inherited GetPrintType(PrintType, PrintAs, PrintAsLink);
end;



{******************************************
 ***         NEW MARK SHEET             ***
 ******************************************}
{Actually just gives shortcut access to student list, can then use
F4 w/out hitting locking bottleneck problem through directory item}

procedure FindStudent; far;
var EditBox : PEditBox;
		R : TREct;
		Control : word;
		Course : PCourse;
		CoyCourseLinker : PInputLinker;
		InputRec : record
			CoyID : longint;
			CourseID : longint;
		end;
		ChainWindow : PListWindow;

begin
	R.ASsign(0,0,33,8);
	New(EditBox, init(R, 'Lookup Students',nil));

	New(CoyCourseLinker, init(@LinkCoyCourse, EditBox)); {uses same link method as tstudent.makeeditbox}

	with EditBox^ do begin
		Options := Options or ofCentered;

		InsTitledField(10, 2, 20, 1, 'Company', New(PInputDirectory, init(R, 26, fiFullDirIdx, lsDirectory, '')));
		CoyCourseLinker^.SetSourceView(Current, 1);
		InsTitledField(10, 3, 20, 1, 'Course', New(PInputHookedJimmy, init(R, 26, hkHistory, lsHistory, srCourse, -1)));
		CoyCourseLinker^.SetTargetView(Current, 1);
		PINputELine(Current)^.MustInputToClose := True;

		InsOKButton(9, 5, @InputRec);
		InsCancelButton(20, 5);
		EndInit;
	end;

	Control := Desktop^.ExecView(EditBox);

	if Control = cmOK then begin
		{Start Student List}

		Course := PCourse(GetJimmy(InputRec.CourseID));

		{Set bounds for window}
		R.Assign(0,0,30,12);

		{Execute list}
		ChainWindow := NewJimmyHookWindow(R,
																			lsStudents,
																			0, {restrictions}
																			hkStudents,
																			Course, {parent}
																			nil);

		ChainWindow^.Options := ChainWindow^.Options or ofCentered;

		Desktop^.ExecView(ChainWindow);
		dispose(ChainWindow, done);

		dispose(Course, done);
	end;

	dispose(EditBox, done);

end;




{******************************************
 ***         UNIT INSTALLATION          ***
 ******************************************}
function NewStudent(P : pointer) : pointer; far;
begin NewStudent := New(PStudent, init(PJImmyInitParam(P))); end;

function CreateReport(P : pointer) : pointer; far;
begin CreateReport := New(PReport, init(P)); end;

{function NewCriteria(P : pointer) : pointer; far;
begin NewCriteria := New(PCriteria, init(PJImmyInitParam(P))); end;{}

function NewCourse(P : pointer) : pointer; far;
begin NewCourse := New(PCourse, init(PJImmyInitParam(P))); end;

function NewASSESSMENT(P : pointer) : pointer; far;
begin NewAssessment := New(PAssessment, init(PJImmyInitParam(P))); end;

function NewMarkSheet(P : pointer) : pointer; far;
begin NewMarkSheet := New(PMarkSheet, init(PJImmyInitParam(P))); end;

{unit initialisation procedure}
var B : byte;
begin
	{-- course --}
	RegisterJimmy(RCourse, NewCourse, lsHistory, '~C~ourse');{}

	RegisterSCodeType(scCourseType, 'KCOURSES.SC', 'Course Types', StdSCodeCreator);
	RegisterSCodeType(scDisciplines, 'DISCPLNS.SC', 'Disciplines', StdSCodeCreator);

	{-- students --}
	RegisterJimmy(RStudent, NewStudent, lsStudents, '~S~tudent');{}

	{-- Assessments --}
	RegisterJimmy(RAssessment, NewAssessment, lsAssessments, '~A~ssessment');{}

	{-- MarkSheet --}
	RegisterJimmy(RMarkSheet, NewMarkSheet, lsMarkSheets, '~M~ark Sheet');{}

	RegisterNewWithList(lsDesktop, '~M~arksheet', cmFindStudent);
	RegisterTask(DesktopTasks, cmFindStudent, @FindStudent);

	{maintaining action codes}
	RegisterTask(DesktopTasks, cmMaintainActionCodes, @MaintainActionCodes);

	{-- Report --}
	RegisterType(RReport);
	RegisterCreator(cmNewReport, CreateReport);
end.


