|
|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 5504 (0x1580)
Types: TextFile
Names: »DIALOG.BAK«
└─⟦4fbcde1e4⟧ Bits:30003931/GEM_Development-A.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline)
└─⟦this⟧ »DIALOG.BAK«
(************************************************************************)
(* File: dialog.pas *)
(************************************************************************)
(* *)
(* GGGGG EEEEEEEE MM MM *)
(* GG EE MMMM MMMM *)
(* GG GGG EEEEE MM MM MM *)
(* GG GG EE MM MM *)
(* GGGGG EEEEEEEE MM MM *)
(* *)
(************************************************************************)
(* *)
(* Author: Mogens Rode *)
(* PRODUCT: GEM Dialogbehandling *)
(* Module: DIALOG *)
(* Version: 87.03.19 *)
(* *)
(************************************************************************)
(*
\f
▶83◀▶f8◀
(*------------------------------*)
(* includes *)
(*------------------------------*)
(*$Igempcon.i*)
(*$Igemptype.i*)
(*$Igempvar.i*)
(*$Ivdibnd.pas*)
(*$Igempatyp.i*)
(*$Igempavar.i*)
(*$Iaesbnd.pas*)
(*$Icstring.pas*)
(*------------------------------*)
(* defines *)
(*------------------------------*)
CONST
(*$IDIALOG.i*)
ARROW= 0;
HOUR_GLASS= 2;
DESK= 0;
END_UPDATE= 0;
BEG_UPDATE= 1;
LONG0:ADDRESS = (lo:0;hi:0);
(*
\f
▶86◀▶80◀
(************************************************************************)
(************************************************************************)
(****
****)
(**** Data Structures
****)
(****
****)
(************************************************************************)
(************************************************************************)
TYPE
GRECT = Record
g_x,g_y,g_w,g_h : integer;
End;
VAR
(*------------------------------*)
(* Local *)
(*------------------------------*)
gl_wchar:integer; (* character width *)
gl_hchar:integer; (* character height *)
gl_wbox:integer; (* box (cell) width *)
gl_hbox:integer; (* box (cell) height *)
gem_handle:integer; (* GEM vdi handle *)
vdi_handle:integer; (* hello vdi handle *)
work_out:ARRAY_57; (* open virt workstation
values *)
work_area:GRECT; (* current window work area *)
gl_apid:integer; (* application ID *)
gl_rmsg:ARRAY_8; (* message buffer *)
ad_rmsg:ADDRESS; (* LONG pointer to message
bfr *)
gl_itemhello:integer; (* hello menu item *)
gl_xfull:integer; (* full window 'x' *)
gl_yfull:integer; (* full window 'y' *)
gl_wfull:integer; (* full window 'w' width *)
gl_hfull:integer; (* full window 'h' height *)
ev_which:integer; (* event message returned
value *)
hello_whndl :integer; (* hello window handle *)
type_size:integer; (* system font cell size *)
dummy:integer;
b:boolean;
gl_dialog:ADDRESS; (* dialog adress
*)
rsc:CharString;
rsc_file:ADDRESS;
(*------------------------------*)
(* set_flag *)
(*------------------------------*)
PROCEDURE set_flag(tree:address;obj,flag:integer;xset:boolean);
Var
a : address;
Begin
a.lo:=tree.lo+(24*obj)+8;
a.hi:=tree.hi;
if xset then a.gwp^:=a.gwp^ OR flag
else a.gwp^:=a.gwp^ AND (NOT flag);
End;
(*------------------------------*)
(* dial_loop *)
(*------------------------------*)
PROCEDURE dial_loop;
VAR
x,y,w,h : integer;
ix,iy,iw,ih : integer;
unhidden : integer;
xit : integer;
Begin
unhidden:=mus;
dummy:=form_center(gl_dialog,x,y,w,h);
ix:=0;
iy:=0;
iw:=0;
ih:=0;
dummy:=form_dial(0,ix,iy,iw,ih,x,y,w,h);
dummy:=objc_draw(gl_dialog,DIALOG,2,x,y,w,h);
repeat
xit:=form_do(gl_dialog,-1);
dummy:=objc_change(gl_dialog,xit,0,x,y,w,h,0,1);
set_flag(gl_dialog,unhidden,$80(*HIDETREE*),TRUE);
case xit of
LILLE : unhidden:=MUS;
MELLEM : unhidden:=KAT;
STOR : unhidden:=ELEFANT;
OTHERWISE
end;
set_flag(gl_dialog,unhidden,$80(*HIDETREE*),FALSE);
dummy:=objc_draw(gl_dialog,DIALOG,2,x,y,w,h);
until xit=SLUT;
dummy:=evnt_timer(2000,0);
dummy:=form_dial(3,ix,iy,iw,ih,x,y,w,h);
end;
(*------------------------------*)
(* aes_init *)
(*------------------------------*)
procedure aes_init;
var i : integer;
work_in : intin_ARRAY;
begin
gl_apid := appl_init; (* initialize libraries *)
for i:=0 TO 9 do work_inÆiÅ:=1;
work_inÆ10Å:=0;
gem_handle := graf_handle(gl_wchar,gl_hchar,gl_wbox,gl_hbox);
vdi_handle := gem_handle;
dummy:=v_opnvwk(work_in,vdi_handle,work_out); (* open virtual work
stn*)
if vdi_handle=0 then
begin
writeln('Kan ikke åbne Workstation');
exit;
end;
if rsrc_load(rsc_file)=0 then
begin
writeln('Kan ikke åbne resource-fil');
end;
dummy:=rsrc_gaddr(0,dialog,gl_dialog);
set_flag(gl_dialog,MUS,$80(*HIDETREE*),TRUE);
set_flag(gl_dialog,KAT,$80(*HIDETREE*),TRUE);
set_flag(gl_dialog,ELEFANT,$80(*HIDETREE*),TRUE);
end;
(*------------------------------*)
(* aes_end *)
(*------------------------------*)
procedure aes_end;
begin
dummy:=rsrc_free;
dummy:=v_clsvwk(vdi_handle);
dummy:=appl_exit;
end;
(*------------------------------*)
(* Main *)
(*------------------------------*)
Begin
MakeCString('DIALOG.RSC',rsc);
rsc_file.hi:=seg(rsc);
rsc_file.lo:=ofs(rsc);
aes_init;
dial_loop;
aes_end;
End.
«eof»