DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦dca1d7b6e⟧ TextFile

    Length: 5504 (0x1580)
    Types: TextFile
    Names: »DIALOG.BAK«

Derivation

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

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:	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»