HPSHELL
Contents of this page
EDITORS.PAS
{************************************************}
{ }
{ UNIT EDITORS }
{ Copyright (c) 1992 Borland International }
{ Copyright (c) 1993-98 by Tom Wellige }
{ }
{ Part of HPShell }
{ Integrated Developing Environment }
{ for HP48 calculators }
{ }
{ Author: Tom Wellige }
{ E-Mail: wellige@t-online.de }
{ }
{ These sources can be freely used as long }
{ as their origin is stated in the }
{ resulting program (code *and* exe) }
{ }
{************************************************}
unit Editors;
[...]
procedure TEditor.ConvertText;
type
sw = record s1, s2: word; end;
var
Dlg : PDialog;
R : TRect;
P: PParser;
Control, HScroll : PView;
I: Word;
Switch: sw;
s1, s2: string;
Pos: word;
begin
Switch.s1:= $00; Switch.s2:= $00;
R.Assign(0,0,47,17);
New(Dlg, Init(R, GetString(436))); {'Text konvertieren'}
with Dlg^ do
begin
Options:= Options or ofCentered;
HelpCtx:= 41104;
R.Assign(5, 1, 42, 12);
Insert(New(P3D_Frame, Init(R)));
R.Assign(13,3,34,5);
Control := New(PRadiobuttons, Init(R,
NewSItem(GetString(431), {'~g~esamten Text'}
NewSItem(GetString(432),Nil)))); {'~m~arkierten Text'}
Insert(Control);
R.Assign(12,2,18,3); {'~T~ext:'}
Insert(New(PLabel, Init(R, GetString(433), Control)));
R.Assign(13,7,34,10);
Control := New(PRadiobuttons, Init(R,
NewSItem(GetString(437), {'~P~C zu HP'}
NewSItem(GetString(438), {'~H~P zu PC'}
NewSItem(GetString(439),Nil))))); {'~P~C zu PC'}
Insert(Control);
R.Assign(12,6,22,7); {'~R~ichtung'}
Insert(New(PLabel, Init(R, GetString(440), Control)));
R.Assign(3,14,16,16);
Control := New(PButton, Init(R, GetString(10), cmOK, bfDefault));
Insert(Control);
R.Assign(17,14,30,16);
Control := New(PButton, Init(R, GetString(13), cmHelp, bfNormal));
Insert(Control);
R.Assign(31,14,44,16);
Control := New(PButton, Init(R, GetString(12), cmCancel, bfNormal));
Insert(Control);
SelectNext(False);
end;
if Application^.ExecuteDialog(Dlg, @Switch) = cmOk then
begin
case Switch.s1 of
$00: s1:= GetString(441); {'gesamten Text'}
$01: s1:= GetString(442); {'markierten Text'}
end;
case Switch.s2 of
$00: s2:= 'PC -> HP';
$01: s2:= 'HP -> PC';
$02: s2:= 'PC -> PC';
end;
P:= nil;
ConvertDialog:= New(PConvertDlg, Init(@s1, @s2, cvManuell));
Desktop^.Insert(ConvertDialog);
Pos:= CurPtr;
if Switch.s1 = $00 then SetCurPtr(BufLen, 0);
case Switch.s1 of
$00: P:= new(PParser, Init(@self, Switch.s2 + 4, 0, BufLen));
$01: P:= new(PParser, Init(@self, Switch.s2 + 4, SelStart, SelEnd));
end;
if (Switch.s1 = $00) and (Pos <= BufLen) then
SetCurPtr(Pos, 0);
Desktop^.Delete(ConvertDialog);
Dispose(ConvertDialog, Done);
ConvertDialog:= nil;
if Assigned(P) then Dispose(P, Done);
end;
end;
procedure TEditor.SendText(ATitle: string; AHelpCtx: word);
var
Dlg : PDialog;
R : TRect;
Control, HScroll : PView;
I: Word;
Switch: word;
begin
Switch:= $00;
R.Assign(0,0,47,12);
Dlg:= New(PDialog, Init(R, ATitle));
with Dlg^ do
begin
Options:= Options or ofCentered;
HelpCtx:= AHelpCtx;
R.Assign(5, 1, 42, 7);
Insert(New(P3D_Frame, Init(R)));
R.Assign(13,3,34,5);
Control := New(PRadiobuttons, Init(R,
NewSItem(GetString(431), {'~g~esamten Text'}
NewSItem(GetString(432),Nil)))); {'~m~arkierten Text'}
Insert(Control);
R.Assign(12,2,21,3); {'~T~ext:'}
Insert(New(PLabel, Init(R, GetString(433), Control)));
R.Assign(3,9,16,11);
Control := New(PButton, Init(R, GetString(10), cmOK, bfDefault));
Insert(Control);
R.Assign(17,9,30,11);
Control := New(PButton, Init(R, GetString(11), cmHelp, bfNormal));
Insert(Control);
R.Assign(31,9,44,11);
Control := New(PButton, Init(R, GetString(12), cmCancel, bfNormal));
Insert(Control);
SelectNext(False);
end;
if Application^.ExecuteDialog(Dlg, @Switch) = cmOk then
begin
with SendRec^ do
begin
case Switch of
$00: begin
Option:= 2;
Size := BufLen;
Start := 0;
Stop := BufLen;
end;
$01: begin
Option:= 1;
Size := SelEnd - SelStart;
Start := SelStart;
Stop := SelEnd;
end;
end;
Editor:= @self;
end;
Message(Application, evBroadCast, cmSendRecord, SendRec);
end;
end;
procedure TEditor.Draw;
var i, s, ag, bg: word;
begin
if DrawLine <> Delta.Y then
begin
DrawPtr := LineMove(DrawPtr, Delta.Y - DrawLine);
DrawLine := Delta.Y;
end;
IsAString:= 0;
IsAList:= 0;
if (Delta.Y > 0) then
begin
s:= LineStart(DrawPtr)-1;
for i:= 0 to s do
if BufChar(i) = '"' then
inc(IsAString)
else
{ nur ausserhalb von Strings Ausschau nach Listen halten. }
if (IsAString mod 2 = 0) then
begin
if BufChar(i) = '{' then inc(IsAList);
if BufChar(i) = '}' then dec(IsAList);
end;
end;
DrawLines(0, Size.Y, DrawPtr);
end;
procedure TEditor.DrawLines(Y, Count: Integer; LinePtr: Word);
var
Color: Word;
B: array[0..MaxLineLength - 1] of Word;
begin
Color := GetColor($0201);
while Count > 0 do
begin
{ FormatLine(B, LinePtr, Delta.X + Size.X, Color);}
if (Delta.X+Size.X) > (LineEnd(LinePtr)-LineStart(LinePtr)) then
FormatLine(B, LinePtr, Delta.X + Size.X, Color) else
FormatLine(B, LinePtr, LineEnd(LinePtr)-LineStart(LinePtr)+1, Color);
if Displays and (not IsClipboard) then DrawDisplay(B, Y);
if SyntaxHighlight and (not IsClipboard) then
{ if (Delta.X+Size.X) >= (LineEnd(LinePtr)-LineStart(LinePtr)) then
DrawSyntax (B, Y, Delta.X + Size.X) else}
DrawSyntax (B, Y, LineEnd(LinePtr)-LineStart(LinePtr));
WriteBuf(0, Y, Size.X, 1, B[Delta.X]);
LinePtr := NextLine(LinePtr);
Inc(Y);
Dec(Count);
end;
end;
procedure TEditor.DrawDisplay(var B: array of word; Y: integer);
var
Color, Tmp: Word;
i: integer;
function IsSelected(w: word): boolean;
var Color: word;
begin
Color:= GetColor($0201);
if Hi(w) = Hi(Color) then IsSelected:= true else IsSelected:= false;
end;
function IsDisplayLine: boolean;
var
d: boolean;
Num: integer;
begin
d:= false;
Y:= Delta.Y + Y;
Num:= Y div (DisplayHight + DisplayDistance);
if Num = 0 then
if Y >= DisplayDistance then d:= true else d:= false
else
if Y >= (Num*(DisplayDistance+DisplayHight))+DisplayDistance then
d:= true else d:= false;
IsDisplayLine:= d;
end;
begin
if IsDisplayLine then
begin
Color:= GetColor($0304);
for i:= 0 to DisplayLength - 1 do
if not IsSelected(B[i]) then
begin
Tmp:= B[i] and $00FF;
Tmp:= (Hi(Color)*256) + Tmp;
B[i]:= Tmp;
end else
begin
Tmp:= B[i] and $00FF;
Tmp:= (Lo(Color)*256) + Tmp;
B[i]:= Tmp;
end;
end;
end;
procedure TEditor.DrawSyntax (var B: array of word; Y: integer; MaxX: word);
var
Pos, x1, x2: word;
c, clrString, clrComment, clrList, clrError: word;
s: TSyntaxString;
function IsString(w: word): boolean;
begin
IsString:= (w and $0F00) = clrString;
end;
function IsComment(w: word): boolean;
begin
IsComment:= (w and $0F00) = clrComment;
end;
function IsList(w: word): boolean;
begin
IsList:= (w and $0F00) = clrList;
end;
procedure ScanForStrings;
var i: word;
begin
for i:= 0 to MaxX do
begin
if Lo(B[i]) = ord('"') then
if (IsAString mod 2 = 0) then
begin
inc(IsAString); { String Anfang }
end else
begin
B[i]:= B[i] and $F0FF; { String beenden, " aber noch farbig }
B[i]:= B[i] or clrString;
inc(IsAString);
end;
if (IsAString mod 2 <> 0) then
begin
B[i]:= B[i] and $F0FF; { String farbig darstellen }
B[i]:= B[i] or clrString;
end;
end;
end;
procedure ReScanForStrings;
var i: word;
begin
for i:= 1 to MaxX do
if IsString(B[i]) and IsComment(B[i-1]) then
begin
B[i]:= B[i] and $F0FF;
B[i]:= B[i] or clrComment;
end;
end;
procedure ScanForComments;
var
i: word;
IsAComment: boolean;
begin
IsAComment:= false;
for i:= 0 to Delta.X + Size.X do
begin
if Lo(B[i]) = ord('@') then
if not IsString(B[i]) then
if (not IsAComment) then
begin
IsAComment:= true; { Kommentar Anfang }
end else
begin
B[i]:= B[i] and $F0FF; { Kommentar Ende, @ aber noch farbig }
B[i]:= B[i] or clrComment;
IsAComment:= false;
end;
if (not IsString(B[i])) and IsAComment then
begin
B[i]:= B[i] and $F0FF; { Kommentar farbig darstellen }
B[i]:= B[i] or clrComment;
end;
end;
end;
procedure ScanForLists;
function IsWhat(i: integer): integer;
begin
if i < 0 then IsWhat:= 0 else
if i = 0 then IsWhat:= 1 else
IsWhat:= 2;
end;
var
i: word;
begin
for i:= 0 to MaxX do
begin
if (not IsString(B[i])) and (not IsComment(B[i])) then
begin
case IsWhat(IsAlist) of
0: { kleiner Null }
begin
if Lo(B[i]) = ord('{') then
begin
B[i]:= B[i] and $00FF;
B[i]:= B[i] or clrError;
end;
if Lo(B[i]) = ord('}') then
begin
B[i]:= B[i] and $00FF;
B[i]:= B[i] or clrError;
end;
end;
1: { gleich Null }
begin
if Lo(B[i]) = ord('{') then
begin
B[i]:= B[i] and $F0FF;
B[i]:= B[i] or clrList;
inc(IsAList);
end;
if Lo(B[i]) = ord('}') then
begin
B[i]:= B[i] and $00FF;
B[i]:= B[i] or clrError;
dec(IsAList);
end;
end;
2: { groesser Null }
begin
B[i]:= B[i] and $F0FF;
B[i]:= B[i] or clrList;
if Lo(B[i]) = ord('{') then inc(IsAList);
if Lo(B[i]) = ord('}') then dec(IsAList);
end;
end;
end;
end;
end;
procedure PutColor(c, x1, x2: word);
var i: word;
begin
for i:= x1 to x2 do
begin
B[i]:= B[i] and $F0FF; { Keyword farbig darstellen }
B[i]:= B[i] or c;
end;
end;
function GetWord(var Pos, x1, x2: word): TSyntaxString;
var
i: word;
s: TSyntaxString;
begin
while IsComment(B[Pos]) or IsString(B[Pos]) or
IsList(B[Pos]) or (Lo(B[Pos]) = ord(' ')) do inc(Pos);
x1:= Pos;
while (not IsComment(B[Pos])) and
(not IsString(B[Pos])) and
(not IsList(B[Pos])) and
(Lo(B[Pos]) <> ord(' ')) and
(Lo(B[Pos]) <> 10) and
(Lo(B[Pos]) <> 13) and
(Pos < Delta.X+Size.X) do inc(Pos);
x2:= Pos-1;
s:= '';
if (x2 - x1) > SizeOf(TSyntaxString) then
x1:= x2 - SizeOf(TSyntaxString);
for i:= x1 to x2 do s:= s + chr(Lo(B[i]));
GetWord:= s;
end;
begin
{ Default-Werte }
clrComment:= $0100;
clrString := $0F00;
clrList := $0500;
clrError := $4F00;
{ Aktuelle Werte Laden }
SyntaxList^.GetColor('@Comments', clrComment);
SyntaxList^.GetColor('" Strings "', clrString);
SyntaxList^.GetColor('{ Lists }', clrList);
ScanForStrings; { Strings }
ScanForComments; { Kommentare }
ScanForLists; { Listen }
ReScanForStrings; { Strings innerhalb von Kommentaren oder Listen }
Pos := 0;
while Pos < Delta.X+Size.X do
begin
s:= GetWord(Pos, x1, x2);
if SyntaxList^.GetColor(s, c) then
PutColor(c, x1, x2);
end;
end;
[...]
HPTRANS.PAS
{************************************************}
{ }
{ UNIT HPTrans Transfer-Routinen }
{ Copyright (c) 1994-98 by Tom Wellige }
{ }
{ Part of HPShell }
{ Integrated Developing Environment }
{ for HP48 calculators }
{ }
{ Author: Tom Wellige }
{ E-Mail: wellige@t-online.de }
{ }
{ These sources can be freely used as long }
{ as their origin is stated in the }
{ resulting program (code *and* exe) }
{ }
{************************************************}
(* 28.04.95 Fehlermeldungen im Klartext hinzugefgt. *)
(* 01.05.95 Fehlermeldungen erweitert. *)
(* 01.05.95 CHECKIFFILESARETHERE: *)
(* - Fehler in Nummernberechnung entf. *)
(* - Abfrage hinzugefgt, ob umbenannt werden soll. *)
(* 14.05.95 Fehlerabfrage, ob w„hrend šbertragung ein Fehler aufge- *)
(* treten ist ( 0 < w < 256 ) *)
(* 28.06.95 DeleteHPHeaders: Check l„uft mittels Block-Fkt., so daá *)
(* er unabh„ngig von der Zeilenl„nge wird -> GROBs ! *)
(* DeleteBrqckets : Check l„uft mittels Block-Fkt., so daá *)
(* er unabh„ngig von der Zeilenl„nge wird -> GROBs ! *)
(* 08.12.98 MakeKermitFile: Anstelle von "*.*" bzw. "*." wird nun *)
(* pro Datei eine "send" Zeile eingefgt. *)
unit HPTrans;
{$O+,F+}
interface
uses
Dos, Objects, Drivers, App, Views, Dialogs, MsgBox,
MultiF, MsgObj, Tone,
TWApp, TWMsgBox, TWWindow, TWDialog, TWGlobal, TWCommon, TWDos,
HPGlobal, HPChars, HPProt, HPPort;
const
kmSend = 1;
kmSendBinary = 2;
kmReceive = 3;
kmReceiveBinary = 4;
(* ermittelt alle Files in beliebigem Verzeichnis *)
function GetFileList(d: string): PFileNames;
(* berprft Files nach Namesregeln fr HP *)
function CheckFileNames(List: PFileNames): boolean;
(* kopiert Files in beliebiges Verzeichnis *)
function CopyFiles(List: PFileNames; d: string): boolean;
(* l”scht alle Dateien im Verzeichnis *)
function DeleteFiles(d: string): boolean;
(* Fgt mehrere Dateien zu einer zusammen *)
(* gibt FALSE und FRESULT=0 zurck, wenn Speicherfehler auftritt. *)
function MergeFiles(var List: PFileNames; FName: string): boolean;
(* berprft, ob Datei schon vorhanden ist, und benennt ggf. um *)
procedure CheckIfFilesAreThere(var List: PFileNames; d: string);
(* konvertiert Files *)
function ConvertFiles(List: PFileNames; AOption: word): boolean;
(* l”scht HP-Header aus Dateien *)
function DeleteHPHeaders(List: PFileNames): boolean;
(* l”scht Programmklammern *)
function DeleteBrackets(List: PFileNames): boolean;
(* Liefert Aufrufparameter fr externes Protokoll zurck *)
function CalcExternalParameters(p: string): string;
(* Ruft KERLITE.EXE zum Senden auf *)
procedure SendKermitProtocol(binary: boolean; List: PFileNames);
(* Ruft KERLITE.EXE zum Empfangen auf *)
function ReceiveKermitProtocol(binary: boolean): boolean;
(* Ruft externes Protokoll zum Senden auf *)
procedure SendExternalProtocol;
(* Ruft externes Protokoll zum Empfangen auf *)
function ReceiveExternalProtocol: boolean;
(* Erzeugt MSKERMIT.INI Datei fr KERLITE.EXE *)
function MakeKermitFile(Option: word; List: PFileNames): boolean;
type
PHPInputLine = ^THPInputLine;
THPInputLine = object(TInputLine)
function Valid(Command: word): boolean; virtual;
end;
implementation
type
PWord = ^word;
(********************************************************************)
(** THPInputLine **)
(********************************************************************)
function THPInputLine.Valid(command: word): boolean;
var
Ok: boolean;
i: integer;
Event: TEvent;
begin
Ok:= true;
if length(Data^)>0 then
if not (command= cmCancel) then
begin
if not CheckObjectName(Data^) then
begin
Ok:= false;
OneStringRec:= Data;
{ Der Variablenname "%s" ist nach der HP48-Namenskonvention ungltig.}
FormatStr(ToFormatString, GetString(1312), OneStringRec);
ErrorBox(#3+ToFormatString, nil, mfOkBeep);
Event.What:= evCommand;
Event.Command:= 234; { Hilfefenster "Namengebung" }
Application^.PutEvent(Event);
Select;
end;
end;
if Ok then valid:= inherited Valid(Command) else valid:= false;
end;
(********************************************************************)
(** procedure SendKermitProtocol **)
(********************************************************************)
procedure SendKermitProtocol(binary: boolean; List: PFileNames);
var
ok: boolean;
s: string;
begin
if not binary then
ok:= MakeKermitFile(kmSend, List) else
ok:= MakeKermitFile(kmSendBinary, List);
if ok then
begin
s:= Dirs.Prog + 'kerlite';
Message(Application, evCommand, cmCallProtocol, @s);
if (CallReturn < 256) and (CallReturn > 0) then
{'šbetragungsprotokoll wurde durch den Benutzer oder
einen Fehler abgebrochen.'}
ErrorBox(#3+GetString(1461), nil, mfOkBeep);
FDelete(Dirs.Temp + 'MSKERMIT.INI');
end;
end;
(********************************************************************)
(** procedure ReceiveKermitProtocol **)
(********************************************************************)
function ReceiveKermitProtocol(binary: boolean): boolean;
var
ok: boolean;
s: string;
begin
if not binary then
ok:= MakeKermitFile(kmReceive, nil) else
ok:= MakeKermitFile(kmReceiveBinary, nil);
if ok then
begin
s:= Dirs.Prog + 'kerlite';
Message(Application, evCommand, cmCallProtocol, @s);
if (CallReturn < 256) and (CallReturn > 0) then
{'šbetragungsprotokoll wurde durch den Benutzer oder
einen Fehler abgebrochen.'}
ErrorBox(#3+GetString(1461), nil, mfOkBeep);
FDelete(Dirs.Temp + 'MSKERMIT.INI');
end;
ReceiveKermitProtocol:= CallReturn = 0;
end;
(********************************************************************)
(** procedure MakeKermitFile **)
(********************************************************************)
function MakeKermitFile(Option: word; List: PFileNames): boolean;
var
INI: Text;
p: PFileRec;
i: integer;
begin
assign(INI, Dirs.Temp + 'MSKERMIT.INI');
{$I-} rewrite(INI); {$I+}
if IOresult <> 0 then
begin
{'Steuerdatei fr KERLITE.EXE konnte nicht erstellt werden.'}
ErrorBox(#3+GetString(1420), nil, mfOkBeep);
MakeKermitFile:= false;
Exit;
end;
writeln(INI, '; FILE MSKERMIT.INI');
writeln(INI, '; ');
writeln(INI, '; Created by HPShell ' + ShellVer + ' ' + CopyRightStr);
writeln(INI, '; ');
writeln(INI, '; Do NOT make any changes in this file since it will be overwritten');
writeln(INI, '; each time you start a transmission between PC and HP48 !');
writeln(INI, '; ');
writeln(INI);
writeln(INI, '; Parameter');
writeln(INI, 'set port com', ComPort.COM+1);
case ComPort.PORT[ComPort.COM] of
0: writeln(INI, 'set com', ComPort.COM+1, ' \x03f8 ', ComPort.IRQ[ComPort.COM]+2);
1: writeln(INI, 'set com', ComPort.COM+1, ' \x02f8 ', ComPort.IRQ[ComPort.COM]+2);
2: writeln(INI, 'set com', ComPort.COM+1, ' \x03e8 ', ComPort.IRQ[ComPort.COM]+2);
3: writeln(INI, 'set com', ComPort.COM+1, ' \x02e8 ', ComPort.IRQ[ComPort.COM]+2)<
