DataMuseum.dk

top - metrics - download

    Length: 7424 (0x1d00)
    Types: TextFile
    Names: »DIALOGG.PAS«

└─⟦4fbcde1e4⟧ Bits:30003931/GEM_Development-A.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline)
    └─⟦this⟧ »DIALOGG.PAS« 

TextFile

(************************************************************************)
(*	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:	April 1, 1987   					*)
(*									*)
(************************************************************************)


(*
\f


Page*)
(*------------------------------*)
(*	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


Page*)
(************************************************************************)
(************************************************************************)
(****								     ****)
(****			    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;

(*------------------------------*)
(*	vdi_fix			*)
(*------------------------------*)

PROCEDURE vdi_fix(Var pfd:MFDB;theaddr:gempoint;wb,h:integer);
Begin
  pfd.widthword:= wb SHR 1;
  pfd.formwidth:= wb SHL 3;
  pfd.formheight:=h;
  pfd.memplanes:=1;
  pfd.mptr:=theaddr;
End;


(*------------------------------*)
(*	vdi_trans		*)
(*------------------------------*)

PROCEDURE vdi_trans(saddr:gempoint;swb:integer;
                    daddr:gempoint;dwb:integer;h:integer);
Var
  src,dst: MFDB;
Begin
  vdi_fix(src,saddr,swb,h);
  src.formatflag:=1;
  
  vdi_fix(dst,daddr,dwb,h);
  dst.formatflag:=0;
  
  dummy:=vr_trn_fm(vdi_handle,src,dst);
end;
  
(*------------------------------*)
(*	LLGET   		*)
(*------------------------------*)

PROCEDURE LLGET(var addr:gempoint;t:gempoint;l:integer);
Var a:gempoint;
Begin
  a.lo:=t.lo+l;
  a.hi:=t.hi;
  addr.lo:=a.gwp^;
  a.lo:=a.lo+2;
  addr.hi:=a.gwp^;
End;
  
(*------------------------------*)
(*	trans_gimage		*)
(*------------------------------*)

PROCEDURE trans_gimage(tree:address;obj:integer);
Var
  a,b,taddr,obspec:gempoint;
  wb,hl,typ : integer;
  i : integer;
Begin
  a.lo:=tree.lo;
  a.hi:=tree.hi;
  LLGET(obspec,a,24*obj+12);
  a.lo:=tree.lo+(24*obj)+6;
  a.hi:=tree.hi;
  typ:=a.gwp^;
  if (typ=31 (*ICON*)) then
  begin
    LLGET(taddr,obspec,0);
    a.lo:=obspec.lo+22;
    a.hi:=obspec.hi;
    wb:=a.gwp^;
    wb:=wb SHR 3;
    a.lo:=obspec.lo+24;
    a.hi:=obspec.hi;
    hl:=a.gwp^;
    vdi_trans(taddr,wb,taddr,wb,hl);
    LLGET(taddr,obspec,4);
  end
  else
  begin
    LLGET(taddr,obspec,0);
    a.lo:=obspec.lo+4;
    a.hi:=obspec.hi;
    wb:=a.gwp^;
    a.lo:=obspec.lo+6;
    a.hi:=obspec.hi;
    hl:=a.gwp^;
  end;
  vdi_trans(taddr,wb,taddr,wb,hl);
end;

      
(*------------------------------*)
(*	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
  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
  Begin
    work_inÆiÅ:=1;
  End;
  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 gem_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);

  for i:=mus to elefant do
  begin
    trans_gimage(gl_dialog,i);
  end;
  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.